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

import           Codec.CBOR.Decoding (Decoder)
import           Codec.CBOR.Encoding (Encoding)
import           Codec.Serialise (Serialise (..))
import qualified Data.ByteString.Lazy as Lazy
import           Data.Coerce (coerce)
import           Data.FingerTree.Strict (Measured (..))
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 (Crypto, HASH)
import qualified Shelley.Spec.Ledger.API as SL

import           Ouroboros.Consensus.Shelley.Eras

{-------------------------------------------------------------------------------
  Header hash
-------------------------------------------------------------------------------}

newtype ShelleyHash c = ShelleyHash {
      ShelleyHash c -> HashHeader c
unShelleyHash :: SL.HashHeader c
    }
  deriving stock    (ShelleyHash c -> ShelleyHash c -> Bool
(ShelleyHash c -> ShelleyHash c -> Bool)
-> (ShelleyHash c -> ShelleyHash c -> Bool) -> Eq (ShelleyHash c)
forall c. ShelleyHash c -> ShelleyHash c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShelleyHash c -> ShelleyHash c -> Bool
$c/= :: forall c. ShelleyHash c -> ShelleyHash c -> Bool
== :: ShelleyHash c -> ShelleyHash c -> Bool
$c== :: forall c. ShelleyHash c -> ShelleyHash c -> Bool
Eq, Eq (ShelleyHash c)
Eq (ShelleyHash c)
-> (ShelleyHash c -> ShelleyHash c -> Ordering)
-> (ShelleyHash c -> ShelleyHash c -> Bool)
-> (ShelleyHash c -> ShelleyHash c -> Bool)
-> (ShelleyHash c -> ShelleyHash c -> Bool)
-> (ShelleyHash c -> ShelleyHash c -> Bool)
-> (ShelleyHash c -> ShelleyHash c -> ShelleyHash c)
-> (ShelleyHash c -> ShelleyHash c -> ShelleyHash c)
-> Ord (ShelleyHash c)
ShelleyHash c -> ShelleyHash c -> Bool
ShelleyHash c -> ShelleyHash c -> Ordering
ShelleyHash c -> ShelleyHash c -> ShelleyHash c
forall c. Eq (ShelleyHash c)
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall c. ShelleyHash c -> ShelleyHash c -> Bool
forall c. ShelleyHash c -> ShelleyHash c -> Ordering
forall c. ShelleyHash c -> ShelleyHash c -> ShelleyHash c
min :: ShelleyHash c -> ShelleyHash c -> ShelleyHash c
$cmin :: forall c. ShelleyHash c -> ShelleyHash c -> ShelleyHash c
max :: ShelleyHash c -> ShelleyHash c -> ShelleyHash c
$cmax :: forall c. ShelleyHash c -> ShelleyHash c -> ShelleyHash c
>= :: ShelleyHash c -> ShelleyHash c -> Bool
$c>= :: forall c. ShelleyHash c -> ShelleyHash c -> Bool
> :: ShelleyHash c -> ShelleyHash c -> Bool
$c> :: forall c. ShelleyHash c -> ShelleyHash c -> Bool
<= :: ShelleyHash c -> ShelleyHash c -> Bool
$c<= :: forall c. ShelleyHash c -> ShelleyHash c -> Bool
< :: ShelleyHash c -> ShelleyHash c -> Bool
$c< :: forall c. ShelleyHash c -> ShelleyHash c -> Bool
compare :: ShelleyHash c -> ShelleyHash c -> Ordering
$ccompare :: forall c. ShelleyHash c -> ShelleyHash c -> Ordering
$cp1Ord :: forall c. Eq (ShelleyHash c)
Ord, Int -> ShelleyHash c -> ShowS
[ShelleyHash c] -> ShowS
ShelleyHash c -> String
(Int -> ShelleyHash c -> ShowS)
-> (ShelleyHash c -> String)
-> ([ShelleyHash c] -> ShowS)
-> Show (ShelleyHash c)
forall c. Int -> ShelleyHash c -> ShowS
forall c. [ShelleyHash c] -> ShowS
forall c. ShelleyHash c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShelleyHash c] -> ShowS
$cshowList :: forall c. [ShelleyHash c] -> ShowS
show :: ShelleyHash c -> String
$cshow :: forall c. ShelleyHash c -> String
showsPrec :: Int -> ShelleyHash c -> ShowS
$cshowsPrec :: forall c. Int -> ShelleyHash c -> ShowS
Show, (forall x. ShelleyHash c -> Rep (ShelleyHash c) x)
-> (forall x. Rep (ShelleyHash c) x -> ShelleyHash c)
-> Generic (ShelleyHash c)
forall x. Rep (ShelleyHash c) x -> ShelleyHash c
forall x. ShelleyHash c -> Rep (ShelleyHash c) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x. Rep (ShelleyHash c) x -> ShelleyHash c
forall c x. ShelleyHash c -> Rep (ShelleyHash c) x
$cto :: forall c x. Rep (ShelleyHash c) x -> ShelleyHash c
$cfrom :: forall c x. ShelleyHash c -> Rep (ShelleyHash c) x
Generic)
  deriving newtype  (Typeable (ShelleyHash c)
Typeable (ShelleyHash c)
-> (ShelleyHash c -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (ShelleyHash c) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [ShelleyHash c] -> Size)
-> ToCBOR (ShelleyHash c)
ShelleyHash c -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [ShelleyHash c] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (ShelleyHash c) -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
forall c. Crypto c => Typeable (ShelleyHash c)
forall c. Crypto c => ShelleyHash c -> Encoding
forall c.
Crypto c =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [ShelleyHash c] -> Size
forall c.
Crypto c =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (ShelleyHash c) -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [ShelleyHash c] -> Size
$cencodedListSizeExpr :: forall c.
Crypto c =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [ShelleyHash c] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (ShelleyHash c) -> Size
$cencodedSizeExpr :: forall c.
Crypto c =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (ShelleyHash c) -> Size
toCBOR :: ShelleyHash c -> Encoding
$ctoCBOR :: forall c. Crypto c => ShelleyHash c -> Encoding
$cp1ToCBOR :: forall c. Crypto c => Typeable (ShelleyHash c)
ToCBOR, Typeable (ShelleyHash c)
Decoder s (ShelleyHash c)
Typeable (ShelleyHash c)
-> (forall s. Decoder s (ShelleyHash c))
-> (Proxy (ShelleyHash c) -> Text)
-> FromCBOR (ShelleyHash c)
Proxy (ShelleyHash c) -> Text
forall s. Decoder s (ShelleyHash c)
forall a.
Typeable a
-> (forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
forall c. Crypto c => Typeable (ShelleyHash c)
forall c. Crypto c => Proxy (ShelleyHash c) -> Text
forall c s. Crypto c => Decoder s (ShelleyHash c)
label :: Proxy (ShelleyHash c) -> Text
$clabel :: forall c. Crypto c => Proxy (ShelleyHash c) -> Text
fromCBOR :: Decoder s (ShelleyHash c)
$cfromCBOR :: forall c s. Crypto c => Decoder s (ShelleyHash c)
$cp1FromCBOR :: forall c. Crypto c => Typeable (ShelleyHash c)
FromCBOR)
  deriving anyclass (Context -> ShelleyHash c -> IO (Maybe ThunkInfo)
Proxy (ShelleyHash c) -> String
(Context -> ShelleyHash c -> IO (Maybe ThunkInfo))
-> (Context -> ShelleyHash c -> IO (Maybe ThunkInfo))
-> (Proxy (ShelleyHash c) -> String)
-> NoThunks (ShelleyHash c)
forall c. Context -> ShelleyHash c -> IO (Maybe ThunkInfo)
forall c. Proxy (ShelleyHash c) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (ShelleyHash c) -> String
$cshowTypeOf :: forall c. Proxy (ShelleyHash c) -> String
wNoThunks :: Context -> ShelleyHash c -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall c. Context -> ShelleyHash c -> IO (Maybe ThunkInfo)
noThunks :: Context -> ShelleyHash c -> IO (Maybe ThunkInfo)
$cnoThunks :: forall c. Context -> ShelleyHash c -> IO (Maybe ThunkInfo)
NoThunks)

instance Crypto c => Serialise (ShelleyHash c) where
  encode :: ShelleyHash c -> Encoding
encode = ShelleyHash c -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
  decode :: Decoder s (ShelleyHash c)
decode = Decoder s (ShelleyHash c)
forall a s. FromCBOR a => Decoder s a
fromCBOR

instance Condense (ShelleyHash c) where
  condense :: ShelleyHash c -> String
condense = HashHeader c -> String
forall a. Show a => a -> String
show (HashHeader c -> String)
-> (ShelleyHash c -> HashHeader c) -> ShelleyHash c -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyHash c -> HashHeader c
forall c. ShelleyHash c -> HashHeader c
unShelleyHash

instance ShelleyBasedEra era => ConvertRawHash (ShelleyBlock era) where
  toShortRawHash :: proxy (ShelleyBlock era)
-> HeaderHash (ShelleyBlock era) -> ShortByteString
toShortRawHash   proxy (ShelleyBlock era)
_ = Hash (HASH (Crypto era)) (BHeader (Crypto era)) -> ShortByteString
forall h a. Hash h a -> ShortByteString
Crypto.hashToBytesShort (Hash (HASH (Crypto era)) (BHeader (Crypto era))
 -> ShortByteString)
-> (ShelleyHash (Crypto era)
    -> Hash (HASH (Crypto era)) (BHeader (Crypto era)))
-> ShelleyHash (Crypto era)
-> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashHeader (Crypto era)
-> Hash (HASH (Crypto era)) (BHeader (Crypto era))
forall crypto. HashHeader crypto -> Hash crypto (BHeader crypto)
SL.unHashHeader (HashHeader (Crypto era)
 -> Hash (HASH (Crypto era)) (BHeader (Crypto era)))
-> (ShelleyHash (Crypto era) -> HashHeader (Crypto era))
-> ShelleyHash (Crypto era)
-> Hash (HASH (Crypto era)) (BHeader (Crypto era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyHash (Crypto era) -> HashHeader (Crypto era)
forall c. ShelleyHash c -> HashHeader c
unShelleyHash
  fromShortRawHash :: proxy (ShelleyBlock era)
-> ShortByteString -> HeaderHash (ShelleyBlock era)
fromShortRawHash proxy (ShelleyBlock era)
_ = HashHeader (Crypto era) -> ShelleyHash (Crypto era)
forall c. HashHeader c -> ShelleyHash c
ShelleyHash (HashHeader (Crypto era) -> ShelleyHash (Crypto era))
-> (ShortByteString -> HashHeader (Crypto era))
-> ShortByteString
-> ShelleyHash (Crypto era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash (HASH (Crypto era)) (BHeader (Crypto era))
-> HashHeader (Crypto era)
forall crypto. Hash crypto (BHeader crypto) -> HashHeader crypto
SL.HashHeader (Hash (HASH (Crypto era)) (BHeader (Crypto era))
 -> HashHeader (Crypto era))
-> (ShortByteString
    -> Hash (HASH (Crypto era)) (BHeader (Crypto era)))
-> ShortByteString
-> HashHeader (Crypto era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> Hash (HASH (Crypto era)) (BHeader (Crypto era))
forall h a.
(HashAlgorithm h, HasCallStack) =>
ShortByteString -> Hash h a
hashFromBytesShortE
  hashSize :: proxy (ShelleyBlock era) -> Word32
hashSize         proxy (ShelleyBlock 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 (Crypto era)) -> Word
forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
Crypto.sizeHash (Proxy (HASH (Crypto era))
forall k (t :: k). Proxy t
Proxy @(HASH (EraCrypto era)))

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

-- | Newtype wrapper to avoid orphan instances
--
-- The phantom type parameter is there to record the additional information
-- we need to work with this block. Most of the code here does not care,
-- but we may need different additional information when running the chain.
data ShelleyBlock era = ShelleyBlock {
      ShelleyBlock era -> Block era
shelleyBlockRaw        :: !(SL.Block era)
    , ShelleyBlock era -> ShelleyHash (EraCrypto era)
shelleyBlockHeaderHash :: !(ShelleyHash (EraCrypto era))
    }

deriving instance ShelleyBasedEra era => Show (ShelleyBlock era)
deriving instance ShelleyBasedEra era => Eq   (ShelleyBlock era)

instance Typeable era => ShowProxy (ShelleyBlock era) where

type instance HeaderHash (ShelleyBlock era) = ShelleyHash (EraCrypto era)

mkShelleyBlock :: ShelleyBasedEra era => SL.Block era -> ShelleyBlock era
mkShelleyBlock :: Block era -> ShelleyBlock era
mkShelleyBlock Block era
raw = ShelleyBlock :: forall era.
Block era -> ShelleyHash (EraCrypto era) -> ShelleyBlock era
ShelleyBlock {
      shelleyBlockRaw :: Block era
shelleyBlockRaw        = Block era
raw
    , shelleyBlockHeaderHash :: ShelleyHash (EraCrypto era)
shelleyBlockHeaderHash = HashHeader (EraCrypto era) -> ShelleyHash (EraCrypto era)
forall c. HashHeader c -> ShelleyHash c
ShelleyHash (BHeader (EraCrypto era) -> HashHeader (EraCrypto era)
forall crypto. Crypto crypto => BHeader crypto -> HashHeader crypto
SL.bhHash (Block era -> BHeader (EraCrypto era)
forall era. Era era => Block era -> BHeader (Crypto era)
SL.bheader Block era
raw))
    }

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

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

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

instance ShelleyBasedEra era => GetHeader (ShelleyBlock era) where
  getHeader :: ShelleyBlock era -> Header (ShelleyBlock era)
getHeader (ShelleyBlock Block era
rawBlk ShelleyHash (EraCrypto era)
hdrHash) = ShelleyHeader :: forall era.
BHeader (EraCrypto era)
-> ShelleyHash (EraCrypto era) -> Header (ShelleyBlock era)
ShelleyHeader {
      shelleyHeaderRaw :: BHeader (EraCrypto era)
shelleyHeaderRaw  = Block era -> BHeader (EraCrypto era)
forall era. Era era => Block era -> BHeader (Crypto era)
SL.bheader Block era
rawBlk
    , shelleyHeaderHash :: ShelleyHash (EraCrypto era)
shelleyHeaderHash = ShelleyHash (EraCrypto era)
hdrHash
    }

  blockMatchesHeader :: Header (ShelleyBlock era) -> ShelleyBlock era -> Bool
blockMatchesHeader Header (ShelleyBlock era)
hdr ShelleyBlock 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 -> HashBBody (EraCrypto era)
forall era. Era era => TxSeq era -> HashBBody (Crypto era)
SL.bbHash TxSeq era
txs HashBBody (EraCrypto era) -> HashBBody (EraCrypto era) -> Bool
forall a. Eq a => a -> a -> Bool
== BHBody (EraCrypto era) -> HashBBody (EraCrypto era)
forall crypto. BHBody crypto -> HashBBody crypto
SL.bhash BHBody (EraCrypto era)
hdrBody
    where
      ShelleyHeader { shelleyHeaderRaw = SL.BHeader hdrBody _ } = Header (ShelleyBlock era)
hdr
      ShelleyBlock  { shelleyBlockRaw :: forall era. ShelleyBlock era -> Block era
shelleyBlockRaw  = SL.Block BHeader (EraCrypto era)
_ TxSeq era
txs }       = ShelleyBlock era
blk

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

mkShelleyHeader ::
     ShelleyBasedEra era
  => SL.BHeader (EraCrypto era) -> Header (ShelleyBlock era)
mkShelleyHeader :: BHeader (EraCrypto era) -> Header (ShelleyBlock era)
mkShelleyHeader BHeader (EraCrypto era)
raw = ShelleyHeader :: forall era.
BHeader (EraCrypto era)
-> ShelleyHash (EraCrypto era) -> Header (ShelleyBlock era)
ShelleyHeader {
      shelleyHeaderRaw :: BHeader (EraCrypto era)
shelleyHeaderRaw  = BHeader (EraCrypto era)
raw
    , shelleyHeaderHash :: ShelleyHash (EraCrypto era)
shelleyHeaderHash = HashHeader (EraCrypto era) -> ShelleyHash (EraCrypto era)
forall c. HashHeader c -> ShelleyHash c
ShelleyHash (BHeader (EraCrypto era) -> HashHeader (EraCrypto era)
forall crypto. Crypto crypto => BHeader crypto -> HashHeader crypto
SL.bhHash BHeader (EraCrypto era)
raw)
    }

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

instance ShelleyBasedEra era => HasHeader (Header (ShelleyBlock era)) where
  getHeaderFields :: Header (ShelleyBlock era)
-> HeaderFields (Header (ShelleyBlock era))
getHeaderFields Header (ShelleyBlock era)
hdr = HeaderFields :: forall b. SlotNo -> BlockNo -> HeaderHash b -> HeaderFields b
HeaderFields {
      headerFieldHash :: HeaderHash (Header (ShelleyBlock era))
headerFieldHash    = Header (ShelleyBlock era) -> ShelleyHash (EraCrypto era)
forall era.
Header (ShelleyBlock era) -> ShelleyHash (EraCrypto era)
shelleyHeaderHash Header (ShelleyBlock era)
hdr
    , headerFieldSlot :: SlotNo
headerFieldSlot    =          BHBody (EraCrypto era) -> SlotNo
forall crypto. BHBody crypto -> SlotNo
SL.bheaderSlotNo  (BHBody (EraCrypto era) -> SlotNo)
-> (Header (ShelleyBlock era) -> BHBody (EraCrypto era))
-> Header (ShelleyBlock era)
-> SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BHeader (EraCrypto era) -> BHBody (EraCrypto era)
forall crypto. Crypto crypto => BHeader crypto -> BHBody crypto
SL.bhbody (BHeader (EraCrypto era) -> BHBody (EraCrypto era))
-> (Header (ShelleyBlock era) -> BHeader (EraCrypto era))
-> Header (ShelleyBlock era)
-> BHBody (EraCrypto era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header (ShelleyBlock era) -> BHeader (EraCrypto era)
forall era. Header (ShelleyBlock era) -> BHeader (EraCrypto era)
shelleyHeaderRaw (Header (ShelleyBlock era) -> SlotNo)
-> Header (ShelleyBlock era) -> SlotNo
forall a b. (a -> b) -> a -> b
$ Header (ShelleyBlock era)
hdr
    , headerFieldBlockNo :: BlockNo
headerFieldBlockNo = BlockNo -> BlockNo
coerce (BlockNo -> BlockNo)
-> (Header (ShelleyBlock era) -> BlockNo)
-> Header (ShelleyBlock era)
-> BlockNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BHBody (EraCrypto era) -> BlockNo
forall crypto. BHBody crypto -> BlockNo
SL.bheaderBlockNo (BHBody (EraCrypto era) -> BlockNo)
-> (Header (ShelleyBlock era) -> BHBody (EraCrypto era))
-> Header (ShelleyBlock era)
-> BlockNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BHeader (EraCrypto era) -> BHBody (EraCrypto era)
forall crypto. Crypto crypto => BHeader crypto -> BHBody crypto
SL.bhbody (BHeader (EraCrypto era) -> BHBody (EraCrypto era))
-> (Header (ShelleyBlock era) -> BHeader (EraCrypto era))
-> Header (ShelleyBlock era)
-> BHBody (EraCrypto era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header (ShelleyBlock era) -> BHeader (EraCrypto era)
forall era. Header (ShelleyBlock era) -> BHeader (EraCrypto era)
shelleyHeaderRaw (Header (ShelleyBlock era) -> BlockNo)
-> Header (ShelleyBlock era) -> BlockNo
forall a b. (a -> b) -> a -> b
$ Header (ShelleyBlock era)
hdr
    }

instance ShelleyBasedEra era => GetPrevHash (ShelleyBlock era) where
  headerPrevHash :: Header (ShelleyBlock era) -> ChainHash (ShelleyBlock era)
headerPrevHash =
      PrevHash (Crypto era) -> ChainHash (ShelleyBlock era)
forall era.
PrevHash (EraCrypto era) -> ChainHash (ShelleyBlock era)
fromShelleyPrevHash
    (PrevHash (Crypto era) -> ChainHash (ShelleyBlock era))
-> (Header (ShelleyBlock era) -> PrevHash (Crypto era))
-> Header (ShelleyBlock era)
-> ChainHash (ShelleyBlock era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BHBody (Crypto era) -> PrevHash (Crypto era)
forall crypto. BHBody crypto -> PrevHash crypto
SL.bheaderPrev
    (BHBody (Crypto era) -> PrevHash (Crypto era))
-> (Header (ShelleyBlock era) -> BHBody (Crypto era))
-> Header (ShelleyBlock era)
-> PrevHash (Crypto era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BHeader (Crypto era) -> BHBody (Crypto era)
forall crypto. Crypto crypto => BHeader crypto -> BHBody crypto
SL.bhbody
    (BHeader (Crypto era) -> BHBody (Crypto era))
-> (Header (ShelleyBlock era) -> BHeader (Crypto era))
-> Header (ShelleyBlock era)
-> BHBody (Crypto era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header (ShelleyBlock era) -> BHeader (Crypto era)
forall era. Header (ShelleyBlock era) -> BHeader (EraCrypto era)
shelleyHeaderRaw

instance ShelleyBasedEra era => Measured BlockMeasure (ShelleyBlock era) where
  measure :: ShelleyBlock era -> BlockMeasure
measure = ShelleyBlock era -> BlockMeasure
forall b. HasHeader b => b -> BlockMeasure
blockMeasure

instance ShelleyBasedEra era => StandardHash (ShelleyBlock era)

instance ShelleyBasedEra era => HasAnnTip (ShelleyBlock 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 (EraCrypto era) -> ChainHash (ShelleyBlock era)
fromShelleyPrevHash :: PrevHash (EraCrypto era) -> ChainHash (ShelleyBlock era)
fromShelleyPrevHash PrevHash (EraCrypto era)
SL.GenesisHash   = ChainHash (ShelleyBlock era)
forall b. ChainHash b
GenesisHash
fromShelleyPrevHash (SL.BlockHash HashHeader (EraCrypto era)
h) = HeaderHash (ShelleyBlock era) -> ChainHash (ShelleyBlock era)
forall b. HeaderHash b -> ChainHash b
BlockHash (HashHeader (EraCrypto era) -> ShelleyHash (EraCrypto era)
forall c. HashHeader c -> ShelleyHash c
ShelleyHash HashHeader (EraCrypto era)
h)

-- | From @ouroboros-consensus@ to @cardano-ledger-specs@
toShelleyPrevHash :: ChainHash (Header (ShelleyBlock era)) -> SL.PrevHash (EraCrypto era)
toShelleyPrevHash :: ChainHash (Header (ShelleyBlock era)) -> PrevHash (EraCrypto era)
toShelleyPrevHash ChainHash (Header (ShelleyBlock era))
GenesisHash                 = PrevHash (EraCrypto era)
forall crypto. PrevHash crypto
SL.GenesisHash
toShelleyPrevHash (BlockHash (ShelleyHash h)) = HashHeader (EraCrypto era) -> PrevHash (EraCrypto era)
forall crypto. HashHeader crypto -> PrevHash crypto
SL.BlockHash HashHeader (EraCrypto era)
h

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

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

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

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

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

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

instance ShelleyBasedEra era => ToCBOR (ShelleyBlock era) where
  -- Don't encode the header hash, we recompute it during deserialisation
  toCBOR :: ShelleyBlock era -> Encoding
toCBOR = Block era -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Block era -> Encoding)
-> (ShelleyBlock era -> Block era) -> ShelleyBlock era -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyBlock era -> Block era
forall era. ShelleyBlock era -> Block era
shelleyBlockRaw

instance ShelleyBasedEra era => FromCBOR (Annotator (ShelleyBlock era)) where
  fromCBOR :: Decoder s (Annotator (ShelleyBlock era))
fromCBOR = (Block era -> ShelleyBlock era)
-> Annotator (Block era) -> Annotator (ShelleyBlock era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Block era -> ShelleyBlock era
forall era. ShelleyBasedEra era => Block era -> ShelleyBlock era
mkShelleyBlock (Annotator (Block era) -> Annotator (ShelleyBlock era))
-> Decoder s (Annotator (Block era))
-> Decoder s (Annotator (ShelleyBlock era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Annotator (Block era))
forall a s. FromCBOR a => Decoder s a
fromCBOR

instance ShelleyBasedEra era => ToCBOR (Header (ShelleyBlock era)) where
  -- Don't encode the header hash, we recompute it during deserialisation
  toCBOR :: Header (ShelleyBlock era) -> Encoding
toCBOR = BHeader (Crypto era) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (BHeader (Crypto era) -> Encoding)
-> (Header (ShelleyBlock era) -> BHeader (Crypto era))
-> Header (ShelleyBlock era)
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header (ShelleyBlock era) -> BHeader (Crypto era)
forall era. Header (ShelleyBlock era) -> BHeader (EraCrypto era)
shelleyHeaderRaw

instance ShelleyBasedEra era => FromCBOR (Annotator (Header (ShelleyBlock era))) where
  fromCBOR :: Decoder s (Annotator (Header (ShelleyBlock era)))
fromCBOR = (BHeader (Crypto era) -> Header (ShelleyBlock era))
-> Annotator (BHeader (Crypto era))
-> Annotator (Header (ShelleyBlock era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BHeader (Crypto era) -> Header (ShelleyBlock era)
forall era.
ShelleyBasedEra era =>
BHeader (EraCrypto era) -> Header (ShelleyBlock era)
mkShelleyHeader (Annotator (BHeader (Crypto era))
 -> Annotator (Header (ShelleyBlock era)))
-> Decoder s (Annotator (BHeader (Crypto era)))
-> Decoder s (Annotator (Header (ShelleyBlock era)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Annotator (BHeader (Crypto era)))
forall a s. FromCBOR a => Decoder s a
fromCBOR

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

decodeShelleyBlock :: ShelleyBasedEra era => Decoder s (Lazy.ByteString -> ShelleyBlock era)
decodeShelleyBlock :: Decoder s (ByteString -> ShelleyBlock era)
decodeShelleyBlock = ((FullByteString -> ShelleyBlock era)
-> (ByteString -> FullByteString) -> ByteString -> ShelleyBlock era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FullByteString
Full) ((FullByteString -> ShelleyBlock era)
 -> ByteString -> ShelleyBlock era)
-> (Annotator (ShelleyBlock era)
    -> FullByteString -> ShelleyBlock era)
-> Annotator (ShelleyBlock era)
-> ByteString
-> ShelleyBlock era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Annotator (ShelleyBlock era) -> FullByteString -> ShelleyBlock era
forall a. Annotator a -> FullByteString -> a
runAnnotator (Annotator (ShelleyBlock era) -> ByteString -> ShelleyBlock era)
-> Decoder s (Annotator (ShelleyBlock era))
-> Decoder s (ByteString -> ShelleyBlock era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Annotator (ShelleyBlock era))
forall a s. FromCBOR a => Decoder s a
fromCBOR

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

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

decodeShelleyHeader :: ShelleyBasedEra era => Decoder s (Lazy.ByteString -> Header (ShelleyBlock era))
decodeShelleyHeader :: Decoder s (ByteString -> Header (ShelleyBlock era))
decodeShelleyHeader = ((FullByteString -> Header (ShelleyBlock era))
-> (ByteString -> FullByteString)
-> ByteString
-> Header (ShelleyBlock era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FullByteString
Full) ((FullByteString -> Header (ShelleyBlock era))
 -> ByteString -> Header (ShelleyBlock era))
-> (Annotator (Header (ShelleyBlock era))
    -> FullByteString -> Header (ShelleyBlock era))
-> Annotator (Header (ShelleyBlock era))
-> ByteString
-> Header (ShelleyBlock era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Annotator (Header (ShelleyBlock era))
-> FullByteString -> Header (ShelleyBlock era)
forall a. Annotator a -> FullByteString -> a
runAnnotator (Annotator (Header (ShelleyBlock era))
 -> ByteString -> Header (ShelleyBlock era))
-> Decoder s (Annotator (Header (ShelleyBlock era)))
-> Decoder s (ByteString -> Header (ShelleyBlock era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Annotator (Header (ShelleyBlock era)))
forall a s. FromCBOR a => Decoder s a
fromCBOR

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

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

instance ShelleyBasedEra era => Condense (Header (ShelleyBlock era)) where
  condense :: Header (ShelleyBlock era) -> String
condense = BHeader (Crypto era) -> String
forall a. Show a => a -> String
show (BHeader (Crypto era) -> String)
-> (Header (ShelleyBlock era) -> BHeader (Crypto era))
-> Header (ShelleyBlock era)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header (ShelleyBlock era) -> BHeader (Crypto era)
forall era. Header (ShelleyBlock era) -> BHeader (EraCrypto era)
shelleyHeaderRaw