{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Ouroboros.Consensus.Shelley.Protocol.Praos () where

import qualified Cardano.Crypto.Hash as Hash
import qualified Cardano.Crypto.KES as KES
import Cardano.Crypto.VRF (certifiedOutput)
import Cardano.Ledger.BaseTypes (ProtVer (ProtVer), StrictMaybe)
import Cardano.Ledger.Binary (getVersion32)
import Cardano.Ledger.Block (BlockHeaderVersionInfo (..), EbReferencesAnnouncement)
import Cardano.Ledger.Chain (ChainChecksPParams (..))
import Cardano.Ledger.Core (Era)
import Cardano.Ledger.Hashes (EraIndependentBlockBody, HASH)
import Cardano.Ledger.Slot (SlotNo (unSlotNo))
import Cardano.Protocol.Crypto (Crypto, KES)
import qualified Cardano.Protocol.Leios.BlockHeader as LeiosCodec
import Cardano.Protocol.Praos.BlockHeader
  ( Header (..)
  , HeaderBody (..)
  , headerHash
  , headerSize
  )
import Cardano.Protocol.TPraos.BlockHeader (PrevHash)
import Cardano.Protocol.TPraos.OCert
  ( OCert (ocertKESPeriod, ocertVkHot)
  )
import qualified Cardano.Protocol.TPraos.OCert as SL
import Cardano.Slotting.Block (BlockNo)
import Control.Monad.Except (Except)
import Data.Either (isRight)
import Data.Word (Word32, Word64)
import Ouroboros.Consensus.Protocol.Ledger.HotKey (HotKey)
import Ouroboros.Consensus.Protocol.Praos
import Ouroboros.Consensus.Protocol.Praos.Common
  ( MaxMajorProtVer (MaxMajorProtVer)
  , PraosCanBeLeader
  )
import Ouroboros.Consensus.Protocol.Praos.Views
import Ouroboros.Consensus.Protocol.Praos2
  ( ConsensusConfig (..)
  , LeiosCrypto
  , LeiosOnly (..)
  , Praos2
  )
import Ouroboros.Consensus.Protocol.Signed
import Ouroboros.Consensus.Shelley.Protocol.Abstract
  ( ProtoCrypto
  , ProtocolHeaderSupportsEnvelope (..)
  , ProtocolHeaderSupportsKES (..)
  , ProtocolHeaderSupportsProtocol (..)
  , ShelleyHash (ShelleyHash)
  , ShelleyProtocol
  , defaultHeaderContainsLeiosCert
  )
import Ouroboros.Consensus.Shelley.Protocol.EnvelopeChecks
  ( EnvelopeError
  , EnvelopeHeaderView (..)
  , envelopeCheck
  )

type instance ProtoCrypto (Praos c) = c

instance PraosCrypto c => ProtocolHeaderSupportsEnvelope (Praos c) where
  pHeaderHash :: ShelleyProtocolHeader (Praos c) -> ShelleyHash
pHeaderHash ShelleyProtocolHeader (Praos c)
hdr = Hash HASH EraIndependentBlockHeader -> ShelleyHash
ShelleyHash (Hash HASH EraIndependentBlockHeader -> ShelleyHash)
-> Hash HASH EraIndependentBlockHeader -> ShelleyHash
forall a b. (a -> b) -> a -> b
$ Header c -> Hash HASH EraIndependentBlockHeader
forall crypto. Header crypto -> Hash HASH EraIndependentBlockHeader
headerHash Header c
ShelleyProtocolHeader (Praos c)
hdr
  pHeaderPrevHash :: ShelleyProtocolHeader (Praos c) -> PrevHash
pHeaderPrevHash (Header HeaderBody c
body SignedKES (KES c) (HeaderBody c)
_) = HeaderBody c -> PrevHash
forall crypto. HeaderBody crypto -> PrevHash
hbPrev HeaderBody c
body
  pHeaderBodyHash :: ShelleyProtocolHeader (Praos c)
-> Hash HASH EraIndependentBlockBody
pHeaderBodyHash (Header HeaderBody c
body SignedKES (KES c) (HeaderBody c)
_) = HeaderBody c -> Hash HASH EraIndependentBlockBody
forall crypto.
HeaderBody crypto -> Hash HASH EraIndependentBlockBody
hbBodyHash HeaderBody c
body
  pHeaderSlot :: ShelleyProtocolHeader (Praos c) -> SlotNo
pHeaderSlot (Header HeaderBody c
body SignedKES (KES c) (HeaderBody c)
_) = HeaderBody c -> SlotNo
forall crypto. HeaderBody crypto -> SlotNo
hbSlotNo HeaderBody c
body
  pHeaderBlock :: ShelleyProtocolHeader (Praos c) -> BlockNo
pHeaderBlock (Header HeaderBody c
body SignedKES (KES c) (HeaderBody c)
_) = HeaderBody c -> BlockNo
forall crypto. HeaderBody crypto -> BlockNo
hbBlockNo HeaderBody c
body
  pHeaderSize :: ShelleyProtocolHeader (Praos c) -> Natural
pHeaderSize ShelleyProtocolHeader (Praos c)
hdr = Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Natural) -> Int -> Natural
forall a b. (a -> b) -> a -> b
$ Header c -> Int
forall crypto. Header crypto -> Int
headerSize Header c
ShelleyProtocolHeader (Praos c)
hdr
  pHeaderBlockSize :: ShelleyProtocolHeader (Praos c) -> Natural
pHeaderBlockSize (Header HeaderBody c
body SignedKES (KES c) (HeaderBody c)
_) = Word32 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Natural) -> Word32 -> Natural
forall a b. (a -> b) -> a -> b
$ HeaderBody c -> Word32
forall crypto. HeaderBody crypto -> Word32
hbBodySize HeaderBody c
body
  pHeaderContainsLeiosCert :: ShelleyProtocolHeader (Praos c) -> Bool
pHeaderContainsLeiosCert = ShelleyProtocolHeader (Praos c) -> Bool
forall proto. ShelleyProtocolHeader proto -> Bool
defaultHeaderContainsLeiosCert

  type EnvelopeCheckError _ = EnvelopeError

  envelopeChecks :: ConsensusConfig (Praos c)
-> LedgerView (Praos c)
-> ShelleyProtocolHeader (Praos c)
-> Except (EnvelopeCheckError (Praos c)) ()
envelopeChecks ConsensusConfig (Praos c)
cfg LedgerView (Praos c)
lv ShelleyProtocolHeader (Praos c)
hdr =
    ConsensusConfig (Praos c)
-> PolyPraosLedgerView (Praos c)
-> Int
-> Word32
-> Except EnvelopeError ()
forall c proto.
ConsensusConfig (Praos c)
-> PolyPraosLedgerView proto
-> Int
-> Word32
-> Except EnvelopeError ()
envelopeChecksPolyPraos ConsensusConfig (Praos c)
cfg LedgerView (Praos c)
PolyPraosLedgerView (Praos c)
lv (Header c -> Int
forall crypto. Header crypto -> Int
headerSize Header c
ShelleyProtocolHeader (Praos c)
hdr) (HeaderBody c -> Word32
forall crypto. HeaderBody crypto -> Word32
hbBodySize HeaderBody c
body)
   where
    Header HeaderBody c
body SignedKES (KES c) (HeaderBody c)
_ = ShelleyProtocolHeader (Praos c)
hdr

-- | 'envelopeChecks' for every Praos.
envelopeChecksPolyPraos ::
  ConsensusConfig (Praos c) ->
  PolyPraosLedgerView proto ->
  -- | Size of the header
  Int ->
  -- | Size of the block body
  Word32 ->
  Except EnvelopeError ()
envelopeChecksPolyPraos :: forall c proto.
ConsensusConfig (Praos c)
-> PolyPraosLedgerView proto
-> Int
-> Word32
-> Except EnvelopeError ()
envelopeChecksPolyPraos ConsensusConfig (Praos c)
cfg PolyPraosLedgerView proto
lv Int
hdrSize Word32
bodySize =
  Version
-> ChainChecksPParams
-> EnvelopeHeaderView
-> Except EnvelopeError ()
envelopeCheck Version
maxpv ChainChecksPParams
ccd (EnvelopeHeaderView -> Except EnvelopeError ())
-> EnvelopeHeaderView -> Except EnvelopeError ()
forall a b. (a -> b) -> a -> b
$
    EnvelopeHeaderView
      { ehvProtVer :: Version
ehvProtVer = Version
m
      , ehvHeaderSize :: Int
ehvHeaderSize = Int
hdrSize
      , ehvBodySize :: Word32
ehvBodySize = Word32
bodySize
      }
 where
  MaxMajorProtVer Version
maxpv = PraosParams -> MaxMajorProtVer
praosMaxMajorPV (ConsensusConfig (Praos c) -> PraosParams
forall c. ConsensusConfig (Praos c) -> PraosParams
praosParams ConsensusConfig (Praos c)
cfg)
  ProtVer Version
m Word32
_ = PolyPraosLedgerView proto -> ProtVer
forall proto. PolyPraosLedgerView proto -> ProtVer
plvProtocolVersion PolyPraosLedgerView proto
lv
  ccd :: ChainChecksPParams
ccd =
    ChainChecksPParams
      { ccMaxBHSize :: Word16
ccMaxBHSize = PolyPraosLedgerView proto -> Word16
forall proto. PolyPraosLedgerView proto -> Word16
plvMaxHeaderSize PolyPraosLedgerView proto
lv
      , ccMaxBBSize :: Word32
ccMaxBBSize = PolyPraosLedgerView proto -> Word32
forall proto. PolyPraosLedgerView proto -> Word32
plvMaxBodySize PolyPraosLedgerView proto
lv
      , ccProtocolVersion :: ProtVer
ccProtocolVersion = PolyPraosLedgerView proto -> ProtVer
forall proto. PolyPraosLedgerView proto -> ProtVer
plvProtocolVersion PolyPraosLedgerView proto
lv
      }

instance PraosCrypto c => ProtocolHeaderSupportsKES (Praos c) where
  configSlotsPerKESPeriod :: ConsensusConfig (Praos c) -> Word64
configSlotsPerKESPeriod ConsensusConfig (Praos c)
cfg = PraosParams -> Word64
praosSlotsPerKESPeriod (PraosParams -> Word64) -> PraosParams -> Word64
forall a b. (a -> b) -> a -> b
$ ConsensusConfig (Praos c) -> PraosParams
forall c. ConsensusConfig (Praos c) -> PraosParams
praosParams ConsensusConfig (Praos c)
cfg
  verifyHeaderIntegrity :: Word64 -> ShelleyProtocolHeader (Praos c) -> Bool
verifyHeaderIntegrity Word64
slotsPerKESPeriod =
    Word64 -> PolyPraosValidateView (Praos c) c -> Bool
forall proto c.
PolyPraosCrypto proto c =>
Word64 -> PolyPraosValidateView proto c -> Bool
verifyHeaderIntegrityPolyPraos Word64
slotsPerKESPeriod (PolyPraosValidateView (Praos c) c -> Bool)
-> (Header c -> PolyPraosValidateView (Praos c) c)
-> Header c
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header c -> PolyPraosValidateView (Praos c) c
ShelleyProtocolHeader (Praos c) -> ValidateView (Praos c)
forall proto.
ProtocolHeaderSupportsProtocol proto =>
ShelleyProtocolHeader proto -> ValidateView proto
protocolHeaderView
  mkHeader :: forall crypto (m :: * -> *) era (proxy :: * -> *).
(Crypto crypto, Monad m, crypto ~ ProtoCrypto (Praos c),
 Era era) =>
proxy era
-> HotKey crypto m
-> CanBeLeader (Praos c)
-> IsLeader (Praos c)
-> SlotNo
-> BlockNo
-> PrevHash
-> Hash HASH EraIndependentBlockBody
-> Int
-> ProtVer
-> WhenLeios (Praos c) (Bool, StrictMaybe EbReferencesAnnouncement)
-> m (ShelleyProtocolHeader (Praos c))
mkHeader proxy era
_ HotKey crypto m
hk CanBeLeader (Praos c)
cbl IsLeader (Praos c)
il SlotNo
slotNo BlockNo
blockNo PrevHash
prevHash Hash HASH EraIndependentBlockBody
bbHash Int
sz ProtVer
protVer (PraosLacksLeios ()) =
    HotKey crypto m
-> PraosCanBeLeader crypto
-> PraosIsLeader crypto
-> SlotNo
-> BlockNo
-> PrevHash
-> Hash HASH EraIndependentBlockBody
-> Int
-> ProtVer
-> (HeaderBody crypto -> HeaderBody crypto)
-> (HeaderBody crypto
    -> SignedKES (KES crypto) (HeaderBody crypto) -> Header crypto)
-> m (Header crypto)
forall c body (m :: * -> *) hdr.
(Crypto c, Signable (KES c) body, Monad m) =>
HotKey c m
-> PraosCanBeLeader c
-> PraosIsLeader c
-> SlotNo
-> BlockNo
-> PrevHash
-> Hash HASH EraIndependentBlockBody
-> Int
-> ProtVer
-> (HeaderBody c -> body)
-> (body -> SignedKES (KES c) body -> hdr)
-> m hdr
mkHeaderPolyPraos HotKey crypto m
hk CanBeLeader (Praos c)
PraosCanBeLeader crypto
cbl IsLeader (Praos c)
PraosIsLeader crypto
il SlotNo
slotNo BlockNo
blockNo PrevHash
prevHash Hash HASH EraIndependentBlockBody
bbHash Int
sz ProtVer
protVer HeaderBody crypto -> HeaderBody crypto
forall a. a -> a
id HeaderBody crypto
-> SignedKES (KES crypto) (HeaderBody crypto) -> Header crypto
forall crypto.
Crypto crypto =>
HeaderBody crypto
-> SignedKES (KES crypto) (HeaderBody crypto) -> Header crypto
Header

-- | 'verifyHeaderIntegrity' for every Praos.
verifyHeaderIntegrityPolyPraos ::
  PolyPraosCrypto proto c =>
  Word64 ->
  PolyPraosValidateView proto c ->
  Bool
verifyHeaderIntegrityPolyPraos :: forall proto c.
PolyPraosCrypto proto c =>
Word64 -> PolyPraosValidateView proto c -> Bool
verifyHeaderIntegrityPolyPraos Word64
slotsPerKESPeriod PolyPraosValidateView proto c
hv =
  Either String () -> Bool
forall a b. Either a b -> Bool
isRight (Either String () -> Bool) -> Either String () -> Bool
forall a b. (a -> b) -> a -> b
$ ContextKES (KES c)
-> VerKeyKES (KES c)
-> Word
-> Signed (ShelleyProtocolHeader proto)
-> SignedKES (KES c) (Signed (ShelleyProtocolHeader proto))
-> Either String ()
forall v a.
(KESAlgorithm v, Signable v a) =>
ContextKES v
-> VerKeyKES v -> Word -> a -> SignedKES v a -> Either String ()
KES.verifySignedKES () VerKeyKES (KES c)
ocertVkHot Word
t (PolyPraosValidateView proto c
-> Signed (ShelleyProtocolHeader proto)
forall proto crypto.
PolyPraosValidateView proto crypto
-> Signed (ShelleyProtocolHeader proto)
hvSigned PolyPraosValidateView proto c
hv) (PolyPraosValidateView proto c
-> SignedKES (KES c) (Signed (ShelleyProtocolHeader proto))
forall proto crypto.
PolyPraosValidateView proto crypto
-> SignedKES (KES crypto) (Signed (ShelleyProtocolHeader proto))
hvSignature PolyPraosValidateView proto c
hv)
 where
  SL.OCert
    { VerKeyKES (KES c)
ocertVkHot :: forall c. OCert c -> VerKeyKES (KES c)
ocertVkHot :: VerKeyKES (KES c)
ocertVkHot
    , ocertKESPeriod :: forall c. OCert c -> KESPeriod
ocertKESPeriod = SL.KESPeriod Word
startOfKesPeriod
    } = PolyPraosValidateView proto c -> OCert c
forall proto crypto.
PolyPraosValidateView proto crypto -> OCert crypto
hvOCert PolyPraosValidateView proto c
hv

  currentKesPeriod :: Word
currentKesPeriod =
    Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word) -> Word64 -> Word
forall a b. (a -> b) -> a -> b
$
      SlotNo -> Word64
unSlotNo (PolyPraosValidateView proto c -> SlotNo
forall proto crypto. PolyPraosValidateView proto crypto -> SlotNo
hvSlotNo PolyPraosValidateView proto c
hv) Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Word64
slotsPerKESPeriod

  t :: Word
t
    | Word
currentKesPeriod Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
>= Word
startOfKesPeriod =
        Word
currentKesPeriod Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
startOfKesPeriod
    | Bool
otherwise =
        Word
0

-- | 'mkHeader' for every Praos.
--
-- The fields the protocols share are filled in here; the caller says how its own
-- header body extends that, since only it knows the extra fields, and how to
-- assemble the signed header.
mkHeaderPolyPraos ::
  (Crypto c, KES.Signable (KES c) body, Monad m) =>
  HotKey c m ->
  PraosCanBeLeader c ->
  PraosIsLeader c ->
  SlotNo ->
  BlockNo ->
  PrevHash ->
  Hash.Hash HASH EraIndependentBlockBody ->
  Int ->
  ProtVer ->
  -- | How this protocol's header body extends the shared one
  (HeaderBody c -> body) ->
  -- | How this protocol assembles the signed header
  (body -> KES.SignedKES (KES c) body -> hdr) ->
  m hdr
mkHeaderPolyPraos :: forall c body (m :: * -> *) hdr.
(Crypto c, Signable (KES c) body, Monad m) =>
HotKey c m
-> PraosCanBeLeader c
-> PraosIsLeader c
-> SlotNo
-> BlockNo
-> PrevHash
-> Hash HASH EraIndependentBlockBody
-> Int
-> ProtVer
-> (HeaderBody c -> body)
-> (body -> SignedKES (KES c) body -> hdr)
-> m hdr
mkHeaderPolyPraos HotKey c m
hk PraosCanBeLeader c
cbl PraosIsLeader c
il SlotNo
slotNo BlockNo
blockNo PrevHash
prevHash Hash HASH EraIndependentBlockBody
bbHash Int
sz ProtVer
protVer HeaderBody c -> body
extend body -> SignedKES (KES c) body -> hdr
mkHdr = do
  PraosFields{praosSignature, praosToSign} <- HotKey c m
-> PraosCanBeLeader c
-> PraosIsLeader c
-> (PraosToSign c -> body)
-> m (PraosFields c body)
forall c toSign (m :: * -> *).
(Crypto c, Signable (KES c) toSign, Monad m) =>
HotKey c m
-> PraosCanBeLeader c
-> PraosIsLeader c
-> (PraosToSign c -> toSign)
-> m (PraosFields c toSign)
forgePraosFields HotKey c m
hk PraosCanBeLeader c
cbl PraosIsLeader c
il PraosToSign c -> body
mkBhBodyBytes
  pure $ mkHdr praosToSign praosSignature
 where
  mkBhBodyBytes :: PraosToSign c -> body
mkBhBodyBytes
    PraosToSign
      { VKey BlockIssuer
praosToSignIssuerVK :: VKey BlockIssuer
praosToSignIssuerVK :: forall c. PraosToSign c -> VKey BlockIssuer
praosToSignIssuerVK
      , VerKeyVRF (VRF c)
praosToSignVrfVK :: VerKeyVRF (VRF c)
praosToSignVrfVK :: forall c. PraosToSign c -> VerKeyVRF (VRF c)
praosToSignVrfVK
      , CertifiedVRF (VRF c) InputVRF
praosToSignVrfRes :: CertifiedVRF (VRF c) InputVRF
praosToSignVrfRes :: forall c. PraosToSign c -> CertifiedVRF (VRF c) InputVRF
praosToSignVrfRes
      , OCert c
praosToSignOCert :: OCert c
praosToSignOCert :: forall c. PraosToSign c -> OCert c
praosToSignOCert
      } =
      HeaderBody c -> body
extend (HeaderBody c -> body) -> HeaderBody c -> body
forall a b. (a -> b) -> a -> b
$
        HeaderBody
          { hbBlockNo :: BlockNo
hbBlockNo = BlockNo
blockNo
          , hbSlotNo :: SlotNo
hbSlotNo = SlotNo
slotNo
          , hbPrev :: PrevHash
hbPrev = PrevHash
prevHash
          , hbVk :: VKey BlockIssuer
hbVk = VKey BlockIssuer
praosToSignIssuerVK
          , hbVrfVk :: VerKeyVRF (VRF c)
hbVrfVk = VerKeyVRF (VRF c)
praosToSignVrfVK
          , hbVrfRes :: CertifiedVRF (VRF c) InputVRF
hbVrfRes = CertifiedVRF (VRF c) InputVRF
praosToSignVrfRes
          , hbBodySize :: Word32
hbBodySize = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz
          , hbBodyHash :: Hash HASH EraIndependentBlockBody
hbBodyHash = Hash HASH EraIndependentBlockBody
bbHash
          , hbOCert :: OCert c
hbOCert = OCert c
praosToSignOCert
          , hbProtVer :: ProtVer
hbProtVer = ProtVer
protVer
          }

instance PraosCrypto c => ProtocolHeaderSupportsProtocol (Praos c) where
  type CannotForgeError (Praos c) = PraosCannotForge c
  protocolHeaderView :: ShelleyProtocolHeader (Praos c) -> ValidateView (Praos c)
protocolHeaderView Header{HeaderBody c
headerBody :: HeaderBody c
headerBody :: forall crypto. Crypto crypto => Header crypto -> HeaderBody crypto
headerBody, SignedKES (KES c) (HeaderBody c)
headerSig :: SignedKES (KES c) (HeaderBody c)
headerSig :: forall crypto.
Crypto crypto =>
Header crypto -> SignedKES (KES crypto) (HeaderBody crypto)
headerSig} =
    HeaderView
      { hvPrevHash :: PrevHash
hvPrevHash = HeaderBody c -> PrevHash
forall crypto. HeaderBody crypto -> PrevHash
hbPrev HeaderBody c
headerBody
      , hvVK :: VKey BlockIssuer
hvVK = HeaderBody c -> VKey BlockIssuer
forall crypto. HeaderBody crypto -> VKey BlockIssuer
hbVk HeaderBody c
headerBody
      , hvVrfVK :: VerKeyVRF (VRF c)
hvVrfVK = HeaderBody c -> VerKeyVRF (VRF c)
forall crypto. HeaderBody crypto -> VerKeyVRF (VRF crypto)
hbVrfVk HeaderBody c
headerBody
      , hvVrfRes :: CertifiedVRF (VRF c) InputVRF
hvVrfRes = HeaderBody c -> CertifiedVRF (VRF c) InputVRF
forall crypto.
HeaderBody crypto -> CertifiedVRF (VRF crypto) InputVRF
hbVrfRes HeaderBody c
headerBody
      , hvOCert :: OCert c
hvOCert = HeaderBody c -> OCert c
forall crypto. HeaderBody crypto -> OCert crypto
hbOCert HeaderBody c
headerBody
      , hvSlotNo :: SlotNo
hvSlotNo = HeaderBody c -> SlotNo
forall crypto. HeaderBody crypto -> SlotNo
hbSlotNo HeaderBody c
headerBody
      , hvLeios :: WhenLeios (Praos c) (Bool, StrictMaybe EbReferencesAnnouncement)
hvLeios = ()
-> WhenLeios (Praos c) (Bool, StrictMaybe EbReferencesAnnouncement)
forall c a b. a -> LeiosOnly (Praos c) a b
PraosLacksLeios ()
      , hvSigned :: Signed (ShelleyProtocolHeader (Praos c))
hvSigned = HeaderBody c
Signed (ShelleyProtocolHeader (Praos c))
headerBody
      , hvSignature :: SignedKES (KES c) (Signed (ShelleyProtocolHeader (Praos c)))
hvSignature = SignedKES (KES c) (HeaderBody c)
SignedKES (KES c) (Signed (ShelleyProtocolHeader (Praos c)))
headerSig
      }
  pHeaderIssuer :: ShelleyProtocolHeader (Praos c) -> VKey BlockIssuer
pHeaderIssuer = HeaderBody c -> VKey BlockIssuer
forall crypto. HeaderBody crypto -> VKey BlockIssuer
hbVk (HeaderBody c -> VKey BlockIssuer)
-> (Header c -> HeaderBody c) -> Header c -> VKey BlockIssuer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header c -> HeaderBody c
forall crypto. Crypto crypto => Header crypto -> HeaderBody crypto
headerBody
  pHeaderIssueNo :: ShelleyProtocolHeader (Praos c) -> Word64
pHeaderIssueNo = OCert c -> Word64
forall c. OCert c -> Word64
SL.ocertN (OCert c -> Word64) -> (Header c -> OCert c) -> Header c -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderBody c -> OCert c
forall crypto. HeaderBody crypto -> OCert crypto
hbOCert (HeaderBody c -> OCert c)
-> (Header c -> HeaderBody c) -> Header c -> OCert c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header c -> HeaderBody c
forall crypto. Crypto crypto => Header crypto -> HeaderBody crypto
headerBody

  -- This is the "unified" VRF value, prior to range extension which yields e.g.
  -- the leader VRF value used for slot election.
  --
  -- In the future, we might want to use a dedicated range-extended VRF value
  -- here instead.
  pTieBreakVRFValue :: ShelleyProtocolHeader (Praos c)
-> OutputVRF (VRF (ProtoCrypto (Praos c)))
pTieBreakVRFValue = CertifiedVRF (VRF c) InputVRF -> OutputVRF (VRF c)
forall v a. CertifiedVRF v a -> OutputVRF v
certifiedOutput (CertifiedVRF (VRF c) InputVRF -> OutputVRF (VRF c))
-> (Header c -> CertifiedVRF (VRF c) InputVRF)
-> Header c
-> OutputVRF (VRF c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderBody c -> CertifiedVRF (VRF c) InputVRF
forall crypto.
HeaderBody crypto -> CertifiedVRF (VRF crypto) InputVRF
hbVrfRes (HeaderBody c -> CertifiedVRF (VRF c) InputVRF)
-> (Header c -> HeaderBody c)
-> Header c
-> CertifiedVRF (VRF c) InputVRF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header c -> HeaderBody c
forall crypto. Crypto crypto => Header crypto -> HeaderBody crypto
headerBody

instance PraosCrypto c => SignedHeader (Header c) where
  headerSigned :: Header c -> Signed (Header c)
headerSigned = Header c -> HeaderBody c
Header c -> Signed (Header c)
forall crypto. Crypto crypto => Header crypto -> HeaderBody crypto
headerBody

instance PraosCrypto c => ShelleyProtocol (Praos c)

{-------------------------------------------------------------------------------
  Praos2
-------------------------------------------------------------------------------}

type instance ProtoCrypto (Praos2 c) = c

instance LeiosCrypto c => ProtocolHeaderSupportsEnvelope (Praos2 c) where
  pHeaderHash :: ShelleyProtocolHeader (Praos2 c) -> ShelleyHash
pHeaderHash ShelleyProtocolHeader (Praos2 c)
hdr = Hash HASH EraIndependentBlockHeader -> ShelleyHash
ShelleyHash (Hash HASH EraIndependentBlockHeader -> ShelleyHash)
-> Hash HASH EraIndependentBlockHeader -> ShelleyHash
forall a b. (a -> b) -> a -> b
$ Header c -> Hash HASH EraIndependentBlockHeader
forall crypto. Header crypto -> Hash HASH EraIndependentBlockHeader
LeiosCodec.headerHash Header c
ShelleyProtocolHeader (Praos2 c)
hdr
  pHeaderPrevHash :: ShelleyProtocolHeader (Praos2 c) -> PrevHash
pHeaderPrevHash = HeaderBody c -> PrevHash
forall crypto. HeaderBody crypto -> PrevHash
LeiosCodec.hbPrev (HeaderBody c -> PrevHash)
-> (Header c -> HeaderBody c) -> Header c -> PrevHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header c -> HeaderBody c
forall crypto. Header crypto -> HeaderBody crypto
LeiosCodec.headerBody
  pHeaderBodyHash :: ShelleyProtocolHeader (Praos2 c)
-> Hash HASH EraIndependentBlockBody
pHeaderBodyHash = HeaderBody c -> Hash HASH EraIndependentBlockBody
forall crypto.
HeaderBody crypto -> Hash HASH EraIndependentBlockBody
LeiosCodec.hbBodyHash (HeaderBody c -> Hash HASH EraIndependentBlockBody)
-> (Header c -> HeaderBody c)
-> Header c
-> Hash HASH EraIndependentBlockBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header c -> HeaderBody c
forall crypto. Header crypto -> HeaderBody crypto
LeiosCodec.headerBody
  pHeaderSlot :: ShelleyProtocolHeader (Praos2 c) -> SlotNo
pHeaderSlot = HeaderBody c -> SlotNo
forall crypto. HeaderBody crypto -> SlotNo
LeiosCodec.hbSlotNo (HeaderBody c -> SlotNo)
-> (Header c -> HeaderBody c) -> Header c -> SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header c -> HeaderBody c
forall crypto. Header crypto -> HeaderBody crypto
LeiosCodec.headerBody
  pHeaderBlock :: ShelleyProtocolHeader (Praos2 c) -> BlockNo
pHeaderBlock = HeaderBody c -> BlockNo
forall crypto. HeaderBody crypto -> BlockNo
LeiosCodec.hbBlockNo (HeaderBody c -> BlockNo)
-> (Header c -> HeaderBody c) -> Header c -> BlockNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header c -> HeaderBody c
forall crypto. Header crypto -> HeaderBody crypto
LeiosCodec.headerBody
  pHeaderSize :: ShelleyProtocolHeader (Praos2 c) -> Natural
pHeaderSize ShelleyProtocolHeader (Praos2 c)
hdr = Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Natural) -> Int -> Natural
forall a b. (a -> b) -> a -> b
$ Header c -> Int
forall crypto. Header crypto -> Int
LeiosCodec.headerSize Header c
ShelleyProtocolHeader (Praos2 c)
hdr
  pHeaderBlockSize :: ShelleyProtocolHeader (Praos2 c) -> Natural
pHeaderBlockSize = Word32 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Natural) -> (Header c -> Word32) -> Header c -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderBody c -> Word32
forall crypto. HeaderBody crypto -> Word32
LeiosCodec.hbBodySize (HeaderBody c -> Word32)
-> (Header c -> HeaderBody c) -> Header c -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header c -> HeaderBody c
forall crypto. Header crypto -> HeaderBody crypto
LeiosCodec.headerBody
  pHeaderContainsLeiosCert :: ShelleyProtocolHeader (Praos2 c) -> Bool
pHeaderContainsLeiosCert = HeaderBody c -> Bool
forall crypto. HeaderBody crypto -> Bool
LeiosCodec.hbBlockBodyContainsLeiosCert (HeaderBody c -> Bool)
-> (Header c -> HeaderBody c) -> Header c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header c -> HeaderBody c
forall crypto. Header crypto -> HeaderBody crypto
LeiosCodec.headerBody

  type EnvelopeCheckError _ = EnvelopeError

  envelopeChecks :: ConsensusConfig (Praos2 c)
-> LedgerView (Praos2 c)
-> ShelleyProtocolHeader (Praos2 c)
-> Except (EnvelopeCheckError (Praos2 c)) ()
envelopeChecks ConsensusConfig (Praos2 c)
cfg LedgerView (Praos2 c)
lv ShelleyProtocolHeader (Praos2 c)
hdr =
    ConsensusConfig (Praos c)
-> PolyPraosLedgerView (Praos2 c)
-> Int
-> Word32
-> Except EnvelopeError ()
forall c proto.
ConsensusConfig (Praos c)
-> PolyPraosLedgerView proto
-> Int
-> Word32
-> Except EnvelopeError ()
envelopeChecksPolyPraos
      (ConsensusConfig (Praos2 c) -> ConsensusConfig (Praos c)
forall c. ConsensusConfig (Praos2 c) -> ConsensusConfig (Praos c)
leiosPraosConfig ConsensusConfig (Praos2 c)
cfg)
      LedgerView (Praos2 c)
PolyPraosLedgerView (Praos2 c)
lv
      (Header c -> Int
forall crypto. Header crypto -> Int
LeiosCodec.headerSize Header c
ShelleyProtocolHeader (Praos2 c)
hdr)
      (HeaderBody c -> Word32
forall crypto. HeaderBody crypto -> Word32
LeiosCodec.hbBodySize (Header c -> HeaderBody c
forall crypto. Header crypto -> HeaderBody crypto
LeiosCodec.headerBody Header c
ShelleyProtocolHeader (Praos2 c)
hdr))

instance LeiosCrypto c => ProtocolHeaderSupportsKES (Praos2 c) where
  configSlotsPerKESPeriod :: ConsensusConfig (Praos2 c) -> Word64
configSlotsPerKESPeriod ConsensusConfig (Praos2 c)
cfg = PraosParams -> Word64
praosSlotsPerKESPeriod (PraosParams -> Word64) -> PraosParams -> Word64
forall a b. (a -> b) -> a -> b
$ ConsensusConfig (Praos c) -> PraosParams
forall c. ConsensusConfig (Praos c) -> PraosParams
praosParams (ConsensusConfig (Praos c) -> PraosParams)
-> ConsensusConfig (Praos c) -> PraosParams
forall a b. (a -> b) -> a -> b
$ ConsensusConfig (Praos2 c) -> ConsensusConfig (Praos c)
forall c. ConsensusConfig (Praos2 c) -> ConsensusConfig (Praos c)
leiosPraosConfig ConsensusConfig (Praos2 c)
cfg
  verifyHeaderIntegrity :: Word64 -> ShelleyProtocolHeader (Praos2 c) -> Bool
verifyHeaderIntegrity Word64
slotsPerKESPeriod =
    Word64 -> PolyPraosValidateView (Praos2 c) c -> Bool
forall proto c.
PolyPraosCrypto proto c =>
Word64 -> PolyPraosValidateView proto c -> Bool
verifyHeaderIntegrityPolyPraos Word64
slotsPerKESPeriod (PolyPraosValidateView (Praos2 c) c -> Bool)
-> (Header c -> PolyPraosValidateView (Praos2 c) c)
-> Header c
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header c -> PolyPraosValidateView (Praos2 c) c
ShelleyProtocolHeader (Praos2 c) -> ValidateView (Praos2 c)
forall proto.
ProtocolHeaderSupportsProtocol proto =>
ShelleyProtocolHeader proto -> ValidateView proto
protocolHeaderView
  mkHeader :: forall crypto (m :: * -> *) era (proxy :: * -> *).
(Crypto crypto, Monad m, crypto ~ ProtoCrypto (Praos2 c),
 Era era) =>
proxy era
-> HotKey crypto m
-> CanBeLeader (Praos2 c)
-> IsLeader (Praos2 c)
-> SlotNo
-> BlockNo
-> PrevHash
-> Hash HASH EraIndependentBlockBody
-> Int
-> ProtVer
-> WhenLeios
     (Praos2 c) (Bool, StrictMaybe EbReferencesAnnouncement)
-> m (ShelleyProtocolHeader (Praos2 c))
mkHeader
    proxy era
era
    HotKey crypto m
hk
    CanBeLeader (Praos2 c)
cbl
    IsLeader (Praos2 c)
il
    SlotNo
slotNo
    BlockNo
blockNo
    PrevHash
prevHash
    Hash HASH EraIndependentBlockBody
bbHash
    Int
sz
    ProtVer
protVer
    (Praos2HasLeios (Bool
containsCert, StrictMaybe EbReferencesAnnouncement
mbAnn)) =
      HotKey crypto m
-> PraosCanBeLeader crypto
-> PraosIsLeader crypto
-> SlotNo
-> BlockNo
-> PrevHash
-> Hash HASH EraIndependentBlockBody
-> Int
-> ProtVer
-> (HeaderBody crypto -> HeaderBody crypto)
-> (HeaderBody crypto
    -> SignedKES (KES crypto) (HeaderBody crypto) -> Header crypto)
-> m (Header crypto)
forall c body (m :: * -> *) hdr.
(Crypto c, Signable (KES c) body, Monad m) =>
HotKey c m
-> PraosCanBeLeader c
-> PraosIsLeader c
-> SlotNo
-> BlockNo
-> PrevHash
-> Hash HASH EraIndependentBlockBody
-> Int
-> ProtVer
-> (HeaderBody c -> body)
-> (body -> SignedKES (KES c) body -> hdr)
-> m hdr
mkHeaderPolyPraos
        HotKey crypto m
hk
        CanBeLeader (Praos2 c)
PraosCanBeLeader crypto
cbl
        IsLeader (Praos2 c)
PraosIsLeader crypto
il
        SlotNo
slotNo
        BlockNo
blockNo
        PrevHash
prevHash
        Hash HASH EraIndependentBlockBody
bbHash
        Int
sz
        ProtVer
protVer
        (\HeaderBody crypto
pb -> proxy era
-> HeaderBody crypto
-> Bool
-> StrictMaybe EbReferencesAnnouncement
-> HeaderBody crypto
forall c era (proxy :: * -> *).
(Crypto c, Era era) =>
proxy era
-> HeaderBody c
-> Bool
-> StrictMaybe EbReferencesAnnouncement
-> HeaderBody c
extendHeaderBodyWithLeios proxy era
era HeaderBody crypto
pb Bool
containsCert StrictMaybe EbReferencesAnnouncement
mbAnn)
        (proxy era
-> HeaderBody crypto
-> SignedKES (KES crypto) (HeaderBody crypto)
-> Header crypto
forall era crypto (proxy :: * -> *).
(Era era, Crypto crypto) =>
proxy era
-> HeaderBody crypto
-> SignedKES (KES crypto) (HeaderBody crypto)
-> Header crypto
LeiosCodec.mkHeader proxy era
era)

-- | The Leios header body is the Praos one plus the Leios fields.
--
-- The version info has the protocol version's wire format: the highest
-- supported major version, and the self-reported software tag.
extendHeaderBodyWithLeios ::
  (Crypto c, Era era) =>
  proxy era ->
  HeaderBody c ->
  -- | Whether the block body carries a Leios certificate
  Bool ->
  StrictMaybe EbReferencesAnnouncement ->
  LeiosCodec.HeaderBody c
extendHeaderBodyWithLeios :: forall c era (proxy :: * -> *).
(Crypto c, Era era) =>
proxy era
-> HeaderBody c
-> Bool
-> StrictMaybe EbReferencesAnnouncement
-> HeaderBody c
extendHeaderBodyWithLeios proxy era
proxy HeaderBody c
pb Bool
containsCert StrictMaybe EbReferencesAnnouncement
ann =
  proxy era -> HeaderBodyRaw c -> HeaderBody c
forall era crypto (proxy :: * -> *).
(Era era, Crypto crypto) =>
proxy era -> HeaderBodyRaw crypto -> HeaderBody crypto
LeiosCodec.mkHeaderBody proxy era
proxy (HeaderBodyRaw c -> HeaderBody c)
-> HeaderBodyRaw c -> HeaderBody c
forall a b. (a -> b) -> a -> b
$
    LeiosCodec.HeaderBodyRaw
      { hbrBlockNo :: BlockNo
LeiosCodec.hbrBlockNo = HeaderBody c -> BlockNo
forall crypto. HeaderBody crypto -> BlockNo
hbBlockNo HeaderBody c
pb
      , hbrSlotNo :: SlotNo
LeiosCodec.hbrSlotNo = HeaderBody c -> SlotNo
forall crypto. HeaderBody crypto -> SlotNo
hbSlotNo HeaderBody c
pb
      , hbrPrev :: PrevHash
LeiosCodec.hbrPrev = HeaderBody c -> PrevHash
forall crypto. HeaderBody crypto -> PrevHash
hbPrev HeaderBody c
pb
      , hbrVk :: VKey BlockIssuer
LeiosCodec.hbrVk = HeaderBody c -> VKey BlockIssuer
forall crypto. HeaderBody crypto -> VKey BlockIssuer
hbVk HeaderBody c
pb
      , hbrVrfVk :: VerKeyVRF (VRF c)
LeiosCodec.hbrVrfVk = HeaderBody c -> VerKeyVRF (VRF c)
forall crypto. HeaderBody crypto -> VerKeyVRF (VRF crypto)
hbVrfVk HeaderBody c
pb
      , hbrVrfRes :: CertifiedVRF (VRF c) InputVRF
LeiosCodec.hbrVrfRes = HeaderBody c -> CertifiedVRF (VRF c) InputVRF
forall crypto.
HeaderBody crypto -> CertifiedVRF (VRF crypto) InputVRF
hbVrfRes HeaderBody c
pb
      , hbrBodySize :: Word32
LeiosCodec.hbrBodySize = HeaderBody c -> Word32
forall crypto. HeaderBody crypto -> Word32
hbBodySize HeaderBody c
pb
      , hbrBodyHash :: Hash HASH EraIndependentBlockBody
LeiosCodec.hbrBodyHash = HeaderBody c -> Hash HASH EraIndependentBlockBody
forall crypto.
HeaderBody crypto -> Hash HASH EraIndependentBlockBody
hbBodyHash HeaderBody c
pb
      , hbrOCert :: OCert c
LeiosCodec.hbrOCert = HeaderBody c -> OCert c
forall crypto. HeaderBody crypto -> OCert crypto
hbOCert HeaderBody c
pb
      , hbrVersionInfo :: BlockHeaderVersionInfo
LeiosCodec.hbrVersionInfo = Word32 -> Word32 -> BlockHeaderVersionInfo
BlockHeaderVersionInfo (Version -> Word32
getVersion32 Version
major) Word32
minor
      , hbrBlockBodyContainsLeiosCert :: Bool
LeiosCodec.hbrBlockBodyContainsLeiosCert = Bool
containsCert
      , hbrEbReferencesAnnouncement :: StrictMaybe EbReferencesAnnouncement
LeiosCodec.hbrEbReferencesAnnouncement = StrictMaybe EbReferencesAnnouncement
ann
      }
 where
  ProtVer Version
major Word32
minor = HeaderBody c -> ProtVer
forall crypto. HeaderBody crypto -> ProtVer
hbProtVer HeaderBody c
pb

instance LeiosCrypto c => ProtocolHeaderSupportsProtocol (Praos2 c) where
  type CannotForgeError (Praos2 c) = PraosCannotForge c
  protocolHeaderView :: ShelleyProtocolHeader (Praos2 c) -> ValidateView (Praos2 c)
protocolHeaderView ShelleyProtocolHeader (Praos2 c)
header =
    HeaderView
      { hvPrevHash :: PrevHash
hvPrevHash = HeaderBody c -> PrevHash
forall crypto. HeaderBody crypto -> PrevHash
LeiosCodec.hbPrev HeaderBody c
body
      , hvVK :: VKey BlockIssuer
hvVK = HeaderBody c -> VKey BlockIssuer
forall crypto. HeaderBody crypto -> VKey BlockIssuer
LeiosCodec.hbVk HeaderBody c
body
      , hvVrfVK :: VerKeyVRF (VRF c)
hvVrfVK = HeaderBody c -> VerKeyVRF (VRF c)
forall crypto. HeaderBody crypto -> VerKeyVRF (VRF crypto)
LeiosCodec.hbVrfVk HeaderBody c
body
      , hvVrfRes :: CertifiedVRF (VRF c) InputVRF
hvVrfRes = HeaderBody c -> CertifiedVRF (VRF c) InputVRF
forall crypto.
HeaderBody crypto -> CertifiedVRF (VRF crypto) InputVRF
LeiosCodec.hbVrfRes HeaderBody c
body
      , hvOCert :: OCert c
hvOCert = HeaderBody c -> OCert c
forall crypto. HeaderBody crypto -> OCert crypto
LeiosCodec.hbOCert HeaderBody c
body
      , hvSlotNo :: SlotNo
hvSlotNo = HeaderBody c -> SlotNo
forall crypto. HeaderBody crypto -> SlotNo
LeiosCodec.hbSlotNo HeaderBody c
body
      , hvLeios :: WhenLeios (Praos2 c) (Bool, StrictMaybe EbReferencesAnnouncement)
hvLeios =
          (Bool, StrictMaybe EbReferencesAnnouncement)
-> WhenLeios
     (Praos2 c) (Bool, StrictMaybe EbReferencesAnnouncement)
forall c a b. b -> LeiosOnly (Praos2 c) a b
Praos2HasLeios
            ( HeaderBody c -> Bool
forall crypto. HeaderBody crypto -> Bool
LeiosCodec.hbBlockBodyContainsLeiosCert HeaderBody c
body
            , HeaderBody c -> StrictMaybe EbReferencesAnnouncement
forall crypto.
HeaderBody crypto -> StrictMaybe EbReferencesAnnouncement
LeiosCodec.hbEbReferencesAnnouncement HeaderBody c
body
            )
      , hvSigned :: Signed (ShelleyProtocolHeader (Praos2 c))
hvSigned = HeaderBody c
Signed (ShelleyProtocolHeader (Praos2 c))
body
      , hvSignature :: SignedKES (KES c) (Signed (ShelleyProtocolHeader (Praos2 c)))
hvSignature = Header c -> SignedKES (KES c) (HeaderBody c)
forall crypto.
Header crypto -> SignedKES (KES crypto) (HeaderBody crypto)
LeiosCodec.headerSig Header c
ShelleyProtocolHeader (Praos2 c)
header
      }
   where
    body :: HeaderBody c
body = Header c -> HeaderBody c
forall crypto. Header crypto -> HeaderBody crypto
LeiosCodec.headerBody Header c
ShelleyProtocolHeader (Praos2 c)
header
  pHeaderIssuer :: ShelleyProtocolHeader (Praos2 c) -> VKey BlockIssuer
pHeaderIssuer = HeaderBody c -> VKey BlockIssuer
forall crypto. HeaderBody crypto -> VKey BlockIssuer
LeiosCodec.hbVk (HeaderBody c -> VKey BlockIssuer)
-> (Header c -> HeaderBody c) -> Header c -> VKey BlockIssuer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header c -> HeaderBody c
forall crypto. Header crypto -> HeaderBody crypto
LeiosCodec.headerBody
  pHeaderIssueNo :: ShelleyProtocolHeader (Praos2 c) -> Word64
pHeaderIssueNo = OCert c -> Word64
forall c. OCert c -> Word64
SL.ocertN (OCert c -> Word64) -> (Header c -> OCert c) -> Header c -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderBody c -> OCert c
forall crypto. HeaderBody crypto -> OCert crypto
LeiosCodec.hbOCert (HeaderBody c -> OCert c)
-> (Header c -> HeaderBody c) -> Header c -> OCert c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header c -> HeaderBody c
forall crypto. Header crypto -> HeaderBody crypto
LeiosCodec.headerBody
  pTieBreakVRFValue :: ShelleyProtocolHeader (Praos2 c)
-> OutputVRF (VRF (ProtoCrypto (Praos2 c)))
pTieBreakVRFValue = CertifiedVRF (VRF c) InputVRF -> OutputVRF (VRF c)
forall v a. CertifiedVRF v a -> OutputVRF v
certifiedOutput (CertifiedVRF (VRF c) InputVRF -> OutputVRF (VRF c))
-> (Header c -> CertifiedVRF (VRF c) InputVRF)
-> Header c
-> OutputVRF (VRF c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderBody c -> CertifiedVRF (VRF c) InputVRF
forall crypto.
HeaderBody crypto -> CertifiedVRF (VRF crypto) InputVRF
LeiosCodec.hbVrfRes (HeaderBody c -> CertifiedVRF (VRF c) InputVRF)
-> (Header c -> HeaderBody c)
-> Header c
-> CertifiedVRF (VRF c) InputVRF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header c -> HeaderBody c
forall crypto. Header crypto -> HeaderBody crypto
LeiosCodec.headerBody

instance LeiosCrypto c => SignedHeader (LeiosCodec.Header c) where
  headerSigned :: Header c -> Signed (Header c)
headerSigned = Header c -> HeaderBody c
Header c -> Signed (Header c)
forall crypto. Header crypto -> HeaderBody crypto
LeiosCodec.headerBody

instance LeiosCrypto c => ShelleyProtocol (Praos2 c)