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

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

instance Monoid Duration where
  mempty :: Duration
mempty = Word64 -> Duration
Duration Word64
0
  mappend :: Duration -> Duration -> Duration
mappend = forall a. Semigroup a => a -> a -> a
(<>)

(-*) :: SlotNo -> SlotNo -> Duration
(SlotNo Word64
s) -* :: SlotNo -> SlotNo -> Duration
-* (SlotNo Word64
t) = Word64 -> Duration
Duration (if Word64
s forall a. Ord a => a -> a -> Bool
> Word64
t then Word64
s forall a. Num a => a -> a -> a
- Word64
t else Word64
t 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 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 forall a. Ord a => a -> a -> Bool
> Word64
d then Word64
s forall a. Num a => a -> a -> a
- Word64
d else Word64
0)

epochInfoEpoch ::
  HasCallStack =>
  EpochInfo Identity ->
  SlotNo ->
  ShelleyBase EpochNo
epochInfoEpoch :: HasCallStack => EpochInfo Identity -> SlotNo -> ShelleyBase EpochNo
epochInfoEpoch EpochInfo Identity
ei = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
HasCallStack =>
EpochInfo m -> SlotNo -> m EpochNo
EI.epochInfoEpoch EpochInfo Identity
ei

epochInfoFirst ::
  HasCallStack =>
  EpochInfo Identity ->
  EpochNo ->
  ShelleyBase SlotNo
epochInfoFirst :: HasCallStack => EpochInfo Identity -> EpochNo -> ShelleyBase SlotNo
epochInfoFirst EpochInfo Identity
ei = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
HasCallStack =>
EpochInfo m -> EpochNo -> m SlotNo
EI.epochInfoFirst EpochInfo Identity
ei

epochInfoSize ::
  HasCallStack =>
  EpochInfo Identity ->
  EpochNo ->
  ShelleyBase EpochSize
epochInfoSize :: HasCallStack =>
EpochInfo Identity -> EpochNo -> ShelleyBase EpochSize
epochInfoSize EpochInfo Identity
ei = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: Word64
stabilityWindow :: Globals -> Word64
stabilityWindow} <- forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  let !epochInfo :: EpochInfo Identity
epochInfo = Globals -> EpochInfo Identity
epochInfoPure Globals
globals
  EpochNo
epochNo <- HasCallStack => EpochInfo Identity -> SlotNo -> ShelleyBase EpochNo
epochInfoEpoch EpochInfo Identity
epochInfo SlotNo
slot
  let !nextEpochNo :: EpochNo
nextEpochNo = forall a. Enum a => a -> a
succ EpochNo
epochNo
  SlotNo
firstSlotNextEpoch <- HasCallStack => EpochInfo Identity -> EpochNo -> ShelleyBase SlotNo
epochInfoFirst EpochInfo Identity
epochInfo EpochNo
nextEpochNo
  let !pointOfNoReturn :: SlotNo
pointOfNoReturn = SlotNo
firstSlotNextEpoch SlotNo -> Duration -> SlotNo
*- Word64 -> Duration
Duration (Word64
2 forall a. Num a => a -> a -> a
* Word64
stabilityWindow)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (EpochNo
epochNo, SlotNo
pointOfNoReturn, EpochNo
nextEpochNo)