{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

{-# OPTIONS_GHC -Wno-orphans #-}

module Ouroboros.Consensus.Byron.Node.Serialisation () where

import qualified Cardano.Chain.Block as CC
import qualified Cardano.Chain.Byron.API as CC
import           Cardano.Ledger.Binary (fromByronCBOR, toByronCBOR)
import           Cardano.Ledger.Binary.Plain
import qualified Codec.CBOR.Decoding as CBOR
import qualified Codec.CBOR.Encoding as CBOR
import           Codec.Serialise (decode, encode)
import           Control.Monad.Except
import qualified Data.ByteString.Lazy as Lazy
import qualified Data.ByteString.Short as Short
import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Byron.Ledger
import           Ouroboros.Consensus.Byron.Ledger.Conversions
import           Ouroboros.Consensus.Byron.Protocol
import           Ouroboros.Consensus.HeaderValidation
import           Ouroboros.Consensus.Ledger.SupportsMempool (GenTxId)
import           Ouroboros.Consensus.Node.Run
import           Ouroboros.Consensus.Node.Serialisation
import           Ouroboros.Consensus.Protocol.PBFT.State (PBftState)
import           Ouroboros.Consensus.Storage.Serialisation
import           Ouroboros.Network.Block (Serialised (..), unwrapCBORinCBOR,
                     wrapCBORinCBOR)
import           Ouroboros.Network.SizeInBytes (SizeInBytes (..))

{-------------------------------------------------------------------------------
  EncodeDisk & DecodeDisk
-------------------------------------------------------------------------------}

instance HasBinaryBlockInfo ByronBlock where
  getBinaryBlockInfo :: ByronBlock -> BinaryBlockInfo
getBinaryBlockInfo = ByronBlock -> BinaryBlockInfo
byronBinaryBlockInfo

instance SerialiseDiskConstraints ByronBlock

instance EncodeDisk ByronBlock ByronBlock where
  encodeDisk :: CodecConfig ByronBlock -> ByronBlock -> Encoding
encodeDisk CodecConfig ByronBlock
_ = ByronBlock -> Encoding
encodeByronBlock
instance DecodeDisk ByronBlock (Lazy.ByteString -> ByronBlock) where
  decodeDisk :: CodecConfig ByronBlock
-> forall s. Decoder s (ByteString -> ByronBlock)
decodeDisk CodecConfig ByronBlock
ccfg = EpochSlots -> Decoder s (ByteString -> ByronBlock)
forall s. EpochSlots -> Decoder s (ByteString -> ByronBlock)
decodeByronBlock (CodecConfig ByronBlock -> EpochSlots
getByronEpochSlots CodecConfig ByronBlock
ccfg)

instance EncodeDisk ByronBlock (LedgerState ByronBlock) where
  encodeDisk :: CodecConfig ByronBlock -> LedgerState ByronBlock -> Encoding
encodeDisk CodecConfig ByronBlock
_ = LedgerState ByronBlock -> Encoding
encodeByronLedgerState
instance DecodeDisk ByronBlock (LedgerState ByronBlock) where
  decodeDisk :: CodecConfig ByronBlock
-> forall s. Decoder s (LedgerState ByronBlock)
decodeDisk CodecConfig ByronBlock
_ = Decoder s (LedgerState ByronBlock)
forall s. Decoder s (LedgerState ByronBlock)
decodeByronLedgerState

-- | @'ChainDepState' ('BlockProtocol' 'ByronBlock')@
instance EncodeDisk ByronBlock (PBftState PBftByronCrypto) where
  encodeDisk :: CodecConfig ByronBlock -> PBftState PBftByronCrypto -> Encoding
encodeDisk CodecConfig ByronBlock
_ = ChainDepState (BlockProtocol ByronBlock) -> Encoding
PBftState PBftByronCrypto -> Encoding
encodeByronChainDepState
-- | @'ChainDepState' ('BlockProtocol' 'ByronBlock')@
instance DecodeDisk ByronBlock (PBftState PBftByronCrypto) where
  decodeDisk :: CodecConfig ByronBlock
-> forall s. Decoder s (PBftState PBftByronCrypto)
decodeDisk CodecConfig ByronBlock
_ = Decoder s (ChainDepState (BlockProtocol ByronBlock))
Decoder s (PBftState PBftByronCrypto)
forall s. Decoder s (ChainDepState (BlockProtocol ByronBlock))
decodeByronChainDepState

instance EncodeDisk ByronBlock (AnnTip ByronBlock) where
  encodeDisk :: CodecConfig ByronBlock -> AnnTip ByronBlock -> Encoding
encodeDisk CodecConfig ByronBlock
_ = AnnTip ByronBlock -> Encoding
encodeByronAnnTip
instance DecodeDisk ByronBlock (AnnTip ByronBlock) where
  decodeDisk :: CodecConfig ByronBlock -> forall s. Decoder s (AnnTip ByronBlock)
decodeDisk CodecConfig ByronBlock
_ = Decoder s (AnnTip ByronBlock)
forall s. Decoder s (AnnTip ByronBlock)
decodeByronAnnTip

{-------------------------------------------------------------------------------
  SerialiseNodeToNode
-------------------------------------------------------------------------------}

instance SerialiseNodeToNodeConstraints ByronBlock where
  estimateBlockSize :: Header ByronBlock -> SizeInBytes
estimateBlockSize = Header ByronBlock -> SizeInBytes
byronHeaderBlockSizeHint

-- | CBOR-in-CBOR for the annotation. This also makes it compatible with the
-- wrapped ('Serialised') variant.
instance SerialiseNodeToNode ByronBlock ByronBlock where
  encodeNodeToNode :: CodecConfig ByronBlock
-> BlockNodeToNodeVersion ByronBlock -> ByronBlock -> Encoding
encodeNodeToNode CodecConfig ByronBlock
_    BlockNodeToNodeVersion ByronBlock
_ = (ByronBlock -> Encoding) -> ByronBlock -> Encoding
forall a. (a -> Encoding) -> a -> Encoding
wrapCBORinCBOR    ByronBlock -> Encoding
encodeByronBlock
  decodeNodeToNode :: CodecConfig ByronBlock
-> BlockNodeToNodeVersion ByronBlock
-> forall s. Decoder s ByronBlock
decodeNodeToNode CodecConfig ByronBlock
ccfg BlockNodeToNodeVersion ByronBlock
_ = (forall s. Decoder s (ByteString -> ByronBlock))
-> forall s. Decoder s ByronBlock
forall a.
(forall s. Decoder s (ByteString -> a)) -> forall s. Decoder s a
unwrapCBORinCBOR (EpochSlots -> Decoder s (ByteString -> ByronBlock)
forall s. EpochSlots -> Decoder s (ByteString -> ByronBlock)
decodeByronBlock EpochSlots
epochSlots)
    where
      epochSlots :: EpochSlots
epochSlots = CodecConfig ByronBlock -> EpochSlots
getByronEpochSlots CodecConfig ByronBlock
ccfg

instance SerialiseNodeToNode ByronBlock (Header ByronBlock) where
  encodeNodeToNode :: CodecConfig ByronBlock
-> BlockNodeToNodeVersion ByronBlock
-> Header ByronBlock
-> Encoding
encodeNodeToNode CodecConfig ByronBlock
ccfg = \case
      BlockNodeToNodeVersion ByronBlock
ByronNodeToNodeVersion
ByronNodeToNodeVersion1 ->
        (Header ByronBlock -> Encoding) -> Header ByronBlock -> Encoding
forall a. (a -> Encoding) -> a -> Encoding
wrapCBORinCBOR ((Header ByronBlock -> Encoding) -> Header ByronBlock -> Encoding)
-> (Header ByronBlock -> Encoding) -> Header ByronBlock -> Encoding
forall a b. (a -> b) -> a -> b
$
          UnsizedHeader -> Encoding
encodeUnsizedHeader (UnsizedHeader -> Encoding)
-> (Header ByronBlock -> UnsizedHeader)
-> Header ByronBlock
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnsizedHeader, SizeInBytes) -> UnsizedHeader
forall a b. (a, b) -> a
fst ((UnsizedHeader, SizeInBytes) -> UnsizedHeader)
-> (Header ByronBlock -> (UnsizedHeader, SizeInBytes))
-> Header ByronBlock
-> UnsizedHeader
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header ByronBlock -> (UnsizedHeader, SizeInBytes)
splitSizeHint
      BlockNodeToNodeVersion ByronBlock
ByronNodeToNodeVersion
ByronNodeToNodeVersion2 ->
        CodecConfig ByronBlock
-> DepPair (NestedCtxt Header ByronBlock) -> Encoding
forall blk a. EncodeDisk blk a => CodecConfig blk -> a -> Encoding
encodeDisk CodecConfig ByronBlock
ccfg (DepPair (NestedCtxt Header ByronBlock) -> Encoding)
-> (Header ByronBlock -> DepPair (NestedCtxt Header ByronBlock))
-> Header ByronBlock
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header ByronBlock -> DepPair (NestedCtxt Header ByronBlock)
forall (f :: * -> *) blk.
HasNestedContent f blk =>
f blk -> DepPair (NestedCtxt f blk)
unnest

  decodeNodeToNode :: CodecConfig ByronBlock
-> BlockNodeToNodeVersion ByronBlock
-> forall s. Decoder s (Header ByronBlock)
decodeNodeToNode CodecConfig ByronBlock
ccfg = \case
      BlockNodeToNodeVersion ByronBlock
ByronNodeToNodeVersion
ByronNodeToNodeVersion1 ->
        (forall s. Decoder s (ByteString -> Header ByronBlock))
-> forall s. Decoder s (Header ByronBlock)
forall a.
(forall s. Decoder s (ByteString -> a)) -> forall s. Decoder s a
unwrapCBORinCBOR ((forall s. Decoder s (ByteString -> Header ByronBlock))
 -> forall s. Decoder s (Header ByronBlock))
-> (forall s. Decoder s (ByteString -> Header ByronBlock))
-> forall s. Decoder s (Header ByronBlock)
forall a b. (a -> b) -> a -> b
$
              ((UnsizedHeader -> SizeInBytes -> Header ByronBlock)
-> SizeInBytes -> UnsizedHeader -> Header ByronBlock
forall a b c. (a -> b -> c) -> b -> a -> c
flip UnsizedHeader -> SizeInBytes -> Header ByronBlock
joinSizeHint SizeInBytes
fakeByronBlockSizeHint (UnsizedHeader -> Header ByronBlock)
-> (ByteString -> UnsizedHeader) -> ByteString -> Header ByronBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
.)
          ((ByteString -> UnsizedHeader) -> ByteString -> Header ByronBlock)
-> Decoder s (ByteString -> UnsizedHeader)
-> Decoder s (ByteString -> Header ByronBlock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EpochSlots -> Decoder s (ByteString -> UnsizedHeader)
forall s. EpochSlots -> Decoder s (ByteString -> UnsizedHeader)
decodeUnsizedHeader EpochSlots
epochSlots
      BlockNodeToNodeVersion ByronBlock
ByronNodeToNodeVersion
ByronNodeToNodeVersion2 ->
        DepPair (NestedCtxt Header ByronBlock) -> Header ByronBlock
forall (f :: * -> *) blk.
HasNestedContent f blk =>
DepPair (NestedCtxt f blk) -> f blk
nest (DepPair (NestedCtxt Header ByronBlock) -> Header ByronBlock)
-> Decoder s (DepPair (NestedCtxt Header ByronBlock))
-> Decoder s (Header ByronBlock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodecConfig ByronBlock
-> forall s. Decoder s (DepPair (NestedCtxt Header ByronBlock))
forall blk a.
DecodeDisk blk a =>
CodecConfig blk -> forall s. Decoder s a
decodeDisk CodecConfig ByronBlock
ccfg
    where
      epochSlots :: EpochSlots
epochSlots = CodecConfig ByronBlock -> EpochSlots
getByronEpochSlots CodecConfig ByronBlock
ccfg

-- | 'Serialised' uses CBOR-in-CBOR by default.
instance SerialiseNodeToNode ByronBlock (Serialised ByronBlock)
  -- Default instance

instance SerialiseNodeToNode ByronBlock (SerialisedHeader ByronBlock) where
  encodeNodeToNode :: CodecConfig ByronBlock
-> BlockNodeToNodeVersion ByronBlock
-> SerialisedHeader ByronBlock
-> Encoding
encodeNodeToNode CodecConfig ByronBlock
ccfg BlockNodeToNodeVersion ByronBlock
version = case BlockNodeToNodeVersion ByronBlock
version of
      -- Drop the context and add the tag, encode that using CBOR-in-CBOR
      BlockNodeToNodeVersion ByronBlock
ByronNodeToNodeVersion
ByronNodeToNodeVersion1 ->
            Serialised Any -> Encoding
forall a. Serialise a => a -> Encoding
encode
          (Serialised Any -> Encoding)
-> (SerialisedHeader ByronBlock -> Serialised Any)
-> SerialisedHeader ByronBlock
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Serialised Any
forall {k} (a :: k). ByteString -> Serialised a
Serialised
          (ByteString -> Serialised Any)
-> (SerialisedHeader ByronBlock -> ByteString)
-> SerialisedHeader ByronBlock
-> Serialised Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeSecond (NestedCtxt Header) ByronBlock, ByteString)
-> ByteString
addV1Envelope
          ((SomeSecond (NestedCtxt Header) ByronBlock, ByteString)
 -> ByteString)
-> (SerialisedHeader ByronBlock
    -> (SomeSecond (NestedCtxt Header) ByronBlock, ByteString))
-> SerialisedHeader ByronBlock
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenDepPair Serialised (NestedCtxt Header ByronBlock)
-> (SomeSecond (NestedCtxt Header) ByronBlock, ByteString)
forall (f :: * -> * -> *) blk.
GenDepPair Serialised (f blk) -> (SomeSecond f blk, ByteString)
aux
          (GenDepPair Serialised (NestedCtxt Header ByronBlock)
 -> (SomeSecond (NestedCtxt Header) ByronBlock, ByteString))
-> (SerialisedHeader ByronBlock
    -> GenDepPair Serialised (NestedCtxt Header ByronBlock))
-> SerialisedHeader ByronBlock
-> (SomeSecond (NestedCtxt Header) ByronBlock, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialisedHeader ByronBlock
-> GenDepPair Serialised (NestedCtxt Header ByronBlock)
forall blk.
SerialisedHeader blk
-> GenDepPair Serialised (NestedCtxt Header blk)
serialisedHeaderToDepPair
        where
          aux :: GenDepPair Serialised (f blk)
              -> (SomeSecond f blk, Lazy.ByteString)
          aux :: forall (f :: * -> * -> *) blk.
GenDepPair Serialised (f blk) -> (SomeSecond f blk, ByteString)
aux (GenDepPair f blk a
ix (Serialised ByteString
bytes)) = (f blk a -> SomeSecond f blk
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond f blk a
ix, ByteString
bytes)

      BlockNodeToNodeVersion ByronBlock
ByronNodeToNodeVersion
ByronNodeToNodeVersion2 -> CodecConfig ByronBlock -> SerialisedHeader ByronBlock -> Encoding
forall blk a. EncodeDisk blk a => CodecConfig blk -> a -> Encoding
encodeDisk CodecConfig ByronBlock
ccfg

  decodeNodeToNode :: CodecConfig ByronBlock
-> BlockNodeToNodeVersion ByronBlock
-> forall s. Decoder s (SerialisedHeader ByronBlock)
decodeNodeToNode CodecConfig ByronBlock
ccfg BlockNodeToNodeVersion ByronBlock
version = case BlockNodeToNodeVersion ByronBlock
version of
      BlockNodeToNodeVersion ByronBlock
ByronNodeToNodeVersion
ByronNodeToNodeVersion1 -> do
          ByteString
bs <- Serialised Any -> ByteString
forall {k} (a :: k). Serialised a -> ByteString
unSerialised (Serialised Any -> ByteString)
-> Decoder s (Serialised Any) -> Decoder s ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Serialised Any)
forall s. Decoder s (Serialised Any)
forall a s. Serialise a => Decoder s a
decode
          (String -> Decoder s (SerialisedHeader ByronBlock))
-> (GenDepPair Serialised (NestedCtxt Header ByronBlock)
    -> Decoder s (SerialisedHeader ByronBlock))
-> Either
     String (GenDepPair Serialised (NestedCtxt Header ByronBlock))
-> Decoder s (SerialisedHeader ByronBlock)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Decoder s (SerialisedHeader ByronBlock)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (SerialisedHeader ByronBlock
-> Decoder s (SerialisedHeader ByronBlock)
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (SerialisedHeader ByronBlock
 -> Decoder s (SerialisedHeader ByronBlock))
-> (GenDepPair Serialised (NestedCtxt Header ByronBlock)
    -> SerialisedHeader ByronBlock)
-> GenDepPair Serialised (NestedCtxt Header ByronBlock)
-> Decoder s (SerialisedHeader ByronBlock)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenDepPair Serialised (NestedCtxt Header ByronBlock)
-> SerialisedHeader ByronBlock
forall blk.
GenDepPair Serialised (NestedCtxt Header blk)
-> SerialisedHeader blk
SerialisedHeaderFromDepPair) (Either
   String (GenDepPair Serialised (NestedCtxt Header ByronBlock))
 -> Decoder s (SerialisedHeader ByronBlock))
-> Either
     String (GenDepPair Serialised (NestedCtxt Header ByronBlock))
-> Decoder s (SerialisedHeader ByronBlock)
forall a b. (a -> b) -> a -> b
$
            Except
  String (GenDepPair Serialised (NestedCtxt Header ByronBlock))
-> Either
     String (GenDepPair Serialised (NestedCtxt Header ByronBlock))
forall e a. Except e a -> Either e a
runExcept (Except
   String (GenDepPair Serialised (NestedCtxt Header ByronBlock))
 -> Either
      String (GenDepPair Serialised (NestedCtxt Header ByronBlock)))
-> Except
     String (GenDepPair Serialised (NestedCtxt Header ByronBlock))
-> Either
     String (GenDepPair Serialised (NestedCtxt Header ByronBlock))
forall a b. (a -> b) -> a -> b
$ (SomeSecond (NestedCtxt Header) ByronBlock, ByteString)
-> GenDepPair Serialised (NestedCtxt Header ByronBlock)
forall (f :: * -> * -> *) blk.
(SomeSecond f blk, ByteString) -> GenDepPair Serialised (f blk)
aux ((SomeSecond (NestedCtxt Header) ByronBlock, ByteString)
 -> GenDepPair Serialised (NestedCtxt Header ByronBlock))
-> ExceptT
     String
     Identity
     (SomeSecond (NestedCtxt Header) ByronBlock, ByteString)
-> Except
     String (GenDepPair Serialised (NestedCtxt Header ByronBlock))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString
-> ExceptT
     String
     Identity
     (SomeSecond (NestedCtxt Header) ByronBlock, ByteString)
dropV1Envelope ByteString
bs
        where
          aux :: (SomeSecond f blk, Lazy.ByteString)
              -> GenDepPair Serialised (f blk)
          aux :: forall (f :: * -> * -> *) blk.
(SomeSecond f blk, ByteString) -> GenDepPair Serialised (f blk)
aux (SomeSecond f blk b
ix, ByteString
bytes) = f blk b -> Serialised b -> GenDepPair Serialised (f blk)
forall (f :: * -> *) a (g :: * -> *). f a -> g a -> GenDepPair g f
GenDepPair f blk b
ix (ByteString -> Serialised b
forall {k} (a :: k). ByteString -> Serialised a
Serialised ByteString
bytes)

      BlockNodeToNodeVersion ByronBlock
ByronNodeToNodeVersion
ByronNodeToNodeVersion2 -> CodecConfig ByronBlock
-> forall s. Decoder s (SerialisedHeader ByronBlock)
forall blk a.
DecodeDisk blk a =>
CodecConfig blk -> forall s. Decoder s a
decodeDisk CodecConfig ByronBlock
ccfg

-- | No CBOR-in-CBOR, because we check for canonical encodings, which means we
-- can use the recomputed encoding for the annotation.
instance SerialiseNodeToNode ByronBlock (GenTx ByronBlock) where
  encodeNodeToNode :: CodecConfig ByronBlock
-> BlockNodeToNodeVersion ByronBlock
-> GenTx ByronBlock
-> Encoding
encodeNodeToNode CodecConfig ByronBlock
_ BlockNodeToNodeVersion ByronBlock
_ = GenTx ByronBlock -> Encoding
encodeByronGenTx
  decodeNodeToNode :: CodecConfig ByronBlock
-> BlockNodeToNodeVersion ByronBlock
-> forall s. Decoder s (GenTx ByronBlock)
decodeNodeToNode CodecConfig ByronBlock
_ BlockNodeToNodeVersion ByronBlock
_ = Decoder s (GenTx ByronBlock)
forall s. Decoder s (GenTx ByronBlock)
decodeByronGenTx

instance SerialiseNodeToNode ByronBlock (GenTxId ByronBlock) where
  encodeNodeToNode :: CodecConfig ByronBlock
-> BlockNodeToNodeVersion ByronBlock
-> GenTxId ByronBlock
-> Encoding
encodeNodeToNode CodecConfig ByronBlock
_ BlockNodeToNodeVersion ByronBlock
_ = GenTxId ByronBlock -> Encoding
encodeByronGenTxId
  decodeNodeToNode :: CodecConfig ByronBlock
-> BlockNodeToNodeVersion ByronBlock
-> forall s. Decoder s (GenTxId ByronBlock)
decodeNodeToNode CodecConfig ByronBlock
_ BlockNodeToNodeVersion ByronBlock
_ = Decoder s (GenTxId ByronBlock)
forall s. Decoder s (GenTxId ByronBlock)
decodeByronGenTxId

{-------------------------------------------------------------------------------
  SerialiseNodeToClient
-------------------------------------------------------------------------------}

instance SerialiseNodeToClientConstraints ByronBlock

-- | CBOR-in-CBOR for the annotation. This also makes it compatible with the
-- wrapped ('Serialised') variant.
instance SerialiseNodeToClient ByronBlock ByronBlock where
  encodeNodeToClient :: CodecConfig ByronBlock
-> BlockNodeToClientVersion ByronBlock -> ByronBlock -> Encoding
encodeNodeToClient CodecConfig ByronBlock
_    BlockNodeToClientVersion ByronBlock
_ = (ByronBlock -> Encoding) -> ByronBlock -> Encoding
forall a. (a -> Encoding) -> a -> Encoding
wrapCBORinCBOR    ByronBlock -> Encoding
encodeByronBlock
  decodeNodeToClient :: CodecConfig ByronBlock
-> BlockNodeToClientVersion ByronBlock
-> forall s. Decoder s ByronBlock
decodeNodeToClient CodecConfig ByronBlock
ccfg BlockNodeToClientVersion ByronBlock
_ = (forall s. Decoder s (ByteString -> ByronBlock))
-> forall s. Decoder s ByronBlock
forall a.
(forall s. Decoder s (ByteString -> a)) -> forall s. Decoder s a
unwrapCBORinCBOR (EpochSlots -> Decoder s (ByteString -> ByronBlock)
forall s. EpochSlots -> Decoder s (ByteString -> ByronBlock)
decodeByronBlock EpochSlots
epochSlots)
    where
      epochSlots :: EpochSlots
epochSlots = CodecConfig ByronBlock -> EpochSlots
getByronEpochSlots CodecConfig ByronBlock
ccfg

-- | 'Serialised' uses CBOR-in-CBOR by default.
instance SerialiseNodeToClient ByronBlock (Serialised ByronBlock)
  -- Default instance

-- | No CBOR-in-CBOR, because we check for canonical encodings, which means we
-- can use the recomputed encoding for the annotation.
instance SerialiseNodeToClient ByronBlock (GenTx ByronBlock) where
  encodeNodeToClient :: CodecConfig ByronBlock
-> BlockNodeToClientVersion ByronBlock
-> GenTx ByronBlock
-> Encoding
encodeNodeToClient CodecConfig ByronBlock
_ BlockNodeToClientVersion ByronBlock
_ = GenTx ByronBlock -> Encoding
encodeByronGenTx
  decodeNodeToClient :: CodecConfig ByronBlock
-> BlockNodeToClientVersion ByronBlock
-> forall s. Decoder s (GenTx ByronBlock)
decodeNodeToClient CodecConfig ByronBlock
_ BlockNodeToClientVersion ByronBlock
_ = Decoder s (GenTx ByronBlock)
forall s. Decoder s (GenTx ByronBlock)
decodeByronGenTx

instance SerialiseNodeToClient ByronBlock (GenTxId ByronBlock) where
  encodeNodeToClient :: CodecConfig ByronBlock
-> BlockNodeToClientVersion ByronBlock
-> GenTxId ByronBlock
-> Encoding
encodeNodeToClient CodecConfig ByronBlock
_ BlockNodeToClientVersion ByronBlock
_ = GenTxId ByronBlock -> Encoding
encodeByronGenTxId
  decodeNodeToClient :: CodecConfig ByronBlock
-> BlockNodeToClientVersion ByronBlock
-> forall s. Decoder s (GenTxId ByronBlock)
decodeNodeToClient CodecConfig ByronBlock
_ BlockNodeToClientVersion ByronBlock
_ = Decoder s (GenTxId ByronBlock)
forall s. Decoder s (GenTxId ByronBlock)
decodeByronGenTxId

instance SerialiseNodeToClient ByronBlock SlotNo where
  encodeNodeToClient :: CodecConfig ByronBlock
-> BlockNodeToClientVersion ByronBlock -> SlotNo -> Encoding
encodeNodeToClient CodecConfig ByronBlock
_ BlockNodeToClientVersion ByronBlock
_ = SlotNo -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR
  decodeNodeToClient :: CodecConfig ByronBlock
-> BlockNodeToClientVersion ByronBlock
-> forall s. Decoder s SlotNo
decodeNodeToClient CodecConfig ByronBlock
_ BlockNodeToClientVersion ByronBlock
_ = Decoder s SlotNo
forall a s. DecCBOR a => Decoder s a
fromByronCBOR

-- | @'ApplyTxErr' 'ByronBlock'@
instance SerialiseNodeToClient ByronBlock CC.ApplyMempoolPayloadErr where
  encodeNodeToClient :: CodecConfig ByronBlock
-> BlockNodeToClientVersion ByronBlock
-> ApplyMempoolPayloadErr
-> Encoding
encodeNodeToClient CodecConfig ByronBlock
_ BlockNodeToClientVersion ByronBlock
_ = ApplyMempoolPayloadErr -> Encoding
ApplyTxErr ByronBlock -> Encoding
encodeByronApplyTxError
  decodeNodeToClient :: CodecConfig ByronBlock
-> BlockNodeToClientVersion ByronBlock
-> forall s. Decoder s ApplyMempoolPayloadErr
decodeNodeToClient CodecConfig ByronBlock
_ BlockNodeToClientVersion ByronBlock
_ = Decoder s ApplyMempoolPayloadErr
Decoder s (ApplyTxErr ByronBlock)
forall s. Decoder s (ApplyTxErr ByronBlock)
decodeByronApplyTxError

instance SerialiseNodeToClient ByronBlock (SomeSecond BlockQuery ByronBlock) where
  encodeNodeToClient :: CodecConfig ByronBlock
-> BlockNodeToClientVersion ByronBlock
-> SomeSecond BlockQuery ByronBlock
-> Encoding
encodeNodeToClient CodecConfig ByronBlock
_ BlockNodeToClientVersion ByronBlock
_ (SomeSecond BlockQuery ByronBlock b
q) = BlockQuery ByronBlock b -> Encoding
forall result. BlockQuery ByronBlock result -> Encoding
encodeByronQuery BlockQuery ByronBlock b
q
  decodeNodeToClient :: CodecConfig ByronBlock
-> BlockNodeToClientVersion ByronBlock
-> forall s. Decoder s (SomeSecond BlockQuery ByronBlock)
decodeNodeToClient CodecConfig ByronBlock
_ BlockNodeToClientVersion ByronBlock
_               = Decoder s (SomeSecond BlockQuery ByronBlock)
forall s. Decoder s (SomeSecond BlockQuery ByronBlock)
decodeByronQuery

instance SerialiseResult ByronBlock (BlockQuery ByronBlock) where
  encodeResult :: forall result.
CodecConfig ByronBlock
-> BlockNodeToClientVersion ByronBlock
-> BlockQuery ByronBlock result
-> result
-> Encoding
encodeResult CodecConfig ByronBlock
_ BlockNodeToClientVersion ByronBlock
_ = BlockQuery ByronBlock result -> result -> Encoding
forall result. BlockQuery ByronBlock result -> result -> Encoding
encodeByronResult
  decodeResult :: forall result.
CodecConfig ByronBlock
-> BlockNodeToClientVersion ByronBlock
-> BlockQuery ByronBlock result
-> forall s. Decoder s result
decodeResult CodecConfig ByronBlock
_ BlockNodeToClientVersion ByronBlock
_ = BlockQuery ByronBlock result -> Decoder s result
BlockQuery ByronBlock result -> forall s. Decoder s result
forall result.
BlockQuery ByronBlock result -> forall s. Decoder s result
decodeByronResult

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

instance ReconstructNestedCtxt Header ByronBlock where
  reconstructPrefixLen :: forall (proxy :: * -> *). proxy (Header ByronBlock) -> PrefixLen
reconstructPrefixLen proxy (Header ByronBlock)
_ = Word8 -> PrefixLen
PrefixLen Word8
2
  reconstructNestedCtxt :: forall (proxy :: * -> *).
proxy (Header ByronBlock)
-> ShortByteString
-> SizeInBytes
-> SomeSecond (NestedCtxt Header) ByronBlock
reconstructNestedCtxt proxy (Header ByronBlock)
_proxy ShortByteString
prefix SizeInBytes
size =
      -- The first byte is @encodeListLen 2@, the second (index 1) is 0 for
      -- EBB, 1 for regular block
      case HasCallStack => ShortByteString -> Int -> Word8
ShortByteString -> Int -> Word8
Short.index ShortByteString
prefix Int
1 of
        Word8
0 -> 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 Header ByronBlock (SlotNo, RawBoundaryHeader)
-> SomeSecond (NestedCtxt Header) ByronBlock
forall a b. (a -> b) -> a -> b
$ 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
size)
        Word8
1 -> 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 Header ByronBlock (AHeader ByteString)
-> SomeSecond (NestedCtxt Header) ByronBlock
forall a b. (a -> b) -> a -> b
$ 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
size)
        Word8
_ -> String -> SomeSecond (NestedCtxt Header) ByronBlock
forall a. HasCallStack => String -> a
error (String -> SomeSecond (NestedCtxt Header) ByronBlock)
-> String -> SomeSecond (NestedCtxt Header) ByronBlock
forall a b. (a -> b) -> a -> b
$ String
"invalid ByronBlock with prefix: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ShortByteString -> String
forall a. Show a => a -> String
show ShortByteString
prefix

instance EncodeDiskDepIx (NestedCtxt Header) ByronBlock where
  encodeDiskDepIx :: CodecConfig ByronBlock
-> SomeSecond (NestedCtxt Header) ByronBlock -> Encoding
encodeDiskDepIx CodecConfig ByronBlock
_ccfg (SomeSecond (NestedCtxt NestedCtxt_ ByronBlock Header b
ctxt)) = [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat [
        Word -> Encoding
CBOR.encodeListLen Word
2
      , case NestedCtxt_ ByronBlock Header b
ctxt of
          CtxtByronBoundary SizeInBytes
size -> [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat [
              Word8 -> Encoding
CBOR.encodeWord8 Word8
0
            , Word32 -> Encoding
CBOR.encodeWord32 (SizeInBytes -> Word32
getSizeInBytes SizeInBytes
size)
            ]
          CtxtByronRegular SizeInBytes
size -> [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat [
              Word8 -> Encoding
CBOR.encodeWord8 Word8
1
            , Word32 -> Encoding
CBOR.encodeWord32 (SizeInBytes -> Word32
getSizeInBytes SizeInBytes
size)
            ]
      ]

instance EncodeDiskDep (NestedCtxt Header) ByronBlock where
  encodeDiskDep :: forall a.
CodecConfig ByronBlock
-> NestedCtxt Header ByronBlock a -> a -> Encoding
encodeDiskDep CodecConfig ByronBlock
_ccfg (NestedCtxt NestedCtxt_ ByronBlock Header a
ctxt) a
h =
      case NestedCtxt_ ByronBlock Header a
ctxt of
        CtxtByronRegular SizeInBytes
_size ->
          AHeader ByteString -> Encoding
encodeByronRegularHeader a
AHeader ByteString
h
        CtxtByronBoundary SizeInBytes
_size ->
          -- We don't encode the 'SlotNo'
          -- This is important, because this encoder/decoder must be compatible
          -- with the raw bytes as stored on disk as part of a Byron block.
          RawBoundaryHeader -> Encoding
encodeByronBoundaryHeader ((SlotNo, RawBoundaryHeader) -> RawBoundaryHeader
forall a b. (a, b) -> b
snd a
(SlotNo, RawBoundaryHeader)
h)

instance DecodeDiskDepIx (NestedCtxt Header) ByronBlock where
  decodeDiskDepIx :: forall s.
CodecConfig ByronBlock
-> Decoder s (SomeSecond (NestedCtxt Header) ByronBlock)
decodeDiskDepIx CodecConfig ByronBlock
_ccfg = do
      Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"decodeDiskDepIx ByronBlock" Int
2
      Decoder s Word8
forall s. Decoder s Word8
CBOR.decodeWord8 Decoder s Word8
-> (Word8 -> Decoder s (SomeSecond (NestedCtxt Header) ByronBlock))
-> Decoder s (SomeSecond (NestedCtxt Header) ByronBlock)
forall a b. Decoder s a -> (a -> Decoder s b) -> Decoder s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Word8
0 -> 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)
-> (Word32
    -> NestedCtxt Header ByronBlock (SlotNo, RawBoundaryHeader))
-> Word32
-> 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)
 -> NestedCtxt Header ByronBlock (SlotNo, RawBoundaryHeader))
-> (Word32
    -> NestedCtxt_ ByronBlock Header (SlotNo, RawBoundaryHeader))
-> Word32
-> NestedCtxt Header ByronBlock (SlotNo, RawBoundaryHeader)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SizeInBytes
-> NestedCtxt_ ByronBlock Header (SlotNo, RawBoundaryHeader)
CtxtByronBoundary (SizeInBytes
 -> NestedCtxt_ ByronBlock Header (SlotNo, RawBoundaryHeader))
-> (Word32 -> SizeInBytes)
-> Word32
-> NestedCtxt_ ByronBlock Header (SlotNo, RawBoundaryHeader)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> SizeInBytes
SizeInBytes (Word32 -> SomeSecond (NestedCtxt Header) ByronBlock)
-> Decoder s Word32
-> Decoder s (SomeSecond (NestedCtxt Header) ByronBlock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word32
forall s. Decoder s Word32
CBOR.decodeWord32
        Word8
1 -> 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)
-> (Word32 -> NestedCtxt Header ByronBlock (AHeader ByteString))
-> Word32
-> 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)
 -> NestedCtxt Header ByronBlock (AHeader ByteString))
-> (Word32 -> NestedCtxt_ ByronBlock Header (AHeader ByteString))
-> Word32
-> NestedCtxt Header ByronBlock (AHeader ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SizeInBytes -> NestedCtxt_ ByronBlock Header (AHeader ByteString)
CtxtByronRegular (SizeInBytes -> NestedCtxt_ ByronBlock Header (AHeader ByteString))
-> (Word32 -> SizeInBytes)
-> Word32
-> NestedCtxt_ ByronBlock Header (AHeader ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> SizeInBytes
SizeInBytes  (Word32 -> SomeSecond (NestedCtxt Header) ByronBlock)
-> Decoder s Word32
-> Decoder s (SomeSecond (NestedCtxt Header) ByronBlock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word32
forall s. Decoder s Word32
CBOR.decodeWord32
        Word8
t -> DecoderError
-> Decoder s (SomeSecond (NestedCtxt Header) ByronBlock)
forall (m :: * -> *) e a. (MonadFail m, Buildable e) => e -> m a
cborError (DecoderError
 -> Decoder s (SomeSecond (NestedCtxt Header) ByronBlock))
-> DecoderError
-> Decoder s (SomeSecond (NestedCtxt Header) ByronBlock)
forall a b. (a -> b) -> a -> b
$ Text -> Word8 -> DecoderError
DecoderErrorUnknownTag Text
"decodeDiskDepIx ByronBlock" Word8
t

instance DecodeDiskDep (NestedCtxt Header) ByronBlock where
  decodeDiskDep :: forall a.
CodecConfig ByronBlock
-> NestedCtxt Header ByronBlock a
-> forall s. Decoder s (ByteString -> a)
decodeDiskDep ByronCodecConfig{EpochSlots
getByronEpochSlots :: CodecConfig ByronBlock -> EpochSlots
getByronEpochSlots :: EpochSlots
..} (NestedCtxt NestedCtxt_ ByronBlock Header a
ctxt) =
      case NestedCtxt_ ByronBlock Header a
ctxt of
        CtxtByronRegular SizeInBytes
_size ->
          EpochSlots -> Decoder s (ByteString -> AHeader ByteString)
forall s.
EpochSlots -> Decoder s (ByteString -> AHeader ByteString)
decodeByronRegularHeader EpochSlots
getByronEpochSlots
        CtxtByronBoundary SizeInBytes
_size ->
          (ByteString -> RawBoundaryHeader) -> ByteString -> a
(ByteString -> RawBoundaryHeader)
-> ByteString -> (SlotNo, RawBoundaryHeader)
auxBoundary ((ByteString -> RawBoundaryHeader) -> ByteString -> a)
-> Decoder s (ByteString -> RawBoundaryHeader)
-> Decoder s (ByteString -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (ByteString -> RawBoundaryHeader)
forall s. Decoder s (ByteString -> RawBoundaryHeader)
decodeByronBoundaryHeader
    where
      auxBoundary :: (Lazy.ByteString -> RawBoundaryHeader)
                  -> (Lazy.ByteString -> (SlotNo, RawBoundaryHeader))
      auxBoundary :: (ByteString -> RawBoundaryHeader)
-> ByteString -> (SlotNo, RawBoundaryHeader)
auxBoundary ByteString -> RawBoundaryHeader
f ByteString
bs =
          (SlotNo
slotNo, RawBoundaryHeader
hdr)
        where
          hdr :: RawBoundaryHeader
          hdr :: RawBoundaryHeader
hdr = ByteString -> RawBoundaryHeader
f ByteString
bs

          slotNo :: SlotNo
          slotNo :: SlotNo
slotNo = SlotNumber -> SlotNo
fromByronSlotNo (SlotNumber -> SlotNo) -> SlotNumber -> SlotNo
forall a b. (a -> b) -> a -> b
$
              EpochSlots -> Word64 -> SlotNumber
CC.boundaryBlockSlot EpochSlots
getByronEpochSlots (RawBoundaryHeader -> Word64
forall a. ABoundaryHeader a -> Word64
CC.boundaryEpoch RawBoundaryHeader
hdr)