Merge #2267

2267: Add CLI option for transaction TTL r=rvl a=rvl

### Issue Number

ADP-93 / #1840

### Overview

- [x] Hide shelley-specific CLI options in `cardano-wallet-jormungandr` (fixes #2169)
- [x] Add option `cardano-wallet transaction create [--ttl=SECONDS]`
- [ ] Update wiki page after merging.

### Comments

- Based on PR #2262 branch - merge that first.


Co-authored-by: Rodney Lorrimar <[email protected]>
Co-authored-by: Piotr Stachyra <[email protected]>

lib/cli/cardano-wallet-cli.cabal

@@ -47,6 +47,7 @@ library
     , servant-client-core
     , text
     , text-class
+    , time
     , optparse-applicative
   hs-source-dirs:
       src

lib/cli/src/Cardano/CLI.hs

@@ -35,6 +35,7 @@ module Cardano.CLI
     , cmdWalletCreate
     , cmdByronWalletCreate
     , cmdTransaction
+    , cmdTransactionJormungandr
     , cmdAddress
     , cmdStakePool
     , cmdNetwork
@@ -55,6 +56,7 @@ module Cardano.CLI
     , tlsOption
     , poolMetadataSourceOption
     , metadataOption
+    , timeToLiveOption
 
     -- * Option parsers for configuring tracing
     , LoggingOptions (..)
@@ -155,6 +157,8 @@ import Cardano.Wallet.Api.Types
     )
 import Cardano.Wallet.Network
     ( ErrNetworkUnavailable (..) )
+import Cardano.Wallet.Orphans
+    ()
 import Cardano.Wallet.Primitive.AddressDerivation
     ( Depth (..)
     , DerivationType (..)
@@ -199,6 +203,8 @@ import Data.List.NonEmpty
     ( NonEmpty (..) )
 import Data.Maybe
     ( fromMaybe )
+import Data.Quantity
+    ( Quantity (..) )
 import Data.String
     ( IsString )
 import Data.Text
@@ -207,6 +213,8 @@ import Data.Text.Class
     ( FromText (..), TextDecodingError (..), ToText (..), showT )
 import Data.Text.Read
     ( decimal )
+import Data.Time.Clock
+    ( NominalDiffTime )
 import Data.Void
     ( Void )
 import Fmt
@@ -683,19 +691,38 @@ cmdWalletGetUtxoStatistics mkClient =
                             Commands - 'transaction'
 -------------------------------------------------------------------------------}
 
+data TransactionFeatures = NoShelleyFeatures | ShelleyFeatures
+    deriving (Show, Eq)
+
 -- | cardano-wallet transaction
 cmdTransaction
     :: ToJSON wallet
     => TransactionClient
     -> WalletClient wallet
     -> Mod CommandFields (IO ())
-cmdTransaction mkTxClient mkWalletClient =
+cmdTransaction = cmdTransactionBase ShelleyFeatures
+
+-- | cardano-wallet-jormungandr transaction
+cmdTransactionJormungandr
+    :: ToJSON wallet
+    => TransactionClient
+    -> WalletClient wallet
+    -> Mod CommandFields (IO ())
+cmdTransactionJormungandr = cmdTransactionBase NoShelleyFeatures
+
+cmdTransactionBase
+    :: ToJSON wallet
+    => TransactionFeatures
+    -> TransactionClient
+    -> WalletClient wallet
+    -> Mod CommandFields (IO ())
+cmdTransactionBase isShelley mkTxClient mkWalletClient =
     command "transaction" $ info (helper <*> cmds) $ mempty
         <> progDesc "About transactions"
   where
     cmds = subparser $ mempty
-        <> cmdTransactionCreate mkTxClient mkWalletClient
-        <> cmdTransactionFees mkTxClient mkWalletClient
+        <> cmdTransactionCreate isShelley mkTxClient mkWalletClient
+        <> cmdTransactionFees isShelley mkTxClient mkWalletClient
         <> cmdTransactionList mkTxClient
         <> cmdTransactionSubmit mkTxClient
         <> cmdTransactionForget mkTxClient
@@ -707,23 +734,31 @@ data TransactionCreateArgs t = TransactionCreateArgs
     , _id :: WalletId
     , _payments :: NonEmpty Text
     , _metadata :: ApiTxMetadata
+    , _timeToLive :: Maybe (Quantity "second" NominalDiffTime)
     }
 
+whenShelley :: a -> Parser a -> TransactionFeatures -> Parser a
+whenShelley j s = \case
+    NoShelleyFeatures -> pure j
+    ShelleyFeatures -> s
+
 cmdTransactionCreate
     :: ToJSON wallet
-    => TransactionClient
+    => TransactionFeatures
+    -> TransactionClient
     -> WalletClient wallet
     -> Mod CommandFields (IO ())
-cmdTransactionCreate mkTxClient mkWalletClient =
+cmdTransactionCreate isShelley mkTxClient mkWalletClient =
     command "create" $ info (helper <*> cmd) $ mempty
         <> progDesc "Create and submit a new transaction."
   where
     cmd = fmap exec $ TransactionCreateArgs
         <$> portOption
         <*> walletIdArgument
         <*> fmap NE.fromList (some paymentOption)
-        <*> metadataOption
-    exec (TransactionCreateArgs wPort wId wAddressAmounts md) = do
+        <*> whenShelley (ApiTxMetadata Nothing) metadataOption isShelley
+        <*> whenShelley Nothing timeToLiveOption isShelley
+    exec (TransactionCreateArgs wPort wId wAddressAmounts md ttl) = do
         wPayments <- either (fail . getTextDecodingError) pure $
             traverse (fromText @(AddressAmount Text)) wAddressAmounts
         res <- sendRequest wPort $ getWallet mkWalletClient $ ApiT wId
@@ -737,26 +772,29 @@ cmdTransactionCreate mkTxClient mkWalletClient =
                         [ "payments" .= wPayments
                         , "passphrase" .= ApiT wPwd
                         , "metadata" .= md
+                        , "time_to_live" .= ttl
                         ]
                     )
             Left _ ->
                 handleResponse Aeson.encodePretty res
 
 cmdTransactionFees
     :: ToJSON wallet
-    => TransactionClient
+    => TransactionFeatures
+    -> TransactionClient
     -> WalletClient wallet
     -> Mod CommandFields (IO ())
-cmdTransactionFees mkTxClient mkWalletClient =
+cmdTransactionFees isShelley mkTxClient mkWalletClient =
     command "fees" $ info (helper <*> cmd) $ mempty
         <> progDesc "Estimate fees for a transaction."
   where
     cmd = fmap exec $ TransactionCreateArgs
         <$> portOption
         <*> walletIdArgument
         <*> fmap NE.fromList (some paymentOption)
-        <*> metadataOption
-    exec (TransactionCreateArgs wPort wId wAddressAmounts md) = do
+        <*> whenShelley (ApiTxMetadata Nothing) metadataOption isShelley
+        <*> whenShelley Nothing timeToLiveOption isShelley
+    exec (TransactionCreateArgs wPort wId wAddressAmounts md ttl) = do
         wPayments <- either (fail . getTextDecodingError) pure $
             traverse (fromText @(AddressAmount Text)) wAddressAmounts
         res <- sendRequest wPort $ getWallet mkWalletClient $ ApiT wId
@@ -768,6 +806,7 @@ cmdTransactionFees mkTxClient mkWalletClient =
                     (Aeson.object
                         [ "payments" .= wPayments
                         , "metadata" .= md
+                        , "time_to_live" .= ttl
                         ])
             Left _ ->
                 handleResponse Aeson.encodePretty res
@@ -1339,7 +1378,7 @@ walletIdArgument :: Parser WalletId
 walletIdArgument = argumentT $ mempty
     <> metavar "WALLET_ID"
 
--- | <stake=STAKE>
+-- | [--stake=STAKE]
 stakeOption :: Parser (Maybe Coin)
 stakeOption = optional $ optionT $ mempty
     <> long "stake"
@@ -1369,7 +1408,7 @@ transactionSubmitPayloadArgument = argumentT $ mempty
     <> metavar "BINARY_BLOB"
     <> help "hex-encoded binary blob of externally-signed transaction."
 
--- | <metadata=JSON>
+-- | [--metadata=JSON]
 --
 -- Note: we decode the JSON just so that we can validate more client-side.
 metadataOption :: Parser ApiTxMetadata
@@ -1384,6 +1423,15 @@ metadataOption = option txMetadataReader $ mempty
 txMetadataReader :: ReadM ApiTxMetadata
 txMetadataReader = eitherReader (Aeson.eitherDecode' . BL8.pack)
 
+-- | [--ttl=DURATION]
+timeToLiveOption :: Parser (Maybe (Quantity "second" NominalDiffTime))
+timeToLiveOption = optional $ fmap Quantity $ optionT $ mempty
+    <> long "ttl"
+    <> metavar "DURATION"
+    <> help ("Time-to-live value. "
+             <> "Expressed in seconds with a trailing 's'. "
+             <> "Default is 3600s (2 hours).")
+
 -- | <address=ADDRESS>
 addressIdArgument :: Parser Text
 addressIdArgument = argumentT $ mempty

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

@@ -30,6 +30,7 @@ import Cardano.CLI
     , hGetSensitiveLine
     , metadataOption
     , poolMetadataSourceOption
+    , timeToLiveOption
     )
 import Cardano.Wallet.Api.Client
     ( addressClient
@@ -50,6 +51,8 @@ import Control.Monad
     ( mapM_ )
 import Data.Proxy
     ( Proxy (..) )
+import Data.Quantity
+    ( Quantity (..) )
 import Data.Text
     ( Text )
 import Data.Text.Class
@@ -267,6 +270,7 @@ spec = do
         ["transaction", "create", "--help"] `shouldShowUsage`
             [ "Usage:  transaction create [--port INT] WALLET_ID"
             , "                           --payment PAYMENT [--metadata JSON]"
+            , "                           [--ttl DURATION]"
             , "  Create and submit a new transaction."
             , ""
             , "Available options:"
@@ -280,11 +284,14 @@ spec = do
             , "                           metadata as a JSON object. The value"
             , "                           must match the schema defined in the"
             , "                           cardano-wallet OpenAPI specification."
+            , "  --ttl DURATION           Time-to-live value. Expressed in"
+            , "                           seconds with a trailing 's'. Default"
+            , "                           is 3600s (2 hours)."
             ]
 
         ["transaction", "fees", "--help"] `shouldShowUsage`
             [ "Usage:  transaction fees [--port INT] WALLET_ID --payment PAYMENT"
-            , "                         [--metadata JSON]"
+            , "                         [--metadata JSON] [--ttl DURATION]"
             , "  Estimate fees for a transaction."
             , ""
             , "Available options:"
@@ -298,6 +305,9 @@ spec = do
             , "                           metadata as a JSON object. The value"
             , "                           must match the schema defined in the"
             , "                           cardano-wallet OpenAPI specification."
+            , "  --ttl DURATION           Time-to-live value. Expressed in"
+            , "                           seconds with a trailing 's'. Default"
+            , "                           is 3600s (2 hours)."
             ]
 
         ["transaction", "list", "--help"] `shouldShowUsage`
@@ -685,6 +695,26 @@ spec = do
             , ("null 3", "{ }", ok (Just (ApiT mempty)))
             ]
 
+    describe "Tx TTL option" $ do
+        let parse arg = execParserPure defaultPrefs
+                (info timeToLiveOption mempty) ["--ttl", arg]
+        let ok ex (Success res) = Just (Quantity ex) == res
+            ok _ _ = False
+        let err (Failure _) = True
+            err _ = False
+        mapM_
+            (\(desc, arg, tst) -> it desc (parse arg `shouldSatisfy` tst))
+            [ ("valid integer", "1s", ok 1)
+            , ("valid zero", "0s", ok 0)
+            , ("invalid negative", "-1s", err)
+            , ("invalid fractional", "1.5s", err)
+            , ("malformed trailling", "1ss", err)
+            , ("malformed suffix", "1", err)
+            , ("malformed empty", "", err)
+            , ("malformed emptyish", "s", err)
+            , ("malformed leading", "a1s", err)
+            ]
+
   where
     backspace :: Text
     backspace = T.singleton (toEnum 127)

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

@@ -128,11 +128,11 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do
         wDest <- emptyWallet ctx
 
         let amt = fromIntegral minUTxOValue
-        args <- postTxArgs ctx wSrc wDest amt Nothing
+        args <- postTxArgs ctx wSrc wDest amt Nothing Nothing
         Stdout feeOut <- postTransactionFeeViaCLI @t ctx args
         ApiFee (Quantity feeMin) (Quantity feeMax) <- expectValidJSON Proxy feeOut
 
-        txJson <- postTxViaCLI ctx wSrc wDest amt Nothing
+        txJson <- postTxViaCLI ctx wSrc wDest amt Nothing Nothing
         verify txJson
             [ expectCliField (#amount . #getQuantity)
                 (between (feeMin + amt, feeMax + amt))
@@ -321,11 +321,11 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do
         let expected = Just $ ApiT $ TxMetadata $
                 Map.singleton 1 (TxMetaText "hello")
 
-        args <- postTxArgs ctx wSrc wDest amt md
+        args <- postTxArgs ctx wSrc wDest amt md Nothing
         Stdout feeOut <- postTransactionFeeViaCLI @t ctx args
         ApiFee (Quantity feeMin) (Quantity feeMax) <- expectValidJSON Proxy feeOut
 
-        txJson <- postTxViaCLI ctx wSrc wDest amt md
+        txJson <- postTxViaCLI ctx wSrc wDest amt md Nothing
         verify txJson
             [ expectCliField (#amount . #getQuantity)
                 (between (feeMin + amt, feeMax + amt))
@@ -345,6 +345,32 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do
                 , expectCliListField 0 (#status . #getApiT) (`shouldBe` InLedger)
                 ]
 
+    it "TRANSTTL_CREATE_01 - Transaction with TTL via CLI" $ \ctx -> runResourceT $ do
+      (wSrc, wDest) <- (,) <$> fixtureWallet ctx <*> emptyWallet ctx
+      let amt = 10_000_000
+      let ttl = Just "30s"
+
+      args <- postTxArgs ctx wSrc wDest amt Nothing ttl
+      Stdout feeOut <- postTransactionFeeViaCLI @t ctx args
+      ApiFee (Quantity feeMin) (Quantity feeMax) <- expectValidJSON Proxy feeOut
+
+      txJson <- postTxViaCLI ctx wSrc wDest amt Nothing ttl
+      verify txJson
+          [ expectCliField (#amount . #getQuantity)
+              (between (feeMin + amt, feeMax + amt))
+          , expectCliField (#direction . #getApiT) (`shouldBe` Outgoing)
+          , expectCliField (#status . #getApiT) (`shouldBe` Pending)
+          ]
+
+      eventually "transaction with ttl is confirmed in transaction list" $ do
+          (Exit code, Stdout out, Stderr err) <-
+              listTransactionsViaCLI @t ctx [T.unpack $ wDest ^. walletId]
+          err `shouldBe` "Ok.\n"
+          code `shouldBe` ExitSuccess
+          outJson <- expectValidJSON (Proxy @([ApiTransaction n])) out
+          verify outJson
+              [ expectCliListField 0 (#status . #getApiT) (`shouldBe` InLedger) ]
+
     describe "TRANS_ESTIMATE_08 - Invalid addresses" $ do
         forM_ matrixInvalidAddrs $ \(title, addr, errMsg) -> it title $ \ctx -> runResourceT $ do
             wSrc <- emptyWallet ctx
@@ -729,7 +755,7 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do
         let wSrcId = T.unpack (wSrc ^. walletId)
 
         -- post transaction
-        txJson <- postTxViaCLI ctx wSrc wDest minUTxOValue Nothing
+        txJson <- postTxViaCLI ctx wSrc wDest minUTxOValue Nothing Nothing
         verify txJson
             [ expectCliField (#direction . #getApiT) (`shouldBe` Outgoing)
             , expectCliField (#status . #getApiT) (`shouldBe` Pending)
@@ -784,7 +810,7 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do
             -- post tx
             wSrc <- fixtureWallet ctx
             wDest <- emptyWallet ctx
-            txJson <- postTxViaCLI ctx wSrc wDest minUTxOValue Nothing
+            txJson <- postTxViaCLI ctx wSrc wDest minUTxOValue Nothing Nothing
 
             -- try to forget from different wallet
             widDiff <- emptyWallet' ctx
@@ -853,9 +879,10 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do
           -> ApiWallet
           -> Natural
           -> Maybe Text
+          -> Maybe Text
           -> m (ApiTransaction n)
-      postTxViaCLI ctx wSrc wDest amt md = do
-          args <- postTxArgs ctx wSrc wDest amt md
+      postTxViaCLI ctx wSrc wDest amt md ttl = do
+          args <- postTxArgs ctx wSrc wDest amt md ttl
 
           -- post transaction
           (c, out, err) <- postTransactionViaCLI @t ctx "cardano-wallet" args
@@ -870,14 +897,16 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do
         -> ApiWallet
         -> Natural
         -> Maybe Text
+        -> Maybe Text
         -> m [String]
-      postTxArgs ctx wSrc wDest amt md = do
+      postTxArgs ctx wSrc wDest amt md ttl = 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
+              ++ maybe [] (\s -> ["--ttl", s]) ttl
 
       fixtureWallet' :: Context t -> ResourceT IO String
       fixtureWallet' = fmap (T.unpack . view walletId) . fixtureWallet