Fix failing tests

IntersectMBO · May 8, 2024 · ae3ef5d · ae3ef5d
1 parent 0ba3f18
commit ae3ef5d
Show file tree

Hide file tree

Showing 8 changed files with 473 additions and 428 deletions.
diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal
@@ -35,7 +35,7 @@ library
                       , aeson-pretty
                       , ansi-terminal
                       , bytestring
-                      , cardano-api ^>= 8.45
+                      , cardano-api:{cardano-api, internal} ^>= 8.45
                       , cardano-cli ^>= 8.22
                       , cardano-crypto-class
                       , cardano-crypto-wrapper

diff --git a/cardano-testnet/src/Testnet/Property/Utils.hs b/cardano-testnet/src/Testnet/Property/Utils.hs
@@ -8,6 +8,7 @@ module Testnet.Property.Utils
   ( integration
   , integrationRetryWorkspace
   , integrationWorkspace
+  , isBootstrapPhase
   , isLinux
   , runInBackground
 
@@ -22,6 +23,7 @@ module Testnet.Property.Utils
   ) where
 
 import           Cardano.Api
+import           Cardano.Api.ProtocolParameters (ProtocolParameters(..))
 
 import           Cardano.Chain.Genesis (GenesisHash (unGenesisHash), readGenesisData)
 import qualified Cardano.Crypto.Hash.Blake2b as Crypto
@@ -44,6 +46,8 @@ import qualified System.Environment as IO
 import           System.Info (os)
 import qualified System.IO.Unsafe as IO
 
+import           Testnet.Process.Cli
+
 import qualified Hedgehog as H
 import qualified Hedgehog.Extras as H
 import           Hedgehog.Internal.Property (MonadTest)
@@ -123,3 +127,18 @@ runInBackground act = void . H.evalM $ allocate (H.async act) cleanUp
 decodeEraUTxO :: (IsShelleyBasedEra era, MonadTest m) => ShelleyBasedEra era -> Aeson.Value -> m (UTxO era)
 decodeEraUTxO _ = H.jsonErrorFail . Aeson.fromJSON
 
+isBootstrapPhase
+  :: ( HasCallStack
+     , MonadIO m
+     , MonadTest m
+     , MonadCatch m
+     )
+  => String
+  -> H.ExecConfig
+  -> m Bool
+isBootstrapPhase eraName execConfig = do
+  ppJSON <-
+    execCliStdoutToJson execConfig [ eraName, "query", "protocol-parameters" ]
+  protocolParametersOut :: ProtocolParameters <- H.jsonErrorFail $ fromJSON ppJSON
+  let (major, _minor) = protocolParamProtocolVersion protocolParametersOut
+  pure $ major == 9
diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitution.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitution.hs
@@ -23,6 +23,7 @@ import           Prelude
 
 import           Control.Monad
 import           Control.Monad.State.Strict (StateT)
+import           Data.List (isInfixOf)
 import           Data.Maybe
 import           Data.Maybe.Strict
 import           Data.String
@@ -168,58 +169,66 @@ hprop_ledger_events_propose_new_constitution = H.integrationWorkspace "propose-n
   signedProposalTx <- signTx execConfig cEra gov "signed-proposal"
                            (File txbodyFp) [paymentKeyInfoPair wallet1]
 
-  submitTx execConfig cEra signedProposalTx
-
-  governanceActionTxId <- retrieveTransactionId execConfig signedProposalTx
-
-  !propSubmittedResult <- findCondition (maybeExtractGovernanceActionIndex sbe (fromString governanceActionTxId))
-                                        configurationFile
-                                        socketPath
-                                        (EpochNo 10)
-
-  governanceActionIndex <- case propSubmittedResult of
-                             Left e ->
-                               H.failMessage callStack
-                                 $ "findCondition failed with: " <> displayError e
-                             Right Nothing ->
-                               H.failMessage callStack "Couldn't find proposal."
-                             Right (Just a) -> return a
-
-  -- Proposal was successfully submitted, now we vote on the proposal and confirm it was ratified
-  voteFiles <- generateVoteFiles execConfig work "vote-files"
-                                 governanceActionTxId governanceActionIndex
-                                 [(defaultDRepKeyPair idx, vote) | (vote, idx) <- allVotes]
-
-  -- Submit votes
-  voteTxBodyFp <- createVotingTxBody execConfig epochStateView sbe work "vote-tx-body"
-                                     voteFiles wallet0
-
-  voteTxFp <- signTx execConfig cEra gov "signed-vote-tx" voteTxBodyFp
-                     (paymentKeyInfoPair wallet0:[defaultDRepKeyPair n | (_, n) <- allVotes])
-  submitTx execConfig cEra voteTxFp
-
-  -- We check that constitution was succcessfully ratified
-
-  !eConstitutionAdopted
-    <- evalIO . runExceptT $ foldEpochState
-                      (File configurationFile)
-                      (File socketPath)
-                      FullValidation
-                      (EpochNo 10)
-                      ()
-                      (\epochState _ _ -> foldBlocksCheckConstitutionWasRatified constitutionHash constitutionScriptHash epochState)
-
-  void $ evalEither eConstitutionAdopted
-
-  -- Tally registered votes
-  govState <- getGovState epochStateView ceo
-  govActionState <- H.headM $ govState ^. L.cgsProposalsL . L.pPropsL . to toList
-  let votes = govActionState ^. L.gasDRepVotesL . to toList
-
-  length (filter ((== L.VoteYes) . snd) votes) === 4
-  length (filter ((== L.VoteNo) . snd) votes) === 3
-  length (filter ((== L.Abstain) . snd) votes) === 2
-  length votes === numVotes
+  bootstrapPhase <- H.isBootstrapPhase (anyEraToString cEra) execConfig
+  if bootstrapPhase then do
+    (_code, _out, err) <- H.execCliAny execConfig
+      [ anyEraToString cEra, "transaction", "submit"
+      , "--tx-file", unFile signedProposalTx
+      ]
+    assert ("DisallowedProposalDuringBootstrap" `isInfixOf` err)
+  else do
+    submitTx execConfig cEra signedProposalTx
+
+    governanceActionTxId <- retrieveTransactionId execConfig signedProposalTx
+
+    !propSubmittedResult <- findCondition (maybeExtractGovernanceActionIndex sbe (fromString governanceActionTxId))
+                                          configurationFile
+                                          socketPath
+                                          (EpochNo 10)
+
+    governanceActionIndex <- case propSubmittedResult of
+                              Left e ->
+                                H.failMessage callStack
+                                  $ "findCondition failed with: " <> displayError e
+                              Right Nothing ->
+                                H.failMessage callStack "Couldn't find proposal."
+                              Right (Just a) -> return a
+
+    -- Proposal was successfully submitted, now we vote on the proposal and confirm it was ratified
+    voteFiles <- generateVoteFiles execConfig work "vote-files"
+                                  governanceActionTxId governanceActionIndex
+                                  [(defaultDRepKeyPair idx, vote) | (vote, idx) <- allVotes]
+
+    -- Submit votes
+    voteTxBodyFp <- createVotingTxBody execConfig epochStateView sbe work "vote-tx-body"
+                                      voteFiles wallet0
+
+    voteTxFp <- signTx execConfig cEra gov "signed-vote-tx" voteTxBodyFp
+                      (paymentKeyInfoPair wallet0:[defaultDRepKeyPair n | (_, n) <- allVotes])
+    submitTx execConfig cEra voteTxFp
+
+    -- We check that constitution was succcessfully ratified
+
+    !eConstitutionAdopted
+      <- evalIO . runExceptT $ foldEpochState
+                        (File configurationFile)
+                        (File socketPath)
+                        FullValidation
+                        (EpochNo 10)
+                        ()
+                        (\epochState _ _ -> foldBlocksCheckConstitutionWasRatified constitutionHash constitutionScriptHash epochState)
+
+    void $ evalEither eConstitutionAdopted
+
+    -- Tally registered votes
+    govState <- getGovState epochStateView ceo
+    govActionState <- H.headM $ govState ^. L.cgsProposalsL . L.pPropsL . to toList
+    let votes = govActionState ^. L.gasDRepVotesL . to toList
+
+    length (filter ((== L.VoteYes) . snd) votes) === 4
+    length (filter ((== L.VoteNo) . snd) votes) === 3
+    length (filter ((== L.Abstain) . snd) votes) === 2
+    length votes === numVotes
 
 foldBlocksCheckConstitutionWasRatified
   :: String -- submitted constitution hash
@@ -251,4 +260,3 @@ filterRatificationState c guardRailScriptHash (AnyNewEpochState sbe newEpochStat
 
     )
     sbe
-
diff --git a/...o-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitutionSPO.hs b/...o-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitutionSPO.hs
@@ -20,12 +20,14 @@ import           Prelude
 
 import           Control.Monad.Trans.State.Strict (put)
 import           Data.Bifunctor (Bifunctor (..))
+import           Data.List (isInfixOf)
 import qualified Data.Map.Strict as Map
 import qualified Data.Text as Text
 import           GHC.Stack (HasCallStack)
 import           Lens.Micro
 import           System.FilePath ((</>))
 
+import           Testnet.Components.Configuration
 import           Testnet.Components.DReps (createVotingTxBody, failToSubmitTx,
                    retrieveTransactionId, signTx, submitTx)
 import           Testnet.Components.Query
@@ -140,34 +142,42 @@ hprop_ledger_events_propose_new_constitution_spo = H.integrationWorkspace "propo
 
   txBodySigned <- signTx execConfig cEra work "proposal-signed-tx" (File txBodyFp) [paymentKeyInfoPair wallet0]
 
-  submitTx execConfig cEra txBodySigned
+  bootstrapPhase <- H.isBootstrapPhase (anyEraToString cEra) execConfig
+  if bootstrapPhase then do
+    (_code, _out, err) <- H.execCliAny execConfig
+      [ anyEraToString cEra, "transaction", "submit"
+      , "--tx-file", unFile txBodySigned
+      ]
+    assert ("DisallowedProposalDuringBootstrap" `isInfixOf` err)
+  else do
+    submitTx execConfig cEra txBodySigned
 
-  txIdString <- retrieveTransactionId execConfig txBodySigned
+    txIdString <- retrieveTransactionId execConfig txBodySigned
 
-  currentEpoch <- getCurrentEpochNo epochStateView
+    currentEpoch <- getCurrentEpochNo epochStateView
 
-  -- Proposal should be there already, so don't wait a lot:
-  let terminationEpoch = succ . succ $ currentEpoch
+    -- Proposal should be there already, so don't wait a lot:
+    let terminationEpoch = succ . succ $ currentEpoch
 
-  mGovActionId <- getConstitutionProposal (Api.File configurationFile) (Api.File socketPath) terminationEpoch
-  govActionId <- H.evalMaybe mGovActionId
+    mGovActionId <- getConstitutionProposal (Api.File configurationFile) (Api.File socketPath) terminationEpoch
+    govActionId <- H.evalMaybe mGovActionId
 
-  -- Proposal was successfully submitted, now we vote on the proposal and confirm it was ratified
+    -- Proposal was successfully submitted, now we vote on the proposal and confirm it was ratified
 
-  let L.GovActionIx governanceActionIndex = L.gaidGovActionIx govActionId
+    let L.GovActionIx governanceActionIndex = L.gaidGovActionIx govActionId
 
-  votes <- generateVoteFiles ceo execConfig work "vote-files" txIdString governanceActionIndex
-                             [(defaultSPOKeys n, "yes") | n <- [1..3]]
+    votes <- generateVoteFiles ceo execConfig work "vote-files" txIdString governanceActionIndex
+                              [(defaultSPOKeys n, "yes") | n <- [1..3]]
 
-  -- Submit votes
-  votesTxBody <- createVotingTxBody execConfig epochStateView sbe work "vote-tx-body" votes wallet0
+    -- Submit votes
+    votesTxBody <- createVotingTxBody execConfig epochStateView sbe work "vote-tx-body" votes wallet0
 
-  votesSignedTx <- signTx execConfig cEra work "vote-signed-tx"
-                     votesTxBody (SomeKeyPair (paymentKeyInfoPair wallet0)
-                                  :[SomeKeyPair $ defaultSPOColdKeyPair n | n <- [1..3]])
+    votesSignedTx <- signTx execConfig cEra work "vote-signed-tx"
+                      votesTxBody (SomeKeyPair (paymentKeyInfoPair wallet0)
+                                    :[SomeKeyPair $ defaultSPOColdKeyPair n | n <- [1..3]])
 
-  -- Call should fail, because SPOs are unallowed to vote on the constitution
-  failToSubmitTx execConfig cEra votesSignedTx "DisallowedVoters"
+    -- Call should fail, because SPOs are unallowed to vote on the constitution
+    failToSubmitTx execConfig cEra votesSignedTx "DisallowedVoters"
 
 getConstitutionProposal
   :: (HasCallStack, MonadIO m, MonadTest m)