Add majorVersionAtLeast and majorVersionAtMost

Author: Soupstraw

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

@@ -89,11 +89,9 @@ spec =
             & bodyTxL . inputsTxBodyL .~ Set.singleton txIn
             & bodyTxL . referenceInputsTxBodyL .~ Set.singleton txIn
 
-      it "Can run scripts that expect inputs and refInputs to overlap (PV 9)"
-        . whenMajorVersion @9
-        $ do
-          txIn <- produceScript $ scriptHash SPlutusV3
-          submitTx_ @era $ tx txIn
+      it "Can run scripts that expect inputs and refInputs to overlap (PV 9)" . whenMajorVersion @9 $ do
+        txIn <- produceScript $ scriptHash SPlutusV3
+        submitTx_ @era $ tx txIn
       it "Same script cannot appear in regular and reference inputs in PlutusV3 (PV 10)"
         . whenMajorVersion @10
         $ do

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

@@ -116,14 +116,9 @@ module Test.Cardano.Ledger.Conway.ImpTest (
   expectNoCurrentProposals,
   expectPulserProposals,
   expectNoPulserProposals,
-  minorFollow,
-  majorFollow,
-  cantFollow,
   getsPParams,
   currentProposalsShouldContain,
   ifBootstrap,
-  whenMajorVersion,
-  unlessMajorVersion,
   whenBootstrap,
   whenPostBootstrap,
   submitYesVoteCCs_,
@@ -145,17 +140,12 @@ import Cardano.Ledger.Allegra.Scripts (Timelock)
 import Cardano.Ledger.BaseTypes (
   EpochInterval (..),
   EpochNo (..),
-  MaxVersion,
-  MinVersion,
-  ProtVer (..),
   ShelleyBase,
   StrictMaybe (..),
   UnitInterval,
   addEpochInterval,
   binOpEpochNo,
   inject,
-  natVersion,
-  succVersion,
   textToUrl,
  )
 import Cardano.Ledger.Coin (Coin (..))
@@ -226,7 +216,6 @@ import qualified Data.Sequence.Strict as SSeq
 import qualified Data.Set as Set
 import Data.Tree
 import qualified GHC.Exts as GHC (fromList)
-import GHC.TypeLits (KnownNat, Natural, type (<=))
 import Lens.Micro
 import Prettyprinter (align, hsep, viaShow, vsep)
 import Test.Cardano.Ledger.Babbage.ImpTest
@@ -1584,49 +1573,11 @@ pulsingStateSnapshotL = lens getter setter
     setter (DRComplete _ y) snap = DRComplete snap y
     setter state snap = DRComplete snap $ snd $ finishDRepPulser state
 
--- | A legal ProtVer that differs in the minor Version
-minorFollow :: ProtVer -> ProtVer
-minorFollow (ProtVer x y) = ProtVer x (y + 1)
-
--- | A legal ProtVer that moves to the next major Version
-majorFollow :: ProtVer -> ProtVer
-majorFollow pv@(ProtVer x _) = case succVersion x of
-  Just x' -> ProtVer x' 0
-  Nothing -> error ("The last major version can't be incremented. " ++ show pv)
-
--- | An illegal ProtVer that skips 3 minor versions
-cantFollow :: ProtVer -> ProtVer
-cantFollow (ProtVer x y) = ProtVer x (y + 3)
-
-whenMajorVersion ::
-  forall (v :: Natural) era.
-  ( EraGov era
-  , KnownNat v
-  , MinVersion <= v
-  , v <= MaxVersion
-  ) =>
-  ImpTestM era () -> ImpTestM era ()
-whenMajorVersion a = do
-  pv <- getProtVer
-  when (pvMajor pv == natVersion @v) a
-
-unlessMajorVersion ::
-  forall (v :: Natural) era.
-  ( EraGov era
-  , KnownNat v
-  , MinVersion <= v
-  , v <= MaxVersion
-  ) =>
-  ImpTestM era () -> ImpTestM era ()
-unlessMajorVersion a = do
-  pv <- getProtVer
-  unless (pvMajor pv == natVersion @v) a
-
 whenBootstrap :: EraGov era => ImpTestM era () -> ImpTestM era ()
 whenBootstrap = whenMajorVersion @9
 
 whenPostBootstrap :: EraGov era => ImpTestM era () -> ImpTestM era ()
-whenPostBootstrap = unlessMajorVersion @9
+whenPostBootstrap = whenMajorVersionAtLeast @10
 
 ifBootstrap :: EraGov era => ImpTestM era a -> ImpTestM era a -> ImpTestM era a
 ifBootstrap inBootstrap outOfBootstrap = do

eras/shelley/impl/CHANGELOG.md

@@ -2,6 +2,14 @@
 
 ## 1.17.0.0
 
+* Add:
+  * `unlessMajorVersion`
+  * `whenMajorVersion`
+  * `whenMajorVersionAtLeast`
+  * `whenMajorVersionAtMost`
+  * `cantFollow`
+  * `majorFollow`
+  * `minorFollow`
 * Remove `ShelleyTxBody`
 * Removed `era` parameter from `ShelleyTxBodyRaw`
 * Remove `HeapWords` instances for: #5001

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

@@ -105,6 +105,13 @@ module Test.Cardano.Ledger.Shelley.ImpTest (
   modifyImpInitProtVer,
   modifyImpInitExpectLedgerRuleConformance,
   disableImpInitExpectLedgerRuleConformance,
+  minorFollow,
+  majorFollow,
+  cantFollow,
+  whenMajorVersion,
+  whenMajorVersionAtLeast,
+  whenMajorVersionAtMost,
+  unlessMajorVersion,
 
   -- * Logging
   Doc,
@@ -243,7 +250,7 @@ import Data.Time.Format.ISO8601 (iso8601ParseM)
 import Data.TreeDiff (ansiWlExpr)
 import Data.Type.Equality (TestEquality (..))
 import Data.Void
-import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)
+import GHC.TypeLits (KnownSymbol, Symbol, symbolVal, KnownNat, type (<=))
 import Lens.Micro (Lens', SimpleGetter, lens, to, (%~), (&), (.~), (<>~), (^.))
 import Lens.Micro.Mtl (use, view, (%=), (+=), (.=))
 import Numeric.Natural (Natural)
@@ -1651,3 +1658,65 @@ advanceToPointOfNoReturn = do
   impLastTick <- gets impLastTick
   (_, slotOfNoReturn, _) <- runShelleyBase $ getTheSlotOfNoReturn impLastTick
   impLastTickL .= slotOfNoReturn
+
+-- | A legal ProtVer that differs in the minor Version
+minorFollow :: ProtVer -> ProtVer
+minorFollow (ProtVer x y) = ProtVer x (y + 1)
+
+-- | A legal ProtVer that moves to the next major Version
+majorFollow :: ProtVer -> ProtVer
+majorFollow pv@(ProtVer x _) = case succVersion x of
+  Just x' -> ProtVer x' 0
+  Nothing -> error ("The last major version can't be incremented. " ++ show pv)
+
+-- | An illegal ProtVer that skips 3 minor versions
+cantFollow :: ProtVer -> ProtVer
+cantFollow (ProtVer x y) = ProtVer x (y + 3)
+
+whenMajorVersion ::
+  forall (v :: Natural) era.
+  ( EraGov era
+  , KnownNat v
+  , MinVersion <= v
+  , v <= MaxVersion
+  ) =>
+  ImpTestM era () -> ImpTestM era ()
+whenMajorVersion a = do
+  pv <- getProtVer
+  when (pvMajor pv == natVersion @v) a
+
+whenMajorVersionAtLeast ::
+  forall (v :: Natural) era.
+  ( EraGov era
+  , KnownNat v
+  , MinVersion <= v
+  , v <= MaxVersion
+  ) =>
+  ImpTestM era () -> ImpTestM era ()
+whenMajorVersionAtLeast a = do
+  pv <- getProtVer
+  when (pvMajor pv >= natVersion @v) a
+
+whenMajorVersionAtMost ::
+  forall (v :: Natural) era.
+  ( EraGov era
+  , KnownNat v
+  , MinVersion <= v
+  , v <= MaxVersion
+  ) =>
+  ImpTestM era () -> ImpTestM era ()
+whenMajorVersionAtMost a = do
+  pv <- getProtVer
+  when (pvMajor pv <= natVersion @v) a
+
+unlessMajorVersion ::
+  forall (v :: Natural) era.
+  ( EraGov era
+  , KnownNat v
+  , MinVersion <= v
+  , v <= MaxVersion
+  ) =>
+  ImpTestM era () -> ImpTestM era ()
+unlessMajorVersion a = do
+  pv <- getProtVer
+  unless (pvMajor pv == natVersion @v) a