{-# LANGUAGE DataKinds #-}
{-# LANGUAGE MultiParamTypeClasses #-}

module Cardano.Ledger.BHeaderView where

import Cardano.Ledger.BaseTypes (BoundedRational (..), UnitInterval)
import Cardano.Ledger.Hashes (EraIndependentBlockBody)
import Cardano.Ledger.Keys (Hash, KeyHash, KeyRole (..))
import Cardano.Ledger.Slot (SlotNo (..), (-*))
import Numeric.Natural (Natural)

-- | 'BHeaderView' provides an interface between block headers
-- from different Cardano protocols and packages that should be
-- agnostic of Cardano protocol specific details,
-- such as those in TPraos, Praos, Genesis, etc.
--
-- In particular, the 'BBODY' rule comprises most of the ledger logic
-- and should work independently of the protocol. The values in
-- 'BHeaderView' provide 'BBODY' all the data that it needs from the
-- block headers.
data BHeaderView crypto = BHeaderView
  { -- | The block issuer. In the TPraos protocol, this can be a
    --  Genesis delegate, everywhere else it is the stake pool ID.
    BHeaderView crypto -> KeyHash 'BlockIssuer crypto
bhviewID :: KeyHash 'BlockIssuer crypto,
    -- | The purported size (in bytes) of the block body.
    BHeaderView crypto -> Natural
bhviewBSize :: Natural,
    -- | The purported size (in bytes) of the block header.
    BHeaderView crypto -> Int
bhviewHSize :: Int,
    -- | The purported hash of the block body.
    BHeaderView crypto -> Hash crypto EraIndependentBlockBody
bhviewBHash :: Hash crypto EraIndependentBlockBody,
    -- | The slot for which this block was submitted to the chain.
    BHeaderView crypto -> SlotNo
bhviewSlot :: SlotNo
  }

-- | Determine if the given slot is reserved for the overlay schedule.
isOverlaySlot ::
  -- | The first slot of the given epoch.
  SlotNo ->
  -- | The decentralization parameter.
  UnitInterval ->
  -- | The slot to check.
  SlotNo ->
  Bool
isOverlaySlot :: SlotNo -> UnitInterval -> SlotNo -> Bool
isOverlaySlot SlotNo
firstSlotNo UnitInterval
dval SlotNo
slot = Rational -> Integer
step Rational
s Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Rational -> Integer
step (Rational
s Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
1)
  where
    s :: Rational
s = Duration -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Duration -> Rational) -> Duration -> Rational
forall a b. (a -> b) -> a -> b
$ SlotNo
slot SlotNo -> SlotNo -> Duration
-* SlotNo
firstSlotNo
    d :: Rational
d = UnitInterval -> Rational
forall r. BoundedRational r => r -> Rational
unboundRational UnitInterval
dval
    step :: Rational -> Integer
    step :: Rational -> Integer
step Rational
x = Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Rational
x Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
d)