{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}

module Ouroboros.Consensus.Shelley.Ledger.Block (
    GetHeader (..)
  , Header (..)
  , IsShelleyBlock
  , NestedCtxt_ (..)
  , ShelleyBasedEra
  , ShelleyBlock (..)
  , ShelleyBlockLedgerEra
  , ShelleyHash (..)
    -- * Shelley Compatibility
  , ShelleyCompatible
  , mkShelleyBlock
  , mkShelleyHeader
    -- * Serialisation
  , decodeShelleyBlock
  , decodeShelleyHeader
  , encodeShelleyBlock
  , encodeShelleyHeader
  , shelleyBinaryBlockInfo
    -- * Conversion
  , fromShelleyPrevHash
  , toShelleyPrevHash
  ) where

import qualified Cardano.Crypto.Hash as Crypto
import           Cardano.Ledger.Binary (Annotator (..), DecCBOR (..),
                     EncCBOR (..), FullByteString (..), serialize)
import qualified Cardano.Ledger.Binary.Plain as Plain
import           Cardano.Ledger.Core as SL (eraDecoder, eraProtVerLow,
                     toEraCBOR)
import qualified Cardano.Ledger.Core as SL (hashTxSeq)
import           Cardano.Ledger.Hashes (HASH)
import qualified Cardano.Ledger.Shelley.API as SL
import           Cardano.Protocol.Crypto (Crypto)
import qualified Cardano.Protocol.TPraos.BHeader as SL
import qualified Data.ByteString.Lazy as Lazy
import           Data.Coerce (coerce)
import           Data.Typeable (Typeable)
import           GHC.Generics (Generic)
import           NoThunks.Class (NoThunks (..))
import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.HardFork.Combinator
                     (HasPartialConsensusConfig)
import           Ouroboros.Consensus.HeaderValidation
import           Ouroboros.Consensus.Protocol.Abstract (ChainDepState,
                     SelectView)
import           Ouroboros.Consensus.Protocol.Praos.Common
                     (PraosChainSelectView)
import           Ouroboros.Consensus.Protocol.Signed (SignedHeader)
import           Ouroboros.Consensus.Shelley.Eras
import           Ouroboros.Consensus.Shelley.Protocol.Abstract (ProtoCrypto,
                     ProtocolHeaderSupportsEnvelope (pHeaderPrevHash),
                     ProtocolHeaderSupportsProtocol (CannotForgeError),
                     ShelleyHash (ShelleyHash, unShelleyHash), ShelleyProtocol,
                     ShelleyProtocolHeader, pHeaderBlock, pHeaderBodyHash,
                     pHeaderHash, pHeaderSlot)
import           Ouroboros.Consensus.Storage.Common (BinaryBlockInfo (..))
import           Ouroboros.Consensus.Storage.Serialisation (DecodeDisk,
                     EncodeDisk)
import           Ouroboros.Consensus.Util (ShowProxy (..), hashFromBytesShortE)
import           Ouroboros.Consensus.Util.Condense

{-------------------------------------------------------------------------------
  ShelleyCompatible
-------------------------------------------------------------------------------}
class
  ( ShelleyBasedEra era
  , ShelleyProtocol proto
    -- Header constraints
  , Eq (ShelleyProtocolHeader proto)
  , Show (ShelleyProtocolHeader proto)
  , NoThunks (ShelleyProtocolHeader proto)
  , EncCBOR (ShelleyProtocolHeader proto)
  , DecCBOR (Annotator (ShelleyProtocolHeader proto))
  , Show (CannotForgeError proto)
    -- Currently the chain select view is identical
    -- Era and proto crypto must coincide
  , SelectView proto ~ PraosChainSelectView (ProtoCrypto proto)
    -- Need to be able to sign the protocol header
  , SignedHeader (ShelleyProtocolHeader proto)
    -- ChainDepState needs to be serialisable
  , DecodeDisk (ShelleyBlock proto era) (ChainDepState proto)
  , EncodeDisk (ShelleyBlock proto era) (ChainDepState proto)
    -- Hard-fork related constraints
  , HasPartialConsensusConfig proto
  , DecCBOR (SL.PState era)
  , Crypto (ProtoCrypto proto)
  ) => ShelleyCompatible proto era

instance ShelleyCompatible proto era => ConvertRawHash (ShelleyBlock proto era) where
  toShortRawHash :: forall (proxy :: * -> *).
proxy (ShelleyBlock proto era)
-> HeaderHash (ShelleyBlock proto era) -> ShortByteString
toShortRawHash   proxy (ShelleyBlock proto era)
_ = Hash HASH EraIndependentBlockHeader -> ShortByteString
forall h a. Hash h a -> ShortByteString
Crypto.hashToBytesShort (Hash HASH EraIndependentBlockHeader -> ShortByteString)
-> (ShelleyHash -> Hash HASH EraIndependentBlockHeader)
-> ShelleyHash
-> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyHash -> Hash HASH EraIndependentBlockHeader
unShelleyHash
  fromShortRawHash :: forall (proxy :: * -> *).
proxy (ShelleyBlock proto era)
-> ShortByteString -> HeaderHash (ShelleyBlock proto era)
fromShortRawHash proxy (ShelleyBlock proto era)
_ = Hash HASH EraIndependentBlockHeader -> ShelleyHash
ShelleyHash (Hash HASH EraIndependentBlockHeader -> ShelleyHash)
-> (ShortByteString -> Hash HASH EraIndependentBlockHeader)
-> ShortByteString
-> ShelleyHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> Hash HASH EraIndependentBlockHeader
forall h a.
(HashAlgorithm h, HasCallStack) =>
ShortByteString -> Hash h a
hashFromBytesShortE
  hashSize :: forall (proxy :: * -> *). proxy (ShelleyBlock proto era) -> Word32
hashSize         proxy (ShelleyBlock proto era)
_ = Word -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Word32) -> Word -> Word32
forall a b. (a -> b) -> a -> b
$ Proxy HASH -> Word
forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
Crypto.sizeHash (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @HASH)

{-------------------------------------------------------------------------------
  Shelley blocks and headers
-------------------------------------------------------------------------------}

-- | Shelley-based block type.
--
-- This block is parametrised over both the (ledger) era and the protocol.
data ShelleyBlock proto era = ShelleyBlock {
      forall proto era.
ShelleyBlock proto era -> Block (ShelleyProtocolHeader proto) era
shelleyBlockRaw        :: !(SL.Block (ShelleyProtocolHeader proto) era)
    , forall proto era. ShelleyBlock proto era -> ShelleyHash
shelleyBlockHeaderHash :: !ShelleyHash
    }

deriving instance ShelleyCompatible proto era => Show (ShelleyBlock proto era)
deriving instance ShelleyCompatible proto era => Eq   (ShelleyBlock proto era)

instance (Typeable era, Typeable proto)
  => ShowProxy (ShelleyBlock proto era) where

type instance HeaderHash (ShelleyBlock proto era) = ShelleyHash

mkShelleyBlock ::
     ShelleyCompatible proto era
  => SL.Block (ShelleyProtocolHeader proto) era
  -> ShelleyBlock proto era
mkShelleyBlock :: forall proto era.
ShelleyCompatible proto era =>
Block (ShelleyProtocolHeader proto) era -> ShelleyBlock proto era
mkShelleyBlock Block (ShelleyProtocolHeader proto) era
raw = ShelleyBlock {
      shelleyBlockRaw :: Block (ShelleyProtocolHeader proto) era
shelleyBlockRaw        = Block (ShelleyProtocolHeader proto) era
raw
    , shelleyBlockHeaderHash :: ShelleyHash
shelleyBlockHeaderHash = ShelleyProtocolHeader proto -> ShelleyHash
forall proto.
ProtocolHeaderSupportsEnvelope proto =>
ShelleyProtocolHeader proto -> ShelleyHash
pHeaderHash (ShelleyProtocolHeader proto -> ShelleyHash)
-> ShelleyProtocolHeader proto -> ShelleyHash
forall a b. (a -> b) -> a -> b
$ Block (ShelleyProtocolHeader proto) era
-> ShelleyProtocolHeader proto
forall h era. Block h era -> h
SL.bheader Block (ShelleyProtocolHeader proto) era
raw
    }

class
  ( ShelleyCompatible (BlockProtocol blk) (ShelleyBlockLedgerEra blk)
  , blk ~ ShelleyBlock (BlockProtocol blk) (ShelleyBlockLedgerEra blk)
  ) => IsShelleyBlock blk

instance ( proto ~ BlockProtocol (ShelleyBlock proto era)
         , ShelleyCompatible proto era
         ) => IsShelleyBlock (ShelleyBlock proto era)

type family ShelleyBlockLedgerEra blk where
  ShelleyBlockLedgerEra (ShelleyBlock proto era) = era

data instance Header (ShelleyBlock proto era) = ShelleyHeader {
      forall proto era.
Header (ShelleyBlock proto era) -> ShelleyProtocolHeader proto
shelleyHeaderRaw  :: !(ShelleyProtocolHeader proto)
    , forall proto era. Header (ShelleyBlock proto era) -> ShelleyHash
shelleyHeaderHash :: !ShelleyHash
    }
  deriving ((forall x.
 Header (ShelleyBlock proto era)
 -> Rep (Header (ShelleyBlock proto era)) x)
-> (forall x.
    Rep (Header (ShelleyBlock proto era)) x
    -> Header (ShelleyBlock proto era))
-> Generic (Header (ShelleyBlock proto era))
forall x.
Rep (Header (ShelleyBlock proto era)) x
-> Header (ShelleyBlock proto era)
forall x.
Header (ShelleyBlock proto era)
-> Rep (Header (ShelleyBlock proto era)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall proto era x.
Rep (Header (ShelleyBlock proto era)) x
-> Header (ShelleyBlock proto era)
forall proto era x.
Header (ShelleyBlock proto era)
-> Rep (Header (ShelleyBlock proto era)) x
$cfrom :: forall proto era x.
Header (ShelleyBlock proto era)
-> Rep (Header (ShelleyBlock proto era)) x
from :: forall x.
Header (ShelleyBlock proto era)
-> Rep (Header (ShelleyBlock proto era)) x
$cto :: forall proto era x.
Rep (Header (ShelleyBlock proto era)) x
-> Header (ShelleyBlock proto era)
to :: forall x.
Rep (Header (ShelleyBlock proto era)) x
-> Header (ShelleyBlock proto era)
Generic)

deriving instance ShelleyCompatible proto era => Show     (Header (ShelleyBlock proto era))
deriving instance ShelleyCompatible proto era => Eq       (Header (ShelleyBlock proto era))
deriving instance ShelleyCompatible proto era => NoThunks (Header (ShelleyBlock proto era))

instance (Typeable era, Typeable proto)
  => ShowProxy (Header (ShelleyBlock proto era)) where

instance ShelleyCompatible proto era => GetHeader (ShelleyBlock proto era) where
  getHeader :: ShelleyBlock proto era -> Header (ShelleyBlock proto era)
getHeader (ShelleyBlock Block (ShelleyProtocolHeader proto) era
rawBlk ShelleyHash
hdrHash) = ShelleyHeader {
      shelleyHeaderRaw :: ShelleyProtocolHeader proto
shelleyHeaderRaw  = Block (ShelleyProtocolHeader proto) era
-> ShelleyProtocolHeader proto
forall h era. Block h era -> h
SL.bheader Block (ShelleyProtocolHeader proto) era
rawBlk
    , shelleyHeaderHash :: ShelleyHash
shelleyHeaderHash = ShelleyHash
hdrHash
    }

  blockMatchesHeader :: Header (ShelleyBlock proto era) -> ShelleyBlock proto era -> Bool
blockMatchesHeader Header (ShelleyBlock proto era)
hdr ShelleyBlock proto era
blk =
      -- Compute the hash the body of the block (the transactions) and compare
      -- that against the hash of the body stored in the header.
      forall era.
EraSegWits era =>
TxSeq era -> Hash HASH EraIndependentBlockBody
SL.hashTxSeq @era TxSeq era
txs Hash HASH EraIndependentBlockBody
-> Hash HASH EraIndependentBlockBody -> Bool
forall a. Eq a => a -> a -> Bool
== ShelleyProtocolHeader proto -> Hash HASH EraIndependentBlockBody
forall proto.
ProtocolHeaderSupportsEnvelope proto =>
ShelleyProtocolHeader proto -> Hash HASH EraIndependentBlockBody
pHeaderBodyHash ShelleyProtocolHeader proto
shelleyHdr
    where
      ShelleyHeader { shelleyHeaderRaw :: forall proto era.
Header (ShelleyBlock proto era) -> ShelleyProtocolHeader proto
shelleyHeaderRaw = ShelleyProtocolHeader proto
shelleyHdr }     = Header (ShelleyBlock proto era)
hdr
      ShelleyBlock  { shelleyBlockRaw :: forall proto era.
ShelleyBlock proto era -> Block (ShelleyProtocolHeader proto) era
shelleyBlockRaw  = SL.Block ShelleyProtocolHeader proto
_ TxSeq era
txs } = ShelleyBlock proto era
blk

  headerIsEBB :: Header (ShelleyBlock proto era) -> Maybe EpochNo
headerIsEBB = Maybe EpochNo -> Header (ShelleyBlock proto era) -> Maybe EpochNo
forall a b. a -> b -> a
const Maybe EpochNo
forall a. Maybe a
Nothing

mkShelleyHeader ::
     ShelleyCompatible proto era
  => ShelleyProtocolHeader proto
  -> Header (ShelleyBlock proto era)
mkShelleyHeader :: forall proto era.
ShelleyCompatible proto era =>
ShelleyProtocolHeader proto -> Header (ShelleyBlock proto era)
mkShelleyHeader ShelleyProtocolHeader proto
raw = ShelleyHeader {
      shelleyHeaderRaw :: ShelleyProtocolHeader proto
shelleyHeaderRaw  = ShelleyProtocolHeader proto
raw
    , shelleyHeaderHash :: ShelleyHash
shelleyHeaderHash = ShelleyProtocolHeader proto -> ShelleyHash
forall proto.
ProtocolHeaderSupportsEnvelope proto =>
ShelleyProtocolHeader proto -> ShelleyHash
pHeaderHash ShelleyProtocolHeader proto
raw
    }

instance ShelleyCompatible proto era => HasHeader (ShelleyBlock proto era)  where
  getHeaderFields :: ShelleyBlock proto era -> HeaderFields (ShelleyBlock proto era)
getHeaderFields = ShelleyBlock proto era -> HeaderFields (ShelleyBlock proto era)
forall blk. GetHeader blk => blk -> HeaderFields blk
getBlockHeaderFields

instance ShelleyCompatible proto era => HasHeader (Header (ShelleyBlock proto era)) where
  getHeaderFields :: Header (ShelleyBlock proto era)
-> HeaderFields (Header (ShelleyBlock proto era))
getHeaderFields Header (ShelleyBlock proto era)
hdr = HeaderFields {
      headerFieldHash :: HeaderHash (Header (ShelleyBlock proto era))
headerFieldHash    = ShelleyProtocolHeader proto
-> HeaderHash (Header (ShelleyBlock proto era))
ShelleyProtocolHeader proto -> ShelleyHash
forall proto.
ProtocolHeaderSupportsEnvelope proto =>
ShelleyProtocolHeader proto -> ShelleyHash
pHeaderHash (ShelleyProtocolHeader proto
 -> HeaderHash (Header (ShelleyBlock proto era)))
-> (Header (ShelleyBlock proto era) -> ShelleyProtocolHeader proto)
-> Header (ShelleyBlock proto era)
-> HeaderHash (Header (ShelleyBlock proto era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header (ShelleyBlock proto era) -> ShelleyProtocolHeader proto
forall proto era.
Header (ShelleyBlock proto era) -> ShelleyProtocolHeader proto
shelleyHeaderRaw (Header (ShelleyBlock proto era)
 -> HeaderHash (Header (ShelleyBlock proto era)))
-> Header (ShelleyBlock proto era)
-> HeaderHash (Header (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ Header (ShelleyBlock proto era)
hdr
    , headerFieldSlot :: SlotNo
headerFieldSlot    = ShelleyProtocolHeader proto -> SlotNo
forall proto.
ProtocolHeaderSupportsEnvelope proto =>
ShelleyProtocolHeader proto -> SlotNo
pHeaderSlot (ShelleyProtocolHeader proto -> SlotNo)
-> (Header (ShelleyBlock proto era) -> ShelleyProtocolHeader proto)
-> Header (ShelleyBlock proto era)
-> SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header (ShelleyBlock proto era) -> ShelleyProtocolHeader proto
forall proto era.
Header (ShelleyBlock proto era) -> ShelleyProtocolHeader proto
shelleyHeaderRaw (Header (ShelleyBlock proto era) -> SlotNo)
-> Header (ShelleyBlock proto era) -> SlotNo
forall a b. (a -> b) -> a -> b
$ Header (ShelleyBlock proto era)
hdr
    , headerFieldBlockNo :: BlockNo
headerFieldBlockNo = BlockNo -> BlockNo
forall a b. Coercible a b => a -> b
coerce (BlockNo -> BlockNo)
-> (Header (ShelleyBlock proto era) -> BlockNo)
-> Header (ShelleyBlock proto era)
-> BlockNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyProtocolHeader proto -> BlockNo
forall proto.
ProtocolHeaderSupportsEnvelope proto =>
ShelleyProtocolHeader proto -> BlockNo
pHeaderBlock (ShelleyProtocolHeader proto -> BlockNo)
-> (Header (ShelleyBlock proto era) -> ShelleyProtocolHeader proto)
-> Header (ShelleyBlock proto era)
-> BlockNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header (ShelleyBlock proto era) -> ShelleyProtocolHeader proto
forall proto era.
Header (ShelleyBlock proto era) -> ShelleyProtocolHeader proto
shelleyHeaderRaw (Header (ShelleyBlock proto era) -> BlockNo)
-> Header (ShelleyBlock proto era) -> BlockNo
forall a b. (a -> b) -> a -> b
$ Header (ShelleyBlock proto era)
hdr
    }

instance ShelleyCompatible proto era => GetPrevHash (ShelleyBlock proto era) where
  headerPrevHash :: Header (ShelleyBlock proto era)
-> ChainHash (ShelleyBlock proto era)
headerPrevHash =
      PrevHash -> ChainHash (ShelleyBlock proto era)
forall proto era. PrevHash -> ChainHash (ShelleyBlock proto era)
fromShelleyPrevHash
    (PrevHash -> ChainHash (ShelleyBlock proto era))
-> (Header (ShelleyBlock proto era) -> PrevHash)
-> Header (ShelleyBlock proto era)
-> ChainHash (ShelleyBlock proto era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyProtocolHeader proto -> PrevHash
forall proto.
ProtocolHeaderSupportsEnvelope proto =>
ShelleyProtocolHeader proto -> PrevHash
pHeaderPrevHash
    (ShelleyProtocolHeader proto -> PrevHash)
-> (Header (ShelleyBlock proto era) -> ShelleyProtocolHeader proto)
-> Header (ShelleyBlock proto era)
-> PrevHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header (ShelleyBlock proto era) -> ShelleyProtocolHeader proto
forall proto era.
Header (ShelleyBlock proto era) -> ShelleyProtocolHeader proto
shelleyHeaderRaw

instance ShelleyCompatible proto era => StandardHash (ShelleyBlock proto era)

instance ShelleyCompatible proto era => HasAnnTip (ShelleyBlock proto era)

-- The 'ValidateEnvelope' instance lives in the
-- "Ouroboros.Consensus.Shelley.Ledger.Ledger" module because of the
-- dependency on the 'LedgerConfig'.

{-------------------------------------------------------------------------------
  Conversions
-------------------------------------------------------------------------------}

-- | From @cardano-ledger-specs@ to @ouroboros-consensus@
fromShelleyPrevHash ::
  SL.PrevHash -> ChainHash (ShelleyBlock proto era)
fromShelleyPrevHash :: forall proto era. PrevHash -> ChainHash (ShelleyBlock proto era)
fromShelleyPrevHash PrevHash
SL.GenesisHash   = ChainHash (ShelleyBlock proto era)
forall {k} (b :: k). ChainHash b
GenesisHash
fromShelleyPrevHash (SL.BlockHash HashHeader
h) = HeaderHash (ShelleyBlock proto era)
-> ChainHash (ShelleyBlock proto era)
forall {k} (b :: k). HeaderHash b -> ChainHash b
BlockHash (Hash HASH EraIndependentBlockHeader -> ShelleyHash
ShelleyHash (Hash HASH EraIndependentBlockHeader -> ShelleyHash)
-> Hash HASH EraIndependentBlockHeader -> ShelleyHash
forall a b. (a -> b) -> a -> b
$ HashHeader -> Hash HASH EraIndependentBlockHeader
SL.unHashHeader HashHeader
h)

-- | From @ouroboros-consensus@ to @cardano-ledger-specs@
toShelleyPrevHash ::
  ChainHash (Header (ShelleyBlock proto era)) -> SL.PrevHash
toShelleyPrevHash :: forall proto era.
ChainHash (Header (ShelleyBlock proto era)) -> PrevHash
toShelleyPrevHash ChainHash (Header (ShelleyBlock proto era))
GenesisHash                 = PrevHash
SL.GenesisHash
toShelleyPrevHash (BlockHash (ShelleyHash Hash HASH EraIndependentBlockHeader
h)) = HashHeader -> PrevHash
SL.BlockHash (HashHeader -> PrevHash) -> HashHeader -> PrevHash
forall a b. (a -> b) -> a -> b
$ Hash HASH EraIndependentBlockHeader -> HashHeader
SL.HashHeader Hash HASH EraIndependentBlockHeader
h

{-------------------------------------------------------------------------------
  NestedCtxt
-------------------------------------------------------------------------------}

data instance NestedCtxt_ (ShelleyBlock proto era) f a where
  CtxtShelley :: NestedCtxt_ (ShelleyBlock proto era) f (f (ShelleyBlock proto era))

deriving instance Show (NestedCtxt_ (ShelleyBlock proto era) f a)

instance TrivialDependency (NestedCtxt_ (ShelleyBlock proto era) f) where
  type TrivialIndex (NestedCtxt_ (ShelleyBlock proto era) f) = f (ShelleyBlock proto era)
  hasSingleIndex :: forall a b.
NestedCtxt_ (ShelleyBlock proto era) f a
-> NestedCtxt_ (ShelleyBlock proto era) f b -> a :~: b
hasSingleIndex NestedCtxt_ (ShelleyBlock proto era) f a
R:NestedCtxt_ShelleyBlockfa proto era f a
CtxtShelley NestedCtxt_ (ShelleyBlock proto era) f b
R:NestedCtxt_ShelleyBlockfa proto era f b
CtxtShelley = a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
  indexIsTrivial :: NestedCtxt_
  (ShelleyBlock proto era)
  f
  (TrivialIndex (NestedCtxt_ (ShelleyBlock proto era) f))
indexIsTrivial = NestedCtxt_ (ShelleyBlock proto era) f (f (ShelleyBlock proto era))
NestedCtxt_
  (ShelleyBlock proto era)
  f
  (TrivialIndex (NestedCtxt_ (ShelleyBlock proto era) f))
forall proto era (f :: * -> *).
NestedCtxt_ (ShelleyBlock proto era) f (f (ShelleyBlock proto era))
CtxtShelley

instance SameDepIndex (NestedCtxt_ (ShelleyBlock proto era) f)
instance HasNestedContent f (ShelleyBlock proto era)

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

instance ShelleyCompatible proto era => EncCBOR (ShelleyBlock proto era) where
  -- Don't encode the header hash, we recompute it during deserialisation
  encCBOR :: ShelleyBlock proto era -> Encoding
encCBOR = Block (ShelleyProtocolHeader proto) era -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Block (ShelleyProtocolHeader proto) era -> Encoding)
-> (ShelleyBlock proto era
    -> Block (ShelleyProtocolHeader proto) era)
-> ShelleyBlock proto era
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyBlock proto era -> Block (ShelleyProtocolHeader proto) era
forall proto era.
ShelleyBlock proto era -> Block (ShelleyProtocolHeader proto) era
shelleyBlockRaw

instance ShelleyCompatible proto era => DecCBOR (Annotator (ShelleyBlock proto era)) where
  decCBOR :: forall s. Decoder s (Annotator (ShelleyBlock proto era))
decCBOR = (Block (ShelleyProtocolHeader proto) era -> ShelleyBlock proto era)
-> Annotator (Block (ShelleyProtocolHeader proto) era)
-> Annotator (ShelleyBlock proto era)
forall a b. (a -> b) -> Annotator a -> Annotator b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Block (ShelleyProtocolHeader proto) era -> ShelleyBlock proto era
forall proto era.
ShelleyCompatible proto era =>
Block (ShelleyProtocolHeader proto) era -> ShelleyBlock proto era
mkShelleyBlock (Annotator (Block (ShelleyProtocolHeader proto) era)
 -> Annotator (ShelleyBlock proto era))
-> Decoder s (Annotator (Block (ShelleyProtocolHeader proto) era))
-> Decoder s (Annotator (ShelleyBlock proto era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Annotator (Block (ShelleyProtocolHeader proto) era))
forall s.
Decoder s (Annotator (Block (ShelleyProtocolHeader proto) era))
forall a s. DecCBOR a => Decoder s a
decCBOR

instance ShelleyCompatible proto era => EncCBOR (Header (ShelleyBlock proto era)) where
  -- Don't encode the header hash, we recompute it during deserialisation
  encCBOR :: Header (ShelleyBlock proto era) -> Encoding
encCBOR = ShelleyProtocolHeader proto -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (ShelleyProtocolHeader proto -> Encoding)
-> (Header (ShelleyBlock proto era) -> ShelleyProtocolHeader proto)
-> Header (ShelleyBlock proto era)
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header (ShelleyBlock proto era) -> ShelleyProtocolHeader proto
forall proto era.
Header (ShelleyBlock proto era) -> ShelleyProtocolHeader proto
shelleyHeaderRaw

instance ShelleyCompatible proto era => DecCBOR (Annotator (Header (ShelleyBlock proto era))) where
  decCBOR :: forall s. Decoder s (Annotator (Header (ShelleyBlock proto era)))
decCBOR = (ShelleyProtocolHeader proto -> Header (ShelleyBlock proto era))
-> Annotator (ShelleyProtocolHeader proto)
-> Annotator (Header (ShelleyBlock proto era))
forall a b. (a -> b) -> Annotator a -> Annotator b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ShelleyProtocolHeader proto -> Header (ShelleyBlock proto era)
forall proto era.
ShelleyCompatible proto era =>
ShelleyProtocolHeader proto -> Header (ShelleyBlock proto era)
mkShelleyHeader (Annotator (ShelleyProtocolHeader proto)
 -> Annotator (Header (ShelleyBlock proto era)))
-> Decoder s (Annotator (ShelleyProtocolHeader proto))
-> Decoder s (Annotator (Header (ShelleyBlock proto era)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Annotator (ShelleyProtocolHeader proto))
forall s. Decoder s (Annotator (ShelleyProtocolHeader proto))
forall a s. DecCBOR a => Decoder s a
decCBOR

encodeShelleyBlock ::
  forall proto era. ShelleyCompatible proto era
  => ShelleyBlock proto era -> Plain.Encoding
encodeShelleyBlock :: forall proto era.
ShelleyCompatible proto era =>
ShelleyBlock proto era -> Encoding
encodeShelleyBlock = forall era t. (Era era, EncCBOR t) => t -> Encoding
toEraCBOR @era

decodeShelleyBlock ::
  forall proto era. ShelleyCompatible proto era
  => forall s. Plain.Decoder s (Lazy.ByteString -> ShelleyBlock proto era)
decodeShelleyBlock :: forall proto era s.
ShelleyCompatible proto era =>
Decoder s (ByteString -> ShelleyBlock proto era)
decodeShelleyBlock = forall era t s. Era era => Decoder s t -> Decoder s t
eraDecoder @era (Decoder s (ByteString -> ShelleyBlock proto era)
 -> Decoder s (ByteString -> ShelleyBlock proto era))
-> Decoder s (ByteString -> ShelleyBlock proto era)
-> Decoder s (ByteString -> ShelleyBlock proto era)
forall a b. (a -> b) -> a -> b
$ ((FullByteString -> ShelleyBlock proto era)
-> (ByteString -> FullByteString)
-> ByteString
-> ShelleyBlock proto era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FullByteString
Full) ((FullByteString -> ShelleyBlock proto era)
 -> ByteString -> ShelleyBlock proto era)
-> (Annotator (ShelleyBlock proto era)
    -> FullByteString -> ShelleyBlock proto era)
-> Annotator (ShelleyBlock proto era)
-> ByteString
-> ShelleyBlock proto era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Annotator (ShelleyBlock proto era)
-> FullByteString -> ShelleyBlock proto era
forall a. Annotator a -> FullByteString -> a
runAnnotator (Annotator (ShelleyBlock proto era)
 -> ByteString -> ShelleyBlock proto era)
-> Decoder s (Annotator (ShelleyBlock proto era))
-> Decoder s (ByteString -> ShelleyBlock proto era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Annotator (ShelleyBlock proto era))
forall s. Decoder s (Annotator (ShelleyBlock proto era))
forall a s. DecCBOR a => Decoder s a
decCBOR

shelleyBinaryBlockInfo :: forall proto era. ShelleyCompatible proto era => ShelleyBlock proto era -> BinaryBlockInfo
shelleyBinaryBlockInfo :: forall proto era.
ShelleyCompatible proto era =>
ShelleyBlock proto era -> BinaryBlockInfo
shelleyBinaryBlockInfo ShelleyBlock proto era
blk = BinaryBlockInfo {
      -- Drop the 'encodeListLen' that precedes the header and the body (= tx
      -- seq)
      headerOffset :: Word16
headerOffset = Word16
1
      -- The Shelley decoders use annotations, so this is cheap
    , headerSize :: Word16
headerSize   = Int64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word16) -> Int64 -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
Lazy.length (Version -> Header (ShelleyBlock proto era) -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize (forall era. Era era => Version
SL.eraProtVerLow @era) (ShelleyBlock proto era -> Header (ShelleyBlock proto era)
forall blk. GetHeader blk => blk -> Header blk
getHeader ShelleyBlock proto era
blk))
    }

encodeShelleyHeader ::
  forall proto era. ShelleyCompatible proto era
  => Header (ShelleyBlock proto era) -> Plain.Encoding
encodeShelleyHeader :: forall proto era.
ShelleyCompatible proto era =>
Header (ShelleyBlock proto era) -> Encoding
encodeShelleyHeader = forall era t. (Era era, EncCBOR t) => t -> Encoding
toEraCBOR @era

decodeShelleyHeader ::
  forall proto era. ShelleyCompatible proto era
  => forall s. Plain.Decoder s (Lazy.ByteString -> Header (ShelleyBlock proto era))
decodeShelleyHeader :: forall proto era s.
ShelleyCompatible proto era =>
Decoder s (ByteString -> Header (ShelleyBlock proto era))
decodeShelleyHeader = forall era t s. Era era => Decoder s t -> Decoder s t
eraDecoder @era (Decoder s (ByteString -> Header (ShelleyBlock proto era))
 -> Decoder s (ByteString -> Header (ShelleyBlock proto era)))
-> Decoder s (ByteString -> Header (ShelleyBlock proto era))
-> Decoder s (ByteString -> Header (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ ((FullByteString -> Header (ShelleyBlock proto era))
-> (ByteString -> FullByteString)
-> ByteString
-> Header (ShelleyBlock proto era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FullByteString
Full) ((FullByteString -> Header (ShelleyBlock proto era))
 -> ByteString -> Header (ShelleyBlock proto era))
-> (Annotator (Header (ShelleyBlock proto era))
    -> FullByteString -> Header (ShelleyBlock proto era))
-> Annotator (Header (ShelleyBlock proto era))
-> ByteString
-> Header (ShelleyBlock proto era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Annotator (Header (ShelleyBlock proto era))
-> FullByteString -> Header (ShelleyBlock proto era)
forall a. Annotator a -> FullByteString -> a
runAnnotator (Annotator (Header (ShelleyBlock proto era))
 -> ByteString -> Header (ShelleyBlock proto era))
-> Decoder s (Annotator (Header (ShelleyBlock proto era)))
-> Decoder s (ByteString -> Header (ShelleyBlock proto era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Annotator (Header (ShelleyBlock proto era)))
forall s. Decoder s (Annotator (Header (ShelleyBlock proto era)))
forall a s. DecCBOR a => Decoder s a
decCBOR

{-------------------------------------------------------------------------------
  Condense
-------------------------------------------------------------------------------}

instance ShelleyCompatible proto era => Condense (ShelleyBlock proto era) where
  condense :: ShelleyBlock proto era -> String
condense = Block (ShelleyProtocolHeader proto) era -> String
forall a. Show a => a -> String
show (Block (ShelleyProtocolHeader proto) era -> String)
-> (ShelleyBlock proto era
    -> Block (ShelleyProtocolHeader proto) era)
-> ShelleyBlock proto era
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyBlock proto era -> Block (ShelleyProtocolHeader proto) era
forall proto era.
ShelleyBlock proto era -> Block (ShelleyProtocolHeader proto) era
shelleyBlockRaw

instance ShelleyCompatible proto era => Condense (Header (ShelleyBlock proto era)) where
  condense :: Header (ShelleyBlock proto era) -> String
condense = ShelleyProtocolHeader proto -> String
forall a. Show a => a -> String
show (ShelleyProtocolHeader proto -> String)
-> (Header (ShelleyBlock proto era) -> ShelleyProtocolHeader proto)
-> Header (ShelleyBlock proto era)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header (ShelleyBlock proto era) -> ShelleyProtocolHeader proto
forall proto era.
Header (ShelleyBlock proto era) -> ShelleyProtocolHeader proto
shelleyHeaderRaw