wip

cardano-testnet/cardano-testnet.cabal

@@ -188,6 +188,7 @@ test-suite cardano-testnet-test
                         Cardano.Testnet.Test.FoldBlocks
                         Cardano.Testnet.Test.Misc
 
+                        Cardano.Testnet.Test.LedgerEvents.Gov.ConstitutionalCommittee
                         Cardano.Testnet.Test.LedgerEvents.Gov.DRepDeposits
                         Cardano.Testnet.Test.LedgerEvents.Gov.InfoAction
                         Cardano.Testnet.Test.LedgerEvents.Gov.ProposeNewConstitution

cardano-testnet/src/Testnet/EpochStateProcessing.hs

@@ -1,32 +1,31 @@
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
 
 module Testnet.EpochStateProcessing
   ( maybeExtractGovernanceActionIndex
   , findCondition
   ) where
 
-import           Cardano.Api (AnyNewEpochState (..), ConwayEra, EpochNo, File (File),
-                   FoldBlocksError, LedgerStateCondition (..), MonadIO, ShelleyBasedEra,
-                   ValidationMode (FullValidation), foldEpochState, runExceptT,
-                   shelleyBasedEraConstraints)
-import qualified Cardano.Api as Api
+import           Cardano.Api
 import           Cardano.Api.Ledger (GovActionId (..))
 import qualified Cardano.Api.Ledger as L
 
 import qualified Cardano.Ledger.Conway.Governance as L
-import           Cardano.Ledger.Shelley.API (TxId (..))
+import qualified Cardano.Ledger.Shelley.API as L
 import qualified Cardano.Ledger.Shelley.LedgerState as L
 
 import           Prelude
 
 import           Control.Monad.State.Strict (MonadState (put), StateT)
 import           Data.Data ((:~:) (..))
 import qualified Data.Map as Map
-import           Data.Type.Equality (TestEquality (..))
 import           Data.Word (Word32)
 import           GHC.Stack
 import           Lens.Micro ((^.))
 
+import           Testnet.Property.Assert (assertErasEqual)
+
 import           Hedgehog
 
 findCondition
@@ -58,20 +57,19 @@ findCondition epochStateFoldFunc configurationFile socketPath maxEpochNo = withF
         Just x -> put (Just x) >> pure ConditionMet
         Nothing -> pure ConditionNotMet
 
-maybeExtractGovernanceActionIndex :: ShelleyBasedEra ConwayEra -- ^ The era in which the test runs
-  -> Api.TxId
+maybeExtractGovernanceActionIndex
+  :: forall era. HasCallStack
+  => ConwayEraOnwards era -- ^ The era in which the test runs
+  -> TxId -- ^ transaction id searched for
   -> AnyNewEpochState
   -> Maybe Word32
-maybeExtractGovernanceActionIndex sbe txid (AnyNewEpochState actualEra newEpochState) =
-  case testEquality sbe actualEra of
-          Just Refl -> do
-            let proposals = shelleyBasedEraConstraints sbe newEpochState
-                          ^. L.newEpochStateGovStateL
-                           . L.proposalsGovStateL
-            Map.foldlWithKey' (compareWithTxId txid) Nothing (L.proposalsActionsMap proposals)
-          Nothing -> do
-            error $ "Eras mismatch! expected: " <> show sbe <> ", actual: " <> show actualEra
+maybeExtractGovernanceActionIndex ceo txid (AnyNewEpochState actualEra newEpochState) = conwayEraOnwardsConstraints ceo $ do
+  let sbe = conwayEraOnwardsToShelleyBasedEra ceo
+  Refl <- either error pure $ assertErasEqual sbe actualEra
+  let proposals = newEpochState ^. L.newEpochStateGovStateL . L.proposalsGovStateL
+  Map.foldlWithKey' (compareWithTxId txid) Nothing (L.proposalsActionsMap proposals)
   where
-    compareWithTxId (Api.TxId ti1) Nothing (GovActionId (TxId ti2) (L.GovActionIx gai)) _
+    compareWithTxId (TxId ti1) Nothing (GovActionId (L.TxId ti2) (L.GovActionIx gai)) _
       | ti1 == L.extractHash ti2 = Just gai
     compareWithTxId _ x _ _ = x
+

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

@@ -177,9 +177,12 @@ getRelevantSlots poolNodeStdoutFile slotLowerBound = do
 
 assertErasEqual
   :: HasCallStack
+  => TestEquality eon
+  => Show (eon expectedEra)
+  => Show (eon receivedEra)
   => MonadError String m
-  => ShelleyBasedEra expectedEra
-  -> ShelleyBasedEra receivedEra
+  => eon expectedEra
+  -> eon receivedEra
   -> m (expectedEra :~: receivedEra)
 assertErasEqual expectedEra receivedEra = withFrozenCallStack $
   case testEquality expectedEra receivedEra of

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

@@ -0,0 +1,126 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Cardano.Testnet.Test.LedgerEvents.Gov.ConstitutionalCommittee
+  ( hprop_constitutional_committee
+  ) where
+
+import           Cardano.Api as Api
+import           Cardano.Api.Error (displayError)
+
+import qualified Cardano.Crypto.Hash as L
+import qualified Cardano.Ledger.Conway.Governance as L
+import qualified Cardano.Ledger.Conway.Governance as Ledger
+import qualified Cardano.Ledger.Hashes as L
+import qualified Cardano.Ledger.Shelley.LedgerState as L
+import           Cardano.Testnet
+
+import           Prelude
+
+import           Control.Monad
+import           Control.Monad.State.Strict (StateT)
+import           Data.Maybe
+import           Data.Maybe.Strict
+import           Data.String
+import qualified Data.Text as Text
+import           GHC.Exts (IsList (..))
+import           GHC.Stack (callStack)
+import           Lens.Micro
+import           System.FilePath ((</>))
+
+import           Testnet.Components.Configuration
+import           Testnet.Components.DReps (createVotingTxBody, generateVoteFiles,
+                   retrieveTransactionId, signTx, submitTx)
+import           Testnet.Components.Query
+import           Testnet.Components.TestWatchdog
+import           Testnet.Defaults
+import qualified Testnet.Process.Cli as P
+import qualified Testnet.Process.Run as H
+import qualified Testnet.Property.Utils as H
+import           Testnet.Runtime
+
+import           Hedgehog
+import qualified Hedgehog.Extras as H
+import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as IO
+
+hprop_constitutional_committee :: Property
+hprop_constitutional_committee = H.integrationWorkspace "constitutional-committee" $ \tempAbsBasePath' -> runWithDefaultWatchdog_ $ do
+  -- Start a local test net
+  conf@Conf { tempAbsPath } <- mkConf tempAbsBasePath'
+  let tempAbsPath' = unTmpAbsPath tempAbsPath
+      tempBaseAbsPath = makeTmpBaseAbsPath tempAbsPath
+
+  work <- H.createDirectoryIfMissing $ tempAbsPath' </> "work"
+
+  -- Generate model for votes
+  let allVotes :: [(String, Int)]
+      allVotes = zip (concatMap (uncurry replicate) [(4, "yes"), (3, "no"), (2, "abstain")]) [1..]
+  annotateShow allVotes
+
+  let numVotes :: Int
+      numVotes = length allVotes
+  annotateShow numVotes
+
+  let ceo = ConwayEraOnwardsConway
+      sbe = conwayEraOnwardsToShelleyBasedEra ceo
+      era = toCardanoEra sbe
+      cEra = AnyCardanoEra era
+      fastTestnetOptions = cardanoDefaultTestnetOptions
+        { cardanoEpochLength = 100
+        , cardanoNodeEra = cEra
+        , cardanoNumDReps = numVotes
+        }
+
+  TestnetRuntime
+    { testnetMagic
+    , poolNodes
+    , wallets=wallet0:wallet1:_
+    , configurationFile
+    }
+    <- cardanoTestnetDefault fastTestnetOptions conf
+
+  poolNode1 <- H.headM poolNodes
+  poolSprocket1 <- H.noteShow $ nodeSprocket $ poolRuntime poolNode1
+  execConfig <- H.mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic
+
+  let socketName' = IO.sprocketName poolSprocket1
+      socketBase = IO.sprocketBase poolSprocket1 -- /tmp
+      socketPath = socketBase </> socketName'
+
+  epochStateView <- getEpochStateView (File configurationFile) (File socketPath)
+
+  H.note_ $ "Sprocket: " <> show poolSprocket1
+  H.note_ $ "Abs path: " <> tempAbsBasePath'
+  H.note_ $ "Socketpath: " <> socketPath
+  H.note_ $ "Foldblocks config file: " <> configurationFile
+
+  -- Create Conway constitution
+  gov <- H.createDirectoryIfMissing $ work </> "governance"
+  proposalAnchorFile <- H.note $ gov </> "sample-proposal-anchor"
+  consitutionFile <- H.note $ gov </> "sample-constitution"
+  constitutionActionFp <- H.note $ gov </> "constitution.action"
+
+  H.writeFile proposalAnchorFile "dummy anchor data"
+  H.writeFile consitutionFile "dummy constitution data"
+  constitutionHash <- H.execCli' execConfig
+    [ "conway", "governance"
+    , "hash", "anchor-data", "--file-text", consitutionFile
+    ]
+
+  proposalAnchorDataHash <- H.execCli' execConfig
+    [ "conway", "governance"
+    , "hash", "anchor-data", "--file-text", proposalAnchorFile
+    ]
+
+  let stakeVkeyFp = gov </> "stake.vkey"
+      stakeSKeyFp = gov </> "stake.skey"
+
+  _ <- P.cliStakeAddressKeyGen tempAbsPath'
+         $ P.KeyNames { P.verificationKeyFile = stakeVkeyFp
+                      , P.signingKeyFile = stakeSKeyFp
+                      }
+
+  failure

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

@@ -308,7 +308,7 @@ makeActivityChangeProposal execConfig epochStateView configurationFile socketPat
 
   governanceActionTxId <- retrieveTransactionId execConfig signedProposalTx
 
-  !propSubmittedResult <- findCondition (maybeExtractGovernanceActionIndex sbe (fromString governanceActionTxId))
+  !propSubmittedResult <- findCondition (maybeExtractGovernanceActionIndex ceo (fromString governanceActionTxId))
                                         (unFile configurationFile)
                                         (unFile socketPath)
                                         (EpochNo timeout)

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

@@ -55,8 +55,9 @@ hprop_ledger_events_info_action = H.integrationRetryWorkspace 0 "info-hash" $ \t
 
   work <- H.createDirectoryIfMissing $ tempAbsPath' </> "work"
 
-  let sbe = ShelleyBasedEraConway
+  let ceo = ConwayEraOnwardsConway
       era = toCardanoEra sbe
+      sbe = conwayEraOnwardsToShelleyBasedEra ceo
       fastTestnetOptions = cardanoDefaultTestnetOptions
         { cardanoEpochLength = 100
         , cardanoNodeEra = AnyCardanoEra era
@@ -147,7 +148,7 @@ hprop_ledger_events_info_action = H.integrationRetryWorkspace 0 "info-hash" $ \t
     , "--tx-file", txbodySignedFp
     ]
 
-  !propSubmittedResult <- findCondition (maybeExtractGovernanceActionIndex sbe (fromString txidString))
+  !propSubmittedResult <- findCondition (maybeExtractGovernanceActionIndex ceo (fromString txidString))
                                         configurationFile
                                         socketPath
                                         (EpochNo 10)

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

@@ -172,7 +172,7 @@ hprop_ledger_events_propose_new_constitution = H.integrationWorkspace "propose-n
 
   governanceActionTxId <- retrieveTransactionId execConfig signedProposalTx
 
-  !propSubmittedResult <- findCondition (maybeExtractGovernanceActionIndex sbe (fromString governanceActionTxId))
+  !propSubmittedResult <- findCondition (maybeExtractGovernanceActionIndex ceo (fromString governanceActionTxId))
                                         configurationFile
                                         socketPath
                                         (EpochNo 10)

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

@@ -14,6 +14,7 @@ import qualified Cardano.Testnet.Test.Cli.KesPeriodInfo
 import qualified Cardano.Testnet.Test.Cli.Queries
 import qualified Cardano.Testnet.Test.Cli.QuerySlotNumber
 import qualified Cardano.Testnet.Test.FoldBlocks
+import qualified Cardano.Testnet.Test.LedgerEvents.Gov.ConstitutionalCommittee
 import qualified Cardano.Testnet.Test.LedgerEvents.Gov.DRepActivity
 import qualified Cardano.Testnet.Test.LedgerEvents.Gov.DRepDeposits
 import qualified Cardano.Testnet.Test.LedgerEvents.Gov.ProposeNewConstitution
@@ -48,11 +49,12 @@ tests = do
             , H.ignoreOnWindows "Treasury Growth" LedgerEvents.prop_check_if_treasury_is_growing
             -- TODO: Replace foldBlocks with checkLedgerStateCondition
             , T.testGroup "Governance"
-                [ H.ignoreOnMacAndWindows "ProposeAndRatifyNewConstitution" Cardano.Testnet.Test.LedgerEvents.Gov.ProposeNewConstitution.hprop_ledger_events_propose_new_constitution
+                [ H.ignoreOnMacAndWindows "ConstitutionalCommittee" Cardano.Testnet.Test.LedgerEvents.Gov.ConstitutionalCommittee.hprop_constitutional_committee
                 , H.ignoreOnWindows "DRep Activity" Cardano.Testnet.Test.LedgerEvents.Gov.DRepActivity.hprop_check_drep_activity
                 , H.ignoreOnWindows "DRep Deposits" Cardano.Testnet.Test.LedgerEvents.Gov.DRepDeposits.hprop_ledger_events_drep_deposits
                   -- FIXME Those tests are flaky
                   -- , H.ignoreOnWindows "InfoAction" LedgerEvents.hprop_ledger_events_info_action
+                , H.ignoreOnMacAndWindows "ProposeAndRatifyNewConstitution" Cardano.Testnet.Test.LedgerEvents.Gov.ProposeNewConstitution.hprop_ledger_events_propose_new_constitution
                 , H.ignoreOnWindows "ProposeNewConstitutionSPO" LedgerEvents.hprop_ledger_events_propose_new_constitution_spo
                 , H.ignoreOnWindows "TreasuryWithdrawal" LedgerEvents.hprop_ledger_events_treasury_withdrawal
                 , H.ignoreOnWindows "DRepRetirement" DRepRetirement.hprop_drep_retirement