{-# 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,
                     toPlainDecoder)
import qualified Cardano.Ledger.Binary.Plain as Plain
import           Cardano.Ledger.Core as SL (eraProtVerLow, toEraCBOR)
import           Cardano.Ledger.Crypto (HASH)
import qualified Cardano.Ledger.Era as SL (hashTxSeq)
import qualified Cardano.Ledger.Shelley.API as SL
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.Ledger.Query.PParamsLegacyEncoder
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
  , SelectView proto ~ PraosChainSelectView (EraCrypto era)
    -- 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)
    -- Era and proto crypto must coincide
  , EraCrypto era ~ ProtoCrypto proto
    -- Hard-fork related constraints
  , HasPartialConsensusConfig proto
  , DecCBOR (SL.PState era)

    -- Backwards compatibility
  , Plain.FromCBOR (LegacyPParams era)
  , Plain.ToCBOR (LegacyPParams era)
  ) => 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 (ProtoCrypto proto)) EraIndependentBlockHeader
-> ShortByteString
forall h a. Hash h a -> ShortByteString
Crypto.hashToBytesShort (Hash (HASH (ProtoCrypto proto)) EraIndependentBlockHeader
 -> ShortByteString)
-> (ShelleyHash (ProtoCrypto proto)
    -> Hash (HASH (ProtoCrypto proto)) EraIndependentBlockHeader)
-> ShelleyHash (ProtoCrypto proto)
-> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyHash (ProtoCrypto proto)
-> Hash (HASH (ProtoCrypto proto)) EraIndependentBlockHeader
forall crypto.
ShelleyHash crypto -> Hash crypto EraIndependentBlockHeader
unShelleyHash
  fromShortRawHash :: forall (proxy :: * -> *).
proxy (ShelleyBlock proto era)
-> ShortByteString -> HeaderHash (ShelleyBlock proto era)
fromShortRawHash proxy (ShelleyBlock proto era)
_ = Hash (HASH (ProtoCrypto proto)) EraIndependentBlockHeader
-> ShelleyHash (ProtoCrypto proto)
forall crypto.
Hash crypto EraIndependentBlockHeader -> ShelleyHash crypto
ShelleyHash (Hash (HASH (ProtoCrypto proto)) EraIndependentBlockHeader
 -> ShelleyHash (ProtoCrypto proto))
-> (ShortByteString
    -> Hash (HASH (ProtoCrypto proto)) EraIndependentBlockHeader)
-> ShortByteString
-> ShelleyHash (ProtoCrypto proto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString
-> Hash (HASH (ProtoCrypto proto)) 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 (ProtoCrypto proto)) -> Word
forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
Crypto.sizeHash (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(HASH (EraCrypto era)))

{-------------------------------------------------------------------------------
  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 (ProtoCrypto proto)
shelleyBlockHeaderHash :: !(ShelleyHash (ProtoCrypto proto))
    }

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 (ProtoCrypto proto)

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 (ProtoCrypto proto)
shelleyBlockHeaderHash = ShelleyProtocolHeader proto -> ShelleyHash (ProtoCrypto proto)
forall proto.
ProtocolHeaderSupportsEnvelope proto =>
ShelleyProtocolHeader proto -> ShelleyHash (ProtoCrypto proto)
pHeaderHash (ShelleyProtocolHeader proto -> ShelleyHash (ProtoCrypto proto))
-> ShelleyProtocolHeader proto -> ShelleyHash (ProtoCrypto proto)
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 (ProtoCrypto proto)
shelleyHeaderHash :: !(ShelleyHash (ProtoCrypto proto))
    }
  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 (ProtoCrypto proto)
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 (ProtoCrypto proto)
shelleyHeaderHash = ShelleyHash (ProtoCrypto proto)
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 (EraCrypto era)) EraIndependentBlockBody
SL.hashTxSeq @era TxSeq era
txs Hash (HASH (ProtoCrypto proto)) EraIndependentBlockBody
-> Hash (HASH (ProtoCrypto proto)) EraIndependentBlockBody -> Bool
forall a. Eq a => a -> a -> Bool
== ShelleyProtocolHeader proto
-> Hash (HASH (ProtoCrypto proto)) EraIndependentBlockBody
forall proto.
ProtocolHeaderSupportsEnvelope proto =>
ShelleyProtocolHeader proto
-> Hash (ProtoCrypto proto) 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 (ProtoCrypto proto)
shelleyHeaderHash = ShelleyProtocolHeader proto -> ShelleyHash (ProtoCrypto proto)
forall proto.
ProtocolHeaderSupportsEnvelope proto =>
ShelleyProtocolHeader proto -> ShelleyHash (ProtoCrypto proto)
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 (ProtoCrypto proto)
forall proto.
ProtocolHeaderSupportsEnvelope proto =>
ShelleyProtocolHeader proto -> ShelleyHash (ProtoCrypto proto)
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 (EraCrypto era) -> ChainHash (ShelleyBlock proto era)
PrevHash (ProtoCrypto proto) -> ChainHash (ShelleyBlock proto era)
forall era proto.
(EraCrypto era ~ ProtoCrypto proto) =>
PrevHash (EraCrypto era) -> ChainHash (ShelleyBlock proto era)
fromShelleyPrevHash
    (PrevHash (ProtoCrypto proto)
 -> ChainHash (ShelleyBlock proto era))
-> (Header (ShelleyBlock proto era)
    -> PrevHash (ProtoCrypto proto))
-> Header (ShelleyBlock proto era)
-> ChainHash (ShelleyBlock proto era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyProtocolHeader proto -> PrevHash (ProtoCrypto proto)
forall proto.
ProtocolHeaderSupportsEnvelope proto =>
ShelleyProtocolHeader proto -> PrevHash (ProtoCrypto proto)
pHeaderPrevHash
    (ShelleyProtocolHeader proto -> PrevHash (ProtoCrypto proto))
-> (Header (ShelleyBlock proto era) -> ShelleyProtocolHeader proto)
-> Header (ShelleyBlock proto era)
-> PrevHash (ProtoCrypto proto)
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 :: EraCrypto era ~ ProtoCrypto proto =>
  SL.PrevHash (EraCrypto era) -> ChainHash (ShelleyBlock proto era)
fromShelleyPrevHash :: forall era proto.
(EraCrypto era ~ ProtoCrypto proto) =>
PrevHash (EraCrypto era) -> ChainHash (ShelleyBlock proto era)
fromShelleyPrevHash PrevHash (EraCrypto era)
SL.GenesisHash   = ChainHash (ShelleyBlock proto era)
forall {k} (b :: k). ChainHash b
GenesisHash
fromShelleyPrevHash (SL.BlockHash HashHeader (EraCrypto era)
h) = HeaderHash (ShelleyBlock proto era)
-> ChainHash (ShelleyBlock proto era)
forall {k} (b :: k). HeaderHash b -> ChainHash b
BlockHash (Hash (ProtoCrypto proto) EraIndependentBlockHeader
-> ShelleyHash (ProtoCrypto proto)
forall crypto.
Hash crypto EraIndependentBlockHeader -> ShelleyHash crypto
ShelleyHash (Hash (ProtoCrypto proto) EraIndependentBlockHeader
 -> ShelleyHash (ProtoCrypto proto))
-> Hash (ProtoCrypto proto) EraIndependentBlockHeader
-> ShelleyHash (ProtoCrypto proto)
forall a b. (a -> b) -> a -> b
$ HashHeader (ProtoCrypto proto)
-> Hash (ProtoCrypto proto) EraIndependentBlockHeader
forall c. HashHeader c -> Hash c EraIndependentBlockHeader
SL.unHashHeader HashHeader (EraCrypto era)
HashHeader (ProtoCrypto proto)
h)

-- | From @ouroboros-consensus@ to @cardano-ledger-specs@
toShelleyPrevHash :: EraCrypto era ~ ProtoCrypto proto =>
  ChainHash (Header (ShelleyBlock proto era)) -> SL.PrevHash (EraCrypto era)
toShelleyPrevHash :: forall era proto.
(EraCrypto era ~ ProtoCrypto proto) =>
ChainHash (Header (ShelleyBlock proto era))
-> PrevHash (EraCrypto era)
toShelleyPrevHash ChainHash (Header (ShelleyBlock proto era))
GenesisHash                 = PrevHash (EraCrypto era)
PrevHash (ProtoCrypto proto)
forall c. PrevHash c
SL.GenesisHash
toShelleyPrevHash (BlockHash (ShelleyHash Hash (ProtoCrypto proto) EraIndependentBlockHeader
h)) = HashHeader (EraCrypto era) -> PrevHash (EraCrypto era)
forall c. HashHeader c -> PrevHash c
SL.BlockHash (HashHeader (EraCrypto era) -> PrevHash (EraCrypto era))
-> HashHeader (EraCrypto era) -> PrevHash (EraCrypto era)
forall a b. (a -> b) -> a -> b
$ Hash (ProtoCrypto proto) EraIndependentBlockHeader
-> HashHeader (ProtoCrypto proto)
forall c. Hash c EraIndependentBlockHeader -> HashHeader c
SL.HashHeader Hash (ProtoCrypto proto) 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 = Version
-> Decoder s (ByteString -> ShelleyBlock proto era)
-> Decoder s (ByteString -> ShelleyBlock proto era)
forall s a. Version -> Decoder s a -> Decoder s a
toPlainDecoder (forall era. Era era => Version
eraProtVerLow @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 = Version
-> Decoder s (ByteString -> Header (ShelleyBlock proto era))
-> Decoder s (ByteString -> Header (ShelleyBlock proto era))
forall s a. Version -> Decoder s a -> Decoder s a
toPlainDecoder (forall era. Era era => Version
eraProtVerLow @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