{-# 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.Binary
  ( FromCBOR (..),
    ToCBOR (..),
    encodeListLen,
    enforceSize,
  )
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.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
(Int -> EpochAndSlotCount -> ShowS)
-> (EpochAndSlotCount -> String)
-> ([EpochAndSlotCount] -> ShowS)
-> Show EpochAndSlotCount
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
(EpochAndSlotCount -> EpochAndSlotCount -> Bool)
-> (EpochAndSlotCount -> EpochAndSlotCount -> Bool)
-> Eq EpochAndSlotCount
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
Eq EpochAndSlotCount
-> (EpochAndSlotCount -> EpochAndSlotCount -> Ordering)
-> (EpochAndSlotCount -> EpochAndSlotCount -> Bool)
-> (EpochAndSlotCount -> EpochAndSlotCount -> Bool)
-> (EpochAndSlotCount -> EpochAndSlotCount -> Bool)
-> (EpochAndSlotCount -> EpochAndSlotCount -> Bool)
-> (EpochAndSlotCount -> EpochAndSlotCount -> EpochAndSlotCount)
-> (EpochAndSlotCount -> EpochAndSlotCount -> EpochAndSlotCount)
-> Ord 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
$cp1Ord :: Eq EpochAndSlotCount
Ord, (forall x. EpochAndSlotCount -> Rep EpochAndSlotCount x)
-> (forall x. Rep EpochAndSlotCount x -> EpochAndSlotCount)
-> Generic EpochAndSlotCount
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 -> ()
(EpochAndSlotCount -> ()) -> NFData EpochAndSlotCount
forall a. (a -> ()) -> NFData a
rnf :: EpochAndSlotCount -> ()
$crnf :: EpochAndSlotCount -> ()
NFData)

instance B.Buildable EpochAndSlotCount where
  build :: EpochAndSlotCount -> Builder
build EpochAndSlotCount
eas =
    Format Builder (Word64 -> Word64 -> Builder)
-> Word64 -> Word64 -> Builder
forall a. Format Builder a -> a
bprint
      (Format (Word64 -> Builder) (Word64 -> Word64 -> Builder)
forall n r. Integral n => Format r (n -> r)
ords Format (Word64 -> Builder) (Word64 -> Word64 -> Builder)
-> Format Builder (Word64 -> Builder)
-> Format Builder (Word64 -> Word64 -> Builder)
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 " Format (Word64 -> Builder) (Word64 -> Builder)
-> Format Builder (Word64 -> Builder)
-> Format Builder (Word64 -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (Word64 -> Builder)
forall n r. Integral n => Format r (n -> r)
ords Format Builder (Word64 -> Builder)
-> Format Builder Builder -> Format Builder (Word64 -> Builder)
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 (SlotCount -> Word64) -> SlotCount -> Word64
forall a b. (a -> b) -> a -> b
$ EpochAndSlotCount -> SlotCount
slotCount EpochAndSlotCount
eas)
      (EpochNumber -> Word64
getEpochNumber (EpochNumber -> Word64) -> EpochNumber -> Word64
forall a b. (a -> b) -> a -> b
$ EpochAndSlotCount -> EpochNumber
epochNo EpochAndSlotCount
eas)

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

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

-- | Flatten 'EpochAndSlotCount' into a single absolute 'SlotNumber'
toSlotNumber :: EpochSlots -> EpochAndSlotCount -> SlotNumber
toSlotNumber :: EpochSlots -> EpochAndSlotCount -> SlotNumber
toSlotNumber EpochSlots
es EpochAndSlotCount
eas = Word64 -> SlotNumber
SlotNumber (Word64 -> SlotNumber) -> Word64 -> SlotNumber
forall a b. (a -> b) -> a -> b
$ Word64
pastSlots Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
slots
  where
    slots :: Word64
    slots :: Word64
slots = SlotCount -> Word64
unSlotCount (SlotCount -> Word64) -> SlotCount -> Word64
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 (EpochNumber -> SlotNumber) -> EpochNumber -> SlotNumber
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 (Word64 -> SlotNumber) -> Word64 -> SlotNumber
forall a b. (a -> b) -> a -> b
$ Word64
i Word64 -> Word64 -> Word64
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 Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 =
      Text -> EpochAndSlotCount
forall a. HasCallStack => Text -> a
panic (Text -> EpochAndSlotCount) -> Text -> EpochAndSlotCount
forall a b. (a -> b) -> a -> b
$
        Text
"'unflattenEpochAndSlotCount': The number of slots-per-epoch "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"passed to this function must be positive"
  | Bool
otherwise =
      EpochAndSlotCount :: EpochNumber -> SlotCount -> EpochAndSlotCount
EpochAndSlotCount
        { epochNo :: EpochNumber
epochNo = Word64 -> EpochNumber
EpochNumber Word64
epoch,
          slotCount :: SlotCount
slotCount = Word64 -> SlotCount
SlotCount Word64
slot
        }
  where
    (Word64
epoch, Word64
slot) = Word64
fsId Word64 -> Word64 -> (Word64, Word64)
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 (EpochAndSlotCount -> EpochNumber)
-> EpochAndSlotCount -> EpochNumber
forall a b. (a -> b) -> a -> b
$ EpochSlots -> SlotNumber -> EpochAndSlotCount
fromSlotNumber EpochSlots
epochSlots SlotNumber
slot