Add tx-mempool command to CLI

Author: Robert 'Probie' Offner

Diff for: 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

Diff for: cardano-api/src/Cardano/Api/IPC.hs

@@ -83,6 +83,7 @@ import           Prelude
 
 import           Data.Void (Void)
 
+import           Data.Aeson (ToJSON, (.=), object, toJSON)
 import qualified Data.ByteString.Lazy as LBS
 import qualified Data.Map.Strict as Map
 
@@ -650,6 +651,30 @@ data LocalTxMonitoringResult mode
       Consensus.MempoolSizeAndCapacity
       SlotNo -- ^ Slot number at which the mempool snapshot was taken
 
+instance ToJSON (LocalTxMonitoringResult mode) where
+  toJSON result =
+    object $ case result of
+      LocalTxMonitoringTxExists tx slot ->
+          [ "exists" .= True
+          , "txId" .= tx
+          , "slot" .= slot
+          ]
+      LocalTxMonitoringTxDoesNotExist tx slot ->
+          [ "exists" .= False
+          , "txId" .= tx
+          , "slot" .= slot
+          ]
+      LocalTxMonitoringNextTx tx slot ->
+          [ "nextTx" .= (show <$> tx) -- TODO Render this properly
+          , "slot" .= slot
+          ]
+      LocalTxMonitoringMempoolSizeAndCapacity mempool slot ->
+          [ "capacityInBytes" .= Consensus.capacityInBytes mempool
+          , "sizeInBytes" .= Consensus.sizeInBytes mempool
+          , "numberOfTxs" .= Consensus.numberOfTxs mempool
+          , "slot" .= slot
+          ]
+
 data LocalTxMonitoringQuery mode
   -- | Query if a particular tx exists in the mempool. Note that, the absence
   -- of a transaction does not imply anything about how the transaction was

Diff for: cardano-cli/ChangeLog.md

@@ -1,5 +1,11 @@
 # Changelog for cardano-cli
 
+## vNext
+
+### Features
+
+- Add `query tx-mempool` ([PR 4276](https://github.com/input-output-hk/cardano-node/pull/4276))
+
 ## 1.33.0 -- December 2021
 ## 1.32.1 -- November 2021
 

Diff for: cardano-cli/src/Cardano/CLI/Shelley/Commands.hs

@@ -373,6 +373,7 @@ data QueryCmd =
       -- ^ Node operational certificate
       (Maybe OutputFile)
   | QueryPoolState' AnyConsensusModeParams NetworkId [Hash StakePoolKey]
+  | QueryTxMempool AnyConsensusModeParams NetworkId TxMempoolQuery (Maybe OutputFile)
   deriving Show
 
 renderQueryCmd :: QueryCmd -> Text
@@ -390,6 +391,14 @@ renderQueryCmd cmd =
     QueryStakeSnapshot' {} -> "query stake-snapshot"
     QueryKesPeriodInfo {} -> "query kes-period-info"
     QueryPoolState' {} -> "query pool-state"
+    QueryTxMempool _ _ query _ -> "query tx-mempool" <> renderTxMempoolQuery query
+  where
+    renderTxMempoolQuery query =
+      case query of
+        TxMempoolQueryTxExists tx -> "tx-exists " <> serialiseToRawBytesHexText tx
+        TxMempoolQueryNextTx -> "next-tx"
+        TxMempoolQueryInfo -> "info"
+
 
 data GovernanceCmd
   = GovernanceMIRPayStakeAddressesCertificate

Diff for: 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,25 @@ pQueryCmd =
       <*> pNetworkId
       <*> many pStakePoolVerificationKeyHash
 
+    pQueryTxMempool :: Parser QueryCmd
+    pQueryTxMempool = QueryTxMempool
+      <$> pConsensusModeParams
+      <*> pNetworkId
+      <*> pTxMempoolQuery
+      <*> pMaybeOutputFile
+      where
+        pTxMempoolQuery :: Parser TxMempoolQuery
+        pTxMempoolQuery = asum
+          [ subParser "info"
+            (Opt.info (pure TxMempoolQueryInfo) $
+              Opt.progDesc "Ask the server about the current mempool's capacity and sizes")
+          , subParser "next-tx"
+            (Opt.info (pure TxMempoolQueryNextTx) $
+              Opt.progDesc "Requests the next transaction from the current list")
+          , subParser "tx-exists"
+            (Opt.info (TxMempoolQueryTxExists <$> argument Opt.str (metavar "TX_ID")) $
+              Opt.progDesc "Query if a particular transaction exists in the mempool")
+          ]
     pLeadershipSchedule :: Parser QueryCmd
     pLeadershipSchedule = QueryLeadershipSchedule
       <$> pConsensusModeParams

Diff for: 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 mOutFile ->
+      runQueryTxMempool consensusModeParams network op mOutFile
 
 runQueryProtocolParameters
   :: AnyConsensusModeParams
@@ -620,6 +622,34 @@ 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
+  -> Maybe OutputFile
+  -> ExceptT ShelleyQueryCmdError IO ()
+runQueryTxMempool (AnyConsensusModeParams cModeParams) network query mOutFile = 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
+  let renderedResult = encodePretty result
+  liftIO $ LBS.putStrLn renderedResult
+  forM_ mOutFile (\(OutputFile oFp) ->
+    handleIOExceptT (ShelleyQueryCmdWriteFileError . FileIOError oFp)
+      $ LBS.writeFile oFp renderedResult)
+
 
 -- | 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.

Diff for: cardano-cli/src/Cardano/CLI/Types.hs

@@ -36,6 +36,7 @@ module Cardano.CLI.Types
   , TxOutChangeAddress (..)
   , TxOutDatumAnyEra (..)
   , TxFile (..)
+  , TxMempoolQuery (..)
   , UpdateProposalFile (..)
   , VerificationKeyFile (..)
   , Stakes (..)
@@ -53,8 +54,8 @@ import           Data.Word (Word64)
 import qualified Cardano.Chain.Slotting as Byron
 
 import           Cardano.Api (AddressAny, AnyScriptLanguage, EpochNo, ExecutionUnits, Hash,
-                   InAnyCardanoEra, PaymentKey, PolicyId, ScriptData, SlotNo (SlotNo), Tx, TxIn,
-                   Value, WitCtxMint, WitCtxStake, WitCtxTxIn)
+                   InAnyCardanoEra, PaymentKey, PolicyId, ScriptData, SlotNo (SlotNo), Tx, TxId,
+                   TxIn, Value, WitCtxMint, WitCtxStake, WitCtxTxIn)
 
 import qualified Cardano.Ledger.Crypto as Crypto
 
@@ -395,4 +396,8 @@ newtype TxFile
   = TxFile FilePath
   deriving Show
 
-
+data TxMempoolQuery =
+      TxMempoolQueryTxExists TxId
+    | TxMempoolQueryNextTx
+    | TxMempoolQueryInfo
+  deriving Show

Diff for: 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"