{-# LANGUAGE DataKinds #-}

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

import           Cardano.Crypto.KES (SignedKES)
import           Cardano.Crypto.VRF (CertifiedVRF, VRFAlgorithm (VerKeyVRF))
import           Cardano.Ledger.BaseTypes (ProtVer)
import           Cardano.Ledger.Crypto (KES, VRF)
import           Cardano.Ledger.Keys (KeyRole (BlockIssuer), VKey)
import qualified Cardano.Ledger.Shelley.API as SL
import           Cardano.Protocol.TPraos.BHeader (PrevHash)
import           Cardano.Protocol.TPraos.OCert (OCert)
import           Cardano.Slotting.Slot (SlotNo)
import           Numeric.Natural (Natural)
import           Ouroboros.Consensus.Protocol.Praos.Header (HeaderBody)
import           Ouroboros.Consensus.Protocol.Praos.VRF (InputVRF)

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

data LedgerView crypto = LedgerView
  { -- | Stake distribution
    LedgerView crypto -> PoolDistr crypto
lvPoolDistr       :: SL.PoolDistr crypto,
    -- | Maximum header size
    LedgerView crypto -> Natural
lvMaxHeaderSize   :: !Natural,
    -- | Maximum block body size
    LedgerView crypto -> Natural
lvMaxBodySize     :: !Natural,
    -- | Current protocol version
    LedgerView crypto -> ProtVer
lvProtocolVersion :: !ProtVer
  }
  deriving (Int -> LedgerView crypto -> ShowS
[LedgerView crypto] -> ShowS
LedgerView crypto -> String
(Int -> LedgerView crypto -> ShowS)
-> (LedgerView crypto -> String)
-> ([LedgerView crypto] -> ShowS)
-> Show (LedgerView crypto)
forall crypto. Int -> LedgerView crypto -> ShowS
forall crypto. [LedgerView crypto] -> ShowS
forall crypto. LedgerView crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LedgerView crypto] -> ShowS
$cshowList :: forall crypto. [LedgerView crypto] -> ShowS
show :: LedgerView crypto -> String
$cshow :: forall crypto. LedgerView crypto -> String
showsPrec :: Int -> LedgerView crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> LedgerView crypto -> ShowS
Show)