{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE UndecidableInstances #-}

module Cardano.Chain.Slotting.EpochAndSlotCount (
  EpochAndSlotCount (..),
  toSlotNumber,
  fromSlotNumber,
  slotNumberEpoch,
)
where

import Cardano.Chain.Slotting.EpochNumber (EpochNumber (..))
import Cardano.Chain.Slotting.EpochSlots (EpochSlots (..))
import Cardano.Chain.Slotting.SlotCount (SlotCount (..))
import Cardano.Chain.Slotting.SlotNumber (SlotNumber (..))
import Cardano.Ledger.Binary (
  DecCBOR (..),
  EncCBOR (..),
  FromCBOR (..),
  ToCBOR (..),
  encodeListLen,
  enforceSize,
  fromByronCBOR,
  toByronCBOR,
 )
import Cardano.Prelude
import Formatting (bprint, ords)
import qualified Formatting.Buildable as B

-- | 'EpochAndSlotCount' identifies a slot by its 'EpochNumber' and the number of
--   slots into the epoch that it sits
data EpochAndSlotCount = EpochAndSlotCount
  { EpochAndSlotCount -> EpochNumber
epochNo :: !EpochNumber
  , EpochAndSlotCount -> SlotCount
slotCount :: !SlotCount
  }
  deriving (Int -> EpochAndSlotCount -> ShowS
[EpochAndSlotCount] -> ShowS
EpochAndSlotCount -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EpochAndSlotCount] -> ShowS
$cshowList :: [EpochAndSlotCount] -> ShowS
show :: EpochAndSlotCount -> String
$cshow :: EpochAndSlotCount -> String
showsPrec :: Int -> EpochAndSlotCount -> ShowS
$cshowsPrec :: Int -> EpochAndSlotCount -> ShowS
Show, EpochAndSlotCount -> EpochAndSlotCount -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EpochAndSlotCount -> EpochAndSlotCount -> Bool
$c/= :: EpochAndSlotCount -> EpochAndSlotCount -> Bool
== :: EpochAndSlotCount -> EpochAndSlotCount -> Bool
$c== :: EpochAndSlotCount -> EpochAndSlotCount -> Bool
Eq, Eq EpochAndSlotCount
EpochAndSlotCount -> EpochAndSlotCount -> Bool
EpochAndSlotCount -> EpochAndSlotCount -> Ordering
EpochAndSlotCount -> EpochAndSlotCount -> EpochAndSlotCount
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 :: EpochAndSlotCount -> EpochAndSlotCount -> EpochAndSlotCount
$cmin :: EpochAndSlotCount -> EpochAndSlotCount -> EpochAndSlotCount
max :: EpochAndSlotCount -> EpochAndSlotCount -> EpochAndSlotCount
$cmax :: EpochAndSlotCount -> EpochAndSlotCount -> EpochAndSlotCount
>= :: EpochAndSlotCount -> EpochAndSlotCount -> Bool
$c>= :: EpochAndSlotCount -> EpochAndSlotCount -> Bool
> :: EpochAndSlotCount -> EpochAndSlotCount -> Bool
$c> :: EpochAndSlotCount -> EpochAndSlotCount -> Bool
<= :: EpochAndSlotCount -> EpochAndSlotCount -> Bool
$c<= :: EpochAndSlotCount -> EpochAndSlotCount -> Bool
< :: EpochAndSlotCount -> EpochAndSlotCount -> Bool
$c< :: EpochAndSlotCount -> EpochAndSlotCount -> Bool
compare :: EpochAndSlotCount -> EpochAndSlotCount -> Ordering
$ccompare :: EpochAndSlotCount -> EpochAndSlotCount -> Ordering
Ord, forall x. Rep EpochAndSlotCount x -> EpochAndSlotCount
forall x. EpochAndSlotCount -> Rep EpochAndSlotCount x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EpochAndSlotCount x -> EpochAndSlotCount
$cfrom :: forall x. EpochAndSlotCount -> Rep EpochAndSlotCount x
Generic)
  deriving anyclass (EpochAndSlotCount -> ()
forall a. (a -> ()) -> NFData a
rnf :: EpochAndSlotCount -> ()
$crnf :: EpochAndSlotCount -> ()
NFData)

instance B.Buildable EpochAndSlotCount where
  build :: EpochAndSlotCount -> Builder
build EpochAndSlotCount
eas =
    forall a. Format Builder a -> a
bprint
      (forall n r. Integral n => Format r (n -> r)
ords forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (Word64 -> Builder) (Word64 -> Builder)
" slot of " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall n r. Integral n => Format r (n -> r)
ords forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder Builder
" epoch")
      (SlotCount -> Word64
unSlotCount forall a b. (a -> b) -> a -> b
$ EpochAndSlotCount -> SlotCount
slotCount EpochAndSlotCount
eas)
      (EpochNumber -> Word64
getEpochNumber forall a b. (a -> b) -> a -> b
$ EpochAndSlotCount -> EpochNumber
epochNo EpochAndSlotCount
eas)

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

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

instance EncCBOR EpochAndSlotCount where
  encCBOR :: EpochAndSlotCount -> Encoding
encCBOR EpochAndSlotCount
eas = Word -> Encoding
encodeListLen Word
2 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (EpochAndSlotCount -> EpochNumber
epochNo EpochAndSlotCount
eas) forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (EpochAndSlotCount -> SlotCount
slotCount EpochAndSlotCount
eas)
  encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy EpochAndSlotCount -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
f Proxy EpochAndSlotCount
eas =
    Size
1
      forall a. Num a => a -> a -> a
+ forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
f (EpochAndSlotCount -> EpochNumber
epochNo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy EpochAndSlotCount
eas)
      forall a. Num a => a -> a -> a
+ forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
f (EpochAndSlotCount -> SlotCount
slotCount forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy EpochAndSlotCount
eas)

instance DecCBOR EpochAndSlotCount where
  decCBOR :: forall s. Decoder s EpochAndSlotCount
decCBOR = do
    forall s. Text -> Int -> Decoder s ()
enforceSize Text
"EpochAndSlotCount" Int
2
    EpochNumber -> SlotCount -> EpochAndSlotCount
EpochAndSlotCount forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR

-- | Flatten 'EpochAndSlotCount' into a single absolute 'SlotNumber'
toSlotNumber :: EpochSlots -> EpochAndSlotCount -> SlotNumber
toSlotNumber :: EpochSlots -> EpochAndSlotCount -> SlotNumber
toSlotNumber EpochSlots
es EpochAndSlotCount
eas = Word64 -> SlotNumber
SlotNumber forall a b. (a -> b) -> a -> b
$ Word64
pastSlots forall a. Num a => a -> a -> a
+ Word64
slots
  where
    slots :: Word64
    slots :: Word64
slots = SlotCount -> Word64
unSlotCount forall a b. (a -> b) -> a -> b
$ EpochAndSlotCount -> SlotCount
slotCount EpochAndSlotCount
eas
    pastSlots :: Word64
    pastSlots :: Word64
pastSlots = SlotNumber -> Word64
unSlotNumber (EpochSlots -> EpochNumber -> SlotNumber
flattenEpochNumber EpochSlots
es forall a b. (a -> b) -> a -> b
$ EpochAndSlotCount -> EpochNumber
epochNo EpochAndSlotCount
eas)

-- | Flattens 'EpochNumber' into a single number
flattenEpochNumber :: EpochSlots -> EpochNumber -> SlotNumber
flattenEpochNumber :: EpochSlots -> EpochNumber -> SlotNumber
flattenEpochNumber EpochSlots
es (EpochNumber Word64
i) = Word64 -> SlotNumber
SlotNumber forall a b. (a -> b) -> a -> b
$ Word64
i forall a. Num a => a -> a -> a
* EpochSlots -> Word64
unEpochSlots EpochSlots
es

-- | Construct a 'EpochAndSlotCount' from a 'SlotNumber', using a given 'EpochSlots'
fromSlotNumber :: EpochSlots -> SlotNumber -> EpochAndSlotCount
fromSlotNumber :: EpochSlots -> SlotNumber -> EpochAndSlotCount
fromSlotNumber (EpochSlots Word64
n) (SlotNumber Word64
fsId)
  | Word64
n forall a. Eq a => a -> a -> Bool
== Word64
0 =
      forall a. HasCallStack => Text -> a
panic
        forall a b. (a -> b) -> a -> b
$ Text
"'unflattenEpochAndSlotCount': The number of slots-per-epoch "
        forall a. Semigroup a => a -> a -> a
<> Text
"passed to this function must be positive"
  | Bool
otherwise =
      EpochAndSlotCount
        { epochNo :: EpochNumber
epochNo = Word64 -> EpochNumber
EpochNumber Word64
epoch
        , slotCount :: SlotCount
slotCount = Word64 -> SlotCount
SlotCount Word64
slot
        }
  where
    (Word64
epoch, Word64
slot) = Word64
fsId forall a. Integral a => a -> a -> (a, a)
`divMod` Word64
n

slotNumberEpoch :: EpochSlots -> SlotNumber -> EpochNumber
slotNumberEpoch :: EpochSlots -> SlotNumber -> EpochNumber
slotNumberEpoch EpochSlots
epochSlots SlotNumber
slot = EpochAndSlotCount -> EpochNumber
epochNo forall a b. (a -> b) -> a -> b
$ EpochSlots -> SlotNumber -> EpochAndSlotCount
fromSlotNumber EpochSlots
epochSlots SlotNumber
slot