diff --git a/lib/wallet/cardano-wallet.cabal b/lib/wallet/cardano-wallet.cabal index e0f31b04dac..875c4695d84 100644 --- a/lib/wallet/cardano-wallet.cabal +++ b/lib/wallet/cardano-wallet.cabal @@ -358,7 +358,6 @@ library Cardano.Wallet.Write.Tx Cardano.Wallet.Write.Tx.Balance Cardano.Wallet.Write.Tx.Balance.TokenBundleSize - Cardano.Wallet.Write.Tx.Balance.TokenBundleSize.Gen Cardano.Wallet.Write.Tx.Gen Cardano.Wallet.Write.Tx.Redeemers Cardano.Wallet.Write.Tx.Sign @@ -932,8 +931,8 @@ test-suite unit Cardano.Wallet.Submissions.OperationsSpec Cardano.Wallet.Submissions.PrimitivesSpec Cardano.Wallet.TokenMetadataSpec - Cardano.Wallet.Write.Tx.Balance.TokenBundleSizeSpec Cardano.Wallet.Write.TxSpec + Cardano.Wallet.Write.Tx.Balance.TokenBundleSizeSpec Cardano.WalletSpec Control.Concurrent.ConciergeSpec Control.Monad.UtilSpec diff --git a/lib/wallet/src/Cardano/Wallet/Write/Tx.hs b/lib/wallet/src/Cardano/Wallet/Write/Tx.hs index 8df617a6a71..2267d091420 100644 --- a/lib/wallet/src/Cardano/Wallet/Write/Tx.hs +++ b/lib/wallet/src/Cardano/Wallet/Write/Tx.hs @@ -79,6 +79,8 @@ module Cardano.Wallet.Write.Tx , feeOfBytes , maxScriptExecutionCost , stakeKeyDeposit + , ProtVer (..) + , Version -- * Tx , Core.Tx @@ -169,7 +171,7 @@ import Cardano.Ledger.Api.UTxO import Cardano.Ledger.Babbage.TxBody ( BabbageTxOut (..) ) import Cardano.Ledger.BaseTypes - ( maybeToStrictMaybe ) + ( ProtVer (..), Version, maybeToStrictMaybe ) import Cardano.Ledger.Binary ( Sized (..) ) import Cardano.Ledger.Coin diff --git a/lib/wallet/src/Cardano/Wallet/Write/Tx/Balance.hs b/lib/wallet/src/Cardano/Wallet/Write/Tx/Balance.hs index fd99f5da199..888daac3a54 100644 --- a/lib/wallet/src/Cardano/Wallet/Write/Tx/Balance.hs +++ b/lib/wallet/src/Cardano/Wallet/Write/Tx/Balance.hs @@ -148,7 +148,7 @@ import Cardano.Wallet.Write.Tx , withConstraints ) import Cardano.Wallet.Write.Tx.Balance.TokenBundleSize - ( getTokenBundleMaxSize, mkTokenBundleSizeAssessor ) + ( mkTokenBundleSizeAssessor ) import Cardano.Wallet.Write.Tx.Redeemers ( ErrAssignRedeemers (..), Redeemer (..), assignScriptRedeemers ) import Cardano.Wallet.Write.Tx.Sign @@ -926,7 +926,7 @@ selectAssets era (ProtocolParameters pp) utxoAssumptions outs redeemers selectionConstraints = SelectionConstraints { tokenBundleSizeAssessor = - mkTokenBundleSizeAssessor (getTokenBundleMaxSize era pp) + mkTokenBundleSizeAssessor era pp , computeMinimumAdaQuantity = \addr tokens -> W.toWallet $ computeMinimumCoinForTxOut era diff --git a/lib/wallet/src/Cardano/Wallet/Write/Tx/Balance/TokenBundleSize.hs b/lib/wallet/src/Cardano/Wallet/Write/Tx/Balance/TokenBundleSize.hs index 90137a26cf8..b8b6683226e 100644 --- a/lib/wallet/src/Cardano/Wallet/Write/Tx/Balance/TokenBundleSize.hs +++ b/lib/wallet/src/Cardano/Wallet/Write/Tx/Balance/TokenBundleSize.hs @@ -1,13 +1,8 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE NamedFieldPuns #-} - -- | Assessing sizes of token bundles module Cardano.Wallet.Write.Tx.Balance.TokenBundleSize ( TokenBundleSizeAssessor (..) - , TokenBundleMaxSize (..) - , computeTokenBundleSerializedLengthBytes , mkTokenBundleSizeAssessor - , getTokenBundleMaxSize + , computeTokenBundleSerializedLengthBytes ) where @@ -16,73 +11,55 @@ import Prelude import Cardano.CoinSelection.Size ( TokenBundleSizeAssessment (..), TokenBundleSizeAssessor (..) ) import Cardano.Ledger.Api - ( ppMaxValSizeL ) + ( StandardCrypto, ppMaxValSizeL, ppProtocolVersionL ) +import Cardano.Ledger.BaseTypes + ( ProtVer (pvMajor) ) import Cardano.Ledger.Binary - ( serialize', shelleyProtVer ) + ( serialize ) import Cardano.Wallet.Primitive.Types.Tx.Constraints ( TxSize (..) ) -import Cardano.Wallet.Shelley.Compatibility - ( toCardanoValue ) +import Cardano.Wallet.Shelley.Compatibility.Ledger + ( toLedger ) import Cardano.Wallet.Write.Tx - ( PParams, RecentEra, ShelleyLedgerEra, withConstraints ) -import Control.DeepSeq - ( NFData ) + ( PParams, RecentEra, ShelleyLedgerEra, Value, Version, withConstraints ) import Control.Lens ( (^.) ) -import GHC.Generics - ( Generic ) -import Numeric.Natural - ( Natural ) +import Data.IntCast + ( intCastMaybe ) -import qualified Cardano.Api.Shelley as Cardano import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle -import qualified Data.ByteString as BS - --- | The maximum size of a serialized 'TokenBundle'. --- ('_maxValSize' in the Alonzo ledger) -newtype TokenBundleMaxSize = TokenBundleMaxSize - { unTokenBundleMaxSize :: TxSize } - deriving (Eq, Generic, Show) - -instance NFData TokenBundleMaxSize +import qualified Data.ByteString.Lazy as BL -- | Assesses a token bundle size in relation to the maximum size that can be -- included in a transaction output. -- --- See 'W.TokenBundleSizeAssessor' for the expected properties of this function. +-- See 'TokenBundleSizeAssessor' for the expected properties of this function. -- -mkTokenBundleSizeAssessor :: TokenBundleMaxSize -> TokenBundleSizeAssessor -mkTokenBundleSizeAssessor maxSize = - TokenBundleSizeAssessor { assessTokenBundleSize } +mkTokenBundleSizeAssessor + :: RecentEra era + -> PParams (ShelleyLedgerEra era) + -> TokenBundleSizeAssessor +mkTokenBundleSizeAssessor era pp = TokenBundleSizeAssessor $ \tb -> + if computeTokenBundleSerializedLengthBytes tb ver > maxValSize + then TokenBundleSizeExceedsLimit + else TokenBundleSizeWithinLimit where - assessTokenBundleSize tb - | serializedLengthBytes <= maxSize' = - TokenBundleSizeWithinLimit - | otherwise = - TokenBundleSizeExceedsLimit - where - serializedLengthBytes :: TxSize - serializedLengthBytes = computeTokenBundleSerializedLengthBytes tb + maxValSize :: TxSize + maxValSize = TxSize $ withConstraints era $ pp ^. ppMaxValSizeL - maxSize' :: TxSize - maxSize' = unTokenBundleMaxSize maxSize + ver :: Version + ver = withConstraints era $ pvMajor $ pp ^. ppProtocolVersionL -computeTokenBundleSerializedLengthBytes :: TokenBundle.TokenBundle -> TxSize -computeTokenBundleSerializedLengthBytes = - TxSize - . safeCast - . BS.length - . serialize' shelleyProtVer - . Cardano.toMaryValue - . toCardanoValue +computeTokenBundleSerializedLengthBytes + :: TokenBundle.TokenBundle + -> Version + -> TxSize +computeTokenBundleSerializedLengthBytes tb ver = serSize (toLedger tb) where - safeCast :: Int -> Natural - safeCast = fromIntegral - --- | Get a 'TokenBundleMaxSize' from a 'PParam era'. -getTokenBundleMaxSize - :: RecentEra era - -> PParams (ShelleyLedgerEra era) - -> TokenBundleMaxSize -getTokenBundleMaxSize era pp = withConstraints era $ - TokenBundleMaxSize $ TxSize $ pp ^. ppMaxValSizeL + serSize :: Value StandardCrypto -> TxSize + serSize v = maybe err TxSize + . intCastMaybe + . BL.length + $ serialize ver v + where + err = error $ "negative serialized size of value: " <> show v diff --git a/lib/wallet/src/Cardano/Wallet/Write/Tx/Balance/TokenBundleSize/Gen.hs b/lib/wallet/src/Cardano/Wallet/Write/Tx/Balance/TokenBundleSize/Gen.hs deleted file mode 100644 index 2d77fee7539..00000000000 --- a/lib/wallet/src/Cardano/Wallet/Write/Tx/Balance/TokenBundleSize/Gen.hs +++ /dev/null @@ -1,38 +0,0 @@ -{-# LANGUAGE TypeApplications #-} - --- | --- Copyright: © 2023 Cardano Foundation --- License: Apache-2.0 -module Cardano.Wallet.Write.Tx.Balance.TokenBundleSize.Gen - ( genTokenBundleMaxSize - , shrinkTokenBundleMaxSize - ) where - -import Prelude - -import Cardano.Wallet.Primitive.Types.Tx.Constraints - ( TxSize (..) ) -import Cardano.Wallet.Write.Tx.Balance.TokenBundleSize - ( TokenBundleMaxSize (..) ) -import Data.Word - ( Word64 ) -import Test.QuickCheck - ( Arbitrary (arbitrary, shrink), Gen, oneof ) - -genTokenBundleMaxSize :: Gen TokenBundleMaxSize -genTokenBundleMaxSize = TokenBundleMaxSize . TxSize <$> - oneof - -- Generate values close to the mainnet value of 4000 (and guard - -- against underflow) - [ fromIntegral . max 0 . (4000 +) <$> arbitrary @Int - - -- Generate more extreme values (both small and large) - , fromIntegral <$> arbitrary @Word64 - ] - -shrinkTokenBundleMaxSize :: TokenBundleMaxSize -> [TokenBundleMaxSize] -shrinkTokenBundleMaxSize (TokenBundleMaxSize (TxSize s)) = - map (TokenBundleMaxSize . TxSize . fromIntegral) - . shrink @Word64 -- Safe w.r.t the generator, despite TxSize wrapping a - -- Natural - $ fromIntegral s diff --git a/lib/wallet/test/unit/Cardano/Wallet/Write/Tx/Balance/TokenBundleSizeSpec.hs b/lib/wallet/test/unit/Cardano/Wallet/Write/Tx/Balance/TokenBundleSizeSpec.hs index 8363f91e8eb..0b6f5037276 100644 --- a/lib/wallet/test/unit/Cardano/Wallet/Write/Tx/Balance/TokenBundleSizeSpec.hs +++ b/lib/wallet/test/unit/Cardano/Wallet/Write/Tx/Balance/TokenBundleSizeSpec.hs @@ -1,4 +1,6 @@ {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Cardano.Wallet.Write.Tx.Balance.TokenBundleSizeSpec where @@ -6,6 +8,10 @@ import Prelude import Cardano.CoinSelection.Size ( TokenBundleSizeAssessment (..) ) +import Cardano.Ledger.Api.Era + ( eraProtVerLow ) +import Cardano.Ledger.Api.PParams + ( PParams, ppMaxValSizeL, ppProtocolVersionL ) import Cardano.Wallet.Primitive.Types.TokenBundle ( TokenBundle ) import Cardano.Wallet.Primitive.Types.TokenBundle.Gen @@ -14,22 +20,40 @@ import Cardano.Wallet.Primitive.Types.Tx.Constraints ( TxSize (..), txOutMaxCoin, txOutMinCoin ) import Cardano.Wallet.Primitive.Types.Tx.TxOut.Gen ( genTxOutTokenBundle ) +import Cardano.Wallet.Write.Tx + ( ProtVer (..) + , RecentEra (..) + , ShelleyLedgerEra + , StandardBabbage + , StandardConway + , Version + , withConstraints + ) import Cardano.Wallet.Write.Tx.Balance.TokenBundleSize - ( TokenBundleMaxSize (TokenBundleMaxSize) + ( TokenBundleSizeAssessor , assessTokenBundleSize , computeTokenBundleSerializedLengthBytes , mkTokenBundleSizeAssessor ) -import Cardano.Wallet.Write.Tx.Balance.TokenBundleSize.Gen - ( genTokenBundleMaxSize, shrinkTokenBundleMaxSize ) +import Control.Lens + ( (&), (.~) ) +import Data.Default + ( def ) +import Data.Word + ( Word64 ) +import Numeric.Natural + ( Natural ) import Test.Hspec ( Spec, describe, it ) import Test.QuickCheck ( Arbitrary (..) , Blind (..) + , Gen , Property + , arbitraryBoundedEnum , conjoin , counterexample + , oneof , property , resize , withMaxSuccess @@ -64,8 +88,9 @@ spec = describe "Assessing the sizes of token bundles" $ do prop_assessTokenBundleSize_enlarge :: Blind (VariableSize1024 TokenBundle) -> Blind (VariableSize16 TokenBundle) + -> PParamsInRecentEra -> Property -prop_assessTokenBundleSize_enlarge b1' b2' = +prop_assessTokenBundleSize_enlarge b1' b2' pp = assess b1 == TokenBundleSizeExceedsLimit ==> conjoin [ assess (b1 `TokenBundle.add` b2) === TokenBundleSizeExceedsLimit @@ -73,8 +98,7 @@ prop_assessTokenBundleSize_enlarge b1' b2' = === TokenBundleSizeExceedsLimit ] where - assess = assessTokenBundleSize - $ mkTokenBundleSizeAssessor maryTokenBundleMaxSize + assess = assessTokenBundleSize $ mkAssessorFromPParamsInRecentEra pp b1 = unVariableSize1024 $ getBlind b1' b2 = unVariableSize16 $ getBlind b2' @@ -84,9 +108,9 @@ prop_assessTokenBundleSize_enlarge b1' b2' = prop_assessTokenBundleSize_shrink :: Blind (VariableSize1024 TokenBundle) -> Blind (VariableSize16 TokenBundle) - -> TokenBundleMaxSize + -> PParamsInRecentEra -> Property -prop_assessTokenBundleSize_shrink b1' b2' maxSize = +prop_assessTokenBundleSize_shrink b1' b2' pp = assess b1 == TokenBundleSizeWithinLimit ==> conjoin [ assess (b1 `TokenBundle.difference` b2) === TokenBundleSizeWithinLimit @@ -94,7 +118,7 @@ prop_assessTokenBundleSize_shrink b1' b2' maxSize = === TokenBundleSizeWithinLimit ] where - assess = assessTokenBundleSize (mkTokenBundleSizeAssessor maxSize) + assess = assessTokenBundleSize $ mkAssessorFromPParamsInRecentEra pp b1 = unVariableSize1024 $ getBlind b1' b2 = unVariableSize16 $ getBlind b2' @@ -108,7 +132,7 @@ unit_assessTokenBundleSize_fixedSizeBundle -- ^ Fixed size bundle -> TokenBundleSizeAssessment -- ^ Expected size assessment - -> TokenBundleMaxSize + -> TokenBundleSizeAssessor -- ^ TokenBundle assessor function -> TxSize -- ^ Expected min length (bytes) @@ -118,7 +142,7 @@ unit_assessTokenBundleSize_fixedSizeBundle unit_assessTokenBundleSize_fixedSizeBundle bundle expectedAssessment - maxSize + assessor expectedMinLengthBytes expectedMaxLengthBytes = withMaxSuccess 100 $ @@ -129,10 +153,9 @@ unit_assessTokenBundleSize_fixedSizeBundle , actualLengthBytes <= expectedMaxLengthBytes ] where - actualAssessment = assessTokenBundleSize - (mkTokenBundleSizeAssessor maxSize) - bundle - actualLengthBytes = computeTokenBundleSerializedLengthBytes bundle + actualAssessment = assessTokenBundleSize assessor bundle + v = eraProtVerLow @StandardBabbage + actualLengthBytes = computeTokenBundleSerializedLengthBytes bundle v counterexampleText = unlines [ "Expected min length bytes:" , show expectedMinLengthBytes @@ -151,7 +174,7 @@ unit_assessTokenBundleSize_fixedSizeBundle_32 unit_assessTokenBundleSize_fixedSizeBundle_32 (Blind (FixedSize32 b)) = unit_assessTokenBundleSize_fixedSizeBundle b TokenBundleSizeWithinLimit - maryTokenBundleMaxSize + babbageTokenBundleSizeAssessor (TxSize 2116) (TxSize 2380) unit_assessTokenBundleSize_fixedSizeBundle_48 @@ -159,7 +182,7 @@ unit_assessTokenBundleSize_fixedSizeBundle_48 unit_assessTokenBundleSize_fixedSizeBundle_48 (Blind (FixedSize48 b)) = unit_assessTokenBundleSize_fixedSizeBundle b TokenBundleSizeWithinLimit - maryTokenBundleMaxSize + babbageTokenBundleSizeAssessor (TxSize 3172) (TxSize 3564) unit_assessTokenBundleSize_fixedSizeBundle_64 @@ -167,7 +190,7 @@ unit_assessTokenBundleSize_fixedSizeBundle_64 unit_assessTokenBundleSize_fixedSizeBundle_64 (Blind (FixedSize64 b)) = unit_assessTokenBundleSize_fixedSizeBundle b TokenBundleSizeExceedsLimit - maryTokenBundleMaxSize + babbageTokenBundleSizeAssessor (TxSize 4228) (TxSize 4748) unit_assessTokenBundleSize_fixedSizeBundle_128 @@ -175,17 +198,13 @@ unit_assessTokenBundleSize_fixedSizeBundle_128 unit_assessTokenBundleSize_fixedSizeBundle_128 (Blind (FixedSize128 b)) = unit_assessTokenBundleSize_fixedSizeBundle b TokenBundleSizeExceedsLimit - maryTokenBundleMaxSize + babbageTokenBundleSizeAssessor (TxSize 8452) (TxSize 9484) instance Arbitrary TokenBundle where arbitrary = genTokenBundleSmallRange shrink = shrinkTokenBundleSmallRange -instance Arbitrary TokenBundleMaxSize where - arbitrary = genTokenBundleMaxSize - shrink = shrinkTokenBundleMaxSize - newtype FixedSize32 a = FixedSize32 { unFixedSize32 :: a } deriving (Eq, Show) @@ -228,5 +247,55 @@ instance Arbitrary (VariableSize1024 TokenBundle) where arbitrary = VariableSize1024 <$> resize 1024 genTokenBundle -- No shrinking -maryTokenBundleMaxSize :: TokenBundleMaxSize -maryTokenBundleMaxSize = TokenBundleMaxSize 4000 +instance Arbitrary Version where + arbitrary = arbitraryBoundedEnum + +data PParamsInRecentEra + = PParamsInBabbage (PParams StandardBabbage) + | PParamsInConway (PParams StandardConway) + deriving (Show, Eq) + +instance Arbitrary PParamsInRecentEra where + arbitrary = oneof + [ PParamsInBabbage <$> genPParams RecentEraBabbage + , PParamsInConway <$> genPParams RecentEraConway + ] + + where + genPParams + :: RecentEra era + -> Gen (PParams (ShelleyLedgerEra era)) + genPParams era = withConstraints era $ do + ver <- arbitrary + maxSize <- genMaxSizeBytes + return $ def + & ppProtocolVersionL .~ (ProtVer ver 0) + -- minor version doesn't matter + & ppMaxValSizeL .~ maxSize + where + genMaxSizeBytes :: Gen Natural + genMaxSizeBytes = + oneof + -- Generate values close to the mainnet value of 4000 bytes + -- (and guard against underflow) + [ fromIntegral . max 0 . (4000 +) <$> arbitrary @Int + + -- Generate more extreme values (both small and large) + , fromIntegral <$> arbitrary @Word64 + ] + +babbageTokenBundleSizeAssessor :: TokenBundleSizeAssessor +babbageTokenBundleSizeAssessor = mkTokenBundleSizeAssessor RecentEraBabbage + $ def + & ppProtocolVersionL .~ (ProtVer (eraProtVerLow @StandardBabbage) 0) + & ppMaxValSizeL .~ maryTokenBundleMaxSizeBytes + where + maryTokenBundleMaxSizeBytes = 4000 + +mkAssessorFromPParamsInRecentEra + :: PParamsInRecentEra + -> TokenBundleSizeAssessor +mkAssessorFromPParamsInRecentEra (PParamsInBabbage pp) = + mkTokenBundleSizeAssessor RecentEraBabbage pp +mkAssessorFromPParamsInRecentEra (PParamsInConway pp) = + mkTokenBundleSizeAssessor RecentEraConway pp