Skip to content

Commit 2258014

Browse files
palaspalas
committed
Test predefined always abstain DRep
1 parent c138731 commit 2258014

File tree

2 files changed

+269
-17
lines changed

2 files changed

+269
-17
lines changed

‎cardano-testnet/src/Testnet/Defaults.hs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -17,13 +17,13 @@ module Testnet.Defaults
1717
, defaultDRepVkeyFp
1818
, defaultDRepSkeyFp
1919
, defaultDRepKeyPair
20+
, defaultDelegatorStakeKeyPair
2021
, defaultShelleyGenesis
2122
, defaultGenesisFilepath
2223
, defaultYamlHardforkViaConfig
2324
, defaultMainnetTopology
2425
, plutusV3NonSpendingScript
2526
, plutusV3SpendingScript
26-
, defaultDelegatorStakeKeyPair
2727
) where
2828

2929
import Cardano.Api (AnyCardanoEra (..), CardanoEra (..), pshow)
@@ -517,13 +517,13 @@ defaultDRepKeyPair n = PaymentKeyPair (defaultDRepVkeyFp n) (defaultDRepSkeyFp n
517517

518518
-- | The relative path to stake delegator stake keys in directories created by cardano-testnet
519519
defaultDelegatorStakeVkeyFp
520-
:: Int -- ^ The Stake delegator index (starts at 1)
520+
:: Int -- ^The Stake delegator index (starts at 1)
521521
-> FilePath
522522
defaultDelegatorStakeVkeyFp n = "stake-delegators" </> ("delegator" <> show n) </> "staking.vkey"
523523

524524
-- | The relative path to stake delegator stake secret keys in directories created by cardano-testnet
525525
defaultDelegatorStakeSkeyFp
526-
:: Int -- ^ The Stake delegator index (starts at 1)
526+
:: Int -- ^The Stake delegator index (starts at 1)
527527
-> FilePath
528528
defaultDelegatorStakeSkeyFp n = "stake-delegators" </> ("delegator" <> show n) </> "staking.skey"
529529

‎cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/Gov/PredefinedAbstainDRep.hs‎

Lines changed: 266 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -1,21 +1,39 @@
1+
{-# LANGUAGE BangPatterns #-}
12
{-# LANGUAGE DataKinds #-}
23
{-# LANGUAGE NamedFieldPuns #-}
34
{-# LANGUAGE OverloadedStrings #-}
45
{-# LANGUAGE ScopedTypeVariables #-}
6+
{-# LANGUAGE TypeApplications #-}
57

68
module Cardano.Testnet.Test.LedgerEvents.Gov.PredefinedAbstainDRep
79
( hprop_check_predefined_abstain_drep
810
) where
911

1012
import Cardano.Api as Api
13+
import Cardano.Api.Error (displayError)
1114

1215
import Cardano.Testnet
1316

1417
import Prelude
1518

19+
import Control.Monad (void)
20+
import Control.Monad.Catch (MonadCatch)
21+
import qualified Data.Aeson as Aeson
22+
import qualified Data.Aeson.Lens as AL
23+
import Data.ByteString.Lazy.Char8 (pack)
24+
import Data.String (fromString)
25+
import qualified Data.Text as Text
26+
import Data.Word (Word32)
27+
import GHC.Stack (callStack)
28+
import Lens.Micro ((^?))
1629
import System.FilePath ((</>))
1730

18-
import Testnet.Components.Query (getEpochStateView)
31+
import Testnet.Components.DReps (createCertificatePublicationTxBody, createVotingTxBody,
32+
generateVoteFiles, retrieveTransactionId, signTx, submitTx)
33+
import Testnet.Components.Query (EpochStateView, findLargestUtxoForPaymentKey,
34+
getCurrentEpochNo, getEpochStateView, getMinDRepDeposit)
35+
import Testnet.Defaults (defaultDRepKeyPair, defaultDelegatorStakeKeyPair)
36+
import qualified Testnet.Process.Cli as P
1937
import qualified Testnet.Process.Run as H
2038
import qualified Testnet.Property.Utils as H
2139
import Testnet.Runtime
@@ -28,15 +46,16 @@ import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as IO
2846
-- @DISABLE_RETRIES=1 cabal test cardano-testnet-test --test-options '-p "/Predefined Abstain DRep/"'@
2947
hprop_check_predefined_abstain_drep :: Property
3048
hprop_check_predefined_abstain_drep = H.integrationWorkspace "test-activity" $ \tempAbsBasePath' -> do
31-
-- Start a local test net
49+
-- Start a local test net
3250
conf@Conf { tempAbsPath } <- mkConf tempAbsBasePath'
3351
let tempAbsPath' = unTmpAbsPath tempAbsPath
3452
tempBaseAbsPath = makeTmpBaseAbsPath tempAbsPath
3553

3654
work <- H.createDirectoryIfMissing $ tempAbsPath' </> "work"
3755

3856
-- Create default testnet with 3 DReps and 3 stake holders delegated, one to each DRep.
39-
let sbe = ShelleyBasedEraConway
57+
let ceo = ConwayEraOnwardsConway
58+
sbe = conwayEraOnwardsToShelleyBasedEra ceo
4059
era = toCardanoEra sbe
4160
cEra = AnyCardanoEra era
4261
fastTestnetOptions = cardanoDefaultTestnetOptions
@@ -48,20 +67,20 @@ hprop_check_predefined_abstain_drep = H.integrationWorkspace "test-activity" $ \
4867
testnetRuntime@TestnetRuntime
4968
{ testnetMagic
5069
, poolNodes
51-
, wallets=_wallet0:_wallet1:_wallet2:_
70+
, wallets=wallet0:wallet1:wallet2:_
5271
, configurationFile
5372
}
5473
<- cardanoTestnetDefault fastTestnetOptions conf
5574

5675
poolNode1 <- H.headM poolNodes
5776
poolSprocket1 <- H.noteShow $ nodeSprocket $ poolRuntime poolNode1
58-
_execConfig <- H.mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic
77+
execConfig <- H.mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic
5978

6079
let socketName' = IO.sprocketName poolSprocket1
6180
socketBase = IO.sprocketBase poolSprocket1 -- /tmp
6281
socketPath = socketBase </> socketName'
6382

64-
_epochStateView <- getEpochStateView (File configurationFile) (File socketPath)
83+
epochStateView <- getEpochStateView (File configurationFile) (File socketPath)
6584

6685
startLedgerNewEpochStateLogging testnetRuntime tempAbsPath'
6786

@@ -70,13 +89,246 @@ hprop_check_predefined_abstain_drep = H.integrationWorkspace "test-activity" $ \
7089
H.note_ $ "Socketpath: " <> socketPath
7190
H.note_ $ "Foldblocks config file: " <> configurationFile
7291

73-
_gov <- H.createDirectoryIfMissing $ work </> "governance"
92+
gov <- H.createDirectoryIfMissing $ work </> "governance"
7493

75-
-- ToDo: Do some proposal and vote yes with the first DRep only.
76-
-- ToDo: ASSERT: Check that proposal does NOT pass.
77-
-- ToDo: Take the last two stake delegators and delegate them to "Abstain".
78-
-- ToDo: This can be done using cardano-cli conway stake-address vote-delegation-certificate --always-abstain
79-
-- ToDo: Do some other proposal and vote yes with first DRep only.
80-
-- ToDo: ASSERT: Check the new proposal passes now.
94+
initialDesiredNumberOfPools <- getDesiredPoolNumberValue execConfig
8195

82-
success
96+
let newNumberOfDesiredPools = fromIntegral (initialDesiredNumberOfPools + 1)
97+
98+
-- Do some proposal and vote yes with the first DRep only
99+
-- and assert that proposal does NOT pass.
100+
void $ desiredPoolNumberProposalTest execConfig epochStateView configurationFile socketPath ceo gov "firstProposal"
101+
wallet0 Nothing [(1, "yes")] newNumberOfDesiredPools initialDesiredNumberOfPools 2
102+
103+
-- Take the last two stake delegators and delegate them to "Abstain".
104+
delegateToAlwaysAbstain execConfig epochStateView configurationFile socketPath sbe gov "delegateToAbstain1"
105+
wallet1 (defaultDelegatorStakeKeyPair 2)
106+
delegateToAlwaysAbstain execConfig epochStateView configurationFile socketPath sbe gov "delegateToAbstain2"
107+
wallet2 (defaultDelegatorStakeKeyPair 3)
108+
109+
-- Do some other proposal and vote yes with first DRep only
110+
-- and assert the new proposal passes now.
111+
let newNumberOfDesiredPools2 = fromIntegral (newNumberOfDesiredPools + 1)
112+
void $ desiredPoolNumberProposalTest execConfig epochStateView configurationFile socketPath ceo gov "secondProposal"
113+
wallet0 Nothing [(1, "yes")] newNumberOfDesiredPools2 newNumberOfDesiredPools2 2
114+
115+
delegateToAlwaysAbstain
116+
:: (MonadTest m, MonadIO m, H.MonadAssertion m, MonadCatch m)
117+
=> H.ExecConfig
118+
-> EpochStateView
119+
-> FilePath
120+
-> FilePath
121+
-> ShelleyBasedEra ConwayEra
122+
-> FilePath
123+
-> String
124+
-> PaymentKeyInfo
125+
-> StakingKeyPair
126+
-> m ()
127+
delegateToAlwaysAbstain execConfig epochStateView configurationFile socketPath sbe work prefix
128+
payingWallet skeyPair@(StakingKeyPair vKeyFile _sKeyFile) = do
129+
130+
let era = toCardanoEra sbe
131+
cEra = AnyCardanoEra era
132+
133+
baseDir <- H.createDirectoryIfMissing $ work </> prefix
134+
135+
-- Create vote delegation certificate
136+
let voteDelegationCertificatePath = baseDir </> "delegation-certificate.delegcert"
137+
void $ H.execCli' execConfig
138+
[ "conway", "stake-address", "vote-delegation-certificate"
139+
, "--always-abstain"
140+
, "--stake-verification-key-file", vKeyFile
141+
, "--out-file", voteDelegationCertificatePath
142+
]
143+
144+
-- Compose transaction to publish delegation certificate
145+
repRegTxBody1 <- createCertificatePublicationTxBody execConfig epochStateView sbe baseDir "del-cert-txbody"
146+
(File voteDelegationCertificatePath) payingWallet
147+
148+
-- Sign transaction
149+
repRegSignedRegTx1 <- signTx execConfig cEra baseDir "signed-reg-tx"
150+
repRegTxBody1 [ SomeKeyPair (paymentKeyInfoPair payingWallet)
151+
, SomeKeyPair skeyPair]
152+
153+
-- Submit transaction
154+
submitTx execConfig cEra repRegSignedRegTx1
155+
156+
-- Wait two epochs
157+
(EpochNo epochAfterProp) <- getCurrentEpochNo epochStateView
158+
void $ waitUntilEpoch (File configurationFile) (File socketPath) (EpochNo (epochAfterProp + 2))
159+
160+
desiredPoolNumberProposalTest
161+
:: (MonadTest m, MonadIO m, H.MonadAssertion m, MonadCatch m, Foldable t)
162+
=> H.ExecConfig
163+
-> EpochStateView
164+
-> FilePath
165+
-> FilePath
166+
-> ConwayEraOnwards ConwayEra
167+
-> FilePath
168+
-> FilePath
169+
-> PaymentKeyInfo
170+
-> Maybe (String, Word32)
171+
-> t (Int, String)
172+
-> Integer
173+
-> Integer
174+
-> Integer
175+
-> m (String, Word32)
176+
desiredPoolNumberProposalTest execConfig epochStateView configurationFile socketPath ceo work prefix
177+
wallet previousProposalInfo votes change expected epochsToWait = do
178+
let sbe = conwayEraOnwardsToShelleyBasedEra ceo
179+
180+
baseDir <- H.createDirectoryIfMissing $ work </> prefix
181+
182+
let propVotes :: [(String, Int)]
183+
propVotes = zip (concatMap (uncurry replicate) votes) [1..]
184+
annotateShow propVotes
185+
186+
thisProposal@(governanceActionTxId, governanceActionIndex) <-
187+
makeDesiredPoolNumberChangeProposal execConfig epochStateView (File configurationFile) (File socketPath)
188+
ceo baseDir "proposal" previousProposalInfo (fromIntegral change) wallet
189+
190+
voteChangeProposal execConfig epochStateView sbe baseDir "vote"
191+
governanceActionTxId governanceActionIndex propVotes wallet
192+
193+
(EpochNo epochAfterProp) <- getCurrentEpochNo epochStateView
194+
H.note_ $ "Epoch after \"" <> prefix <> "\" prop: " <> show epochAfterProp
195+
196+
void $ waitUntilEpoch (File configurationFile) (File socketPath) (EpochNo (epochAfterProp + fromIntegral epochsToWait))
197+
desiredPoolNumberAfterProp <- getDesiredPoolNumberValue execConfig
198+
199+
desiredPoolNumberAfterProp === expected
200+
201+
return thisProposal
202+
203+
makeDesiredPoolNumberChangeProposal
204+
:: (H.MonadAssertion m, MonadTest m, MonadCatch m, MonadIO m)
205+
=> H.ExecConfig
206+
-> EpochStateView
207+
-> NodeConfigFile 'In
208+
-> SocketPath
209+
-> ConwayEraOnwards ConwayEra
210+
-> FilePath
211+
-> String
212+
-> Maybe (String, Word32)
213+
-> Word32
214+
-> PaymentKeyInfo
215+
-> m (String, Word32)
216+
makeDesiredPoolNumberChangeProposal execConfig epochStateView configurationFile socketPath
217+
ceo work prefix prevGovActionInfo desiredPoolNumber wallet = do
218+
219+
let sbe = conwayEraOnwardsToShelleyBasedEra ceo
220+
era = toCardanoEra sbe
221+
cEra = AnyCardanoEra era
222+
223+
baseDir <- H.createDirectoryIfMissing $ work </> prefix
224+
225+
let stakeVkeyFp = baseDir </> "stake.vkey"
226+
stakeSKeyFp = baseDir </> "stake.skey"
227+
228+
_ <- P.cliStakeAddressKeyGen baseDir
229+
$ P.KeyNames { P.verificationKeyFile = stakeVkeyFp
230+
, P.signingKeyFile = stakeSKeyFp
231+
}
232+
233+
proposalAnchorFile <- H.note $ baseDir </> "sample-proposal-anchor"
234+
H.writeFile proposalAnchorFile "dummy anchor data"
235+
236+
proposalAnchorDataHash <- H.execCli' execConfig
237+
[ "conway", "governance"
238+
, "hash", "anchor-data", "--file-text", proposalAnchorFile
239+
]
240+
241+
minDRepDeposit <- getMinDRepDeposit execConfig ceo
242+
243+
proposalFile <- H.note $ baseDir </> "sample-proposal-file"
244+
245+
void $ H.execCli' execConfig $
246+
[ "conway", "governance", "action", "create-protocol-parameters-update"
247+
, "--testnet"
248+
, "--governance-action-deposit", show @Integer minDRepDeposit
249+
, "--deposit-return-stake-verification-key-file", stakeVkeyFp
250+
] ++ concatMap (\(prevGovernanceActionTxId, prevGovernanceActionIndex) ->
251+
[ "--prev-governance-action-tx-id", prevGovernanceActionTxId
252+
, "--prev-governance-action-index", show prevGovernanceActionIndex
253+
]) prevGovActionInfo ++
254+
[ "--number-of-pools", show desiredPoolNumber
255+
, "--anchor-url", "https://tinyurl.com/3wrwb2as"
256+
, "--anchor-data-hash", proposalAnchorDataHash
257+
, "--out-file", proposalFile
258+
]
259+
260+
proposalBody <- H.note $ baseDir </> "tx.body"
261+
txIn <- findLargestUtxoForPaymentKey epochStateView sbe wallet
262+
263+
void $ H.execCli' execConfig
264+
[ "conway", "transaction", "build"
265+
, "--change-address", Text.unpack $ paymentKeyInfoAddr wallet
266+
, "--tx-in", Text.unpack $ renderTxIn txIn
267+
, "--proposal-file", proposalFile
268+
, "--out-file", proposalBody
269+
]
270+
271+
signedProposalTx <- signTx execConfig cEra baseDir "signed-proposal"
272+
(File proposalBody) [paymentKeyInfoPair wallet]
273+
274+
submitTx execConfig cEra signedProposalTx
275+
276+
governanceActionTxId <- retrieveTransactionId execConfig signedProposalTx
277+
278+
!propSubmittedResult <- findCondition (maybeExtractGovernanceActionIndex sbe (fromString governanceActionTxId))
279+
(unFile configurationFile)
280+
(unFile socketPath)
281+
(EpochNo 30)
282+
283+
governanceActionIndex <- case propSubmittedResult of
284+
Left e ->
285+
H.failMessage callStack
286+
$ "findCondition failed with: " <> displayError e
287+
Right Nothing ->
288+
H.failMessage callStack "Couldn't find proposal."
289+
Right (Just a) -> return a
290+
291+
return (governanceActionTxId, governanceActionIndex)
292+
293+
voteChangeProposal :: (MonadTest m, MonadIO m, MonadCatch m, H.MonadAssertion m)
294+
=> H.ExecConfig
295+
-> EpochStateView
296+
-> ShelleyBasedEra ConwayEra
297+
-> FilePath
298+
-> FilePath
299+
-> String
300+
-> Word32
301+
-> [([Char], Int)]
302+
-> PaymentKeyInfo
303+
-> m ()
304+
voteChangeProposal execConfig epochStateView sbe work prefix governanceActionTxId governanceActionIndex votes wallet = do
305+
baseDir <- H.createDirectoryIfMissing $ work </> prefix
306+
307+
let era = toCardanoEra sbe
308+
cEra = AnyCardanoEra era
309+
310+
voteFiles <- generateVoteFiles execConfig baseDir "vote-files"
311+
governanceActionTxId governanceActionIndex
312+
[(defaultDRepKeyPair idx, vote) | (vote, idx) <- votes]
313+
314+
voteTxBodyFp <- createVotingTxBody execConfig epochStateView sbe baseDir "vote-tx-body"
315+
voteFiles wallet
316+
317+
voteTxFp <- signTx execConfig cEra baseDir "signed-vote-tx" voteTxBodyFp
318+
(paymentKeyInfoPair wallet:[defaultDRepKeyPair n | (_, n) <- votes])
319+
submitTx execConfig cEra voteTxFp
320+
321+
getDesiredPoolNumberValue :: (MonadTest m, MonadCatch m, MonadIO m) => H.ExecConfig -> m Integer
322+
getDesiredPoolNumberValue execConfig = do
323+
govStateString <- H.execCli' execConfig
324+
[ "conway", "query", "gov-state"
325+
, "--volatile-tip"
326+
]
327+
328+
govStateJSON <- H.nothingFail (Aeson.decode (pack govStateString) :: Maybe Aeson.Value)
329+
let mTargetPoolNum :: Maybe Integer
330+
mTargetPoolNum = govStateJSON
331+
^? AL.key "currentPParams"
332+
. AL.key "stakePoolTargetNum"
333+
. AL._Integer
334+
evalMaybe mTargetPoolNum

0 commit comments

Comments
 (0)