1
+ {-# LANGUAGE BangPatterns #-}
1
2
{-# LANGUAGE DataKinds #-}
2
3
{-# LANGUAGE NamedFieldPuns #-}
3
4
{-# LANGUAGE OverloadedStrings #-}
4
5
{-# LANGUAGE ScopedTypeVariables #-}
6
+ {-# LANGUAGE TypeApplications #-}
5
7
6
8
module Cardano.Testnet.Test.LedgerEvents.Gov.PredefinedNoConfidenceDRep
7
9
( hprop_check_predefined_no_confidence_drep
8
10
) where
9
11
10
12
import Cardano.Api as Api
13
+ import Cardano.Api.Error (displayError )
11
14
12
15
import Cardano.Testnet
16
+ import Cardano.Testnet.Test.LedgerEvents.Gov.PredefinedAbstainDRep
17
+ (delegateToAutomaticDRep , desiredPoolNumberProposalTest ,
18
+ getDesiredPoolNumberValue , voteChangeProposal )
13
19
14
20
import Prelude
15
21
22
+ import Control.Monad (void )
23
+ import Control.Monad.Catch (MonadCatch )
24
+ import qualified Data.Aeson as Aeson
25
+ import qualified Data.Aeson.Lens as AL
26
+ import qualified Data.ByteString.Lazy.Char8 as LBS
27
+ import Data.String (fromString )
28
+ import Data.Text (Text )
29
+ import qualified Data.Text as Text
30
+ import Data.Word (Word32 )
31
+ import GHC.Stack (callStack )
32
+ import Lens.Micro ((^?) )
16
33
import System.FilePath ((</>) )
17
34
18
- import Testnet.Components.Query (getEpochStateView )
35
+ import Testnet.Components.DReps (retrieveTransactionId , signTx , submitTx )
36
+ import Testnet.Components.Query (EpochStateView , findLargestUtxoForPaymentKey ,
37
+ getCurrentEpochNo , getEpochStateView , getMinDRepDeposit )
38
+ import Testnet.Defaults (defaultDelegatorStakeKeyPair )
39
+ import qualified Testnet.Process.Cli as P
19
40
import qualified Testnet.Process.Run as H
20
41
import qualified Testnet.Property.Utils as H
21
42
import Testnet.Runtime
@@ -36,7 +57,8 @@ hprop_check_predefined_no_confidence_drep = H.integrationWorkspace "test-activit
36
57
work <- H. createDirectoryIfMissing $ tempAbsPath' </> " work"
37
58
38
59
-- Create default testnet with 3 DReps and 3 stake holders delegated, one to each DRep.
39
- let sbe = ShelleyBasedEraConway
60
+ let ceo = ConwayEraOnwardsConway
61
+ sbe = conwayEraOnwardsToShelleyBasedEra ceo
40
62
era = toCardanoEra sbe
41
63
cEra = AnyCardanoEra era
42
64
fastTestnetOptions = cardanoDefaultTestnetOptions
@@ -48,20 +70,20 @@ hprop_check_predefined_no_confidence_drep = H.integrationWorkspace "test-activit
48
70
testnetRuntime@ TestnetRuntime
49
71
{ testnetMagic
50
72
, poolNodes
51
- , wallets= _wallet0 : _wallet1 : _wallet2 : _
73
+ , wallets= wallet0 : wallet1 : wallet2 : _
52
74
, configurationFile
53
75
}
54
76
<- cardanoTestnetDefault fastTestnetOptions conf
55
77
56
78
poolNode1 <- H. headM poolNodes
57
79
poolSprocket1 <- H. noteShow $ nodeSprocket $ poolRuntime poolNode1
58
- _execConfig <- H. mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic
80
+ execConfig <- H. mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic
59
81
60
82
let socketName' = IO. sprocketName poolSprocket1
61
83
socketBase = IO. sprocketBase poolSprocket1 -- /tmp
62
84
socketPath = socketBase </> socketName'
63
85
64
- _epochStateView <- getEpochStateView (File configurationFile) (File socketPath)
86
+ epochStateView <- getEpochStateView (File configurationFile) (File socketPath)
65
87
66
88
startLedgerNewEpochStateLogging testnetRuntime tempAbsPath'
67
89
@@ -70,17 +92,207 @@ hprop_check_predefined_no_confidence_drep = H.integrationWorkspace "test-activit
70
92
H. note_ $ " Socketpath: " <> socketPath
71
93
H. note_ $ " Foldblocks config file: " <> configurationFile
72
94
73
- _gov <- H. createDirectoryIfMissing $ work </> " governance"
95
+ gov <- H. createDirectoryIfMissing $ work </> " governance"
74
96
75
- -- ToDo: Do some proposal and vote yes with all the DReps.
76
- -- ToDo: ASSERT: that proposal passes.
77
- -- ToDo: Take the last two stake delegators and delegate them to "No Confidence".
78
- -- ToDo: This can be done using cardano-cli conway stake-address vote-delegation-certificate --always-no-confidence
79
- -- ToDo: Do some other proposal and vote yes with all the DReps.
80
- -- ToDo: ASSERT: the new proposal does NOT pass.
81
- -- ToDo: Create a no confidence proposal.
82
- -- ToDo: This can be done using cardano-cli conway governance action create-no-confidence
83
- -- ToDo: Vote no to the no confidence proposal with all DReps.
84
- -- ToDo: ASSERT: the no confidence proposal passes.
97
+ -- Do some proposal and vote yes with all the DReps
98
+ -- and assert that proposal passes.
99
+ initialDesiredNumberOfPools <- getDesiredPoolNumberValue execConfig
85
100
86
- success
101
+ let newNumberOfDesiredPools = fromIntegral (initialDesiredNumberOfPools + 1 )
102
+
103
+ firstProposalInfo <- desiredPoolNumberProposalTest execConfig epochStateView configurationFile socketPath ceo gov " firstProposal"
104
+ wallet0 Nothing [(3 , " yes" )] newNumberOfDesiredPools newNumberOfDesiredPools 3
105
+
106
+ -- Take the last two stake delegators and delegate them to "No Confidence".
107
+ delegateToAlwaysNoConfidence execConfig epochStateView configurationFile socketPath sbe gov " delegateToAbstain1"
108
+ wallet1 (defaultDelegatorStakeKeyPair 2 )
109
+ delegateToAlwaysNoConfidence execConfig epochStateView configurationFile socketPath sbe gov " delegateToAbstain2"
110
+ wallet1 (defaultDelegatorStakeKeyPair 3 )
111
+
112
+ -- Do some other proposal and vote yes with all the DReps
113
+ -- and assert the new proposal does NOT pass
114
+ let newNumberOfDesiredPools2 = fromIntegral (newNumberOfDesiredPools + 1 )
115
+
116
+ void $ desiredPoolNumberProposalTest execConfig epochStateView configurationFile socketPath ceo gov " secondProposal"
117
+ wallet2 (Just firstProposalInfo) [(3 , " yes" )] newNumberOfDesiredPools2 newNumberOfDesiredPools 3
118
+
119
+ -- Create a no confidence proposal and vote "no" to the proposal with all DReps.
120
+ -- Assert the no confidence proposal passes.
121
+ void $ testNoConfidenceProposal execConfig epochStateView configurationFile socketPath ceo work " noConfidenceProposal"
122
+ wallet0 firstProposalInfo [(3 , " no" )] 3
123
+
124
+ delegateToAlwaysNoConfidence
125
+ :: (MonadTest m , MonadIO m , H. MonadAssertion m , MonadCatch m )
126
+ => H. ExecConfig
127
+ -> EpochStateView
128
+ -> FilePath
129
+ -> FilePath
130
+ -> ShelleyBasedEra ConwayEra
131
+ -> FilePath
132
+ -> String
133
+ -> PaymentKeyInfo
134
+ -> StakingKeyPair
135
+ -> m ()
136
+ delegateToAlwaysNoConfidence execConfig epochStateView configurationFile socketPath sbe work prefix =
137
+ delegateToAutomaticDRep execConfig epochStateView configurationFile socketPath sbe work prefix
138
+ " --always-no-confidence"
139
+
140
+ testNoConfidenceProposal
141
+ :: (MonadTest m , MonadIO m , H. MonadAssertion m , MonadCatch m , Foldable t )
142
+ => H. ExecConfig
143
+ -> EpochStateView
144
+ -> FilePath
145
+ -> FilePath
146
+ -> ConwayEraOnwards ConwayEra
147
+ -> FilePath
148
+ -> FilePath
149
+ -> PaymentKeyInfo
150
+ -> (String , Word32 )
151
+ -> t (Int , String )
152
+ -> Integer
153
+ -> m (String , Word32 )
154
+ testNoConfidenceProposal execConfig epochStateView configurationFile socketPath ceo work prefix
155
+ wallet previousProposalInfo votes epochsToWait = do
156
+
157
+ let sbe = conwayEraOnwardsToShelleyBasedEra ceo
158
+ baseDir <- H. createDirectoryIfMissing $ work </> prefix
159
+
160
+ let propVotes :: [(String , Int )]
161
+ propVotes = zip (concatMap (uncurry replicate ) votes) [1 .. ]
162
+ annotateShow propVotes
163
+
164
+ thisProposal@ (governanceActionTxId, governanceActionIndex) <-
165
+ makeNoConfidenceProposal execConfig epochStateView (File configurationFile) (File socketPath)
166
+ ceo baseDir " proposal" previousProposalInfo wallet
167
+
168
+ voteChangeProposal execConfig epochStateView sbe baseDir " vote"
169
+ governanceActionTxId governanceActionIndex propVotes wallet
170
+
171
+ -- Wait two epochs
172
+ (EpochNo epochAfterProp) <- getCurrentEpochNo epochStateView
173
+ H. note_ $ " Epoch after \" " <> prefix <> " \" prop: " <> show epochAfterProp
174
+ void $ waitUntilEpoch (File configurationFile) (File socketPath) (EpochNo (epochAfterProp + fromIntegral epochsToWait))
175
+
176
+ -- We check that no confidence proposal passes
177
+ obtainedProposalId <- getLastEnactedCommitteeActionId execConfig
178
+ obtainedProposalId === thisProposal
179
+
180
+ return thisProposal
181
+
182
+ getLastEnactedCommitteeActionId :: (MonadTest m , MonadCatch m , MonadIO m ) => H. ExecConfig -> m (String , Word32 )
183
+ getLastEnactedCommitteeActionId execConfig = do
184
+ govStateString <- H. execCli' execConfig
185
+ [ " conway" , " query" , " gov-state"
186
+ , " --volatile-tip"
187
+ ]
188
+
189
+ govStateJSON <- H. nothingFail (Aeson. decode (LBS. pack govStateString) :: Maybe Aeson. Value )
190
+
191
+ let mLastCommitteeAction :: Maybe Aeson. Value
192
+ mLastCommitteeAction = govStateJSON
193
+ ^? AL. key " nextRatifyState"
194
+ . AL. key " nextEnactState"
195
+ . AL. key " prevGovActionIds"
196
+ . AL. key " Committee"
197
+
198
+ lastCommitteeAction <- evalMaybe mLastCommitteeAction
199
+
200
+ let mLastCommitteeActionIx :: Maybe Integer
201
+ mLastCommitteeActionIx = lastCommitteeAction ^? AL. key " govActionIx"
202
+ . AL. _Integer
203
+
204
+ lastCommitteeActionIx <- fromIntegral <$> evalMaybe mLastCommitteeActionIx
205
+
206
+ let mLastCommitteeActionTxId :: Maybe Text
207
+ mLastCommitteeActionTxId = lastCommitteeAction ^? AL. key " txId"
208
+ . AL. _String
209
+
210
+ lastCommitteeActionTxId <- Text. unpack <$> evalMaybe mLastCommitteeActionTxId
211
+
212
+ return (lastCommitteeActionTxId, lastCommitteeActionIx)
213
+
214
+ makeNoConfidenceProposal
215
+ :: (H. MonadAssertion m , MonadTest m , MonadCatch m , MonadIO m )
216
+ => H. ExecConfig
217
+ -> EpochStateView
218
+ -> NodeConfigFile 'In
219
+ -> SocketPath
220
+ -> ConwayEraOnwards ConwayEra
221
+ -> FilePath
222
+ -> String
223
+ -> (String , Word32 )
224
+ -> PaymentKeyInfo
225
+ -> m (String , Word32 )
226
+ makeNoConfidenceProposal execConfig epochStateView configurationFile socketPath
227
+ ceo work prefix (prevGovernanceActionTxId, prevGovernanceActionIndex) wallet = do
228
+
229
+ let sbe = conwayEraOnwardsToShelleyBasedEra ceo
230
+ era = toCardanoEra sbe
231
+ cEra = AnyCardanoEra era
232
+
233
+ baseDir <- H. createDirectoryIfMissing $ work </> prefix
234
+
235
+ let stakeVkeyFp = baseDir </> " stake.vkey"
236
+ stakeSKeyFp = baseDir </> " stake.skey"
237
+
238
+ _ <- P. cliStakeAddressKeyGen baseDir
239
+ $ P. KeyNames { P. verificationKeyFile = stakeVkeyFp
240
+ , P. signingKeyFile = stakeSKeyFp
241
+ }
242
+
243
+ proposalAnchorFile <- H. note $ baseDir </> " sample-proposal-anchor"
244
+ H. writeFile proposalAnchorFile " dummy anchor data"
245
+
246
+ proposalAnchorDataHash <- H. execCli' execConfig
247
+ [ " conway" , " governance"
248
+ , " hash" , " anchor-data" , " --file-text" , proposalAnchorFile
249
+ ]
250
+
251
+ minDRepDeposit <- getMinDRepDeposit epochStateView ceo
252
+
253
+ proposalFile <- H. note $ baseDir </> " sample-proposal-file"
254
+
255
+ void $ H. execCli' execConfig $
256
+ [ " conway" , " governance" , " action" , " create-no-confidence"
257
+ , " --testnet"
258
+ , " --governance-action-deposit" , show @ Integer minDRepDeposit
259
+ , " --deposit-return-stake-verification-key-file" , stakeVkeyFp
260
+ , " --prev-governance-action-tx-id" , prevGovernanceActionTxId
261
+ , " --prev-governance-action-index" , show prevGovernanceActionIndex
262
+ , " --anchor-url" , " https://tinyurl.com/3wrwb2as"
263
+ , " --anchor-data-hash" , proposalAnchorDataHash
264
+ , " --out-file" , proposalFile
265
+ ]
266
+
267
+ proposalBody <- H. note $ baseDir </> " tx.body"
268
+ txIn <- findLargestUtxoForPaymentKey epochStateView sbe wallet
269
+
270
+ void $ H. execCli' execConfig
271
+ [ " conway" , " transaction" , " build"
272
+ , " --change-address" , Text. unpack $ paymentKeyInfoAddr wallet
273
+ , " --tx-in" , Text. unpack $ renderTxIn txIn
274
+ , " --proposal-file" , proposalFile
275
+ , " --out-file" , proposalBody
276
+ ]
277
+
278
+ signedProposalTx <- signTx execConfig cEra baseDir " signed-proposal"
279
+ (File proposalBody) [paymentKeyInfoPair wallet]
280
+
281
+ submitTx execConfig cEra signedProposalTx
282
+
283
+ governanceActionTxId <- retrieveTransactionId execConfig signedProposalTx
284
+
285
+ ! propSubmittedResult <- findCondition (maybeExtractGovernanceActionIndex sbe (fromString governanceActionTxId))
286
+ (unFile configurationFile)
287
+ (unFile socketPath)
288
+ (EpochNo 30 )
289
+
290
+ governanceActionIndex <- case propSubmittedResult of
291
+ Left e ->
292
+ H. failMessage callStack
293
+ $ " findCondition failed with: " <> displayError e
294
+ Right Nothing ->
295
+ H. failMessage callStack " Couldn't find proposal."
296
+ Right (Just a) -> return a
297
+
298
+ return (governanceActionTxId, governanceActionIndex)
0 commit comments