Command argument types for poll commands

cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Poll.hs

@@ -1,32 +1,53 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
 
 module Cardano.CLI.EraBased.Commands.Governance.Poll
-  ( GovernancePollCmds(..) , renderGovernancePollCmds) where
+  ( GovernancePollCmds(..)
+  , renderGovernancePollCmds
+
+  , GovernanceCreatePollCmdArgs(..)
+  , GovernanceAnswerPollCmdArgs(..)
+  , GovernanceVerifyPollCmdArgs(..)
+  ) where
 
 import           Cardano.Api
 import           Cardano.Api.Shelley
 
 import           Data.Text (Text)
 
 data GovernancePollCmds era
-  = GovernanceCreatePoll -- ^ Create a SPO poll
-      (BabbageEraOnwards era) {- TODO smelc, use BabbageEraOnly here instead -}
-      Text -- ^ Prompt
-      [Text] -- ^ Choices
-      (Maybe Word) -- ^ Nonce
-      (File GovernancePoll Out)
-  | GovernanceAnswerPoll  -- ^ Answer a SPO poll
-      (BabbageEraOnwards era) {- TODO smelc, use BabbageEraOnly here instead -}
-      (File GovernancePoll In) -- ^ Poll file
-      (Maybe Word) -- ^ Answer index
-      (Maybe (File () Out)) -- ^ Tx file
-  | GovernanceVerifyPoll  -- ^ Verify answer to a given SPO poll
-      (BabbageEraOnwards era) {- TODO smelc, use BabbageEraOnly here instead -}
-      (File GovernancePoll In) -- Poll file
-      (File (Tx ()) In) -- Tx file
-      (Maybe (File () Out)) -- Tx file
+  = GovernanceCreatePoll !(GovernanceCreatePollCmdArgs era)
+  | GovernanceAnswerPoll !(GovernanceAnswerPollCmdArgs era)
+  | GovernanceVerifyPoll !(GovernanceVerifyPollCmdArgs era)
+
+-- | Create a SPO poll
+data GovernanceCreatePollCmdArgs era =
+  GovernanceCreatePollCmdArgs
+    { eon     :: !(BabbageEraOnwards era)
+    , prompt  :: !Text
+    , choices :: ![Text]
+    , nonce   :: !(Maybe Word)
+    , outFile :: !(File GovernancePoll Out)
+    } deriving (Eq, Show)
+
+-- | Answer a SPO poll
+data GovernanceAnswerPollCmdArgs era =
+  GovernanceAnswerPollCmdArgs
+    { eon         :: !(BabbageEraOnwards era)
+    , pollFile    :: !(File GovernancePoll In)
+    , answerIndex :: !(Maybe Word)
+    , mOutFile    :: !(Maybe (File () Out))
+    } deriving (Eq, Show)
 
+-- | Verify answer to a given SPO poll
+data GovernanceVerifyPollCmdArgs era =
+  GovernanceVerifyPollCmdArgs
+    { eon       :: !(BabbageEraOnwards era)
+    , pollFile  :: !(File GovernancePoll In)
+    , txFile    :: !(File (Tx ()) In)
+    , mOutFile  :: !(Maybe (File () Out))
+    } deriving (Eq, Show)
 
 renderGovernancePollCmds :: ()
   => GovernancePollCmds era

cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Poll.hs

@@ -5,7 +5,7 @@ where
 
 import           Cardano.Api
 
-import           Cardano.CLI.EraBased.Commands.Governance.Poll (GovernancePollCmds (..))
+import qualified Cardano.CLI.EraBased.Commands.Governance.Poll as Cmd
 import           Cardano.CLI.EraBased.Options.Common
 import           Cardano.Prelude (catMaybes, isInfixOf)
 
@@ -16,7 +16,7 @@ import qualified Options.Applicative as Opt
 
 pGovernancePollCmds :: ()
   => CardanoEra era
-  -> Maybe (Parser (GovernancePollCmds era))
+  -> Maybe (Parser (Cmd.GovernancePollCmds era))
 pGovernancePollCmds era =
   case parsers of
     [] -> Nothing
@@ -41,33 +41,33 @@ pGovernancePollCmds era =
                 )
         ]
 
-pGovernanceCreatePoll :: CardanoEra era -> Maybe (Parser (GovernancePollCmds era))
+pGovernanceCreatePoll :: CardanoEra era -> Maybe (Parser (Cmd.GovernancePollCmds era))
 pGovernanceCreatePoll era = do
   w <- forEraMaybeEon era
-  when ("BabbageEraOnwardsConway" `isInfixOf` show w) Nothing -- TODO smelc remove this when BabbageEraBabbageOnly is introduced
-  pure $
-    GovernanceCreatePoll w
+  when ("BabbageEraOnwardsConway" `isInfixOf` show w) Nothing
+  pure $ fmap Cmd.GovernanceCreatePoll $
+    Cmd.GovernanceCreatePollCmdArgs w
       <$> pPollQuestion
       <*> some pPollAnswer
       <*> optional pPollNonce
       <*> pOutputFile
 
-pGovernanceAnswerPoll :: CardanoEra era -> Maybe (Parser (GovernancePollCmds era))
+pGovernanceAnswerPoll :: CardanoEra era -> Maybe (Parser (Cmd.GovernancePollCmds era))
 pGovernanceAnswerPoll era = do
   w <- forEraMaybeEon era
-  when ("BabbageEraOnwardsConway" `isInfixOf` show w) Nothing -- TODO smelc remove this when BabbageEraBabbageOnly is introduced
-  pure $
-    GovernanceAnswerPoll w
+  when ("BabbageEraOnwardsConway" `isInfixOf` show w) Nothing
+  pure $ fmap Cmd.GovernanceAnswerPoll $
+    Cmd.GovernanceAnswerPollCmdArgs w
       <$> pPollFile
       <*> optional pPollAnswerIndex
       <*> optional pOutputFile
 
-pGovernanceVerifyPoll :: CardanoEra era -> Maybe (Parser (GovernancePollCmds era))
+pGovernanceVerifyPoll :: CardanoEra era -> Maybe (Parser (Cmd.GovernancePollCmds era))
 pGovernanceVerifyPoll era = do
   w <- forEraMaybeEon era
-  when ("BabbageEraOnwardsConway" `isInfixOf` show w) Nothing -- TODO smelc remove this when BabbageEraBabbageOnly is introduced
-  pure $
-    GovernanceVerifyPoll w
+  when ("BabbageEraOnwardsConway" `isInfixOf` show w) Nothing
+  pure $ fmap Cmd.GovernanceVerifyPoll $
+    Cmd.GovernanceVerifyPollCmdArgs w
       <$> pPollFile
       <*> pPollTxFile
       <*> optional pOutputFile

cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Poll.hs

@@ -1,20 +1,20 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Cardano.CLI.EraBased.Run.Governance.Poll
   ( runGovernancePollCmds,
-    runGovernanceCreatePoll,
-    runGovernanceAnswerPoll,
-    runGovernanceVerifyPoll
+    runGovernanceCreatePollCmd,
+    runGovernanceAnswerPollCmd,
+    runGovernanceVerifyPollCmd
   ) where
 
 import           Cardano.Api
 import           Cardano.Api.Shelley
-import qualified Cardano.Api.Shelley as Api
 
-import           Cardano.CLI.EraBased.Commands.Governance.Poll
+import qualified Cardano.CLI.EraBased.Commands.Governance.Poll as Cmd
 import           Cardano.CLI.Read
 import           Cardano.CLI.Types.Errors.GovernanceCmdError
 
@@ -26,7 +26,6 @@ import           Control.Monad.Trans.Except.Extra
 import qualified Data.ByteString.Char8 as BSC
 import           Data.Function ((&))
 import           Data.String (fromString)
-import           Data.Text (Text)
 import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text
 import qualified Data.Text.IO as Text
@@ -35,23 +34,25 @@ import qualified System.IO as IO
 import           System.IO (stderr, stdin, stdout)
 
 
-runGovernancePollCmds :: GovernancePollCmds era -> ExceptT GovernanceCmdError IO ()
+runGovernancePollCmds :: ()
+  => Cmd.GovernancePollCmds era
+  -> ExceptT GovernanceCmdError IO ()
 runGovernancePollCmds = \case
-  GovernanceCreatePoll w prompt choices nonce out ->
-    runGovernanceCreatePoll w prompt choices nonce out
-  GovernanceAnswerPoll w poll ix mOutFile ->
-    runGovernanceAnswerPoll w poll ix mOutFile
-  GovernanceVerifyPoll w poll metadata mOutFile ->
-    runGovernanceVerifyPoll w poll metadata mOutFile
-
-runGovernanceCreatePoll
-  :: BabbageEraOnwards era
-  -> Text
-  -> [Text]
-  -> Maybe Word
-  -> File GovernancePoll Out
+  Cmd.GovernanceCreatePoll args -> runGovernanceCreatePollCmd args
+  Cmd.GovernanceAnswerPoll args -> runGovernanceAnswerPollCmd args
+  Cmd.GovernanceVerifyPoll args -> runGovernanceVerifyPollCmd args
+
+runGovernanceCreatePollCmd :: ()
+  => Cmd.GovernanceCreatePollCmdArgs era
   -> ExceptT GovernanceCmdError IO ()
-runGovernanceCreatePoll _w govPollQuestion govPollAnswers govPollNonce out = do
+runGovernanceCreatePollCmd
+    Cmd.GovernanceCreatePollCmdArgs
+      { eon     = _eon
+      , prompt  = govPollQuestion
+      , choices = govPollAnswers
+      , nonce   = govPollNonce
+      , outFile = out
+      } = do
   let poll = GovernancePoll{ govPollQuestion, govPollAnswers, govPollNonce }
 
   let description = fromString $ "An on-chain poll for SPOs: " <> Text.unpack govPollQuestion
@@ -79,13 +80,16 @@ runGovernanceCreatePoll _w govPollQuestion govPollAnswers govPollNonce out = do
       , "participants has been generated at '" <> outPath <> "'."
       ]
 
-runGovernanceAnswerPoll
-  :: BabbageEraOnwards era
-  -> File GovernancePoll In
-  -> Maybe Word -- ^ Answer index
-  -> Maybe (File () Out) -- ^ Output file
+runGovernanceAnswerPollCmd :: ()
+  => Cmd.GovernanceAnswerPollCmdArgs era
   -> ExceptT GovernanceCmdError IO ()
-runGovernanceAnswerPoll _ pollFile maybeChoice mOutFile = do
+runGovernanceAnswerPollCmd
+    Cmd.GovernanceAnswerPollCmdArgs
+      { eon         = _eon
+      , pollFile    = pollFile
+      , answerIndex = maybeChoice
+      , mOutFile    = mOutFile
+       } = do
   poll <- firstExceptT GovernanceCmdTextEnvReadError . newExceptT $
     readFileTextEnvelope AsGovernancePoll pollFile
 
@@ -151,13 +155,16 @@ runGovernanceAnswerPoll _ pollFile maybeChoice mOutFile = do
       _ ->
         left GovernanceCmdPollInvalidChoice
 
-runGovernanceVerifyPoll
-  :: BabbageEraOnwards era
-  -> File GovernancePoll In
-  -> File (Api.Tx ()) In
-  -> Maybe (File () Out) -- ^ Output file
+runGovernanceVerifyPollCmd :: ()
+  => Cmd.GovernanceVerifyPollCmdArgs era
   -> ExceptT GovernanceCmdError IO ()
-runGovernanceVerifyPoll _ pollFile txFile mOutFile = do
+runGovernanceVerifyPollCmd
+    Cmd.GovernanceVerifyPollCmdArgs
+      { eon       = _eon
+      , pollFile  = pollFile
+      , txFile    = txFile
+      , mOutFile  = mOutFile
+      } = do
   poll <- firstExceptT GovernanceCmdTextEnvReadError . newExceptT $
     readFileTextEnvelope AsGovernancePoll pollFile
 

cardano-cli/src/Cardano/CLI/Legacy/Run/Governance.hs

@@ -1,6 +1,8 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Cardano.CLI.Legacy.Run.Governance
@@ -11,6 +13,7 @@ import           Cardano.Api
 import qualified Cardano.Api.Ledger as Ledger
 import           Cardano.Api.Shelley
 
+import qualified Cardano.CLI.EraBased.Commands.Governance.Poll as Cmd
 import           Cardano.CLI.EraBased.Run.Governance
 import           Cardano.CLI.EraBased.Run.Governance.GenesisKeyDelegationCertificate
                    (runGovernanceGenesisKeyDelegationCertificate)
@@ -25,6 +28,7 @@ import           Control.Monad.Trans.Except.Extra
 import           Data.Aeson (eitherDecode)
 import qualified Data.ByteString.Lazy as LB
 import           Data.Function ((&))
+import           Data.Text (Text)
 import qualified Data.Text as Text
 
 runLegacyGovernanceCmds :: LegacyGovernanceCmds -> ExceptT GovernanceCmdError IO ()
@@ -38,12 +42,55 @@ runLegacyGovernanceCmds = \case
   GovernanceUpdateProposal out eNo genVKeys ppUp mCostModelFp ->
     runLegacyGovernanceUpdateProposal out eNo genVKeys ppUp mCostModelFp
   GovernanceCreatePoll prompt choices nonce out ->
-    runGovernanceCreatePoll BabbageEraOnwardsBabbage  prompt choices nonce out
+    runLegacyGovernanceCreatePoll prompt choices nonce out
   GovernanceAnswerPoll poll ix mOutFile ->
-    runGovernanceAnswerPoll BabbageEraOnwardsBabbage poll ix mOutFile
+    runLegacyGovernanceAnswerPoll poll ix mOutFile
   GovernanceVerifyPoll poll metadata mOutFile ->
-    runGovernanceVerifyPoll BabbageEraOnwardsBabbage poll metadata mOutFile
+    runLegacyGovernanceVerifyPoll poll metadata mOutFile
 
+runLegacyGovernanceCreatePoll :: ()
+  => Text
+  -> [Text]
+  -> Maybe Word
+  -> File GovernancePoll Out
+  -> ExceptT GovernanceCmdError IO ()
+runLegacyGovernanceCreatePoll prompt choices nonce outFile =
+  runGovernanceCreatePollCmd
+    Cmd.GovernanceCreatePollCmdArgs
+      { eon     = BabbageEraOnwardsBabbage
+      , prompt
+      , choices
+      , nonce
+      , outFile
+      }
+
+runLegacyGovernanceAnswerPoll :: ()
+  => File GovernancePoll In
+  -> Maybe Word
+  -> Maybe (File () Out)
+  -> ExceptT GovernanceCmdError IO ()
+runLegacyGovernanceAnswerPoll pollFile answerIndex mOutFile =
+  runGovernanceAnswerPollCmd
+    Cmd.GovernanceAnswerPollCmdArgs
+      { eon         = BabbageEraOnwardsBabbage
+      , pollFile
+      , answerIndex
+      , mOutFile
+      }
+
+runLegacyGovernanceVerifyPoll :: ()
+  => File GovernancePoll In
+  -> File (Tx ()) In
+  -> Maybe (File () Out)
+  -> ExceptT GovernanceCmdError IO ()
+runLegacyGovernanceVerifyPoll pollFile txFile mOutFile =
+  runGovernanceVerifyPollCmd
+    Cmd.GovernanceVerifyPollCmdArgs
+      { eon       = BabbageEraOnwardsBabbage
+      , pollFile
+      , txFile
+      , mOutFile
+      }
 
 runLegacyGovernanceMIRCertificatePayStakeAddrs
   :: EraInEon ShelleyToBabbageEra