WIP return round length when converting from round number to slot

Author: geo2a

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

@@ -240,7 +240,7 @@ data Expr (f :: Type -> Type) :: Type -> Type where
   ESlotLength :: Expr f SlotNo -> Expr f SlotLength
   EEpochSize :: Expr f EpochNo -> Expr f EpochSize
   EGenesisWindow :: Expr f SlotNo -> Expr f GenesisWindow
-  EPerasRoundLength :: Expr f SlotNo -> Expr f PerasRoundLength
+  EPerasRoundLength :: Expr f PerasRoundNo -> Expr f PerasRoundLength
 
 {-------------------------------------------------------------------------------
   Interpreter
@@ -362,11 +362,8 @@ evalExprInEra EraSummary{..} = \(ClosedExpr e) -> go e
     r <- go expr
     -- here we implicitly check that we are in Peras-enabled era,
     -- i.e. the round length is not Nothing
-    slot <-
-      (*)
-        <$> Just (getPerasRoundNoInEra r)
-        <*> (unPerasRoundLength <$> strictMaybeToMaybe eraPerasRoundLength)
-    pure (SlotInEra slot)
+    perasRoundLength <- unPerasRoundLength <$> strictMaybeToMaybe eraPerasRoundLength
+    pure $ SlotInEra (getPerasRoundNoInEra r * perasRoundLength)
   go (ERelSlotToPerasRoundNo expr) = do
     s <- go expr
     -- here we implicitly check that we are in Peras-enabled era,
@@ -398,15 +395,12 @@ evalExprInEra EraSummary{..} = \(ClosedExpr e) -> go e
     guardEnd $ \end -> s < boundSlot end
     return eraGenesisWin
   go (EPerasRoundLength expr) = do
-    s <- go expr
-    guard $ s >= boundSlot eraStart
-    guardEnd $ \end -> s < boundSlot end
-    ((_, _), es) <- go $ slotToEpochExpr s
-    -- here we implicitly check that we are in Peras-enabled era,
-    -- i.e. the round length is not Nothing
-    roundLength <- strictMaybeToMaybe eraPerasRoundLength
-    -- additionally, we check that Peras round length divides epoch size
-    guard $ (unEpochSize es) `mod` (unPerasRoundLength roundLength) == 0
+    r <- go expr
+    firstPerasRound <- strictMaybeToMaybe $ boundPerasRound eraStart
+    guard $ r >= firstPerasRound
+    guardEndM $ \end -> do
+      lastPerasRound  <- strictMaybeToMaybe $ boundPerasRound end
+      pure $ r < lastPerasRound
     strictMaybeToMaybe eraPerasRoundLength
 
 {-------------------------------------------------------------------------------
@@ -599,7 +593,7 @@ epochToSize absEpoch =
 -- | Translate 'PerasRoundNo' to the 'SlotNo' of the first slot in that Peras round
 --
 -- Additionally returns the length of the round.
-perasRoundNoToSlot :: PerasRoundNo -> Qry SlotNo
+perasRoundNoToSlot :: PerasRoundNo -> Qry (SlotNo, PerasRoundLength)
 perasRoundNoToSlot perasRoundNo = qryFromExpr (perasRoundNoToSlotExpr perasRoundNo)
 
 -- | Translate 'SlotNo' to its corresponding 'PerasRoundNo'
@@ -659,13 +653,19 @@ slotToGenesisWindow :: SlotNo -> Expr f GenesisWindow
 slotToGenesisWindow absSlot =
   EGenesisWindow (ELit absSlot)
 
-perasRoundNoToSlotExpr :: PerasRoundNo -> Expr f SlotNo
-perasRoundNoToSlotExpr absPerasRoundNo =
+perasRoundNoToSlotExpr' :: PerasRoundNo -> Expr f SlotNo
+perasRoundNoToSlotExpr' absPerasRoundNo =
   let relPerasRoundExpr = EAbsToRelPerasRoundNo (ELit absPerasRoundNo)
       startOfSlot = ELit (TimeInSlot 0)
    in ERelToAbsSlot (EPair (ERelPerasRoundNoToSlot relPerasRoundExpr) startOfSlot)
 
--- SlotNo -> SlotInEra -> PerasRoundNoInEra -> PerasRoundNo
+perasRoundNoToSlotExpr :: PerasRoundNo -> Expr f (SlotNo, PerasRoundLength)
+perasRoundNoToSlotExpr absPerasRoundNo =
+  EPair (perasRoundNoToSlotExpr' absPerasRoundNo) (perasRoundNoPerasRoundLengthExpr absPerasRoundNo)
+
+perasRoundNoPerasRoundLengthExpr :: PerasRoundNo -> Expr f PerasRoundLength
+perasRoundNoPerasRoundLengthExpr absPerasRoundNo =
+  EPerasRoundLength (ELit absPerasRoundNo)
 
 slotToPerasRoundNoExpr :: SlotNo -> Expr f PerasRoundNo
 slotToPerasRoundNoExpr absSlot = ERelToAbsPerasRoundNo (ERelSlotToPerasRoundNo (EAbsToRelSlot (ELit absSlot)))

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

@@ -137,7 +137,7 @@ roundtripEpochSlot s@ArbitrarySummary{beforeHorizonEpoch = epoch} =
 roundtripPerasRoundSlot :: ArbitrarySummary -> Property
 roundtripPerasRoundSlot s@ArbitrarySummary{beforeHorizonPerasRoundNo = perasRoundNo} =
   noPastHorizonException s $ do
-    slot <- HF.perasRoundNoToSlot perasRoundNo
+    (slot, _roundLenght) <- HF.perasRoundNoToSlot perasRoundNo
     perasRoundNo' <- HF.slotToPerasRoundNo slot
     pure $
       conjoin