Type per command for query commands

IntersectMBO · Sep 29, 2023 · 2b4e21c · 2b4e21c
1 parent dfb28b5
commit 2b4e21c
Show file tree

Hide file tree

Showing 3 changed files with 269 additions and 192 deletions.
diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Query.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Query.hs
@@ -1,8 +1,24 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE LambdaCase #-}
 
 module Cardano.CLI.EraBased.Commands.Query
   ( QueryCmds (..)
+  , QueryLeadershipScheduleCmdArgs(..)
+  , QueryProtocolParametersCmdArgs(..)
+  , QueryConstitutionHashCmdArgs(..)
+  , QueryTipCmdArgs(..)
+  , QueryStakePoolsCmdArgs(..)
+  , QueryStakeDistributionCmdArgs(..)
+  , QueryStakeAddressInfoCmdArgs(..)
+  , QueryUTxOCmdArgs(..)
+  , QueryDebugLedgerStateCmdArgs(..)
+  , QueryProtocolStateCmdArgs(..)
+  , QueryStakeSnapshotCmdArgs(..)
+  , QueryKesPeriodInfoCmdArgs(..)
+  , QueryPoolStateCmdArgs(..)
+  , QueryTxMempoolCmdArgs(..)
+  , QuerySlotNumberCmdArgs(..)
   , renderQueryCmds
   ) where
 
@@ -13,94 +29,140 @@ import           Cardano.CLI.Types.Key
 
 import           Data.Text (Text)
 import           Data.Time.Clock
+import           GHC.Generics
 
 data QueryCmds era
-  = QueryLeadershipScheduleCmd
-      SocketPath
-      AnyConsensusModeParams
-      NetworkId
-      GenesisFile
-      (VerificationKeyOrHashOrFile StakePoolKey)
-      (SigningKeyFile In)
-      EpochLeadershipSchedule
-      (Maybe (File () Out))
-  | QueryProtocolParametersCmd
-      SocketPath
-      AnyConsensusModeParams
-      NetworkId
-      (Maybe (File () Out))
-  | QueryConstitutionHashCmd
-      SocketPath
-      AnyConsensusModeParams
-      NetworkId
-      (Maybe (File () Out))
-  | QueryTipCmd
-      SocketPath
-      AnyConsensusModeParams
-      NetworkId
-      (Maybe (File () Out))
-  | QueryStakePoolsCmd
-      SocketPath
-      AnyConsensusModeParams
-      NetworkId
-      (Maybe (File () Out))
-  | QueryStakeDistributionCmd
-      SocketPath
-      AnyConsensusModeParams
-      NetworkId
-      (Maybe (File () Out))
-  | QueryStakeAddressInfoCmd
-      SocketPath
-      AnyConsensusModeParams
-      StakeAddress
-      NetworkId
-      (Maybe (File () Out))
-  | QueryUTxOCmd
-      SocketPath
-      AnyConsensusModeParams
-      QueryUTxOFilter
-      NetworkId
-      (Maybe (File () Out))
-  | QueryDebugLedgerStateCmd
-      SocketPath
-      AnyConsensusModeParams
-      NetworkId
-      (Maybe (File () Out))
-  | QueryProtocolStateCmd
-      SocketPath
-      AnyConsensusModeParams
-      NetworkId
-      (Maybe (File () Out))
-  | QueryStakeSnapshotCmd
-      SocketPath
-      AnyConsensusModeParams
-      NetworkId
-      (AllOrOnly [Hash StakePoolKey])
-      (Maybe (File () Out))
-  | QueryKesPeriodInfoCmd
-      SocketPath
-      AnyConsensusModeParams
-      NetworkId
-      (File () In)
-      -- ^ Node operational certificate
-      (Maybe (File () Out))
-  | QueryPoolStateCmd
-      SocketPath
-      AnyConsensusModeParams
-      NetworkId
-      [Hash StakePoolKey]
-  | QueryTxMempoolCmd
-      SocketPath
-      AnyConsensusModeParams
-      NetworkId
-      TxMempoolQuery
-      (Maybe (File () Out))
-  | QuerySlotNumberCmd
-      SocketPath
-      AnyConsensusModeParams
-      NetworkId
-      UTCTime
-  deriving Show
+  = QueryLeadershipScheduleCmd  !QueryLeadershipScheduleCmdArgs
+  | QueryProtocolParametersCmd  !QueryProtocolParametersCmdArgs
+  | QueryConstitutionHashCmd    !QueryConstitutionHashCmdArgs
+  | QueryTipCmd                 !QueryTipCmdArgs
+  | QueryStakePoolsCmd          !QueryStakePoolsCmdArgs
+  | QueryStakeDistributionCmd   !QueryStakeDistributionCmdArgs
+  | QueryStakeAddressInfoCmd    !QueryStakeAddressInfoCmdArgs
+  | QueryUTxOCmd                !QueryUTxOCmdArgs
+  | QueryDebugLedgerStateCmd    !QueryDebugLedgerStateCmdArgs
+  | QueryProtocolStateCmd       !QueryProtocolStateCmdArgs
+  | QueryStakeSnapshotCmd       !QueryStakeSnapshotCmdArgs
+  | QueryKesPeriodInfoCmd       !QueryKesPeriodInfoCmdArgs
+  | QueryPoolStateCmd           !QueryPoolStateCmdArgs
+  | QueryTxMempoolCmd           !QueryTxMempoolCmdArgs
+  | QuerySlotNumberCmd          !QuerySlotNumberCmdArgs
+  deriving (Generic, Show)
+
+data QueryLeadershipScheduleCmdArgs = QueryLeadershipScheduleCmdArgs
+  !SocketPath
+  !AnyConsensusModeParams
+  !NetworkId
+  !GenesisFile
+  !(VerificationKeyOrHashOrFile StakePoolKey)
+  !(SigningKeyFile In)
+  !EpochLeadershipSchedule
+  !(Maybe (File () Out))
+  deriving (Generic, Show)
+
+data QueryProtocolParametersCmdArgs = QueryProtocolParametersCmdArgs
+  !SocketPath
+  !AnyConsensusModeParams
+  !NetworkId
+  !(Maybe (File () Out))
+  deriving (Generic, Show)
+
+data QueryConstitutionHashCmdArgs = QueryConstitutionHashCmdArgs
+  !SocketPath
+  !AnyConsensusModeParams
+  !NetworkId
+  !(Maybe (File () Out))
+  deriving (Generic, Show)
+
+data QueryTipCmdArgs = QueryTipCmdArgs
+  !SocketPath
+  !AnyConsensusModeParams
+  !NetworkId
+  !(Maybe (File () Out))
+  deriving (Generic, Show)
+
+data QueryStakePoolsCmdArgs = QueryStakePoolsCmdArgs
+  !SocketPath
+  !AnyConsensusModeParams
+  !NetworkId
+  !(Maybe (File () Out))
+  deriving (Generic, Show)
+
+data QueryStakeDistributionCmdArgs = QueryStakeDistributionCmdArgs
+  !SocketPath
+  !AnyConsensusModeParams
+  !NetworkId
+  !(Maybe (File () Out))
+  deriving (Generic, Show)
+
+data QueryStakeAddressInfoCmdArgs = QueryStakeAddressInfoCmdArgs
+  !SocketPath
+  !AnyConsensusModeParams
+  !StakeAddress
+  !NetworkId
+  !(Maybe (File () Out))
+  deriving (Generic, Show)
+
+data QueryUTxOCmdArgs = QueryUTxOCmdArgs
+  !SocketPath
+  !AnyConsensusModeParams
+  !QueryUTxOFilter
+  !NetworkId
+  !(Maybe (File () Out))
+  deriving (Generic, Show)
+
+data QueryDebugLedgerStateCmdArgs = QueryDebugLedgerStateCmdArgs
+  !SocketPath
+  !AnyConsensusModeParams
+  !NetworkId
+  !(Maybe (File () Out))
+  deriving (Generic, Show)
+
+data QueryProtocolStateCmdArgs = QueryProtocolStateCmdArgs
+  !SocketPath
+  !AnyConsensusModeParams
+  !NetworkId
+  !(Maybe (File () Out))
+  deriving (Generic, Show)
+
+data QueryStakeSnapshotCmdArgs = QueryStakeSnapshotCmdArgs
+  !SocketPath
+  !AnyConsensusModeParams
+  !NetworkId
+  !(AllOrOnly [Hash StakePoolKey])
+  !(Maybe (File () Out))
+  deriving (Generic, Show)
+
+data QueryKesPeriodInfoCmdArgs = QueryKesPeriodInfoCmdArgs
+  !SocketPath
+  !AnyConsensusModeParams
+  !NetworkId
+  !(File () In)
+  -- ^ Node operational certificate
+  !(Maybe (File () Out))
+  deriving (Generic, Show)
+
+data QueryPoolStateCmdArgs = QueryPoolStateCmdArgs
+  !SocketPath
+  !AnyConsensusModeParams
+  !NetworkId
+  ![Hash StakePoolKey]
+  deriving (Generic, Show)
+
+data QueryTxMempoolCmdArgs = QueryTxMempoolCmdArgs
+  !SocketPath
+  !AnyConsensusModeParams
+  !NetworkId
+  !TxMempoolQuery
+  !(Maybe (File () Out))
+  deriving (Generic, Show)
+
+data QuerySlotNumberCmdArgs = QuerySlotNumberCmdArgs
+  !SocketPath
+  !AnyConsensusModeParams
+  !NetworkId
+  !UTCTime
+  deriving (Generic, Show)
 
 renderQueryCmds :: QueryCmds era -> Text
 renderQueryCmds = \case
@@ -130,7 +192,7 @@ renderQueryCmds = \case
     "query kes-period-info"
   QueryPoolStateCmd {} ->
     "query pool-state"
-  QueryTxMempoolCmd _ _ _ query _ ->
+  QueryTxMempoolCmd (QueryTxMempoolCmdArgs _ _ _ query _) ->
     "query tx-mempool" <> renderTxMempoolQuery query
   QuerySlotNumberCmd {} ->
     "query slot-number"