{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE UndecidableInstances #-}

module Cardano.Chain.Slotting.EpochNumber (
  EpochNumber (..),
  isBootstrapEra,
)
where

import Cardano.Ledger.Binary (
  DecCBOR (..),
  EncCBOR (..),
  FromCBOR (..),
  ToCBOR (..),
  fromByronCBOR,
  toByronCBOR,
 )
import Cardano.Prelude
import qualified Data.Aeson as Aeson
import Data.Data (Data)
import Data.Ix (Ix)
import Formatting (bprint, int)
import Formatting.Buildable (Buildable (..))
import NoThunks.Class (NoThunks (..))
import Text.JSON.Canonical (FromJSON (..), ToJSON (..))

-- | Index of epoch.
newtype EpochNumber = EpochNumber
  { EpochNumber -> Word64
getEpochNumber :: Word64
  }
  deriving
    ( Int -> EpochNumber -> ShowS
[EpochNumber] -> ShowS
EpochNumber -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EpochNumber] -> ShowS
$cshowList :: [EpochNumber] -> ShowS
show :: EpochNumber -> String
$cshow :: EpochNumber -> String
showsPrec :: Int -> EpochNumber -> ShowS
$cshowsPrec :: Int -> EpochNumber -> ShowS
Show
    , Typeable EpochNumber
EpochNumber -> DataType
EpochNumber -> Constr
(forall b. Data b => b -> b) -> EpochNumber -> EpochNumber
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> EpochNumber -> u
forall u. (forall d. Data d => d -> u) -> EpochNumber -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EpochNumber -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EpochNumber -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EpochNumber -> m EpochNumber
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EpochNumber -> m EpochNumber
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EpochNumber
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EpochNumber -> c EpochNumber
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EpochNumber)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EpochNumber)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EpochNumber -> m EpochNumber
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EpochNumber -> m EpochNumber
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EpochNumber -> m EpochNumber
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EpochNumber -> m EpochNumber
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EpochNumber -> m EpochNumber
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EpochNumber -> m EpochNumber
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> EpochNumber -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> EpochNumber -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> EpochNumber -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> EpochNumber -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EpochNumber -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EpochNumber -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EpochNumber -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EpochNumber -> r
gmapT :: (forall b. Data b => b -> b) -> EpochNumber -> EpochNumber
$cgmapT :: (forall b. Data b => b -> b) -> EpochNumber -> EpochNumber
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EpochNumber)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EpochNumber)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EpochNumber)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EpochNumber)
dataTypeOf :: EpochNumber -> DataType
$cdataTypeOf :: EpochNumber -> DataType
toConstr :: EpochNumber -> Constr
$ctoConstr :: EpochNumber -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EpochNumber
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EpochNumber
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EpochNumber -> c EpochNumber
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EpochNumber -> c EpochNumber
Data
    , EpochNumber -> EpochNumber -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EpochNumber -> EpochNumber -> Bool
$c/= :: EpochNumber -> EpochNumber -> Bool
== :: EpochNumber -> EpochNumber -> Bool
$c== :: EpochNumber -> EpochNumber -> Bool
Eq
    , Eq EpochNumber
EpochNumber -> EpochNumber -> Bool
EpochNumber -> EpochNumber -> Ordering
EpochNumber -> EpochNumber -> EpochNumber
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 :: EpochNumber -> EpochNumber -> EpochNumber
$cmin :: EpochNumber -> EpochNumber -> EpochNumber
max :: EpochNumber -> EpochNumber -> EpochNumber
$cmax :: EpochNumber -> EpochNumber -> EpochNumber
>= :: EpochNumber -> EpochNumber -> Bool
$c>= :: EpochNumber -> EpochNumber -> Bool
> :: EpochNumber -> EpochNumber -> Bool
$c> :: EpochNumber -> EpochNumber -> Bool
<= :: EpochNumber -> EpochNumber -> Bool
$c<= :: EpochNumber -> EpochNumber -> Bool
< :: EpochNumber -> EpochNumber -> Bool
$c< :: EpochNumber -> EpochNumber -> Bool
compare :: EpochNumber -> EpochNumber -> Ordering
$ccompare :: EpochNumber -> EpochNumber -> Ordering
Ord
    , Integer -> EpochNumber
EpochNumber -> EpochNumber
EpochNumber -> EpochNumber -> EpochNumber
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> EpochNumber
$cfromInteger :: Integer -> EpochNumber
signum :: EpochNumber -> EpochNumber
$csignum :: EpochNumber -> EpochNumber
abs :: EpochNumber -> EpochNumber
$cabs :: EpochNumber -> EpochNumber
negate :: EpochNumber -> EpochNumber
$cnegate :: EpochNumber -> EpochNumber
* :: EpochNumber -> EpochNumber -> EpochNumber
$c* :: EpochNumber -> EpochNumber -> EpochNumber
- :: EpochNumber -> EpochNumber -> EpochNumber
$c- :: EpochNumber -> EpochNumber -> EpochNumber
+ :: EpochNumber -> EpochNumber -> EpochNumber
$c+ :: EpochNumber -> EpochNumber -> EpochNumber
Num
    , Int -> EpochNumber
EpochNumber -> Int
EpochNumber -> [EpochNumber]
EpochNumber -> EpochNumber
EpochNumber -> EpochNumber -> [EpochNumber]
EpochNumber -> EpochNumber -> EpochNumber -> [EpochNumber]
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 :: EpochNumber -> EpochNumber -> EpochNumber -> [EpochNumber]
$cenumFromThenTo :: EpochNumber -> EpochNumber -> EpochNumber -> [EpochNumber]
enumFromTo :: EpochNumber -> EpochNumber -> [EpochNumber]
$cenumFromTo :: EpochNumber -> EpochNumber -> [EpochNumber]
enumFromThen :: EpochNumber -> EpochNumber -> [EpochNumber]
$cenumFromThen :: EpochNumber -> EpochNumber -> [EpochNumber]
enumFrom :: EpochNumber -> [EpochNumber]
$cenumFrom :: EpochNumber -> [EpochNumber]
fromEnum :: EpochNumber -> Int
$cfromEnum :: EpochNumber -> Int
toEnum :: Int -> EpochNumber
$ctoEnum :: Int -> EpochNumber
pred :: EpochNumber -> EpochNumber
$cpred :: EpochNumber -> EpochNumber
succ :: EpochNumber -> EpochNumber
$csucc :: EpochNumber -> EpochNumber
Enum
    , Ord EpochNumber
(EpochNumber, EpochNumber) -> Int
(EpochNumber, EpochNumber) -> [EpochNumber]
(EpochNumber, EpochNumber) -> EpochNumber -> Bool
(EpochNumber, EpochNumber) -> EpochNumber -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (EpochNumber, EpochNumber) -> Int
$cunsafeRangeSize :: (EpochNumber, EpochNumber) -> Int
rangeSize :: (EpochNumber, EpochNumber) -> Int
$crangeSize :: (EpochNumber, EpochNumber) -> Int
inRange :: (EpochNumber, EpochNumber) -> EpochNumber -> Bool
$cinRange :: (EpochNumber, EpochNumber) -> EpochNumber -> Bool
unsafeIndex :: (EpochNumber, EpochNumber) -> EpochNumber -> Int
$cunsafeIndex :: (EpochNumber, EpochNumber) -> EpochNumber -> Int
index :: (EpochNumber, EpochNumber) -> EpochNumber -> Int
$cindex :: (EpochNumber, EpochNumber) -> EpochNumber -> Int
range :: (EpochNumber, EpochNumber) -> [EpochNumber]
$crange :: (EpochNumber, EpochNumber) -> [EpochNumber]
Ix
    , Enum EpochNumber
Real EpochNumber
EpochNumber -> Integer
EpochNumber -> EpochNumber -> (EpochNumber, EpochNumber)
EpochNumber -> EpochNumber -> EpochNumber
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 :: EpochNumber -> Integer
$ctoInteger :: EpochNumber -> Integer
divMod :: EpochNumber -> EpochNumber -> (EpochNumber, EpochNumber)
$cdivMod :: EpochNumber -> EpochNumber -> (EpochNumber, EpochNumber)
quotRem :: EpochNumber -> EpochNumber -> (EpochNumber, EpochNumber)
$cquotRem :: EpochNumber -> EpochNumber -> (EpochNumber, EpochNumber)
mod :: EpochNumber -> EpochNumber -> EpochNumber
$cmod :: EpochNumber -> EpochNumber -> EpochNumber
div :: EpochNumber -> EpochNumber -> EpochNumber
$cdiv :: EpochNumber -> EpochNumber -> EpochNumber
rem :: EpochNumber -> EpochNumber -> EpochNumber
$crem :: EpochNumber -> EpochNumber -> EpochNumber
quot :: EpochNumber -> EpochNumber -> EpochNumber
$cquot :: EpochNumber -> EpochNumber -> EpochNumber
Integral
    , Num EpochNumber
Ord EpochNumber
EpochNumber -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: EpochNumber -> Rational
$ctoRational :: EpochNumber -> Rational
Real
    , forall x. Rep EpochNumber x -> EpochNumber
forall x. EpochNumber -> Rep EpochNumber x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EpochNumber x -> EpochNumber
$cfrom :: forall x. EpochNumber -> Rep EpochNumber x
Generic
    , EpochNumber
forall a. a -> a -> Bounded a
maxBound :: EpochNumber
$cmaxBound :: EpochNumber
minBound :: EpochNumber
$cminBound :: EpochNumber
Bounded
    , EpochNumber -> ()
forall a. (a -> ()) -> NFData a
rnf :: EpochNumber -> ()
$crnf :: EpochNumber -> ()
NFData
    , Context -> EpochNumber -> IO (Maybe ThunkInfo)
Proxy EpochNumber -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy EpochNumber -> String
$cshowTypeOf :: Proxy EpochNumber -> String
wNoThunks :: Context -> EpochNumber -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> EpochNumber -> IO (Maybe ThunkInfo)
noThunks :: Context -> EpochNumber -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> EpochNumber -> IO (Maybe ThunkInfo)
NoThunks
    )

instance Buildable EpochNumber where
  build :: EpochNumber -> Builder
build = forall a. Format Builder a -> a
bprint (Format (EpochNumber -> Builder) (EpochNumber -> Builder)
"#" forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Integral a => Format r (a -> r)
int)

-- Used for debugging purposes only
instance Aeson.ToJSON EpochNumber

instance ToCBOR EpochNumber where
  toCBOR :: EpochNumber -> Encoding
toCBOR = forall a. EncCBOR a => a -> Encoding
toByronCBOR

instance FromCBOR EpochNumber where
  fromCBOR :: forall s. Decoder s EpochNumber
fromCBOR = forall a s. DecCBOR a => Decoder s a
fromByronCBOR

instance EncCBOR EpochNumber where
  encCBOR :: EpochNumber -> Encoding
encCBOR (EpochNumber Word64
epoch) = forall a. EncCBOR a => a -> Encoding
encCBOR Word64
epoch
  encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy EpochNumber -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
size = forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
size forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap EpochNumber -> Word64
getEpochNumber

instance DecCBOR EpochNumber where
  decCBOR :: forall s. Decoder s EpochNumber
decCBOR = Word64 -> EpochNumber
EpochNumber forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR

-- Note that it will be encoded as string, because 'EpochNumber' doesn't
-- necessary fit into JS number.
instance Monad m => ToJSON m EpochNumber where
  toJSON :: EpochNumber -> m JSValue
toJSON = forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. EpochNumber -> Word64
getEpochNumber

instance MonadError SchemaError m => FromJSON m EpochNumber where
  fromJSON :: JSValue -> m EpochNumber
fromJSON = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> EpochNumber
EpochNumber forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *) a. FromJSON m a => JSValue -> m a
fromJSON

-- | Bootstrap era is ongoing until stakes are unlocked. The reward era starts
--   from the epoch specified as the epoch that unlocks stakes:
--
--   @
--                       [unlock stake epoch]
--                               /
--   Epoch: ...  E-3  E-2  E-1   E+0  E+1  E+2  E+3  ...
--          ------------------ | -----------------------
--               Bootstrap era   Reward era
--   @
isBootstrapEra ::
  -- | Unlock stake epoch
  EpochNumber ->
  -- | Epoch in question (for which we determine whether it belongs to the
  --   bootstrap era)
  EpochNumber ->
  Bool
isBootstrapEra :: EpochNumber -> EpochNumber -> Bool
isBootstrapEra EpochNumber
unlockStakeEpoch EpochNumber
epoch = EpochNumber
epoch forall a. Ord a => a -> a -> Bool
< EpochNumber
unlockStakeEpoch