Add tx-mempool command to CLI

Author: Robert 'Probie' Offner

cardano-api/src/Cardano/Api.hs

@@ -591,6 +591,8 @@ module Cardano.Api (
     MempoolSizeAndCapacity(..),
     queryTxMonitoringLocal,
 
+    TxIdInMode(..),
+
     EraHistory(..),
     getProgress,
 
@@ -681,6 +683,7 @@ import           Cardano.Api.Fees
 import           Cardano.Api.GenesisParameters
 import           Cardano.Api.Hash
 import           Cardano.Api.HasTypeProxy
+import           Cardano.Api.InMode
 import           Cardano.Api.IPC
 import           Cardano.Api.IPC.Monad
 import           Cardano.Api.Key

cardano-cli/src/Cardano/CLI/Shelley/Commands.hs

@@ -17,6 +17,9 @@ module Cardano.CLI.Shelley.Commands
   , TextViewCmd (..)
   , renderShelleyCommand
 
+    -- * Subqueries for the local mempool command
+  , TxMempoolQuery (..)
+
     -- * CLI flag types
   , AddressKeyType (..)
   , ByronKeyType (..)
@@ -49,7 +52,7 @@ import           Prelude
 
 import           Cardano.Api.Shelley
 
-import           Data.Text (Text)
+import           Data.Text (Text, pack)
 
 import           Cardano.CLI.Shelley.Key (PaymentVerifier, StakeVerifier, VerificationKeyOrFile,
                    VerificationKeyOrHashOrFile, VerificationKeyTextOrFile)
@@ -348,6 +351,19 @@ renderPoolCmd cmd =
     PoolGetId {} -> "stake-pool id"
     PoolMetadataHash {} -> "stake-pool metadata-hash"
 
+data TxMempoolQuery =
+      TxMempoolQueryTxExists TxId
+    | TxMempoolQueryNextTx
+    | TxMempoolQueryInfo
+  deriving Show
+
+renderTxMempoolQuery :: TxMempoolQuery -> Text
+renderTxMempoolQuery query =
+  case query of
+    TxMempoolQueryTxExists tx -> "tx-exists " <> pack (show tx) -- TODO render this properly
+    TxMempoolQueryNextTx -> "next-tx"
+    TxMempoolQueryInfo -> "info"
+
 data QueryCmd =
     QueryLeadershipSchedule
       AnyConsensusModeParams
@@ -373,6 +389,7 @@ data QueryCmd =
       -- ^ Node operational certificate
       (Maybe OutputFile)
   | QueryPoolState' AnyConsensusModeParams NetworkId [Hash StakePoolKey]
+  | QueryTxMempool AnyConsensusModeParams NetworkId TxMempoolQuery
   deriving Show
 
 renderQueryCmd :: QueryCmd -> Text
@@ -390,6 +407,7 @@ renderQueryCmd cmd =
     QueryStakeSnapshot' {} -> "query stake-snapshot"
     QueryKesPeriodInfo {} -> "query kes-period-info"
     QueryPoolState' {} -> "query pool-state"
+    QueryTxMempool _ _ query -> "query tx-mempool" <> renderTxMempoolQuery query
 
 data GovernanceCmd
   = GovernanceMIRPayStakeAddressesCertificate

cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs

@@ -941,6 +941,8 @@ pQueryCmd =
         (Opt.info pKesPeriodInfo $ Opt.progDesc "Get information about the current KES period and your node's operational certificate.")
     , subParser "pool-state"
         (Opt.info pQueryPoolState $ Opt.progDesc "Dump the pool state")
+    , subParser "tx-mempool"
+        (Opt.info pQueryTxMempool $ Opt.progDesc "Local Mempool info")
     ]
   where
     pQueryProtocolParameters :: Parser QueryCmd
@@ -1010,6 +1012,17 @@ pQueryCmd =
       <*> pNetworkId
       <*> many pStakePoolVerificationKeyHash
 
+    pQueryTxMempool :: Parser QueryCmd
+    pQueryTxMempool = QueryTxMempool
+      <$> pConsensusModeParams
+      <*> pNetworkId
+      <*> pTxMempoolQuery
+      where
+        pTxMempoolQuery :: Parser TxMempoolQuery
+        pTxMempoolQuery = subparser $
+             command "info" (info (pure TxMempoolQueryInfo) (progDesc "Mempool info"))
+          <> command "next-tx" (info (pure TxMempoolQueryNextTx) (progDesc "Next transaction"))
+          <> command "tx-exists" (info (TxMempoolQueryTxExists <$> argument Opt.str (metavar "TX_ID")) (progDesc "Check if transaction exists"))
     pLeadershipSchedule :: Parser QueryCmd
     pLeadershipSchedule = QueryLeadershipSchedule
       <$> pConsensusModeParams

cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs

@@ -199,6 +199,8 @@ runQueryCmd cmd =
       runQueryKesPeriodInfo consensusModeParams network nodeOpCert mOutFile
     QueryPoolState' consensusModeParams network poolid ->
       runQueryPoolState consensusModeParams network poolid
+    QueryTxMempool consensusModeParams network op ->
+      runQueryTxMempool consensusModeParams network op
 
 runQueryProtocolParameters
   :: AnyConsensusModeParams
@@ -620,6 +622,52 @@ runQueryPoolState (AnyConsensusModeParams cModeParams) network poolIds = do
   result <- executeQuery era cModeParams localNodeConnInfo qInMode
   obtainLedgerEraClassConstraints sbe writePoolState result
 
+-- | Query the local mempool state
+runQueryTxMempool
+  :: AnyConsensusModeParams
+  -> NetworkId
+  -> TxMempoolQuery
+  -> ExceptT ShelleyQueryCmdError IO ()
+runQueryTxMempool (AnyConsensusModeParams cModeParams) network query = do
+  SocketPath sockPath <- firstExceptT ShelleyQueryCmdEnvVarSocketErr readEnvSocketPath
+  let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath
+
+  localQuery <- case query of
+      TxMempoolQueryTxExists tx -> do
+        anyE@(AnyCardanoEra era) <- determineEra cModeParams localNodeConnInfo
+        let cMode = consensusModeOnly cModeParams
+        eInMode <- toEraInMode era cMode
+          & hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE)
+        pure $ LocalTxMonitoringQueryTx $ TxIdInMode tx eInMode
+      TxMempoolQueryNextTx -> pure LocalTxMonitoringSendNextTx
+      TxMempoolQueryInfo -> pure LocalTxMonitoringMempoolInformation
+
+  result <- liftIO $ queryTxMonitoringLocal localNodeConnInfo localQuery
+  liftIO $ LBS.putStrLn (renderResult result)
+  where
+    renderResult result =
+      case result of
+        LocalTxMonitoringTxExists tx slot -> encodePretty $ object
+            [ "exists" .= True
+            , "txId" .= tx
+            , "slot" .= slot
+            ]
+        LocalTxMonitoringTxDoesNotExist tx slot -> encodePretty $ object
+            [ "exists" .= False
+            , "txId" .= tx
+            , "slot" .= slot
+            ]
+        LocalTxMonitoringNextTx tx slot -> encodePretty $ object
+            [ "nextTx" .= (show tx :: String) -- TODO Render this properly
+            , "slot" .= slot
+            ]
+        LocalTxMonitoringMempoolSizeAndCapacity mempool slot ->
+          encodePretty $ object
+            [ "capacityInBytes" .= capacityInBytes mempool
+            , "sizeInBytes" .= sizeInBytes mempool
+            , "numberOfTxs" .= numberOfTxs mempool
+            , "slot" .= slot
+            ]
 
 -- | Obtain stake snapshot information for a pool, plus information about the total active stake.
 -- This information can be used for leader slot calculation, for example, and has been requested by SPOs.

scripts/babbage/example-babbage-script-usage.sh

@@ -22,7 +22,7 @@ ls -al "$CARDANO_NODE_SOCKET_PATH"
 plutusspendingscript="$BASE/scripts/plutus/scripts/v2/required-redeemer.plutus"
 plutusmintingscript="$BASE/scripts/plutus/scripts/v2/minting-script.plutus"
 plutusstakescript="scripts/plutus/scripts/v2/stake-script.plutus"
-mintpolicyid=$(cardano-cli transaction policyid --script-file $plutusmintingscript)
+mintpolicyid=$($CARDANO_CLI transaction policyid --script-file $plutusmintingscript)
 ## This datum hash is the hash of the untyped 42
 scriptdatumhash="9e1199a988ba72ffd6e9c269cadb3b53b5f360ff99f112d9b2ee30c4d74ad88b"
 datumfilepath="$BASE/scripts/plutus/data/42.datum"