{-# LANGUAGE DeriveGeneric  #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeFamilies   #-}
{-# OPTIONS_GHC -Wno-orphans #-}
-- See https://gitlab.haskell.org/ghc/ghc/-/issues/14630. GHC currently warns
-- (erroneously) about name shadowing for record field selectors defined by
-- pattern synonyms.
{-# OPTIONS_GHC -Wno-name-shadowing #-}

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

import qualified Cardano.Crypto.KES as KES
import           Cardano.Crypto.VRF (certifiedOutput)
import           Cardano.Ledger.BHeaderView
import           Cardano.Ledger.BaseTypes (ProtVer (ProtVer))
import           Cardano.Ledger.Keys (hashKey)
import           Cardano.Ledger.Slot (SlotNo (unSlotNo))
import           Cardano.Protocol.TPraos.OCert
                     (OCert (ocertKESPeriod, ocertVkHot))
import qualified Cardano.Protocol.TPraos.OCert as SL
import           Control.Monad (unless)
import           Control.Monad.Except (throwError)
import           Data.Either (isRight)
import           GHC.Generics (Generic)
import           NoThunks.Class (NoThunks)
import           Numeric.Natural (Natural)
import           Ouroboros.Consensus.Protocol.Praos
import           Ouroboros.Consensus.Protocol.Praos.Common
                     (MaxMajorProtVer (MaxMajorProtVer))
import           Ouroboros.Consensus.Protocol.Praos.Header (Header (..),
                     HeaderBody (..), headerHash, headerSize)
import           Ouroboros.Consensus.Protocol.Praos.Views
import           Ouroboros.Consensus.Protocol.Signed
import           Ouroboros.Consensus.Shelley.Protocol.Abstract (ProtoCrypto,
                     ProtocolHeaderSupportsEnvelope (..),
                     ProtocolHeaderSupportsKES (..),
                     ProtocolHeaderSupportsLedger (..),
                     ProtocolHeaderSupportsProtocol (..),
                     ShelleyHash (ShelleyHash), ShelleyProtocol,
                     ShelleyProtocolHeader)


type instance ProtoCrypto (Praos c) = c

type instance ShelleyProtocolHeader (Praos c) = Header c

data PraosEnvelopeError
  = ObsoleteNode Natural Natural
  | HeaderSizeTooLarge Natural Natural
  | BlockSizeTooLarge Natural Natural
  deriving (PraosEnvelopeError -> PraosEnvelopeError -> Bool
(PraosEnvelopeError -> PraosEnvelopeError -> Bool)
-> (PraosEnvelopeError -> PraosEnvelopeError -> Bool)
-> Eq PraosEnvelopeError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PraosEnvelopeError -> PraosEnvelopeError -> Bool
$c/= :: PraosEnvelopeError -> PraosEnvelopeError -> Bool
== :: PraosEnvelopeError -> PraosEnvelopeError -> Bool
$c== :: PraosEnvelopeError -> PraosEnvelopeError -> Bool
Eq, (forall x. PraosEnvelopeError -> Rep PraosEnvelopeError x)
-> (forall x. Rep PraosEnvelopeError x -> PraosEnvelopeError)
-> Generic PraosEnvelopeError
forall x. Rep PraosEnvelopeError x -> PraosEnvelopeError
forall x. PraosEnvelopeError -> Rep PraosEnvelopeError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PraosEnvelopeError x -> PraosEnvelopeError
$cfrom :: forall x. PraosEnvelopeError -> Rep PraosEnvelopeError x
Generic, Int -> PraosEnvelopeError -> ShowS
[PraosEnvelopeError] -> ShowS
PraosEnvelopeError -> String
(Int -> PraosEnvelopeError -> ShowS)
-> (PraosEnvelopeError -> String)
-> ([PraosEnvelopeError] -> ShowS)
-> Show PraosEnvelopeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PraosEnvelopeError] -> ShowS
$cshowList :: [PraosEnvelopeError] -> ShowS
show :: PraosEnvelopeError -> String
$cshow :: PraosEnvelopeError -> String
showsPrec :: Int -> PraosEnvelopeError -> ShowS
$cshowsPrec :: Int -> PraosEnvelopeError -> ShowS
Show)

instance NoThunks PraosEnvelopeError

instance PraosCrypto c => ProtocolHeaderSupportsEnvelope (Praos c) where
  pHeaderHash :: ShelleyProtocolHeader (Praos c)
-> ShelleyHash (ProtoCrypto (Praos c))
pHeaderHash ShelleyProtocolHeader (Praos c)
hdr = Hash c EraIndependentBlockHeader -> ShelleyHash c
forall crypto.
Hash crypto EraIndependentBlockHeader -> ShelleyHash crypto
ShelleyHash (Hash c EraIndependentBlockHeader -> ShelleyHash c)
-> Hash c EraIndependentBlockHeader -> ShelleyHash c
forall a b. (a -> b) -> a -> b
$ Header c -> Hash c EraIndependentBlockHeader
forall crypto.
Crypto crypto =>
Header crypto -> Hash (HASH crypto) EraIndependentBlockHeader
headerHash Header c
ShelleyProtocolHeader (Praos c)
hdr
  pHeaderPrevHash :: ShelleyProtocolHeader (Praos c) -> PrevHash (ProtoCrypto (Praos c))
pHeaderPrevHash (Header body _) = HeaderBody c -> PrevHash c
forall crypto. HeaderBody crypto -> PrevHash crypto
hbPrev HeaderBody c
body
  pHeaderBodyHash :: ShelleyProtocolHeader (Praos c)
-> Hash (ProtoCrypto (Praos c)) EraIndependentBlockBody
pHeaderBodyHash (Header body _) = HeaderBody c -> Hash c EraIndependentBlockBody
forall crypto.
HeaderBody crypto -> Hash crypto EraIndependentBlockBody
hbBodyHash HeaderBody c
body
  pHeaderSlot :: ShelleyProtocolHeader (Praos c) -> SlotNo
pHeaderSlot (Header body _) = HeaderBody c -> SlotNo
forall crypto. HeaderBody crypto -> SlotNo
hbSlotNo HeaderBody c
body
  pHeaderBlock :: ShelleyProtocolHeader (Praos c) -> BlockNo
pHeaderBlock (Header body _) = 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 body _) = 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

  type EnvelopeCheckError _ = PraosEnvelopeError

  envelopeChecks :: ConsensusConfig (Praos c)
-> Ticked (LedgerView (Praos c))
-> ShelleyProtocolHeader (Praos c)
-> Except (EnvelopeCheckError (Praos c)) ()
envelopeChecks ConsensusConfig (Praos c)
cfg (TickedPraosLedgerView lv) ShelleyProtocolHeader (Praos c)
hdr = do
    Bool
-> ExceptT PraosEnvelopeError Identity ()
-> ExceptT PraosEnvelopeError Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Natural
m Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
<= Natural
maxpv) (ExceptT PraosEnvelopeError Identity ()
 -> ExceptT PraosEnvelopeError Identity ())
-> ExceptT PraosEnvelopeError Identity ()
-> ExceptT PraosEnvelopeError Identity ()
forall a b. (a -> b) -> a -> b
$ PraosEnvelopeError -> ExceptT PraosEnvelopeError Identity ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Natural -> Natural -> PraosEnvelopeError
ObsoleteNode Natural
m Natural
maxpv)
    Bool
-> ExceptT PraosEnvelopeError Identity ()
-> ExceptT PraosEnvelopeError Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (BHeaderView c -> Int
forall crypto. BHeaderView crypto -> Int
bhviewHSize BHeaderView c
BHeaderView (ProtoCrypto (Praos c))
bhv) Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
<= Natural
maxHeaderSize) (ExceptT PraosEnvelopeError Identity ()
 -> ExceptT PraosEnvelopeError Identity ())
-> ExceptT PraosEnvelopeError Identity ()
-> ExceptT PraosEnvelopeError Identity ()
forall a b. (a -> b) -> a -> b
$
      PraosEnvelopeError -> ExceptT PraosEnvelopeError Identity ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PraosEnvelopeError -> ExceptT PraosEnvelopeError Identity ())
-> PraosEnvelopeError -> ExceptT PraosEnvelopeError Identity ()
forall a b. (a -> b) -> a -> b
$
        Natural -> Natural -> PraosEnvelopeError
HeaderSizeTooLarge (Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Natural) -> Int -> Natural
forall a b. (a -> b) -> a -> b
$ BHeaderView c -> Int
forall crypto. BHeaderView crypto -> Int
bhviewHSize BHeaderView c
BHeaderView (ProtoCrypto (Praos c))
bhv) Natural
maxHeaderSize
    Bool
-> ExceptT PraosEnvelopeError Identity ()
-> ExceptT PraosEnvelopeError Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (BHeaderView c -> Natural
forall crypto. BHeaderView crypto -> Natural
bhviewBSize BHeaderView c
BHeaderView (ProtoCrypto (Praos c))
bhv Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
<= Natural
maxBodySize) (ExceptT PraosEnvelopeError Identity ()
 -> ExceptT PraosEnvelopeError Identity ())
-> ExceptT PraosEnvelopeError Identity ()
-> ExceptT PraosEnvelopeError Identity ()
forall a b. (a -> b) -> a -> b
$
      PraosEnvelopeError -> ExceptT PraosEnvelopeError Identity ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PraosEnvelopeError -> ExceptT PraosEnvelopeError Identity ())
-> PraosEnvelopeError -> ExceptT PraosEnvelopeError Identity ()
forall a b. (a -> b) -> a -> b
$
        Natural -> Natural -> PraosEnvelopeError
BlockSizeTooLarge (BHeaderView c -> Natural
forall crypto. BHeaderView crypto -> Natural
bhviewBSize BHeaderView c
BHeaderView (ProtoCrypto (Praos c))
bhv) Natural
maxBodySize
    where
      pp :: PraosParams
pp = ConsensusConfig (Praos c) -> PraosParams
forall c. ConsensusConfig (Praos c) -> PraosParams
praosParams ConsensusConfig (Praos c)
cfg
      (MaxMajorProtVer Natural
maxpv) = PraosParams -> MaxMajorProtVer
praosMaxMajorPV PraosParams
pp
      (ProtVer Natural
m Natural
_) = LedgerView c -> ProtVer
forall crypto. LedgerView crypto -> ProtVer
lvProtocolVersion LedgerView c
lv
      maxHeaderSize :: Natural
maxHeaderSize = LedgerView c -> Natural
forall crypto. LedgerView crypto -> Natural
lvMaxHeaderSize LedgerView c
lv
      maxBodySize :: Natural
maxBodySize = LedgerView c -> Natural
forall crypto. LedgerView crypto -> Natural
lvMaxBodySize LedgerView c
lv
      bhv :: BHeaderView (ProtoCrypto (Praos c))
bhv = ShelleyProtocolHeader (Praos c)
-> BHeaderView (ProtoCrypto (Praos c))
forall proto.
ProtocolHeaderSupportsLedger proto =>
ShelleyProtocolHeader proto -> BHeaderView (ProtoCrypto proto)
mkHeaderView ShelleyProtocolHeader (Praos c)
hdr

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 ShelleyProtocolHeader (Praos c)
header =
    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)
-> Period
-> HeaderBody c
-> SignedKES (KES c) (HeaderBody c)
-> Either String ()
forall v a.
(KESAlgorithm v, Signable v a) =>
ContextKES v
-> VerKeyKES v -> Period -> a -> SignedKES v a -> Either String ()
KES.verifySignedKES () VerKeyKES (KES c)
ocertVkHot Period
t HeaderBody c
headerBody SignedKES (KES c) (HeaderBody c)
headerSig
    where
      Header {HeaderBody c
headerBody :: forall crypto. Header crypto -> Crypto crypto => HeaderBody crypto
headerBody :: HeaderBody c
headerBody, SignedKES (KES c) (HeaderBody c)
headerSig :: forall crypto.
Header crypto
-> Crypto crypto => SignedKES crypto (HeaderBody crypto)
headerSig :: SignedKES (KES c) (HeaderBody c)
headerSig} = Header c
ShelleyProtocolHeader (Praos c)
header
      SL.OCert
        { VerKeyKES (KES c)
ocertVkHot :: VerKeyKES (KES c)
ocertVkHot :: forall crypto. OCert crypto -> VerKeyKES crypto
ocertVkHot,
          ocertKESPeriod :: forall crypto. OCert crypto -> KESPeriod
ocertKESPeriod = SL.KESPeriod Period
startOfKesPeriod
        } = HeaderBody c -> OCert c
forall crypto. HeaderBody crypto -> OCert crypto
hbOCert HeaderBody c
headerBody

      currentKesPeriod :: Period
currentKesPeriod =
        Word64 -> Period
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Period) -> Word64 -> Period
forall a b. (a -> b) -> a -> b
$
          SlotNo -> Word64
unSlotNo (HeaderBody c -> SlotNo
forall crypto. HeaderBody crypto -> SlotNo
hbSlotNo HeaderBody c
headerBody) Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Word64
slotsPerKESPeriod

      t :: Period
t
        | Period
currentKesPeriod Period -> Period -> Bool
forall a. Ord a => a -> a -> Bool
>= Period
startOfKesPeriod =
            Period
currentKesPeriod Period -> Period -> Period
forall a. Num a => a -> a -> a
- Period
startOfKesPeriod
        | Bool
otherwise =
            Period
0
  mkHeader :: HotKey crypto m
-> CanBeLeader (Praos c)
-> IsLeader (Praos c)
-> SlotNo
-> BlockNo
-> PrevHash crypto
-> Hash crypto EraIndependentBlockBody
-> Int
-> ProtVer
-> m (ShelleyProtocolHeader (Praos c))
mkHeader HotKey crypto m
hk CanBeLeader (Praos c)
cbl IsLeader (Praos c)
il SlotNo
slotNo BlockNo
blockNo PrevHash crypto
prevHash Hash crypto EraIndependentBlockBody
bbHash Int
sz ProtVer
protVer = do
    PraosFields {SignedKES crypto (HeaderBody crypto)
praosSignature :: forall c toSign. PraosFields c toSign -> SignedKES c toSign
praosSignature :: SignedKES crypto (HeaderBody crypto)
praosSignature, HeaderBody crypto
praosToSign :: forall c toSign. PraosFields c toSign -> toSign
praosToSign :: HeaderBody crypto
praosToSign} <- HotKey crypto m
-> CanBeLeader (Praos crypto)
-> IsLeader (Praos crypto)
-> (PraosToSign crypto -> HeaderBody crypto)
-> m (PraosFields crypto (HeaderBody crypto))
forall c toSign (m :: * -> *).
(PraosCrypto c, KESignable c toSign, Monad m) =>
HotKey c m
-> CanBeLeader (Praos c)
-> IsLeader (Praos c)
-> (PraosToSign c -> toSign)
-> m (PraosFields c toSign)
forgePraosFields HotKey crypto m
hk CanBeLeader (Praos c)
CanBeLeader (Praos crypto)
cbl IsLeader (Praos c)
IsLeader (Praos crypto)
il PraosToSign crypto -> HeaderBody crypto
mkBhBodyBytes
    Header crypto -> m (Header crypto)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Header crypto -> m (Header crypto))
-> Header crypto -> m (Header crypto)
forall a b. (a -> b) -> a -> b
$ HeaderBody crypto
-> SignedKES crypto (HeaderBody crypto) -> Header crypto
forall crypto.
Crypto crypto =>
HeaderBody crypto
-> SignedKES crypto (HeaderBody crypto) -> Header crypto
Header HeaderBody crypto
praosToSign SignedKES crypto (HeaderBody crypto)
praosSignature
    where
      mkBhBodyBytes :: PraosToSign crypto -> HeaderBody crypto
mkBhBodyBytes
        PraosToSign
          { VKey 'BlockIssuer crypto
praosToSignIssuerVK :: forall c. PraosToSign c -> VKey 'BlockIssuer c
praosToSignIssuerVK :: VKey 'BlockIssuer crypto
praosToSignIssuerVK,
            VerKeyVRF crypto
praosToSignVrfVK :: forall c. PraosToSign c -> VerKeyVRF c
praosToSignVrfVK :: VerKeyVRF crypto
praosToSignVrfVK,
            CertifiedVRF crypto InputVRF
praosToSignVrfRes :: forall c. PraosToSign c -> CertifiedVRF c InputVRF
praosToSignVrfRes :: CertifiedVRF crypto InputVRF
praosToSignVrfRes,
            OCert crypto
praosToSignOCert :: forall c. PraosToSign c -> OCert c
praosToSignOCert :: OCert crypto
praosToSignOCert
          } =
          HeaderBody :: forall crypto.
BlockNo
-> SlotNo
-> PrevHash crypto
-> VKey 'BlockIssuer crypto
-> VerKeyVRF crypto
-> CertifiedVRF crypto InputVRF
-> Word32
-> Hash crypto EraIndependentBlockBody
-> OCert crypto
-> ProtVer
-> HeaderBody crypto
HeaderBody
            { hbBlockNo :: BlockNo
hbBlockNo = BlockNo
blockNo,
              hbSlotNo :: SlotNo
hbSlotNo = SlotNo
slotNo,
              hbPrev :: PrevHash crypto
hbPrev = PrevHash crypto
prevHash,
              hbVk :: VKey 'BlockIssuer crypto
hbVk = VKey 'BlockIssuer crypto
praosToSignIssuerVK,
              hbVrfVk :: VerKeyVRF crypto
hbVrfVk = VerKeyVRF crypto
praosToSignVrfVK,
              hbVrfRes :: CertifiedVRF crypto InputVRF
hbVrfRes = CertifiedVRF crypto InputVRF
praosToSignVrfRes,
              hbBodySize :: Word32
hbBodySize = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz,
              hbBodyHash :: Hash crypto EraIndependentBlockBody
hbBodyHash = Hash crypto EraIndependentBlockBody
bbHash,
              hbOCert :: OCert crypto
hbOCert = OCert crypto
praosToSignOCert,
              hbProtVer :: ProtVer
hbProtVer = ProtVer
protVer
            }

instance PraosCrypto c => ProtocolHeaderSupportsProtocol (Praos c) where
  type CannotForgeError _ = PraosCannotForge c
  protocolHeaderView :: ShelleyProtocolHeader (Praos c) -> ValidateView (Praos c)
protocolHeaderView Header {headerBody, headerSig} =
    HeaderView :: forall crypto.
PrevHash crypto
-> VKey 'BlockIssuer crypto
-> VerKeyVRF (VRF crypto)
-> CertifiedVRF (VRF crypto) InputVRF
-> OCert crypto
-> SlotNo
-> HeaderBody crypto
-> SignedKES (KES crypto) (HeaderBody crypto)
-> HeaderView crypto
HeaderView
      { hvPrevHash :: PrevHash c
hvPrevHash = HeaderBody c -> PrevHash c
forall crypto. HeaderBody crypto -> PrevHash crypto
hbPrev HeaderBody c
headerBody,
        hvVK :: VKey 'BlockIssuer c
hvVK = HeaderBody c -> VKey 'BlockIssuer c
forall crypto. HeaderBody crypto -> VKey 'BlockIssuer crypto
hbVk HeaderBody c
headerBody,
        hvVrfVK :: VerKeyVRF (VRF c)
hvVrfVK = HeaderBody c -> VerKeyVRF (VRF c)
forall crypto. HeaderBody crypto -> VerKeyVRF crypto
hbVrfVk HeaderBody c
headerBody,
        hvVrfRes :: CertifiedVRF (VRF c) InputVRF
hvVrfRes = HeaderBody c -> CertifiedVRF (VRF c) InputVRF
forall crypto. HeaderBody crypto -> CertifiedVRF 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,
        hvSigned :: HeaderBody c
hvSigned = HeaderBody c
headerBody,
        hvSignature :: SignedKES (KES c) (HeaderBody c)
hvSignature = SignedKES (KES c) (HeaderBody c)
headerSig
      }
  pHeaderIssuer :: ShelleyProtocolHeader (Praos c)
-> VKey 'BlockIssuer (ProtoCrypto (Praos c))
pHeaderIssuer = HeaderBody c -> VKey 'BlockIssuer c
forall crypto. HeaderBody crypto -> VKey 'BlockIssuer crypto
hbVk (HeaderBody c -> VKey 'BlockIssuer c)
-> (Header c -> HeaderBody c) -> Header c -> VKey 'BlockIssuer c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header c -> HeaderBody c
forall crypto. Header crypto -> Crypto crypto => HeaderBody crypto
headerBody
  pHeaderIssueNo :: ShelleyProtocolHeader (Praos c) -> Word64
pHeaderIssueNo = OCert c -> Word64
forall crypto. OCert crypto -> 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. Header crypto -> Crypto crypto => HeaderBody crypto
headerBody
  pHeaderVRFValue :: ShelleyProtocolHeader (Praos c)
-> OutputVRF (VRF (ProtoCrypto (Praos c)))
pHeaderVRFValue = 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 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. Header crypto -> Crypto crypto => HeaderBody crypto
headerBody

instance PraosCrypto c => ProtocolHeaderSupportsLedger (Praos c) where
  mkHeaderView :: ShelleyProtocolHeader (Praos c)
-> BHeaderView (ProtoCrypto (Praos c))
mkHeaderView hdr :: ShelleyProtocolHeader (Praos c)
hdr@Header {headerBody} =
    BHeaderView :: forall crypto.
KeyHash 'BlockIssuer crypto
-> Natural
-> Int
-> Hash crypto EraIndependentBlockBody
-> SlotNo
-> BHeaderView crypto
BHeaderView
      { bhviewID :: KeyHash 'BlockIssuer c
bhviewID = VKey 'BlockIssuer c -> KeyHash 'BlockIssuer c
forall crypto (kd :: KeyRole).
Crypto crypto =>
VKey kd crypto -> KeyHash kd crypto
hashKey (VKey 'BlockIssuer c -> KeyHash 'BlockIssuer c)
-> VKey 'BlockIssuer c -> KeyHash 'BlockIssuer c
forall a b. (a -> b) -> a -> b
$ HeaderBody c -> VKey 'BlockIssuer c
forall crypto. HeaderBody crypto -> VKey 'BlockIssuer crypto
hbVk HeaderBody c
headerBody,
        bhviewBSize :: Natural
bhviewBSize = 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
headerBody,
        bhviewHSize :: Int
bhviewHSize = Header c -> Int
forall crypto. Header crypto -> Int
headerSize Header c
ShelleyProtocolHeader (Praos c)
hdr,
        bhviewBHash :: Hash c EraIndependentBlockBody
bhviewBHash = HeaderBody c -> Hash c EraIndependentBlockBody
forall crypto.
HeaderBody crypto -> Hash crypto EraIndependentBlockBody
hbBodyHash HeaderBody c
headerBody,
        bhviewSlot :: SlotNo
bhviewSlot = HeaderBody c -> SlotNo
forall crypto. HeaderBody crypto -> SlotNo
hbSlotNo HeaderBody c
headerBody
      }

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

instance PraosCrypto c => ShelleyProtocol (Praos c)