{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}

module Cardano.Ledger.Slot (
  SlotNo (..),
  getTheSlotOfNoReturn,
  Duration (..),
  (-*),
  (+*),
  (*-),
  EpochNo (..),
  EpochSize (..),
  EpochInfo,
  -- Block number
  BlockNo (..),
  epochFromSlot,
  epochInfoEpoch,
  epochInfoFirst,
  epochInfoSize,
) where

import Cardano.Ledger.BaseTypes (Globals (Globals, stabilityWindow), ShelleyBase, epochInfoPure)
import Cardano.Slotting.Block (BlockNo (..))
import Cardano.Slotting.EpochInfo (EpochInfo)
import qualified Cardano.Slotting.EpochInfo as EI
import Cardano.Slotting.Slot (EpochNo (..), EpochSize (..), SlotNo (..))
import Control.Monad.Reader (Reader, ask, asks)
import Data.Functor.Identity (Identity, runIdentity)
import Data.Word (Word64)
import GHC.Generics (Generic)
import GHC.Stack (HasCallStack)
import NoThunks.Class (NoThunks (..))
import Quiet

newtype Duration = Duration {Duration -> Word64
unDuration :: Word64}
  deriving (Duration -> Duration -> Bool
(Duration -> Duration -> Bool)
-> (Duration -> Duration -> Bool) -> Eq Duration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Duration -> Duration -> Bool
== :: Duration -> Duration -> Bool
$c/= :: Duration -> Duration -> Bool
/= :: Duration -> Duration -> Bool
Eq, (forall x. Duration -> Rep Duration x)
-> (forall x. Rep Duration x -> Duration) -> Generic Duration
forall x. Rep Duration x -> Duration
forall x. Duration -> Rep Duration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Duration -> Rep Duration x
from :: forall x. Duration -> Rep Duration x
$cto :: forall x. Rep Duration x -> Duration
to :: forall x. Rep Duration x -> Duration
Generic, Eq Duration
Eq Duration =>
(Duration -> Duration -> Ordering)
-> (Duration -> Duration -> Bool)
-> (Duration -> Duration -> Bool)
-> (Duration -> Duration -> Bool)
-> (Duration -> Duration -> Bool)
-> (Duration -> Duration -> Duration)
-> (Duration -> Duration -> Duration)
-> Ord Duration
Duration -> Duration -> Bool
Duration -> Duration -> Ordering
Duration -> Duration -> Duration
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Duration -> Duration -> Ordering
compare :: Duration -> Duration -> Ordering
$c< :: Duration -> Duration -> Bool
< :: Duration -> Duration -> Bool
$c<= :: Duration -> Duration -> Bool
<= :: Duration -> Duration -> Bool
$c> :: Duration -> Duration -> Bool
> :: Duration -> Duration -> Bool
$c>= :: Duration -> Duration -> Bool
>= :: Duration -> Duration -> Bool
$cmax :: Duration -> Duration -> Duration
max :: Duration -> Duration -> Duration
$cmin :: Duration -> Duration -> Duration
min :: Duration -> Duration -> Duration
Ord, Context -> Duration -> IO (Maybe ThunkInfo)
Proxy Duration -> String
(Context -> Duration -> IO (Maybe ThunkInfo))
-> (Context -> Duration -> IO (Maybe ThunkInfo))
-> (Proxy Duration -> String)
-> NoThunks Duration
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> Duration -> IO (Maybe ThunkInfo)
noThunks :: Context -> Duration -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> Duration -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> Duration -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy Duration -> String
showTypeOf :: Proxy Duration -> String
NoThunks, Integer -> Duration
Duration -> Duration
Duration -> Duration -> Duration
(Duration -> Duration -> Duration)
-> (Duration -> Duration -> Duration)
-> (Duration -> Duration -> Duration)
-> (Duration -> Duration)
-> (Duration -> Duration)
-> (Duration -> Duration)
-> (Integer -> Duration)
-> Num Duration
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Duration -> Duration -> Duration
+ :: Duration -> Duration -> Duration
$c- :: Duration -> Duration -> Duration
- :: Duration -> Duration -> Duration
$c* :: Duration -> Duration -> Duration
* :: Duration -> Duration -> Duration
$cnegate :: Duration -> Duration
negate :: Duration -> Duration
$cabs :: Duration -> Duration
abs :: Duration -> Duration
$csignum :: Duration -> Duration
signum :: Duration -> Duration
$cfromInteger :: Integer -> Duration
fromInteger :: Integer -> Duration
Num, Enum Duration
Real Duration
(Real Duration, Enum Duration) =>
(Duration -> Duration -> Duration)
-> (Duration -> Duration -> Duration)
-> (Duration -> Duration -> Duration)
-> (Duration -> Duration -> Duration)
-> (Duration -> Duration -> (Duration, Duration))
-> (Duration -> Duration -> (Duration, Duration))
-> (Duration -> Integer)
-> Integral Duration
Duration -> Integer
Duration -> Duration -> (Duration, Duration)
Duration -> Duration -> Duration
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: Duration -> Duration -> Duration
quot :: Duration -> Duration -> Duration
$crem :: Duration -> Duration -> Duration
rem :: Duration -> Duration -> Duration
$cdiv :: Duration -> Duration -> Duration
div :: Duration -> Duration -> Duration
$cmod :: Duration -> Duration -> Duration
mod :: Duration -> Duration -> Duration
$cquotRem :: Duration -> Duration -> (Duration, Duration)
quotRem :: Duration -> Duration -> (Duration, Duration)
$cdivMod :: Duration -> Duration -> (Duration, Duration)
divMod :: Duration -> Duration -> (Duration, Duration)
$ctoInteger :: Duration -> Integer
toInteger :: Duration -> Integer
Integral, Num Duration
Ord Duration
(Num Duration, Ord Duration) =>
(Duration -> Rational) -> Real Duration
Duration -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: Duration -> Rational
toRational :: Duration -> Rational
Real, Int -> Duration
Duration -> Int
Duration -> [Duration]
Duration -> Duration
Duration -> Duration -> [Duration]
Duration -> Duration -> Duration -> [Duration]
(Duration -> Duration)
-> (Duration -> Duration)
-> (Int -> Duration)
-> (Duration -> Int)
-> (Duration -> [Duration])
-> (Duration -> Duration -> [Duration])
-> (Duration -> Duration -> [Duration])
-> (Duration -> Duration -> Duration -> [Duration])
-> Enum Duration
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Duration -> Duration
succ :: Duration -> Duration
$cpred :: Duration -> Duration
pred :: Duration -> Duration
$ctoEnum :: Int -> Duration
toEnum :: Int -> Duration
$cfromEnum :: Duration -> Int
fromEnum :: Duration -> Int
$cenumFrom :: Duration -> [Duration]
enumFrom :: Duration -> [Duration]
$cenumFromThen :: Duration -> Duration -> [Duration]
enumFromThen :: Duration -> Duration -> [Duration]
$cenumFromTo :: Duration -> Duration -> [Duration]
enumFromTo :: Duration -> Duration -> [Duration]
$cenumFromThenTo :: Duration -> Duration -> Duration -> [Duration]
enumFromThenTo :: Duration -> Duration -> Duration -> [Duration]
Enum)
  deriving (Int -> Duration -> ShowS
[Duration] -> ShowS
Duration -> String
(Int -> Duration -> ShowS)
-> (Duration -> String) -> ([Duration] -> ShowS) -> Show Duration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Duration -> ShowS
showsPrec :: Int -> Duration -> ShowS
$cshow :: Duration -> String
show :: Duration -> String
$cshowList :: [Duration] -> ShowS
showList :: [Duration] -> ShowS
Show) via Quiet Duration

instance Semigroup Duration where
  (Duration Word64
x) <> :: Duration -> Duration -> Duration
<> (Duration Word64
y) = Word64 -> Duration
Duration (Word64 -> Duration) -> Word64 -> Duration
forall a b. (a -> b) -> a -> b
$ Word64
x Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
y

instance Monoid Duration where
  mempty :: Duration
mempty = Word64 -> Duration
Duration Word64
0

(-*) :: SlotNo -> SlotNo -> Duration
(SlotNo Word64
s) -* :: SlotNo -> SlotNo -> Duration
-* (SlotNo Word64
t) = Word64 -> Duration
Duration (if Word64
s Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
t then Word64
s Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
t else Word64
t Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
s)

(+*) :: SlotNo -> Duration -> SlotNo
(SlotNo Word64
s) +* :: SlotNo -> Duration -> SlotNo
+* (Duration Word64
d) = Word64 -> SlotNo
SlotNo (Word64
s Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
d)

-- | Subtract a duration from a slot
(*-) :: SlotNo -> Duration -> SlotNo
(SlotNo Word64
s) *- :: SlotNo -> Duration -> SlotNo
*- (Duration Word64
d) = Word64 -> SlotNo
SlotNo (if Word64
s Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
d then Word64
s Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
d else Word64
0)

epochFromSlot :: SlotNo -> Reader Globals EpochNo
epochFromSlot :: SlotNo -> Reader Globals EpochNo
epochFromSlot SlotNo
slot = do
  EpochInfo Identity
ei <- (Globals -> EpochInfo Identity)
-> ReaderT Globals Identity (EpochInfo Identity)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Globals -> EpochInfo Identity
epochInfoPure
  EpochNo -> Reader Globals EpochNo
forall a. a -> ReaderT Globals Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EpochNo -> Reader Globals EpochNo)
-> EpochNo -> Reader Globals EpochNo
forall a b. (a -> b) -> a -> b
$ HasCallStack => EpochInfo Identity -> SlotNo -> EpochNo
EpochInfo Identity -> SlotNo -> EpochNo
epochInfoEpoch EpochInfo Identity
ei SlotNo
slot

epochInfoEpoch ::
  HasCallStack =>
  EpochInfo Identity ->
  SlotNo ->
  EpochNo
epochInfoEpoch :: HasCallStack => EpochInfo Identity -> SlotNo -> EpochNo
epochInfoEpoch EpochInfo Identity
ei = Identity EpochNo -> EpochNo
forall a. Identity a -> a
runIdentity (Identity EpochNo -> EpochNo)
-> (SlotNo -> Identity EpochNo) -> SlotNo -> EpochNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochInfo Identity -> SlotNo -> Identity EpochNo
forall (m :: * -> *).
HasCallStack =>
EpochInfo m -> SlotNo -> m EpochNo
EI.epochInfoEpoch EpochInfo Identity
ei

epochInfoFirst ::
  HasCallStack =>
  EpochInfo Identity ->
  EpochNo ->
  SlotNo
epochInfoFirst :: HasCallStack => EpochInfo Identity -> EpochNo -> SlotNo
epochInfoFirst EpochInfo Identity
ei = Identity SlotNo -> SlotNo
forall a. Identity a -> a
runIdentity (Identity SlotNo -> SlotNo)
-> (EpochNo -> Identity SlotNo) -> EpochNo -> SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochInfo Identity -> EpochNo -> Identity SlotNo
forall (m :: * -> *).
HasCallStack =>
EpochInfo m -> EpochNo -> m SlotNo
EI.epochInfoFirst EpochInfo Identity
ei

epochInfoSize ::
  HasCallStack =>
  EpochInfo Identity ->
  EpochNo ->
  EpochSize
epochInfoSize :: HasCallStack => EpochInfo Identity -> EpochNo -> EpochSize
epochInfoSize EpochInfo Identity
ei = Identity EpochSize -> EpochSize
forall a. Identity a -> a
runIdentity (Identity EpochSize -> EpochSize)
-> (EpochNo -> Identity EpochSize) -> EpochNo -> EpochSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochInfo Identity -> EpochNo -> Identity EpochSize
forall (m :: * -> *).
HasCallStack =>
EpochInfo m -> EpochNo -> m EpochSize
EI.epochInfoSize EpochInfo Identity
ei

-- | Figure out a slot number that is two stability windows before the end of the next
-- epoch. Together with the slot number we also return the current epoch number and the
-- next epoch number.
--
-- The reason why it is called the point of no return, is because that is the point when
-- HardForkCombinator (HFC) initiates a controlled hard fork, if there is a major protocol
-- version update that forks into a new era.
getTheSlotOfNoReturn :: HasCallStack => SlotNo -> ShelleyBase (EpochNo, SlotNo, EpochNo)
getTheSlotOfNoReturn :: HasCallStack => SlotNo -> ShelleyBase (EpochNo, SlotNo, EpochNo)
getTheSlotOfNoReturn SlotNo
slot = do
  globals :: Globals
globals@Globals {Word64
stabilityWindow :: Globals -> Word64
stabilityWindow :: Word64
stabilityWindow} <- ReaderT Globals Identity Globals
forall r (m :: * -> *). MonadReader r m => m r
ask
  let epochInfo :: EpochInfo Identity
epochInfo = Globals -> EpochInfo Identity
epochInfoPure Globals
globals
      epochNo :: EpochNo
epochNo = HasCallStack => EpochInfo Identity -> SlotNo -> EpochNo
EpochInfo Identity -> SlotNo -> EpochNo
epochInfoEpoch EpochInfo Identity
epochInfo SlotNo
slot
      nextEpochNo :: EpochNo
nextEpochNo = EpochNo -> EpochNo
forall a. Enum a => a -> a
succ EpochNo
epochNo
      firstSlotNextEpoch :: SlotNo
firstSlotNextEpoch = HasCallStack => EpochInfo Identity -> EpochNo -> SlotNo
EpochInfo Identity -> EpochNo -> SlotNo
epochInfoFirst EpochInfo Identity
epochInfo EpochNo
nextEpochNo
      pointOfNoReturn :: SlotNo
pointOfNoReturn = SlotNo
firstSlotNextEpoch SlotNo -> Duration -> SlotNo
*- Word64 -> Duration
Duration (Word64
2 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
stabilityWindow)
  (EpochNo, SlotNo, EpochNo)
-> ShelleyBase (EpochNo, SlotNo, EpochNo)
forall a. a -> ReaderT Globals Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EpochNo
epochNo, SlotNo
pointOfNoReturn, EpochNo
nextEpochNo)