Fix failing tests

cardano-testnet/src/Testnet/Property/Util.hs

@@ -8,6 +8,7 @@ module Testnet.Property.Util
   ( integration
   , integrationRetryWorkspace
   , integrationWorkspace
+  , isBootstrapPhase
   , isLinux
   , runInBackground
 
@@ -22,6 +23,7 @@ module Testnet.Property.Util
   ) 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

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitution.hs

@@ -24,6 +24,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
@@ -169,48 +170,56 @@ 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
-
-  _ <- waitForEpochs epochStateView (EpochInterval 1)
-
-  -- Count votes before checking for ratification. It may happen that the proposal gets removed after
-  -- ratification because of a long waiting time, so we won't be able to access 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
+
+    _ <- waitForEpochs epochStateView (EpochInterval 1)
+
+    -- Count votes before checking for ratification. It may happen that the proposal gets removed after
+    -- ratification because of a long waiting time, so we won't be able to access 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
 
   -- We check that constitution was succcessfully ratified
   void . H.leftFailM . evalIO . runExceptT $
@@ -252,4 +261,3 @@ filterRatificationState c guardRailScriptHash (AnyNewEpochState sbe newEpochStat
 
     )
     sbe
-

cardano-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.DRep (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)

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryWithdrawal.hs

@@ -29,6 +29,7 @@ import           Prelude
 import           Control.Monad
 import           Control.Monad.State.Class
 import           Data.Bifunctor (Bifunctor (..))
+import           Data.List (isInfixOf)
 import           Data.Map (Map)
 import qualified Data.Map.Strict as M
 import qualified Data.Text as Text
@@ -189,75 +190,83 @@ hprop_ledger_events_treasury_withdrawal = H.integrationRetryWorkspace 1  "treasu
     , "--out-file", txbodySignedFp
     ]
 
-  void $ H.execCli' execConfig
-    [ eraName, "transaction", "submit"
-    , "--tx-file", txbodySignedFp
-    ]
+  bootstrapPhase <- H.isBootstrapPhase eraName execConfig
+  if bootstrapPhase then do
+    (_code, _out, err) <- H.execCliAny execConfig
+      [ eraName, "transaction", "submit"
+      , "--tx-file", txbodySignedFp
+      ]
+    assert ("DisallowedProposalDuringBootstrap" `isInfixOf` err)
+  else do
+    void $ H.execCli' execConfig
+      [ eraName, "transaction", "submit"
+      , "--tx-file", txbodySignedFp
+      ]
   -- }}}
 
-  txidString <- mconcat . lines <$> H.execCli' execConfig
-    [ "transaction", "txid"
-    , "--tx-file", txbodySignedFp
-    ]
-
-  currentEpoch <- getCurrentEpochNo epochStateView
-  let terminationEpoch = succ . succ $ currentEpoch
-  L.GovActionIx governanceActionIndex <- fmap L.gaidGovActionIx . H.nothingFailM $
-    getTreasuryWithdrawalProposal (File configurationFile) (File socketPath) terminationEpoch
-
-  let voteFp :: Int -> FilePath
-      voteFp n = work </> gov </> "vote-" <> show n
-
-  -- Proposal was successfully submitted, now we vote on the proposal and confirm it was ratified
-  H.forConcurrently_ [1..3] $ \n -> do
-    H.execCli' execConfig
-      [ eraName, "governance", "vote", "create"
-      , "--yes"
-      , "--governance-action-tx-id", txidString
-      , "--governance-action-index", show governanceActionIndex
-      , "--drep-verification-key-file", defaultDRepVkeyFp n
-      , "--out-file", voteFp n
+    txidString <- mconcat . lines <$> H.execCli' execConfig
+      [ "transaction", "txid"
+      , "--tx-file", txbodySignedFp
       ]
 
-  txin4 <- findLargestUtxoForPaymentKey epochStateView sbe wallet1
-
-  voteTxFp <- H.note $ work </> gov </> "vote.tx"
-  voteTxBodyFp <- H.note $ work </> gov </> "vote.txbody"
-  -- {{{ Submit votes
-  void $ H.execCli' execConfig
-    [ eraName, "transaction", "build"
-    , "--change-address", Text.unpack $ paymentKeyInfoAddr wallet1
-    , "--tx-in", Text.unpack $ renderTxIn txin4
-    , "--tx-out", Text.unpack (paymentKeyInfoAddr wallet0) <> "+" <> show @Int 3_000_000
-    , "--vote-file", voteFp 1
-    , "--vote-file", voteFp 2
-    , "--vote-file", voteFp 3
-    , "--witness-override", show @Int 4
-    , "--out-file", voteTxBodyFp
-    ]
+    currentEpoch <- getCurrentEpochNo epochStateView
+    let terminationEpoch = succ . succ $ currentEpoch
+    L.GovActionIx governanceActionIndex <- fmap L.gaidGovActionIx . H.nothingFailM $
+      getTreasuryWithdrawalProposal (File configurationFile) (File socketPath) terminationEpoch
+
+    let voteFp :: Int -> FilePath
+        voteFp n = work </> gov </> "vote-" <> show n
+
+    -- Proposal was successfully submitted, now we vote on the proposal and confirm it was ratified
+    H.forConcurrently_ [1..3] $ \n -> do
+      H.execCli' execConfig
+        [ eraName, "governance", "vote", "create"
+        , "--yes"
+        , "--governance-action-tx-id", txidString
+        , "--governance-action-index", show governanceActionIndex
+        , "--drep-verification-key-file", defaultDRepVkeyFp n
+        , "--out-file", voteFp n
+        ]
+
+    txin4 <- findLargestUtxoForPaymentKey epochStateView sbe wallet1
+
+    voteTxFp <- H.note $ work </> gov </> "vote.tx"
+    voteTxBodyFp <- H.note $ work </> gov </> "vote.txbody"
+    -- {{{ Submit votes
+    void $ H.execCli' execConfig
+      [ eraName, "transaction", "build"
+      , "--change-address", Text.unpack $ paymentKeyInfoAddr wallet1
+      , "--tx-in", Text.unpack $ renderTxIn txin4
+      , "--tx-out", Text.unpack (paymentKeyInfoAddr wallet0) <> "+" <> show @Int 3_000_000
+      , "--vote-file", voteFp 1
+      , "--vote-file", voteFp 2
+      , "--vote-file", voteFp 3
+      , "--witness-override", show @Int 4
+      , "--out-file", voteTxBodyFp
+      ]
 
-  void $ H.execCli' execConfig
-    [ eraName, "transaction", "sign"
-    , "--tx-body-file", voteTxBodyFp
-    , "--signing-key-file", paymentSKey $ paymentKeyInfoPair wallet1
-    , "--signing-key-file", defaultDRepSkeyFp 1
-    , "--signing-key-file", defaultDRepSkeyFp 2
-    , "--signing-key-file", defaultDRepSkeyFp 3
-    , "--out-file", voteTxFp
-    ]
+    void $ H.execCli' execConfig
+      [ eraName, "transaction", "sign"
+      , "--tx-body-file", voteTxBodyFp
+      , "--signing-key-file", paymentSKey $ paymentKeyInfoPair wallet1
+      , "--signing-key-file", defaultDRepSkeyFp 1
+      , "--signing-key-file", defaultDRepSkeyFp 2
+      , "--signing-key-file", defaultDRepSkeyFp 3
+      , "--out-file", voteTxFp
+      ]
 
-  void $ H.execCli' execConfig
-    [ eraName, "transaction", "submit"
-    , "--tx-file", voteTxFp
-    ]
-  -- }}}
+    void $ H.execCli' execConfig
+      [ eraName, "transaction", "submit"
+      , "--tx-file", voteTxFp
+      ]
+    -- }}}
 
-  withdrawals <- H.nothingFailM $
-    getCurrentEpochNo epochStateView >>=
-      getAnyWithdrawals (File configurationFile) (File socketPath) . (`L.addEpochInterval` EpochInterval 5)
+    withdrawals <- H.nothingFailM $
+      getCurrentEpochNo epochStateView >>=
+        getAnyWithdrawals (File configurationFile) (File socketPath) . (`L.addEpochInterval` EpochInterval 5)
 
-  H.noteShow_ withdrawals
-  (L.unCoin . snd <$> M.toList withdrawals) === [withdrawalAmount]
+    H.noteShow_ withdrawals
+    (L.unCoin . snd <$> M.toList withdrawals) === [withdrawalAmount]
 
 
 getAnyWithdrawals
@@ -313,4 +322,3 @@ getTreasuryWithdrawalProposal nodeConfigFile socketPath maxEpoch = withFrozenCal
               _ ->
                 pure ConditionNotMet
           ) actualEra
-