{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module Cardano.Chain.Block.Header (
  -- * Header
  Header,
  AHeader (..),

  -- * Header Constructors
  mkHeader,
  mkHeaderExplicit,

  -- * Header Accessors
  headerProtocolMagicId,
  headerPrevHash,
  headerProof,
  headerSlot,
  headerIssuer,
  headerLength,
  headerDifficulty,
  headerToSign,

  -- * Header Binary Serialization
  encCBORHeader,
  encCBORHeaderSize,
  encCBORHeaderToHash,
  decCBORAHeader,
  decCBORHeader,
  decCBORHeaderToHash,
  wrapHeaderBytes,
  encCBORBlockVersions,
  encCBORBlockVersionsSize,

  -- * Header Formatting
  renderHeader,

  -- * Boundary Header
  ABoundaryHeader (..),
  mkABoundaryHeader,
  encCBORABoundaryHeader,
  encCBORABoundaryHeaderSize,
  decCBORABoundaryHeader,
  boundaryHeaderHashAnnotated,
  wrapBoundaryBytes,

  -- * HeaderHash
  HeaderHash,
  headerHashF,
  hashHeader,
  headerHashAnnotated,
  genesisHeaderHash,

  -- * BlockSignature
  BlockSignature,
  ABlockSignature (..),

  -- * ToSign
  ToSign (..),
  recoverSignedBytes,
)
where

import Cardano.Chain.Block.Body (Body)
import Cardano.Chain.Block.Boundary (
  decCBORBoundaryConsensusData,
  dropBoundaryExtraHeaderDataRetainGenesisTag,
 )
import Cardano.Chain.Block.Proof (Proof (..), mkProof)
import Cardano.Chain.Common (ChainDifficulty (..), dropEmptyAttributes)
import qualified Cardano.Chain.Delegation.Certificate as Delegation
import Cardano.Chain.Genesis.Hash (GenesisHash (..))
import Cardano.Chain.Slotting (
  EpochAndSlotCount (..),
  EpochSlots,
  SlotNumber (..),
  WithEpochSlots (WithEpochSlots),
  fromSlotNumber,
  toSlotNumber,
 )
import Cardano.Chain.Update.ProtocolVersion (ProtocolVersion)
import Cardano.Chain.Update.SoftwareVersion (SoftwareVersion)
import Cardano.Crypto (
  Hash,
  ProtocolMagicId (..),
  SignTag (..),
  Signature,
  SigningKey,
  VerificationKey,
  hashDecoded,
  hashHexF,
  hashRaw,
  serializeCborHash,
  sign,
  unsafeAbstractHash,
 )
import Cardano.Crypto.Raw (Raw)
import Cardano.Ledger.Binary (
  Annotated (..),
  ByteSpan,
  Case (..),
  DecCBOR (..),
  Decoded (..),
  Decoder,
  DecoderError (..),
  EncCBOR (..),
  Encoding,
  FromCBOR (..),
  Size,
  ToCBOR (..),
  annotatedDecoder,
  byronProtVer,
  cborError,
  decCBORAnnotated,
  dropBytes,
  dropInt32,
  encodeListLen,
  enforceSize,
  fromByronCBOR,
  serialize,
  szCases,
  szGreedy,
  toByronCBOR,
 )
import Cardano.Prelude hiding (cborError)
import Data.Aeson (ToJSON)
import qualified Data.ByteString as BS
import Data.Coerce (coerce)
import qualified Data.Map.Strict as Map (singleton)
import Data.Text.Lazy.Builder (Builder)
import Formatting (Format, bprint, build, int)
import qualified Formatting.Buildable as B
import NoThunks.Class (NoThunks (..))

--------------------------------------------------------------------------------
-- Header
--------------------------------------------------------------------------------

type Header = AHeader ()

data AHeader a = AHeader
  { forall a. AHeader a -> Annotated ProtocolMagicId a
aHeaderProtocolMagicId :: !(Annotated ProtocolMagicId a)
  , forall a. AHeader a -> Annotated HeaderHash a
aHeaderPrevHash :: !(Annotated HeaderHash a)
  -- ^ Pointer to the header of the previous block
  , forall a. AHeader a -> Annotated SlotNumber a
aHeaderSlot :: !(Annotated SlotNumber a)
  -- ^ The slot number this block was published for
  , forall a. AHeader a -> Annotated ChainDifficulty a
aHeaderDifficulty :: !(Annotated ChainDifficulty a)
  -- ^ The chain difficulty up to this block
  , forall a. AHeader a -> ProtocolVersion
headerProtocolVersion :: !ProtocolVersion
  -- ^ The version of the protocol parameters this block is using
  , forall a. AHeader a -> SoftwareVersion
headerSoftwareVersion :: !SoftwareVersion
  -- ^ The software version this block was published from
  , forall a. AHeader a -> Annotated Proof a
aHeaderProof :: !(Annotated Proof a)
  -- ^ Proof of body
  , forall a. AHeader a -> VerificationKey
headerGenesisKey :: !VerificationKey
  -- ^ The genesis key that is delegating to publish this block
  , forall a. AHeader a -> ABlockSignature a
headerSignature :: !(ABlockSignature a)
  -- ^ The signature of the block, which contains the delegation certificate
  , forall a. AHeader a -> a
headerAnnotation :: !a
  -- ^ An annotation that captures the full header bytes
  , forall a. AHeader a -> a
headerExtraAnnotation :: !a
  -- ^ An annotation that captures the bytes from the deprecated ExtraHeaderData
  }
  deriving (AHeader a -> AHeader a -> Bool
forall a. Eq a => AHeader a -> AHeader a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AHeader a -> AHeader a -> Bool
$c/= :: forall a. Eq a => AHeader a -> AHeader a -> Bool
== :: AHeader a -> AHeader a -> Bool
$c== :: forall a. Eq a => AHeader a -> AHeader a -> Bool
Eq, Int -> AHeader a -> ShowS
forall a. Show a => Int -> AHeader a -> ShowS
forall a. Show a => [AHeader a] -> ShowS
forall a. Show a => AHeader a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AHeader a] -> ShowS
$cshowList :: forall a. Show a => [AHeader a] -> ShowS
show :: AHeader a -> String
$cshow :: forall a. Show a => AHeader a -> String
showsPrec :: Int -> AHeader a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> AHeader a -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (AHeader a) x -> AHeader a
forall a x. AHeader a -> Rep (AHeader a) x
$cto :: forall a x. Rep (AHeader a) x -> AHeader a
$cfrom :: forall a x. AHeader a -> Rep (AHeader a) x
Generic, forall a. NFData a => AHeader a -> ()
forall a. (a -> ()) -> NFData a
rnf :: AHeader a -> ()
$crnf :: forall a. NFData a => AHeader a -> ()
NFData, forall a b. a -> AHeader b -> AHeader a
forall a b. (a -> b) -> AHeader a -> AHeader b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> AHeader b -> AHeader a
$c<$ :: forall a b. a -> AHeader b -> AHeader a
fmap :: forall a b. (a -> b) -> AHeader a -> AHeader b
$cfmap :: forall a b. (a -> b) -> AHeader a -> AHeader b
Functor, forall a.
NoThunks a =>
Context -> AHeader a -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Proxy (AHeader a) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (AHeader a) -> String
$cshowTypeOf :: forall a. NoThunks a => Proxy (AHeader a) -> String
wNoThunks :: Context -> AHeader a -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall a.
NoThunks a =>
Context -> AHeader a -> IO (Maybe ThunkInfo)
noThunks :: Context -> AHeader a -> IO (Maybe ThunkInfo)
$cnoThunks :: forall a.
NoThunks a =>
Context -> AHeader a -> IO (Maybe ThunkInfo)
NoThunks)

-- Used for debugging purposes only
instance ToJSON a => ToJSON (AHeader a)

--------------------------------------------------------------------------------
-- Header Constructors
--------------------------------------------------------------------------------

-- | Smart constructor for 'Header'
mkHeader ::
  ProtocolMagicId ->
  Either GenesisHash Header ->
  -- | Number of slots per epoch. This is needed to convert the slot number to
  -- the legacy format used in 'ToSign', where a slot is identified by the
  -- epoch to which it belongs and the offset within that epoch (counted in
  -- number of slots).
  EpochSlots ->
  SlotNumber ->
  -- | The 'SigningKey' used for signing the block
  SigningKey ->
  -- | A certificate of delegation from a genesis key to the 'SigningKey'
  Delegation.Certificate ->
  Body ->
  ProtocolVersion ->
  SoftwareVersion ->
  Header
mkHeader :: ProtocolMagicId
-> Either GenesisHash (AHeader ())
-> EpochSlots
-> SlotNumber
-> SigningKey
-> Certificate
-> Body
-> ProtocolVersion
-> SoftwareVersion
-> AHeader ()
mkHeader ProtocolMagicId
pm Either GenesisHash (AHeader ())
prevHeader EpochSlots
epochSlots =
  ProtocolMagicId
-> HeaderHash
-> ChainDifficulty
-> EpochSlots
-> SlotNumber
-> SigningKey
-> Certificate
-> Body
-> ProtocolVersion
-> SoftwareVersion
-> AHeader ()
mkHeaderExplicit
    ProtocolMagicId
pm
    HeaderHash
prevHash
    ChainDifficulty
difficulty
    EpochSlots
epochSlots
  where
    prevHash :: HeaderHash
prevHash = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either GenesisHash -> HeaderHash
genesisHeaderHash (EpochSlots -> AHeader () -> HeaderHash
hashHeader EpochSlots
epochSlots) Either GenesisHash (AHeader ())
prevHeader
    difficulty :: ChainDifficulty
difficulty =
      forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
        (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ Word64 -> ChainDifficulty
ChainDifficulty Word64
0)
        (forall a. Enum a => a -> a
succ forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. AHeader a -> ChainDifficulty
headerDifficulty)
        Either GenesisHash (AHeader ())
prevHeader

-- | Make a 'Header' for a given slot, with a given body, parent hash,
--   and difficulty. This takes care of some signing and consensus data.
mkHeaderExplicit ::
  ProtocolMagicId ->
  -- | Parent
  HeaderHash ->
  ChainDifficulty ->
  -- | See 'mkHeader'.
  EpochSlots ->
  SlotNumber ->
  -- | The 'SigningKey' used for signing the block
  SigningKey ->
  -- | A certificate of delegation from a genesis key to the 'SigningKey'
  Delegation.Certificate ->
  Body ->
  ProtocolVersion ->
  SoftwareVersion ->
  Header
mkHeaderExplicit :: ProtocolMagicId
-> HeaderHash
-> ChainDifficulty
-> EpochSlots
-> SlotNumber
-> SigningKey
-> Certificate
-> Body
-> ProtocolVersion
-> SoftwareVersion
-> AHeader ()
mkHeaderExplicit ProtocolMagicId
pm HeaderHash
prevHash ChainDifficulty
difficulty EpochSlots
epochSlots SlotNumber
slotNumber SigningKey
sk Certificate
dlgCert Body
body ProtocolVersion
pv SoftwareVersion
sv =
  forall a.
Annotated ProtocolMagicId a
-> Annotated HeaderHash a
-> Annotated SlotNumber a
-> Annotated ChainDifficulty a
-> ProtocolVersion
-> SoftwareVersion
-> Annotated Proof a
-> VerificationKey
-> ABlockSignature a
-> a
-> a
-> AHeader a
AHeader
    (forall b a. b -> a -> Annotated b a
Annotated ProtocolMagicId
pm ())
    (forall b a. b -> a -> Annotated b a
Annotated HeaderHash
prevHash ())
    (forall b a. b -> a -> Annotated b a
Annotated SlotNumber
slotNumber ())
    (forall b a. b -> a -> Annotated b a
Annotated ChainDifficulty
difficulty ())
    ProtocolVersion
pv
    SoftwareVersion
sv
    (forall b a. b -> a -> Annotated b a
Annotated Proof
proof ())
    VerificationKey
genesisVK
    BlockSignature
sig
    ()
    ()
  where
    proof :: Proof
proof = Body -> Proof
mkProof Body
body

    genesisVK :: VerificationKey
genesisVK = forall a. ACertificate a -> VerificationKey
Delegation.issuerVK Certificate
dlgCert

    sig :: BlockSignature
sig = forall a. ACertificate a -> Signature ToSign -> ABlockSignature a
ABlockSignature Certificate
dlgCert forall a b. (a -> b) -> a -> b
$ forall a.
EncCBOR a =>
ProtocolMagicId -> SignTag -> SigningKey -> a -> Signature a
sign ProtocolMagicId
pm (VerificationKey -> SignTag
SignBlock VerificationKey
genesisVK) SigningKey
sk ToSign
toSign

    toSign :: ToSign
toSign = HeaderHash
-> Proof
-> EpochAndSlotCount
-> ChainDifficulty
-> ProtocolVersion
-> SoftwareVersion
-> ToSign
ToSign HeaderHash
prevHash Proof
proof EpochAndSlotCount
epochAndSlotCount ChainDifficulty
difficulty ProtocolVersion
pv SoftwareVersion
sv

    epochAndSlotCount :: EpochAndSlotCount
epochAndSlotCount = EpochSlots -> SlotNumber -> EpochAndSlotCount
fromSlotNumber EpochSlots
epochSlots SlotNumber
slotNumber

--------------------------------------------------------------------------------
-- Header Accessors
--------------------------------------------------------------------------------

headerProtocolMagicId :: AHeader a -> ProtocolMagicId
headerProtocolMagicId :: forall a. AHeader a -> ProtocolMagicId
headerProtocolMagicId = forall b a. Annotated b a -> b
unAnnotated forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. AHeader a -> Annotated ProtocolMagicId a
aHeaderProtocolMagicId

headerPrevHash :: AHeader a -> HeaderHash
headerPrevHash :: forall a. AHeader a -> HeaderHash
headerPrevHash = forall b a. Annotated b a -> b
unAnnotated forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. AHeader a -> Annotated HeaderHash a
aHeaderPrevHash

headerSlot :: AHeader a -> SlotNumber
headerSlot :: forall a. AHeader a -> SlotNumber
headerSlot = forall b a. Annotated b a -> b
unAnnotated forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. AHeader a -> Annotated SlotNumber a
aHeaderSlot

headerDifficulty :: AHeader a -> ChainDifficulty
headerDifficulty :: forall a. AHeader a -> ChainDifficulty
headerDifficulty = forall b a. Annotated b a -> b
unAnnotated forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. AHeader a -> Annotated ChainDifficulty a
aHeaderDifficulty

headerProof :: AHeader a -> Proof
headerProof :: forall a. AHeader a -> Proof
headerProof = forall b a. Annotated b a -> b
unAnnotated forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. AHeader a -> Annotated Proof a
aHeaderProof

headerIssuer :: AHeader a -> VerificationKey
headerIssuer :: forall a. AHeader a -> VerificationKey
headerIssuer AHeader a
h = case forall a. AHeader a -> ABlockSignature a
headerSignature AHeader a
h of
  ABlockSignature ACertificate a
cert Signature ToSign
_ -> forall a. ACertificate a -> VerificationKey
Delegation.delegateVK ACertificate a
cert

headerToSign :: EpochSlots -> AHeader a -> ToSign
headerToSign :: forall a. EpochSlots -> AHeader a -> ToSign
headerToSign EpochSlots
epochSlots AHeader a
h =
  HeaderHash
-> Proof
-> EpochAndSlotCount
-> ChainDifficulty
-> ProtocolVersion
-> SoftwareVersion
-> ToSign
ToSign
    (forall a. AHeader a -> HeaderHash
headerPrevHash AHeader a
h)
    (forall a. AHeader a -> Proof
headerProof AHeader a
h)
    (EpochSlots -> SlotNumber -> EpochAndSlotCount
fromSlotNumber EpochSlots
epochSlots forall a b. (a -> b) -> a -> b
$ forall a. AHeader a -> SlotNumber
headerSlot AHeader a
h)
    (forall a. AHeader a -> ChainDifficulty
headerDifficulty AHeader a
h)
    (forall a. AHeader a -> ProtocolVersion
headerProtocolVersion AHeader a
h)
    (forall a. AHeader a -> SoftwareVersion
headerSoftwareVersion AHeader a
h)

headerLength :: AHeader ByteString -> Natural
headerLength :: AHeader ByteString -> Natural
headerLength = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> Int
BS.length forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. AHeader a -> a
headerAnnotation

--------------------------------------------------------------------------------
-- Header Binary Serialization
--------------------------------------------------------------------------------

-- | Encode a header, without taking in to account deprecated epoch boundary
-- blocks.
encCBORHeader :: EpochSlots -> Header -> Encoding
encCBORHeader :: EpochSlots -> AHeader () -> Encoding
encCBORHeader EpochSlots
es AHeader ()
h =
  Word -> Encoding
encodeListLen Word
5
    forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (forall a. AHeader a -> ProtocolMagicId
headerProtocolMagicId AHeader ()
h)
    forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (forall a. AHeader a -> HeaderHash
headerPrevHash AHeader ()
h)
    forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (forall a. AHeader a -> Proof
headerProof AHeader ()
h)
    forall a. Semigroup a => a -> a -> a
<> ( Word -> Encoding
encodeListLen Word
4
          forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (EpochSlots -> SlotNumber -> EpochAndSlotCount
fromSlotNumber EpochSlots
es forall a b. (a -> b) -> a -> b
$ forall a. AHeader a -> SlotNumber
headerSlot AHeader ()
h)
          forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (forall a. AHeader a -> VerificationKey
headerGenesisKey AHeader ()
h)
          forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (forall a. AHeader a -> ChainDifficulty
headerDifficulty AHeader ()
h)
          forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (forall a. AHeader a -> ABlockSignature a
headerSignature AHeader ()
h)
       )
    forall a. Semigroup a => a -> a -> a
<> ProtocolVersion -> SoftwareVersion -> Encoding
encCBORBlockVersions (forall a. AHeader a -> ProtocolVersion
headerProtocolVersion AHeader ()
h) (forall a. AHeader a -> SoftwareVersion
headerSoftwareVersion AHeader ()
h)

encCBORHeaderSize :: Proxy EpochSlots -> Proxy (AHeader a) -> Size
encCBORHeaderSize :: forall a. Proxy EpochSlots -> Proxy (AHeader a) -> Size
encCBORHeaderSize Proxy EpochSlots
es Proxy (AHeader a)
hdr =
  Size
1 -- encodeListLen 5
    forall a. Num a => a -> a -> a
+ forall a. EncCBOR a => Proxy a -> Size
szGreedy (forall a. AHeader a -> ProtocolMagicId
headerProtocolMagicId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (AHeader a)
hdr)
    forall a. Num a => a -> a -> a
+ forall a. EncCBOR a => Proxy a -> Size
szGreedy (forall a. AHeader a -> HeaderHash
headerPrevHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (AHeader a)
hdr)
    forall a. Num a => a -> a -> a
+ forall a. EncCBOR a => Proxy a -> Size
szGreedy (forall a. AHeader a -> Proof
headerProof forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (AHeader a)
hdr)
    forall a. Num a => a -> a -> a
+ ( Size
1
          forall a. Num a => a -> a -> a
+ forall a. EncCBOR a => Proxy a -> Size
szGreedy (EpochSlots -> SlotNumber -> EpochAndSlotCount
fromSlotNumber forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy EpochSlots
es forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. AHeader a -> SlotNumber
headerSlot forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (AHeader a)
hdr))
          forall a. Num a => a -> a -> a
+ forall a. EncCBOR a => Proxy a -> Size
szGreedy (forall a. AHeader a -> VerificationKey
headerGenesisKey forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (AHeader a)
hdr)
          forall a. Num a => a -> a -> a
+ forall a. EncCBOR a => Proxy a -> Size
szGreedy (forall a. AHeader a -> ChainDifficulty
headerDifficulty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (AHeader a)
hdr)
          -- there is only 'EncCBOR' @ASignature ()@ instance, we
          -- must map 'a' to '()'
          forall a. Num a => a -> a -> a
+ forall a. EncCBOR a => Proxy a -> Size
szGreedy (forall a. AHeader a -> ABlockSignature a
headerSignature forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const ()) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (AHeader a)
hdr)
      )
    forall a. Num a => a -> a -> a
+ Proxy ProtocolVersion -> Proxy SoftwareVersion -> Size
encCBORBlockVersionsSize
      (forall a. AHeader a -> ProtocolVersion
headerProtocolVersion forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (AHeader a)
hdr)
      (forall a. AHeader a -> SoftwareVersion
headerSoftwareVersion forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (AHeader a)
hdr)

encCBORBlockVersions :: ProtocolVersion -> SoftwareVersion -> Encoding
encCBORBlockVersions :: ProtocolVersion -> SoftwareVersion -> Encoding
encCBORBlockVersions ProtocolVersion
pv SoftwareVersion
sv =
  Word -> Encoding
encodeListLen Word
4
    forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR ProtocolVersion
pv
    forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR SoftwareVersion
sv
    -- Encoding of empty Attributes
    forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (forall a. Monoid a => a
mempty :: Map Word8 LByteString)
    -- Hash of the encoding of empty ExtraBodyData
    forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (LByteString -> Hash Raw
hashRaw LByteString
"\129\160")

encCBORBlockVersionsSize :: Proxy ProtocolVersion -> Proxy SoftwareVersion -> Size
encCBORBlockVersionsSize :: Proxy ProtocolVersion -> Proxy SoftwareVersion -> Size
encCBORBlockVersionsSize Proxy ProtocolVersion
pv Proxy SoftwareVersion
sv =
  Size
1
    forall a. Num a => a -> a -> a
+ forall a. EncCBOR a => Proxy a -> Size
szGreedy Proxy ProtocolVersion
pv
    forall a. Num a => a -> a -> a
+ forall a. EncCBOR a => Proxy a -> Size
szGreedy Proxy SoftwareVersion
sv
    -- empty attributes dictionary
    forall a. Num a => a -> a -> a
+ Size
1
    forall a. Num a => a -> a -> a
+ forall a. EncCBOR a => Proxy a -> Size
szGreedy (forall {k} (t :: k). Proxy t
Proxy :: Proxy (Hash Raw))

decCBORHeader :: EpochSlots -> Decoder s Header
decCBORHeader :: forall s. EpochSlots -> Decoder s (AHeader ())
decCBORHeader EpochSlots
epochSlots = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. EpochSlots -> Decoder s (AHeader ByteSpan)
decCBORAHeader EpochSlots
epochSlots

decCBORAHeader :: EpochSlots -> Decoder s (AHeader ByteSpan)
decCBORAHeader :: forall s. EpochSlots -> Decoder s (AHeader ByteSpan)
decCBORAHeader EpochSlots
epochSlots = do
  Annotated
    ( Annotated ProtocolMagicId ByteSpan
pm
      , Annotated HeaderHash ByteSpan
prevHash
      , Annotated Proof ByteSpan
proof
      , (Annotated SlotNumber ByteSpan
slot, VerificationKey
genesisKey, Annotated ChainDifficulty ByteSpan
difficulty, ABlockSignature ByteSpan
sig)
      , Annotated (ProtocolVersion
protocolVersion, SoftwareVersion
softwareVersion) ByteSpan
extraByteSpan
      )
    ByteSpan
byteSpan <-
    forall s a. Decoder s a -> Decoder s (Annotated a ByteSpan)
annotatedDecoder forall a b. (a -> b) -> a -> b
$ do
      forall s. Text -> Int -> Decoder s ()
enforceSize Text
"Header" Int
5
      (,,,,)
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s (Annotated a ByteSpan)
decCBORAnnotated
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s (Annotated a ByteSpan)
decCBORAnnotated
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s (Annotated a ByteSpan)
decCBORAnnotated
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> do
          forall s. Text -> Int -> Decoder s ()
enforceSize Text
"ConsensusData" Int
4
          (,,,)
            -- Next, we decode a 'EpochAndSlotCount' into a 'SlotNumber': the `EpochAndSlotCount`
            -- used in 'AConsensusData' is encoded as a epoch and slot-count
            -- pair.
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (EpochSlots -> EpochAndSlotCount -> SlotNumber
toSlotNumber EpochSlots
epochSlots)) forall a s. DecCBOR a => Decoder s (Annotated a ByteSpan)
decCBORAnnotated
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s (Annotated a ByteSpan)
decCBORAnnotated
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s a. Decoder s a -> Decoder s (Annotated a ByteSpan)
annotatedDecoder forall s. Decoder s (ProtocolVersion, SoftwareVersion)
decCBORBlockVersions
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    forall a b. (a -> b) -> a -> b
$ forall a.
Annotated ProtocolMagicId a
-> Annotated HeaderHash a
-> Annotated SlotNumber a
-> Annotated ChainDifficulty a
-> ProtocolVersion
-> SoftwareVersion
-> Annotated Proof a
-> VerificationKey
-> ABlockSignature a
-> a
-> a
-> AHeader a
AHeader
      Annotated ProtocolMagicId ByteSpan
pm
      Annotated HeaderHash ByteSpan
prevHash
      Annotated SlotNumber ByteSpan
slot
      Annotated ChainDifficulty ByteSpan
difficulty
      ProtocolVersion
protocolVersion
      SoftwareVersion
softwareVersion
      Annotated Proof ByteSpan
proof
      VerificationKey
genesisKey
      ABlockSignature ByteSpan
sig
      ByteSpan
byteSpan
      ByteSpan
extraByteSpan

decCBORBlockVersions :: Decoder s (ProtocolVersion, SoftwareVersion)
decCBORBlockVersions :: forall s. Decoder s (ProtocolVersion, SoftwareVersion)
decCBORBlockVersions = do
  forall s. Text -> Int -> Decoder s ()
enforceSize Text
"BlockVersions" Int
4
  (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s. Dropper s
dropEmptyAttributes forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s. Dropper s
dropBytes

instance Decoded (AHeader ByteString) where
  type BaseType (AHeader ByteString) = Header
  recoverBytes :: AHeader ByteString -> ByteString
recoverBytes = forall a. AHeader a -> a
headerAnnotation

-- | Encode a 'Header' accounting for deprecated epoch boundary blocks
--
--   This encoding is only used when hashing the header for backwards
--   compatibility, but should not be used when serializing a header within a
--   block
encCBORHeaderToHash :: EpochSlots -> Header -> Encoding
encCBORHeaderToHash :: EpochSlots -> AHeader () -> Encoding
encCBORHeaderToHash EpochSlots
epochSlots AHeader ()
h =
  Word -> Encoding
encodeListLen Word
2 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (Word
1 :: Word) forall a. Semigroup a => a -> a -> a
<> EpochSlots -> AHeader () -> Encoding
encCBORHeader EpochSlots
epochSlots AHeader ()
h

decCBORHeaderToHash :: EpochSlots -> Decoder s (Maybe Header)
decCBORHeaderToHash :: forall s. EpochSlots -> Decoder s (Maybe (AHeader ()))
decCBORHeaderToHash EpochSlots
epochSlots = do
  forall s. Text -> Int -> Decoder s ()
enforceSize Text
"Header" Int
2
  forall a s. DecCBOR a => Decoder s a
decCBOR @Word forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word
0 -> do
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall s. Decoder s (ABoundaryHeader ByteSpan)
decCBORABoundaryHeader
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
    Word
1 -> forall a. a -> Maybe a
Just forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall s. EpochSlots -> Decoder s (AHeader ())
decCBORHeader EpochSlots
epochSlots
    Word
t -> forall (m :: * -> *) e a. (MonadFail m, Buildable e) => e -> m a
cborError forall a b. (a -> b) -> a -> b
$ Text -> Word8 -> DecoderError
DecoderErrorUnknownTag Text
"Header" (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
t)

--------------------------------------------------------------------------------
-- Header Formatting
--------------------------------------------------------------------------------

instance B.Buildable (WithEpochSlots Header) where
  build :: WithEpochSlots (AHeader ()) -> Builder
build (WithEpochSlots EpochSlots
es AHeader ()
header) = EpochSlots -> AHeader () -> Builder
renderHeader EpochSlots
es AHeader ()
header

renderHeader :: EpochSlots -> Header -> Builder
renderHeader :: EpochSlots -> AHeader () -> Builder
renderHeader EpochSlots
es AHeader ()
header =
  forall a. Format Builder a -> a
bprint
    ( Format
  (HeaderHash
   -> HeaderHash
   -> SlotNumber
   -> Word64
   -> ProtocolVersion
   -> SoftwareVersion
   -> VerificationKey
   -> BlockSignature
   -> Builder)
  (HeaderHash
   -> HeaderHash
   -> SlotNumber
   -> Word64
   -> ProtocolVersion
   -> SoftwareVersion
   -> VerificationKey
   -> BlockSignature
   -> Builder)
"Header:\n"
        forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (HeaderHash
   -> HeaderHash
   -> SlotNumber
   -> Word64
   -> ProtocolVersion
   -> SoftwareVersion
   -> VerificationKey
   -> BlockSignature
   -> Builder)
  (HeaderHash
   -> HeaderHash
   -> SlotNumber
   -> Word64
   -> ProtocolVersion
   -> SoftwareVersion
   -> VerificationKey
   -> BlockSignature
   -> Builder)
"    hash: "
        forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall r algo a. Format r (AbstractHash algo a -> r)
hashHexF
        forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (HeaderHash
   -> SlotNumber
   -> Word64
   -> ProtocolVersion
   -> SoftwareVersion
   -> VerificationKey
   -> BlockSignature
   -> Builder)
  (HeaderHash
   -> SlotNumber
   -> Word64
   -> ProtocolVersion
   -> SoftwareVersion
   -> VerificationKey
   -> BlockSignature
   -> Builder)
"\n"
        forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (HeaderHash
   -> SlotNumber
   -> Word64
   -> ProtocolVersion
   -> SoftwareVersion
   -> VerificationKey
   -> BlockSignature
   -> Builder)
  (HeaderHash
   -> SlotNumber
   -> Word64
   -> ProtocolVersion
   -> SoftwareVersion
   -> VerificationKey
   -> BlockSignature
   -> Builder)
"    previous block: "
        forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall r algo a. Format r (AbstractHash algo a -> r)
hashHexF
        forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (SlotNumber
   -> Word64
   -> ProtocolVersion
   -> SoftwareVersion
   -> VerificationKey
   -> BlockSignature
   -> Builder)
  (SlotNumber
   -> Word64
   -> ProtocolVersion
   -> SoftwareVersion
   -> VerificationKey
   -> BlockSignature
   -> Builder)
"\n"
        forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (SlotNumber
   -> Word64
   -> ProtocolVersion
   -> SoftwareVersion
   -> VerificationKey
   -> BlockSignature
   -> Builder)
  (SlotNumber
   -> Word64
   -> ProtocolVersion
   -> SoftwareVersion
   -> VerificationKey
   -> BlockSignature
   -> Builder)
"    slot: "
        forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Buildable a => Format r (a -> r)
build
        forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (Word64
   -> ProtocolVersion
   -> SoftwareVersion
   -> VerificationKey
   -> BlockSignature
   -> Builder)
  (Word64
   -> ProtocolVersion
   -> SoftwareVersion
   -> VerificationKey
   -> BlockSignature
   -> Builder)
"\n"
        forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (Word64
   -> ProtocolVersion
   -> SoftwareVersion
   -> VerificationKey
   -> BlockSignature
   -> Builder)
  (Word64
   -> ProtocolVersion
   -> SoftwareVersion
   -> VerificationKey
   -> BlockSignature
   -> Builder)
"    difficulty: "
        forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Integral a => Format r (a -> r)
int
        forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (ProtocolVersion
   -> SoftwareVersion -> VerificationKey -> BlockSignature -> Builder)
  (ProtocolVersion
   -> SoftwareVersion -> VerificationKey -> BlockSignature -> Builder)
"\n"
        forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (ProtocolVersion
   -> SoftwareVersion -> VerificationKey -> BlockSignature -> Builder)
  (ProtocolVersion
   -> SoftwareVersion -> VerificationKey -> BlockSignature -> Builder)
"    protocol: v"
        forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Buildable a => Format r (a -> r)
build
        forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (SoftwareVersion -> VerificationKey -> BlockSignature -> Builder)
  (SoftwareVersion -> VerificationKey -> BlockSignature -> Builder)
"\n"
        forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (SoftwareVersion -> VerificationKey -> BlockSignature -> Builder)
  (SoftwareVersion -> VerificationKey -> BlockSignature -> Builder)
"    software: "
        forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Buildable a => Format r (a -> r)
build
        forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (VerificationKey -> BlockSignature -> Builder)
  (VerificationKey -> BlockSignature -> Builder)
"\n"
        forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (VerificationKey -> BlockSignature -> Builder)
  (VerificationKey -> BlockSignature -> Builder)
"    genesis key: "
        forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Buildable a => Format r (a -> r)
build
        forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (BlockSignature -> Builder) (BlockSignature -> Builder)
"\n"
        forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (BlockSignature -> Builder) (BlockSignature -> Builder)
"    signature: "
        forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Buildable a => Format r (a -> r)
build
    )
    HeaderHash
headerHash
    (forall a. AHeader a -> HeaderHash
headerPrevHash AHeader ()
header)
    (forall a. AHeader a -> SlotNumber
headerSlot AHeader ()
header)
    (ChainDifficulty -> Word64
unChainDifficulty forall a b. (a -> b) -> a -> b
$ forall a. AHeader a -> ChainDifficulty
headerDifficulty AHeader ()
header)
    (forall a. AHeader a -> ProtocolVersion
headerProtocolVersion AHeader ()
header)
    (forall a. AHeader a -> SoftwareVersion
headerSoftwareVersion AHeader ()
header)
    (forall a. AHeader a -> VerificationKey
headerGenesisKey AHeader ()
header)
    (forall a. AHeader a -> ABlockSignature a
headerSignature AHeader ()
header)
  where
    headerHash :: HeaderHash
    headerHash :: HeaderHash
headerHash = EpochSlots -> AHeader () -> HeaderHash
hashHeader EpochSlots
es AHeader ()
header

--------------------------------------------------------------------------------
-- HeaderHash
--------------------------------------------------------------------------------

-- | 'Hash' of block header
type HeaderHash = Hash Header

-- | Specialized formatter for 'HeaderHash'
headerHashF :: Format r (HeaderHash -> r)
headerHashF :: forall r. Format r (HeaderHash -> r)
headerHashF = forall a r. Buildable a => Format r (a -> r)
build

-- | Extract the genesis hash and cast it into a header hash.
genesisHeaderHash :: GenesisHash -> HeaderHash
genesisHeaderHash :: GenesisHash -> HeaderHash
genesisHeaderHash = coerce :: forall a b. Coercible a b => a -> b
coerce forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. GenesisHash -> Hash Raw
unGenesisHash

-- | These bytes must be prepended when hashing raw boundary header data
--
--   In the Byron release, hashes were taken over a data type that was never
--   directly serialized to the blockchain, so these magic bytes cannot be
--   determined from the raw header data.
--
--   These bytes are from `encodeListLen 2 <> encCBOR (1 :: Word8)`
wrapHeaderBytes :: ByteString -> ByteString
wrapHeaderBytes :: ByteString -> ByteString
wrapHeaderBytes = forall a. Monoid a => a -> a -> a
mappend ByteString
"\130\SOH"

-- | Hash the serialised representation of a `Header`
--
--   For backwards compatibility we have to take the hash of the header
--   serialised with 'encCBORHeaderToHash'
hashHeader :: EpochSlots -> Header -> HeaderHash
hashHeader :: EpochSlots -> AHeader () -> HeaderHash
hashHeader EpochSlots
es = forall algo a.
HashAlgorithm algo =>
LByteString -> AbstractHash algo a
unsafeAbstractHash forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. EncCBOR a => Version -> a -> LByteString
serialize Version
byronProtVer forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. EpochSlots -> AHeader () -> Encoding
encCBORHeaderToHash EpochSlots
es

headerHashAnnotated :: AHeader ByteString -> HeaderHash
headerHashAnnotated :: AHeader ByteString -> HeaderHash
headerHashAnnotated = forall t. Decoded t => t -> Hash (BaseType t)
hashDecoded forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
wrapHeaderBytes

--------------------------------------------------------------------------------
-- BoundaryHeader
--------------------------------------------------------------------------------

data ABoundaryHeader a = UnsafeABoundaryHeader
  { forall a. ABoundaryHeader a -> Either GenesisHash HeaderHash
boundaryPrevHash :: !(Either GenesisHash HeaderHash)
  , forall a. ABoundaryHeader a -> Word64
boundaryEpoch :: !Word64
  , forall a. ABoundaryHeader a -> ChainDifficulty
boundaryDifficulty :: !ChainDifficulty
  , forall a. ABoundaryHeader a -> a
boundaryHeaderAnnotation :: !a
  }
  deriving (ABoundaryHeader a -> ABoundaryHeader a -> Bool
forall a. Eq a => ABoundaryHeader a -> ABoundaryHeader a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ABoundaryHeader a -> ABoundaryHeader a -> Bool
$c/= :: forall a. Eq a => ABoundaryHeader a -> ABoundaryHeader a -> Bool
== :: ABoundaryHeader a -> ABoundaryHeader a -> Bool
$c== :: forall a. Eq a => ABoundaryHeader a -> ABoundaryHeader a -> Bool
Eq, Int -> ABoundaryHeader a -> ShowS
forall a. Show a => Int -> ABoundaryHeader a -> ShowS
forall a. Show a => [ABoundaryHeader a] -> ShowS
forall a. Show a => ABoundaryHeader a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ABoundaryHeader a] -> ShowS
$cshowList :: forall a. Show a => [ABoundaryHeader a] -> ShowS
show :: ABoundaryHeader a -> String
$cshow :: forall a. Show a => ABoundaryHeader a -> String
showsPrec :: Int -> ABoundaryHeader a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ABoundaryHeader a -> ShowS
Show, forall a b. a -> ABoundaryHeader b -> ABoundaryHeader a
forall a b. (a -> b) -> ABoundaryHeader a -> ABoundaryHeader b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> ABoundaryHeader b -> ABoundaryHeader a
$c<$ :: forall a b. a -> ABoundaryHeader b -> ABoundaryHeader a
fmap :: forall a b. (a -> b) -> ABoundaryHeader a -> ABoundaryHeader b
$cfmap :: forall a b. (a -> b) -> ABoundaryHeader a -> ABoundaryHeader b
Functor, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ABoundaryHeader a) x -> ABoundaryHeader a
forall a x. ABoundaryHeader a -> Rep (ABoundaryHeader a) x
$cto :: forall a x. Rep (ABoundaryHeader a) x -> ABoundaryHeader a
$cfrom :: forall a x. ABoundaryHeader a -> Rep (ABoundaryHeader a) x
Generic, forall a.
NoThunks a =>
Context -> ABoundaryHeader a -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Proxy (ABoundaryHeader a) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (ABoundaryHeader a) -> String
$cshowTypeOf :: forall a. NoThunks a => Proxy (ABoundaryHeader a) -> String
wNoThunks :: Context -> ABoundaryHeader a -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall a.
NoThunks a =>
Context -> ABoundaryHeader a -> IO (Maybe ThunkInfo)
noThunks :: Context -> ABoundaryHeader a -> IO (Maybe ThunkInfo)
$cnoThunks :: forall a.
NoThunks a =>
Context -> ABoundaryHeader a -> IO (Maybe ThunkInfo)
NoThunks)

-- Used for debugging purposes only
instance ToJSON a => ToJSON (ABoundaryHeader a)

-- | Smart constructor for 'ABoundaryHeader'
--
-- Makes sure that the hash is forced.
mkABoundaryHeader ::
  Either GenesisHash HeaderHash ->
  Word64 ->
  ChainDifficulty ->
  a ->
  ABoundaryHeader a
mkABoundaryHeader :: forall a.
Either GenesisHash HeaderHash
-> Word64 -> ChainDifficulty -> a -> ABoundaryHeader a
mkABoundaryHeader Either GenesisHash HeaderHash
prevHash Word64
epoch ChainDifficulty
dty a
ann =
  case Either GenesisHash HeaderHash
prevHash of
    Left !GenesisHash
genHash -> forall a.
Either GenesisHash HeaderHash
-> Word64 -> ChainDifficulty -> a -> ABoundaryHeader a
UnsafeABoundaryHeader (forall a b. a -> Either a b
Left GenesisHash
genHash) Word64
epoch ChainDifficulty
dty a
ann
    Right !HeaderHash
hdrHash -> forall a.
Either GenesisHash HeaderHash
-> Word64 -> ChainDifficulty -> a -> ABoundaryHeader a
UnsafeABoundaryHeader (forall a b. b -> Either a b
Right HeaderHash
hdrHash) Word64
epoch ChainDifficulty
dty a
ann

instance Decoded (ABoundaryHeader ByteString) where
  type BaseType (ABoundaryHeader ByteString) = ABoundaryHeader ()
  recoverBytes :: ABoundaryHeader ByteString -> ByteString
recoverBytes = forall a. ABoundaryHeader a -> a
boundaryHeaderAnnotation

-- | Compute the hash of a boundary block header from its annotation.
-- It uses `wrapBoundaryBytes`, for the hash must be computed on the header
-- bytes tagged with the CBOR list length and tag discriminator, which is
-- the encoding chosen by cardano-sl.
boundaryHeaderHashAnnotated :: ABoundaryHeader ByteString -> HeaderHash
boundaryHeaderHashAnnotated :: ABoundaryHeader ByteString -> HeaderHash
boundaryHeaderHashAnnotated = coerce :: forall a b. Coercible a b => a -> b
coerce forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall t. Decoded t => t -> Hash (BaseType t)
hashDecoded forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
wrapBoundaryBytes

-- | Encode from a boundary header with any annotation. This does not
-- necessarily invert `decCBORBoundaryHeader`, because that decoder drops
-- information that this encoder replaces, such as the body proof (assumes
-- the body is empty) and the extra header data (sets it to empty map).
encCBORABoundaryHeader :: ProtocolMagicId -> ABoundaryHeader a -> Encoding
encCBORABoundaryHeader :: forall a. ProtocolMagicId -> ABoundaryHeader a -> Encoding
encCBORABoundaryHeader ProtocolMagicId
pm ABoundaryHeader a
hdr =
  Word -> Encoding
encodeListLen Word
5
    forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR ProtocolMagicId
pm
    forall a. Semigroup a => a -> a -> a
<> ( case forall a. ABoundaryHeader a -> Either GenesisHash HeaderHash
boundaryPrevHash ABoundaryHeader a
hdr of
          Left GenesisHash
gh -> forall a. EncCBOR a => a -> Encoding
encCBOR (GenesisHash -> HeaderHash
genesisHeaderHash GenesisHash
gh)
          Right HeaderHash
hh -> forall a. EncCBOR a => a -> Encoding
encCBOR HeaderHash
hh
       )
    -- Body proof
    -- The body is always an empty slot leader schedule, so we hash that.
    forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (forall a. EncCBOR a => a -> Hash a
serializeCborHash ([] :: [()]))
    -- Consensus data
    forall a. Semigroup a => a -> a -> a
<> ( Word -> Encoding
encodeListLen Word
2
          -- Epoch
          forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (forall a. ABoundaryHeader a -> Word64
boundaryEpoch ABoundaryHeader a
hdr)
          -- Chain difficulty
          forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (forall a. ABoundaryHeader a -> ChainDifficulty
boundaryDifficulty ABoundaryHeader a
hdr)
       )
    -- Extra data
    forall a. Semigroup a => a -> a -> a
<> ( Word -> Encoding
encodeListLen Word
1
          forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR Map Word8 LByteString
genesisTag
       )
  where
    -- Genesis tag to indicate the presence of a genesis hash in a non-zero
    -- epoch. See 'dropBoundaryExtraHeaderDataRetainGenesisTag' for more
    -- details on this.
    genesisTag :: Map Word8 LByteString
genesisTag = case (forall a. ABoundaryHeader a -> Either GenesisHash HeaderHash
boundaryPrevHash ABoundaryHeader a
hdr, forall a. ABoundaryHeader a -> Word64
boundaryEpoch ABoundaryHeader a
hdr) of
      (Left GenesisHash
_, Word64
n) | Word64
n forall a. Ord a => a -> a -> Bool
> Word64
0 -> forall k a. k -> a -> Map k a
Map.singleton Word8
255 LByteString
"Genesis"
      (Either GenesisHash HeaderHash, Word64)
_ -> forall a. Monoid a => a
mempty :: Map Word8 LByteString

encCBORABoundaryHeaderSize :: Proxy ProtocolMagicId -> Proxy (ABoundaryHeader a) -> Size
encCBORABoundaryHeaderSize :: forall a.
Proxy ProtocolMagicId -> Proxy (ABoundaryHeader a) -> Size
encCBORABoundaryHeaderSize Proxy ProtocolMagicId
pm Proxy (ABoundaryHeader a)
hdr =
  Size
1
    forall a. Num a => a -> a -> a
+ forall a. EncCBOR a => Proxy a -> Size
szGreedy Proxy ProtocolMagicId
pm
    forall a. Num a => a -> a -> a
+ [Case Size] -> Size
szCases
      [ forall t. Text -> t -> Case t
Case Text
"GenesisHash"
          forall a b. (a -> b) -> a -> b
$ forall a. EncCBOR a => Proxy a -> Size
szGreedy
          forall a b. (a -> b) -> a -> b
$ forall a b. Proxy (Either a b) -> Proxy a
pFromLeft
          forall a b. (a -> b) -> a -> b
$ forall a. ABoundaryHeader a -> Either GenesisHash HeaderHash
boundaryPrevHash
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (ABoundaryHeader a)
hdr
      , forall t. Text -> t -> Case t
Case Text
"HeaderHash"
          forall a b. (a -> b) -> a -> b
$ forall a. EncCBOR a => Proxy a -> Size
szGreedy
          forall a b. (a -> b) -> a -> b
$ forall a b. Proxy (Either a b) -> Proxy b
pFromRight
          forall a b. (a -> b) -> a -> b
$ forall a. ABoundaryHeader a -> Either GenesisHash HeaderHash
boundaryPrevHash
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (ABoundaryHeader a)
hdr
      ]
    -- Body proof
    forall a. Num a => a -> a -> a
+ forall a. EncCBOR a => Proxy a -> Size
szGreedy (forall {k} (t :: k). Proxy t
Proxy :: Proxy (Hash LByteString))
    -- Consensus data
    forall a. Num a => a -> a -> a
+ ( Size
1
          forall a. Num a => a -> a -> a
+ forall a. EncCBOR a => Proxy a -> Size
szGreedy (forall a. ABoundaryHeader a -> Word64
boundaryEpoch forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (ABoundaryHeader a)
hdr)
          forall a. Num a => a -> a -> a
+ forall a. EncCBOR a => Proxy a -> Size
szGreedy (forall a. ABoundaryHeader a -> ChainDifficulty
boundaryDifficulty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (ABoundaryHeader a)
hdr)
      )
    -- Extra data
    forall a. Num a => a -> a -> a
+ ( Size
1
          forall a. Num a => a -> a -> a
+ [Case Size] -> Size
szCases
            [ forall t. Text -> t -> Case t
Case Text
"Genesis" Size
11
            , forall t. Text -> t -> Case t
Case Text
"" Size
1
            ]
      )
  where
    pFromLeft :: Proxy (Either a b) -> Proxy a
    pFromLeft :: forall a b. Proxy (Either a b) -> Proxy a
pFromLeft Proxy (Either a b)
_ = forall {k} (t :: k). Proxy t
Proxy

    pFromRight :: Proxy (Either a b) -> Proxy b
    pFromRight :: forall a b. Proxy (Either a b) -> Proxy b
pFromRight Proxy (Either a b)
_ = forall {k} (t :: k). Proxy t
Proxy

decCBORABoundaryHeader :: Decoder s (ABoundaryHeader ByteSpan)
decCBORABoundaryHeader :: forall s. Decoder s (ABoundaryHeader ByteSpan)
decCBORABoundaryHeader = do
  Annotated ABoundaryHeader ()
header ByteSpan
bytespan <- forall s a. Decoder s a -> Decoder s (Annotated a ByteSpan)
annotatedDecoder forall a b. (a -> b) -> a -> b
$ do
    forall s. Text -> Int -> Decoder s ()
enforceSize Text
"BoundaryHeader" Int
5
    forall s. Dropper s
dropInt32
    -- HeaderHash
    HeaderHash
hh <- forall a s. DecCBOR a => Decoder s a
decCBOR
    -- BoundaryBodyProof
    forall s. Dropper s
dropBytes
    (Word64
epoch, ChainDifficulty
difficulty) <- forall s. Decoder s (Word64, ChainDifficulty)
decCBORBoundaryConsensusData
    Bool
isGen <- forall s. Decoder s Bool
dropBoundaryExtraHeaderDataRetainGenesisTag
    let hh' :: Either GenesisHash HeaderHash
hh' = if Word64
epoch forall a. Eq a => a -> a -> Bool
== Word64
0 Bool -> Bool -> Bool
|| Bool
isGen then forall a b. a -> Either a b
Left (coerce :: forall a b. Coercible a b => a -> b
coerce HeaderHash
hh) else forall a b. b -> Either a b
Right HeaderHash
hh
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a.
Either GenesisHash HeaderHash
-> Word64 -> ChainDifficulty -> a -> ABoundaryHeader a
mkABoundaryHeader Either GenesisHash HeaderHash
hh' Word64
epoch ChainDifficulty
difficulty ()
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (ABoundaryHeader ()
header {boundaryHeaderAnnotation :: ByteSpan
boundaryHeaderAnnotation = ByteSpan
bytespan})

-- | These bytes must be prepended when hashing raw boundary header data
--
--   In the Byron release, hashes were taken over a data type that was never
--   directly serialized to the blockchain, so these magic bytes cannot be
--   determined from the raw header data.
wrapBoundaryBytes :: ByteString -> ByteString
wrapBoundaryBytes :: ByteString -> ByteString
wrapBoundaryBytes = forall a. Monoid a => a -> a -> a
mappend ByteString
"\130\NUL"

--------------------------------------------------------------------------------
-- BlockSignature
--------------------------------------------------------------------------------

type BlockSignature = ABlockSignature ()

-- | Signature of the 'Block'
--
--   We use a heavyweight delegation scheme, so the signature has two parts:
--
--   1. A delegation certificate from a genesis key to the block signer
--   2. The actual signature over `ToSign`
data ABlockSignature a = ABlockSignature
  { forall a. ABlockSignature a -> ACertificate a
delegationCertificate :: !(Delegation.ACertificate a)
  , forall a. ABlockSignature a -> Signature ToSign
signature :: !(Signature ToSign)
  }
  deriving (Int -> ABlockSignature a -> ShowS
forall a. Show a => Int -> ABlockSignature a -> ShowS
forall a. Show a => [ABlockSignature a] -> ShowS
forall a. Show a => ABlockSignature a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ABlockSignature a] -> ShowS
$cshowList :: forall a. Show a => [ABlockSignature a] -> ShowS
show :: ABlockSignature a -> String
$cshow :: forall a. Show a => ABlockSignature a -> String
showsPrec :: Int -> ABlockSignature a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ABlockSignature a -> ShowS
Show, ABlockSignature a -> ABlockSignature a -> Bool
forall a. Eq a => ABlockSignature a -> ABlockSignature a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ABlockSignature a -> ABlockSignature a -> Bool
$c/= :: forall a. Eq a => ABlockSignature a -> ABlockSignature a -> Bool
== :: ABlockSignature a -> ABlockSignature a -> Bool
$c== :: forall a. Eq a => ABlockSignature a -> ABlockSignature a -> Bool
Eq, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ABlockSignature a) x -> ABlockSignature a
forall a x. ABlockSignature a -> Rep (ABlockSignature a) x
$cto :: forall a x. Rep (ABlockSignature a) x -> ABlockSignature a
$cfrom :: forall a x. ABlockSignature a -> Rep (ABlockSignature a) x
Generic, forall a b. a -> ABlockSignature b -> ABlockSignature a
forall a b. (a -> b) -> ABlockSignature a -> ABlockSignature b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> ABlockSignature b -> ABlockSignature a
$c<$ :: forall a b. a -> ABlockSignature b -> ABlockSignature a
fmap :: forall a b. (a -> b) -> ABlockSignature a -> ABlockSignature b
$cfmap :: forall a b. (a -> b) -> ABlockSignature a -> ABlockSignature b
Functor)
  deriving anyclass (forall a. NFData a => ABlockSignature a -> ()
forall a. (a -> ()) -> NFData a
rnf :: ABlockSignature a -> ()
$crnf :: forall a. NFData a => ABlockSignature a -> ()
NFData, forall a.
NoThunks a =>
Context -> ABlockSignature a -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Proxy (ABlockSignature a) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (ABlockSignature a) -> String
$cshowTypeOf :: forall a. NoThunks a => Proxy (ABlockSignature a) -> String
wNoThunks :: Context -> ABlockSignature a -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall a.
NoThunks a =>
Context -> ABlockSignature a -> IO (Maybe ThunkInfo)
noThunks :: Context -> ABlockSignature a -> IO (Maybe ThunkInfo)
$cnoThunks :: forall a.
NoThunks a =>
Context -> ABlockSignature a -> IO (Maybe ThunkInfo)
NoThunks)

instance B.Buildable BlockSignature where
  build :: BlockSignature -> Builder
build (ABlockSignature Certificate
cert Signature ToSign
_) =
    forall a. Format Builder a -> a
bprint
      ( Format (Certificate -> Builder) (Certificate -> Builder)
"BlockSignature:\n"
          forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (Certificate -> Builder) (Certificate -> Builder)
"  Delegation certificate: "
          forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Buildable a => Format r (a -> r)
build
      )
      Certificate
cert

-- Used for debugging purposes only
instance ToJSON a => ToJSON (ABlockSignature a)

instance ToCBOR BlockSignature where
  toCBOR :: BlockSignature -> Encoding
toCBOR = forall a. EncCBOR a => a -> Encoding
toByronCBOR

instance FromCBOR BlockSignature where
  fromCBOR :: forall s. Decoder s BlockSignature
fromCBOR = forall a s. DecCBOR a => Decoder s a
fromByronCBOR

instance FromCBOR (ABlockSignature ByteSpan) where
  fromCBOR :: forall s. Decoder s (ABlockSignature ByteSpan)
fromCBOR = forall a s. DecCBOR a => Decoder s a
fromByronCBOR

instance EncCBOR BlockSignature where
  encCBOR :: BlockSignature -> Encoding
encCBOR (ABlockSignature Certificate
cert Signature ToSign
sig) =
    -- Tag 0 was previously used for BlockSignature (no delegation)
    -- Tag 1 was previously used for BlockPSignatureLight
    Word -> Encoding
encodeListLen Word
2
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
2 :: Word8)
      forall a. Semigroup a => a -> a -> a
<> (Word -> Encoding
encodeListLen Word
2 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR Certificate
cert forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR Signature ToSign
sig)

  encodedSizeExpr :: (forall a. EncCBOR a => Proxy a -> Size)
-> Proxy BlockSignature -> Size
encodedSizeExpr forall a. EncCBOR a => Proxy a -> Size
size Proxy BlockSignature
sig =
    Size
3
      forall a. Num a => a -> a -> a
+ forall a.
EncCBOR a =>
(forall a. EncCBOR a => Proxy a -> Size) -> Proxy a -> Size
encodedSizeExpr forall a. EncCBOR a => Proxy a -> Size
size (forall a. ABlockSignature a -> ACertificate a
delegationCertificate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy BlockSignature
sig)
      forall a. Num a => a -> a -> a
+ forall a.
EncCBOR a =>
(forall a. EncCBOR a => Proxy a -> Size) -> Proxy a -> Size
encodedSizeExpr forall a. EncCBOR a => Proxy a -> Size
size (forall a. ABlockSignature a -> Signature ToSign
signature forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy BlockSignature
sig)

instance DecCBOR BlockSignature where
  decCBOR :: forall s. Decoder s BlockSignature
decCBOR = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR @(ABlockSignature ByteSpan)

instance DecCBOR (ABlockSignature ByteSpan) where
  decCBOR :: forall s. Decoder s (ABlockSignature ByteSpan)
decCBOR = do
    forall s. Text -> Int -> Decoder s ()
enforceSize Text
"BlockSignature" Int
2
    forall a s. DecCBOR a => Decoder s a
decCBOR forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Word8
2 ->
        forall a. ACertificate a -> Signature ToSign -> ABlockSignature a
ABlockSignature
          forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s. Text -> Int -> Decoder s ()
enforceSize Text
"BlockSignature" Int
2
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR
      Word8
t -> forall (m :: * -> *) e a. (MonadFail m, Buildable e) => e -> m a
cborError forall a b. (a -> b) -> a -> b
$ Text -> Word8 -> DecoderError
DecoderErrorUnknownTag Text
"BlockSignature" Word8
t

--------------------------------------------------------------------------------
-- ToSign
--------------------------------------------------------------------------------

-- | Produces the ByteString that was signed in the block
recoverSignedBytes ::
  EpochSlots -> AHeader ByteString -> Annotated ToSign ByteString
recoverSignedBytes :: EpochSlots -> AHeader ByteString -> Annotated ToSign ByteString
recoverSignedBytes EpochSlots
es AHeader ByteString
h = forall b a. b -> a -> Annotated b a
Annotated (forall a. EpochSlots -> AHeader a -> ToSign
headerToSign EpochSlots
es AHeader ByteString
h) ByteString
bytes
  where
    bytes :: ByteString
bytes =
      [ByteString] -> ByteString
BS.concat
        [ ByteString
"\133"
        , -- This is the value of Codec.CBOR.Write.toLazyByteString (encodeListLen 5)
          -- It is hard coded here because the signed bytes included it as an
          -- implementation artifact
          (forall b a. Annotated b a -> a
annotation forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. AHeader a -> Annotated HeaderHash a
aHeaderPrevHash) AHeader ByteString
h
        , (forall b a. Annotated b a -> a
annotation forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. AHeader a -> Annotated Proof a
aHeaderProof) AHeader ByteString
h
        , (forall b a. Annotated b a -> a
annotation forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. AHeader a -> Annotated SlotNumber a
aHeaderSlot) AHeader ByteString
h
        , (forall b a. Annotated b a -> a
annotation forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. AHeader a -> Annotated ChainDifficulty a
aHeaderDifficulty) AHeader ByteString
h
        , forall a. AHeader a -> a
headerExtraAnnotation AHeader ByteString
h
        ]

-- | Data to be signed in 'Block'
data ToSign = ToSign
  { ToSign -> HeaderHash
tsHeaderHash :: !HeaderHash
  -- ^ Hash of previous header in the chain
  , ToSign -> Proof
tsBodyProof :: !Proof
  , ToSign -> EpochAndSlotCount
tsSlot :: !EpochAndSlotCount
  , ToSign -> ChainDifficulty
tsDifficulty :: !ChainDifficulty
  , ToSign -> ProtocolVersion
tsProtocolVersion :: !ProtocolVersion
  , ToSign -> SoftwareVersion
tsSoftwareVersion :: !SoftwareVersion
  }
  deriving (ToSign -> ToSign -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ToSign -> ToSign -> Bool
$c/= :: ToSign -> ToSign -> Bool
== :: ToSign -> ToSign -> Bool
$c== :: ToSign -> ToSign -> Bool
Eq, Int -> ToSign -> ShowS
[ToSign] -> ShowS
ToSign -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ToSign] -> ShowS
$cshowList :: [ToSign] -> ShowS
show :: ToSign -> String
$cshow :: ToSign -> String
showsPrec :: Int -> ToSign -> ShowS
$cshowsPrec :: Int -> ToSign -> ShowS
Show, forall x. Rep ToSign x -> ToSign
forall x. ToSign -> Rep ToSign x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ToSign x -> ToSign
$cfrom :: forall x. ToSign -> Rep ToSign x
Generic)

instance ToCBOR ToSign where
  toCBOR :: ToSign -> Encoding
toCBOR = forall a. EncCBOR a => a -> Encoding
toByronCBOR

instance FromCBOR ToSign where
  fromCBOR :: forall s. Decoder s ToSign
fromCBOR = forall a s. DecCBOR a => Decoder s a
fromByronCBOR

instance EncCBOR ToSign where
  encCBOR :: ToSign -> Encoding
encCBOR ToSign
ts =
    Word -> Encoding
encodeListLen Word
5
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (ToSign -> HeaderHash
tsHeaderHash ToSign
ts)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (ToSign -> Proof
tsBodyProof ToSign
ts)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (ToSign -> EpochAndSlotCount
tsSlot ToSign
ts)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (ToSign -> ChainDifficulty
tsDifficulty ToSign
ts)
      forall a. Semigroup a => a -> a -> a
<> ProtocolVersion -> SoftwareVersion -> Encoding
encCBORBlockVersions (ToSign -> ProtocolVersion
tsProtocolVersion ToSign
ts) (ToSign -> SoftwareVersion
tsSoftwareVersion ToSign
ts)

  encodedSizeExpr :: (forall a. EncCBOR a => Proxy a -> Size) -> Proxy ToSign -> Size
encodedSizeExpr forall a. EncCBOR a => Proxy a -> Size
size Proxy ToSign
ts =
    Size
1
      forall a. Num a => a -> a -> a
+ forall a.
EncCBOR a =>
(forall a. EncCBOR a => Proxy a -> Size) -> Proxy a -> Size
encodedSizeExpr forall a. EncCBOR a => Proxy a -> Size
size (ToSign -> HeaderHash
tsHeaderHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy ToSign
ts)
      forall a. Num a => a -> a -> a
+ forall a.
EncCBOR a =>
(forall a. EncCBOR a => Proxy a -> Size) -> Proxy a -> Size
encodedSizeExpr forall a. EncCBOR a => Proxy a -> Size
size (ToSign -> Proof
tsBodyProof forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy ToSign
ts)
      forall a. Num a => a -> a -> a
+ forall a.
EncCBOR a =>
(forall a. EncCBOR a => Proxy a -> Size) -> Proxy a -> Size
encodedSizeExpr forall a. EncCBOR a => Proxy a -> Size
size (ToSign -> EpochAndSlotCount
tsSlot forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy ToSign
ts)
      forall a. Num a => a -> a -> a
+ forall a.
EncCBOR a =>
(forall a. EncCBOR a => Proxy a -> Size) -> Proxy a -> Size
encodedSizeExpr forall a. EncCBOR a => Proxy a -> Size
size (ToSign -> ChainDifficulty
tsDifficulty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy ToSign
ts)
      forall a. Num a => a -> a -> a
+ Proxy ProtocolVersion -> Proxy SoftwareVersion -> Size
encCBORBlockVersionsSize (ToSign -> ProtocolVersion
tsProtocolVersion forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy ToSign
ts) (ToSign -> SoftwareVersion
tsSoftwareVersion forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy ToSign
ts)

instance DecCBOR ToSign where
  decCBOR :: forall s. Decoder s ToSign
decCBOR = do
    forall s. Text -> Int -> Decoder s ()
enforceSize Text
"ToSign" Int
5
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (HeaderHash
-> Proof
-> EpochAndSlotCount
-> ChainDifficulty
-> ProtocolVersion
-> SoftwareVersion
-> ToSign
ToSign forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s. Decoder s (ProtocolVersion, SoftwareVersion)
decCBORBlockVersions