|
| 1 | +{-# LANGUAGE BangPatterns #-} |
| 2 | +{-# LANGUAGE NamedFieldPuns #-} |
| 3 | +{-# LANGUAGE NumericUnderscores #-} |
| 4 | +{-# LANGUAGE OverloadedStrings #-} |
| 5 | +{-# LANGUAGE ScopedTypeVariables #-} |
| 6 | +{-# LANGUAGE TypeApplications #-} |
| 7 | + |
| 8 | +module Cardano.Testnet.Test.Gov.NoConfidence |
| 9 | + ( hprop_gov_no_confidence |
| 10 | + ) where |
| 11 | + |
| 12 | +import Cardano.Api as Api |
| 13 | +import Cardano.Api.Error |
| 14 | +import Cardano.Api.Ledger |
| 15 | +import Cardano.Api.Shelley |
| 16 | + |
| 17 | +import qualified Cardano.Ledger.Conway.Genesis as L |
| 18 | +import qualified Cardano.Ledger.Conway.Governance as L |
| 19 | +import qualified Cardano.Ledger.Credential as L |
| 20 | +import qualified Cardano.Ledger.Shelley.LedgerState as L |
| 21 | +import Cardano.Testnet |
| 22 | + |
| 23 | +import Prelude |
| 24 | + |
| 25 | +import Control.Monad |
| 26 | +import Data.Bifunctor |
| 27 | +import qualified Data.ByteString.Char8 as BSC |
| 28 | +import qualified Data.Map.Strict as Map |
| 29 | +import Data.Maybe.Strict |
| 30 | +import Data.String |
| 31 | +import qualified Data.Text as Text |
| 32 | +import GHC.Stack |
| 33 | +import Lens.Micro |
| 34 | +import System.FilePath ((</>)) |
| 35 | + |
| 36 | +import Testnet.Components.Configuration |
| 37 | +import Testnet.Components.Query |
| 38 | +import Testnet.Components.TestWatchdog |
| 39 | +import Testnet.Defaults |
| 40 | +import qualified Testnet.Process.Cli.DRep as DRep |
| 41 | +import Testnet.Process.Cli.Keys |
| 42 | +import qualified Testnet.Process.Cli.SPO as SPO |
| 43 | +import Testnet.Process.Cli.Transaction |
| 44 | +import qualified Testnet.Process.Run as H |
| 45 | +import Testnet.Property.Util (integrationWorkspace) |
| 46 | +import Testnet.Types |
| 47 | + |
| 48 | +import Hedgehog |
| 49 | +import qualified Hedgehog as H |
| 50 | +import qualified Hedgehog.Extras as H |
| 51 | +import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as IO |
| 52 | + |
| 53 | +-- | Execute me with: |
| 54 | +-- @DISABLE_RETRIES=1 cabal test cardano-testnet-test --test-options '-p "/Committee Motion Of No Confidence/"'@ |
| 55 | +-- Generate a testnet with a committee defined in the Conway genesis. Submit a motion of no confidence |
| 56 | +-- and have the required threshold of SPOs and DReps vote yes on it. |
| 57 | +hprop_gov_no_confidence :: Property |
| 58 | +hprop_gov_no_confidence = integrationWorkspace "no-confidence" $ \tempAbsBasePath' -> runWithDefaultWatchdog_ $ do |
| 59 | + |
| 60 | + conf@Conf { tempAbsPath } <- mkConf tempAbsBasePath' |
| 61 | + let tempAbsPath' = unTmpAbsPath tempAbsPath |
| 62 | + tempBaseAbsPath = makeTmpBaseAbsPath tempAbsPath |
| 63 | + |
| 64 | + work <- H.createDirectoryIfMissing $ tempAbsPath' </> "work" |
| 65 | + |
| 66 | + |
| 67 | + let ceo = ConwayEraOnwardsConway |
| 68 | + sbe = conwayEraOnwardsToShelleyBasedEra ceo |
| 69 | + era = toCardanoEra sbe |
| 70 | + cEra = AnyCardanoEra era |
| 71 | + fastTestnetOptions = cardanoDefaultTestnetOptions |
| 72 | + { cardanoEpochLength = 100 |
| 73 | + , cardanoNodeEra = cEra |
| 74 | + } |
| 75 | + execConfigOffline <- H.mkExecConfigOffline tempBaseAbsPath |
| 76 | + |
| 77 | + -- Step 1. Define generate and define a committee in the genesis file |
| 78 | + |
| 79 | + -- Create committee cold key |
| 80 | + H.createDirectoryIfMissing_ $ tempAbsPath' </> work </> "committee-keys" |
| 81 | + H.forConcurrently_ [1] $ \n -> do |
| 82 | + H.execCli' execConfigOffline |
| 83 | + [ anyEraToString cEra, "governance", "committee" |
| 84 | + , "key-gen-cold" |
| 85 | + , "--cold-verification-key-file", work </> defaultCommitteeVkeyFp n |
| 86 | + , "--cold-signing-key-file", work </> defaultCommitteeSkeyFp n |
| 87 | + ] |
| 88 | + |
| 89 | + committeeVkey1Fp <- H.noteShow $ work </> defaultCommitteeVkeyFp 1 |
| 90 | + |
| 91 | + -- Read committee cold keys from disk to put into conway genesis |
| 92 | + |
| 93 | + comKeyHash1Str <- filter (/= '\n') <$> H.execCli' execConfigOffline |
| 94 | + [ anyEraToString cEra, "governance", "committee" |
| 95 | + , "key-hash" |
| 96 | + , "--verification-key-file", committeeVkey1Fp |
| 97 | + ] |
| 98 | + |
| 99 | + CommitteeColdKeyHash comKeyHash1 <- |
| 100 | + H.evalEither |
| 101 | + $ deserialiseFromRawBytesHex (AsHash AsCommitteeColdKey) |
| 102 | + $ BSC.pack comKeyHash1Str |
| 103 | + |
| 104 | + let comKeyCred1 = L.KeyHashObj comKeyHash1 |
| 105 | + committeeThreshold = unsafeBoundedRational 0.5 |
| 106 | + committee = L.Committee (Map.fromList [(comKeyCred1, EpochNo 100)]) committeeThreshold |
| 107 | + |
| 108 | + alonzoGenesis <- evalEither $ first prettyError defaultAlonzoGenesis |
| 109 | + (startTime, shelleyGenesis') <- getDefaultShelleyGenesis fastTestnetOptions |
| 110 | + let conwayGenesisWithCommittee = |
| 111 | + defaultConwayGenesis { L.cgCommittee = committee } |
| 112 | + |
| 113 | + TestnetRuntime |
| 114 | + { testnetMagic |
| 115 | + , poolNodes |
| 116 | + , wallets=wallet0:_wallet1:_ |
| 117 | + , configurationFile |
| 118 | + } <- cardanoTestnet |
| 119 | + fastTestnetOptions |
| 120 | + conf startTime shelleyGenesis' |
| 121 | + alonzoGenesis conwayGenesisWithCommittee |
| 122 | + |
| 123 | + poolNode1 <- H.headM poolNodes |
| 124 | + poolSprocket1 <- H.noteShow $ nodeSprocket $ poolRuntime poolNode1 |
| 125 | + execConfig <- H.mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic |
| 126 | + |
| 127 | + let socketName' = IO.sprocketName poolSprocket1 |
| 128 | + socketBase = IO.sprocketBase poolSprocket1 -- /tmp |
| 129 | + socketPath = socketBase </> socketName' |
| 130 | + |
| 131 | + H.note_ $ "Sprocket: " <> show poolSprocket1 |
| 132 | + H.note_ $ "Abs path: " <> tempAbsBasePath' |
| 133 | + H.note_ $ "Socketpath: " <> socketPath |
| 134 | + |
| 135 | + mCommitteePresent |
| 136 | + <- H.leftFailM $ findCondition (committeeIsPresent True) configurationFile (File socketPath) (EpochNo 3) |
| 137 | + H.nothingFail mCommitteePresent |
| 138 | + |
| 139 | + -- Step 2. Propose motion of no confidence. DRep and SPO voting thresholds must be met. |
| 140 | + |
| 141 | + -- Create proposal to add a new member to the committee |
| 142 | + |
| 143 | + proposalAnchorFile <- H.note $ work </> "sample-proposal-anchor" |
| 144 | + H.writeFile proposalAnchorFile "dummy anchor data" |
| 145 | + |
| 146 | + proposalAnchorDataHash <- H.execCli' execConfig |
| 147 | + [ eraToString era, "governance" |
| 148 | + , "hash", "anchor-data", "--file-text", proposalAnchorFile |
| 149 | + ] |
| 150 | + |
| 151 | + |
| 152 | + proposalFile <- H.note $ work </> "sample-proposal-anchor" |
| 153 | + stakeVkeyFp <- H.note $ work </> "stake.vkey" |
| 154 | + stakeSKeyFp <- H.note $ work </> "stake.skey" |
| 155 | + |
| 156 | + cliStakeAddressKeyGen |
| 157 | + $ KeyPair (File stakeVkeyFp) (File stakeSKeyFp) |
| 158 | + |
| 159 | + epochStateView <- getEpochStateView configurationFile (File socketPath) |
| 160 | + minActDeposit <- getMinGovActionDeposit epochStateView ceo |
| 161 | + |
| 162 | + void $ H.execCli' execConfig $ |
| 163 | + [ eraToString era, "governance", "action", "create-no-confidence" |
| 164 | + , "--testnet" |
| 165 | + , "--governance-action-deposit", show @Integer minActDeposit |
| 166 | + , "--deposit-return-stake-verification-key-file", stakeVkeyFp |
| 167 | + , "--anchor-url", "https://tinyurl.com/3wrwb2as" |
| 168 | + , "--anchor-data-hash", proposalAnchorDataHash |
| 169 | + , "--out-file", proposalFile |
| 170 | + ] |
| 171 | + |
| 172 | + txbodyFp <- H.note $ work </> "tx.body" |
| 173 | + |
| 174 | + txin1 <- findLargestUtxoForPaymentKey epochStateView sbe wallet0 |
| 175 | + |
| 176 | + void $ H.execCli' execConfig |
| 177 | + [ eraToString era, "transaction", "build" |
| 178 | + , "--change-address", Text.unpack $ paymentKeyInfoAddr wallet0 |
| 179 | + , "--tx-in", Text.unpack $ renderTxIn txin1 |
| 180 | + , "--tx-out", Text.unpack (paymentKeyInfoAddr wallet0) <> "+" <> show @Int 5_000_000 |
| 181 | + , "--proposal-file", proposalFile |
| 182 | + , "--out-file", txbodyFp |
| 183 | + ] |
| 184 | + |
| 185 | + signedProposalTx <- signTx execConfig cEra work "signed-proposal" |
| 186 | + (File txbodyFp) [SomeKeyPair $ paymentKeyInfoPair wallet0] |
| 187 | + |
| 188 | + submitTx execConfig cEra signedProposalTx |
| 189 | + |
| 190 | + -- Step 3. Create and submit votes on motion of no confidence proposal. |
| 191 | + -- Proposal was successfully submitted, now we vote on the proposal |
| 192 | + -- and confirm it was ratified. |
| 193 | + |
| 194 | + governanceActionTxId <- retrieveTransactionId execConfig signedProposalTx |
| 195 | + |
| 196 | + !propSubmittedResult <- findCondition (maybeExtractGovernanceActionIndex (fromString governanceActionTxId)) |
| 197 | + configurationFile |
| 198 | + (File socketPath) |
| 199 | + (EpochNo 10) |
| 200 | + |
| 201 | + governanceActionIndex <- case propSubmittedResult of |
| 202 | + Left e -> |
| 203 | + H.failMessage callStack |
| 204 | + $ "findCondition failed with: " <> displayError e |
| 205 | + Right Nothing -> |
| 206 | + H.failMessage callStack "Couldn't find proposal." |
| 207 | + Right (Just a) -> return a |
| 208 | + |
| 209 | + let spoVotes :: [(String, Int)] |
| 210 | + spoVotes = [("yes", 1), ("yes", 2), ("yes", 3)] |
| 211 | + drepVotes :: [(String, Int)] |
| 212 | + drepVotes = [("yes", 1), ("yes", 2), ("yes", 3)] |
| 213 | + |
| 214 | + spoVoteFiles <- SPO.generateVoteFiles ceo execConfig work "spo-vote-files" |
| 215 | + governanceActionTxId governanceActionIndex |
| 216 | + [(defaultSpoKeys idx, vote) | (vote, idx) <- spoVotes] |
| 217 | + drepVoteFiles <- DRep.generateVoteFiles execConfig work "drep-vote-files" |
| 218 | + governanceActionTxId governanceActionIndex |
| 219 | + [(defaultDRepKeyPair idx, vote) | (vote, idx) <- drepVotes] |
| 220 | + |
| 221 | + let allVoteFiles = spoVoteFiles ++ drepVoteFiles |
| 222 | + annotateShow allVoteFiles |
| 223 | + |
| 224 | + -- Submit votes |
| 225 | + voteTxBodyFp <- DRep.createVotingTxBody execConfig epochStateView sbe work "vote-tx-body" |
| 226 | + allVoteFiles wallet0 |
| 227 | + let spoSigningKeys = [SomeKeyPair $ defaultSpoColdKeyPair n | (_, n) <- spoVotes] |
| 228 | + drepSigningKeys = [SomeKeyPair $ defaultDRepKeyPair n | (_, n) <- drepVotes] |
| 229 | + allVoteSigningKeys = spoSigningKeys ++ drepSigningKeys |
| 230 | + |
| 231 | + voteTxFp <- signTx execConfig cEra work "signed-vote-tx" voteTxBodyFp |
| 232 | + (SomeKeyPair (paymentKeyInfoPair wallet0) : allVoteSigningKeys) |
| 233 | + |
| 234 | + submitTx execConfig cEra voteTxFp |
| 235 | + |
| 236 | + -- Step 4. We confirm the no confidence motion has been ratified by checking |
| 237 | + -- for an empty constitutional committee. |
| 238 | + |
| 239 | + mCommitteeEmpty |
| 240 | + <- H.leftFailM $ findCondition (committeeIsPresent False) configurationFile (File socketPath) (EpochNo 5) |
| 241 | + H.nothingFail mCommitteeEmpty |
| 242 | + |
| 243 | +-- | Checks if the committee is empty or not. |
| 244 | +committeeIsPresent :: Bool -> AnyNewEpochState -> Maybe () |
| 245 | +committeeIsPresent committeeExists (AnyNewEpochState sbe newEpochState) = |
| 246 | + caseShelleyToBabbageOrConwayEraOnwards |
| 247 | + (const $ error "Constitutional committee does not exist pre-Conway era") |
| 248 | + (const $ let mCommittee = newEpochState |
| 249 | + ^. L.nesEsL |
| 250 | + . L.esLStateL |
| 251 | + . L.lsUTxOStateL |
| 252 | + . L.utxosGovStateL |
| 253 | + . L.cgsCommitteeL |
| 254 | + in if committeeExists |
| 255 | + then if isSJust mCommittee |
| 256 | + then Just () -- The committee is non empty and we terminate. |
| 257 | + else Nothing |
| 258 | + else if mCommittee == SNothing |
| 259 | + then Just () -- The committee is empty and we terminate. |
| 260 | + else Nothing |
| 261 | + ) |
| 262 | + sbe |
| 263 | + |
0 commit comments