diff --git a/lib/wallet/api/http/Cardano/Wallet/Api/Http/Shelley/Server.hs b/lib/wallet/api/http/Cardano/Wallet/Api/Http/Shelley/Server.hs index 54cb2ef2b54..ea4d80fa533 100644 --- a/lib/wallet/api/http/Cardano/Wallet/Api/Http/Shelley/Server.hs +++ b/lib/wallet/api/http/Cardano/Wallet/Api/Http/Shelley/Server.hs @@ -1786,7 +1786,7 @@ selectCoins ctx@ApiLayer {..} argGenChange (ApiT walletId) body = do body ^. #withdrawal & maybe (pure NoWithdrawal) (shelleyOnlyMkWithdrawal @s - netLayer (txWitnessTagFor @k) db era) + netLayer (txWitnessTagFor @k) db) let genChange = W.defaultChangeAddressGen argGenChange let paymentOuts = NE.toList $ addressAmountToTxOut <$> body ^. #payments let txCtx = defaultTransactionCtx @@ -1909,7 +1909,7 @@ selectCoinsForQuit ctx@ApiLayer{..} (ApiT walletId) = do toTimeTranslation (timeInterpreter netLayer) pp <- NW.currentProtocolParameters netLayer withdrawal <- W.shelleyOnlyMkSelfWithdrawal @s - netLayer (txWitnessTagFor @k) era db + netLayer (txWitnessTagFor @k) db action <- WD.quitStakePoolDelegationAction db withdrawal let changeAddrGen = W.defaultChangeAddressGen (delegationAddressS @n) let txCtx = defaultTransactionCtx @@ -2193,7 +2193,7 @@ postTransactionOld ctx@ApiLayer{..} argGenChange (ApiT wid) body = do Nothing -> pure NoWithdrawal Just apiWdrl -> shelleyOnlyMkWithdrawal @s - netLayer (txWitnessTagFor @k) db era apiWdrl + netLayer (txWitnessTagFor @k) db apiWdrl let txCtx = defaultTransactionCtx { txWithdrawal = wdrl , txMetadata = md @@ -2375,9 +2375,9 @@ postTransactionFeeOld ctx@ApiLayer{..} (ApiT walletId) body = do Nothing -> pure NoWithdrawal Just apiWdrl -> shelleyOnlyMkWithdrawal @s - netLayer (txWitnessTagFor @k) db era apiWdrl + netLayer (txWitnessTagFor @k) db apiWdrl let outputs = F.toList $ addressAmountToTxOut <$> body ^. #payments - minCoins = W.calcMinimumCoinValues protocolParameters txLayer era + minCoins = W.calcMinimumCoinValues protocolParameters txLayer <$> outputs feePercentiles <- liftIO $ W.transactionFee @s db @@ -2473,7 +2473,7 @@ constructTransaction api argGenChange knownPools poolStatus apiWalletId body = d withdrawal <- case body ^. #withdrawal of Just SelfWithdraw -> liftIO $ W.shelleyOnlyMkSelfWithdrawal - netLayer (txWitnessTagFor @k) era db + netLayer (txWitnessTagFor @k) db _ -> pure NoWithdrawal let transactionCtx0 = defaultTransactionCtx @@ -3746,13 +3746,12 @@ createMigrationPlan createMigrationPlan ctx@ApiLayer{..} withdrawalType (ApiT wid) postData = withWorkerCtx ctx wid liftE liftE $ \wrk -> do let db = wrk ^. dbLayer - era <- liftIO $ NW.currentNodeEra netLayer rewardWithdrawal <- case withdrawalType of Nothing -> pure NoWithdrawal Just pd -> shelleyOnlyMkWithdrawal @s - netLayer (txWitnessTagFor @k) db era pd + netLayer (txWitnessTagFor @k) db pd (wallet, _, _) <- handler $ W.readWallet wrk - plan <- handler $ W.createMigrationPlan @_ wrk era rewardWithdrawal + plan <- handler $ W.createMigrationPlan @_ wrk rewardWithdrawal liftHandler $ failWith ErrCreateMigrationPlanEmpty $ mkApiWalletMigrationPlan @@ -3851,8 +3850,8 @@ migrateWallet ctx@ApiLayer{..} withdrawalType (ApiT wid) postData = do rewardWithdrawal <- case withdrawalType of Nothing -> pure NoWithdrawal Just pd -> shelleyOnlyMkWithdrawal @s - netLayer (txWitnessTagFor @k) db era pd - plan <- handler $ W.createMigrationPlan @_ wrk era rewardWithdrawal + netLayer (txWitnessTagFor @k) db pd + plan <- handler $ W.createMigrationPlan @_ wrk rewardWithdrawal ttl <- liftIO $ W.transactionExpirySlot ti Nothing pp <- liftIO $ NW.currentProtocolParameters netLayer selectionWithdrawals <- liftHandler @@ -4222,15 +4221,14 @@ mkWithdrawal . NetworkLayer IO block -> TxWitnessTag -> DBLayer IO (SeqState n ShelleyKey) - -> AnyCardanoEra -> ApiWithdrawalPostData -> Handler Withdrawal -mkWithdrawal netLayer txWitnessTag db era = \case +mkWithdrawal netLayer txWitnessTag db = \case SelfWithdrawal -> - liftIO $ W.mkSelfWithdrawal netLayer txWitnessTag era db + liftIO $ W.mkSelfWithdrawal netLayer txWitnessTag db ExternalWithdrawal (ApiMnemonicT mnemonic) -> liftHandler . ExceptT - $ W.mkExternalWithdrawal netLayer txWitnessTag era mnemonic + $ W.mkExternalWithdrawal netLayer txWitnessTag mnemonic -- | Unsafe version of `mkWithdrawal` that throws runtime error -- when applied to a non-shelley or non-sequential wallet state. @@ -4240,13 +4238,12 @@ shelleyOnlyMkWithdrawal => NetworkLayer IO block -> TxWitnessTag -> DBLayer IO s - -> AnyCardanoEra -> ApiWithdrawalPostData -> Handler Withdrawal -shelleyOnlyMkWithdrawal netLayer txWitnessTag db era postData = +shelleyOnlyMkWithdrawal netLayer txWitnessTag db postData = case walletFlavor @s of ShelleyWallet -> - mkWithdrawal netLayer txWitnessTag db era postData + mkWithdrawal netLayer txWitnessTag db postData _ -> notShelleyWallet where notShelleyWallet = diff --git a/lib/wallet/bench/api-bench.hs b/lib/wallet/bench/api-bench.hs index c47809d8c2e..007909492b4 100644 --- a/lib/wallet/bench/api-bench.hs +++ b/lib/wallet/bench/api-bench.hs @@ -256,9 +256,8 @@ benchmarksSeq BenchmarkConfig{benchmarkName,ctx} = do $ W.listTransactions @_ @s ctx Nothing Nothing Nothing Descending (Just 50) - let era = Cardano.anyCardanoEra Cardano.BabbageEra (_, createMigrationPlanTime) <- bench "createMigrationPlan" - $ W.createMigrationPlan @_ @s ctx era Tx.NoWithdrawal + $ W.createMigrationPlan @_ @s ctx Tx.NoWithdrawal (_, delegationFeeTime) <- bench "delegationFee" $ do timeTranslation <- @@ -410,9 +409,8 @@ benchmarksRnd BenchmarkConfig{benchmarkName,ctx} = do $ W.listTransactions @_ @s ctx Nothing Nothing Nothing Descending (Just 50) - let era = Cardano.anyCardanoEra Cardano.BabbageEra (_, createMigrationPlanTime) <- bench "createMigrationPlan" - $ W.createMigrationPlan @_ @s ctx era Tx.NoWithdrawal + $ W.createMigrationPlan @_ @s ctx Tx.NoWithdrawal pure BenchRndResults { benchName = benchmarkName diff --git a/lib/wallet/src/Cardano/Wallet.hs b/lib/wallet/src/Cardano/Wallet.hs index b9c4415a438..b67f718e244 100644 --- a/lib/wallet/src/Cardano/Wallet.hs +++ b/lib/wallet/src/Cardano/Wallet.hs @@ -231,7 +231,7 @@ import Cardano.Address.Derivation import Cardano.Address.Script ( Cosigner (..), KeyHash ) import Cardano.Api - ( AnyCardanoEra, serialiseToCBOR ) + ( serialiseToCBOR ) import Cardano.Api.Extra ( inAnyCardanoEra ) import Cardano.BM.Data.Severity @@ -968,27 +968,25 @@ getWalletUtxoSnapshot getWalletUtxoSnapshot ctx = do (wallet, _, pending) <- readWallet @ctx @s ctx pp <- liftIO $ currentProtocolParameters nl - era <- liftIO $ currentNodeEra nl let txOuts = availableUTxO @s pending wallet & unUTxO & F.toList - pure $ first (view #tokens) . pairTxOutWithMinAdaQuantity era pp <$> txOuts + pure $ first (view #tokens) . pairTxOutWithMinAdaQuantity pp <$> txOuts where nl = ctx ^. networkLayer tl = ctx ^. transactionLayer @(KeyOf s) @(CredFromOf s) pairTxOutWithMinAdaQuantity - :: Cardano.AnyCardanoEra - -> ProtocolParameters + :: ProtocolParameters -> TxOut -> (TxOut, Coin) - pairTxOutWithMinAdaQuantity era pp out = + pairTxOutWithMinAdaQuantity pp out = (out, computeMinAdaQuantity out) where computeMinAdaQuantity :: TxOut -> Coin computeMinAdaQuantity (TxOut addr bundle) = view #txOutputMinimumAdaQuantity - (constraints tl era pp) + (constraints tl pp) (addr) (view #tokens bundle) @@ -1228,29 +1226,27 @@ fetchRewardBalance DBLayer{..} = atomically readDelegationRewardBalance mkExternalWithdrawal :: NetworkLayer IO block -> TxWitnessTag - -> AnyCardanoEra -> SomeMnemonic -> IO (Either ErrWithdrawalNotBeneficial Withdrawal) -mkExternalWithdrawal netLayer txWitnessTag era mnemonic = do +mkExternalWithdrawal netLayer txWitnessTag mnemonic = do let (_, rewardAccount, derivationPath) = someRewardAccount @ShelleyKey mnemonic balance <- getCachedRewardAccountBalance netLayer rewardAccount pp <- currentProtocolParameters netLayer let (xprv, _acct , _path) = someRewardAccount @ShelleyKey mnemonic - pure $ checkRewardIsWorthTxCost txWitnessTag pp era balance $> + pure $ checkRewardIsWorthTxCost txWitnessTag pp balance $> WithdrawalExternal rewardAccount derivationPath balance xprv mkSelfWithdrawal :: NetworkLayer IO block -> TxWitnessTag - -> AnyCardanoEra -> DBLayer IO (SeqState n ShelleyKey) -> IO Withdrawal -mkSelfWithdrawal netLayer txWitnessTag era db = do +mkSelfWithdrawal netLayer txWitnessTag db = do (rewardAccount, _, derivationPath) <- readRewardAccount db balance <- getCachedRewardAccountBalance netLayer rewardAccount pp <- currentProtocolParameters netLayer - pure $ case checkRewardIsWorthTxCost txWitnessTag pp era balance of + pure $ case checkRewardIsWorthTxCost txWitnessTag pp balance of Left ErrWithdrawalNotBeneficial -> NoWithdrawal Right () -> WithdrawalSelf rewardAccount derivationPath balance @@ -1261,12 +1257,11 @@ shelleyOnlyMkSelfWithdrawal . WalletFlavor s => NetworkLayer IO block -> TxWitnessTag - -> AnyCardanoEra -> DBLayer IO s -> IO Withdrawal -shelleyOnlyMkSelfWithdrawal netLayer txWitnessTag era db = +shelleyOnlyMkSelfWithdrawal netLayer txWitnessTag db = case walletFlavor @s of - ShelleyWallet -> mkSelfWithdrawal netLayer txWitnessTag era db + ShelleyWallet -> mkSelfWithdrawal netLayer txWitnessTag db _ -> notShelleyWallet where notShelleyWallet = throwIO @@ -1275,14 +1270,13 @@ shelleyOnlyMkSelfWithdrawal netLayer txWitnessTag era db = checkRewardIsWorthTxCost :: TxWitnessTag -> ProtocolParameters - -> AnyCardanoEra -> Coin -> Either ErrWithdrawalNotBeneficial () -checkRewardIsWorthTxCost txWitnessTag pp era balance = do +checkRewardIsWorthTxCost txWitnessTag pp balance = do when (balance == Coin 0) $ Left ErrWithdrawalNotBeneficial let minimumCost txCtx = - calculateMinimumFee era feePerByte txWitnessTag txCtx emptySkeleton + calculateMinimumFee feePerByte txWitnessTag txCtx emptySkeleton costWith = minimumCost $ mkTxCtx balance costWithout = minimumCost $ mkTxCtx $ Coin 0 worthOfWithdrawal = Coin.toInteger costWith - Coin.toInteger costWithout @@ -1774,11 +1768,10 @@ readWalletUTxO ctx = do calcMinimumCoinValues :: ProtocolParameters -> TransactionLayer k ktype tx - -> Cardano.AnyCardanoEra -> TxOut -> Coin -calcMinimumCoinValues pp txLayer era = - uncurry (constraints txLayer era pp ^. #txOutputMinimumAdaQuantity) +calcMinimumCoinValues pp txLayer = + uncurry (constraints txLayer pp ^. #txOutputMinimumAdaQuantity) . (\o -> (o ^. #address, o ^. #tokens . #tokens)) signTransaction @@ -2643,13 +2636,12 @@ createMigrationPlan , HasTransactionLayer (KeyOf s) 'CredFromKeyK ctx ) => ctx - -> Cardano.AnyCardanoEra -> Withdrawal -> IO MigrationPlan -createMigrationPlan ctx era rewardWithdrawal = do +createMigrationPlan ctx rewardWithdrawal = do (wallet, _, pending) <- readWallet @ctx @s ctx pp <- liftIO $ currentProtocolParameters nl - let txConstraints = constraints tl era pp + let txConstraints = constraints tl pp let utxo = availableUTxO @s pending wallet pure $ Migration.createPlan txConstraints utxo diff --git a/lib/wallet/src/Cardano/Wallet/Shelley/Transaction.hs b/lib/wallet/src/Cardano/Wallet/Shelley/Transaction.hs index cb0703a8504..13f3d8d4af4 100644 --- a/lib/wallet/src/Cardano/Wallet/Shelley/Transaction.hs +++ b/lib/wallet/src/Cardano/Wallet/Shelley/Transaction.hs @@ -159,7 +159,6 @@ import Cardano.Wallet.Primitive.Types.Tx , cardanoTxIdeallyNoLaterThan , sealedTxFromCardano' , sealedTxFromCardanoBody - , withinEra ) import Cardano.Wallet.Primitive.Types.Tx.Constraints ( TxConstraints (..), TxSize (..), txOutMaxTokenQuantity, txSizeDistance ) @@ -686,7 +685,7 @@ newTransactionLayer keyF networkId = TransactionLayer , tokenBundleSizeAssessor = Compatibility.tokenBundleSizeAssessor - , constraints = \era pp -> txConstraints era pp (txWitnessTagFor @k) + , constraints = \pp -> txConstraints pp (txWitnessTagFor @k) , decodeTx = _decodeSealedTx @@ -1311,8 +1310,8 @@ getFeePerByteFromWalletPParams pp = LinearFee LinearFunction{slope} = getFeePolicy $ txParameters pp txConstraints - :: AnyCardanoEra -> ProtocolParameters -> TxWitnessTag -> TxConstraints -txConstraints era protocolParams witnessTag = TxConstraints + :: ProtocolParameters -> TxWitnessTag -> TxConstraints +txConstraints protocolParams witnessTag = TxConstraints { txBaseCost , txBaseSize , txInputCost @@ -1329,7 +1328,7 @@ txConstraints era protocolParams witnessTag = TxConstraints } where txBaseCost = - constantTxFee <> estimateTxCost era feePerByte empty + constantTxFee <> estimateTxCost feePerByte empty constantTxFee = Coin $ ceiling intercept feePerByte = getFeePerByteFromWalletPParams protocolParams @@ -1337,7 +1336,7 @@ txConstraints era protocolParams witnessTag = TxConstraints = getFeePolicy $ txParameters protocolParams txBaseSize = - estimateTxSize era empty + estimateTxSize empty txInputCost = marginalCostOf empty {txInputCount = 1} @@ -1386,14 +1385,14 @@ txConstraints era protocolParams witnessTag = TxConstraints marginalCostOf :: TxSkeleton -> Coin marginalCostOf skeleton = Coin.distance - (estimateTxCost era feePerByte empty) - (estimateTxCost era feePerByte skeleton) + (estimateTxCost feePerByte empty) + (estimateTxCost feePerByte skeleton) -- Computes the size difference between the given skeleton and an empty -- skeleton. marginalSizeOf :: TxSkeleton -> TxSize marginalSizeOf = - txSizeDistance txBaseSize . estimateTxSize era + txSizeDistance txBaseSize . estimateTxSize -- Constructs a real transaction output from a token bundle. mkTxOut :: TokenBundle -> TxOut @@ -1485,9 +1484,9 @@ mkTxSkeleton witness context skeleton = TxSkeleton -- | Estimates the final cost of a transaction based on its skeleton. -- -- The constant tx fee is /not/ included in the result of this function. -estimateTxCost :: AnyCardanoEra -> FeePerByte -> TxSkeleton -> Coin -estimateTxCost era (FeePerByte feePerByte) skeleton = - computeFee (estimateTxSize era skeleton) +estimateTxCost :: FeePerByte -> TxSkeleton -> Coin +estimateTxCost (FeePerByte feePerByte) skeleton = + computeFee (estimateTxSize skeleton) where computeFee :: TxSize -> Coin computeFee (TxSize size) = Coin $ feePerByte * size @@ -1497,9 +1496,7 @@ estimateTxCost era (FeePerByte feePerByte) skeleton = -- -- The constant tx fee is /not/ included in the result of this function. calculateMinimumFee - :: AnyCardanoEra - -- ^ Era for which the transaction should be created. - -> FeePerByte + :: FeePerByte -> TxWitnessTag -- ^ Witness tag -> TransactionCtx @@ -1507,8 +1504,8 @@ calculateMinimumFee -> SelectionSkeleton -- ^ An intermediate representation of an ongoing selection -> Coin -calculateMinimumFee era feePerByte witnessTag ctx skeleton = - estimateTxCost era feePerByte (mkTxSkeleton witnessTag ctx skeleton) +calculateMinimumFee feePerByte witnessTag ctx skeleton = + estimateTxCost feePerByte (mkTxSkeleton witnessTag ctx skeleton) -- | Calculate the cost of increasing a CBOR-encoded Coin-value by another Coin -- with the lovelace/byte cost given by the 'FeePolicy'. @@ -1705,10 +1702,9 @@ burnSurplusAsFees feePolicy surplus (TxFeeAndChange fee0 ()) -- https://github.com/input-output-hk/cardano-ledger/blob/master/eras/alonzo/test-suite/cddl-files/alonzo.cddl -- estimateTxSize - :: AnyCardanoEra - -> TxSkeleton + :: TxSkeleton -> TxSize -estimateTxSize era skeleton = +estimateTxSize skeleton = TxSize $ fromIntegral sizeOf_Transaction where TxSkeleton @@ -1877,17 +1873,6 @@ estimateTxSize era skeleton = + sizeOf_Hash32 + sizeOf_UInt - -- legacy_transaction_output = - -- [address, amount : value] - -- value = - -- coin / [coin,multiasset] - sizeOf_LegacyTransactionOutput TxOut {address, tokens} - = sizeOf_SmallArray - + sizeOf_Address address - + sizeOf_SmallArray - + sizeOf_Coin (TokenBundle.getCoin tokens) - + sumVia sizeOf_NativeAsset (TokenBundle.getAssets tokens) - -- post_alonzo_transaction_output = -- { 0 : address -- , 1 : value @@ -1906,27 +1891,11 @@ estimateTxSize era skeleton = + sumVia sizeOf_NativeAsset (TokenBundle.getAssets tokens) sizeOf_Output - = if withinEra (AnyCardanoEra AlonzoEra) era - then sizeOf_LegacyTransactionOutput - else sizeOf_PostAlonzoTransactionOutput + = sizeOf_PostAlonzoTransactionOutput sizeOf_ChangeOutput :: Set AssetId -> Integer sizeOf_ChangeOutput - = if withinEra (AnyCardanoEra AlonzoEra) era - then sizeOf_LegacyChangeOutput - else sizeOf_PostAlonzoChangeOutput - - -- transaction_output = - -- [address, amount : value] - -- value = - -- coin / [coin,multiasset] - sizeOf_LegacyChangeOutput :: Set AssetId -> Integer - sizeOf_LegacyChangeOutput xs - = sizeOf_SmallArray - + sizeOf_ChangeAddress - + sizeOf_SmallArray - + sizeOf_LargeUInt - + sumVia sizeOf_NativeAsset xs + = sizeOf_PostAlonzoChangeOutput -- post_alonzo_transaction_output = -- { 0 : address diff --git a/lib/wallet/src/Cardano/Wallet/Transaction.hs b/lib/wallet/src/Cardano/Wallet/Transaction.hs index 4ba39b652d3..ef1a63455f4 100644 --- a/lib/wallet/src/Cardano/Wallet/Transaction.hs +++ b/lib/wallet/src/Cardano/Wallet/Transaction.hs @@ -205,9 +205,7 @@ data TransactionLayer k ktype tx = TransactionLayer -- ^ A function to assess the size of a token bundle. , constraints - :: AnyCardanoEra - -- Era for which the transaction should be created. - -> ProtocolParameters + :: ProtocolParameters -- Current protocol parameters. -> TxConstraints -- The set of constraints that apply to all transactions. diff --git a/lib/wallet/src/Cardano/Wallet/Write/Tx/Balance.hs b/lib/wallet/src/Cardano/Wallet/Write/Tx/Balance.hs index dddf51c2c70..3b4b2e8fe1a 100644 --- a/lib/wallet/src/Cardano/Wallet/Write/Tx/Balance.hs +++ b/lib/wallet/src/Cardano/Wallet/Write/Tx/Balance.hs @@ -129,7 +129,6 @@ import Cardano.Wallet.Write.Tx , feeOfBytes , fromCardanoTx , fromCardanoUTxO - , fromRecentEra , getFeePerByte , isBelowMinimumCoinForTxOut , maxScriptExecutionCost @@ -879,9 +878,7 @@ balanceTransactionWithSelectionStrategyAndNoZeroAdaAdjustment -- transaction. For this, and other reasons, the selection may include too -- much ada. selectAssets - :: forall era changeState - . Cardano.IsCardanoEra era - => RecentEra era + :: forall era changeState. RecentEra era -> ProtocolParameters era -> UTxOAssumptions -> [W.TxOut] @@ -925,7 +922,6 @@ selectAssets era (ProtocolParameters pp) utxoAssumptions outs redeemers , fee0 , txPlutusScriptExecutionCost , calculateMinimumFee - (Cardano.AnyCardanoEra (fromRecentEra era)) feePerByte (assumedTxWitnessTag utxoAssumptions) (defaultTransactionCtx @@ -996,7 +992,6 @@ selectAssets era (ProtocolParameters pp) utxoAssumptions outs redeemers boringFee = calculateMinimumFee - (Cardano.AnyCardanoEra (fromRecentEra era)) feePerByte (assumedTxWitnessTag utxoAssumptions) defaultTransactionCtx diff --git a/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs b/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs index 43f3eee930f..fe460d9d788 100644 --- a/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs +++ b/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs @@ -506,7 +506,7 @@ import qualified Test.Hspec.Extra as Hspec spec :: Spec spec = do decodeSealedTxSpec - forAllEras feeCalculationSpec + feeCalculationSpec feeEstimationRegressionSpec forAllRecentEras binaryCalculationsSpec transactionConstraintsSpec @@ -551,15 +551,6 @@ spec_forAllRecentEras description p = forAllRecentEras' f = forAllRecentEras $ \(AnyRecentEra era) -> f $ AnyCardanoEra $ Write.cardanoEraFromRecentEra era -spec_forAllEras - :: Testable prop => String -> (AnyCardanoEra -> prop) -> Spec -spec_forAllEras description p = - describe description $ - forAllEras - $ \(AnyCardanoEra era) -> it (show era) - $ property - $ p (AnyCardanoEra era) - instance Arbitrary SealedTx where arbitrary = sealedTxFromCardano <$> genTx @@ -1095,20 +1086,6 @@ prop_signTransaction_preservesScriptIntegrity (AnyCardanoEra era) rootK utxo = ) ] -forAllEras :: (AnyCardanoEra -> Spec) -> Spec -forAllEras eraSpec = do - eraSpec (AnyCardanoEra ByronEra) - forAllShelleyBasedEras eraSpec - -forAllShelleyBasedEras :: (AnyCardanoEra -> Spec) -> Spec -forAllShelleyBasedEras eraSpec = do - eraSpec (AnyCardanoEra ShelleyEra) - eraSpec (AnyCardanoEra AllegraEra) - eraSpec (AnyCardanoEra MaryEra) - eraSpec (AnyCardanoEra AlonzoEra) - eraSpec (AnyCardanoEra BabbageEra) - eraSpec (AnyCardanoEra ConwayEra) - forAllRecentEras :: (AnyRecentEra -> Spec) -> Spec forAllRecentEras eraSpec = do eraSpec (AnyRecentEra RecentEraBabbage) @@ -1160,8 +1137,8 @@ decodeSealedTxSpec = describe "SealedTx serialisation/deserialisation" $ do , "b77b47f2ddb31c19326b87ed6f71fb9a27133ad51b000000e8d4a510000e80a0f5f6" ] -feeCalculationSpec :: AnyCardanoEra -> Spec -feeCalculationSpec era = describe "fee calculations" $ do +feeCalculationSpec :: Spec +feeCalculationSpec = describe "fee calculations" $ do it "withdrawals incur fees" $ property $ \wdrl -> let costWith = @@ -1456,15 +1433,15 @@ feeCalculationSpec era = describe "fee calculations" $ do minFee :: TransactionCtx -> Integer minFee ctx = Coin.toInteger $ - calculateMinimumFee era feePerByte witnessTag ctx emptySkeleton + calculateMinimumFee feePerByte witnessTag ctx emptySkeleton where witnessTag = txWitnessTagFor @ShelleyKey minFeeSkeleton :: TxSkeleton -> Integer - minFeeSkeleton = Coin.toInteger . estimateTxCost era feePerByte + minFeeSkeleton = Coin.toInteger . estimateTxCost feePerByte estimateTxSize' :: TxSkeleton -> Integer - estimateTxSize' = fromIntegral . unTxSize . estimateTxSize era + estimateTxSize' = fromIntegral . unTxSize . estimateTxSize (dummyAcct, dummyPath) = (FromKeyHash mempty, DerivationIndex 0 :| []) @@ -1769,7 +1746,7 @@ binaryCalculationsSpec' era = describe ("calculateBinary - "+||era||+"") $ do transactionConstraintsSpec :: Spec transactionConstraintsSpec = describe "Transaction constraints" $ do - spec_forAllEras "size of empty transaction" prop_txConstraints_txBaseSize + it "size of empty transaction" prop_txConstraints_txBaseSize it "size of non-empty transaction" $ property prop_txConstraints_txSize it "maximum size of output" $ @@ -2038,9 +2015,9 @@ mockProtocolParameters = dummyProtocolParameters , minimumCollateralPercentage = 150 } -mockTxConstraints :: AnyCardanoEra -> TxConstraints -mockTxConstraints era = - txConstraints era mockProtocolParameters TxWitnessShelleyUTxO +mockTxConstraints :: TxConstraints +mockTxConstraints = + txConstraints mockProtocolParameters TxWitnessShelleyUTxO data MockSelection = MockSelection { txInputCount :: Int @@ -2089,17 +2066,16 @@ instance Arbitrary MockSelection where -- produces a result that is consistent with the result of using -- 'estimateTxSize'. -- -prop_txConstraints_txBaseSize :: AnyCardanoEra -> Property -prop_txConstraints_txBaseSize era = - txBaseSize (mockTxConstraints era) - === estimateTxSize era emptyTxSkeleton +prop_txConstraints_txBaseSize :: Property +prop_txConstraints_txBaseSize = + txBaseSize mockTxConstraints === estimateTxSize emptyTxSkeleton -- Tests that using 'txConstraints' to estimate the size of a non-empty -- selection produces a result that is consistent with the result of using -- 'estimateTxSize'. -- -prop_txConstraints_txSize :: AnyCardanoEra -> MockSelection -> Property -prop_txConstraints_txSize era mock = +prop_txConstraints_txSize :: MockSelection -> Property +prop_txConstraints_txSize mock = counterexample ("result: " <> show result) $ counterexample ("lower bound: " <> show lowerBound) $ counterexample ("upper bound: " <> show upperBound) $ @@ -2111,12 +2087,12 @@ prop_txConstraints_txSize era mock = MockSelection {txInputCount, txOutputs, txRewardWithdrawal} = mock result :: TxSize result = mconcat - [ txBaseSize (mockTxConstraints era) - , txInputCount `mtimesDefault` txInputSize (mockTxConstraints era) - , F.foldMap (txOutputSize (mockTxConstraints era) . tokens) txOutputs - , txRewardWithdrawalSize (mockTxConstraints era) txRewardWithdrawal + [ txBaseSize mockTxConstraints + , txInputCount `mtimesDefault` txInputSize mockTxConstraints + , F.foldMap (txOutputSize mockTxConstraints . tokens) txOutputs + , txRewardWithdrawalSize mockTxConstraints txRewardWithdrawal ] - lowerBound = estimateTxSize era emptyTxSkeleton + lowerBound = estimateTxSize emptyTxSkeleton {txInputCount, txOutputs, txRewardWithdrawal} -- We allow a small amount of overestimation due to the slight variation in -- the marginal size of an input: @@ -2133,10 +2109,9 @@ instance Arbitrary (Large TokenBundle) where -- the bundle is oversized. -- prop_txConstraints_txOutputMaximumSize - :: AnyCardanoEra - -> Blind (Large TokenBundle) + :: Blind (Large TokenBundle) -> Property -prop_txConstraints_txOutputMaximumSize era (Blind (Large bundle)) = +prop_txConstraints_txOutputMaximumSize (Blind (Large bundle)) = checkCoverage $ cover 10 (authenticComparison == LT) "authentic bundle size is smaller than maximum" $ @@ -2182,9 +2157,9 @@ prop_txConstraints_txOutputMaximumSize era (Blind (Large bundle)) = authenticSizeMax = unTokenBundleMaxSize maryTokenBundleMaxSize simulatedSize :: TxSize - simulatedSize = txOutputSize (mockTxConstraints era) bundle + simulatedSize = txOutputSize mockTxConstraints bundle simulatedSizeMax :: TxSize - simulatedSizeMax = txOutputMaximumSize (mockTxConstraints era) + simulatedSizeMax = txOutputMaximumSize mockTxConstraints instance Arbitrary AssetId where arbitrary =