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`

Added Testable instance for `ImpTestM`

Co-authored-by: Maximilian Algehed <MaximilianAlgehed@users.noreply.github.com>

Co-authored-by: Alexey Kuleshevich <alexey.kuleshevich@iohk.io>

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/CHANGELOG.md

@@ -2,6 +2,7 @@
 
 ## 1.14.0 0
 
+* Remove `gePrevGovActionIds` from `GovEnv`
 * Add lenses:
   * `dvtHardForkInitiationL`
   * `dvtMotionNoConfidenceL`

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)
   }
@@ -357,11 +359,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/shelley/impl/CHANGELOG.md

@@ -6,6 +6,7 @@
 
 ### `testlib`
 
+* Add `Testable` instance for `ImpTestM`
 * Export `impNESL` instead of of `impNESG` from `ImpTest`
 * Replace `initImpNES` with `initImpTestState` and change its return type to MonadState
 * Add functions to Shelley `ImpTest`:

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

@@ -569,6 +569,14 @@ 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 $ MkGen $ \qcGen qcSize ->
+    ioProperty $ do
+      preppedState <-
+        execImpTestM (Just qcSize) (mixinCurrentGen def qcGen) $
+          addRootTxOut >> initImpTestState
+      evalImpTestM (Just qcSize) preppedState m
+
 instance MonadWriter [SomeSTSEvent era] (ImpTestM era) where
   writer (x, evs) = (impEventsL %= (<> evs)) $> x
   listen act = do
@@ -1107,43 +1115,53 @@ logEntry e = impLogL %= (<> pretty loc <> "\t" <> pretty e <> line)
 logToExpr :: (HasCallStack, ToExpr a) => a -> ImpTestM era ()
 logToExpr e = logEntry (showExpr e)
 
+instance ShelleyEraImp era => Default (ImpTestState era) where
+  def =
+    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 ::
   ShelleyEraImp era =>
   SpecWith (ImpTestState era) ->
   Spec
 withImpState = withImpStateModified id
 
+addRootTxOut ::
+  forall era m.
+  ( MonadGen m
+  , MonadState (ImpTestState era) m
+  , ShelleyEraImp era
+  ) =>
+  m ()
+addRootTxOut = do
+  (rootKeyHash, _) <- freshKeyPair @era
+  let rootAddr = Addr Testnet (KeyHashObj rootKeyHash) StakeRefNull
+      rootTxOut = mkBasicTxOut rootAddr $ inject rootCoin
+  impNESL . nesEsL . esLStateL . lsUTxOStateL . utxosUtxoL
+    %= (<> UTxO (Map.singleton (impRootTxIn @era def) rootTxOut))
+  where
+    rootCoin = Coin 1_000_000_000
+
 withImpStateModified ::
+  forall era.
   ShelleyEraImp era =>
   (ImpTestState era -> ImpTestState era) ->
   SpecWith (ImpTestState era) ->
   Spec
 withImpStateModified f =
   beforeAll $
-    execImpTestM Nothing (f impTestState0) $
+    execImpTestM Nothing (f def) $
       addRootTxOut >> initImpTestState
-  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))
 
 -- | Creates a fresh @SafeHash@
 freshSafeHash :: Era era => ImpTestM era (SafeHash (EraCrypto era) a)

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

@@ -21,7 +21,9 @@ flag asserts
 library
     exposed-modules:
         Test.Cardano.Ledger.Conformance
+        Test.Cardano.Ledger.Conformance.ConformanceSpec
         Test.Cardano.Ledger.Conformance.Spec.Conway
+        Test.Cardano.Ledger.Conformance.Utils
 
     hs-source-dirs:   src
     other-modules:
@@ -39,8 +41,10 @@ library
 
     build-depends:
         base >=4.14 && <5,
+        base16-bytestring,
         cardano-data,
         cardano-strict-containers,
+        data-default-class,
         microlens,
         mtl,
         cardano-ledger-binary,
@@ -57,7 +61,8 @@ library
         constrained-generators,
         deepseq,
         small-steps >=1.1,
-        text
+        text,
+        unliftio
 
     if !impl(ghc >=9.2)
         ghc-options: -Wno-incomplete-patterns

libs/cardano-ledger-conformance/src/Test/Cardano/Ledger/Conformance/ConformanceSpec.hs

@@ -0,0 +1,24 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Test.Cardano.Ledger.Conformance.ConformanceSpec (spec) where
+
+import Cardano.Ledger.Crypto (StandardCrypto)
+import Cardano.Ledger.Keys (KeyHash, KeyRole (..))
+import Data.List (isInfixOf)
+import Test.Cardano.Ledger.Common
+import Test.Cardano.Ledger.Conformance (SpecTranslate (..), runSpecTransM)
+import Test.Cardano.Ledger.Conformance.Spec.Conway ()
+import Test.Cardano.Ledger.Conformance.Utils (agdaHashToBytes)
+
+spec :: Spec
+spec =
+  describe "Translation" $ do
+    prop "Hashes are displayed in the same way in the implementation and in the spec" $ do
+      someHash <- arbitrary @(KeyHash 'Staking StandardCrypto)
+      let
+        specRes =
+          case runSpecTransM () (toTestRep someHash) of
+            Left e -> error $ "Failed to translate hash: " <> show e
+            Right x -> agdaHashToBytes x
+      pure $ show specRes `isInfixOf` showExpr someHash