Don't support balanceTx in eras ahead of node tip

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

@@ -477,6 +477,19 @@ instance IsServerError ErrWriteTxEra where
                 , supportedRecentEras =
                     map (toApiEra . Write.toAnyCardanoEra) [minBound .. maxBound]
                 }
+        ErrPartialTxNotInNodeEra nodeEra ->
+            apiError err403 TxNotInNodeEra $ T.unwords
+                [ "The provided transaction could be deserialised, just not in"
+                , showT nodeEra <> ","
+                , "the era the local node is currently in."
+                , "If the node is not yet fully synchronised, 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."
+                , "If you're attempting to balance a partial transaction from"
+                , "an old era, please recreate your transaction so that it is"
+                , "compatible with a recent era."
+                ]
 
 instance IsServerError ErrBalanceTx where
     toServerError = \case

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

@@ -156,10 +156,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
@@ -520,7 +516,7 @@ import Cardano.Wallet.Primitive.Types.Tx
     , TxChange (..)
     , TxStatus (..)
     , UnsignedTx (..)
-    , cardanoTxIdeallyNoLaterThan
+    , cardanoTxInExactEra
     , getSealedTxWitnesses
     , sealedTxFromCardanoBody
     )
@@ -561,15 +557,15 @@ import Cardano.Wallet.Unsafe
 import Cardano.Wallet.Write.Tx
     ( AnyRecentEra (..) )
 import Cardano.Wallet.Write.Tx.Balance
-    ( UTxOAssumptions (..), constructUTxOIndex )
+    ( UTxOAssumptions (..) )
 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
@@ -3086,90 +3082,59 @@ balanceTransaction
 balanceTransaction
     ctx@ApiLayer{..} argGenChange utxoAssumptions (ApiT wid) body = do
     -- NOTE: Ideally we'd read @pp@ and @era@ atomically.
-    pp <- liftIO $ NW.currentProtocolParameters nl
-    era <- liftIO $ NW.currentNodeEra nl
+    pp <- liftIO $ currentProtocolParameters netLayer
+    era <- liftIO $ NW.currentNodeEra 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
-
-        let balanceTx
-                :: forall era. Write.IsRecentEra era
-                => Write.PartialTx era
-                -> Handler (Cardano.Tx era)
-            balanceTx partialTx =
-                liftHandler $ fst <$> Write.balanceTransaction @_ @IO @s
-                    (MsgWallet . W.MsgBalanceTx >$< wrk ^. W.logger)
-                    utxoAssumptions
-                    (Write.unsafeFromWalletProtocolParameters pp)
-                    timeTranslation
-                    (constructUTxOIndex walletUTxO)
-                    (W.defaultChangeAddressGen argGenChange)
-                    (getState wallet)
-                    partialTx
 
-        anyRecentTx <- maybeToHandler (W.ErrOldEraNotSupported era)
-            . Write.asAnyRecentEra
-            . cardanoTxIdeallyNoLaterThan era
-            . getApiT $ body ^. #transaction
+        partialTx <- parsePartialTx recentEra
 
-        res <- Write.withInAnyRecentEra anyRecentTx
-            (fmap inAnyCardanoEra . balanceTx <=< mkPartialTx)
+        balancedTx <- liftHandler
+            . fmap (Cardano.InAnyCardanoEra Write.cardanoEra . fst)
+            $ Write.balanceTransaction
+                (MsgWallet . W.MsgBalanceTx >$< wrk ^. W.logger)
+                utxoAssumptions
+                (Write.unsafeFromWalletProtocolParameters pp)
+                timeTranslation
+                (Write.constructUTxOIndex utxo)
+                (W.defaultChangeAddressGen argGenChange)
+                (getState wallet)
+                partialTx
 
         case body ^. #encoding of
             Just HexEncoded ->
                 pure $ ApiSerialisedTransaction
-                (ApiT $ W.sealedTxFromCardano res) HexEncoded
+                (ApiT $ W.sealedTxFromCardano balancedTx) HexEncoded
             _ -> pure $ ApiSerialisedTransaction
-                (ApiT $ W.sealedTxFromCardano res) Base64Encoded
+                (ApiT $ W.sealedTxFromCardano balancedTx) 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.ErrPartialTxNotInNodeEra
+                    $ AnyRecentEra era)
+                pure
+            . cardanoTxInExactEra (Write.cardanoEraFromRecentEra era)
+            . getApiT
+            $ body ^. #transaction
+
+        pure $ Write.PartialTx
+            tx
+            externalUTxO
+            (fromApiRedeemer <$> body ^. #redeemers)
 
 decodeTransaction
     :: forall s n
@@ -4250,7 +4215,7 @@ guardIsRecentEra (Cardano.AnyCardanoEra era) = case era of
     Cardano.ShelleyEra -> liftE invalidEra
     Cardano.ByronEra   -> liftE invalidEra
   where
-    invalidEra = W.ErrOldEraNotSupported $ Cardano.AnyCardanoEra era
+    invalidEra = W.ErrNodeNotYetInRecentEra $ Cardano.AnyCardanoEra era
 
 mkWithdrawal
     :: forall n block

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

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

lib/wallet/src/Cardano/Wallet.hs

@@ -1870,6 +1870,15 @@ type MakeRewardAccountBuilder k =
 data ErrWriteTxEra
     = ErrNodeNotYetInRecentEra Cardano.AnyCardanoEra
     -- ^ Node is not synced enough or on an unsupported testnet in an older era.
+    | ErrPartialTxNotInNodeEra
+        Write.AnyRecentEra -- node era
+    -- ^ The provided partial tx is not deserialisable as a tx in the era of the
+    -- node.
+    --
+    -- NOTE: In general we don't have /one/ known tx era. The tx could in theory
+    -- be deserialisable in all other eras than the one node era we need.
+    -- Exposing a 'Set AnyCardanoEra' of the candidate tx eras /could/ be done,
+    -- but would require some work.
     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
@@ -91,6 +92,7 @@ import Cardano.Wallet.Primitive.Types.Tx.SealedTx
     ( SealedTx (..)
     , SerialisedTx (..)
     , cardanoTxIdeallyNoLaterThan
+    , cardanoTxInExactEra
     , getSealedTxBody
     , getSealedTxWitnesses
     , mockSealedTx

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

@@ -5,6 +5,7 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 
 -- |
@@ -17,6 +18,7 @@ module Cardano.Wallet.Primitive.Types.Tx.SealedTx (
      -- * Types
     SealedTx (serialisedTx, unsafeCardanoTx)
     , cardanoTxIdeallyNoLaterThan
+    , cardanoTxInExactEra
     , sealedTxFromBytes
     , sealedTxFromBytes'
     , sealedTxFromCardano
@@ -56,8 +58,12 @@ import Data.ByteArray
     ( ByteArray, ByteArrayAccess )
 import Data.ByteString
     ( ByteString )
+import Data.Data
+    ( Proxy (..) )
 import Data.Either
     ( partitionEithers )
+import Data.Either.Extra
+    ( eitherToMaybe )
 import Data.Function
     ( on )
 import Data.Text
@@ -176,6 +182,18 @@ cardanoTxIdeallyNoLaterThan
     -> InAnyCardanoEra Cardano.Tx
 cardanoTxIdeallyNoLaterThan era = unsafeCardanoTx . ideallyNoLaterThan era
 
+-- | Re-deserialises the bytes of the 'SealedTx' as a transaction in the
+-- provided era, and that era only.
+cardanoTxInExactEra
+    :: forall era. Cardano.IsCardanoEra era
+    => CardanoEra era
+    -> SealedTx
+    -> Maybe (Cardano.Tx era)
+cardanoTxInExactEra _ tx =
+    eitherToMaybe
+    $ deserialiseFromCBOR (Cardano.AsTx (Cardano.proxyToAsType $ Proxy @era))
+    $ serialisedTx tx
+
 getSealedTxBody :: SealedTx -> InAnyCardanoEra Cardano.TxBody
 getSealedTxBody (SealedTx _ (InAnyCardanoEra era tx) _) =
     InAnyCardanoEra era (Cardano.getTxBody tx)

specifications/api/swagger.yaml

@@ -4758,6 +4758,16 @@ x-errNodeNotYetInRecentEra: &errNodeNotYetInRecentEra
             type: array
             items: *ApiEra
 
+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
@@ -6202,6 +6212,7 @@ x-responsesBalanceTransaction: &responsesBalanceTransaction
             - <<: *errTransactionAlreadyBalanced
             - <<: *errTransactionIsTooBig
             - <<: *errUtxoTooSmall
+            - <<: *errTxNotInNodeEra
 
   <<: *responsesErr404WalletNotFound
   <<: *responsesErr406