Merge pull request #419 from input-output-hk/newhoggy/command-argumen…

…t-types-for-stake-pool-commands Command arguments types for stake-pool commands
IntersectMBO · Nov 2, 2023 · 5a0d2f7 · 5a0d2f7
2 parents a4c65ae + c38f881
commit 5a0d2f7
Show file tree

Hide file tree

Showing 4 changed files with 216 additions and 159 deletions.
diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/StakePool.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/StakePool.hs
@@ -1,9 +1,15 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
 
 module Cardano.CLI.EraBased.Commands.StakePool
   ( StakePoolCmds (..)
   , renderStakePoolCmds
+
+  , StakePoolDeregistrationCertificateCmdArgs(..)
+  , StakePoolIdCmdArgs(..)
+  , StakePoolMetadataHashCmdArgs(..)
+  , StakePoolRegistrationCertificateCmdArgs(..)
   ) where
 
 import           Cardano.Api.Shelley hiding (QueryInShelleyBasedEra (..))
@@ -16,44 +22,51 @@ import           Prelude
 import           Data.Text (Text)
 
 data StakePoolCmds era
-  = StakePoolDeregistrationCertificateCmd
-      (ShelleyBasedEra era)
-      -- ^ Era in which to retire the stake pool.
-      (VerificationKeyOrFile StakePoolKey)
-      -- ^ Stake pool verification key.
-      EpochNo
-      -- ^ Epoch in which to retire the stake pool.
-      (File () Out)
-  | StakePoolIdCmd
-      (VerificationKeyOrFile StakePoolKey)
-      IdOutputFormat
-      (Maybe (File () Out))
-  | StakePoolMetadataHashCmd
-      (StakePoolMetadataFile In)
-      (Maybe (File () Out))
-  | StakePoolRegistrationCertificateCmd
-      (ShelleyBasedEra era)
-      -- ^ Era in which to register the stake pool.
-      (VerificationKeyOrFile StakePoolKey)
-      -- ^ Stake pool verification key.
-      (VerificationKeyOrFile VrfKey)
-      -- ^ VRF Verification key.
-      Lovelace
-      -- ^ Pool pledge.
-      Lovelace
-      -- ^ Pool cost.
-      Rational
-      -- ^ Pool margin.
-      (VerificationKeyOrFile StakeKey)
-      -- ^ Reward account verification staking key.
-      [VerificationKeyOrFile StakeKey]
-      -- ^ Pool owner verification staking key(s).
-      [StakePoolRelay]
-      -- ^ Stake pool relays.
-      (Maybe StakePoolMetadataReference)
-      -- ^ Stake pool metadata.
-      NetworkId
-      (File () Out)
+  = StakePoolDeregistrationCertificateCmd !(StakePoolDeregistrationCertificateCmdArgs era)
+  | StakePoolIdCmd                        !(StakePoolIdCmdArgs era)
+  | StakePoolMetadataHashCmd              !(StakePoolMetadataHashCmdArgs era)
+  | StakePoolRegistrationCertificateCmd   !(StakePoolRegistrationCertificateCmdArgs era)
+  deriving Show
+
+data StakePoolDeregistrationCertificateCmdArgs era =
+  StakePoolDeregistrationCertificateCmdArgs
+    { sbe                       :: !(ShelleyBasedEra era)
+    , poolVerificationKeyOrFile :: !(VerificationKeyOrFile StakePoolKey)
+    , retireEpoch               :: !EpochNo
+    , outFile                   :: !(File () Out)
+    }
+  deriving Show
+
+data StakePoolIdCmdArgs era =
+  StakePoolIdCmdArgs
+    { poolVerificationKeyOrFile :: !(VerificationKeyOrFile StakePoolKey)
+    , outputFormat              :: !IdOutputFormat
+    , mOutFile                  :: !(Maybe (File () Out))
+    }
+  deriving Show
+
+data StakePoolMetadataHashCmdArgs era =
+  StakePoolMetadataHashCmdArgs
+    { poolMetadataFile  :: !(StakePoolMetadataFile In)
+    , mOutFile          :: !(Maybe (File () Out))
+    }
+  deriving Show
+
+data StakePoolRegistrationCertificateCmdArgs era =
+  StakePoolRegistrationCertificateCmdArgs
+    { sbe                               :: !(ShelleyBasedEra era) -- ^ Era in which to register the stake pool.
+    , poolVerificationKeyOrFile         :: !(VerificationKeyOrFile StakePoolKey) -- ^ Stake pool verification key.
+    , vrfVerificationKeyOrFile          :: !(VerificationKeyOrFile VrfKey) -- ^ VRF Verification key.
+    , poolPledge                        :: !Lovelace -- ^ Pool pledge.
+    , poolCost                          :: !Lovelace -- ^ Pool cost.
+    , poolMargin                        :: !Rational -- ^ Pool margin.
+    , rewardStakeVerificationKeyOrFile  :: !(VerificationKeyOrFile StakeKey) -- ^ Reward account verification staking key.
+    , ownerStakeVerificationKeyOrFiles  :: ![VerificationKeyOrFile StakeKey] -- ^ Pool owner verification staking key(s).
+    , relays                            :: ![StakePoolRelay] -- ^ Stake pool relays.
+    , mMetadata                         :: !(Maybe StakePoolMetadataReference) -- ^ Stake pool metadata.
+    , network                           :: !NetworkId
+    , outFile                           :: !(File () Out)
+    }
   deriving Show
 
 renderStakePoolCmds :: StakePoolCmds era -> Text

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/StakePool.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/StakePool.hs
@@ -3,26 +3,26 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
+{- HLINT ignore "Use <$>" -}
+{- HLINT ignore "Move brackets to avoid $" -}
+
 module Cardano.CLI.EraBased.Options.StakePool
   ( pStakePoolCmds
   ) where
 
 import           Cardano.Api
 
 import           Cardano.CLI.Environment (EnvCli (..))
-import           Cardano.CLI.EraBased.Commands.StakePool
+import qualified Cardano.CLI.EraBased.Commands.StakePool as Cmd
 import           Cardano.CLI.EraBased.Options.Common
 
 import           Options.Applicative hiding (help, str)
 import qualified Options.Applicative as Opt
 
-{- HLINT ignore "Use <$>" -}
-{- HLINT ignore "Move brackets to avoid $" -}
-
 pStakePoolCmds :: ()
   => CardanoEra era
   -> EnvCli
-  -> Maybe (Parser (StakePoolCmds era))
+  -> Maybe (Parser (Cmd.StakePoolCmds era))
 pStakePoolCmds era envCli =
   subInfoParser "stake-pool"
     ( Opt.progDesc
@@ -42,49 +42,60 @@ pStakePoolCmds era envCli =
         $ Opt.progDesc "Print the hash of pool metadata."
     ]
 
-pStakePoolId :: Parser (StakePoolCmds era)
+pStakePoolId :: ()
+  => Parser (Cmd.StakePoolCmds era)
 pStakePoolId =
-  StakePoolIdCmd
-    <$> pStakePoolVerificationKeyOrFile Nothing
-    <*> pPoolIdOutputFormat
-    <*> pMaybeOutputFile
+  fmap Cmd.StakePoolIdCmd $
+    Cmd.StakePoolIdCmdArgs
+      <$> pStakePoolVerificationKeyOrFile Nothing
+      <*> pPoolIdOutputFormat
+      <*> pMaybeOutputFile
 
-pStakePoolMetadataHashCmd :: Parser (StakePoolCmds era)
+pStakePoolMetadataHashCmd :: ()
+  => Parser (Cmd.StakePoolCmds era)
 pStakePoolMetadataHashCmd =
-  StakePoolMetadataHashCmd
-    <$> pPoolMetadataFile
-    <*> pMaybeOutputFile
+  fmap Cmd.StakePoolMetadataHashCmd $
+    Cmd.StakePoolMetadataHashCmdArgs
+      <$> pPoolMetadataFile
+      <*> pMaybeOutputFile
 
-pStakePoolRegistrationCertificateCmd :: CardanoEra era -> EnvCli -> Maybe (Parser (StakePoolCmds era))
+pStakePoolRegistrationCertificateCmd :: ()
+  => CardanoEra era
+  -> EnvCli
+  -> Maybe (Parser (Cmd.StakePoolCmds era))
 pStakePoolRegistrationCertificateCmd era envCli = do
   w <- forEraMaybeEon era
   pure
     $ subParser "registration-certificate"
     $ Opt.info
-        ( StakePoolRegistrationCertificateCmd w
-            <$> pStakePoolVerificationKeyOrFile Nothing
-            <*> pVrfVerificationKeyOrFile
-            <*> pPoolPledge
-            <*> pPoolCost
-            <*> pPoolMargin
-            <*> pRewardAcctVerificationKeyOrFile
-            <*> some pPoolOwnerVerificationKeyOrFile
-            <*> many pPoolRelay
-            <*> pStakePoolMetadataReference
-            <*> pNetworkId envCli
-            <*> pOutputFile
+        ( fmap Cmd.StakePoolRegistrationCertificateCmd $
+            Cmd.StakePoolRegistrationCertificateCmdArgs w
+              <$> pStakePoolVerificationKeyOrFile Nothing
+              <*> pVrfVerificationKeyOrFile
+              <*> pPoolPledge
+              <*> pPoolCost
+              <*> pPoolMargin
+              <*> pRewardAcctVerificationKeyOrFile
+              <*> some pPoolOwnerVerificationKeyOrFile
+              <*> many pPoolRelay
+              <*> pStakePoolMetadataReference
+              <*> pNetworkId envCli
+              <*> pOutputFile
         )
     $ Opt.progDesc "Create a stake pool registration certificate"
 
-pStakePoolDeregistrationCertificateCmd :: CardanoEra era -> Maybe (Parser (StakePoolCmds era))
+pStakePoolDeregistrationCertificateCmd :: ()
+  => CardanoEra era
+  -> Maybe (Parser (Cmd.StakePoolCmds era))
 pStakePoolDeregistrationCertificateCmd era = do
   w <- forEraMaybeEon era
   pure
     $ subParser "deregistration-certificate"
     $ Opt.info
-        ( StakePoolDeregistrationCertificateCmd w
-            <$> pStakePoolVerificationKeyOrFile Nothing
-            <*> pEpochNo "The epoch number."
-            <*> pOutputFile
+        ( fmap Cmd.StakePoolDeregistrationCertificateCmd $
+            Cmd.StakePoolDeregistrationCertificateCmdArgs w
+              <$> pStakePoolVerificationKeyOrFile Nothing
+              <*> pEpochNo "The epoch number."
+              <*> pOutputFile
         )
     $ Opt.progDesc "Create a stake pool deregistration certificate"