{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE DerivingVia                #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns             #-}
{-# LANGUAGE PatternSynonyms            #-}
{-# LANGUAGE StandaloneDeriving         #-}

-- | Block header associated with Praos.
--
-- The choice of whether to associate the header with the ledger era or the
-- protocol is a little artitrary. Functionally the header contains things which
-- are associated with both ledger and protocol, and which are used by both.
--
-- We choose to associate the header with the protocol, since it more strongly
-- binds in that direction, and to assist with the mental picture that the
-- protocol is concerned with the block header, while the ledger is concerned
-- with the block body. However, in order to more cleanly illustrate which parts
-- of the header are _strictly_ protocol concerns, we also provide a view of the
-- header (in 'Ouroboros.Consensus.Protocol.Praos.Views') which extracts just
-- the fields needed for the Praos protocol. This also allows us to hide the
-- more detailed construction of the header.
module Ouroboros.Consensus.Protocol.Praos.Header (
    Header (Header, headerBody, headerSig)
  , HeaderBody (..)
  , headerHash
  , headerSize
  ) where

import           Cardano.Binary (FromCBOR (fromCBOR), ToCBOR (toCBOR),
                     serialize')
import qualified Cardano.Crypto.Hash as Hash
import           Cardano.Crypto.Util
                     (SignableRepresentation (getSignableRepresentation))
import           Cardano.Ledger.BaseTypes (ProtVer)
import qualified Cardano.Ledger.Crypto as CC
import           Cardano.Ledger.Hashes (EraIndependentBlockBody,
                     EraIndependentBlockHeader)
import           Cardano.Ledger.Keys (CertifiedVRF, Hash, KeyRole (BlockIssuer),
                     SignedKES, VKey, VerKeyVRF, decodeSignedKES,
                     decodeVerKeyVRF, encodeSignedKES, encodeVerKeyVRF)
import           Cardano.Ledger.Serialization (CBORGroup (unCBORGroup))
import           Cardano.Protocol.TPraos.BHeader (PrevHash)
import           Cardano.Protocol.TPraos.OCert (OCert)
import           Cardano.Slotting.Block (BlockNo)
import           Cardano.Slotting.Slot (SlotNo)
import qualified Data.ByteString.Short as SBS
import           Data.Coders
import           Data.MemoBytes (Mem, MemoBytes (Memo), memoBytes)
import           Data.Word (Word32)
import           GHC.Generics (Generic)
import           NoThunks.Class (NoThunks)
import           Ouroboros.Consensus.Protocol.Praos.VRF (InputVRF)

-- | The body of the header is the part which gets hashed to form the hash
-- chain.
data HeaderBody crypto = HeaderBody
  { -- | block number
    HeaderBody crypto -> BlockNo
hbBlockNo  :: !BlockNo,
    -- | block slot
    HeaderBody crypto -> SlotNo
hbSlotNo   :: !SlotNo,
    -- | Hash of the previous block header
    HeaderBody crypto -> PrevHash crypto
hbPrev     :: !(PrevHash crypto),
    -- | verification key of block issuer
    HeaderBody crypto -> VKey 'BlockIssuer crypto
hbVk       :: !(VKey 'BlockIssuer crypto),
    -- | VRF verification key for block issuer
    HeaderBody crypto -> VerKeyVRF crypto
hbVrfVk    :: !(VerKeyVRF crypto),
    -- | Certified VRF value
    HeaderBody crypto -> CertifiedVRF crypto InputVRF
hbVrfRes   :: !(CertifiedVRF crypto InputVRF),
    -- | Size of the block body
    HeaderBody crypto -> Word32
hbBodySize :: !Word32,
    -- | Hash of block body
    HeaderBody crypto -> Hash crypto EraIndependentBlockBody
hbBodyHash :: !(Hash crypto EraIndependentBlockBody),
    -- | operational certificate
    HeaderBody crypto -> OCert crypto
hbOCert    :: !(OCert crypto),
    -- | protocol version
    HeaderBody crypto -> ProtVer
hbProtVer  :: !ProtVer
  }
  deriving ((forall x. HeaderBody crypto -> Rep (HeaderBody crypto) x)
-> (forall x. Rep (HeaderBody crypto) x -> HeaderBody crypto)
-> Generic (HeaderBody crypto)
forall x. Rep (HeaderBody crypto) x -> HeaderBody crypto
forall x. HeaderBody crypto -> Rep (HeaderBody crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x. Rep (HeaderBody crypto) x -> HeaderBody crypto
forall crypto x. HeaderBody crypto -> Rep (HeaderBody crypto) x
$cto :: forall crypto x. Rep (HeaderBody crypto) x -> HeaderBody crypto
$cfrom :: forall crypto x. HeaderBody crypto -> Rep (HeaderBody crypto) x
Generic)

deriving instance CC.Crypto crypto => Show (HeaderBody crypto)

deriving instance CC.Crypto crypto => Eq (HeaderBody crypto)

instance
  CC.Crypto crypto =>
  SignableRepresentation (HeaderBody crypto)
  where
  getSignableRepresentation :: HeaderBody crypto -> ByteString
getSignableRepresentation = HeaderBody crypto -> ByteString
forall a. ToCBOR a => a -> ByteString
serialize'

instance
  CC.Crypto crypto =>
  NoThunks (HeaderBody crypto)

data HeaderRaw crypto = HeaderRaw
  { HeaderRaw crypto -> HeaderBody crypto
headerRawBody :: !(HeaderBody crypto),
    HeaderRaw crypto -> SignedKES crypto (HeaderBody crypto)
headerRawSig  :: !(SignedKES crypto (HeaderBody crypto))
  }
  deriving (Int -> HeaderRaw crypto -> ShowS
[HeaderRaw crypto] -> ShowS
HeaderRaw crypto -> String
(Int -> HeaderRaw crypto -> ShowS)
-> (HeaderRaw crypto -> String)
-> ([HeaderRaw crypto] -> ShowS)
-> Show (HeaderRaw crypto)
forall crypto. Crypto crypto => Int -> HeaderRaw crypto -> ShowS
forall crypto. Crypto crypto => [HeaderRaw crypto] -> ShowS
forall crypto. Crypto crypto => HeaderRaw crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HeaderRaw crypto] -> ShowS
$cshowList :: forall crypto. Crypto crypto => [HeaderRaw crypto] -> ShowS
show :: HeaderRaw crypto -> String
$cshow :: forall crypto. Crypto crypto => HeaderRaw crypto -> String
showsPrec :: Int -> HeaderRaw crypto -> ShowS
$cshowsPrec :: forall crypto. Crypto crypto => Int -> HeaderRaw crypto -> ShowS
Show, (forall x. HeaderRaw crypto -> Rep (HeaderRaw crypto) x)
-> (forall x. Rep (HeaderRaw crypto) x -> HeaderRaw crypto)
-> Generic (HeaderRaw crypto)
forall x. Rep (HeaderRaw crypto) x -> HeaderRaw crypto
forall x. HeaderRaw crypto -> Rep (HeaderRaw crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x. Rep (HeaderRaw crypto) x -> HeaderRaw crypto
forall crypto x. HeaderRaw crypto -> Rep (HeaderRaw crypto) x
$cto :: forall crypto x. Rep (HeaderRaw crypto) x -> HeaderRaw crypto
$cfrom :: forall crypto x. HeaderRaw crypto -> Rep (HeaderRaw crypto) x
Generic)

instance
  CC.Crypto crypto =>
  NoThunks (HeaderRaw crypto)

-- | Full header type, carrying its own memoised bytes.
newtype Header crypto = HeaderConstr (MemoBytes (HeaderRaw crypto))
  deriving newtype (Header crypto -> Header crypto -> Bool
(Header crypto -> Header crypto -> Bool)
-> (Header crypto -> Header crypto -> Bool) -> Eq (Header crypto)
forall crypto. Header crypto -> Header crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Header crypto -> Header crypto -> Bool
$c/= :: forall crypto. Header crypto -> Header crypto -> Bool
== :: Header crypto -> Header crypto -> Bool
$c== :: forall crypto. Header crypto -> Header crypto -> Bool
Eq, Int -> Header crypto -> ShowS
[Header crypto] -> ShowS
Header crypto -> String
(Int -> Header crypto -> ShowS)
-> (Header crypto -> String)
-> ([Header crypto] -> ShowS)
-> Show (Header crypto)
forall crypto. Crypto crypto => Int -> Header crypto -> ShowS
forall crypto. Crypto crypto => [Header crypto] -> ShowS
forall crypto. Crypto crypto => Header crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Header crypto] -> ShowS
$cshowList :: forall crypto. Crypto crypto => [Header crypto] -> ShowS
show :: Header crypto -> String
$cshow :: forall crypto. Crypto crypto => Header crypto -> String
showsPrec :: Int -> Header crypto -> ShowS
$cshowsPrec :: forall crypto. Crypto crypto => Int -> Header crypto -> ShowS
Show, Context -> Header crypto -> IO (Maybe ThunkInfo)
Proxy (Header crypto) -> String
(Context -> Header crypto -> IO (Maybe ThunkInfo))
-> (Context -> Header crypto -> IO (Maybe ThunkInfo))
-> (Proxy (Header crypto) -> String)
-> NoThunks (Header crypto)
forall crypto.
Crypto crypto =>
Context -> Header crypto -> IO (Maybe ThunkInfo)
forall crypto. Crypto crypto => Proxy (Header crypto) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (Header crypto) -> String
$cshowTypeOf :: forall crypto. Crypto crypto => Proxy (Header crypto) -> String
wNoThunks :: Context -> Header crypto -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall crypto.
Crypto crypto =>
Context -> Header crypto -> IO (Maybe ThunkInfo)
noThunks :: Context -> Header crypto -> IO (Maybe ThunkInfo)
$cnoThunks :: forall crypto.
Crypto crypto =>
Context -> Header crypto -> IO (Maybe ThunkInfo)
NoThunks, Typeable (Header crypto)
Typeable (Header crypto)
-> (Header crypto -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (Header crypto) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [Header crypto] -> Size)
-> ToCBOR (Header crypto)
Header crypto -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Header crypto] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Header crypto) -> Size
forall crypto. Typeable crypto => Typeable (Header crypto)
forall crypto. Typeable crypto => Header crypto -> Encoding
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
forall crypto.
Typeable crypto =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Header crypto] -> Size
forall crypto.
Typeable crypto =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Header crypto) -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Header crypto] -> Size
$cencodedListSizeExpr :: forall crypto.
Typeable crypto =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Header crypto] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Header crypto) -> Size
$cencodedSizeExpr :: forall crypto.
Typeable crypto =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Header crypto) -> Size
toCBOR :: Header crypto -> Encoding
$ctoCBOR :: forall crypto. Typeable crypto => Header crypto -> Encoding
$cp1ToCBOR :: forall crypto. Typeable crypto => Typeable (Header crypto)
ToCBOR)

deriving via
  (Mem (HeaderRaw crypto))
  instance
    CC.Crypto crypto => (FromCBOR (Annotator (Header crypto)))

pattern Header ::
  CC.Crypto crypto =>
  HeaderBody crypto ->
  SignedKES crypto (HeaderBody crypto) ->
  Header crypto
pattern $bHeader :: HeaderBody crypto
-> SignedKES crypto (HeaderBody crypto) -> Header crypto
$mHeader :: forall r crypto.
Crypto crypto =>
Header crypto
-> (HeaderBody crypto -> SignedKES crypto (HeaderBody crypto) -> r)
-> (Void# -> r)
-> r
Header {Header crypto -> Crypto crypto => HeaderBody crypto
headerBody, Header crypto
-> Crypto crypto => SignedKES crypto (HeaderBody crypto)
headerSig} <-
  HeaderConstr
    ( Memo
        HeaderRaw
          { headerRawBody = headerBody,
            headerRawSig = headerSig
          }
        _
      )
  where
    Header HeaderBody crypto
body SignedKES crypto (HeaderBody crypto)
sig =
      MemoBytes (HeaderRaw crypto) -> Header crypto
forall crypto. MemoBytes (HeaderRaw crypto) -> Header crypto
HeaderConstr (MemoBytes (HeaderRaw crypto) -> Header crypto)
-> MemoBytes (HeaderRaw crypto) -> Header crypto
forall a b. (a -> b) -> a -> b
$ Encode ('Closed 'Dense) (HeaderRaw crypto)
-> MemoBytes (HeaderRaw crypto)
forall (w :: Wrapped) t. Encode w t -> MemoBytes t
memoBytes (HeaderRaw crypto -> Encode ('Closed 'Dense) (HeaderRaw crypto)
forall crypto.
Crypto crypto =>
HeaderRaw crypto -> Encode ('Closed 'Dense) (HeaderRaw crypto)
encodeHeaderRaw (HeaderRaw crypto -> Encode ('Closed 'Dense) (HeaderRaw crypto))
-> HeaderRaw crypto -> Encode ('Closed 'Dense) (HeaderRaw crypto)
forall a b. (a -> b) -> a -> b
$ HeaderBody crypto
-> SignedKES crypto (HeaderBody crypto) -> HeaderRaw crypto
forall crypto.
HeaderBody crypto
-> SignedKES crypto (HeaderBody crypto) -> HeaderRaw crypto
HeaderRaw HeaderBody crypto
body SignedKES crypto (HeaderBody crypto)
sig)

{-# COMPLETE Header #-}

-- | Compute the size of the header
headerSize :: Header crypto -> Int
headerSize :: Header crypto -> Int
headerSize (HeaderConstr (Memo HeaderRaw crypto
_ ShortByteString
bytes)) = ShortByteString -> Int
SBS.length ShortByteString
bytes

-- | Hash a header
headerHash ::
  CC.Crypto crypto =>
  Header crypto ->
  Hash.Hash (CC.HASH crypto) EraIndependentBlockHeader
headerHash :: Header crypto -> Hash (HASH crypto) EraIndependentBlockHeader
headerHash = Hash (HASH crypto) (Header crypto)
-> Hash (HASH crypto) EraIndependentBlockHeader
forall h a b. Hash h a -> Hash h b
Hash.castHash (Hash (HASH crypto) (Header crypto)
 -> Hash (HASH crypto) EraIndependentBlockHeader)
-> (Header crypto -> Hash (HASH crypto) (Header crypto))
-> Header crypto
-> Hash (HASH crypto) EraIndependentBlockHeader
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Header crypto -> Encoding)
-> Header crypto -> Hash (HASH crypto) (Header crypto)
forall h a. HashAlgorithm h => (a -> Encoding) -> a -> Hash h a
Hash.hashWithSerialiser Header crypto -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR

--------------------------------------------------------------------------------
-- Serialisation
--------------------------------------------------------------------------------

instance CC.Crypto crypto => ToCBOR (HeaderBody crypto) where
  toCBOR :: HeaderBody crypto -> Encoding
toCBOR
    HeaderBody
      { BlockNo
hbBlockNo :: BlockNo
hbBlockNo :: forall crypto. HeaderBody crypto -> BlockNo
hbBlockNo,
        SlotNo
hbSlotNo :: SlotNo
hbSlotNo :: forall crypto. HeaderBody crypto -> SlotNo
hbSlotNo,
        PrevHash crypto
hbPrev :: PrevHash crypto
hbPrev :: forall crypto. HeaderBody crypto -> PrevHash crypto
hbPrev,
        VKey 'BlockIssuer crypto
hbVk :: VKey 'BlockIssuer crypto
hbVk :: forall crypto. HeaderBody crypto -> VKey 'BlockIssuer crypto
hbVk,
        VerKeyVRF crypto
hbVrfVk :: VerKeyVRF crypto
hbVrfVk :: forall crypto. HeaderBody crypto -> VerKeyVRF crypto
hbVrfVk,
        CertifiedVRF crypto InputVRF
hbVrfRes :: CertifiedVRF crypto InputVRF
hbVrfRes :: forall crypto. HeaderBody crypto -> CertifiedVRF crypto InputVRF
hbVrfRes,
        Word32
hbBodySize :: Word32
hbBodySize :: forall crypto. HeaderBody crypto -> Word32
hbBodySize,
        Hash crypto EraIndependentBlockBody
hbBodyHash :: Hash crypto EraIndependentBlockBody
hbBodyHash :: forall crypto.
HeaderBody crypto -> Hash crypto EraIndependentBlockBody
hbBodyHash,
        OCert crypto
hbOCert :: OCert crypto
hbOCert :: forall crypto. HeaderBody crypto -> OCert crypto
hbOCert,
        ProtVer
hbProtVer :: ProtVer
hbProtVer :: forall crypto. HeaderBody crypto -> ProtVer
hbProtVer
      } =
      Encode ('Closed 'Dense) (HeaderBody crypto) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode ('Closed 'Dense) (HeaderBody crypto) -> Encoding)
-> Encode ('Closed 'Dense) (HeaderBody crypto) -> Encoding
forall a b. (a -> b) -> a -> b
$
        (BlockNo
 -> SlotNo
 -> PrevHash crypto
 -> VKey 'BlockIssuer crypto
 -> VerKeyVRF crypto
 -> CertifiedVRF crypto InputVRF
 -> Word32
 -> Hash crypto EraIndependentBlockBody
 -> OCert crypto
 -> ProtVer
 -> HeaderBody crypto)
-> Encode
     ('Closed 'Dense)
     (BlockNo
      -> SlotNo
      -> PrevHash crypto
      -> VKey 'BlockIssuer crypto
      -> VerKeyVRF crypto
      -> CertifiedVRF crypto InputVRF
      -> Word32
      -> Hash crypto EraIndependentBlockBody
      -> OCert crypto
      -> ProtVer
      -> HeaderBody crypto)
forall t. t -> Encode ('Closed 'Dense) t
Rec BlockNo
-> SlotNo
-> PrevHash crypto
-> VKey 'BlockIssuer crypto
-> VerKeyVRF crypto
-> CertifiedVRF crypto InputVRF
-> Word32
-> Hash crypto EraIndependentBlockBody
-> OCert crypto
-> ProtVer
-> HeaderBody crypto
forall crypto.
BlockNo
-> SlotNo
-> PrevHash crypto
-> VKey 'BlockIssuer crypto
-> VerKeyVRF crypto
-> CertifiedVRF crypto InputVRF
-> Word32
-> Hash crypto EraIndependentBlockBody
-> OCert crypto
-> ProtVer
-> HeaderBody crypto
HeaderBody
          Encode
  ('Closed 'Dense)
  (BlockNo
   -> SlotNo
   -> PrevHash crypto
   -> VKey 'BlockIssuer crypto
   -> VerKeyVRF crypto
   -> CertifiedVRF crypto InputVRF
   -> Word32
   -> Hash crypto EraIndependentBlockBody
   -> OCert crypto
   -> ProtVer
   -> HeaderBody crypto)
-> Encode ('Closed 'Dense) BlockNo
-> Encode
     ('Closed 'Dense)
     (SlotNo
      -> PrevHash crypto
      -> VKey 'BlockIssuer crypto
      -> VerKeyVRF crypto
      -> CertifiedVRF crypto InputVRF
      -> Word32
      -> Hash crypto EraIndependentBlockBody
      -> OCert crypto
      -> ProtVer
      -> HeaderBody crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> BlockNo -> Encode ('Closed 'Dense) BlockNo
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To BlockNo
hbBlockNo
          Encode
  ('Closed 'Dense)
  (SlotNo
   -> PrevHash crypto
   -> VKey 'BlockIssuer crypto
   -> VerKeyVRF crypto
   -> CertifiedVRF crypto InputVRF
   -> Word32
   -> Hash crypto EraIndependentBlockBody
   -> OCert crypto
   -> ProtVer
   -> HeaderBody crypto)
-> Encode ('Closed 'Dense) SlotNo
-> Encode
     ('Closed 'Dense)
     (PrevHash crypto
      -> VKey 'BlockIssuer crypto
      -> VerKeyVRF crypto
      -> CertifiedVRF crypto InputVRF
      -> Word32
      -> Hash crypto EraIndependentBlockBody
      -> OCert crypto
      -> ProtVer
      -> HeaderBody crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> SlotNo -> Encode ('Closed 'Dense) SlotNo
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To SlotNo
hbSlotNo
          Encode
  ('Closed 'Dense)
  (PrevHash crypto
   -> VKey 'BlockIssuer crypto
   -> VerKeyVRF crypto
   -> CertifiedVRF crypto InputVRF
   -> Word32
   -> Hash crypto EraIndependentBlockBody
   -> OCert crypto
   -> ProtVer
   -> HeaderBody crypto)
-> Encode ('Closed 'Dense) (PrevHash crypto)
-> Encode
     ('Closed 'Dense)
     (VKey 'BlockIssuer crypto
      -> VerKeyVRF crypto
      -> CertifiedVRF crypto InputVRF
      -> Word32
      -> Hash crypto EraIndependentBlockBody
      -> OCert crypto
      -> ProtVer
      -> HeaderBody crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> PrevHash crypto -> Encode ('Closed 'Dense) (PrevHash crypto)
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To PrevHash crypto
hbPrev
          Encode
  ('Closed 'Dense)
  (VKey 'BlockIssuer crypto
   -> VerKeyVRF crypto
   -> CertifiedVRF crypto InputVRF
   -> Word32
   -> Hash crypto EraIndependentBlockBody
   -> OCert crypto
   -> ProtVer
   -> HeaderBody crypto)
-> Encode ('Closed 'Dense) (VKey 'BlockIssuer crypto)
-> Encode
     ('Closed 'Dense)
     (VerKeyVRF crypto
      -> CertifiedVRF crypto InputVRF
      -> Word32
      -> Hash crypto EraIndependentBlockBody
      -> OCert crypto
      -> ProtVer
      -> HeaderBody crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> VKey 'BlockIssuer crypto
-> Encode ('Closed 'Dense) (VKey 'BlockIssuer crypto)
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To VKey 'BlockIssuer crypto
hbVk
          Encode
  ('Closed 'Dense)
  (VerKeyVRF crypto
   -> CertifiedVRF crypto InputVRF
   -> Word32
   -> Hash crypto EraIndependentBlockBody
   -> OCert crypto
   -> ProtVer
   -> HeaderBody crypto)
-> Encode ('Closed 'Dense) (VerKeyVRF crypto)
-> Encode
     ('Closed 'Dense)
     (CertifiedVRF crypto InputVRF
      -> Word32
      -> Hash crypto EraIndependentBlockBody
      -> OCert crypto
      -> ProtVer
      -> HeaderBody crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (VerKeyVRF crypto -> Encoding)
-> VerKeyVRF crypto -> Encode ('Closed 'Dense) (VerKeyVRF crypto)
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E VerKeyVRF crypto -> Encoding
forall v. VRFAlgorithm v => VerKeyVRF v -> Encoding
encodeVerKeyVRF VerKeyVRF crypto
hbVrfVk
          Encode
  ('Closed 'Dense)
  (CertifiedVRF crypto InputVRF
   -> Word32
   -> Hash crypto EraIndependentBlockBody
   -> OCert crypto
   -> ProtVer
   -> HeaderBody crypto)
-> Encode ('Closed 'Dense) (CertifiedVRF crypto InputVRF)
-> Encode
     ('Closed 'Dense)
     (Word32
      -> Hash crypto EraIndependentBlockBody
      -> OCert crypto
      -> ProtVer
      -> HeaderBody crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> CertifiedVRF crypto InputVRF
-> Encode ('Closed 'Dense) (CertifiedVRF crypto InputVRF)
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To CertifiedVRF crypto InputVRF
hbVrfRes
          Encode
  ('Closed 'Dense)
  (Word32
   -> Hash crypto EraIndependentBlockBody
   -> OCert crypto
   -> ProtVer
   -> HeaderBody crypto)
-> Encode ('Closed 'Dense) Word32
-> Encode
     ('Closed 'Dense)
     (Hash crypto EraIndependentBlockBody
      -> OCert crypto -> ProtVer -> HeaderBody crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word32 -> Encode ('Closed 'Dense) Word32
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Word32
hbBodySize
          Encode
  ('Closed 'Dense)
  (Hash crypto EraIndependentBlockBody
   -> OCert crypto -> ProtVer -> HeaderBody crypto)
-> Encode ('Closed 'Dense) (Hash crypto EraIndependentBlockBody)
-> Encode
     ('Closed 'Dense) (OCert crypto -> ProtVer -> HeaderBody crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Hash crypto EraIndependentBlockBody
-> Encode ('Closed 'Dense) (Hash crypto EraIndependentBlockBody)
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Hash crypto EraIndependentBlockBody
hbBodyHash
          Encode
  ('Closed 'Dense) (OCert crypto -> ProtVer -> HeaderBody crypto)
-> Encode ('Closed 'Dense) (OCert crypto)
-> Encode ('Closed 'Dense) (ProtVer -> HeaderBody crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> OCert crypto -> Encode ('Closed 'Dense) (OCert crypto)
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To OCert crypto
hbOCert
          Encode ('Closed 'Dense) (ProtVer -> HeaderBody crypto)
-> Encode ('Closed 'Dense) ProtVer
-> Encode ('Closed 'Dense) (HeaderBody crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> ProtVer -> Encode ('Closed 'Dense) ProtVer
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To ProtVer
hbProtVer

instance CC.Crypto crypto => FromCBOR (HeaderBody crypto) where
  fromCBOR :: Decoder s (HeaderBody crypto)
fromCBOR =
    Decode ('Closed 'Dense) (HeaderBody crypto)
-> Decoder s (HeaderBody crypto)
forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) (HeaderBody crypto)
 -> Decoder s (HeaderBody crypto))
-> Decode ('Closed 'Dense) (HeaderBody crypto)
-> Decoder s (HeaderBody crypto)
forall a b. (a -> b) -> a -> b
$
      (BlockNo
 -> SlotNo
 -> PrevHash crypto
 -> VKey 'BlockIssuer crypto
 -> VerKeyVRF (VRF crypto)
 -> CertifiedVRF (VRF crypto) InputVRF
 -> Word32
 -> Hash (HASH crypto) EraIndependentBlockBody
 -> OCert crypto
 -> ProtVer
 -> HeaderBody crypto)
-> Decode
     ('Closed 'Dense)
     (BlockNo
      -> SlotNo
      -> PrevHash crypto
      -> VKey 'BlockIssuer crypto
      -> VerKeyVRF (VRF crypto)
      -> CertifiedVRF (VRF crypto) InputVRF
      -> Word32
      -> Hash (HASH crypto) EraIndependentBlockBody
      -> OCert crypto
      -> ProtVer
      -> HeaderBody crypto)
forall t. t -> Decode ('Closed 'Dense) t
RecD BlockNo
-> SlotNo
-> PrevHash crypto
-> VKey 'BlockIssuer crypto
-> VerKeyVRF (VRF crypto)
-> CertifiedVRF (VRF crypto) InputVRF
-> Word32
-> Hash (HASH crypto) EraIndependentBlockBody
-> OCert crypto
-> ProtVer
-> HeaderBody crypto
forall crypto.
BlockNo
-> SlotNo
-> PrevHash crypto
-> VKey 'BlockIssuer crypto
-> VerKeyVRF crypto
-> CertifiedVRF crypto InputVRF
-> Word32
-> Hash crypto EraIndependentBlockBody
-> OCert crypto
-> ProtVer
-> HeaderBody crypto
HeaderBody
        Decode
  ('Closed 'Dense)
  (BlockNo
   -> SlotNo
   -> PrevHash crypto
   -> VKey 'BlockIssuer crypto
   -> VerKeyVRF (VRF crypto)
   -> CertifiedVRF (VRF crypto) InputVRF
   -> Word32
   -> Hash (HASH crypto) EraIndependentBlockBody
   -> OCert crypto
   -> ProtVer
   -> HeaderBody crypto)
-> Decode ('Closed Any) BlockNo
-> Decode
     ('Closed 'Dense)
     (SlotNo
      -> PrevHash crypto
      -> VKey 'BlockIssuer crypto
      -> VerKeyVRF (VRF crypto)
      -> CertifiedVRF (VRF crypto) InputVRF
      -> Word32
      -> Hash (HASH crypto) EraIndependentBlockBody
      -> OCert crypto
      -> ProtVer
      -> HeaderBody crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) BlockNo
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (SlotNo
   -> PrevHash crypto
   -> VKey 'BlockIssuer crypto
   -> VerKeyVRF (VRF crypto)
   -> CertifiedVRF (VRF crypto) InputVRF
   -> Word32
   -> Hash (HASH crypto) EraIndependentBlockBody
   -> OCert crypto
   -> ProtVer
   -> HeaderBody crypto)
-> Decode ('Closed Any) SlotNo
-> Decode
     ('Closed 'Dense)
     (PrevHash crypto
      -> VKey 'BlockIssuer crypto
      -> VerKeyVRF (VRF crypto)
      -> CertifiedVRF (VRF crypto) InputVRF
      -> Word32
      -> Hash (HASH crypto) EraIndependentBlockBody
      -> OCert crypto
      -> ProtVer
      -> HeaderBody crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) SlotNo
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (PrevHash crypto
   -> VKey 'BlockIssuer crypto
   -> VerKeyVRF (VRF crypto)
   -> CertifiedVRF (VRF crypto) InputVRF
   -> Word32
   -> Hash (HASH crypto) EraIndependentBlockBody
   -> OCert crypto
   -> ProtVer
   -> HeaderBody crypto)
-> Decode ('Closed Any) (PrevHash crypto)
-> Decode
     ('Closed 'Dense)
     (VKey 'BlockIssuer crypto
      -> VerKeyVRF (VRF crypto)
      -> CertifiedVRF (VRF crypto) InputVRF
      -> Word32
      -> Hash (HASH crypto) EraIndependentBlockBody
      -> OCert crypto
      -> ProtVer
      -> HeaderBody crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (PrevHash crypto)
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (VKey 'BlockIssuer crypto
   -> VerKeyVRF (VRF crypto)
   -> CertifiedVRF (VRF crypto) InputVRF
   -> Word32
   -> Hash (HASH crypto) EraIndependentBlockBody
   -> OCert crypto
   -> ProtVer
   -> HeaderBody crypto)
-> Decode ('Closed Any) (VKey 'BlockIssuer crypto)
-> Decode
     ('Closed 'Dense)
     (VerKeyVRF (VRF crypto)
      -> CertifiedVRF (VRF crypto) InputVRF
      -> Word32
      -> Hash (HASH crypto) EraIndependentBlockBody
      -> OCert crypto
      -> ProtVer
      -> HeaderBody crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (VKey 'BlockIssuer crypto)
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (VerKeyVRF (VRF crypto)
   -> CertifiedVRF (VRF crypto) InputVRF
   -> Word32
   -> Hash (HASH crypto) EraIndependentBlockBody
   -> OCert crypto
   -> ProtVer
   -> HeaderBody crypto)
-> Decode ('Closed 'Dense) (VerKeyVRF (VRF crypto))
-> Decode
     ('Closed 'Dense)
     (CertifiedVRF (VRF crypto) InputVRF
      -> Word32
      -> Hash (HASH crypto) EraIndependentBlockBody
      -> OCert crypto
      -> ProtVer
      -> HeaderBody crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! (forall s. Decoder s (VerKeyVRF (VRF crypto)))
-> Decode ('Closed 'Dense) (VerKeyVRF (VRF crypto))
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D forall s. Decoder s (VerKeyVRF (VRF crypto))
forall v s. VRFAlgorithm v => Decoder s (VerKeyVRF v)
decodeVerKeyVRF
        Decode
  ('Closed 'Dense)
  (CertifiedVRF (VRF crypto) InputVRF
   -> Word32
   -> Hash (HASH crypto) EraIndependentBlockBody
   -> OCert crypto
   -> ProtVer
   -> HeaderBody crypto)
-> Decode ('Closed Any) (CertifiedVRF (VRF crypto) InputVRF)
-> Decode
     ('Closed 'Dense)
     (Word32
      -> Hash (HASH crypto) EraIndependentBlockBody
      -> OCert crypto
      -> ProtVer
      -> HeaderBody crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (CertifiedVRF (VRF crypto) InputVRF)
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (Word32
   -> Hash (HASH crypto) EraIndependentBlockBody
   -> OCert crypto
   -> ProtVer
   -> HeaderBody crypto)
-> Decode ('Closed Any) Word32
-> Decode
     ('Closed 'Dense)
     (Hash (HASH crypto) EraIndependentBlockBody
      -> OCert crypto -> ProtVer -> HeaderBody crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Word32
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (Hash (HASH crypto) EraIndependentBlockBody
   -> OCert crypto -> ProtVer -> HeaderBody crypto)
-> Decode
     ('Closed Any) (Hash (HASH crypto) EraIndependentBlockBody)
-> Decode
     ('Closed 'Dense) (OCert crypto -> ProtVer -> HeaderBody crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (Hash (HASH crypto) EraIndependentBlockBody)
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense) (OCert crypto -> ProtVer -> HeaderBody crypto)
-> Decode ('Closed Any) (OCert crypto)
-> Decode ('Closed 'Dense) (ProtVer -> HeaderBody crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! (CBORGroup (OCert crypto) -> OCert crypto
forall a. CBORGroup a -> a
unCBORGroup (CBORGroup (OCert crypto) -> OCert crypto)
-> Decode ('Closed Any) (CBORGroup (OCert crypto))
-> Decode ('Closed Any) (OCert crypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decode ('Closed Any) (CBORGroup (OCert crypto))
forall t (w :: Wrapped). FromCBOR t => Decode w t
From)
        Decode ('Closed 'Dense) (ProtVer -> HeaderBody crypto)
-> Decode ('Closed Any) ProtVer
-> Decode ('Closed 'Dense) (HeaderBody crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) ProtVer
forall t (w :: Wrapped). FromCBOR t => Decode w t
From

encodeHeaderRaw ::
  CC.Crypto crypto =>
  HeaderRaw crypto ->
  Encode ('Closed 'Dense) (HeaderRaw crypto)
encodeHeaderRaw :: HeaderRaw crypto -> Encode ('Closed 'Dense) (HeaderRaw crypto)
encodeHeaderRaw (HeaderRaw HeaderBody crypto
body SignedKES crypto (HeaderBody crypto)
sig) =
  (HeaderBody crypto
 -> SignedKES crypto (HeaderBody crypto) -> HeaderRaw crypto)
-> Encode
     ('Closed 'Dense)
     (HeaderBody crypto
      -> SignedKES crypto (HeaderBody crypto) -> HeaderRaw crypto)
forall t. t -> Encode ('Closed 'Dense) t
Rec HeaderBody crypto
-> SignedKES crypto (HeaderBody crypto) -> HeaderRaw crypto
forall crypto.
HeaderBody crypto
-> SignedKES crypto (HeaderBody crypto) -> HeaderRaw crypto
HeaderRaw Encode
  ('Closed 'Dense)
  (HeaderBody crypto
   -> SignedKES crypto (HeaderBody crypto) -> HeaderRaw crypto)
-> Encode ('Closed 'Dense) (HeaderBody crypto)
-> Encode
     ('Closed 'Dense)
     (SignedKES crypto (HeaderBody crypto) -> HeaderRaw crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> HeaderBody crypto -> Encode ('Closed 'Dense) (HeaderBody crypto)
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To HeaderBody crypto
body Encode
  ('Closed 'Dense)
  (SignedKES crypto (HeaderBody crypto) -> HeaderRaw crypto)
-> Encode ('Closed 'Dense) (SignedKES crypto (HeaderBody crypto))
-> Encode ('Closed 'Dense) (HeaderRaw crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (SignedKES crypto (HeaderBody crypto) -> Encoding)
-> SignedKES crypto (HeaderBody crypto)
-> Encode ('Closed 'Dense) (SignedKES crypto (HeaderBody crypto))
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E SignedKES crypto (HeaderBody crypto) -> Encoding
forall v a. KESAlgorithm v => SignedKES v a -> Encoding
encodeSignedKES SignedKES crypto (HeaderBody crypto)
sig

instance CC.Crypto crypto => ToCBOR (HeaderRaw crypto) where
  toCBOR :: HeaderRaw crypto -> Encoding
toCBOR = Encode ('Closed 'Dense) (HeaderRaw crypto) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode ('Closed 'Dense) (HeaderRaw crypto) -> Encoding)
-> (HeaderRaw crypto -> Encode ('Closed 'Dense) (HeaderRaw crypto))
-> HeaderRaw crypto
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderRaw crypto -> Encode ('Closed 'Dense) (HeaderRaw crypto)
forall crypto.
Crypto crypto =>
HeaderRaw crypto -> Encode ('Closed 'Dense) (HeaderRaw crypto)
encodeHeaderRaw

instance CC.Crypto crypto => FromCBOR (HeaderRaw crypto) where
  fromCBOR :: Decoder s (HeaderRaw crypto)
fromCBOR = Decode ('Closed 'Dense) (HeaderRaw crypto)
-> Decoder s (HeaderRaw crypto)
forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) (HeaderRaw crypto)
 -> Decoder s (HeaderRaw crypto))
-> Decode ('Closed 'Dense) (HeaderRaw crypto)
-> Decoder s (HeaderRaw crypto)
forall a b. (a -> b) -> a -> b
$ (HeaderBody crypto
 -> SignedKES (KES crypto) (HeaderBody crypto) -> HeaderRaw crypto)
-> Decode
     ('Closed 'Dense)
     (HeaderBody crypto
      -> SignedKES (KES crypto) (HeaderBody crypto) -> HeaderRaw crypto)
forall t. t -> Decode ('Closed 'Dense) t
RecD HeaderBody crypto
-> SignedKES (KES crypto) (HeaderBody crypto) -> HeaderRaw crypto
forall crypto.
HeaderBody crypto
-> SignedKES crypto (HeaderBody crypto) -> HeaderRaw crypto
HeaderRaw Decode
  ('Closed 'Dense)
  (HeaderBody crypto
   -> SignedKES (KES crypto) (HeaderBody crypto) -> HeaderRaw crypto)
-> Decode ('Closed Any) (HeaderBody crypto)
-> Decode
     ('Closed 'Dense)
     (SignedKES (KES crypto) (HeaderBody crypto) -> HeaderRaw crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (HeaderBody crypto)
forall t (w :: Wrapped). FromCBOR t => Decode w t
From Decode
  ('Closed 'Dense)
  (SignedKES (KES crypto) (HeaderBody crypto) -> HeaderRaw crypto)
-> Decode
     ('Closed 'Dense) (SignedKES (KES crypto) (HeaderBody crypto))
-> Decode ('Closed 'Dense) (HeaderRaw crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! (forall s. Decoder s (SignedKES (KES crypto) (HeaderBody crypto)))
-> Decode
     ('Closed 'Dense) (SignedKES (KES crypto) (HeaderBody crypto))
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D forall s. Decoder s (SignedKES (KES crypto) (HeaderBody crypto))
forall v s a. KESAlgorithm v => Decoder s (SignedKES v a)
decodeSignedKES

instance CC.Crypto crypto => FromCBOR (Annotator (HeaderRaw crypto)) where
  fromCBOR :: Decoder s (Annotator (HeaderRaw crypto))
fromCBOR = HeaderRaw crypto -> Annotator (HeaderRaw crypto)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HeaderRaw crypto -> Annotator (HeaderRaw crypto))
-> Decoder s (HeaderRaw crypto)
-> Decoder s (Annotator (HeaderRaw crypto))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (HeaderRaw crypto)
forall a s. FromCBOR a => Decoder s a
fromCBOR