#667 Add ref-script-size query command

cardano-cli/src/Cardano/CLI/EraBased/Commands/Query.hs

@@ -21,6 +21,7 @@ module Cardano.CLI.EraBased.Commands.Query
   , QueryPoolStateCmdArgs(..)
   , QueryTxMempoolCmdArgs(..)
   , QuerySlotNumberCmdArgs(..)
+  , QueryRefScriptSizeCmdArgs(..)
   , QueryNoArgCmdArgs(..)
   , QueryDRepStateCmdArgs(..)
   , QueryDRepStakeDistributionCmdArgs(..)
@@ -34,6 +35,7 @@ import           Cardano.CLI.Types.Common
 import           Cardano.CLI.Types.Key
 import qualified Ouroboros.Network.Protocol.LocalStateQuery.Type as Consensus
 
+import           Data.Set (Set)
 import           Data.Text (Text)
 import           Data.Time.Clock
 import           GHC.Generics
@@ -54,6 +56,7 @@ data QueryCmds era
   | QueryPoolStateCmd               !QueryPoolStateCmdArgs
   | QueryTxMempoolCmd               !QueryTxMempoolCmdArgs
   | QuerySlotNumberCmd              !QuerySlotNumberCmdArgs
+  | QueryRefScriptSizeCmd           !QueryRefScriptSizeCmdArgs
   | QueryConstitutionCmd            !(QueryNoArgCmdArgs era)
   | QueryGovStateCmd                !(QueryNoArgCmdArgs era)
   | QueryDRepStateCmd               !(QueryDRepStateCmdArgs era)
@@ -193,6 +196,16 @@ data QuerySlotNumberCmdArgs = QuerySlotNumberCmdArgs
   , utcTime             :: !UTCTime
   } deriving (Generic, Show)
 
+data QueryRefScriptSizeCmdArgs = QueryRefScriptSizeCmdArgs
+  { nodeSocketPath      :: !SocketPath
+  , consensusModeParams :: !ConsensusModeParams
+  , transactionInputs   :: !(Set TxIn)
+  , networkId           :: !NetworkId
+  , target              :: !(Consensus.Target ChainPoint)
+  , format              :: Maybe QueryOutputFormat
+  , mOutFile            :: !(Maybe (File () Out))
+  } deriving (Generic, Show)
+
 data QueryNoArgCmdArgs era = QueryNoArgCmdArgs
   { eon                 :: !(ConwayEraOnwards era)
   , nodeSocketPath      :: !SocketPath
@@ -272,6 +285,8 @@ renderQueryCmds = \case
     "query tx-mempool" <> renderTxMempoolQuery q
   QuerySlotNumberCmd {} ->
     "query slot-number"
+  QueryRefScriptSizeCmd {} ->
+    "query ref-script-size"
   QueryConstitutionCmd {} ->
     "constitution"
   QueryGovStateCmd {} ->

cardano-cli/src/Cardano/CLI/EraBased/Options/Query.hs

@@ -18,6 +18,7 @@ import           Cardano.CLI.Types.Common
 import           Cardano.CLI.Types.Key
 
 import           Data.Foldable
+import           GHC.Exts (IsList (..))
 import           Options.Applicative hiding (help, str)
 import qualified Options.Applicative as Opt
 
@@ -109,6 +110,10 @@ pQueryCmds era envCli =
         $ subParser "slot-number"
         $ Opt.info (pQuerySlotNumberCmd era envCli)
         $ Opt.progDesc "Query slot number for UTC timestamp"
+    , Just
+        . subParser "ref-script-size"
+        . Opt.info (pQueryRefScriptSizeCmd era envCli)
+        $ Opt.progDesc "Calculate the reference input scripts size in bytes for provided transaction inputs."
     , pQueryGetConstitutionCmd era envCli
     , pQueryGetGovStateCmd era envCli
     , pQueryDRepStateCmd era envCli
@@ -295,6 +300,26 @@ pQuerySlotNumberCmd era envCli =
         , Opt.help "UTC timestamp in YYYY-MM-DDThh:mm:ssZ format"
         ]
 
+pQueryRefScriptSizeCmd :: CardanoEra era -> EnvCli -> Parser (QueryCmds era)
+pQueryRefScriptSizeCmd era envCli =
+  fmap QueryRefScriptSizeCmd $
+    QueryRefScriptSizeCmdArgs
+      <$> pSocketPath envCli
+      <*> pConsensusModeParams
+      <*> (fromList <$> some pByTxIn)
+      <*> pNetworkId envCli
+      <*> pTarget era
+      <*> (optional $ pQueryOutputFormat "reference inputs")
+      <*> pMaybeOutputFile
+  where
+    pByTxIn :: Parser TxIn
+    pByTxIn =
+      Opt.option (readerFromParsecParser parseTxIn) $ mconcat
+        [ Opt.long "tx-in"
+        , Opt.metavar "TX-IN"
+        , Opt.help "Transaction input (TxId#TxIx)."
+        ]
+
 pQueryGetConstitutionCmd :: ()
   => CardanoEra era
   -> EnvCli

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

@@ -1,4 +1,6 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -81,13 +83,15 @@ import qualified Data.Map.Strict as Map
 import           Data.Proxy (Proxy (..))
 import           Data.Set (Set)
 import qualified Data.Set as Set
+import           Data.String
 import           Data.Text (Text)
 import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text
 import qualified Data.Text.IO as T
 import qualified Data.Text.IO as Text
 import qualified Data.Text.Lazy.IO as LT
 import           Data.Time.Clock
+import           GHC.Generics
 import           Lens.Micro ((^.))
 import           Numeric (showEFloat)
 import           Prettyprinter
@@ -115,6 +119,7 @@ runQueryCmds = \case
   Cmd.QueryPoolStateCmd             args -> runQueryPoolStateCmd args
   Cmd.QueryTxMempoolCmd             args -> runQueryTxMempoolCmd args
   Cmd.QuerySlotNumberCmd            args -> runQuerySlotNumberCmd args
+  Cmd.QueryRefScriptSizeCmd         args -> runQueryRefScriptSizeCmd args
   Cmd.QueryConstitutionCmd          args -> runQueryConstitution args
   Cmd.QueryGovStateCmd              args -> runQueryGovState args
   Cmd.QueryDRepStateCmd             args -> runQueryDRepState args
@@ -672,6 +677,51 @@ runQuerySlotNumberCmd
   SlotNo slotNo <- utcTimeToSlotNo nodeSocketPath consensusModeParams networkId target utcTime
   liftIO . putStr $ show slotNo
 
+runQueryRefScriptSizeCmd
+  :: ()
+  => Cmd.QueryRefScriptSizeCmdArgs
+  -> ExceptT QueryCmdError IO ()
+runQueryRefScriptSizeCmd
+    Cmd.QueryRefScriptSizeCmdArgs
+    { Cmd.nodeSocketPath
+    , Cmd.consensusModeParams
+    , Cmd.transactionInputs
+    , Cmd.networkId
+    , Cmd.target
+    , Cmd.format
+    , Cmd.mOutFile
+    } = do
+  let localNodeConnInfo = LocalNodeConnectInfo consensusModeParams networkId nodeSocketPath
+
+  join $ lift
+    ( executeLocalStateQueryExpr localNodeConnInfo target $ runExceptT $ do
+        AnyCardanoEra era <- lift queryCurrentEra
+          & onLeft (left . QueryCmdUnsupportedNtcVersion)
+
+        sbe <- requireShelleyBasedEra era
+          & onNothing (left QueryCmdByronEra)
+
+        beo <- requireEon BabbageEra era
+
+        utxo <- lift (queryUtxo sbe $ QueryUTxOByTxIn transactionInputs)
+          & onLeft (left . QueryCmdUnsupportedNtcVersion)
+          & onLeft (left . QueryCmdLocalStateQueryError . EraMismatchError)
+
+        pure $
+          writeFormattedOutput format mOutFile $
+            RefInputScriptSize $
+              getReferenceInputsSizeForTxIds beo (toLedgerUTxO sbe utxo) transactionInputs
+    )
+    & onLeft (left . QueryCmdAcquireFailure)
+    & onLeft left
+
+newtype RefInputScriptSize = RefInputScriptSize { refInputScriptSize :: Int }
+  deriving (Generic)
+  deriving anyclass (ToJSON)
+
+instance Pretty RefInputScriptSize where
+  pretty (RefInputScriptSize s) = "Reference inputs scripts size is" <+> pretty s <+> "bytes."
+
 -- | 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.
 -- Obtaining the information directly is significantly more time and memory efficient than using a full ledger state dump.
@@ -1120,6 +1170,7 @@ runQueryStakePoolsCmd
     ) & onLeft (left . QueryCmdAcquireFailure)
       & onLeft left
 
+-- TODO: replace with writeFormattedOutput
 writeStakePools
   :: QueryOutputFormat
   -> Maybe (File () Out)
@@ -1138,6 +1189,23 @@ writeStakePools format mOutFile stakePools =
         QueryOutputFormatJson ->
           encodePretty stakePools
 
+writeFormattedOutput
+  :: MonadIOTransError QueryCmdError t m
+  => ToJSON a
+  => Pretty a
+  => Maybe QueryOutputFormat
+  -> Maybe (File b Out)
+  -> a
+  -> t m ()
+writeFormattedOutput mFormat mOutFile value =
+  modifyError QueryCmdWriteFileError . hoistIOEither $
+      writeLazyByteStringOutput mOutFile toWrite
+  where
+    toWrite :: LBS.ByteString =
+      case newOutputFormat mFormat mOutFile of
+        QueryOutputFormatText -> fromString . docToString $ pretty value
+        QueryOutputFormatJson -> encodePretty value
+
 runQueryStakeDistributionCmd :: ()
   => Cmd.QueryStakeDistributionCmdArgs
   -> ExceptT QueryCmdError IO ()