Drop support balancing in future eras

lib/wallet/api/http/Cardano/Wallet/Api/Http/Server/Error.hs

@@ -457,14 +457,20 @@ instance IsServerError ErrGetPolicyId where
 
 instance IsServerError ErrWriteTxEra where
     toServerError = \case
-        ErrTxNotInEra _ ->
-            apiError err403 BalanceTxTxInUnexpectedEra $ T.unwords
-                [ "The provided transaction could be deserialised, just not"
-                , "in the era of the local node tip."
+        ErrTxNotInNodeEra era ->
+            apiError err403 TxNotInNodeEra $ T.unwords
+                [ "The provided transaction could be deserialised, just not in"
+                , showT era <> ","
+                , "the era the local node currently is in."
+                , "If the node is not yet fully synced, try waiting."
+                , "If you're constructing a transaction for a future era for"
+                , "testing purposes, try doing so on a testnet in that era"
+                , "instead."
                 ]
         ErrOldEraNotSupported (Cardano.AnyCardanoEra era) ->
             apiError err403 BalanceTxEraNotSupported $ T.unwords
-                [ "Balancing in ", showT era, " "
+                [ "Balancing transactions in ", showT era
+                , "(the era the local node currently is in)"
                 , "is not supported."
                 ]
 

lib/wallet/api/http/Cardano/Wallet/Api/Http/Shelley/Server.hs

@@ -155,10 +155,6 @@ import Cardano.Api
     , toNetworkMagic
     , unNetworkMagic
     )
-import Cardano.Api.Extra
-    ( inAnyCardanoEra )
-import Cardano.Api.Shelley
-    ( ShelleyLedgerEra )
 import Cardano.BM.Tracing
     ( HasPrivacyAnnotation (..), HasSeverityAnnotation (..) )
 import Cardano.Mnemonic
@@ -508,7 +504,7 @@ import Cardano.Wallet.Primitive.Types.Tx
     , TxChange (..)
     , TxStatus (..)
     , UnsignedTx (..)
-    , cardanoTxIdeallyNoLaterThan
+    , cardanoTxInExactEra
     , getSealedTxWitnesses
     , sealedTxFromCardanoBody
     )
@@ -549,16 +545,14 @@ import Cardano.Wallet.Unsafe
     ( unsafeRunExceptT )
 import Cardano.Wallet.Write.Tx
     ( AnyRecentEra (..) )
-import Cardano.Wallet.Write.Tx.Balance
-    ( constructUTxOIndex )
 import Control.Arrow
     ( second, (&&&) )
 import Control.DeepSeq
     ( NFData )
 import Control.Error.Util
     ( failWith )
 import Control.Monad
-    ( forM, forever, join, void, when, (<=<), (>=>) )
+    ( forM, forever, join, void, when, (>=>) )
 import Control.Monad.Error.Class
     ( throwError )
 import Control.Monad.IO.Class
@@ -3070,80 +3064,36 @@ balanceTransaction
     (ApiT wid)
     body = do
     -- NOTE: Ideally we'd read @pp@ and @era@ atomically.
-    pp <- liftIO $ NW.currentProtocolParameters nl
-    era <- liftIO $ NW.currentNodeEra nl
+    era <- liftIO $ NW.currentNodeEra netLayer
+    pp <- liftIO (currentProtocolParameters netLayer)
+    Write.AnyRecentEra recentEra <- guardIsRecentEra era
+
     withWorkerCtx ctx wid liftE liftE $ \wrk -> do
-        (walletUTxO, wallet, _txs) <- handler $ W.readWalletUTxO @_ @s wrk
+        (utxo, wallet, _txs) <- handler $ W.readWalletUTxO wrk
         timeTranslation <- liftIO $ toTimeTranslation (timeInterpreter netLayer)
-        let mkPartialTx
-                :: forall era. Write.IsRecentEra era => Cardano.Tx era
-                -> Handler (Write.PartialTx era)
-            mkPartialTx tx = do
-                utxo <- fmap Write.toCardanoUTxO $ mkLedgerUTxO $ body ^. #inputs
-                pure $ Write.PartialTx
-                    tx
-                    utxo
-                    (fromApiRedeemer <$> body ^. #redeemers)
-              where
-                -- NOTE: There are a couple of spread-out pieces of logic
-                -- dealing with the choice of era, most prominantly: tx, utxo,
-                -- pparams / current node era. It /might/ be neater to have a
-                -- single function dedicated to this choice instead; something
-                -- like
-                -- @@
-                --      chooseEra
-                --          :: InRecentEra Tx
-                --          -> InRecentEra UTxO
-                --          -> InRecentEra PParams
-                --          -> (IsRecentEra era
-                --              => Tx era
-                --              -> UTxO era
-                --              -> PParams era
-                --              -> res)
-                --          -> res
-                -- @@
-
-                mkRecentEra :: Handler (Write.RecentEra era)
-                mkRecentEra = case Cardano.cardanoEra @era of
-                    Cardano.ConwayEra -> pure Write.RecentEraConway
-                    Cardano.BabbageEra -> pure Write.RecentEraBabbage
-                    _ -> liftHandler $ throwE $ W.ErrOldEraNotSupported era
-
-                mkLedgerUTxO
-                    :: [ApiExternalInput n]
-                    -> Handler (Write.UTxO (ShelleyLedgerEra era))
-                mkLedgerUTxO ins = do
-                    recentEra <- mkRecentEra
-                    pure
-                        . Write.utxoFromTxOutsInRecentEra recentEra
-                        . map fromExternalInput
-                        $ ins
+
+        partialTx <- parsePartialTx recentEra
 
         let balanceTx
                 :: forall era. Write.IsRecentEra era
                 => Write.PartialTx era
                 -> Handler (Cardano.Tx era)
-            balanceTx partialTx =
+            balanceTx ptx =
                 liftHandler $ fst <$> Write.balanceTransaction @_ @IO @s
                     (MsgWallet . W.MsgBalanceTx >$< wrk ^. W.logger)
                     (Write.UTxOAssumptions
                         genInpScripts
                         mScriptTemplate
-                        (txWitnessTagFor @k))
-                    (Write.unsafeFromWalletProtocolParameters pp)
+                        (txWitnessTagFor @k)
+                        )
+                    (Write.unsafeFromWalletProtocolParameters @era pp)
                     timeTranslation
-                    (constructUTxOIndex walletUTxO)
+                    (Write.constructUTxOIndex utxo)
                     (W.defaultChangeAddressGen argGenChange)
                     (getState wallet)
-                    partialTx
-
-        anyRecentTx <- maybeToHandler (W.ErrOldEraNotSupported era)
-            . Write.asAnyRecentEra
-            . cardanoTxIdeallyNoLaterThan era
-            . getApiT $ body ^. #transaction
+                    ptx
 
-        res <- Write.withInAnyRecentEra anyRecentTx
-            (fmap inAnyCardanoEra . balanceTx <=< mkPartialTx)
+        res <- Cardano.InAnyCardanoEra Write.cardanoEra <$> balanceTx partialTx
 
         case body ^. #encoding of
             Just HexEncoded ->
@@ -3152,11 +3102,27 @@ balanceTransaction
             _ -> pure $ ApiSerialisedTransaction
                 (ApiT $ W.sealedTxFromCardano res) Base64Encoded
   where
-    nl = ctx ^. networkLayer
-
-    maybeToHandler :: IsServerError e => e -> Maybe a -> Handler a
-    maybeToHandler _ (Just a) = pure a
-    maybeToHandler e Nothing  = liftHandler $ throwE e
+    parsePartialTx
+        :: Write.IsRecentEra era
+        => Write.RecentEra era
+        -> Handler (Write.PartialTx era)
+    parsePartialTx era = do
+        let externalUTxO = Write.toCardanoUTxO
+                $ Write.utxoFromTxOutsInRecentEra era
+                $ map fromExternalInput
+                $ body ^. #inputs
+
+        tx <- maybe
+                (liftHandler $ throwE $ W.ErrTxNotInNodeEra $ AnyRecentEra era)
+                pure
+            . cardanoTxInExactEra (Write.cardanoEraFromRecentEra era)
+            . getApiT
+            $ body ^. #transaction
+
+        return $ Write.PartialTx
+            tx
+            externalUTxO
+            (fromApiRedeemer <$> body ^. #redeemers)
 
 decodeTransaction
     :: forall s n

lib/wallet/api/http/Cardano/Wallet/Api/Types/Error.hs

@@ -89,7 +89,7 @@ data ApiErrorInfo
     | BalanceTxExistingCollateral
     | BalanceTxExistingKeyWitnesses
     | BalanceTxExistingReturnCollateral
-    | BalanceTxTxInUnexpectedEra
+    | TxNotInNodeEra
     | BalanceTxExistingTotalCollateral
     | BalanceTxInternalError
     | BalanceTxUnderestimatedFee

lib/wallet/src/Cardano/Wallet.hs

@@ -1839,7 +1839,7 @@ type MakeRewardAccountBuilder k =
 
 data ErrWriteTxEra
     = ErrOldEraNotSupported Cardano.AnyCardanoEra
-    | ErrTxNotInEra Write.AnyRecentEra
+    | ErrTxNotInNodeEra Write.AnyRecentEra
     deriving (Show, Eq)
 
 -- | Build, Sign, Submit transaction.

lib/wallet/src/Cardano/Wallet/Primitive/Types/Tx.hs

@@ -34,6 +34,7 @@ module Cardano.Wallet.Primitive.Types.Tx
     -- * Serialisation
     , SealedTx (serialisedTx)
     , cardanoTxIdeallyNoLaterThan
+    , cardanoTxInExactEra
     , sealedTxFromBytes
     , sealedTxFromBytes'
     , sealedTxFromCardano
@@ -94,6 +95,7 @@ import Cardano.Wallet.Primitive.Types.Tx.SealedTx
     , SerialisedTx (..)
     , SerialisedTxParts (..)
     , cardanoTxIdeallyNoLaterThan
+    , cardanoTxInExactEra
     , getSealedTxBody
     , getSealedTxWitnesses
     , getSerialisedTxParts

lib/wallet/src/Cardano/Wallet/Write/Tx.hs

@@ -1,8 +1,8 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE ExplicitNamespaces #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE EmptyCase #-}
+{-# LANGUAGE ExplicitNamespaces #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
@@ -202,7 +202,7 @@ import Data.IntCast
 import Data.Maybe
     ( fromMaybe, isJust )
 import Data.Type.Equality
-    ( TestEquality (testEquality), type (:~:) (Refl) )
+    ( (:~:) (Refl), TestEquality (testEquality) )
 import Data.Typeable
     ( Typeable )
 import Numeric.Natural

specifications/api/swagger.yaml

@@ -4748,6 +4748,17 @@ x-errBalanceTxEraNotSupported: &errBalanceTxEraNotSupported
       type: string
       enum: ["balance_tx_era_not_supported"]
 
+x-errTxNotInNodeEra: &errTxNotInNodeEra
+  <<: *responsesErr
+  title: tx_not_in_node_era
+  properties:
+    message:
+      type: string
+      description: The transaction could be deserialised, just not in the era of the local node.
+    code:
+      type: string
+      enum: ["tx_not_in_node_era"]
+
 x-errBalanceTxConflictingNetworks: &errBalanceTxConflictingNetworks
   <<: *responsesErr
   title: balance_tx_conflicting_networks
@@ -6191,6 +6202,7 @@ x-responsesBalanceTransaction: &responsesBalanceTransaction
             - <<: *errTransactionAlreadyBalanced
             - <<: *errTransactionIsTooBig
             - <<: *errUtxoTooSmall
+            - <<: *errTxNotInNodeEra
 
   <<: *responsesErr404WalletNotFound
   <<: *responsesErr406