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

-- | 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 qualified Cardano.Crypto.Hash as Hash
import qualified Cardano.Crypto.KES as KES
import Cardano.Crypto.Util
  ( SignableRepresentation (getSignableRepresentation)
  )
import qualified Cardano.Crypto.VRF as VRF
import Cardano.Ledger.BaseTypes (ProtVer (pvMajor))
import Cardano.Ledger.Binary
  ( Annotator (..)
  , DecCBOR (decCBOR)
  , EncCBOR (..)
  , ToCBOR (..)
  , encodedSigKESSizeExpr
  , serialize'
  , unCBORGroup
  )
import Cardano.Ledger.Binary.Coders
import Cardano.Ledger.Binary.Crypto
  ( decodeSignedKES
  , decodeVerKeyVRF
  , encodeSignedKES
  , encodeVerKeyVRF
  )
import qualified Cardano.Ledger.Binary.Plain as Plain
import Cardano.Ledger.Hashes
  ( EraIndependentBlockBody
  , EraIndependentBlockHeader
  , HASH
  , SafeToHash
  , originalBytesSize
  )
import Cardano.Ledger.Keys (KeyRole (BlockIssuer), VKey)
import Cardano.Ledger.MemoBytes
  ( Mem
  , MemoBytes
  , Memoized (..)
  , getMemoRawType
  , mkMemoized
  )
import Cardano.Protocol.Crypto (Crypto, KES, VRF)
import Cardano.Protocol.TPraos.BHeader (PrevHash)
import Cardano.Protocol.TPraos.OCert (OCert)
import Cardano.Slotting.Block (BlockNo)
import Cardano.Slotting.Slot (SlotNo)
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
  { forall crypto. HeaderBody crypto -> BlockNo
hbBlockNo :: !BlockNo
  -- ^ block number
  , forall crypto. HeaderBody crypto -> SlotNo
hbSlotNo :: !SlotNo
  -- ^ block slot
  , forall crypto. HeaderBody crypto -> PrevHash
hbPrev :: !PrevHash
  -- ^ Hash of the previous block header
  , forall crypto. HeaderBody crypto -> VKey 'BlockIssuer
hbVk :: !(VKey 'BlockIssuer)
  -- ^ verification key of block issuer
  , forall crypto. HeaderBody crypto -> VerKeyVRF (VRF crypto)
hbVrfVk :: !(VRF.VerKeyVRF (VRF crypto))
  -- ^ VRF verification key for block issuer
  , forall crypto.
HeaderBody crypto -> CertifiedVRF (VRF crypto) InputVRF
hbVrfRes :: !(VRF.CertifiedVRF (VRF crypto) InputVRF)
  -- ^ Certified VRF value
  , forall crypto. HeaderBody crypto -> Word32
hbBodySize :: !Word32
  -- ^ Size of the block body
  , forall crypto.
HeaderBody crypto -> Hash HASH EraIndependentBlockBody
hbBodyHash :: !(Hash.Hash HASH EraIndependentBlockBody)
  -- ^ Hash of block body
  , forall crypto. HeaderBody crypto -> OCert crypto
hbOCert :: !(OCert crypto)
  -- ^ operational certificate
  , forall crypto. HeaderBody crypto -> ProtVer
hbProtVer :: !ProtVer
  -- ^ protocol version
  }
  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
$cfrom :: forall crypto x. HeaderBody crypto -> Rep (HeaderBody crypto) x
from :: forall x. HeaderBody crypto -> Rep (HeaderBody crypto) x
$cto :: forall crypto x. Rep (HeaderBody crypto) x -> HeaderBody crypto
to :: forall x. Rep (HeaderBody crypto) x -> HeaderBody crypto
Generic

deriving instance Crypto crypto => Show (HeaderBody crypto)

deriving instance Crypto crypto => Eq (HeaderBody crypto)

instance
  Crypto crypto =>
  SignableRepresentation (HeaderBody crypto)
  where
  getSignableRepresentation :: HeaderBody crypto -> ByteString
getSignableRepresentation HeaderBody crypto
hb = Version -> HeaderBody crypto -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize' (ProtVer -> Version
pvMajor (HeaderBody crypto -> ProtVer
forall crypto. HeaderBody crypto -> ProtVer
hbProtVer HeaderBody crypto
hb)) HeaderBody crypto
hb

instance
  Crypto crypto =>
  NoThunks (HeaderBody crypto)

data HeaderRaw crypto = HeaderRaw
  { forall crypto. HeaderRaw crypto -> HeaderBody crypto
headerRawBody :: !(HeaderBody crypto)
  , forall crypto.
HeaderRaw crypto -> SignedKES (KES crypto) (HeaderBody crypto)
headerRawSig :: !(KES.SignedKES (KES 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
$cshowsPrec :: forall crypto. Crypto crypto => Int -> HeaderRaw crypto -> ShowS
showsPrec :: Int -> HeaderRaw crypto -> ShowS
$cshow :: forall crypto. Crypto crypto => HeaderRaw crypto -> String
show :: HeaderRaw crypto -> String
$cshowList :: forall crypto. Crypto crypto => [HeaderRaw crypto] -> ShowS
showList :: [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
$cfrom :: forall crypto x. HeaderRaw crypto -> Rep (HeaderRaw crypto) x
from :: forall x. HeaderRaw crypto -> Rep (HeaderRaw crypto) x
$cto :: forall crypto x. Rep (HeaderRaw crypto) x -> HeaderRaw crypto
to :: forall x. Rep (HeaderRaw crypto) x -> HeaderRaw crypto
Generic)

instance Crypto c => Eq (HeaderRaw c) where
  HeaderRaw c
h1 == :: HeaderRaw c -> HeaderRaw c -> Bool
== HeaderRaw c
h2 =
    HeaderRaw c -> SignedKES (KES c) (HeaderBody c)
forall crypto.
HeaderRaw crypto -> SignedKES (KES crypto) (HeaderBody crypto)
headerRawSig HeaderRaw c
h1 SignedKES (KES c) (HeaderBody c)
-> SignedKES (KES c) (HeaderBody c) -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderRaw c -> SignedKES (KES c) (HeaderBody c)
forall crypto.
HeaderRaw crypto -> SignedKES (KES crypto) (HeaderBody crypto)
headerRawSig HeaderRaw c
h2
      Bool -> Bool -> Bool
&& HeaderRaw c -> HeaderBody c
forall crypto. HeaderRaw crypto -> HeaderBody crypto
headerRawBody HeaderRaw c
h1 HeaderBody c -> HeaderBody c -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderRaw c -> HeaderBody c
forall crypto. HeaderRaw crypto -> HeaderBody crypto
headerRawBody HeaderRaw c
h2

instance
  Crypto crypto =>
  NoThunks (HeaderRaw crypto)

-- | Full header type, carrying its own memoised bytes.
newtype Header crypto = HeaderConstr (MemoBytes (HeaderRaw crypto))
  deriving (forall x. Header crypto -> Rep (Header crypto) x)
-> (forall x. Rep (Header crypto) x -> Header crypto)
-> Generic (Header crypto)
forall x. Rep (Header crypto) x -> Header crypto
forall x. Header crypto -> Rep (Header crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x. Rep (Header crypto) x -> Header crypto
forall crypto x. Header crypto -> Rep (Header crypto) x
$cfrom :: forall crypto x. Header crypto -> Rep (Header crypto) x
from :: forall x. Header crypto -> Rep (Header crypto) x
$cto :: forall crypto x. Rep (Header crypto) x -> Header crypto
to :: forall x. Rep (Header crypto) x -> Header crypto
Generic
  deriving newtype (Header crypto -> Header crypto -> Bool
(Header crypto -> Header crypto -> Bool)
-> (Header crypto -> Header crypto -> Bool) -> Eq (Header crypto)
forall crypto.
Crypto crypto =>
Header crypto -> Header crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall crypto.
Crypto crypto =>
Header crypto -> Header crypto -> Bool
== :: Header crypto -> Header crypto -> Bool
$c/= :: forall crypto.
Crypto crypto =>
Header crypto -> Header crypto -> Bool
/= :: 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
$cshowsPrec :: forall crypto. Crypto crypto => Int -> Header crypto -> ShowS
showsPrec :: Int -> Header crypto -> ShowS
$cshow :: forall crypto. Crypto crypto => Header crypto -> String
show :: Header crypto -> String
$cshowList :: forall crypto. Crypto crypto => [Header crypto] -> ShowS
showList :: [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
$cnoThunks :: forall crypto.
Crypto crypto =>
Context -> Header crypto -> IO (Maybe ThunkInfo)
noThunks :: Context -> Header crypto -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall crypto.
Crypto crypto =>
Context -> Header crypto -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> Header crypto -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall crypto. Crypto crypto => Proxy (Header crypto) -> String
showTypeOf :: Proxy (Header crypto) -> String
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
$ctoCBOR :: forall crypto. Typeable crypto => Header crypto -> Encoding
toCBOR :: Header crypto -> Encoding
$cencodedSizeExpr :: 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
$cencodedListSizeExpr :: 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
Plain.ToCBOR, Header crypto -> Int
Header crypto -> ByteString
(Header crypto -> ByteString)
-> (Header crypto -> Int)
-> (forall i. Proxy i -> Header crypto -> SafeHash i)
-> SafeToHash (Header crypto)
forall i. Proxy i -> Header crypto -> SafeHash i
forall crypto. Header crypto -> Int
forall crypto. Header crypto -> ByteString
forall t.
(t -> ByteString)
-> (t -> Int)
-> (forall i. Proxy i -> t -> SafeHash i)
-> SafeToHash t
forall crypto i. Proxy i -> Header crypto -> SafeHash i
$coriginalBytes :: forall crypto. Header crypto -> ByteString
originalBytes :: Header crypto -> ByteString
$coriginalBytesSize :: forall crypto. Header crypto -> Int
originalBytesSize :: Header crypto -> Int
$cmakeHashWithExplicitProxys :: forall crypto i. Proxy i -> Header crypto -> SafeHash i
makeHashWithExplicitProxys :: forall i. Proxy i -> Header crypto -> SafeHash i
SafeToHash)

instance Memoized (Header crypto) where
  type RawType (Header crypto) = HeaderRaw crypto

pattern Header ::
  Crypto crypto =>
  HeaderBody crypto ->
  KES.SignedKES (KES crypto) (HeaderBody crypto) ->
  Header crypto
pattern $mHeader :: forall {r} {crypto}.
Crypto crypto =>
Header crypto
-> (HeaderBody crypto
    -> SignedKES (KES crypto) (HeaderBody crypto) -> r)
-> ((# #) -> r)
-> r
$bHeader :: forall crypto.
Crypto crypto =>
HeaderBody crypto
-> SignedKES (KES crypto) (HeaderBody crypto) -> Header crypto
Header{forall crypto. Crypto crypto => Header crypto -> HeaderBody crypto
headerBody, forall crypto.
Crypto crypto =>
Header crypto -> SignedKES (KES crypto) (HeaderBody crypto)
headerSig} <- (getMemoRawType -> HeaderRaw headerBody headerSig)
  where
    Header HeaderBody crypto
body SignedKES (KES crypto) (HeaderBody crypto)
sig = Version -> RawType (Header crypto) -> Header crypto
forall t.
(EncCBOR (RawType t), Memoized t) =>
Version -> RawType t -> t
mkMemoized (ProtVer -> Version
pvMajor (HeaderBody crypto -> ProtVer
forall crypto. HeaderBody crypto -> ProtVer
hbProtVer HeaderBody crypto
body)) (RawType (Header crypto) -> Header crypto)
-> RawType (Header crypto) -> Header crypto
forall a b. (a -> b) -> a -> b
$ HeaderBody crypto
-> SignedKES (KES crypto) (HeaderBody crypto) -> HeaderRaw crypto
forall crypto.
HeaderBody crypto
-> SignedKES (KES crypto) (HeaderBody crypto) -> HeaderRaw crypto
HeaderRaw HeaderBody crypto
body SignedKES (KES crypto) (HeaderBody crypto)
sig
{-# COMPLETE Header #-}

-- | Compute the size of the header
headerSize :: Header crypto -> Int
headerSize :: forall crypto. Header crypto -> Int
headerSize = Header crypto -> Int
forall t. SafeToHash t => t -> Int
originalBytesSize

-- | Hash a header
headerHash ::
  Crypto crypto =>
  Header crypto ->
  Hash.Hash HASH EraIndependentBlockHeader
headerHash :: forall crypto.
Crypto crypto =>
Header crypto -> Hash HASH EraIndependentBlockHeader
headerHash = Hash HASH (Header crypto) -> Hash HASH EraIndependentBlockHeader
forall h a b. Hash h a -> Hash h b
Hash.castHash (Hash HASH (Header crypto) -> Hash HASH EraIndependentBlockHeader)
-> (Header crypto -> Hash HASH (Header crypto))
-> Header crypto
-> Hash HASH EraIndependentBlockHeader
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Header crypto -> Encoding)
-> Header crypto -> Hash HASH (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 Crypto crypto => EncCBOR (HeaderBody crypto) where
  encCBOR :: HeaderBody crypto -> Encoding
encCBOR
    HeaderBody
      { BlockNo
hbBlockNo :: forall crypto. HeaderBody crypto -> BlockNo
hbBlockNo :: BlockNo
hbBlockNo
      , SlotNo
hbSlotNo :: forall crypto. HeaderBody crypto -> SlotNo
hbSlotNo :: SlotNo
hbSlotNo
      , PrevHash
hbPrev :: forall crypto. HeaderBody crypto -> PrevHash
hbPrev :: PrevHash
hbPrev
      , VKey 'BlockIssuer
hbVk :: forall crypto. HeaderBody crypto -> VKey 'BlockIssuer
hbVk :: VKey 'BlockIssuer
hbVk
      , VerKeyVRF (VRF crypto)
hbVrfVk :: forall crypto. HeaderBody crypto -> VerKeyVRF (VRF crypto)
hbVrfVk :: VerKeyVRF (VRF crypto)
hbVrfVk
      , CertifiedVRF (VRF crypto) InputVRF
hbVrfRes :: forall crypto.
HeaderBody crypto -> CertifiedVRF (VRF crypto) InputVRF
hbVrfRes :: CertifiedVRF (VRF crypto) InputVRF
hbVrfRes
      , Word32
hbBodySize :: forall crypto. HeaderBody crypto -> Word32
hbBodySize :: Word32
hbBodySize
      , Hash HASH EraIndependentBlockBody
hbBodyHash :: forall crypto.
HeaderBody crypto -> Hash HASH EraIndependentBlockBody
hbBodyHash :: Hash HASH EraIndependentBlockBody
hbBodyHash
      , OCert crypto
hbOCert :: forall crypto. HeaderBody crypto -> OCert crypto
hbOCert :: OCert crypto
hbOCert
      , ProtVer
hbProtVer :: forall crypto. HeaderBody crypto -> ProtVer
hbProtVer :: 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
 -> VKey 'BlockIssuer
 -> VerKeyVRF (VRF crypto)
 -> CertifiedVRF (VRF crypto) InputVRF
 -> Word32
 -> Hash HASH EraIndependentBlockBody
 -> OCert crypto
 -> ProtVer
 -> HeaderBody crypto)
-> Encode
     ('Closed 'Dense)
     (BlockNo
      -> SlotNo
      -> PrevHash
      -> VKey 'BlockIssuer
      -> VerKeyVRF (VRF crypto)
      -> CertifiedVRF (VRF crypto) InputVRF
      -> Word32
      -> Hash HASH EraIndependentBlockBody
      -> OCert crypto
      -> ProtVer
      -> HeaderBody crypto)
forall t. t -> Encode ('Closed 'Dense) t
Rec BlockNo
-> SlotNo
-> PrevHash
-> VKey 'BlockIssuer
-> VerKeyVRF (VRF crypto)
-> CertifiedVRF (VRF crypto) InputVRF
-> Word32
-> Hash HASH EraIndependentBlockBody
-> OCert crypto
-> ProtVer
-> HeaderBody crypto
forall crypto.
BlockNo
-> SlotNo
-> PrevHash
-> VKey 'BlockIssuer
-> VerKeyVRF (VRF crypto)
-> CertifiedVRF (VRF crypto) InputVRF
-> Word32
-> Hash HASH EraIndependentBlockBody
-> OCert crypto
-> ProtVer
-> HeaderBody crypto
HeaderBody
          Encode
  ('Closed 'Dense)
  (BlockNo
   -> SlotNo
   -> PrevHash
   -> VKey 'BlockIssuer
   -> VerKeyVRF (VRF crypto)
   -> CertifiedVRF (VRF crypto) InputVRF
   -> Word32
   -> Hash HASH EraIndependentBlockBody
   -> OCert crypto
   -> ProtVer
   -> HeaderBody crypto)
-> Encode ('Closed 'Dense) BlockNo
-> Encode
     ('Closed 'Dense)
     (SlotNo
      -> PrevHash
      -> VKey 'BlockIssuer
      -> VerKeyVRF (VRF crypto)
      -> CertifiedVRF (VRF crypto) InputVRF
      -> Word32
      -> Hash HASH 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. EncCBOR t => t -> Encode ('Closed 'Dense) t
To BlockNo
hbBlockNo
          Encode
  ('Closed 'Dense)
  (SlotNo
   -> PrevHash
   -> VKey 'BlockIssuer
   -> VerKeyVRF (VRF crypto)
   -> CertifiedVRF (VRF crypto) InputVRF
   -> Word32
   -> Hash HASH EraIndependentBlockBody
   -> OCert crypto
   -> ProtVer
   -> HeaderBody crypto)
-> Encode ('Closed 'Dense) SlotNo
-> Encode
     ('Closed 'Dense)
     (PrevHash
      -> VKey 'BlockIssuer
      -> VerKeyVRF (VRF crypto)
      -> CertifiedVRF (VRF crypto) InputVRF
      -> Word32
      -> Hash HASH 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. EncCBOR t => t -> Encode ('Closed 'Dense) t
To SlotNo
hbSlotNo
          Encode
  ('Closed 'Dense)
  (PrevHash
   -> VKey 'BlockIssuer
   -> VerKeyVRF (VRF crypto)
   -> CertifiedVRF (VRF crypto) InputVRF
   -> Word32
   -> Hash HASH EraIndependentBlockBody
   -> OCert crypto
   -> ProtVer
   -> HeaderBody crypto)
-> Encode ('Closed 'Dense) PrevHash
-> Encode
     ('Closed 'Dense)
     (VKey 'BlockIssuer
      -> VerKeyVRF (VRF crypto)
      -> CertifiedVRF (VRF crypto) InputVRF
      -> Word32
      -> Hash HASH 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 -> Encode ('Closed 'Dense) PrevHash
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To PrevHash
hbPrev
          Encode
  ('Closed 'Dense)
  (VKey 'BlockIssuer
   -> VerKeyVRF (VRF crypto)
   -> CertifiedVRF (VRF crypto) InputVRF
   -> Word32
   -> Hash HASH EraIndependentBlockBody
   -> OCert crypto
   -> ProtVer
   -> HeaderBody crypto)
-> Encode ('Closed 'Dense) (VKey 'BlockIssuer)
-> Encode
     ('Closed 'Dense)
     (VerKeyVRF (VRF crypto)
      -> CertifiedVRF (VRF crypto) InputVRF
      -> Word32
      -> Hash HASH 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 -> Encode ('Closed 'Dense) (VKey 'BlockIssuer)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To VKey 'BlockIssuer
hbVk
          Encode
  ('Closed 'Dense)
  (VerKeyVRF (VRF crypto)
   -> CertifiedVRF (VRF crypto) InputVRF
   -> Word32
   -> Hash HASH EraIndependentBlockBody
   -> OCert crypto
   -> ProtVer
   -> HeaderBody crypto)
-> Encode ('Closed 'Dense) (VerKeyVRF (VRF crypto))
-> Encode
     ('Closed 'Dense)
     (CertifiedVRF (VRF crypto) InputVRF
      -> Word32
      -> Hash HASH 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 (VRF crypto) -> Encoding)
-> VerKeyVRF (VRF crypto)
-> Encode ('Closed 'Dense) (VerKeyVRF (VRF crypto))
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E VerKeyVRF (VRF crypto) -> Encoding
forall v. VRFAlgorithm v => VerKeyVRF v -> Encoding
encodeVerKeyVRF VerKeyVRF (VRF crypto)
hbVrfVk
          Encode
  ('Closed 'Dense)
  (CertifiedVRF (VRF crypto) InputVRF
   -> Word32
   -> Hash HASH EraIndependentBlockBody
   -> OCert crypto
   -> ProtVer
   -> HeaderBody crypto)
-> Encode ('Closed 'Dense) (CertifiedVRF (VRF crypto) InputVRF)
-> Encode
     ('Closed 'Dense)
     (Word32
      -> Hash HASH 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 (VRF crypto) InputVRF
-> Encode ('Closed 'Dense) (CertifiedVRF (VRF crypto) InputVRF)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To CertifiedVRF (VRF crypto) InputVRF
hbVrfRes
          Encode
  ('Closed 'Dense)
  (Word32
   -> Hash HASH EraIndependentBlockBody
   -> OCert crypto
   -> ProtVer
   -> HeaderBody crypto)
-> Encode ('Closed 'Dense) Word32
-> Encode
     ('Closed 'Dense)
     (Hash HASH 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. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Word32
hbBodySize
          Encode
  ('Closed 'Dense)
  (Hash HASH EraIndependentBlockBody
   -> OCert crypto -> ProtVer -> HeaderBody crypto)
-> Encode ('Closed 'Dense) (Hash HASH 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 HASH EraIndependentBlockBody
-> Encode ('Closed 'Dense) (Hash HASH EraIndependentBlockBody)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Hash HASH 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. EncCBOR 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. EncCBOR t => t -> Encode ('Closed 'Dense) t
To ProtVer
hbProtVer

instance Crypto crypto => DecCBOR (HeaderBody crypto) where
  decCBOR :: forall s. Decoder s (HeaderBody crypto)
decCBOR =
    Decode ('Closed 'Dense) (HeaderBody crypto)
-> Decoder s (HeaderBody crypto)
forall t (w :: Wrapped) s. Typeable t => 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
 -> VKey 'BlockIssuer
 -> VerKeyVRF (VRF crypto)
 -> CertifiedVRF (VRF crypto) InputVRF
 -> Word32
 -> Hash HASH EraIndependentBlockBody
 -> OCert crypto
 -> ProtVer
 -> HeaderBody crypto)
-> Decode
     ('Closed 'Dense)
     (BlockNo
      -> SlotNo
      -> PrevHash
      -> VKey 'BlockIssuer
      -> VerKeyVRF (VRF crypto)
      -> CertifiedVRF (VRF crypto) InputVRF
      -> Word32
      -> Hash HASH EraIndependentBlockBody
      -> OCert crypto
      -> ProtVer
      -> HeaderBody crypto)
forall t. t -> Decode ('Closed 'Dense) t
RecD BlockNo
-> SlotNo
-> PrevHash
-> VKey 'BlockIssuer
-> VerKeyVRF (VRF crypto)
-> CertifiedVRF (VRF crypto) InputVRF
-> Word32
-> Hash HASH EraIndependentBlockBody
-> OCert crypto
-> ProtVer
-> HeaderBody crypto
forall crypto.
BlockNo
-> SlotNo
-> PrevHash
-> VKey 'BlockIssuer
-> VerKeyVRF (VRF crypto)
-> CertifiedVRF (VRF crypto) InputVRF
-> Word32
-> Hash HASH EraIndependentBlockBody
-> OCert crypto
-> ProtVer
-> HeaderBody crypto
HeaderBody
        Decode
  ('Closed 'Dense)
  (BlockNo
   -> SlotNo
   -> PrevHash
   -> VKey 'BlockIssuer
   -> VerKeyVRF (VRF crypto)
   -> CertifiedVRF (VRF crypto) InputVRF
   -> Word32
   -> Hash HASH EraIndependentBlockBody
   -> OCert crypto
   -> ProtVer
   -> HeaderBody crypto)
-> Decode ('Closed (ZonkAny 9)) BlockNo
-> Decode
     ('Closed 'Dense)
     (SlotNo
      -> PrevHash
      -> VKey 'BlockIssuer
      -> VerKeyVRF (VRF crypto)
      -> CertifiedVRF (VRF crypto) InputVRF
      -> Word32
      -> Hash HASH EraIndependentBlockBody
      -> OCert crypto
      -> ProtVer
      -> HeaderBody crypto)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed (ZonkAny 9)) BlockNo
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (SlotNo
   -> PrevHash
   -> VKey 'BlockIssuer
   -> VerKeyVRF (VRF crypto)
   -> CertifiedVRF (VRF crypto) InputVRF
   -> Word32
   -> Hash HASH EraIndependentBlockBody
   -> OCert crypto
   -> ProtVer
   -> HeaderBody crypto)
-> Decode ('Closed (ZonkAny 8)) SlotNo
-> Decode
     ('Closed 'Dense)
     (PrevHash
      -> VKey 'BlockIssuer
      -> VerKeyVRF (VRF crypto)
      -> CertifiedVRF (VRF crypto) InputVRF
      -> Word32
      -> Hash HASH EraIndependentBlockBody
      -> OCert crypto
      -> ProtVer
      -> HeaderBody crypto)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed (ZonkAny 8)) SlotNo
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (PrevHash
   -> VKey 'BlockIssuer
   -> VerKeyVRF (VRF crypto)
   -> CertifiedVRF (VRF crypto) InputVRF
   -> Word32
   -> Hash HASH EraIndependentBlockBody
   -> OCert crypto
   -> ProtVer
   -> HeaderBody crypto)
-> Decode ('Closed (ZonkAny 7)) PrevHash
-> Decode
     ('Closed 'Dense)
     (VKey 'BlockIssuer
      -> VerKeyVRF (VRF crypto)
      -> CertifiedVRF (VRF crypto) InputVRF
      -> Word32
      -> Hash HASH EraIndependentBlockBody
      -> OCert crypto
      -> ProtVer
      -> HeaderBody crypto)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed (ZonkAny 7)) PrevHash
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (VKey 'BlockIssuer
   -> VerKeyVRF (VRF crypto)
   -> CertifiedVRF (VRF crypto) InputVRF
   -> Word32
   -> Hash HASH EraIndependentBlockBody
   -> OCert crypto
   -> ProtVer
   -> HeaderBody crypto)
-> Decode ('Closed (ZonkAny 6)) (VKey 'BlockIssuer)
-> Decode
     ('Closed 'Dense)
     (VerKeyVRF (VRF crypto)
      -> CertifiedVRF (VRF crypto) InputVRF
      -> Word32
      -> Hash HASH EraIndependentBlockBody
      -> OCert crypto
      -> ProtVer
      -> HeaderBody crypto)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed (ZonkAny 6)) (VKey 'BlockIssuer)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (VerKeyVRF (VRF crypto)
   -> CertifiedVRF (VRF crypto) InputVRF
   -> Word32
   -> Hash HASH EraIndependentBlockBody
   -> OCert crypto
   -> ProtVer
   -> HeaderBody crypto)
-> Decode ('Closed 'Dense) (VerKeyVRF (VRF crypto))
-> Decode
     ('Closed 'Dense)
     (CertifiedVRF (VRF crypto) InputVRF
      -> Word32
      -> Hash HASH EraIndependentBlockBody
      -> OCert crypto
      -> ProtVer
      -> HeaderBody crypto)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
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 Decoder s (VerKeyVRF (VRF crypto))
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 EraIndependentBlockBody
   -> OCert crypto
   -> ProtVer
   -> HeaderBody crypto)
-> Decode
     ('Closed (ZonkAny 5)) (CertifiedVRF (VRF crypto) InputVRF)
-> Decode
     ('Closed 'Dense)
     (Word32
      -> Hash HASH EraIndependentBlockBody
      -> OCert crypto
      -> ProtVer
      -> HeaderBody crypto)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed (ZonkAny 5)) (CertifiedVRF (VRF crypto) InputVRF)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (Word32
   -> Hash HASH EraIndependentBlockBody
   -> OCert crypto
   -> ProtVer
   -> HeaderBody crypto)
-> Decode ('Closed (ZonkAny 4)) Word32
-> Decode
     ('Closed 'Dense)
     (Hash HASH EraIndependentBlockBody
      -> OCert crypto -> ProtVer -> HeaderBody crypto)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed (ZonkAny 4)) Word32
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (Hash HASH EraIndependentBlockBody
   -> OCert crypto -> ProtVer -> HeaderBody crypto)
-> Decode ('Closed (ZonkAny 3)) (Hash HASH EraIndependentBlockBody)
-> Decode
     ('Closed 'Dense) (OCert crypto -> ProtVer -> HeaderBody crypto)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed (ZonkAny 3)) (Hash HASH EraIndependentBlockBody)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense) (OCert crypto -> ProtVer -> HeaderBody crypto)
-> Decode ('Closed (ZonkAny 2)) (OCert crypto)
-> Decode ('Closed 'Dense) (ProtVer -> HeaderBody crypto)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! (CBORGroup (OCert crypto) -> OCert crypto)
-> Decode ('Closed (ZonkAny 2)) (CBORGroup (OCert crypto))
-> Decode ('Closed (ZonkAny 2)) (OCert crypto)
forall a b (w :: Wrapped).
Typeable a =>
(a -> b) -> Decode w a -> Decode w b
mapCoder CBORGroup (OCert crypto) -> OCert crypto
forall a. CBORGroup a -> a
unCBORGroup Decode ('Closed (ZonkAny 2)) (CBORGroup (OCert crypto))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode ('Closed 'Dense) (ProtVer -> HeaderBody crypto)
-> Decode ('Closed (ZonkAny 1)) ProtVer
-> Decode ('Closed 'Dense) (HeaderBody crypto)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed (ZonkAny 1)) ProtVer
forall t (w :: Wrapped). DecCBOR t => Decode w t
From

encodeHeaderRaw ::
  Crypto crypto =>
  HeaderRaw crypto ->
  Encode ('Closed 'Dense) (HeaderRaw crypto)
encodeHeaderRaw :: forall crypto.
Crypto crypto =>
HeaderRaw crypto -> Encode ('Closed 'Dense) (HeaderRaw crypto)
encodeHeaderRaw (HeaderRaw HeaderBody crypto
body SignedKES (KES crypto) (HeaderBody crypto)
sig) =
  (HeaderBody crypto
 -> SignedKES (KES crypto) (HeaderBody crypto) -> HeaderRaw crypto)
-> Encode
     ('Closed 'Dense)
     (HeaderBody crypto
      -> SignedKES (KES crypto) (HeaderBody crypto) -> HeaderRaw crypto)
forall t. t -> Encode ('Closed 'Dense) t
Rec HeaderBody crypto
-> SignedKES (KES crypto) (HeaderBody crypto) -> HeaderRaw crypto
forall crypto.
HeaderBody crypto
-> SignedKES (KES crypto) (HeaderBody crypto) -> HeaderRaw crypto
HeaderRaw Encode
  ('Closed 'Dense)
  (HeaderBody crypto
   -> SignedKES (KES crypto) (HeaderBody crypto) -> HeaderRaw crypto)
-> Encode ('Closed 'Dense) (HeaderBody crypto)
-> Encode
     ('Closed 'Dense)
     (SignedKES (KES 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. EncCBOR t => t -> Encode ('Closed 'Dense) t
To HeaderBody crypto
body Encode
  ('Closed 'Dense)
  (SignedKES (KES crypto) (HeaderBody crypto) -> HeaderRaw crypto)
-> Encode
     ('Closed 'Dense) (SignedKES (KES 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 (KES crypto) (HeaderBody crypto) -> Encoding)
-> SignedKES (KES crypto) (HeaderBody crypto)
-> Encode
     ('Closed 'Dense) (SignedKES (KES crypto) (HeaderBody crypto))
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E SignedKES (KES crypto) (HeaderBody crypto) -> Encoding
forall v a. KESAlgorithm v => SignedKES v a -> Encoding
encodeSignedKES SignedKES (KES crypto) (HeaderBody crypto)
sig

instance Crypto crypto => EncCBOR (HeaderRaw crypto) where
  encCBOR :: HeaderRaw crypto -> Encoding
encCBOR = 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 Crypto crypto => DecCBOR (HeaderRaw crypto) where
  decCBOR :: forall s. Decoder s (HeaderRaw crypto)
decCBOR = Decode ('Closed 'Dense) (HeaderRaw crypto)
-> Decoder s (HeaderRaw crypto)
forall t (w :: Wrapped) s. Typeable t => 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 (KES crypto) (HeaderBody crypto) -> HeaderRaw crypto
HeaderRaw Decode
  ('Closed 'Dense)
  (HeaderBody crypto
   -> SignedKES (KES crypto) (HeaderBody crypto) -> HeaderRaw crypto)
-> Decode ('Closed (ZonkAny 0)) (HeaderBody crypto)
-> Decode
     ('Closed 'Dense)
     (SignedKES (KES crypto) (HeaderBody crypto) -> HeaderRaw crypto)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed (ZonkAny 0)) (HeaderBody crypto)
forall t (w :: Wrapped). DecCBOR 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 a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
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 Decoder s (SignedKES (KES crypto) (HeaderBody crypto))
forall s. Decoder s (SignedKES (KES crypto) (HeaderBody crypto))
forall v s a. KESAlgorithm v => Decoder s (SignedKES v a)
decodeSignedKES

instance Crypto crypto => DecCBOR (Annotator (HeaderRaw crypto)) where
  decCBOR :: forall s. Decoder s (Annotator (HeaderRaw crypto))
decCBOR = HeaderRaw crypto -> Annotator (HeaderRaw crypto)
forall a. a -> Annotator a
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 s. Decoder s (HeaderRaw crypto)
forall a s. DecCBOR a => Decoder s a
decCBOR

instance Crypto c => EncCBOR (Header c) where
  encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (Header c) -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
size Proxy (Header c)
proxy =
    Size
1
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (HeaderBody c) -> Size
forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr Proxy t -> Size
forall t. EncCBOR t => Proxy t -> Size
size (Header c -> HeaderBody c
forall crypto. Crypto crypto => Header crypto -> HeaderBody crypto
headerBody (Header c -> HeaderBody c)
-> Proxy (Header c) -> Proxy (HeaderBody c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (Header c)
proxy)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Proxy (SigKES (KES c)) -> Size
forall v. KESAlgorithm v => Proxy (SigKES v) -> Size
encodedSigKESSizeExpr (SignedKES (KES c) (HeaderBody c) -> SigKES (KES c)
forall v a. SignedKES v a -> SigKES v
KES.getSig (SignedKES (KES c) (HeaderBody c) -> SigKES (KES c))
-> (Header c -> SignedKES (KES c) (HeaderBody c))
-> Header c
-> SigKES (KES c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header c -> SignedKES (KES c) (HeaderBody c)
forall crypto.
Crypto crypto =>
Header crypto -> SignedKES (KES crypto) (HeaderBody crypto)
headerSig (Header c -> SigKES (KES c))
-> Proxy (Header c) -> Proxy (SigKES (KES c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (Header c)
proxy)

deriving via
  Mem (HeaderRaw crypto)
  instance
    Crypto crypto => DecCBOR (Annotator (Header crypto))