{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}

{-# OPTIONS_GHC -Wno-orphans #-}

module Ouroboros.Consensus.Byron.Ledger.Serialisation (
    -- * Data family instances
    NestedCtxt_ (..)
  , RawBoundaryHeader
  , RawHeader
    -- * Serialisation
  , byronBlockEncodingOverhead
  , decodeByronBlock
  , decodeByronBoundaryBlock
  , decodeByronBoundaryHeader
  , decodeByronHeaderHash
  , decodeByronRegularBlock
  , decodeByronRegularHeader
  , encodeByronBlock
  , encodeByronBoundaryHeader
  , encodeByronHeaderHash
  , encodeByronRegularHeader
    -- * Support for on-disk format
  , byronBinaryBlockInfo
    -- * Unsized header
  , addV1Envelope
  , decodeUnsizedHeader
  , dropV1Envelope
  , encodeUnsizedHeader
  , fakeByronBlockSizeHint
  ) where

import qualified Cardano.Chain.Block as CC
import qualified Cardano.Chain.Slotting as CC
import           Cardano.Ledger.Binary (ByteSpan, annotationBytes, byronProtVer,
                     fromByronCBOR, slice, toByronCBOR, toPlainDecoder)
import           Cardano.Ledger.Binary.Plain (Decoder, Encoding)
import qualified Codec.CBOR.Encoding as CBOR
import           Codec.Serialise (Serialise (..))
import           Control.Monad (guard)
import           Control.Monad.Except (Except, throwError)
import qualified Data.ByteString as Strict
import qualified Data.ByteString.Lazy as Lazy
import           Data.Word (Word32)
import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Byron.Ledger.Block
import           Ouroboros.Consensus.Byron.Ledger.Orphans ()
import           Ouroboros.Consensus.Storage.Common (BinaryBlockInfo (..))
import           Ouroboros.Network.SizeInBytes (SizeInBytes)

{-------------------------------------------------------------------------------
  Serialise instances

  Mostly we don't depend on Serialise, but use explicit functions instead.
-------------------------------------------------------------------------------}

instance Serialise ByronHash where
  decode :: forall s. Decoder s ByronHash
decode = Decoder s (HeaderHash ByronBlock)
Decoder s ByronHash
forall s. Decoder s (HeaderHash ByronBlock)
decodeByronHeaderHash
  encode :: ByronHash -> Encoding
encode = HeaderHash ByronBlock -> Encoding
ByronHash -> Encoding
encodeByronHeaderHash

{-------------------------------------------------------------------------------
  Type synonyms
-------------------------------------------------------------------------------}

type RawBoundaryHeader = CC.ABoundaryHeader Strict.ByteString
type RawHeader         = CC.AHeader         Strict.ByteString

{-------------------------------------------------------------------------------
  Nested contents
-------------------------------------------------------------------------------}

-- | Since the Byron header does not contain the size, we include it in the
-- nested type instead.
data instance NestedCtxt_ ByronBlock f a where
  CtxtByronRegular ::
       !SizeInBytes
    -> NestedCtxt_ ByronBlock Header RawHeader

  -- | In order to reconstruct 'Header ByronBlock' we need the 'SlotNo'
  --
  -- We could compute that using 'EpochSlots', but we don't have that available
  -- here.
  CtxtByronBoundary ::
       !SizeInBytes
    -> NestedCtxt_ ByronBlock Header (SlotNo, RawBoundaryHeader)

deriving instance Show (NestedCtxt_ ByronBlock f a)

instance SameDepIndex (NestedCtxt_ ByronBlock f) where
  sameDepIndex :: forall a b.
NestedCtxt_ ByronBlock f a
-> NestedCtxt_ ByronBlock f b -> Maybe (a :~: b)
sameDepIndex (CtxtByronRegular SizeInBytes
size) (CtxtByronRegular SizeInBytes
size') = do
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (SizeInBytes
size SizeInBytes -> SizeInBytes -> Bool
forall a. Eq a => a -> a -> Bool
== SizeInBytes
size')
      (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
  sameDepIndex (CtxtByronBoundary SizeInBytes
size) (CtxtByronBoundary SizeInBytes
size') = do
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (SizeInBytes
size SizeInBytes -> SizeInBytes -> Bool
forall a. Eq a => a -> a -> Bool
== SizeInBytes
size')
      (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
  sameDepIndex NestedCtxt_ ByronBlock f a
_ NestedCtxt_ ByronBlock f b
_ =
      Maybe (a :~: b)
forall a. Maybe a
Nothing

instance HasNestedContent Header ByronBlock where
  unnest :: Header ByronBlock -> DepPair (NestedCtxt Header ByronBlock)
unnest Header ByronBlock
hdr = case Header ByronBlock -> ABlockOrBoundaryHdr ByteString
byronHeaderRaw Header ByronBlock
hdr of
      CC.ABOBBoundaryHdr RawBoundaryHeader
h -> NestedCtxt Header ByronBlock (SlotNo, RawBoundaryHeader)
-> (SlotNo, RawBoundaryHeader)
-> DepPair (NestedCtxt Header ByronBlock)
forall (f :: * -> *) a. f a -> a -> DepPair f
DepPair (NestedCtxt_ ByronBlock Header (SlotNo, RawBoundaryHeader)
-> NestedCtxt Header ByronBlock (SlotNo, RawBoundaryHeader)
forall (f :: * -> *) blk a.
NestedCtxt_ blk f a -> NestedCtxt f blk a
NestedCtxt (SizeInBytes
-> NestedCtxt_ ByronBlock Header (SlotNo, RawBoundaryHeader)
CtxtByronBoundary SizeInBytes
blockSize)) (SlotNo
slotNo, RawBoundaryHeader
h)
      CC.ABOBBlockHdr    AHeader ByteString
h -> NestedCtxt Header ByronBlock (AHeader ByteString)
-> AHeader ByteString -> DepPair (NestedCtxt Header ByronBlock)
forall (f :: * -> *) a. f a -> a -> DepPair f
DepPair (NestedCtxt_ ByronBlock Header (AHeader ByteString)
-> NestedCtxt Header ByronBlock (AHeader ByteString)
forall (f :: * -> *) blk a.
NestedCtxt_ blk f a -> NestedCtxt f blk a
NestedCtxt (SizeInBytes -> NestedCtxt_ ByronBlock Header (AHeader ByteString)
CtxtByronRegular  SizeInBytes
blockSize)) AHeader ByteString
h
    where
      blockSize :: SizeInBytes
blockSize = Header ByronBlock -> SizeInBytes
byronHeaderBlockSizeHint Header ByronBlock
hdr
      slotNo :: SlotNo
slotNo    = Header ByronBlock -> SlotNo
byronHeaderSlotNo        Header ByronBlock
hdr

  nest :: DepPair (NestedCtxt Header ByronBlock) -> Header ByronBlock
nest = \case
      DepPair (NestedCtxt (CtxtByronBoundary SizeInBytes
blockSize)) (SlotNo
slotNo, RawBoundaryHeader
h) ->
        SlotNo -> RawBoundaryHeader -> SizeInBytes -> Header ByronBlock
mkBoundaryByronHeader SlotNo
slotNo RawBoundaryHeader
h SizeInBytes
blockSize
      DepPair (NestedCtxt (CtxtByronRegular SizeInBytes
blockSize)) a
h ->
        AHeader ByteString -> SizeInBytes -> Header ByronBlock
mkRegularByronHeader a
AHeader ByteString
h SizeInBytes
blockSize

{-------------------------------------------------------------------------------
  Serialisation
-------------------------------------------------------------------------------}

-- | The Byron block encoding overhead size in bytes.
--
-- This encompasses the overhead in bytes for everything that is encoded
-- within a Byron block, excluding the actual generalized transactions
-- (transactions, delegation certificates, update votes, and update
-- proposals).
byronBlockEncodingOverhead :: Word32
byronBlockEncodingOverhead :: Word32
byronBlockEncodingOverhead =
    Word32
blockHeaderOverhead Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
blockBodyOverhead Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
safetyMargin
  where
    -- The maximum block header size.
    blockHeaderOverhead :: Word32
blockHeaderOverhead = Word32
650

    -- The block body overhead excluding the actual generalized transactions.
    blockBodyOverhead :: Word32
blockBodyOverhead = Word32
1 {- ABody: encodeListLen 4 -}
                      Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
2 {- TxPayload: list -}
                      Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1 {- SscPayload: encodeListLen 2 -}
                      Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1 {- SscPayload: Word8 -}
                      Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1 {- SscPayload: mempty :: Set () -}
                      Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
2 {- Delegation.Payload: list -}
                      Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1 {- Update.Payload: encodeListLen 2 -}
                      Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1 {- Update.Payload: Maybe AProposal -}
                      Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
2 {- Update.Payload: list of AVote -}

    -- Just for safety.
    safetyMargin :: Word32
safetyMargin = Word32
1024

encodeByronHeaderHash :: HeaderHash ByronBlock -> Encoding
encodeByronHeaderHash :: HeaderHash ByronBlock -> Encoding
encodeByronHeaderHash = HeaderHash ByronBlock -> Encoding
ByronHash -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR

decodeByronHeaderHash :: Decoder s (HeaderHash ByronBlock)
decodeByronHeaderHash :: forall s. Decoder s (HeaderHash ByronBlock)
decodeByronHeaderHash = Decoder s (HeaderHash ByronBlock)
Decoder s ByronHash
forall a s. DecCBOR a => Decoder s a
fromByronCBOR

-- | Encode a block
--
-- Should be backwards compatible with legacy (cardano-sl) nodes.
--
-- Implementation note: the decoder uses 'CC.decCBORABlockOrBoundary', which
-- has inverse 'CC.encCBORABlockOrBoundary'. This encoder is intended to be
-- binary compatible with 'CC.encCBORABlockOrBoundary', but does not use it and
-- instead takes advantage of the annotations (using 'encodePreEncoded').
encodeByronBlock :: ByronBlock -> CBOR.Encoding
encodeByronBlock :: ByronBlock -> Encoding
encodeByronBlock ByronBlock
blk = [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat [
      Word -> Encoding
CBOR.encodeListLen Word
2
    , case ByronBlock -> ABlockOrBoundary ByteString
byronBlockRaw ByronBlock
blk of
        CC.ABOBBoundary ABoundaryBlock ByteString
b -> [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat [
            Word -> Encoding
CBOR.encodeWord Word
0
          , ByteString -> Encoding
CBOR.encodePreEncoded (ByteString -> Encoding) -> ByteString -> Encoding
forall a b. (a -> b) -> a -> b
$ ABoundaryBlock ByteString -> ByteString
forall a. ABoundaryBlock a -> a
CC.boundaryAnnotation ABoundaryBlock ByteString
b
          ]
        CC.ABOBBlock ABlock ByteString
b -> [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat [
            Word -> Encoding
CBOR.encodeWord Word
1
          , ByteString -> Encoding
CBOR.encodePreEncoded (ByteString -> Encoding) -> ByteString -> Encoding
forall a b. (a -> b) -> a -> b
$ ABlock ByteString -> ByteString
forall a. ABlock a -> a
CC.blockAnnotation ABlock ByteString
b
          ]
    ]

-- | Inverse of 'encodeByronBlock'
decodeByronBlock :: CC.EpochSlots -> Decoder s (Lazy.ByteString -> ByronBlock)
decodeByronBlock :: forall s. EpochSlots -> Decoder s (ByteString -> ByronBlock)
decodeByronBlock EpochSlots
epochSlots =
    Version
-> Decoder s (ByteString -> ByronBlock)
-> Decoder s (ByteString -> ByronBlock)
forall s a. Version -> Decoder s a -> Decoder s a
toPlainDecoder Version
byronProtVer (Decoder s (ByteString -> ByronBlock)
 -> Decoder s (ByteString -> ByronBlock))
-> Decoder s (ByteString -> ByronBlock)
-> Decoder s (ByteString -> ByronBlock)
forall a b. (a -> b) -> a -> b
$
    (ByteString -> ABlockOrBoundary ByteSpan -> ByronBlock)
-> ABlockOrBoundary ByteSpan -> ByteString -> ByronBlock
forall a b c. (a -> b -> c) -> b -> a -> c
flip (\ByteString
bs -> EpochSlots -> ABlockOrBoundary ByteString -> ByronBlock
mkByronBlock EpochSlots
epochSlots
               (ABlockOrBoundary ByteString -> ByronBlock)
-> (ABlockOrBoundary ByteSpan -> ABlockOrBoundary ByteString)
-> ABlockOrBoundary ByteSpan
-> ByronBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString
-> ABlockOrBoundary ByteSpan -> ABlockOrBoundary ByteString
forall (f :: * -> *).
Functor f =>
ByteString -> f ByteSpan -> f ByteString
annotationBytes ByteString
bs)
    (ABlockOrBoundary ByteSpan -> ByteString -> ByronBlock)
-> Decoder s (ABlockOrBoundary ByteSpan)
-> Decoder s (ByteString -> ByronBlock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EpochSlots -> Decoder s (ABlockOrBoundary ByteSpan)
forall s. EpochSlots -> Decoder s (ABlockOrBoundary ByteSpan)
CC.decCBORABlockOrBoundary EpochSlots
epochSlots

-- | Decoder for a regular (non-EBB) Byron block.
--
-- PRECONDITION: the 'Lazy.ByteString' given as argument to the decoder is the
-- same as the one that is decoded.
--
-- This is a wrapper for 'CC.decCBORABlock'.
--
-- Use 'decodeByronBlock' when you can, this function is provided for use by
-- the hard-fork combinator.
decodeByronRegularBlock :: CC.EpochSlots
                        -> Decoder s (Lazy.ByteString -> ByronBlock)
decodeByronRegularBlock :: forall s. EpochSlots -> Decoder s (ByteString -> ByronBlock)
decodeByronRegularBlock EpochSlots
epochSlots =
    Version
-> Decoder s (ByteString -> ByronBlock)
-> Decoder s (ByteString -> ByronBlock)
forall s a. Version -> Decoder s a -> Decoder s a
toPlainDecoder Version
byronProtVer (Decoder s (ByteString -> ByronBlock)
 -> Decoder s (ByteString -> ByronBlock))
-> Decoder s (ByteString -> ByronBlock)
-> Decoder s (ByteString -> ByronBlock)
forall a b. (a -> b) -> a -> b
$
    (ByteString -> ABlock ByteSpan -> ByronBlock)
-> ABlock ByteSpan -> ByteString -> ByronBlock
forall a b c. (a -> b -> c) -> b -> a -> c
flip (\ByteString
bs -> EpochSlots -> ABlockOrBoundary ByteString -> ByronBlock
mkByronBlock EpochSlots
epochSlots
               (ABlockOrBoundary ByteString -> ByronBlock)
-> (ABlock ByteSpan -> ABlockOrBoundary ByteString)
-> ABlock ByteSpan
-> ByronBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString
-> ABlockOrBoundary ByteSpan -> ABlockOrBoundary ByteString
forall (f :: * -> *).
Functor f =>
ByteString -> f ByteSpan -> f ByteString
annotationBytes ByteString
bs
               (ABlockOrBoundary ByteSpan -> ABlockOrBoundary ByteString)
-> (ABlock ByteSpan -> ABlockOrBoundary ByteSpan)
-> ABlock ByteSpan
-> ABlockOrBoundary ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ABlock ByteSpan -> ABlockOrBoundary ByteSpan
forall a. ABlock a -> ABlockOrBoundary a
CC.ABOBBlock)
    (ABlock ByteSpan -> ByteString -> ByronBlock)
-> Decoder s (ABlock ByteSpan)
-> Decoder s (ByteString -> ByronBlock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EpochSlots -> Decoder s (ABlock ByteSpan)
forall s. EpochSlots -> Decoder s (ABlock ByteSpan)
CC.decCBORABlock EpochSlots
epochSlots

-- | Decoder for a boundary Byron block.
--
-- PRECONDITION: the 'Lazy.ByteString' given as argument to the decoder is the
-- same as the one that is decoded.
--
-- This is a wrapper for 'CC.decCBORABoundaryBlock'.
--
-- Use 'decodeByronBlock' when you can, this function is provided for use by
-- the hard-fork combinator.
decodeByronBoundaryBlock :: CC.EpochSlots
                         -> Decoder s (Lazy.ByteString -> ByronBlock)
decodeByronBoundaryBlock :: forall s. EpochSlots -> Decoder s (ByteString -> ByronBlock)
decodeByronBoundaryBlock EpochSlots
epochSlots =
    Version
-> Decoder s (ByteString -> ByronBlock)
-> Decoder s (ByteString -> ByronBlock)
forall s a. Version -> Decoder s a -> Decoder s a
toPlainDecoder Version
byronProtVer (Decoder s (ByteString -> ByronBlock)
 -> Decoder s (ByteString -> ByronBlock))
-> Decoder s (ByteString -> ByronBlock)
-> Decoder s (ByteString -> ByronBlock)
forall a b. (a -> b) -> a -> b
$
    (ByteString -> ABoundaryBlock ByteSpan -> ByronBlock)
-> ABoundaryBlock ByteSpan -> ByteString -> ByronBlock
forall a b c. (a -> b -> c) -> b -> a -> c
flip (\ByteString
bs -> EpochSlots -> ABlockOrBoundary ByteString -> ByronBlock
mkByronBlock EpochSlots
epochSlots
               (ABlockOrBoundary ByteString -> ByronBlock)
-> (ABoundaryBlock ByteSpan -> ABlockOrBoundary ByteString)
-> ABoundaryBlock ByteSpan
-> ByronBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString
-> ABlockOrBoundary ByteSpan -> ABlockOrBoundary ByteString
forall (f :: * -> *).
Functor f =>
ByteString -> f ByteSpan -> f ByteString
annotationBytes ByteString
bs
               (ABlockOrBoundary ByteSpan -> ABlockOrBoundary ByteString)
-> (ABoundaryBlock ByteSpan -> ABlockOrBoundary ByteSpan)
-> ABoundaryBlock ByteSpan
-> ABlockOrBoundary ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ABoundaryBlock ByteSpan -> ABlockOrBoundary ByteSpan
forall a. ABoundaryBlock a -> ABlockOrBoundary a
CC.ABOBBoundary)
    (ABoundaryBlock ByteSpan -> ByteString -> ByronBlock)
-> Decoder s (ABoundaryBlock ByteSpan)
-> Decoder s (ByteString -> ByronBlock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (ABoundaryBlock ByteSpan)
forall s. Decoder s (ABoundaryBlock ByteSpan)
CC.decCBORABoundaryBlock

-- | Encodes a raw Byron header /without/ a tag indicating whether it's a
-- regular header or an EBB header.
--
-- Uses the annotation, so cheap.
encodeByronRegularHeader :: RawHeader -> CBOR.Encoding
encodeByronRegularHeader :: AHeader ByteString -> Encoding
encodeByronRegularHeader = Encoding -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR (Encoding -> Encoding)
-> (AHeader ByteString -> Encoding)
-> AHeader ByteString
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Encoding
CBOR.encodePreEncoded (ByteString -> Encoding)
-> (AHeader ByteString -> ByteString)
-> AHeader ByteString
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AHeader ByteString -> ByteString
forall a. AHeader a -> a
CC.headerAnnotation

-- | Inverse of 'encodeByronRegularHeader'
decodeByronRegularHeader ::
     CC.EpochSlots
  -> Decoder s (Lazy.ByteString -> RawHeader)
decodeByronRegularHeader :: forall s.
EpochSlots -> Decoder s (ByteString -> AHeader ByteString)
decodeByronRegularHeader EpochSlots
epochSlots =
    Version
-> Decoder s (ByteString -> AHeader ByteString)
-> Decoder s (ByteString -> AHeader ByteString)
forall s a. Version -> Decoder s a -> Decoder s a
toPlainDecoder Version
byronProtVer (Decoder s (ByteString -> AHeader ByteString)
 -> Decoder s (ByteString -> AHeader ByteString))
-> Decoder s (ByteString -> AHeader ByteString)
-> Decoder s (ByteString -> AHeader ByteString)
forall a b. (a -> b) -> a -> b
$
    (ByteString -> AHeader ByteSpan -> AHeader ByteString)
-> AHeader ByteSpan -> ByteString -> AHeader ByteString
forall a b c. (a -> b -> c) -> b -> a -> c
flip ByteString -> AHeader ByteSpan -> AHeader ByteString
forall (f :: * -> *).
Functor f =>
ByteString -> f ByteSpan -> f ByteString
annotationBytes (AHeader ByteSpan -> ByteString -> AHeader ByteString)
-> Decoder s (AHeader ByteSpan)
-> Decoder s (ByteString -> AHeader ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EpochSlots -> Decoder s (AHeader ByteSpan)
forall s. EpochSlots -> Decoder s (AHeader ByteSpan)
CC.decCBORAHeader EpochSlots
epochSlots

-- | Encodes a raw Byron EBB header /without/ a tag indicating whether it's a
-- regular header or an EBB header.
--
-- Uses the annotation, so cheap.
encodeByronBoundaryHeader :: RawBoundaryHeader -> CBOR.Encoding
encodeByronBoundaryHeader :: RawBoundaryHeader -> Encoding
encodeByronBoundaryHeader = Encoding -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR (Encoding -> Encoding)
-> (RawBoundaryHeader -> Encoding) -> RawBoundaryHeader -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Encoding
CBOR.encodePreEncoded (ByteString -> Encoding)
-> (RawBoundaryHeader -> ByteString)
-> RawBoundaryHeader
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawBoundaryHeader -> ByteString
forall a. ABoundaryHeader a -> a
CC.boundaryHeaderAnnotation

-- | Inverse of 'encodeByronBoundaryHeader'
decodeByronBoundaryHeader :: Decoder s (Lazy.ByteString -> RawBoundaryHeader)
decodeByronBoundaryHeader :: forall s. Decoder s (ByteString -> RawBoundaryHeader)
decodeByronBoundaryHeader =
    Version
-> Decoder s (ByteString -> RawBoundaryHeader)
-> Decoder s (ByteString -> RawBoundaryHeader)
forall s a. Version -> Decoder s a -> Decoder s a
toPlainDecoder Version
byronProtVer (Decoder s (ByteString -> RawBoundaryHeader)
 -> Decoder s (ByteString -> RawBoundaryHeader))
-> Decoder s (ByteString -> RawBoundaryHeader)
-> Decoder s (ByteString -> RawBoundaryHeader)
forall a b. (a -> b) -> a -> b
$
    (ByteString -> ABoundaryHeader ByteSpan -> RawBoundaryHeader)
-> ABoundaryHeader ByteSpan -> ByteString -> RawBoundaryHeader
forall a b c. (a -> b -> c) -> b -> a -> c
flip ByteString -> ABoundaryHeader ByteSpan -> RawBoundaryHeader
forall (f :: * -> *).
Functor f =>
ByteString -> f ByteSpan -> f ByteString
annotationBytes (ABoundaryHeader ByteSpan -> ByteString -> RawBoundaryHeader)
-> Decoder s (ABoundaryHeader ByteSpan)
-> Decoder s (ByteString -> RawBoundaryHeader)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (ABoundaryHeader ByteSpan)
forall s. Decoder s (ABoundaryHeader ByteSpan)
CC.decCBORABoundaryHeader

-- | The 'BinaryBlockInfo' of the given 'ByronBlock'.
--
-- NOTE: the bytestring obtained by slicing the serialised block using the
-- header offset and size will correspond to the /header annotation/, but not
-- to the serialised header, as we add an envelope ('encodeListLen' + tag)
-- around a header in 'encodeByronHeader'. This envelope must thus still be
-- added to the sliced bytestring before it can be deserialised using
-- 'decodeByronHeader'.
byronBinaryBlockInfo :: ByronBlock -> BinaryBlockInfo
byronBinaryBlockInfo :: ByronBlock -> BinaryBlockInfo
byronBinaryBlockInfo ByronBlock
blk = BinaryBlockInfo
    { headerOffset :: Word16
headerOffset = Word16
1 {- 'encodeListLen' of the outer 'Either' envelope -}
                   Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
1 {- the tag -}
                   Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
1 {- 'encodeListLen' of the block: header + body + ...  -}
      -- Compute the length of the annotated header
    , headerSize :: Word16
headerSize   = Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
Strict.length (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ case ByronBlock -> ABlockOrBoundary ByteString
byronBlockRaw ByronBlock
blk of
        CC.ABOBBoundary ABoundaryBlock ByteString
b -> RawBoundaryHeader -> ByteString
forall a. ABoundaryHeader a -> a
CC.boundaryHeaderAnnotation (RawBoundaryHeader -> ByteString)
-> RawBoundaryHeader -> ByteString
forall a b. (a -> b) -> a -> b
$ ABoundaryBlock ByteString -> RawBoundaryHeader
forall a. ABoundaryBlock a -> ABoundaryHeader a
CC.boundaryHeader ABoundaryBlock ByteString
b
        CC.ABOBBlock    ABlock ByteString
b -> AHeader ByteString -> ByteString
forall a. AHeader a -> a
CC.headerAnnotation         (AHeader ByteString -> ByteString)
-> AHeader ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ABlock ByteString -> AHeader ByteString
forall a. ABlock a -> AHeader a
CC.blockHeader    ABlock ByteString
b
    }

{-------------------------------------------------------------------------------
  V1 envelope: unsized header

  These are auxiliary functions for encoding/decoding the Byron header.
-------------------------------------------------------------------------------}

-- | A 'CC.ABlockOrBoundary' is a CBOR 2-tuple of a 'Word' (0 = EBB, 1 =
-- regular block) and block/ebb payload. This function returns the bytes that
-- should be prepended to the payload, i.e., the byte indicating it's a CBOR
-- 2-tuple and the 'Word' indicating whether its an EBB or regular block.
isEbbEnvelope :: IsEBB -> Lazy.ByteString
isEbbEnvelope :: IsEBB -> ByteString
isEbbEnvelope = \case
  IsEBB
IsEBB    -> ByteString
"\130\NUL"
  IsEBB
IsNotEBB -> ByteString
"\130\SOH"

addV1Envelope ::
     (SomeSecond (NestedCtxt Header) ByronBlock, Lazy.ByteString)
  -> Lazy.ByteString
addV1Envelope :: (SomeSecond (NestedCtxt Header) ByronBlock, ByteString)
-> ByteString
addV1Envelope (SomeSecond (NestedCtxt NestedCtxt_ ByronBlock Header b
ctxt), ByteString
bs) = ByteString
isEbbTag ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
bs
  where
    isEbbTag :: ByteString
isEbbTag = case NestedCtxt_ ByronBlock Header b
ctxt of
      CtxtByronBoundary {} -> IsEBB -> ByteString
isEbbEnvelope IsEBB
IsEBB
      CtxtByronRegular  {} -> IsEBB -> ByteString
isEbbEnvelope IsEBB
IsNotEBB

-- | Drop the V1 EBB-or-regular-header envelope and reconstruct the context.
-- Since we don't know the block size, use 'fakeByronBlockSizeHint'.
dropV1Envelope ::
     Lazy.ByteString
  -> Except String (SomeSecond (NestedCtxt Header) ByronBlock, Lazy.ByteString)
dropV1Envelope :: ByteString
-> Except
     String (SomeSecond (NestedCtxt Header) ByronBlock, ByteString)
dropV1Envelope ByteString
bs = case Int64 -> ByteString -> (ByteString, ByteString)
Lazy.splitAt Int64
2 ByteString
bs of
    (ByteString
prefix, ByteString
suffix)
      | ByteString
prefix ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== IsEBB -> ByteString
isEbbEnvelope IsEBB
IsEBB
      -> (SomeSecond (NestedCtxt Header) ByronBlock, ByteString)
-> Except
     String (SomeSecond (NestedCtxt Header) ByronBlock, ByteString)
forall a. a -> ExceptT String Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ( NestedCtxt Header ByronBlock (SlotNo, RawBoundaryHeader)
-> SomeSecond (NestedCtxt Header) ByronBlock
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond (NestedCtxt Header ByronBlock (SlotNo, RawBoundaryHeader)
 -> SomeSecond (NestedCtxt Header) ByronBlock)
-> (NestedCtxt_ ByronBlock Header (SlotNo, RawBoundaryHeader)
    -> NestedCtxt Header ByronBlock (SlotNo, RawBoundaryHeader))
-> NestedCtxt_ ByronBlock Header (SlotNo, RawBoundaryHeader)
-> SomeSecond (NestedCtxt Header) ByronBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NestedCtxt_ ByronBlock Header (SlotNo, RawBoundaryHeader)
-> NestedCtxt Header ByronBlock (SlotNo, RawBoundaryHeader)
forall (f :: * -> *) blk a.
NestedCtxt_ blk f a -> NestedCtxt f blk a
NestedCtxt (NestedCtxt_ ByronBlock Header (SlotNo, RawBoundaryHeader)
 -> SomeSecond (NestedCtxt Header) ByronBlock)
-> NestedCtxt_ ByronBlock Header (SlotNo, RawBoundaryHeader)
-> SomeSecond (NestedCtxt Header) ByronBlock
forall a b. (a -> b) -> a -> b
$ SizeInBytes
-> NestedCtxt_ ByronBlock Header (SlotNo, RawBoundaryHeader)
CtxtByronBoundary SizeInBytes
fakeByronBlockSizeHint
                , ByteString
suffix
                )
      | ByteString
prefix ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== IsEBB -> ByteString
isEbbEnvelope IsEBB
IsNotEBB
      -> (SomeSecond (NestedCtxt Header) ByronBlock, ByteString)
-> Except
     String (SomeSecond (NestedCtxt Header) ByronBlock, ByteString)
forall a. a -> ExceptT String Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ( NestedCtxt Header ByronBlock (AHeader ByteString)
-> SomeSecond (NestedCtxt Header) ByronBlock
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond (NestedCtxt Header ByronBlock (AHeader ByteString)
 -> SomeSecond (NestedCtxt Header) ByronBlock)
-> (NestedCtxt_ ByronBlock Header (AHeader ByteString)
    -> NestedCtxt Header ByronBlock (AHeader ByteString))
-> NestedCtxt_ ByronBlock Header (AHeader ByteString)
-> SomeSecond (NestedCtxt Header) ByronBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NestedCtxt_ ByronBlock Header (AHeader ByteString)
-> NestedCtxt Header ByronBlock (AHeader ByteString)
forall (f :: * -> *) blk a.
NestedCtxt_ blk f a -> NestedCtxt f blk a
NestedCtxt (NestedCtxt_ ByronBlock Header (AHeader ByteString)
 -> SomeSecond (NestedCtxt Header) ByronBlock)
-> NestedCtxt_ ByronBlock Header (AHeader ByteString)
-> SomeSecond (NestedCtxt Header) ByronBlock
forall a b. (a -> b) -> a -> b
$ SizeInBytes -> NestedCtxt_ ByronBlock Header (AHeader ByteString)
CtxtByronRegular SizeInBytes
fakeByronBlockSizeHint
                , ByteString
suffix
                )
      | Bool
otherwise
      -> String
-> Except
     String (SomeSecond (NestedCtxt Header) ByronBlock, ByteString)
forall a. String -> ExceptT String Identity a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"decodeUnsized: invalid prefix"

-- | Fake size (used in compatibility mode)
fakeByronBlockSizeHint :: SizeInBytes
fakeByronBlockSizeHint :: SizeInBytes
fakeByronBlockSizeHint = SizeInBytes
2000

-- | Encode an unsized header
--
-- Does /not/ have to backwards compatible with legacy (cardano-sl) nodes
-- (which never send or store these headers), but should be inverse to
-- 'decodeSizedHeader', and moreover uses 'decCBORABlockOrBoundaryHdr' from
-- cardano-ledger-byron, and so we don't have too much choice in this encoder.
encodeUnsizedHeader :: UnsizedHeader -> Encoding
encodeUnsizedHeader :: UnsizedHeader -> Encoding
encodeUnsizedHeader (UnsizedHeader ABlockOrBoundaryHdr ByteString
raw SlotNo
_ ByronHash
_) = Encoding -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR (Encoding -> Encoding) -> Encoding -> Encoding
forall a b. (a -> b) -> a -> b
$ ABlockOrBoundaryHdr ByteString -> Encoding
CC.encCBORABlockOrBoundaryHdr ABlockOrBoundaryHdr ByteString
raw

-- | Inverse of 'encodeSizedHeader'
decodeUnsizedHeader :: CC.EpochSlots
                    -> Decoder s (Lazy.ByteString -> UnsizedHeader)
decodeUnsizedHeader :: forall s. EpochSlots -> Decoder s (ByteString -> UnsizedHeader)
decodeUnsizedHeader EpochSlots
epochSlots =
    Version
-> Decoder s (ByteString -> UnsizedHeader)
-> Decoder s (ByteString -> UnsizedHeader)
forall s a. Version -> Decoder s a -> Decoder s a
toPlainDecoder Version
byronProtVer (Decoder s (ByteString -> UnsizedHeader)
 -> Decoder s (ByteString -> UnsizedHeader))
-> Decoder s (ByteString -> UnsizedHeader)
-> Decoder s (ByteString -> UnsizedHeader)
forall a b. (a -> b) -> a -> b
$
    ABlockOrBoundaryHdr ByteSpan -> ByteString -> UnsizedHeader
fillInByteString (ABlockOrBoundaryHdr ByteSpan -> ByteString -> UnsizedHeader)
-> Decoder s (ABlockOrBoundaryHdr ByteSpan)
-> Decoder s (ByteString -> UnsizedHeader)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EpochSlots -> Decoder s (ABlockOrBoundaryHdr ByteSpan)
forall s. EpochSlots -> Decoder s (ABlockOrBoundaryHdr ByteSpan)
CC.decCBORABlockOrBoundaryHdr EpochSlots
epochSlots
  where
    fillInByteString :: CC.ABlockOrBoundaryHdr ByteSpan
                     -> Lazy.ByteString
                     -> UnsizedHeader
    fillInByteString :: ABlockOrBoundaryHdr ByteSpan -> ByteString -> UnsizedHeader
fillInByteString ABlockOrBoundaryHdr ByteSpan
it ByteString
theBytes = EpochSlots -> ABlockOrBoundaryHdr ByteString -> UnsizedHeader
mkUnsizedHeader EpochSlots
epochSlots (ABlockOrBoundaryHdr ByteString -> UnsizedHeader)
-> ABlockOrBoundaryHdr ByteString -> UnsizedHeader
forall a b. (a -> b) -> a -> b
$
      ByteString -> ByteString
Lazy.toStrict (ByteString -> ByteString)
-> (ByteSpan -> ByteString) -> ByteSpan -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteSpan -> ByteString
slice ByteString
theBytes (ByteSpan -> ByteString)
-> ABlockOrBoundaryHdr ByteSpan -> ABlockOrBoundaryHdr ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ABlockOrBoundaryHdr ByteSpan
it