-
Notifications
You must be signed in to change notification settings - Fork 721
/
Governance.hs
153 lines (133 loc) · 6.46 KB
/
Governance.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
module Cardano.CLI.Shelley.Run.Governance
( ShelleyGovernanceCmdError
, renderShelleyGovernanceError
, runGovernanceCmd
) where
import Cardano.Prelude
import qualified Data.Text as Text
import Control.Monad.Trans.Except.Extra (firstExceptT, left, newExceptT)
import Cardano.Api
import Cardano.Api.Shelley
import Cardano.CLI.Shelley.Key (InputDecodeError, VerificationKeyOrHashOrFile,
readVerificationKeyOrHashOrFile, readVerificationKeyOrHashOrTextEnvFile)
import Cardano.CLI.Shelley.Parsers
import Cardano.CLI.Types
import qualified Cardano.Ledger.Shelley.TxBody as Shelley
data ShelleyGovernanceCmdError
= ShelleyGovernanceCmdTextEnvReadError !(FileError TextEnvelopeError)
| ShelleyGovernanceCmdKeyReadError !(FileError InputDecodeError)
| ShelleyGovernanceCmdTextEnvWriteError !(FileError ())
| ShelleyGovernanceCmdEmptyUpdateProposalError
| ShelleyGovernanceCmdMIRCertificateKeyRewardMistmach
!FilePath
!Int
-- ^ Number of stake verification keys
!Int
-- ^ Number of reward amounts
deriving Show
renderShelleyGovernanceError :: ShelleyGovernanceCmdError -> Text
renderShelleyGovernanceError err =
case err of
ShelleyGovernanceCmdTextEnvReadError fileErr -> Text.pack (displayError fileErr)
ShelleyGovernanceCmdKeyReadError fileErr -> Text.pack (displayError fileErr)
ShelleyGovernanceCmdTextEnvWriteError fileErr -> Text.pack (displayError fileErr)
-- TODO: The equality check is still not working for empty update proposals.
ShelleyGovernanceCmdEmptyUpdateProposalError ->
"Empty update proposals are not allowed"
ShelleyGovernanceCmdMIRCertificateKeyRewardMistmach fp numVKeys numRwdAmts ->
"Error creating the MIR certificate at: " <> textShow fp
<> " The number of staking keys: " <> textShow numVKeys
<> " and the number of reward amounts: " <> textShow numRwdAmts
<> " are not equivalent."
where
textShow x = Text.pack (show x)
runGovernanceCmd :: GovernanceCmd -> ExceptT ShelleyGovernanceCmdError IO ()
runGovernanceCmd (GovernanceMIRPayStakeAddressesCertificate mirpot vKeys rewards out) =
runGovernanceMIRCertificatePayStakeAddrs mirpot vKeys rewards out
runGovernanceCmd (GovernanceMIRTransfer amt out direction) =
runGovernanceMIRCertificateTransfer amt out direction
runGovernanceCmd (GovernanceGenesisKeyDelegationCertificate genVk genDelegVk vrfVk out) =
runGovernanceGenesisKeyDelegationCertificate genVk genDelegVk vrfVk out
runGovernanceCmd (GovernanceUpdateProposal out eNo genVKeys ppUp) =
runGovernanceUpdateProposal out eNo genVKeys ppUp
runGovernanceMIRCertificatePayStakeAddrs
:: Shelley.MIRPot
-> [StakeAddress] -- ^ Stake addresses
-> [Lovelace] -- ^ Corresponding reward amounts (same length)
-> OutputFile
-> ExceptT ShelleyGovernanceCmdError IO ()
runGovernanceMIRCertificatePayStakeAddrs mirPot sAddrs rwdAmts (OutputFile oFp) = do
unless (length sAddrs == length rwdAmts) $
left $ ShelleyGovernanceCmdMIRCertificateKeyRewardMistmach
oFp (length sAddrs) (length rwdAmts)
let sCreds = map stakeAddressCredential sAddrs
mirCert = makeMIRCertificate mirPot (StakeAddressesMIR $ zip sCreds rwdAmts)
firstExceptT ShelleyGovernanceCmdTextEnvWriteError
. newExceptT
$ writeFileTextEnvelope oFp (Just mirCertDesc) mirCert
where
mirCertDesc :: TextEnvelopeDescr
mirCertDesc = "Move Instantaneous Rewards Certificate"
runGovernanceMIRCertificateTransfer
:: Lovelace
-> OutputFile
-> TransferDirection
-> ExceptT ShelleyGovernanceCmdError IO ()
runGovernanceMIRCertificateTransfer ll (OutputFile oFp) direction = do
mirCert <- case direction of
TransferToReserves ->
return . makeMIRCertificate Shelley.TreasuryMIR $ SendToReservesMIR ll
TransferToTreasury ->
return . makeMIRCertificate Shelley.ReservesMIR $ SendToTreasuryMIR ll
firstExceptT ShelleyGovernanceCmdTextEnvWriteError
. newExceptT
$ writeFileTextEnvelope oFp (Just $ mirCertDesc direction) mirCert
where
mirCertDesc :: TransferDirection -> TextEnvelopeDescr
mirCertDesc TransferToTreasury = "MIR Certificate Send To Treasury"
mirCertDesc TransferToReserves = "MIR Certificate Send To Reserves"
runGovernanceGenesisKeyDelegationCertificate
:: VerificationKeyOrHashOrFile GenesisKey
-> VerificationKeyOrHashOrFile GenesisDelegateKey
-> VerificationKeyOrHashOrFile VrfKey
-> OutputFile
-> ExceptT ShelleyGovernanceCmdError IO ()
runGovernanceGenesisKeyDelegationCertificate genVkOrHashOrFp
genDelVkOrHashOrFp
vrfVkOrHashOrFp
(OutputFile oFp) = do
genesisVkHash <- firstExceptT ShelleyGovernanceCmdKeyReadError
. newExceptT
$ readVerificationKeyOrHashOrTextEnvFile AsGenesisKey genVkOrHashOrFp
genesisDelVkHash <-firstExceptT ShelleyGovernanceCmdKeyReadError
. newExceptT
$ readVerificationKeyOrHashOrTextEnvFile AsGenesisDelegateKey genDelVkOrHashOrFp
vrfVkHash <- firstExceptT ShelleyGovernanceCmdKeyReadError
. newExceptT
$ readVerificationKeyOrHashOrFile AsVrfKey vrfVkOrHashOrFp
firstExceptT ShelleyGovernanceCmdTextEnvWriteError
. newExceptT
$ writeFileTextEnvelope oFp (Just genKeyDelegCertDesc)
$ makeGenesisKeyDelegationCertificate genesisVkHash genesisDelVkHash vrfVkHash
where
genKeyDelegCertDesc :: TextEnvelopeDescr
genKeyDelegCertDesc = "Genesis Key Delegation Certificate"
runGovernanceUpdateProposal
:: OutputFile
-> EpochNo
-> [VerificationKeyFile]
-- ^ Genesis verification keys
-> ProtocolParametersUpdate
-> ExceptT ShelleyGovernanceCmdError IO ()
runGovernanceUpdateProposal (OutputFile upFile) eNo genVerKeyFiles upPprams = do
when (upPprams == mempty) $ left ShelleyGovernanceCmdEmptyUpdateProposalError
genVKeys <- sequence
[ firstExceptT ShelleyGovernanceCmdTextEnvReadError . newExceptT $
readFileTextEnvelope
(AsVerificationKey AsGenesisKey)
vkeyFile
| VerificationKeyFile vkeyFile <- genVerKeyFiles ]
let genKeyHashes = map verificationKeyHash genVKeys
upProp = makeShelleyUpdateProposal upPprams genKeyHashes eNo
firstExceptT ShelleyGovernanceCmdTextEnvWriteError . newExceptT $
writeFileTextEnvelope upFile Nothing upProp