Merge #3964

3964: Don't take `AnyCardanoEra` for tx size estimations r=Anviking a=Anviking

- [x] Don't depend on `AnyCardanoEra` for tx size estimation. We're always in a recent era.*

### Comments

- Preparation which makes #3874 nicer
- *) Except such a check may not exist for migration, but the impact of anything going wrong would be low regardless.

### Issue Number

ADP-2990


Co-authored-by: Johannes Lund <johannes.lund@iohk.io>

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 =

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

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