From f839e0f946a9d6e760c1fcd27f2019233ae6a8e6 Mon Sep 17 00:00:00 2001 From: John Ky Date: Sat, 21 Oct 2023 18:18:02 +1100 Subject: [PATCH] Modify run commands to take command value and use named record puns --- .../CLI/EraBased/Run/Governance/Vote.hs | 64 +++++++++++-------- 1 file changed, 39 insertions(+), 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 index 3580d4e3bd..aae3fb6372 100644 --- 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,39 +34,48 @@ 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 @@ -72,34 +83,37 @@ runGovernanceVoteCreateCmd (Cmd.GovernanceVoteCreateCmdArgs cOnwards voteChoice 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 $