Modify run commands to take command value and use named record puns

IntersectMBO · Oct 21, 2023 · f839e0f · f839e0f
1 parent eb9421a
commit f839e0f
Showing 1 changed file with 39 additions and 25 deletions.
diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Vote.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Vote.hs
@@ -1,6 +1,8 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
@@ -32,74 +34,86 @@ runGovernanceVoteCmds :: ()
   => Cmd.GovernanceVoteCmds era
   -> ExceptT CmdError IO ()
 runGovernanceVoteCmds = \case
-  Cmd.GovernanceVoteCreateCmd anyVote ->
-    runGovernanceVoteCreateCmd anyVote
+  Cmd.GovernanceVoteCreateCmd args ->
+    runGovernanceVoteCreateCmd args
       & firstExceptT CmdGovernanceVoteError
-  Cmd.GovernanceVoteViewCmd (Cmd.GovernanceVoteViewCmdArgs w printYaml voteFile mOutFile) ->
-    runGovernanceVoteViewCmd w printYaml voteFile mOutFile
+  Cmd.GovernanceVoteViewCmd args ->
+    runGovernanceVoteViewCmd args
       & firstExceptT CmdGovernanceVoteError
 
 runGovernanceVoteCreateCmd :: ()
   => Cmd.GovernanceVoteCreateCmdArgs era
   -> ExceptT GovernanceVoteCmdError IO ()
-runGovernanceVoteCreateCmd (Cmd.GovernanceVoteCreateCmdArgs cOnwards voteChoice (govActionTxId, govActionIndex) voteStakeCred mAnchor oFp)  = do
-  let sbe = conwayEraOnwardsToShelleyBasedEra cOnwards -- TODO: Conway era - update vote creation related function to take ConwayEraOnwards
+runGovernanceVoteCreateCmd
+    Cmd.GovernanceVoteCreateCmdArgs
+      { eon
+      , voteChoice
+      , governanceAction
+      , votingStakeCredentialSource
+      , mAnchor
+      , outFile
+      } = do
+  let (govActionTxId, govActionIndex) = governanceAction
+  let sbe = conwayEraOnwardsToShelleyBasedEra eon -- TODO: Conway era - update vote creation related function to take ConwayEraOnwards
   voteProcedure <- case mAnchor of
-     Nothing -> pure $ createVotingProcedure cOnwards voteChoice Nothing
+     Nothing -> pure $ createVotingProcedure eon voteChoice Nothing
      Just (VoteUrl url, voteHashSource) -> shelleyBasedEraConstraints sbe $ do
        voteHash <- firstExceptT GovernanceVoteCmdReadVoteTextError $ readVoteHashSource voteHashSource
        let voteAnchor = Ledger.Anchor { Ledger.anchorUrl = url, Ledger.anchorDataHash = voteHash }
-           VotingProcedure votingProcedureWithoutAnchor = createVotingProcedure cOnwards voteChoice Nothing
+           VotingProcedure votingProcedureWithoutAnchor = createVotingProcedure eon voteChoice Nothing
            votingProcedureWithAnchor = VotingProcedure $ votingProcedureWithoutAnchor { Ledger.vProcAnchor = Ledger.SJust voteAnchor }
        return votingProcedureWithAnchor
 
   shelleyBasedEraConstraints sbe $ do
-    case voteStakeCred of
+    case votingStakeCredentialSource of
       AnyDRepVerificationKeyOrHashOrFile stake -> do
         DRepKeyHash h <- firstExceptT  GovernanceVoteCmdReadVerificationKeyError
                                 . newExceptT $ readVerificationKeyOrHashOrTextEnvFile AsDRepKey stake
         let vStakeCred = StakeCredentialByKey . StakeKeyHash $ coerceKeyRole h
 
-        votingCred <- hoistEither $ first GovernanceVoteCmdCredentialDecodeError $ toVotingCredential cOnwards vStakeCred
+        votingCred <- hoistEither $ first GovernanceVoteCmdCredentialDecodeError $ toVotingCredential eon vStakeCred
         let voter = Ledger.DRepVoter (unVotingCredential votingCred)
             govActIdentifier = createGovernanceActionId govActionTxId govActionIndex
-            votingProcedures = singletonVotingProcedures cOnwards voter govActIdentifier (unVotingProcedure voteProcedure)
-        firstExceptT GovernanceVoteCmdWriteError . newExceptT $ writeFileTextEnvelope oFp Nothing votingProcedures
+            votingProcedures = singletonVotingProcedures eon voter govActIdentifier (unVotingProcedure voteProcedure)
+        firstExceptT GovernanceVoteCmdWriteError . newExceptT $ writeFileTextEnvelope outFile Nothing votingProcedures
 
       AnyStakePoolVerificationKeyOrHashOrFile stake -> do
         h <- firstExceptT GovernanceVoteCmdReadVerificationKeyError
               . newExceptT $ readVerificationKeyOrHashOrTextEnvFile AsStakePoolKey stake
 
         let voter = Ledger.StakePoolVoter (unStakePoolKeyHash h)
             govActIdentifier = createGovernanceActionId govActionTxId govActionIndex
-            votingProcedures = singletonVotingProcedures cOnwards voter govActIdentifier (unVotingProcedure voteProcedure)
-        firstExceptT GovernanceVoteCmdWriteError . newExceptT $ writeFileTextEnvelope oFp Nothing votingProcedures
+            votingProcedures = singletonVotingProcedures eon voter govActIdentifier (unVotingProcedure voteProcedure)
+        firstExceptT GovernanceVoteCmdWriteError . newExceptT $ writeFileTextEnvelope outFile Nothing votingProcedures
 
       AnyCommitteeHotVerificationKeyOrHashOrFile stake -> do
         CommitteeHotKeyHash h <- firstExceptT GovernanceVoteCmdReadVerificationKeyError
                                   . newExceptT $ readVerificationKeyOrHashOrTextEnvFile AsCommitteeHotKey stake
         let vStakeCred = StakeCredentialByKey . StakeKeyHash $ coerceKeyRole h
-        votingCred <- hoistEither $ first GovernanceVoteCmdCredentialDecodeError $ toVotingCredential cOnwards vStakeCred
+        votingCred <- hoistEither $ first GovernanceVoteCmdCredentialDecodeError $ toVotingCredential eon vStakeCred
         let voter = Ledger.CommitteeVoter (Ledger.coerceKeyRole (unVotingCredential votingCred)) -- TODO Conway - remove coerceKeyRole
             govActIdentifier = createGovernanceActionId govActionTxId govActionIndex
-            votingProcedures = singletonVotingProcedures cOnwards voter govActIdentifier (unVotingProcedure voteProcedure)
-        firstExceptT GovernanceVoteCmdWriteError . newExceptT $ writeFileTextEnvelope oFp Nothing votingProcedures
+            votingProcedures = singletonVotingProcedures eon voter govActIdentifier (unVotingProcedure voteProcedure)
+        firstExceptT GovernanceVoteCmdWriteError . newExceptT $ writeFileTextEnvelope outFile Nothing votingProcedures
 
 runGovernanceVoteViewCmd :: ()
-  => ConwayEraOnwards era
-  -> Bool
-  -> VoteFile In
-  -> Maybe (File () Out)
+  => Cmd.GovernanceVoteViewCmdArgs era
   -> ExceptT GovernanceVoteCmdError IO ()
-runGovernanceVoteViewCmd w outputYaml fp mOutFile = do
-  let sbe = conwayEraOnwardsToShelleyBasedEra w
+runGovernanceVoteViewCmd
+    Cmd.GovernanceVoteViewCmdArgs
+      { eon
+      , yamlOutput
+      , voteFile
+      , mOutFile
+      } = do
+  let sbe = conwayEraOnwardsToShelleyBasedEra eon
 
   shelleyBasedEraConstraints sbe $ do
     voteProcedures <- firstExceptT GovernanceVoteCmdReadVoteFileError . newExceptT $
-     readVotingProceduresFile w fp
+     readVotingProceduresFile eon voteFile
     firstExceptT GovernanceVoteCmdWriteError .
       newExceptT .
-      (if outputYaml
+      (if yamlOutput
       then writeByteStringOutput mOutFile . Yaml.encodePretty (Yaml.setConfCompare compare Yaml.defConfig)
       else writeLazyByteStringOutput mOutFile . encodePretty' (defConfig {confCompare = compare})) .
       unVotingProcedures $