Tx metadata tests

lib/core-integration/src/Cardano/Wallet/TransactionSpecShared.hs

@@ -48,7 +48,7 @@ propMaxNumberOfInputsEstimation tl qa@(Quantity ma) qb@(Quantity mb) oa ob =
     isIncreasingFunction = if ma < mb then estAA <= estBA else estAA >= estBA
     moreOutputsLessInputs = if oa < ob then estAA >= estAB else estAA <= estAB
     estIsSmallerThanSize = (estAA < ma || ma == 0) .&&. (estBA < mb || mb == 0)
-    est no = fromIntegral . estimateMaxNumberOfInputs tl no
+    est no = fromIntegral . estimateMaxNumberOfInputs tl no Nothing
     debug = unlines
         [ "sizeA = " <> show ma, "sizeB = " <> show mb
         , "numOutputsA = " <> show oa, "numOutputsB = " <> show ob

lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs

@@ -549,8 +549,8 @@ spec = do
                 (#balance . #available)
                 (`shouldBe` Quantity (faucetAmt - feeEstMax - amt)) ra2
 
-    it "TRANS_CREATE_10 - Transaction with metadata" $ \ctx -> do
-        (wa, wb) <- (,) <$> fixtureWallet ctx <*> fixtureWallet ctx
+    it "TRANSMETA_CREATE_01 - Transaction with metadata" $ \ctx -> do
+        (wa, wb) <- (,) <$> fixtureWallet ctx <*> emptyWallet ctx
         let amt = (1 :: Natural)
 
         basePayload <- mkTxPayload ctx wb amt fixturePassphrase
@@ -574,19 +574,57 @@ spec = do
             ]
 
         eventually "metadata is confirmed in transaction list" $ do
-            let link = Link.listTransactions @'Shelley wa
-            rb <- request @([ApiTransaction n]) ctx link Default Empty
-            verify rb
+            -- on src wallet
+            let linkSrcList = Link.listTransactions @'Shelley wa
+            rla <- request @([ApiTransaction n]) ctx linkSrcList Default Empty
+            verify rla
+                [ expectResponseCode HTTP.status200
+                , expectListField 0 (#status . #getApiT) (`shouldBe` InLedger)
+                , expectListField 0 (#direction . #getApiT) (`shouldBe` Outgoing)
+                , expectListField 0
+                    (#metadata . #getApiTxMetadata)
+                    (`shouldBe` Just (ApiT expected))
+                ]
+            -- on dst wallet
+            let linkDstList = Link.listTransactions @'Shelley wb
+            rlb <- request @([ApiTransaction n]) ctx linkDstList Default Empty
+            verify rlb
                 [ expectResponseCode HTTP.status200
                 , expectListField 0 (#status . #getApiT) (`shouldBe` InLedger)
+                , expectListField 0 (#direction . #getApiT) (`shouldBe` Incoming)
                 , expectListField 0
                     (#metadata . #getApiTxMetadata)
                     (`shouldBe` Just (ApiT expected))
                 ]
 
-    it "TRANS_CREATE_11 - Transaction with invalid metadata" $ \ctx -> do
+        let txid = getFromResponse #id ra
+        eventually "metadata is confirmed in transaction get" $ do
+          -- on src wallet
+            let linkSrc = Link.getTransaction @'Shelley wa (ApiTxId txid)
+            rg1 <- request @(ApiTransaction n) ctx linkSrc Default Empty
+            verify rg1
+                [ expectResponseCode HTTP.status200
+                , expectField (#direction . #getApiT) (`shouldBe` Outgoing)
+                , expectField (#status . #getApiT) (`shouldBe` InLedger)
+                , expectField
+                    (#metadata . #getApiTxMetadata)
+                    (`shouldBe` Just (ApiT expected))
+                ]
+          -- on dst wallet
+            let linkDst = Link.getTransaction @'Shelley wb (ApiTxId txid)
+            rg2 <- request @(ApiTransaction n) ctx linkDst Default Empty
+            verify rg2
+                [ expectResponseCode HTTP.status200
+                , expectField (#direction . #getApiT) (`shouldBe` Incoming)
+                , expectField (#status . #getApiT) (`shouldBe` InLedger)
+                , expectField
+                    (#metadata . #getApiTxMetadata)
+                    (`shouldBe` Just (ApiT expected))
+                ]
+
+    it "TRANSMETA_CREATE_02 - Transaction with invalid metadata" $ \ctx -> do
         (wa, wb) <- (,) <$> fixtureWallet ctx <*> fixtureWallet ctx
-        let amt = (1 :: Natural)
+        let amt = (1_000_000 :: Natural)
 
         basePayload <- mkTxPayload ctx wb amt fixturePassphrase
 
@@ -599,9 +637,9 @@ spec = do
         expectResponseCode @IO HTTP.status400 r
         expectErrorMessage errMsg400TxMetadataStringTooLong r
 
-    it "TRANS_CREATE_12 - Transaction with too much metadata" $ \ctx -> do
-        (wa, wb) <- (,) <$> fixtureWallet ctx <*> fixtureWallet ctx
-        let amt = (1 :: Natural)
+    it "TRANSMETA_CREATE_03 - Transaction with too much metadata" $ \ctx -> do
+        (wa, wb) <- (,) <$> fixtureWallet ctx <*> emptyWallet ctx
+        let amt = (1_000_000 :: Natural)
 
         basePayload <- mkTxPayload ctx wb amt fixturePassphrase
 
@@ -618,9 +656,9 @@ spec = do
         expectResponseCode @IO HTTP.status400 r
         expectErrorMessage errMsg400TxTooLarge r
 
-    it "TRANS_ESTIMATE_xxx - fee estimation includes metadata" $ \ctx -> do
-        (wa, wb) <- (,) <$> fixtureWallet ctx <*> fixtureWallet ctx
-        let amt = (1 :: Natural)
+    it "TRANSMETA_ESTIMATE_01 - fee estimation includes metadata" $ \ctx -> do
+        (wa, wb) <- (,) <$> fixtureWallet ctx <*> emptyWallet ctx
+        let amt = (1_000_000 :: Natural)
 
         payload <- mkTxPayload ctx wb amt fixturePassphrase
 
@@ -646,6 +684,40 @@ spec = do
             , expectField (#estimatedMax . #getQuantity) (.< feeEstMax)
             ]
 
+    it "TRANSMETA_ESTIMATE_02 - fee estimation with invalid metadata" $ \ctx -> do
+        (wa, wb) <- (,) <$> fixtureWallet ctx <*> emptyWallet ctx
+        let amt = (1_000_000 :: Natural)
+
+        basePayload <- mkTxPayload ctx wb amt fixturePassphrase
+
+        let txMeta = Aeson.object ["1" .= T.replicate 65 "a"]
+        let payload = addTxMetadata txMeta basePayload
+
+        r <- request @ApiFee ctx
+            (Link.getTransactionFee @'Shelley wa) Default payload
+
+        expectResponseCode @IO HTTP.status400 r
+        expectErrorMessage errMsg400TxMetadataStringTooLong r
+
+    it "TRANSMETA_ESTIMATE_03 - fee estimation with too much metadata" $ \ctx -> do
+        (wa, wb) <- (,) <$> fixtureWallet ctx <*> emptyWallet ctx
+        let amt = (1_000_000 :: Natural)
+
+        basePayload <- mkTxPayload ctx wb amt fixturePassphrase
+
+        -- This will encode to at least 8k of CBOR. The max tx size for the
+        -- integration tests cluster is 4k.
+        let txMeta = Aeson.object
+                [ (toText @Int i, Aeson.String (T.replicate 64 "a"))
+                | i <- [0..127] ]
+        let payload = addTxMetadata txMeta basePayload
+        print payload
+        r <- request @ApiFee ctx
+            (Link.getTransactionFee @'Shelley wa) Default payload
+
+        expectResponseCode @IO HTTP.status400 r
+        expectErrorMessage errMsg400TxTooLarge r
+
     describe "TRANS_ESTIMATE_08 - Bad payload" $ do
         let matrix =
                 [ ( "empty payload", NonJson "" )

lib/core/src/Cardano/Wallet.hs

@@ -155,7 +155,6 @@ module Cardano.Wallet
     , ErrMkTx (..)
     , ErrSubmitTx (..)
     , ErrSubmitExternalTx (..)
-    , ErrTxTooLarge (..)
     , ErrRemovePendingTx (..)
     , ErrPostTx (..)
     , ErrDecodeSignedTx (..)
@@ -1187,9 +1186,10 @@ normalizeDelegationAddress s addr = do
 coinSelOpts
     :: TransactionLayer t k
     -> Quantity "byte" Word16
+    -> Maybe TxMetadata
     -> CoinSelectionOptions (ErrValidateSelection t)
-coinSelOpts tl txMaxSize = CoinSelectionOptions
-    { maximumNumberOfInputs = estimateMaxNumberOfInputs tl txMaxSize
+coinSelOpts tl txMaxSize md = CoinSelectionOptions
+    { maximumNumberOfInputs = estimateMaxNumberOfInputs tl txMaxSize md
     , validate = validateSelection tl
     }
 
@@ -1279,9 +1279,10 @@ selectCoinsForPaymentFromUTxO
     -> ExceptT (ErrSelectForPayment e) IO CoinSelection
 selectCoinsForPaymentFromUTxO ctx utxo txp minUtxo recipients withdrawal md = do
     lift . traceWith tr $ MsgPaymentCoinSelectionStart utxo txp recipients
-    (sel, utxo') <- withExceptT ErrSelectForPaymentCoinSelection $ do
-        let opts = coinSelOpts tl (txp ^. #getTxMaxSize)
+    (sel, utxo') <- withExceptT handleCoinSelError $ do
+        let opts = coinSelOpts tl (txp ^. #getTxMaxSize) md
         CoinSelection.random opts recipients withdrawal utxo
+
     lift . traceWith tr $ MsgPaymentCoinSelection sel
     let feePolicy = feeOpts tl Nothing md txp minUtxo
     withExceptT ErrSelectForPaymentFee $ do
@@ -1291,6 +1292,10 @@ selectCoinsForPaymentFromUTxO ctx utxo txp minUtxo recipients withdrawal md = do
   where
     tl = ctx ^. transactionLayer @t @k
     tr = ctx ^. logger @WalletLog
+    handleCoinSelError = \case
+        ErrMaximumInputsReached maxN ->
+            ErrSelectForPaymentTxTooLarge (W.getTxMaxSize txp) maxN
+        e -> ErrSelectForPaymentCoinSelection e
 
 -- | Select necessary coins to cover for a single delegation request (including
 -- one certificate).
@@ -1405,7 +1410,7 @@ selectCoinsForMigrationFromUTxO ctx utxo txp minUtxo wid = do
             { estimateFee = minimumFee tl feePolicy Nothing Nothing . worstCase
             , dustThreshold = max (Coin $ ceiling a) minUtxo
             }
-    let selOptions = coinSelOpts tl (txp ^. #getTxMaxSize)
+    let selOptions = coinSelOpts tl (txp ^. #getTxMaxSize) Nothing
     let previousDistribution = W.computeUtxoStatistics W.log10 utxo
     liftIO $ traceWith tr $ MsgMigrationUTxOBefore previousDistribution
     case depleteUTxO feeOptions (idealBatchSize selOptions) utxo of
@@ -1784,10 +1789,6 @@ submitTx
     -> (Tx, TxMeta, SealedTx)
     -> ExceptT ErrSubmitTx IO ()
 submitTx ctx wid (tx, meta, binary) = db & \DBLayer{..} -> do
-    txp <- withExceptT ErrSubmitTxNoSuchWallet $
-        txParameters <$> readWalletProtocolParameters @ctx @s @k ctx wid
-    withExceptT ErrSubmitTxTooLarge $
-        guardTransactionSize txp binary
     withExceptT ErrSubmitTxNetwork  $
         postTx nw binary
     mapExceptT atomically $ withExceptT ErrSubmitTxNoSuchWallet $
@@ -1796,20 +1797,6 @@ submitTx ctx wid (tx, meta, binary) = db & \DBLayer{..} -> do
     db = ctx ^. dbLayer @s @k
     nw = ctx ^. networkLayer @t
 
-guardTransactionSize
-    :: Monad m
-    => W.TxParameters
-    -> SealedTx
-    -> ExceptT ErrTxTooLarge m ()
-guardTransactionSize txp (SealedTx bytes) = do
-    let currentSize = Quantity $ BS.length bytes
-    let maxSize = fromIntegral <$> W.getTxMaxSize txp
-    when (currentSize > maxSize) $
-        throwE $ ErrTxTooLarge
-            { tooLargeCurrentSize = currentSize
-            , tooLargeMaximumSize = maxSize
-            }
-
 -- | Broadcast an externally-signed transaction to the network.
 submitExternalTx
     :: forall ctx t k.
@@ -2201,6 +2188,7 @@ data ErrSelectForPayment e
     | ErrSelectForPaymentFee ErrAdjustForFee
     | ErrSelectForPaymentMinimumUTxOValue ErrUTxOTooSmall
     | ErrSelectForPaymentAlreadyWithdrawing Tx
+    | ErrSelectForPaymentTxTooLarge (Quantity "byte" Word16) Word64
     deriving (Show, Eq)
 
 -- | Errors that can occur when listing UTxO statistics.
@@ -2220,14 +2208,8 @@ data ErrSignPayment
 data ErrSubmitTx
     = ErrSubmitTxNetwork ErrPostTx
     | ErrSubmitTxNoSuchWallet ErrNoSuchWallet
-    | ErrSubmitTxTooLarge ErrTxTooLarge
     deriving (Show, Eq)
 
-data ErrTxTooLarge = ErrTxTooLarge
-    { tooLargeCurrentSize :: Quantity "byte" Int
-    , tooLargeMaximumSize :: Quantity "byte" Int
-    } deriving (Show, Eq)
-
 -- | Errors that can occur when submitting an externally-signed transaction
 --   to the network.
 data ErrSubmitExternalTx

lib/core/src/Cardano/Wallet/Api/Server.hs

@@ -128,7 +128,6 @@ import Cardano.Wallet
     , ErrStartTimeLaterThanEndTime (..)
     , ErrSubmitExternalTx (..)
     , ErrSubmitTx (..)
-    , ErrTxTooLarge (..)
     , ErrUTxOTooSmall (..)
     , ErrUpdatePassphrase (..)
     , ErrValidateSelection
@@ -2188,6 +2187,17 @@ instance Buildable e => LiftHandler (ErrSelectForPayment e) where
                 , "transaction; if, for some reason, you really want a new "
                 , "transaction, then cancel the previous one first."
                 ]
+        ErrSelectForPaymentTxTooLarge maxSize maxN  ->
+            apiError err400 TransactionIsTooBig $ mconcat
+                [ "I am afraid that the transaction you're trying to submit is "
+                , "too large! The network allows transactions only as large as "
+                , pretty maxSize, "s! As it stands, the current transaction only "
+                , "allows me to select up to ", showT maxN, " inputs. Note "
+                , "that I am selecting inputs randomly, so retrying *may work* "
+                , "provided I end up choosing bigger inputs sufficient to cover "
+                , "the transaction cost. Alternatively, try sending to less "
+                , "recipients or with smaller metadata."
+                ]
 
 instance LiftHandler ErrListUTxOStatistics where
     handler = \case
@@ -2296,7 +2306,6 @@ instance LiftHandler ErrPostTx where
 instance LiftHandler ErrSubmitTx where
     handler = \case
         ErrSubmitTxNetwork e -> handler e
-        ErrSubmitTxTooLarge e -> handler e
         ErrSubmitTxNoSuchWallet e@ErrNoSuchWallet{} -> (handler e)
             { errHTTPCode = 410
             , errReasonPhrase = errReasonPhrase err410
@@ -2495,17 +2504,6 @@ instance LiftHandler ErrWithdrawalNotWorth where
                 , "request."
                 ]
 
-instance LiftHandler ErrTxTooLarge where
-    handler = \case
-        ErrTxTooLarge {tooLargeCurrentSize, tooLargeMaximumSize}  ->
-            apiError err400 TransactionTooLarge $ mconcat
-                [ "I am afraid that the transaction you're trying to submit is "
-                , "too large! It weights ", pretty tooLargeCurrentSize, "s "
-                , "but the network currently allows only ", pretty tooLargeMaximumSize
-                , "s! Likely, this is because you've added some metadata that "
-                , "are too large."
-                ]
-
 instance LiftHandler (Request, ServerError) where
     handler (req, err@(ServerError code _ body headers))
       | not (isJSON body) = case code of

lib/core/src/Cardano/Wallet/Api/Types.hs

@@ -700,7 +700,6 @@ data ApiErrorCode
     | AlreadyWithdrawing
     | WithdrawalNotWorth
     | PastHorizon
-    | TransactionTooLarge
     deriving (Eq, Generic, Show)
 
 -- | Defines a point in time that can be formatted as and parsed from an

lib/core/src/Cardano/Wallet/Transaction.hs

@@ -125,6 +125,8 @@ data TransactionLayer t k = TransactionLayer
     , estimateMaxNumberOfInputs
         :: Quantity "byte" Word16
             -- Max tx size
+        -> Maybe TxMetadata
+            -- Metadata associated with the transaction
         -> Word8
             -- desired number of outputs
         -> Word8

lib/jormungandr/src/Cardano/Wallet/Jormungandr/Transaction.hs

@@ -127,7 +127,7 @@ newTransactionLayer block0H = TransactionLayer
 
     , minimumFee = _minimumFee
 
-    , estimateMaxNumberOfInputs = \_ _ -> fromIntegral maxNumberOfInputs
+    , estimateMaxNumberOfInputs = \_ _ _ -> fromIntegral maxNumberOfInputs
 
     , validateSelection = \cs -> do
         let tooManyInputs  = length (CS.inputs cs)  > maxNumberOfInputs

lib/shelley/src/Cardano/Wallet/Shelley/Transaction.hs

@@ -306,10 +306,12 @@ _estimateMaxNumberOfInputs
     => NetworkId
     -> Quantity "byte" Word16
      -- ^ Transaction max size in bytes
+    -> Maybe TxMetadata
+     -- ^ Metadata associated with the transaction.
     -> Word8
     -- ^ Number of outputs in transaction
     -> Word8
-_estimateMaxNumberOfInputs networkId (Quantity maxSize) nOuts =
+_estimateMaxNumberOfInputs networkId (Quantity maxSize) md nOuts =
       fromIntegral $ bisect (lowerBound, upperBound)
   where
     bisect (!inf, !sup)
@@ -330,7 +332,7 @@ _estimateMaxNumberOfInputs networkId (Quantity maxSize) nOuts =
 
     isTooBig nInps = size > fromIntegral maxSize
       where
-        size = computeTxSize networkId (txWitnessTagFor @k) Nothing Nothing sel
+        size = computeTxSize networkId (txWitnessTagFor @k) md Nothing sel
         sel  = dummyCoinSel nInps (fromIntegral nOuts)
 
 dummyCoinSel :: Int -> Int -> CoinSelection