{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Ouroboros.Consensus.Protocol.Praos.Views
  ( HeaderView (..)
  , PraosLedgerView (..)
  , forecastToPraosLedgerView
  ) where

import Cardano.Crypto.KES (SignedKES)
import Cardano.Crypto.VRF (CertifiedVRF, VRFAlgorithm (VerKeyVRF))
import Cardano.Ledger.BaseTypes (ProtVer)
import Cardano.Ledger.Chain (ChainChecksPParams (..))
import Cardano.Ledger.Keys (KeyRole (BlockIssuer), VKey)
import qualified Cardano.Ledger.Shelley.API as SL
import Cardano.Protocol.Crypto (KES, VRF)
import Cardano.Protocol.Praos.BlockHeader (HeaderBody)
import Cardano.Protocol.Praos.VRF (InputVRF)
import Cardano.Protocol.TPraos.BlockHeader (PrevHash)
import Cardano.Protocol.TPraos.OCert (OCert)
import Cardano.Slotting.Slot (SlotNo)
import Data.Word (Word16, Word32)
import Lens.Micro ((^.))

-- | View of the block header required by the Praos protocol.
data HeaderView crypto = HeaderView
  { forall crypto. HeaderView crypto -> PrevHash
hvPrevHash :: !PrevHash
  -- ^ Hash of the previous block
  , forall crypto. HeaderView crypto -> VKey BlockIssuer
hvVK :: !(VKey BlockIssuer)
  -- ^ verification key of block issuer
  , forall crypto. HeaderView crypto -> VerKeyVRF (VRF crypto)
hvVrfVK :: !(VerKeyVRF (VRF crypto))
  -- ^ VRF verification key for block issuer
  , forall crypto.
HeaderView crypto -> CertifiedVRF (VRF crypto) InputVRF
hvVrfRes :: !(CertifiedVRF (VRF crypto) InputVRF)
  -- ^ VRF result
  , forall crypto. HeaderView crypto -> OCert crypto
hvOCert :: !(OCert crypto)
  -- ^ operational certificate
  , forall crypto. HeaderView crypto -> SlotNo
hvSlotNo :: !SlotNo
  -- ^ Slot
  , forall crypto. HeaderView crypto -> HeaderBody crypto
hvSigned :: !(HeaderBody crypto)
  -- ^ Header which must be signed
  , forall crypto.
HeaderView crypto -> SignedKES (KES crypto) (HeaderBody crypto)
hvSignature :: !(SignedKES (KES crypto) (HeaderBody crypto))
  -- ^ KES Signature of the header
  }

data PraosLedgerView = PraosLedgerView
  { PraosLedgerView -> PoolDistr
plvPoolDistr :: SL.PoolDistr
  -- ^ Stake distribution
  , PraosLedgerView -> Word16
plvMaxHeaderSize :: !Word16
  -- ^ Maximum header size
  , PraosLedgerView -> Word32
plvMaxBodySize :: !Word32
  -- ^ Maximum block body size
  , PraosLedgerView -> ProtVer
plvProtocolVersion :: !ProtVer
  -- ^ Current protocol version
  }
  deriving Int -> PraosLedgerView -> ShowS
[PraosLedgerView] -> ShowS
PraosLedgerView -> String
(Int -> PraosLedgerView -> ShowS)
-> (PraosLedgerView -> String)
-> ([PraosLedgerView] -> ShowS)
-> Show PraosLedgerView
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PraosLedgerView -> ShowS
showsPrec :: Int -> PraosLedgerView -> ShowS
$cshow :: PraosLedgerView -> String
show :: PraosLedgerView -> String
$cshowList :: [PraosLedgerView] -> ShowS
showList :: [PraosLedgerView] -> ShowS
Show

-- | Build a 'PraosLedgerView' from a ledger 'EraForecast'
forecastToPraosLedgerView ::
  forall t era.
  SL.EraForecast era =>
  SL.Forecast t era ->
  PraosLedgerView
forecastToPraosLedgerView :: forall (t :: Timeline) era.
EraForecast era =>
Forecast t era -> PraosLedgerView
forecastToPraosLedgerView Forecast t era
f =
  PraosLedgerView
    { plvPoolDistr :: PoolDistr
plvPoolDistr = Forecast t era
f Forecast t era
-> Getting PoolDistr (Forecast t era) PoolDistr -> PoolDistr
forall s a. s -> Getting a s a -> a
^. forall era (t :: Timeline).
EraForecast era =>
Lens' (Forecast t era) PoolDistr
SL.poolDistrForecastL @era @t
    , plvMaxHeaderSize :: Word16
plvMaxHeaderSize = ChainChecksPParams -> Word16
ccMaxBHSize ChainChecksPParams
cc
    , plvMaxBodySize :: Word32
plvMaxBodySize = ChainChecksPParams -> Word32
ccMaxBBSize ChainChecksPParams
cc
    , plvProtocolVersion :: ProtVer
plvProtocolVersion = ChainChecksPParams -> ProtVer
ccProtocolVersion ChainChecksPParams
cc
    }
 where
  cc :: ChainChecksPParams
cc = forall (t :: Timeline) era.
EraForecast era =>
Forecast t era -> ChainChecksPParams
SL.forecastChainChecks @t @era Forecast t era
f