{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingVia                #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE TypeFamilyDependencies     #-}
{-# LANGUAGE UndecidableSuperClasses    #-}
module Ouroboros.Consensus.Shelley.Ledger.Block (
    GetHeader (..)
  , Header (..)
  , NestedCtxt_ (..)
  , ShelleyBasedEra
  , ShelleyBlock (..)
  , ShelleyHash (..)
    -- * Shelley Compatibility
  , ShelleyCompatible
  , mkShelleyBlock
  , mkShelleyHeader
    -- * Serialisation
  , decodeShelleyBlock
  , decodeShelleyHeader
  , encodeShelleyBlock
  , encodeShelleyHeader
  , shelleyBinaryBlockInfo
    -- * Conversion
  , fromShelleyPrevHash
  , toShelleyPrevHash
  ) where

import           Codec.CBOR.Decoding (Decoder)
import           Codec.CBOR.Encoding (Encoding)
import qualified Data.ByteString.Lazy as Lazy
import           Data.Coerce (coerce)
import           Data.Typeable (Typeable)
import           GHC.Generics (Generic)
import           NoThunks.Class (NoThunks (..))

import           Cardano.Binary (Annotator (..), FromCBOR (..),
                     FullByteString (..), ToCBOR (..), serialize)
import qualified Cardano.Crypto.Hash as Crypto

import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.HeaderValidation
import           Ouroboros.Consensus.Storage.Common (BinaryBlockInfo (..))
import           Ouroboros.Consensus.Util (ShowProxy (..), hashFromBytesShortE)
import           Ouroboros.Consensus.Util.Condense

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           Ouroboros.Consensus.HardFork.Combinator
                     (HasPartialConsensusConfig)
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.Serialisation (DecodeDisk,
                     EncodeDisk)

{-------------------------------------------------------------------------------
  ShelleyCompatible
-------------------------------------------------------------------------------}
class
  ( ShelleyBasedEra era
  , ShelleyProtocol proto
    -- Header constraints
  , Eq (ShelleyProtocolHeader proto)
  , Show (ShelleyProtocolHeader proto)
  , NoThunks (ShelleyProtocolHeader proto)
  , ToCBOR (ShelleyProtocolHeader proto)
  , FromCBOR (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
  , FromCBOR (SL.PState (ProtoCrypto proto))
  ) => ShelleyCompatible proto era

instance ShelleyCompatible proto era => ConvertRawHash (ShelleyBlock proto era) where
  toShortRawHash :: 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 :: 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 :: 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 (Proxy (HASH (EraCrypto era))
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 {
      ShelleyBlock proto era -> Block (ShelleyProtocolHeader proto) era
shelleyBlockRaw        :: !(SL.Block (ShelleyProtocolHeader 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 :: Block (ShelleyProtocolHeader proto) era -> ShelleyBlock proto era
mkShelleyBlock Block (ShelleyProtocolHeader proto) era
raw = ShelleyBlock :: forall proto era.
Block (ShelleyProtocolHeader proto) era
-> ShelleyHash (ProtoCrypto proto) -> ShelleyBlock proto era
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
    }

data instance Header (ShelleyBlock proto era) = ShelleyHeader {
      Header (ShelleyBlock proto era) -> ShelleyProtocolHeader proto
shelleyHeaderRaw  :: !(ShelleyProtocolHeader proto)
    , 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
$cto :: forall proto era x.
Rep (Header (ShelleyBlock proto era)) x
-> Header (ShelleyBlock proto era)
$cfrom :: forall proto era x.
Header (ShelleyBlock proto era)
-> Rep (Header (ShelleyBlock proto era)) x
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 :: forall proto era.
ShelleyProtocolHeader proto
-> ShelleyHash (ProtoCrypto proto)
-> Header (ShelleyBlock proto era)
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.
      TxSeq era -> Hash (HASH (Crypto era)) EraIndependentBlockBody
forall era.
EraSegWits era =>
TxSeq era -> Hash (HASH (Crypto 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 = shelleyHdr }     = Header (ShelleyBlock proto era)
hdr
      ShelleyBlock  { shelleyBlockRaw :: forall proto era.
ShelleyBlock proto era -> Block (ShelleyProtocolHeader proto) era
shelleyBlockRaw  = SL.Block _ 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 :: ShelleyProtocolHeader proto -> Header (ShelleyBlock proto era)
mkShelleyHeader ShelleyProtocolHeader proto
raw = ShelleyHeader :: forall proto era.
ShelleyProtocolHeader proto
-> ShelleyHash (ProtoCrypto proto)
-> Header (ShelleyBlock proto era)
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 :: forall b. SlotNo -> BlockNo -> HeaderHash b -> HeaderFields b
HeaderFields {
      headerFieldHash :: HeaderHash (Header (ShelleyBlock proto era))
headerFieldHash    = ShelleyProtocolHeader proto -> ShelleyHash (ProtoCrypto proto)
forall proto.
ProtocolHeaderSupportsEnvelope proto =>
ShelleyProtocolHeader proto -> ShelleyHash (ProtoCrypto proto)
pHeaderHash (ShelleyProtocolHeader proto -> ShelleyHash (ProtoCrypto proto))
-> (Header (ShelleyBlock proto era) -> ShelleyProtocolHeader proto)
-> Header (ShelleyBlock proto era)
-> ShelleyHash (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 (Header (ShelleyBlock proto era)
 -> ShelleyHash (ProtoCrypto proto))
-> Header (ShelleyBlock proto era)
-> ShelleyHash (ProtoCrypto proto)
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
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 (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 :: PrevHash (EraCrypto era) -> ChainHash (ShelleyBlock proto era)
fromShelleyPrevHash PrevHash (EraCrypto era)
SL.GenesisHash   = ChainHash (ShelleyBlock proto era)
forall b. ChainHash b
GenesisHash
fromShelleyPrevHash (SL.BlockHash HashHeader (EraCrypto era)
h) = HeaderHash (ShelleyBlock proto era)
-> ChainHash (ShelleyBlock proto era)
forall b. 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 crypto.
HashHeader crypto -> Hash crypto 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 :: ChainHash (Header (ShelleyBlock proto era))
-> PrevHash (EraCrypto era)
toShelleyPrevHash ChainHash (Header (ShelleyBlock proto era))
GenesisHash                 = PrevHash (EraCrypto era)
forall crypto. PrevHash crypto
SL.GenesisHash
toShelleyPrevHash (BlockHash (ShelleyHash h)) = HashHeader (ProtoCrypto proto) -> PrevHash (ProtoCrypto proto)
forall crypto. HashHeader crypto -> PrevHash crypto
SL.BlockHash (HashHeader (ProtoCrypto proto) -> PrevHash (ProtoCrypto proto))
-> HashHeader (ProtoCrypto proto) -> PrevHash (ProtoCrypto proto)
forall a b. (a -> b) -> a -> b
$ Hash (ProtoCrypto proto) EraIndependentBlockHeader
-> HashHeader (ProtoCrypto proto)
forall crypto.
Hash crypto EraIndependentBlockHeader -> HashHeader crypto
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 :: NestedCtxt_ (ShelleyBlock proto era) f a
-> NestedCtxt_ (ShelleyBlock proto era) f b -> a :~: b
hasSingleIndex NestedCtxt_ (ShelleyBlock proto era) f a
CtxtShelley NestedCtxt_ (ShelleyBlock proto era) f b
CtxtShelley = 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
  (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 => ToCBOR (ShelleyBlock proto era) where
  -- Don't encode the header hash, we recompute it during deserialisation
  toCBOR :: ShelleyBlock proto era -> Encoding
toCBOR = Block (ShelleyProtocolHeader proto) era -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (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 => FromCBOR (Annotator (ShelleyBlock proto era)) where
  fromCBOR :: Decoder s (Annotator (ShelleyBlock proto era))
fromCBOR = (Block (ShelleyProtocolHeader proto) era -> ShelleyBlock proto era)
-> Annotator (Block (ShelleyProtocolHeader proto) era)
-> Annotator (ShelleyBlock proto era)
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 a s. FromCBOR a => Decoder s a
fromCBOR

instance ShelleyCompatible proto era => ToCBOR (Header (ShelleyBlock proto era)) where
  -- Don't encode the header hash, we recompute it during deserialisation
  toCBOR :: Header (ShelleyBlock proto era) -> Encoding
toCBOR = ShelleyProtocolHeader proto -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (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 => FromCBOR (Annotator (Header (ShelleyBlock proto era))) where
  fromCBOR :: Decoder s (Annotator (Header (ShelleyBlock proto era)))
fromCBOR = (ShelleyProtocolHeader proto -> Header (ShelleyBlock proto era))
-> Annotator (ShelleyProtocolHeader proto)
-> Annotator (Header (ShelleyBlock proto era))
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 a s. FromCBOR a => Decoder s a
fromCBOR

encodeShelleyBlock :: ShelleyCompatible proto era => ShelleyBlock proto era-> Encoding
encodeShelleyBlock :: ShelleyBlock proto era -> Encoding
encodeShelleyBlock = ShelleyBlock proto era -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR

decodeShelleyBlock :: ShelleyCompatible proto era => Decoder s (Lazy.ByteString -> ShelleyBlock proto era)
decodeShelleyBlock :: Decoder s (ByteString -> ShelleyBlock proto era)
decodeShelleyBlock = ((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 a s. FromCBOR a => Decoder s a
fromCBOR

shelleyBinaryBlockInfo :: ShelleyCompatible proto era => ShelleyBlock proto era-> BinaryBlockInfo
shelleyBinaryBlockInfo :: ShelleyBlock proto era -> BinaryBlockInfo
shelleyBinaryBlockInfo ShelleyBlock proto era
blk = BinaryBlockInfo :: Word16 -> Word16 -> BinaryBlockInfo
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 (Header (ShelleyBlock proto era) -> ByteString
forall a. ToCBOR a => a -> ByteString
serialize (ShelleyBlock proto era -> Header (ShelleyBlock proto era)
forall blk. GetHeader blk => blk -> Header blk
getHeader ShelleyBlock proto era
blk))
    }

encodeShelleyHeader :: ShelleyCompatible proto era => Header (ShelleyBlock proto era) -> Encoding
encodeShelleyHeader :: Header (ShelleyBlock proto era) -> Encoding
encodeShelleyHeader = Header (ShelleyBlock proto era) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR

decodeShelleyHeader :: ShelleyCompatible proto era => Decoder s (Lazy.ByteString -> Header (ShelleyBlock proto era))
decodeShelleyHeader :: Decoder s (ByteString -> Header (ShelleyBlock proto era))
decodeShelleyHeader = ((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 a s. FromCBOR a => Decoder s a
fromCBOR

{-------------------------------------------------------------------------------
  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