Removed GovRelation from GovEnv

Fixed a bug in prevGovActionId translation

Fixed TestRep of Proposals

Added generation timeout tests

Bump cardano-ledger-executable-spec

Fixed OMap.assocList

cabal.project

@@ -13,8 +13,8 @@ repository cardano-haskell-packages
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/cardano-ledger-executable-spec.git
-  tag: 324fafa887b7b6b38e15d2b505c4eec5a3247176
-  --sha256: sha256-zpQToGA04NQ3TfkeWBJXIzisvoGLfYdWNbVQ/2BfeEI=
+  tag: ac7af152d7d4c7b3ef1f3513e637c2c1e86ca30e
+  --sha256: sha256-hOdJTXA+vxm2Gh7t0hKXtSJ+3/iCoNyrzEiMzWGs6s4=
 
 index-state:
   -- Bump this if you need newer packages from Hackage

eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Gov.hs

@@ -71,10 +71,12 @@ import Cardano.Ledger.Conway.Governance (
   isCommitteeVotingAllowed,
   isDRepVotingAllowed,
   isStakePoolVotingAllowed,
+  pRootsL,
   proposalsActionsMap,
   proposalsAddAction,
   proposalsAddVote,
   proposalsLookupId,
+  toPrevGovActionIds,
  )
 import Cardano.Ledger.Conway.Governance.Procedures (GovAction (..), foldrVotingProcedures)
 import Cardano.Ledger.Conway.PParams (
@@ -112,14 +114,14 @@ import qualified Data.Sequence.Strict as SSeq
 import qualified Data.Set as Set
 import GHC.Generics (Generic)
 import Lens.Micro
+import qualified Lens.Micro as L
 import NoThunks.Class (NoThunks (..))
 import Validation (failureUnless)
 
 data GovEnv era = GovEnv
   { geTxId :: !(TxId (EraCrypto era))
   , geEpoch :: !EpochNo
   , gePParams :: !(PParams era)
-  , gePrevGovActionIds :: !(GovRelation StrictMaybe era)
   , gePPolicy :: !(StrictMaybe (ScriptHash (EraCrypto era)))
   , geCommitteeState :: !(CommitteeState era)
   }
@@ -329,11 +331,12 @@ govTransition ::
   TransitionRule (EraRule "GOV" era)
 govTransition = do
   TRC
-    ( GovEnv txid currentEpoch pp prevGovActionIds constitutionPolicy committeeState
+    ( GovEnv txid currentEpoch pp constitutionPolicy committeeState
       , st
       , gp
       ) <-
     judgmentContext
+  let prevGovActionIds = st ^. pRootsL . L.to toPrevGovActionIds
 
   expectedNetworkId <- liftSTS $ asks networkId
 

eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Ledger.hs

@@ -50,9 +50,7 @@ import Cardano.Ledger.Conway.Governance (
   GovProcedures (..),
   Proposals,
   constitutionScriptL,
-  pRootsL,
   proposalsGovStateL,
-  toPrevGovActionIds,
  )
 import Cardano.Ledger.Conway.Rules.Cert (CertEnv, ConwayCertPredFailure)
 import Cardano.Ledger.Conway.Rules.Certs (
@@ -390,7 +388,6 @@ ledgerTransition = do
                   (txIdTxBody txBody)
                   currentEpoch
                   pp
-                  (utxoState ^. utxosGovStateL . proposalsGovStateL . pRootsL . L.to toPrevGovActionIds)
                   (utxoState ^. utxosGovStateL . constitutionGovStateL . constitutionScriptL)
                   (certState ^. certVStateL . vsCommitteeStateL)
               , utxoState ^. utxosGovStateL . proposalsGovStateL

eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Arbitrary.hs

@@ -583,7 +583,6 @@ instance (Era era, Arbitrary (PParamsHKD Identity era)) => Arbitrary (GovEnv era
       <*> arbitrary
       <*> arbitrary
       <*> arbitrary
-      <*> arbitrary
 
 instance Era era => Arbitrary (VotingProcedure era) where
   arbitrary = VotingProcedure <$> arbitrary <*> arbitrary

eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/GovSpec.hs

@@ -4,7 +4,9 @@
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
 
@@ -30,6 +32,7 @@ import Data.Default.Class (Default (..))
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.Map.Strict as Map
 import Data.Maybe
+import qualified Data.OMap.Strict as OMap
 import qualified Data.Sequence.Strict as SSeq
 import qualified Data.Set as Set
 import Data.Tree
@@ -250,6 +253,7 @@ pparamUpdateSpec =
 proposalsSpec ::
   forall era.
   ( ConwayEraImp era
+  , GovState era ~ ConwayGovState era
   , InjectRuleFailure "LEDGER" ConwayGovPredFailure era
   ) =>
   SpecWith (ImpTestState era)
@@ -291,6 +295,20 @@ proposalsSpec =
           constitutionProposal
           [ injectFailure $ InvalidPrevGovActionId constitutionProposal
           ]
+      it "NoConfidence without a valid parent fails" $ do
+        pProcReturnAddr <- registerRewardAccount
+        corruptGPID <- arbitrary
+        pProcDeposit <- getsPParams ppGovActionDepositL
+        let
+          badProposal =
+            ProposalProcedure
+              { pProcGovAction = NoConfidence $ SJust corruptGPID
+              , pProcAnchor = def
+              , ..
+              }
+        submitFailingProposal
+          badProposal
+          [injectFailure $ InvalidPrevGovActionId badProposal]
       it "Subtrees are pruned when proposals expire" $ do
         modifyPParams $ ppGovActionLifetimeL .~ EpochInterval 4
         p1 <- submitInitConstitutionGovAction
@@ -726,6 +744,38 @@ proposalsSpec =
         passNEpochs 3
         fmap (!! 3) getProposalsForest
           `shouldReturn` Node (SJust p116) []
+    it "Proposals are stored in the expected order" $ do
+      modifyPParams $
+        ppMaxValSizeL .~ 1_000_000_000
+      returnAddr <- registerRewardAccount
+      deposit <- getsNES $ nesEsL . curPParamsEpochStateL . ppGovActionDepositL
+      ens <- getEnactState
+      withdrawals <- arbitrary
+      let
+        mkProp name action = do
+          ProposalProcedure
+            { pProcReturnAddr = returnAddr
+            , pProcGovAction = action
+            , pProcDeposit = deposit
+            , pProcAnchor = Anchor (fromJust $ textToUrl 16 name) def
+            }
+        prop0 = mkProp "prop0" InfoAction
+        prop1 = mkProp "prop1" $ NoConfidence (ens ^. ensPrevCommitteeL)
+        prop2 = mkProp "prop2" InfoAction
+        prop3 = mkProp "prop3" $ TreasuryWithdrawals withdrawals SNothing
+      submitProposal_ prop0
+      submitProposal_ prop1
+      let
+        checkProps l = do
+          props <-
+            getsNES $
+              nesEsL . epochStateGovStateL @era . cgsProposalsL . pPropsL
+          fmap (pProcAnchor . gasProposalProcedure . snd) (OMap.assocList props)
+            `shouldBe` fmap pProcAnchor l
+      checkProps [prop0, prop1]
+      submitProposal_ prop2
+      submitProposal_ prop3
+      checkProps [prop0, prop1, prop2, prop3]
 
 votingSpec ::
   forall era.

eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs

@@ -567,6 +567,16 @@ newtype ImpTestM era a = ImpTestM {_unImpTestM :: ReaderT (ImpTestEnv era) IO a}
     , MonadReader (ImpTestEnv era)
     )
 
+instance
+  ( Testable a
+  , ShelleyEraImp era
+  ) =>
+  Testable (ImpTestM era a)
+  where
+  property m = property . fmap ioProperty . runGenT $ do
+    res <- liftGen $ runImpTestGenM mkImpState m
+    liftIO $ fst <$> res
+
 instance MonadWriter [SomeSTSEvent era] (ImpTestM era) where
   writer (x, evs) = (impEventsL %= (<> evs)) $> x
   listen act = do
@@ -1105,37 +1115,36 @@ logEntry e = impLogL %= (<> pretty loc <> "\t" <> pretty e <> line)
 logToExpr :: (HasCallStack, ToExpr a) => a -> ImpTestM era ()
 logToExpr e = logEntry (showExpr e)
 
+mkImpState :: ShelleyEraImp era => ImpTestState era
+mkImpState =
+  ImpTestState
+    { impNES = initShelleyImpNES
+    , impRootTxIn = TxIn (mkTxId 0) minBound
+    , impKeyPairs = mempty
+    , impByronKeyPairs = mempty
+    , impNativeScripts = mempty
+    , impLastTick = 0
+    , impGlobals = testGlobals
+    , impLog = mempty
+    , impGen = mkQCGen 2024
+    , impEvents = mempty
+    }
+
 withImpState ::
   forall era.
   ShelleyEraImp era =>
   SpecWith (ImpTestState era) ->
   Spec
 withImpState =
-  beforeAll $
-    execImpTestM Nothing impTestState0 $
-      addRootTxOut >> initImpTestState
+  beforeAll $ execImpTestM Nothing mkImpState addRootTxOut
   where
-    impTestState0 =
-      ImpTestState
-        { impNES = initShelleyImpNES
-        , impRootTxIn = rootTxIn
-        , impKeyPairs = mempty
-        , impByronKeyPairs = mempty
-        , impNativeScripts = mempty
-        , impLastTick = 0
-        , impGlobals = testGlobals
-        , impLog = mempty
-        , impGen = mkQCGen 2024
-        , impEvents = mempty
-        }
     rootCoin = Coin 1_000_000_000
-    rootTxIn = TxIn (mkTxId 0) minBound
     addRootTxOut = do
       (rootKeyHash, _) <- freshKeyPair
       let rootAddr = Addr Testnet (KeyHashObj rootKeyHash) StakeRefNull
           rootTxOut = mkBasicTxOut rootAddr $ inject rootCoin
       impNESL . nesEsL . esLStateL . lsUTxOStateL . utxosUtxoL
-        %= (<> UTxO (Map.singleton rootTxIn rootTxOut))
+        %= (<> UTxO (Map.singleton (impRootTxIn @era mkImpState) rootTxOut))
 
 -- | Creates a fresh @SafeHash@
 freshSafeHash :: Era era => ImpTestM era (SafeHash (EraCrypto era) a)

libs/cardano-data/src/Data/OMap/Strict.hs

@@ -376,8 +376,8 @@ instance HasOKey k v => IsList (OMap k v) where
   fromList = fromFoldable
   toList = F.toList
 
-assocList :: OMap k v -> [(k, v)]
-assocList = Map.toList . toMap
+assocList :: Ord k => OMap k v -> [(k, v)]
+assocList = toList . toStrictSeqOfPairs
 
 instance (HasOKey k v, ToJSON v) => ToJSON (OMap k v) where
   toJSON = toJSON . toStrictSeq

libs/cardano-data/testlib/Test/Cardano/Data/TreeDiff.hs

@@ -5,12 +5,14 @@
 
 module Test.Cardano.Data.TreeDiff where
 
+import Data.Foldable (Foldable (..))
 import Data.Foldable qualified as F
 import Data.OMap.Strict
 import Data.OSet.Strict
-import Test.Cardano.Ledger.Binary.TreeDiff (ToExpr (..))
+import Test.Cardano.Ledger.Binary.TreeDiff (Expr (..), ToExpr (..))
 
-deriving instance ToExpr a => ToExpr (OSet a)
+instance ToExpr a => ToExpr (OSet a) where
+  toExpr x = App "OSet.fromList" [toExpr $ toList x]
 
 instance (HasOKey k v, ToExpr v) => ToExpr (OMap k v) where
   listToExpr = listToExpr . F.toList

libs/cardano-ledger-conformance/cardano-ledger-conformance.cabal

@@ -41,6 +41,7 @@ library
         base >=4.14 && <5,
         cardano-data,
         cardano-strict-containers,
+        data-default-class,
         microlens,
         mtl,
         cardano-ledger-binary,
@@ -57,7 +58,8 @@ library
         constrained-generators,
         deepseq,
         small-steps >=1.1,
-        text
+        text,
+        unliftio
 
     if !impl(ghc >=9.2)
         ghc-options: -Wno-incomplete-patterns