WIP add test for Peras

Author: geo2a

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Block/SupportsPeras.hs

@@ -29,7 +29,7 @@ import Quiet (Quiet (..))
 newtype PerasRoundNo = PerasRoundNo {unPerasRoundNo :: Word64}
   deriving Show via Quiet PerasRoundNo
   deriving stock Generic
-  deriving newtype (Eq, Ord, NoThunks, Serialise)
+  deriving newtype (Enum, Eq, Ord, NoThunks, Serialise)
 
 defaultPerasRoundNo :: PerasRoundNo
 defaultPerasRoundNo = PerasRoundNo 0

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/History/Summary.hs

@@ -347,8 +347,16 @@ summarize ::
   Transitions xs ->
   Summary xs
 summarize ledgerTip = \(Shape shape) (Transitions transitions) ->
-  Summary $ go initBound shape transitions
+  Summary $ go initBoundWithPeras shape transitions
  where
+  -- as noted in the haddock, this function is only used for testing purposes,
+  -- therefore we make the initial era is Peras-enabled, which means
+  -- we only test Peras-enabled eras. It is rather difficult
+  -- to parameterise the test suite, as it requires also parameterise many non-test functions, like
+  -- 'HF.initBound', and leads to a huge diff. Therefore, we make the judgement call to
+  -- only test Peras-enabled eras.
+  initBoundWithPeras = initBound{boundPerasRound = SJust . PerasRoundNo $ 0}
+
   go ::
     Bound -> -- Lower bound for current era
     Exactly (x ': xs) EraParams -> -- params for all eras

ouroboros-consensus/test/consensus-test/Test/Consensus/HardFork/History.hs

@@ -25,6 +25,7 @@
 -- them to be).
 module Test.Consensus.HardFork.History (tests) where
 
+import Cardano.Ledger.BaseTypes (StrictMaybe (..))
 import Cardano.Slotting.EpochInfo
 import Control.Exception (throw)
 import Control.Monad.Except
@@ -65,11 +66,11 @@ import Test.Util.QuickCheck
 -- General approach:
 --
 -- * Generate a chain of events
--- * Each event records its own 'RelativeTime', 'SlotNo', and 'EpochNo'
+-- * Each event records its own 'RelativeTime', 'SlotNo', 'EpochNo', and 'PerasRoundNo'
 -- * We then construct a 'HF.Summary' from a /prefix/ of this chain
 -- * We then pick an arbitrary event from the (full) chain:
 --   a. If that event is on the prefix of the chain, or within the safe zone, we
---      expect to be able to do any slot/epoch or slot/time conversion, and we
+--      expect to be able to do any slot/epoch, slot/time or Peras round/slot conversion, and we
 --      can easily verify the result by comparing it to the values the 'Event'
 --      itself reports.
 --   b. If the event is outside of safe zone, we expect the conversion to throw
@@ -96,6 +97,7 @@ tests =
         , testProperty "eventWallclockToSlot" eventWallclockToSlot
         , testProperty "epochInfoSlotToEpoch" epochInfoSlotToEpoch
         , testProperty "epochInfoEpochToSlot" epochInfoEpochToSlot
+        , testProperty "eventPerasRounNoToSlot" eventPerasRounNoToSlot
         , testProperty "query vs expr" queryVsExprConsistency
         ]
     ]
@@ -208,6 +210,16 @@ eventWallclockToSlot chain@ArbitraryChain{..} =
   diff :: NominalDiffTime
   diff = arbitraryDiffTime arbitraryParams
 
+eventPerasRounNoToSlot :: ArbitraryChain -> Property
+eventPerasRounNoToSlot chain@ArbitraryChain{..} =
+  testSkeleton chain (HF.perasRoundNoToSlot eventTimePerasRoundNo) $
+    \(startOfPerasRound, _roundLength) ->
+      conjoin
+        [ eventTimeSlot === HF.addSlots eventTimeSlotInPerasRound startOfPerasRound
+        ]
+ where
+  EventTime{..} = eventTime arbitraryEvent
+
 -- | Composing queries should be equivalent to composing expressions.
 --
 -- This is a regression test. Each expression in a query should be evaluated in
@@ -503,7 +515,13 @@ data EventTime = EventTime
   { eventTimeSlot :: SlotNo
   , eventTimeEpochNo :: EpochNo
   , eventTimeEpochSlot :: Word64
+  -- ^ Relative slot withing the current epoch round,
+  --   needed to be able to advance the epoch number
   , eventTimeRelative :: RelativeTime
+  , eventTimePerasRoundNo :: PerasRoundNo
+  , eventTimeSlotInPerasRound :: Word64
+  -- ^ Relative slot withing the current Peras round,
+  --   needed to be able to advance the round number
   }
   deriving Show
 
@@ -514,6 +532,8 @@ initEventTime =
     , eventTimeEpochNo = EpochNo 0
     , eventTimeEpochSlot = 0
     , eventTimeRelative = RelativeTime 0
+    , eventTimePerasRoundNo = PerasRoundNo 0
+    , eventTimeSlotInPerasRound = 0
     }
 
 -- | Next time slot
@@ -526,6 +546,8 @@ stepEventTime HF.EraParams{..} EventTime{..} =
     , eventTimeRelative =
         addRelTime (getSlotLength eraSlotLength) $
           eventTimeRelative
+    , eventTimePerasRoundNo = perasRoundNo'
+    , eventTimeSlotInPerasRound = slotInPerasRound'
     }
  where
   epoch' :: EpochNo
@@ -535,6 +557,16 @@ stepEventTime HF.EraParams{..} EventTime{..} =
       then (succ eventTimeEpochNo, 0)
       else (eventTimeEpochNo, succ eventTimeEpochSlot)
 
+  perasRoundNo' :: PerasRoundNo
+  slotInPerasRound' :: Word64
+  args@(perasRoundNo', slotInPerasRound') =
+    case eraPerasRoundLength of
+      SNothing -> args
+      SJust (PerasRoundLength perasRoundLength) ->
+        if succ eventTimeSlotInPerasRound == perasRoundLength
+          then (succ eventTimePerasRoundNo, 0)
+          else (eventTimePerasRoundNo, succ eventTimeSlotInPerasRound)
+
 {-------------------------------------------------------------------------------
   Chain model
 -----------------------------------------------------------------------------}