Bump deps to get slot-to-time conversion in EpochInfo

cabal.project

@@ -161,8 +161,8 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/cardano-base
-  tag: 4251c0bb6e4f443f00231d28f5f70d42876da055
-  --sha256: 02a61ymvx054pcdcgvg5qj9kpybiajg993nr22iqiya196jmgciv
+  tag: 0f0f139b842473a1e15a4cbfbf9c4a410e8f6bf6
+  --sha256: 10qh4zkl7scj0sv53lavzivdi2228i4adcc954azzz3dvnwx6b6v
   subdir:
     binary
     binary/test
@@ -173,8 +173,8 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/cardano-ledger-specs
-  tag: 653dadcc70cd6456784f597866dd44a952cfbfb9
-  --sha256: 03dc6qf9w5xi8psz6sd14w7y1fa6dxf356c0nfp1q8qlg8ndix1r
+  tag: f9ef0b0af9dd843f3d64f32cc45bf3aa08c18c30
+  --sha256: 0qhqlysblbhs15vw079wf4dlih5xpik5v59nijslsnnxgg09qmrl
   subdir:
     byron/chain/executable-spec
     byron/crypto

ouroboros-consensus-cardano-test/src/Test/ThreadNet/Infra/TwoEras.hs

@@ -313,7 +313,7 @@ secondEraOverlaySlots numSlots (NumSlots numFirstEraSlots) d secondEraEpochSize
 
     -- Suitable only for this narrow context
     epochInfo :: EpochInfo Identity
-    epochInfo = fixedSizeEpochInfo secondEraEpochSize
+    epochInfo = fixedEpochInfo secondEraEpochSize (error "dummy mkSlotLength")
 
 tabulatePartitionPosition ::
      NumSlots -> Partition -> Bool -> Property -> Property

ouroboros-consensus-mock/src/Ouroboros/Consensus/Mock/Protocol/Praos.hs

@@ -388,7 +388,7 @@ slotEpoch :: ConsensusConfig (Praos c) -> SlotNo -> EpochNo
 slotEpoch PraosConfig{..} s =
     runIdentity $ epochInfoEpoch epochInfo s
   where
-    epochInfo = fixedSizeEpochInfo (EpochSize praosSlotsPerEpoch)
+    epochInfo = fixedEpochInfo (EpochSize praosSlotsPerEpoch) (error "dummy mkSlotLength")
     PraosParams{..} = praosParams
 
 blockInfoEpoch :: ConsensusConfig (Praos c) -> BlockInfo c -> EpochNo
@@ -398,7 +398,7 @@ epochFirst :: ConsensusConfig (Praos c) -> EpochNo -> SlotNo
 epochFirst PraosConfig{..} e =
     runIdentity $ epochInfoFirst epochInfo e
   where
-    epochInfo = fixedSizeEpochInfo (EpochSize praosSlotsPerEpoch)
+    epochInfo = fixedEpochInfo (EpochSize praosSlotsPerEpoch) (error "dummy mkSlotLength")
     PraosParams{..} = praosParams
 
 infosSlice :: SlotNo -> SlotNo -> [BlockInfo c] -> [BlockInfo c]

ouroboros-consensus-shelley-test/test/Test/ThreadNet/Shelley.hs

@@ -12,7 +12,7 @@ import           Test.Tasty
 import           Test.Tasty.QuickCheck
 
 import           Cardano.Crypto.Hash (ShortHash)
-import           Cardano.Slotting.EpochInfo (fixedSizeEpochInfo)
+import           Cardano.Slotting.EpochInfo (fixedEpochInfo)
 
 import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.Config.SecurityParam
@@ -369,5 +369,5 @@ prop_simple_real_tpraos_convergence TestSetup
         ledgerConfig :: LedgerConfig (ShelleyBlock Era)
         ledgerConfig = Shelley.mkShelleyLedgerConfig
             genesisConfig
-            (fixedSizeEpochInfo epochSize)
+            (fixedEpochInfo epochSize tpraosSlotLength)
             (MaxMajorProtVer 1000) -- TODO

ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Node.hs

@@ -51,6 +51,7 @@ import           GHC.Stack (HasCallStack)
 
 import qualified Cardano.Crypto.VRF as VRF
 import           Cardano.Slotting.EpochInfo
+import           Cardano.Slotting.Time (mkSlotLength)
 
 import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.Config
@@ -294,7 +295,10 @@ protocolInfoShelleyBased ProtocolParamsShelleyBased {
     ledgerConfig = mkShelleyLedgerConfig genesis epochInfo maxMajorProtVer
 
     epochInfo :: EpochInfo Identity
-    epochInfo = fixedSizeEpochInfo $ SL.sgEpochLength genesis
+    epochInfo =
+        fixedEpochInfo
+          (SL.sgEpochLength genesis)
+          (mkSlotLength $ SL.sgSlotLength genesis)
 
     tpraosParams :: TPraosParams
     tpraosParams = mkTPraosParams maxMajorProtVer initialNonce genesis

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

@@ -802,6 +802,8 @@ hardForkEpochInfo ArbitraryChain{..} for =
                  epochInfoSize_  = \_ -> throw err
                , epochInfoFirst_ = \_ -> throw err
                , epochInfoEpoch_ = \_ -> throw err
+
+               , epochInfoSlotToRelativeTime_ = \_ -> throw err
                }
            , "<out of range>"
            , "<out of range>"

ouroboros-consensus/src/Ouroboros/Consensus/BlockchainTime/WallClock/Types.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE DataKinds                  #-}
-{-# LANGUAGE DeriveGeneric              #-}
 {-# LANGUAGE DerivingVia                #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
@@ -26,49 +25,16 @@ module Ouroboros.Consensus.BlockchainTime.WallClock.Types (
   , SlotLength
   ) where
 
-import           Codec.Serialise
-import           Control.Exception (assert)
-import           Data.Fixed
-import           Data.Time (NominalDiffTime, UTCTime, addUTCTime, diffUTCTime)
-import           GHC.Generics (Generic)
-import           NoThunks.Class (InspectHeap (..), NoThunks,
-                     OnlyCheckWhnfNamed (..))
-import           Quiet
+import           Data.Time.Clock (NominalDiffTime)
+import           NoThunks.Class (NoThunks, OnlyCheckWhnfNamed (..))
 
-{-------------------------------------------------------------------------------
-  System start
--------------------------------------------------------------------------------}
-
--- | System start
---
--- Slots are counted from the system start.
-newtype SystemStart = SystemStart { getSystemStart :: UTCTime }
-  deriving (Eq, Generic)
-  deriving NoThunks via InspectHeap SystemStart
-  deriving Show via Quiet SystemStart
-
-{-------------------------------------------------------------------------------
-  Relative time
--------------------------------------------------------------------------------}
-
--- | 'RelativeTime' is time relative to the 'SystemStart'
-newtype RelativeTime = RelativeTime { getRelativeTime :: NominalDiffTime }
-  deriving stock   (Eq, Ord, Generic)
-  deriving newtype (NoThunks)
-  deriving Show via Quiet RelativeTime
+import           Cardano.Slotting.Time
 
 addRelTime :: NominalDiffTime -> RelativeTime -> RelativeTime
-addRelTime delta (RelativeTime t) = RelativeTime (t + delta)
+addRelTime = addRelativeTime
 
 diffRelTime :: RelativeTime -> RelativeTime -> NominalDiffTime
-diffRelTime (RelativeTime t) (RelativeTime t') = t - t'
-
-toRelativeTime :: SystemStart -> UTCTime -> RelativeTime
-toRelativeTime (SystemStart t) t' = assert (t' >= t) $
-                                      RelativeTime (diffUTCTime t' t)
-
-fromRelativeTime :: SystemStart -> RelativeTime -> UTCTime
-fromRelativeTime (SystemStart t) (RelativeTime t') = addUTCTime t' t
+diffRelTime = diffRelativeTime
 
 {-------------------------------------------------------------------------------
   Get current time (as RelativeTime)
@@ -92,61 +58,3 @@ data SystemTime m = SystemTime {
     , systemTimeWait    :: m ()
     }
   deriving NoThunks via OnlyCheckWhnfNamed "SystemTime" (SystemTime m)
-
-{-------------------------------------------------------------------------------
-  SlotLength
--------------------------------------------------------------------------------}
-
--- | Slot length
-newtype SlotLength = SlotLength { getSlotLength :: NominalDiffTime }
-  deriving (Eq, Generic, NoThunks)
-  deriving Show via Quiet SlotLength
-
--- | Constructor for 'SlotLength'
-mkSlotLength :: NominalDiffTime -> SlotLength
-mkSlotLength = SlotLength
-
-slotLengthFromSec :: Integer -> SlotLength
-slotLengthFromSec = slotLengthFromMillisec . (* 1000)
-
-slotLengthToSec :: SlotLength -> Integer
-slotLengthToSec = (`div` 1000) . slotLengthToMillisec
-
-slotLengthFromMillisec :: Integer -> SlotLength
-slotLengthFromMillisec = mkSlotLength . conv
-  where
-    -- Explicit type annotation here means that /if/ we change the precision,
-    -- we are forced to reconsider this code.
-    conv :: Integer -> NominalDiffTime
-    conv = (realToFrac :: Pico -> NominalDiffTime)
-         . (/ 1000)
-         . (fromInteger :: Integer -> Pico)
-
-slotLengthToMillisec :: SlotLength -> Integer
-slotLengthToMillisec = conv . getSlotLength
-  where
-    -- Explicit type annotation here means that /if/ we change the precision,
-    -- we are forced to reconsider this code.
-    conv :: NominalDiffTime -> Integer
-    conv = truncate
-         . (* 1000)
-         . (realToFrac :: NominalDiffTime -> Pico)
-
-{-------------------------------------------------------------------------------
-  Serialisation
--------------------------------------------------------------------------------}
-
-instance Serialise RelativeTime where
-  encode = encode . toPico . getRelativeTime
-    where
-      toPico :: NominalDiffTime -> Pico
-      toPico = realToFrac
-
-  decode = (RelativeTime . fromPico) <$> decode
-    where
-      fromPico :: Pico -> NominalDiffTime
-      fromPico = realToFrac
-
-instance Serialise SlotLength where
-  encode = encode . slotLengthToMillisec
-  decode = slotLengthFromMillisec <$> decode

ouroboros-consensus/src/Ouroboros/Consensus/HardFork/Combinator/Abstract/NoHardForks.hs

@@ -41,4 +41,10 @@ class SingleEraBlock blk => NoHardForks blk where
 
 noHardForksEpochInfo :: NoHardForks blk
                      => TopLevelConfig blk -> EpochInfo Identity
-noHardForksEpochInfo = fixedSizeEpochInfo . History.eraEpochSize . getEraParams
+noHardForksEpochInfo cfg =
+    fixedEpochInfo
+      (History.eraEpochSize  params)
+      (History.eraSlotLength params)
+  where
+    params :: EraParams
+    params = getEraParams cfg

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

@@ -39,6 +39,9 @@ summaryToEpochInfo =
           epochInfoSize_  = \e -> cachedRunQueryThrow run (epochToSize  e)
         , epochInfoFirst_ = \e -> cachedRunQueryThrow run (epochToSlot' e)
         , epochInfoEpoch_ = \s -> cachedRunQueryThrow run (fst <$> slotToEpoch' s)
+
+        , epochInfoSlotToRelativeTime_ = \s ->
+            cachedRunQueryThrow run (fst <$> slotToWallclock s)
         }
 
 -- | Construct an 'EpochInfo' for a /snapshot/ of the ledger state
@@ -50,6 +53,9 @@ snapshotEpochInfo summary = EpochInfo {
       epochInfoSize_  = \e -> runQueryPure' (epochToSize  e)
     , epochInfoFirst_ = \e -> runQueryPure' (epochToSlot' e)
     , epochInfoEpoch_ = \s -> runQueryPure' (fst <$> slotToEpoch' s)
+
+    , epochInfoSlotToRelativeTime_ = \s ->
+        runQueryPure' (fst <$> slotToWallclock s)
     }
   where
     runQueryPure' :: HasCallStack => Qry a -> Identity a
@@ -60,7 +66,8 @@ snapshotEpochInfo summary = EpochInfo {
 -- To be used as a placeholder before a summary is available.
 dummyEpochInfo :: EpochInfo Identity
 dummyEpochInfo = EpochInfo {
-      epochInfoSize_  = \_ -> error "dummyEpochInfo used"
-    , epochInfoFirst_ = \_ -> error "dummyEpochInfo used"
-    , epochInfoEpoch_ = \_ -> error "dummyEpochInfo used"
+      epochInfoSize_               = \_ -> error "dummyEpochInfo used"
+    , epochInfoFirst_              = \_ -> error "dummyEpochInfo used"
+    , epochInfoEpoch_              = \_ -> error "dummyEpochInfo used"
+    , epochInfoSlotToRelativeTime_ = \_ -> error "dummyEpochInfo used"
     }