Test SPOs cannot vote PParam change proposals

cardano-testnet/cardano-testnet.cabal

@@ -193,6 +193,7 @@ test-suite cardano-testnet-test
                         Cardano.Testnet.Test.Gov.DRepRetirement
                         Cardano.Testnet.Test.Gov.InfoAction
                         Cardano.Testnet.Test.Gov.NoConfidence
+                        Cardano.Testnet.Test.Gov.PParamChangeFailsSPO
                         Cardano.Testnet.Test.Gov.ProposeNewConstitution
                         Cardano.Testnet.Test.Gov.ProposeNewConstitutionSPO
                         Cardano.Testnet.Test.Gov.TreasuryGrowth

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

@@ -7,6 +7,8 @@
 
 module Cardano.Testnet.Test.Gov.DRepActivity
   ( hprop_check_drep_activity
+  , makeActivityChangeProposal
+  , voteChangeProposal
   ) where
 
 import           Cardano.Api as Api

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

@@ -0,0 +1,132 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Cardano.Testnet.Test.Gov.PParamChangeFailsSPO
+  ( hprop_check_pparam_fails_spo
+  ) where
+
+import           Cardano.Api as Api
+import           Cardano.Api.Ledger (EpochInterval (EpochInterval))
+
+import           Cardano.Testnet
+import           Cardano.Testnet.Test.Gov.DRepActivity (makeActivityChangeProposal)
+
+import           Prelude
+
+import           Control.Monad.Catch (MonadCatch)
+import           Data.Typeable (Typeable)
+import           Data.Word (Word32)
+import           System.FilePath ((</>))
+
+import           Testnet.Components.Query
+import           Testnet.Defaults (defaultSpoColdKeyPair, defaultSpoKeys)
+import           Testnet.Process.Cli.DRep
+import qualified Testnet.Process.Cli.SPO as SPO
+import           Testnet.Process.Cli.Transaction (failToSubmitTx, signTx)
+import           Testnet.Process.Run (mkExecConfig)
+import           Testnet.Property.Util (integrationWorkspace)
+import           Testnet.Types
+
+import           Hedgehog (Property, annotateShow)
+import qualified Hedgehog.Extras as H
+import           Hedgehog.Internal.Property (MonadTest)
+import           Hedgehog.Internal.Source (HasCallStack, withFrozenCallStack)
+
+-- | Test that SPOs cannot vote on a Protocol Parameter change
+-- | Execute me with:
+-- @DISABLE_RETRIES=1 cabal test cardano-testnet-test --test-options '-p "/PParam change fails for SPO/"'@
+hprop_check_pparam_fails_spo :: Property
+hprop_check_pparam_fails_spo = integrationWorkspace "test-pparam-spo" $ \tempAbsBasePath' ->
+                                 H.runWithDefaultWatchdog_ $ do
+  -- Start a local test net
+  conf@Conf { tempAbsPath } <- mkConf tempAbsBasePath'
+  let tempAbsPath' = unTmpAbsPath tempAbsPath
+      tempBaseAbsPath = makeTmpBaseAbsPath tempAbsPath
+
+  work <- H.createDirectoryIfMissing $ tempAbsPath' </> "work"
+
+  -- Create default testnet
+  let ceo = ConwayEraOnwardsConway
+      sbe = conwayEraOnwardsToShelleyBasedEra ceo
+      era = toCardanoEra sbe
+      cEra = AnyCardanoEra era
+      fastTestnetOptions = cardanoDefaultTestnetOptions
+        { cardanoEpochLength = 200
+        , cardanoNodeEra = cEra
+        }
+
+  TestnetRuntime
+    { testnetMagic
+    , poolNodes
+    , wallets=wallet0:wallet1:_wallet2:_
+    , configurationFile
+    }
+    <- cardanoTestnetDefault fastTestnetOptions conf
+
+  PoolNode{poolRuntime} <- H.headM poolNodes
+  poolSprocket1 <- H.noteShow $ nodeSprocket poolRuntime
+  execConfig <- mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic
+  let socketPath = nodeSocketPath poolRuntime
+
+  epochStateView <- getEpochStateView configurationFile socketPath
+
+  H.note_ $ "Sprocket: " <> show poolSprocket1
+  H.note_ $ "Abs path: " <> tempAbsBasePath'
+  H.note_ $ "Socketpath: " <> unFile socketPath
+  H.note_ $ "Foldblocks config file: " <> unFile configurationFile
+
+  gov <- H.createDirectoryIfMissing $ work </> "governance"
+
+  baseDir <- H.createDirectoryIfMissing $ gov </> "output"
+
+
+  let propVotes :: [(String, Int)]
+      propVotes = zip (concatMap (uncurry replicate) [(1, "yes")]) [1..]
+  annotateShow propVotes
+
+  (governanceActionTxId, governanceActionIndex) <-
+    makeActivityChangeProposal execConfig epochStateView ceo baseDir "proposal"
+                               Nothing (EpochInterval 3) wallet0 (EpochInterval 2)
+
+  failToVoteChangeProposalWithSPOs ceo execConfig epochStateView sbe baseDir "vote"
+                                   governanceActionTxId governanceActionIndex propVotes wallet1
+
+-- | Cast votes for a governance action with SPO keys.
+failToVoteChangeProposalWithSPOs
+  :: (HasCallStack, MonadTest m, MonadIO m, MonadCatch m, H.MonadAssertion m, Typeable era)
+  => ConwayEraOnwards era -- ^ The conway era onwards witness for the era in which the
+                          -- transaction will be constructed.
+  -> H.ExecConfig -- ^ Specifies the CLI execution configuration.v
+  -> EpochStateView -- ^ Current epoch state view for transaction building. It can be obtained
+                    -- using the 'getEpochStateView' function.
+  -> ShelleyBasedEra era -- ^ The 'ShelleyBasedEra' witness for current era.
+  -> FilePath -- ^ Base directory path where generated files will be stored.
+  -> String -- ^ Name for the subfolder that will be created under 'work' folder.
+  -> String -- ^ The transaction id of the governance action to vote.
+  -> Word32 -- ^ The index of the governance action to vote.
+  -> [([Char], Int)] -- ^ Votes to be casted for the proposal. Each tuple contains the index
+                     -- of the default SPO that will make the vote and the type of the vote
+                     -- (i.e: "yes", "no", "abstain").
+  -> PaymentKeyInfo -- ^ Wallet that will pay for the transaction.
+  -> m ()
+failToVoteChangeProposalWithSPOs ceo execConfig epochStateView sbe work prefix
+                                 governanceActionTxId governanceActionIndex votes wallet = withFrozenCallStack $ do
+  baseDir <- H.createDirectoryIfMissing $ work </> prefix
+
+  let era = toCardanoEra sbe
+      cEra = AnyCardanoEra era
+
+  voteFiles <- SPO.generateVoteFiles ceo execConfig baseDir "vote-files"
+                                     governanceActionTxId governanceActionIndex
+                                     [(defaultSpoKeys idx, vote) | (vote, idx) <- votes]
+
+  voteTxBodyFp <- createVotingTxBody execConfig epochStateView sbe baseDir "vote-tx-body"
+                                     voteFiles wallet
+
+  let signingKeys = SomeKeyPair (paymentKeyInfoPair wallet):(SomeKeyPair . defaultSpoColdKeyPair . snd <$> votes)
+  voteTxFp <- signTx execConfig cEra baseDir "signed-vote-tx" voteTxBodyFp signingKeys
+
+  failToSubmitTx execConfig cEra voteTxFp "DisallowedVoters"

cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs

@@ -17,6 +17,7 @@ import qualified Cardano.Testnet.Test.Gov.CommitteeAddNew as Gov
 import qualified Cardano.Testnet.Test.Gov.DRepDeposit as Gov
 import qualified Cardano.Testnet.Test.Gov.DRepRetirement as Gov
 import qualified Cardano.Testnet.Test.Gov.NoConfidence as Gov
+import qualified Cardano.Testnet.Test.Gov.PParamChangeFailsSPO as Gov
 import qualified Cardano.Testnet.Test.Gov.ProposeNewConstitution as Gov
 import qualified Cardano.Testnet.Test.Gov.ProposeNewConstitutionSPO as Gov
 import qualified Cardano.Testnet.Test.Gov.TreasuryGrowth as Gov
@@ -59,6 +60,7 @@ tests = do
                 , ignoreOnMacAndWindows "Propose And Ratify New Constitution" Gov.hprop_ledger_events_propose_new_constitution
                 , ignoreOnWindows "Propose New Constitution SPO" Gov.hprop_ledger_events_propose_new_constitution_spo
                 , ignoreOnWindows "Treasury Withdrawal" Gov.hprop_ledger_events_treasury_withdrawal
+                , ignoreOnWindows "PParam change fails for SPO" Gov.hprop_check_pparam_fails_spo
                 -- FIXME Those tests are flaky
                 -- , ignoreOnWindows "InfoAction" LedgerEvents.hprop_ledger_events_info_action
                 ]