Merge #2125

2125: CLI: Add option "cardano-wallet transaction create --metadata=JSON" r=rvl a=rvl

### Issue Number

ADP-307 / #2076

### Overview

- Adds `--metadata=JSON` option to transaction create and fee estimate commands.

### Comments

Will update the CLI wiki page after merging.


Co-authored-by: Rodney Lorrimar <rodney.lorrimar@iohk.io>

lib/cli/cardano-wallet-cli.cabal

@@ -69,11 +69,13 @@ test-suite unit
       base
     , cardano-wallet-cli
     , cardano-wallet-core
+    , containers
     , filepath
     , hspec
     , network-uri
     , optparse-applicative
     , QuickCheck
+    , shelley-spec-ledger
     , temporary
     , text
     , text-class

lib/cli/src/Cardano/CLI.hs

@@ -54,6 +54,7 @@ module Cardano.CLI
     , syncToleranceOption
     , tlsOption
     , smashURLOption
+    , metadataOption
 
     -- * Option parsers for configuring tracing
     , LoggingOptions (..)
@@ -128,6 +129,7 @@ import Cardano.Wallet.Api.Types
     , ApiPostRandomAddressData (..)
     , ApiT (..)
     , ApiTxId (ApiTxId)
+    , ApiTxMetadata (..)
     , ApiWallet
     , ByronWalletPostData (..)
     , ByronWalletStyle (..)
@@ -687,6 +689,7 @@ data TransactionCreateArgs t = TransactionCreateArgs
     { _port :: Port "Wallet"
     , _id :: WalletId
     , _payments :: NonEmpty Text
+    , _metadata :: ApiTxMetadata
     }
 
 cmdTransactionCreate
@@ -702,7 +705,8 @@ cmdTransactionCreate mkTxClient mkWalletClient =
         <$> portOption
         <*> walletIdArgument
         <*> fmap NE.fromList (some paymentOption)
-    exec (TransactionCreateArgs wPort wId wAddressAmounts) = do
+        <*> metadataOption
+    exec (TransactionCreateArgs wPort wId wAddressAmounts md) = do
         wPayments <- either (fail . getTextDecodingError) pure $
             traverse (fromText @(AddressAmount Text)) wAddressAmounts
         res <- sendRequest wPort $ getWallet mkWalletClient $ ApiT wId
@@ -715,6 +719,7 @@ cmdTransactionCreate mkTxClient mkWalletClient =
                     (Aeson.object
                         [ "payments" .= wPayments
                         , "passphrase" .= ApiT wPwd
+                        , "metadata" .= md
                         ]
                     )
             Left _ ->
@@ -733,7 +738,8 @@ cmdTransactionFees mkTxClient mkWalletClient =
         <$> portOption
         <*> walletIdArgument
         <*> fmap NE.fromList (some paymentOption)
-    exec (TransactionCreateArgs wPort wId wAddressAmounts) = do
+        <*> metadataOption
+    exec (TransactionCreateArgs wPort wId wAddressAmounts md) = do
         wPayments <- either (fail . getTextDecodingError) pure $
             traverse (fromText @(AddressAmount Text)) wAddressAmounts
         res <- sendRequest wPort $ getWallet mkWalletClient $ ApiT wId
@@ -742,7 +748,10 @@ cmdTransactionFees mkTxClient mkWalletClient =
                 runClient wPort Aeson.encodePretty $ postTransactionFee
                     mkTxClient
                     (ApiT wId)
-                    (Aeson.object [ "payments" .= wPayments ])
+                    (Aeson.object
+                        [ "payments" .= wPayments
+                        , "metadata" .= md
+                        ])
             Left _ ->
                 handleResponse Aeson.encodePretty res
 
@@ -1348,6 +1357,21 @@ transactionSubmitPayloadArgument = argumentT $ mempty
     <> metavar "BINARY_BLOB"
     <> help "hex-encoded binary blob of externally-signed transaction."
 
+-- | <metadata=JSON>
+--
+-- Note: we decode the JSON just so that we can validate more client-side.
+metadataOption :: Parser ApiTxMetadata
+metadataOption = option txMetadataReader $ mempty
+    <> long "metadata"
+    <> metavar "JSON"
+    <> value (ApiTxMetadata Nothing)
+    <> help ("Application-specific transaction metadata as a JSON object. "
+             <> "The value must match the schema defined in the "
+             <> "cardano-wallet OpenAPI specification.")
+
+txMetadataReader :: ReadM ApiTxMetadata
+txMetadataReader = eitherReader (Aeson.eitherDecode' . BL8.pack)
+
 -- | <address=ADDRESS>
 addressIdArgument :: Parser Text
 addressIdArgument = argumentT $ mempty

lib/cli/test/unit/Cardano/CLISpec.hs

@@ -28,6 +28,7 @@ import Cardano.CLI
     , cmdWalletCreate
     , hGetLine
     , hGetSensitiveLine
+    , metadataOption
     , smashURLOption
     )
 import Cardano.Wallet.Api.Client
@@ -37,6 +38,10 @@ import Cardano.Wallet.Api.Client
     , transactionClient
     , walletClient
     )
+import Cardano.Wallet.Api.Types
+    ( ApiT (..), ApiTxMetadata (..) )
+import Cardano.Wallet.Primitive.Types
+    ( TxMetadata (..) )
 import Control.Concurrent
     ( forkFinally )
 import Control.Concurrent.MVar
@@ -91,8 +96,10 @@ import Test.QuickCheck
 import Test.Text.Roundtrip
     ( textRoundtrip )
 
+import qualified Data.Map as Map
 import qualified Data.Text as T
 import qualified Data.Text.IO as TIO
+import qualified Shelley.Spec.Ledger.MetaData as MD
 
 spec :: Spec
 spec = do
@@ -262,7 +269,7 @@ spec = do
 
         ["transaction", "create", "--help"] `shouldShowUsage`
             [ "Usage:  transaction create [--port INT] WALLET_ID"
-            , "                           --payment PAYMENT"
+            , "                           --payment PAYMENT [--metadata JSON]"
             , "  Create and submit a new transaction."
             , ""
             , "Available options:"
@@ -272,10 +279,15 @@ spec = do
             , "  --payment PAYMENT        address to send to and amount to send"
             , "                           separated by @, e.g."
             , "                           '<amount>@<address>'"
+            , "  --metadata JSON          Application-specific transaction"
+            , "                           metadata as a JSON object. The value"
+            , "                           must match the schema defined in the"
+            , "                           cardano-wallet OpenAPI specification."
             ]
 
         ["transaction", "fees", "--help"] `shouldShowUsage`
             [ "Usage:  transaction fees [--port INT] WALLET_ID --payment PAYMENT"
+            , "                         [--metadata JSON]"
             , "  Estimate fees for a transaction."
             , ""
             , "Available options:"
@@ -285,6 +297,10 @@ spec = do
             , "  --payment PAYMENT        address to send to and amount to send"
             , "                           separated by @, e.g."
             , "                           '<amount>@<address>'"
+            , "  --metadata JSON          Application-specific transaction"
+            , "                           metadata as a JSON object. The value"
+            , "                           must match the schema defined in the"
+            , "                           cardano-wallet OpenAPI specification."
             ]
 
         ["transaction", "list", "--help"] `shouldShowUsage`
@@ -650,6 +666,25 @@ spec = do
             , ( "relative", "/home/user", err )
             ]
 
+    describe "Tx Metadata JSON option" $ do
+        let parse arg = execParserPure defaultPrefs
+                (info metadataOption mempty) ["--metadata", arg]
+        let md = ApiT (TxMetadata (MD.MetaData (Map.singleton 42 (MD.S "hi"))))
+        let ok ex (Success res) = ex == getApiTxMetadata res
+            ok _ _ = False
+        let err (Failure _) = True
+            err _ = False
+        mapM_
+            (\(desc, arg, tst) -> it desc (parse arg `shouldSatisfy` tst))
+            [ ("valid", "{ \"42\": \"hi\" }", ok (Just md))
+            , ("malformed", "testing", err)
+            , ("malformed trailling", "{ \"0\": \"\" } arstneio", err)
+            , ("invalid", "{ \"json\": true }", err)
+            , ("null 1", "{ \"0\": null }", err)
+            , ("null 2", "null", ok Nothing)
+            , ("null 3", "{ }", ok (Just (ApiT mempty)))
+            ]
+
   where
     backspace :: Text
     backspace = T.singleton (toEnum 127)

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

@@ -1,5 +1,6 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
@@ -15,6 +16,7 @@ import Cardano.CLI
     ( Port )
 import Cardano.Wallet.Api.Types
     ( ApiFee (..)
+    , ApiT (..)
     , ApiTransaction
     , ApiWallet
     , DecodeAddress
@@ -23,7 +25,7 @@ import Cardano.Wallet.Api.Types
     , getApiT
     )
 import Cardano.Wallet.Primitive.Types
-    ( Direction (..), SortOrder (..), TxStatus (..) )
+    ( Direction (..), SortOrder (..), TxMetadata (..), TxStatus (..) )
 import Control.Monad
     ( forM_, join )
 import Data.Generics.Internal.VL.Lens
@@ -36,6 +38,8 @@ import Data.Proxy
     ( Proxy (..) )
 import Data.Quantity
     ( Quantity (..) )
+import Data.Text
+    ( Text )
 import Data.Text.Class
     ( showT )
 import Data.Time.Utils
@@ -96,7 +100,9 @@ import Test.Integration.Framework.TestData
     , wildcardsWalletName
     )
 
+import qualified Data.Map as Map
 import qualified Data.Text as T
+import qualified Shelley.Spec.Ledger.MetaData as MD
 
 spec :: forall n t.
     ( KnownCommand t
@@ -110,16 +116,17 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do
         wDest <- emptyWallet ctx
 
         let amt = fromIntegral minUTxOValue
-        args <- postTxArgs ctx wSrc wDest amt
+        args <- postTxArgs ctx wSrc wDest amt Nothing
         Stdout feeOut <- postTransactionFeeViaCLI @t ctx args
         ApiFee (Quantity feeMin) (Quantity feeMax) <- expectValidJSON Proxy feeOut
 
-        txJson <- postTxViaCLI ctx wSrc wDest amt
+        txJson <- postTxViaCLI ctx wSrc wDest amt Nothing
         verify txJson
             [ expectCliField (#amount . #getQuantity)
                 (between (feeMin + amt, feeMax + amt))
             , expectCliField (#direction . #getApiT) (`shouldBe` Outgoing)
             , expectCliField (#status . #getApiT) (`shouldBe` Pending)
+            , expectCliField (#metadata . #getApiTxMetadata) (`shouldBe` Nothing)
             ]
 
         -- verify balance on src wallet
@@ -295,6 +302,36 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do
         out `shouldBe` ""
         c `shouldBe` ExitFailure 1
 
+    it "TRANSMETA_CREATE_01 - Transaction with metadata via CLI" $ \ctx -> do
+        (wSrc, wDest) <- (,) <$> fixtureWallet ctx <*> emptyWallet ctx
+        let amt = 10_000_000
+        let md = Just "{ \"1\": \"hello\" }"
+        let expected = Just (ApiT (TxMetadata (MD.MetaData (Map.singleton 1 (MD.S "hello")))))
+
+        args <- postTxArgs ctx wSrc wDest amt md
+        Stdout feeOut <- postTransactionFeeViaCLI @t ctx args
+        ApiFee (Quantity feeMin) (Quantity feeMax) <- expectValidJSON Proxy feeOut
+
+        txJson <- postTxViaCLI ctx wSrc wDest amt md
+        verify txJson
+            [ expectCliField (#amount . #getQuantity)
+                (between (feeMin + amt, feeMax + amt))
+            , expectCliField (#direction . #getApiT) (`shouldBe` Outgoing)
+            , expectCliField (#status . #getApiT) (`shouldBe` Pending)
+            , expectCliField (#metadata . #getApiTxMetadata) (`shouldBe` expected)
+            ]
+
+        eventually "metadata is confirmed in transaction list" $ do
+            (Exit code, Stdout out, Stderr err) <-
+                listTransactionsViaCLI @t ctx [T.unpack $ wSrc ^. walletId]
+            err `shouldBe` "Ok.\n"
+            code `shouldBe` ExitSuccess
+            outJson <- expectValidJSON (Proxy @([ApiTransaction n])) out
+            verify outJson
+                [ expectCliListField 0 (#metadata . #getApiTxMetadata) (`shouldBe` expected)
+                , expectCliListField 0 (#status . #getApiT) (`shouldBe` InLedger)
+                ]
+
     describe "TRANS_ESTIMATE_08 - Invalid addresses" $ do
         forM_ matrixInvalidAddrs $ \(title, addr, errMsg) -> it title $ \ctx -> do
             wSrc <- emptyWallet ctx
@@ -679,7 +716,7 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do
         let wSrcId = T.unpack (wSrc ^. walletId)
 
         -- post transaction
-        txJson <- postTxViaCLI ctx wSrc wDest minUTxOValue
+        txJson <- postTxViaCLI ctx wSrc wDest minUTxOValue Nothing
         verify txJson
             [ expectCliField (#direction . #getApiT) (`shouldBe` Outgoing)
             , expectCliField (#status . #getApiT) (`shouldBe` Pending)
@@ -734,7 +771,7 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do
             -- post tx
             wSrc <- fixtureWallet ctx
             wDest <- emptyWallet ctx
-            txJson <- postTxViaCLI ctx wSrc wDest minUTxOValue
+            txJson <- postTxViaCLI ctx wSrc wDest minUTxOValue Nothing
 
             -- try to forget from different wallet
             widDiff <- emptyWallet' ctx
@@ -801,9 +838,10 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do
           -> ApiWallet
           -> ApiWallet
           -> Natural
+          -> Maybe Text
           -> IO (ApiTransaction n)
-      postTxViaCLI ctx wSrc wDest amt = do
-          args <- postTxArgs ctx wSrc wDest amt
+      postTxViaCLI ctx wSrc wDest amt md = do
+          args <- postTxArgs ctx wSrc wDest amt md
 
           -- post transaction
           (c, out, err) <- postTransactionViaCLI @t ctx "cardano-wallet" args
@@ -816,14 +854,15 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do
         -> ApiWallet
         -> ApiWallet
         -> Natural
+        -> Maybe Text
         -> IO [String]
-      postTxArgs ctx wSrc wDest amt = do
+      postTxArgs ctx wSrc wDest amt md = do
           addr:_ <- listAddresses @n ctx wDest
           let addrStr = encodeAddress @n (getApiT $ fst $ addr ^. #id)
           return $ T.unpack <$>
               [ wSrc ^. walletId
               , "--payment", T.pack (show amt) <> "@" <> addrStr
-              ]
+              ] ++ maybe [] (\json -> ["--metadata", json]) md
 
       fixtureWallet' :: Context t -> IO String
       fixtureWallet' = fmap (T.unpack . view walletId) . fixtureWallet