Skip to content

Commit

Permalink
Command types for drep commands
Browse files Browse the repository at this point in the history
  • Loading branch information
newhoggy committed Nov 2, 2023
1 parent 3cb4c09 commit 1eebb16
Show file tree
Hide file tree
Showing 4 changed files with 151 additions and 106 deletions.
79 changes: 53 additions & 26 deletions cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/DRep.hs
Original file line number Diff line number Diff line change
@@ -1,9 +1,16 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}

module Cardano.CLI.EraBased.Commands.Governance.DRep
( GovernanceDRepCmds (..),
renderGovernanceDRepCmds,
( GovernanceDRepCmds (..)
, renderGovernanceDRepCmds

, GovernanceDRepKeyGenCmdArgs(..)
, GovernanceDRepIdCmdArgs(..)
, GovernanceDRepRegistrationCertificateCmdArgs(..)
, GovernanceDRepRetirementCertificateCmdArgs(..)
, GovernanceDRepMetadataHashCmdArgs(..)
)
where

Expand All @@ -17,30 +24,50 @@ import Cardano.CLI.Types.Key
import Data.Text (Text)

data GovernanceDRepCmds era
= GovernanceDRepKeyGenCmd
(ConwayEraOnwards era)
(File (VerificationKey ()) Out)
(File (SigningKey ()) Out)
| GovernanceDRepIdCmd
(ConwayEraOnwards era)
(VerificationKeyOrFile DRepKey)
IdOutputFormat
(Maybe (File () Out))
| GovernanceDRepRegistrationCertificateCmd
(ConwayEraOnwards era)
(VerificationKeyOrHashOrFile DRepKey)
Lovelace
(Maybe (Ledger.Anchor (Ledger.EraCrypto (ShelleyLedgerEra era))))
(File () Out)
| GovernanceDRepRetirementCertificateCmd
(ConwayEraOnwards era)
(VerificationKeyOrHashOrFile DRepKey)
Lovelace
(File () Out)
| GovernanceDRepMetadataHashCmd
(ConwayEraOnwards era)
(DRepMetadataFile In)
(Maybe (File () Out))
= GovernanceDRepKeyGenCmd !(GovernanceDRepKeyGenCmdArgs era)
| GovernanceDRepIdCmd !(GovernanceDRepIdCmdArgs era)
| GovernanceDRepRegistrationCertificateCmd !(GovernanceDRepRegistrationCertificateCmdArgs era)
| GovernanceDRepRetirementCertificateCmd !(GovernanceDRepRetirementCertificateCmdArgs era)
| GovernanceDRepMetadataHashCmd !(GovernanceDRepMetadataHashCmdArgs era)

data GovernanceDRepKeyGenCmdArgs era =
GovernanceDRepKeyGenCmdArgs
{ eon :: !(ConwayEraOnwards era)
, vkeyFile :: !(File (VerificationKey ()) Out)
, skeyFile :: !(File (SigningKey ()) Out)
}

data GovernanceDRepIdCmdArgs era =
GovernanceDRepIdCmdArgs
{ eon :: !(ConwayEraOnwards era)
, vkeySource :: !(VerificationKeyOrFile DRepKey)
, idOutputFormat :: !IdOutputFormat
, mOutFile :: !(Maybe (File () Out))
}

data GovernanceDRepRegistrationCertificateCmdArgs era =
GovernanceDRepRegistrationCertificateCmdArgs
{ eon :: !(ConwayEraOnwards era)
, drepVkeyHashSource :: !(VerificationKeyOrHashOrFile DRepKey)
, deposit :: !Lovelace
, mAnchor :: !(Maybe (Ledger.Anchor (Ledger.EraCrypto (ShelleyLedgerEra era))))
, outFile :: !(File () Out)
}

data GovernanceDRepRetirementCertificateCmdArgs era =
GovernanceDRepRetirementCertificateCmdArgs
{ eon :: !(ConwayEraOnwards era)
, vkeyHashSource :: !(VerificationKeyOrHashOrFile DRepKey)
, deposit :: !Lovelace
, outFile :: !(File () Out)
}

data GovernanceDRepMetadataHashCmdArgs era =
GovernanceDRepMetadataHashCmdArgs
{ eon :: !(ConwayEraOnwards era)
, metadataFile :: !(DRepMetadataFile In)
, mOutFile :: !(Maybe (File () Out))
}

renderGovernanceDRepCmds :: ()
=> GovernanceDRepCmds era
Expand Down
38 changes: 22 additions & 16 deletions cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/DRep.hs
Original file line number Diff line number Diff line change
Expand Up @@ -52,9 +52,10 @@ pGovernanceDRepKeyGenCmd era = do
pure
$ subParser "key-gen"
$ Opt.info
( GovernanceDRepKeyGenCmd w
<$> pVerificationKeyFileOut
<*> pSigningKeyFileOut
( fmap GovernanceDRepKeyGenCmd $
GovernanceDRepKeyGenCmdArgs w
<$> pVerificationKeyFileOut
<*> pSigningKeyFileOut
)
$ Opt.progDesc "Generate Delegate Representative verification and signing keys."

Expand All @@ -66,10 +67,11 @@ pGovernanceDRepKeyIdCmd era = do
pure
$ subParser "id"
$ Opt.info
( GovernanceDRepIdCmd w
<$> pDRepVerificationKeyOrFile
<*> pDRepIdOutputFormat
<*> optional pOutputFile
( fmap GovernanceDRepIdCmd $
GovernanceDRepIdCmdArgs w
<$> pDRepVerificationKeyOrFile
<*> pDRepIdOutputFormat
<*> optional pOutputFile
)
$ Opt.progDesc "Generate a drep id."

Expand Down Expand Up @@ -97,7 +99,9 @@ pRegistrationCertificateCmd era = do
$ Opt.info (conwayEraOnwardsConstraints w $ mkParser w)
$ Opt.progDesc "Create a registration certificate."
where
mkParser w = GovernanceDRepRegistrationCertificateCmd w
mkParser w =
fmap GovernanceDRepRegistrationCertificateCmd $
GovernanceDRepRegistrationCertificateCmdArgs w
<$> pDRepVerificationKeyOrHashOrFile
<*> pKeyRegistDeposit
<*> pDRepMetadata
Expand Down Expand Up @@ -131,10 +135,11 @@ pRetirementCertificateCmd era = do
pure
$ subParser "retirement-certificate"
$ Opt.info
( GovernanceDRepRetirementCertificateCmd w
<$> pDRepVerificationKeyOrHashOrFile
<*> pDrepDeposit
<*> pOutputFile
( fmap GovernanceDRepRetirementCertificateCmd $
GovernanceDRepRetirementCertificateCmdArgs w
<$> pDRepVerificationKeyOrHashOrFile
<*> pDrepDeposit
<*> pOutputFile
)
$ Opt.progDesc "Create a DRep retirement certificate."

Expand All @@ -146,10 +151,11 @@ pGovernanceDrepMetadataHashCmd era = do
pure
$ subParser "metadata-hash"
$ Opt.info
( GovernanceDRepMetadataHashCmd w
<$> pFileInDirection "drep-metadata-file" "JSON Metadata file to hash."
<*> pMaybeOutputFile
)
( fmap GovernanceDRepMetadataHashCmd $
GovernanceDRepMetadataHashCmdArgs w
<$> pFileInDirection "drep-metadata-file" "JSON Metadata file to hash."
<*> pMaybeOutputFile
)
$ Opt.progDesc "Calculate the hash of a metadata file."

--------------------------------------------------------------------------------
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -45,8 +45,7 @@ runGovernanceCommitteeKeyGenCold :: ()
-> ExceptT GovernanceCommitteeError IO ()
runGovernanceCommitteeKeyGenCold
Cmd.GovernanceCommitteeKeyGenColdCmdArgs
{ Cmd.eon = _eon
, Cmd.vkeyOutFile = vkeyPath
{ Cmd.vkeyOutFile = vkeyPath
, Cmd.skeyOutFile = skeyPath
} = do
skey <- liftIO $ generateSigningKey AsCommitteeColdKey
Expand Down Expand Up @@ -105,8 +104,7 @@ runGovernanceCommitteeKeyHash :: ()
-> ExceptT GovernanceCommitteeError IO ()
runGovernanceCommitteeKeyHash
Cmd.GovernanceCommitteeKeyHashCmdArgs
{ Cmd.eon = _w
, Cmd.vkeySource
{ Cmd.vkeySource
} = do
vkey <-
case vkeySource of
Expand Down
134 changes: 74 additions & 60 deletions cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/DRep.hs
Original file line number Diff line number Diff line change
@@ -1,6 +1,8 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
Expand All @@ -16,7 +18,7 @@ import Cardano.Api.Ledger (Credential (KeyHashObj))
import qualified Cardano.Api.Ledger as Ledger
import Cardano.Api.Shelley

import Cardano.CLI.EraBased.Commands.Governance.DRep
import qualified Cardano.CLI.EraBased.Commands.Governance.DRep as Cmd
import qualified Cardano.CLI.EraBased.Run.Key as Key
import Cardano.CLI.Types.Common
import Cardano.CLI.Types.Errors.CmdError
Expand All @@ -32,53 +34,56 @@ import Data.Function
import qualified Data.Text.Encoding as Text

runGovernanceDRepCmds :: ()
=> GovernanceDRepCmds era
=> Cmd.GovernanceDRepCmds era
-> ExceptT CmdError IO ()
runGovernanceDRepCmds = \case
GovernanceDRepKeyGenCmd w vrf sgn ->
runGovernanceDRepKeyGenCmd w vrf sgn
Cmd.GovernanceDRepKeyGenCmd args ->
runGovernanceDRepKeyGenCmd args
& firstExceptT CmdGovernanceCmdError

GovernanceDRepIdCmd w vkey idOutputFormat mOutFp ->
runGovernanceDRepIdCmd w vkey idOutputFormat mOutFp
Cmd.GovernanceDRepIdCmd args ->
runGovernanceDRepIdCmd args
& firstExceptT CmdGovernanceCmdError

GovernanceDRepRegistrationCertificateCmd w vkey lovelace anchor outFp ->
conwayEraOnwardsConstraints w $ do
runGovernanceDRepRegistrationCertificateCmd w vkey lovelace anchor outFp
& firstExceptT CmdRegistrationError
Cmd.GovernanceDRepRegistrationCertificateCmd args ->
runGovernanceDRepRegistrationCertificateCmd args
& firstExceptT CmdRegistrationError

GovernanceDRepRetirementCertificateCmd w vkeyOrHashOrFile deposit outFp ->
runGovernanceDRepRetirementCertificateCmd w vkeyOrHashOrFile deposit outFp
Cmd.GovernanceDRepRetirementCertificateCmd args ->
runGovernanceDRepRetirementCertificateCmd args
& firstExceptT CmdGovernanceCmdError

GovernanceDRepMetadataHashCmd _ inFp mOutFp ->
runGovernanceDRepMetadataHashCmd inFp mOutFp
Cmd.GovernanceDRepMetadataHashCmd args ->
runGovernanceDRepMetadataHashCmd args
& firstExceptT CmdGovernanceCmdError

runGovernanceDRepKeyGenCmd :: ()
=> ConwayEraOnwards era
-> VerificationKeyFile Out
-> SigningKeyFile Out
=> Cmd.GovernanceDRepKeyGenCmdArgs era
-> ExceptT GovernanceCmdError IO ()
runGovernanceDRepKeyGenCmd _w vkeyPath skeyPath = firstExceptT GovernanceCmdWriteFileError $ do
runGovernanceDRepKeyGenCmd
Cmd.GovernanceDRepKeyGenCmdArgs
{ vkeyFile
, skeyFile
} = firstExceptT GovernanceCmdWriteFileError $ do
skey <- liftIO $ generateSigningKey AsDRepKey
let vkey = getVerificationKey skey
newExceptT $ writeLazyByteStringFile skeyPath (textEnvelopeToJSON (Just skeyDesc) skey)
newExceptT $ writeLazyByteStringFile vkeyPath (textEnvelopeToJSON (Just Key.drepKeyEnvelopeDescr) vkey)
newExceptT $ writeLazyByteStringFile skeyFile (textEnvelopeToJSON (Just skeyDesc) skey)
newExceptT $ writeLazyByteStringFile vkeyFile (textEnvelopeToJSON (Just Key.drepKeyEnvelopeDescr) vkey)
where
skeyDesc :: TextEnvelopeDescr
skeyDesc = "Delegate Representative Signing Key"

runGovernanceDRepIdCmd :: ()
=> ConwayEraOnwards era
-> VerificationKeyOrFile DRepKey
-> IdOutputFormat
-> Maybe (File () Out)
=> Cmd.GovernanceDRepIdCmdArgs era
-> ExceptT GovernanceCmdError IO ()
runGovernanceDRepIdCmd _ vkOrFp idOutputFormat mOutFile = do
runGovernanceDRepIdCmd
Cmd.GovernanceDRepIdCmdArgs
{ vkeySource
, idOutputFormat
, mOutFile
} = do
drepVerKey <-
lift (readVerificationKeyOrTextEnvFile AsDRepKey vkOrFp)
lift (readVerificationKeyOrTextEnvFile AsDRepKey vkeySource)
& onLeft (left . ReadFileError)

content <-
Expand All @@ -94,40 +99,46 @@ runGovernanceDRepIdCmd _ vkOrFp idOutputFormat mOutFile = do
-- Registration Certificate related

runGovernanceDRepRegistrationCertificateCmd :: ()
=> ConwayEraOnwards era
-> VerificationKeyOrHashOrFile DRepKey
-> Lovelace
-> Maybe (Ledger.Anchor (Ledger.EraCrypto (ShelleyLedgerEra era)))
-> File () Out
=> Cmd.GovernanceDRepRegistrationCertificateCmdArgs era
-> ExceptT RegistrationError IO ()
runGovernanceDRepRegistrationCertificateCmd cOnwards drepKOrHOrF deposit anchor outfp = do
DRepKeyHash drepKeyHash <- firstExceptT RegistrationReadError
. newExceptT
$ readVerificationKeyOrHashOrFile AsDRepKey drepKOrHOrF
let drepCred = Ledger.KeyHashObj $ conwayEraOnwardsConstraints cOnwards drepKeyHash
votingCredential = VotingCredential drepCred
req = DRepRegistrationRequirements cOnwards votingCredential deposit
registrationCert = makeDrepRegistrationCertificate req anchor
description = Just @TextEnvelopeDescr "DRep Key Registration Certificate"

firstExceptT RegistrationWriteFileError
. newExceptT
. writeLazyByteStringFile outfp
$ conwayEraOnwardsConstraints cOnwards
$ textEnvelopeToJSON description registrationCert
runGovernanceDRepRegistrationCertificateCmd
Cmd.GovernanceDRepRegistrationCertificateCmdArgs
{ eon = w
, drepVkeyHashSource
, deposit
, mAnchor
, outFile
} = do
DRepKeyHash drepKeyHash <- firstExceptT RegistrationReadError
. newExceptT
$ readVerificationKeyOrHashOrFile AsDRepKey drepVkeyHashSource
let drepCred = Ledger.KeyHashObj $ conwayEraOnwardsConstraints w drepKeyHash
votingCredential = VotingCredential drepCred
req = DRepRegistrationRequirements w votingCredential deposit
registrationCert = makeDrepRegistrationCertificate req mAnchor
description = Just @TextEnvelopeDescr "DRep Key Registration Certificate"

firstExceptT RegistrationWriteFileError
. newExceptT
. writeLazyByteStringFile outFile
$ conwayEraOnwardsConstraints w
$ textEnvelopeToJSON description registrationCert

runGovernanceDRepRetirementCertificateCmd :: ()
=> ConwayEraOnwards era
-> VerificationKeyOrHashOrFile DRepKey
-> Lovelace
-> File () 'Out
=> Cmd.GovernanceDRepRetirementCertificateCmdArgs era
-> ExceptT GovernanceCmdError IO ()
runGovernanceDRepRetirementCertificateCmd w vKeyOrHashOrFile deposit outFile =
conwayEraOnwardsConstraints w $ do
DRepKeyHash drepKeyHash <- firstExceptT GovernanceCmdKeyReadError
. newExceptT
$ readVerificationKeyOrHashOrFile AsDRepKey vKeyOrHashOrFile
makeDrepUnregistrationCertificate (DRepUnregistrationRequirements w (VotingCredential $ KeyHashObj drepKeyHash) deposit)
runGovernanceDRepRetirementCertificateCmd
Cmd.GovernanceDRepRetirementCertificateCmdArgs
{ eon = w
, vkeyHashSource
, deposit
, outFile
} =
conwayEraOnwardsConstraints w $ do
DRepKeyHash drepKeyHash <- firstExceptT GovernanceCmdKeyReadError
. newExceptT
$ readVerificationKeyOrHashOrFile AsDRepKey vkeyHashSource
makeDrepUnregistrationCertificate (DRepUnregistrationRequirements w (VotingCredential $ KeyHashObj drepKeyHash) deposit)
& writeFileTextEnvelope outFile (Just genKeyDelegCertDesc)
& firstExceptT GovernanceCmdTextEnvWriteError . newExceptT

Expand All @@ -136,11 +147,14 @@ runGovernanceDRepRetirementCertificateCmd w vKeyOrHashOrFile deposit outFile =
genKeyDelegCertDesc = "DRep Retirement Certificate"

runGovernanceDRepMetadataHashCmd :: ()
=> DRepMetadataFile In
-> Maybe (File () Out)
=> Cmd.GovernanceDRepMetadataHashCmdArgs era
-> ExceptT GovernanceCmdError IO ()
runGovernanceDRepMetadataHashCmd drepMDPath mOutFile = do
metadataBytes <- firstExceptT ReadFileError $ newExceptT (readByteStringFile drepMDPath)
runGovernanceDRepMetadataHashCmd
Cmd.GovernanceDRepMetadataHashCmdArgs
{ metadataFile
, mOutFile
} = do
metadataBytes <- firstExceptT ReadFileError $ newExceptT (readByteStringFile metadataFile)
(_metadata, metadataHash) <-
firstExceptT GovernanceCmdDRepMetadataValidationError
. hoistEither
Expand Down

0 comments on commit 1eebb16

Please sign in to comment.