{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE NamedFieldPuns             #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE TypeFamilies               #-}

module Ouroboros.Consensus.Byron.Ledger.Block (
    -- * Hash
    ByronHash (..)
  , mkByronHash
    -- * Block
  , ByronBlock (..)
  , annotateByronBlock
  , mkByronBlock
    -- * Header
  , Header (..)
  , mkBoundaryByronHeader
  , mkByronHeader
  , mkRegularByronHeader
    -- * Dealing with EBBs
  , byronBlockIsEBB
  , byronHeaderIsEBB
  , knownEBBs
    -- * Low-level API
  , UnsizedHeader (..)
  , joinSizeHint
  , mkUnsizedHeader
  , splitSizeHint
  ) where

import           Data.ByteString (ByteString)
import qualified Data.ByteString as Strict
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Data.Proxy
import           Data.Typeable
import           GHC.Generics (Generic)
import           NoThunks.Class (NoThunks (..))

import           Cardano.Binary

import qualified Crypto.Hash as Crypto

import qualified Cardano.Chain.Block as CC
import qualified Cardano.Chain.Byron.API as CC
import qualified Cardano.Chain.Slotting as CC
import qualified Cardano.Crypto.Hashing as CC

import           Ouroboros.Network.DeltaQ (SizeInBytes)

import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Util (ShowProxy (..))
import           Ouroboros.Consensus.Util.Condense

import qualified Ouroboros.Consensus.Byron.EBBs as EBBs
import           Ouroboros.Consensus.Byron.Ledger.Conversions
import           Ouroboros.Consensus.Byron.Ledger.Orphans ()

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

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

mkByronHash :: CC.ABlockOrBoundaryHdr ByteString -> ByronHash
mkByronHash :: ABlockOrBoundaryHdr ByteString -> ByronHash
mkByronHash = HeaderHash -> ByronHash
ByronHash (HeaderHash -> ByronHash)
-> (ABlockOrBoundaryHdr ByteString -> HeaderHash)
-> ABlockOrBoundaryHdr ByteString
-> ByronHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ABlockOrBoundaryHdr ByteString -> HeaderHash
CC.abobHdrHash

instance ConvertRawHash ByronBlock where
  toShortRawHash :: proxy ByronBlock -> HeaderHash ByronBlock -> ShortByteString
toShortRawHash   proxy ByronBlock
_ = HeaderHash -> ShortByteString
forall algo a. AbstractHash algo a -> ShortByteString
CC.abstractHashToShort (HeaderHash -> ShortByteString)
-> (ByronHash -> HeaderHash) -> ByronHash -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByronHash -> HeaderHash
unByronHash
  fromShortRawHash :: proxy ByronBlock -> ShortByteString -> HeaderHash ByronBlock
fromShortRawHash proxy ByronBlock
_ = HeaderHash -> ByronHash
ByronHash (HeaderHash -> ByronHash)
-> (ShortByteString -> HeaderHash) -> ShortByteString -> ByronHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> HeaderHash
forall algo a. ShortByteString -> AbstractHash algo a
CC.unsafeAbstractHashFromShort
  hashSize :: proxy ByronBlock -> Word32
hashSize         proxy ByronBlock
_ = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ Blake2b_256 -> Int
forall a. HashAlgorithm a => a -> Int
Crypto.hashDigestSize
                                        (String -> Blake2b_256
forall a. HasCallStack => String -> a
error String
"proxy" :: Crypto.Blake2b_256)

{-------------------------------------------------------------------------------
  Block
-------------------------------------------------------------------------------}

-- | Byron block
--
-- We cache two bits of information:
--
-- * We cache the slot number as this is not readily available for EBBs.
--   Having it cached allows us to e.g. give a 'HasHeader' instance.
-- * We cache the hash as this is expensive to compute and we need it often.
data ByronBlock = ByronBlock {
      ByronBlock -> ABlockOrBoundary ByteString
byronBlockRaw    :: !(CC.ABlockOrBoundary ByteString)
    , ByronBlock -> SlotNo
byronBlockSlotNo :: !SlotNo
    , ByronBlock -> ByronHash
byronBlockHash   :: !ByronHash
    }
  deriving (ByronBlock -> ByronBlock -> Bool
(ByronBlock -> ByronBlock -> Bool)
-> (ByronBlock -> ByronBlock -> Bool) -> Eq ByronBlock
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ByronBlock -> ByronBlock -> Bool
$c/= :: ByronBlock -> ByronBlock -> Bool
== :: ByronBlock -> ByronBlock -> Bool
$c== :: ByronBlock -> ByronBlock -> Bool
Eq, Int -> ByronBlock -> ShowS
[ByronBlock] -> ShowS
ByronBlock -> String
(Int -> ByronBlock -> ShowS)
-> (ByronBlock -> String)
-> ([ByronBlock] -> ShowS)
-> Show ByronBlock
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ByronBlock] -> ShowS
$cshowList :: [ByronBlock] -> ShowS
show :: ByronBlock -> String
$cshow :: ByronBlock -> String
showsPrec :: Int -> ByronBlock -> ShowS
$cshowsPrec :: Int -> ByronBlock -> ShowS
Show)

instance Condense ByronBlock where
  condense :: ByronBlock -> String
condense = ABlockOrBoundary ByteString -> String
forall a. Condense a => a -> String
condense (ABlockOrBoundary ByteString -> String)
-> (ByronBlock -> ABlockOrBoundary ByteString)
-> ByronBlock
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByronBlock -> ABlockOrBoundary ByteString
byronBlockRaw

instance ShowProxy ByronBlock where

mkByronBlock :: CC.EpochSlots -> CC.ABlockOrBoundary ByteString -> ByronBlock
mkByronBlock :: EpochSlots -> ABlockOrBoundary ByteString -> ByronBlock
mkByronBlock EpochSlots
epochSlots ABlockOrBoundary ByteString
blk = ByronBlock :: ABlockOrBoundary ByteString -> SlotNo -> ByronHash -> ByronBlock
ByronBlock {
      byronBlockRaw :: ABlockOrBoundary ByteString
byronBlockRaw    = ABlockOrBoundary ByteString
blk
    , byronBlockSlotNo :: SlotNo
byronBlockSlotNo = SlotNumber -> SlotNo
fromByronSlotNo (SlotNumber -> SlotNo) -> SlotNumber -> SlotNo
forall a b. (a -> b) -> a -> b
$ EpochSlots -> ABlockOrBoundaryHdr ByteString -> SlotNumber
forall a. EpochSlots -> ABlockOrBoundaryHdr a -> SlotNumber
CC.abobHdrSlotNo EpochSlots
epochSlots ABlockOrBoundaryHdr ByteString
hdr
    , byronBlockHash :: ByronHash
byronBlockHash   = ABlockOrBoundaryHdr ByteString -> ByronHash
mkByronHash ABlockOrBoundaryHdr ByteString
hdr
    }
  where
    hdr :: ABlockOrBoundaryHdr ByteString
hdr = ABlockOrBoundary ByteString -> ABlockOrBoundaryHdr ByteString
forall a. ABlockOrBoundary a -> ABlockOrBoundaryHdr a
CC.abobHdrFromBlock ABlockOrBoundary ByteString
blk

-- | Construct Byron block from unannotated 'CC.Block'
--
-- This should be used only when forging blocks (not when receiving blocks
-- over the wire).
annotateByronBlock :: CC.EpochSlots -> CC.Block -> ByronBlock
annotateByronBlock :: EpochSlots -> Block -> ByronBlock
annotateByronBlock EpochSlots
es = EpochSlots -> ABlockOrBoundary ByteString -> ByronBlock
mkByronBlock EpochSlots
es (ABlockOrBoundary ByteString -> ByronBlock)
-> (Block -> ABlockOrBoundary ByteString) -> Block -> ByronBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ABlock ByteString -> ABlockOrBoundary ByteString
forall a. ABlock a -> ABlockOrBoundary a
CC.ABOBBlock (ABlock ByteString -> ABlockOrBoundary ByteString)
-> (Block -> ABlock ByteString)
-> Block
-> ABlockOrBoundary ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochSlots -> Block -> ABlock ByteString
CC.reAnnotateBlock EpochSlots
es

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

-- | Byron header
--
-- See 'ByronBlock' for comments on why we cache certain values.
data instance Header ByronBlock = ByronHeader {
      Header ByronBlock -> ABlockOrBoundaryHdr ByteString
byronHeaderRaw    :: !(CC.ABlockOrBoundaryHdr ByteString)
    , Header ByronBlock -> SlotNo
byronHeaderSlotNo :: !SlotNo
    , Header ByronBlock -> ByronHash
byronHeaderHash   :: !ByronHash

      -- | Hint about the block size
      --
      -- This is used only for the block fetch client. When this value is
      -- wrong, block fetch might make suboptimal decisions, but it shouldn't
      -- /break/ anything
    , Header ByronBlock -> Word32
byronHeaderBlockSizeHint :: !SizeInBytes
    }
  deriving (Header ByronBlock -> Header ByronBlock -> Bool
(Header ByronBlock -> Header ByronBlock -> Bool)
-> (Header ByronBlock -> Header ByronBlock -> Bool)
-> Eq (Header ByronBlock)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Header ByronBlock -> Header ByronBlock -> Bool
$c/= :: Header ByronBlock -> Header ByronBlock -> Bool
== :: Header ByronBlock -> Header ByronBlock -> Bool
$c== :: Header ByronBlock -> Header ByronBlock -> Bool
Eq, Int -> Header ByronBlock -> ShowS
[Header ByronBlock] -> ShowS
Header ByronBlock -> String
(Int -> Header ByronBlock -> ShowS)
-> (Header ByronBlock -> String)
-> ([Header ByronBlock] -> ShowS)
-> Show (Header ByronBlock)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Header ByronBlock] -> ShowS
$cshowList :: [Header ByronBlock] -> ShowS
show :: Header ByronBlock -> String
$cshow :: Header ByronBlock -> String
showsPrec :: Int -> Header ByronBlock -> ShowS
$cshowsPrec :: Int -> Header ByronBlock -> ShowS
Show, (forall x. Header ByronBlock -> Rep (Header ByronBlock) x)
-> (forall x. Rep (Header ByronBlock) x -> Header ByronBlock)
-> Generic (Header ByronBlock)
forall x. Rep (Header ByronBlock) x -> Header ByronBlock
forall x. Header ByronBlock -> Rep (Header ByronBlock) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Header ByronBlock) x -> Header ByronBlock
$cfrom :: forall x. Header ByronBlock -> Rep (Header ByronBlock) x
Generic)

instance GetHeader ByronBlock where
  getHeader :: ByronBlock -> Header ByronBlock
getHeader ByronBlock{ABlockOrBoundary ByteString
SlotNo
ByronHash
byronBlockHash :: ByronHash
byronBlockSlotNo :: SlotNo
byronBlockRaw :: ABlockOrBoundary ByteString
byronBlockHash :: ByronBlock -> ByronHash
byronBlockSlotNo :: ByronBlock -> SlotNo
byronBlockRaw :: ByronBlock -> ABlockOrBoundary ByteString
..} = ByronHeader :: ABlockOrBoundaryHdr ByteString
-> SlotNo -> ByronHash -> Word32 -> Header ByronBlock
ByronHeader {
        byronHeaderRaw :: ABlockOrBoundaryHdr ByteString
byronHeaderRaw           = ABlockOrBoundary ByteString -> ABlockOrBoundaryHdr ByteString
forall a. ABlockOrBoundary a -> ABlockOrBoundaryHdr a
CC.abobHdrFromBlock ABlockOrBoundary ByteString
byronBlockRaw
      , byronHeaderSlotNo :: SlotNo
byronHeaderSlotNo        = SlotNo
byronBlockSlotNo
      , byronHeaderHash :: ByronHash
byronHeaderHash          = ByronHash
byronBlockHash
      , byronHeaderBlockSizeHint :: Word32
byronHeaderBlockSizeHint = (Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
overhead) (Word32 -> Word32)
-> (ByteString -> Word32) -> ByteString -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> (ByteString -> Int) -> ByteString -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
Strict.length (ByteString -> Word32) -> ByteString -> Word32
forall a b. (a -> b) -> a -> b
$
          -- For some reason regular blocks lack a 'Decoded' instance
          case ABlockOrBoundary ByteString
byronBlockRaw of
            CC.ABOBBlock    ABlock ByteString
blk -> ABlock ByteString -> ByteString
forall a. ABlock a -> a
CC.blockAnnotation ABlock ByteString
blk
            CC.ABOBBoundary ABoundaryBlock ByteString
blk -> ABoundaryBlock ByteString -> ByteString
forall t. Decoded t => t -> ByteString
recoverBytes       ABoundaryBlock ByteString
blk
      }
    where
      -- The maximum block size is 65536, the CBOR-in-CBOR tag for this block
      -- is:
      --
      -- > D8 18          # tag(24)
      -- >    1A 00010000 # bytes(65536)
      --
      -- Which is 7 bytes, enough for up to 4294967295 bytes.
      overhead :: Word32
overhead = Word32
7 {- CBOR-in-CBOR -} Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
2 {- EBB tag -}

  -- Check if a block matches its header
  --
  -- Note that we cannot check this for an EBB, as the EBB header doesn't
  -- store a hash of the EBB body.
  blockMatchesHeader :: Header ByronBlock -> ByronBlock -> Bool
blockMatchesHeader Header ByronBlock
hdr ByronBlock
blk =
      ABlockOrBoundaryHdr ByteString
-> ABlockOrBoundary ByteString -> Bool
CC.abobMatchesBody (Header ByronBlock -> ABlockOrBoundaryHdr ByteString
byronHeaderRaw Header ByronBlock
hdr) (ByronBlock -> ABlockOrBoundary ByteString
byronBlockRaw ByronBlock
blk)

  headerIsEBB :: Header ByronBlock -> Maybe EpochNo
headerIsEBB Header ByronBlock
hdr = case Header ByronBlock -> ABlockOrBoundaryHdr ByteString
byronHeaderRaw Header ByronBlock
hdr of
    CC.ABOBBlockHdr AHeader ByteString
_       -> Maybe EpochNo
forall a. Maybe a
Nothing
    CC.ABOBBoundaryHdr ABoundaryHeader ByteString
bhdr -> EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just
                              (EpochNo -> Maybe EpochNo)
-> (ABoundaryHeader ByteString -> EpochNo)
-> ABoundaryHeader ByteString
-> Maybe EpochNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EpochNo
EpochNo
                              (Word64 -> EpochNo)
-> (ABoundaryHeader ByteString -> Word64)
-> ABoundaryHeader ByteString
-> EpochNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ABoundaryHeader ByteString -> Word64
forall a. ABoundaryHeader a -> Word64
CC.boundaryEpoch
                              (ABoundaryHeader ByteString -> Maybe EpochNo)
-> ABoundaryHeader ByteString -> Maybe EpochNo
forall a b. (a -> b) -> a -> b
$ ABoundaryHeader ByteString
bhdr

instance Condense (Header ByronBlock) where
  condense :: Header ByronBlock -> String
condense = (AHeader ByteString -> String)
-> (ABoundaryHeader ByteString -> String)
-> ABlockOrBoundaryHdr ByteString
-> String
forall a b.
(AHeader a -> b)
-> (ABoundaryHeader a -> b) -> ABlockOrBoundaryHdr a -> b
CC.aBlockOrBoundaryHdr AHeader ByteString -> String
forall a. Condense a => a -> String
condense ABoundaryHeader ByteString -> String
forall a. Condense a => a -> String
condense (ABlockOrBoundaryHdr ByteString -> String)
-> (Header ByronBlock -> ABlockOrBoundaryHdr ByteString)
-> Header ByronBlock
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header ByronBlock -> ABlockOrBoundaryHdr ByteString
byronHeaderRaw

instance ShowProxy (Header ByronBlock) where

instance NoThunks (Header ByronBlock) where
  showTypeOf :: Proxy (Header ByronBlock) -> String
showTypeOf Proxy (Header ByronBlock)
_ = TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ Proxy (Header ByronBlock) -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy (Header ByronBlock)
forall k (t :: k). Proxy t
Proxy @(Header ByronBlock))

mkByronHeader :: CC.EpochSlots
              -> CC.ABlockOrBoundaryHdr ByteString
              -> SizeInBytes -- ^ Block size hint
              -> Header ByronBlock
mkByronHeader :: EpochSlots
-> ABlockOrBoundaryHdr ByteString -> Word32 -> Header ByronBlock
mkByronHeader EpochSlots
epochSlots = UnsizedHeader -> Word32 -> Header ByronBlock
joinSizeHint (UnsizedHeader -> Word32 -> Header ByronBlock)
-> (ABlockOrBoundaryHdr ByteString -> UnsizedHeader)
-> ABlockOrBoundaryHdr ByteString
-> Word32
-> Header ByronBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochSlots -> ABlockOrBoundaryHdr ByteString -> UnsizedHeader
mkUnsizedHeader EpochSlots
epochSlots

mkRegularByronHeader :: CC.AHeader ByteString
                     -> SizeInBytes
                     -> Header ByronBlock
mkRegularByronHeader :: AHeader ByteString -> Word32 -> Header ByronBlock
mkRegularByronHeader = UnsizedHeader -> Word32 -> Header ByronBlock
joinSizeHint (UnsizedHeader -> Word32 -> Header ByronBlock)
-> (AHeader ByteString -> UnsizedHeader)
-> AHeader ByteString
-> Word32
-> Header ByronBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AHeader ByteString -> UnsizedHeader
mkRegularUnsizedHeader

mkBoundaryByronHeader :: SlotNo
                      -> CC.ABoundaryHeader ByteString
                      -> SizeInBytes
                      -> Header ByronBlock
mkBoundaryByronHeader :: SlotNo -> ABoundaryHeader ByteString -> Word32 -> Header ByronBlock
mkBoundaryByronHeader SlotNo
slotNo = UnsizedHeader -> Word32 -> Header ByronBlock
joinSizeHint (UnsizedHeader -> Word32 -> Header ByronBlock)
-> (ABoundaryHeader ByteString -> UnsizedHeader)
-> ABoundaryHeader ByteString
-> Word32
-> Header ByronBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotNo -> ABoundaryHeader ByteString -> UnsizedHeader
mkBoundaryUnsizedHeader SlotNo
slotNo

{-------------------------------------------------------------------------------
  HasHeader instances

  This doesn't do much more than pass to the instance for headers.
-------------------------------------------------------------------------------}

type instance HeaderHash ByronBlock = ByronHash
instance StandardHash ByronBlock

instance HasHeader ByronBlock where
  getHeaderFields :: ByronBlock -> HeaderFields ByronBlock
getHeaderFields = ByronBlock -> HeaderFields ByronBlock
forall blk. GetHeader blk => blk -> HeaderFields blk
getBlockHeaderFields

instance HasHeader (Header ByronBlock) where
  getHeaderFields :: Header ByronBlock -> HeaderFields (Header ByronBlock)
getHeaderFields Header ByronBlock
hdr = HeaderFields :: forall b. SlotNo -> BlockNo -> HeaderHash b -> HeaderFields b
HeaderFields {
        headerFieldHash :: HeaderHash (Header ByronBlock)
headerFieldHash    = Header ByronBlock -> ByronHash
byronHeaderHash Header ByronBlock
hdr
      , headerFieldSlot :: SlotNo
headerFieldSlot    = Header ByronBlock -> SlotNo
byronHeaderSlotNo Header ByronBlock
hdr
      , headerFieldBlockNo :: BlockNo
headerFieldBlockNo = ChainDifficulty -> BlockNo
fromByronBlockNo (ChainDifficulty -> BlockNo)
-> (ABlockOrBoundaryHdr ByteString -> ChainDifficulty)
-> ABlockOrBoundaryHdr ByteString
-> BlockNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ABlockOrBoundaryHdr ByteString -> ChainDifficulty
forall a. ABlockOrBoundaryHdr a -> ChainDifficulty
CC.abobHdrChainDifficulty (ABlockOrBoundaryHdr ByteString -> BlockNo)
-> ABlockOrBoundaryHdr ByteString -> BlockNo
forall a b. (a -> b) -> a -> b
$ Header ByronBlock -> ABlockOrBoundaryHdr ByteString
byronHeaderRaw Header ByronBlock
hdr
      }

instance GetPrevHash ByronBlock where
  headerPrevHash :: Header ByronBlock -> ChainHash ByronBlock
headerPrevHash = Maybe HeaderHash -> ChainHash ByronBlock
fromByronPrevHash (Maybe HeaderHash -> ChainHash ByronBlock)
-> (Header ByronBlock -> Maybe HeaderHash)
-> Header ByronBlock
-> ChainHash ByronBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ABlockOrBoundaryHdr ByteString -> Maybe HeaderHash
forall a. ABlockOrBoundaryHdr a -> Maybe HeaderHash
CC.abobHdrPrevHash (ABlockOrBoundaryHdr ByteString -> Maybe HeaderHash)
-> (Header ByronBlock -> ABlockOrBoundaryHdr ByteString)
-> Header ByronBlock
-> Maybe HeaderHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header ByronBlock -> ABlockOrBoundaryHdr ByteString
byronHeaderRaw

fromByronPrevHash :: Maybe CC.HeaderHash -> ChainHash ByronBlock
fromByronPrevHash :: Maybe HeaderHash -> ChainHash ByronBlock
fromByronPrevHash = \case
    Maybe HeaderHash
Nothing -> ChainHash ByronBlock
forall b. ChainHash b
GenesisHash
    Just HeaderHash
h  -> HeaderHash ByronBlock -> ChainHash ByronBlock
forall b. HeaderHash b -> ChainHash b
BlockHash (HeaderHash -> ByronHash
ByronHash HeaderHash
h)

{-------------------------------------------------------------------------------
  Dealing with EBBs
-------------------------------------------------------------------------------}

byronHeaderIsEBB :: Header ByronBlock -> IsEBB
byronHeaderIsEBB :: Header ByronBlock -> IsEBB
byronHeaderIsEBB = ABlockOrBoundaryHdr ByteString -> IsEBB
forall a. ABlockOrBoundaryHdr a -> IsEBB
go (ABlockOrBoundaryHdr ByteString -> IsEBB)
-> (Header ByronBlock -> ABlockOrBoundaryHdr ByteString)
-> Header ByronBlock
-> IsEBB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header ByronBlock -> ABlockOrBoundaryHdr ByteString
byronHeaderRaw
  where
    go :: CC.ABlockOrBoundaryHdr a -> IsEBB
    go :: ABlockOrBoundaryHdr a -> IsEBB
go (CC.ABOBBlockHdr    AHeader a
_) = IsEBB
IsNotEBB
    go (CC.ABOBBoundaryHdr ABoundaryHeader a
_) = IsEBB
IsEBB

byronBlockIsEBB :: ByronBlock -> IsEBB
byronBlockIsEBB :: ByronBlock -> IsEBB
byronBlockIsEBB = Header ByronBlock -> IsEBB
byronHeaderIsEBB (Header ByronBlock -> IsEBB)
-> (ByronBlock -> Header ByronBlock) -> ByronBlock -> IsEBB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByronBlock -> Header ByronBlock
forall blk. GetHeader blk => blk -> Header blk
getHeader

knownEBBs :: Map (HeaderHash ByronBlock) (ChainHash ByronBlock)
knownEBBs :: Map (HeaderHash ByronBlock) (ChainHash ByronBlock)
knownEBBs = [(ByronHash, ChainHash ByronBlock)]
-> Map ByronHash (ChainHash ByronBlock)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(ByronHash, ChainHash ByronBlock)]
 -> Map ByronHash (ChainHash ByronBlock))
-> [(ByronHash, ChainHash ByronBlock)]
-> Map ByronHash (ChainHash ByronBlock)
forall a b. (a -> b) -> a -> b
$ ((HeaderHash, Maybe HeaderHash)
 -> (ByronHash, ChainHash ByronBlock))
-> [(HeaderHash, Maybe HeaderHash)]
-> [(ByronHash, ChainHash ByronBlock)]
forall a b. (a -> b) -> [a] -> [b]
map (HeaderHash, Maybe HeaderHash) -> (ByronHash, ChainHash ByronBlock)
aux [(HeaderHash, Maybe HeaderHash)]
EBBs.knownEBBs
  where
    aux :: (CC.HeaderHash, Maybe CC.HeaderHash)
        -> (ByronHash, ChainHash ByronBlock)
    aux :: (HeaderHash, Maybe HeaderHash) -> (ByronHash, ChainHash ByronBlock)
aux (HeaderHash
ebb, Maybe HeaderHash
Nothing)   = (HeaderHash -> ByronHash
ByronHash HeaderHash
ebb, ChainHash ByronBlock
forall b. ChainHash b
GenesisHash)
    aux (HeaderHash
ebb, Just HeaderHash
prev) = (HeaderHash -> ByronHash
ByronHash HeaderHash
ebb, HeaderHash ByronBlock -> ChainHash ByronBlock
forall b. HeaderHash b -> ChainHash b
BlockHash (HeaderHash -> ByronHash
ByronHash HeaderHash
prev))

{-------------------------------------------------------------------------------
  Unsized header
-------------------------------------------------------------------------------}

-- | Header without a size hint
--
-- Defined in order to support backwards compatible binary encodings.
data UnsizedHeader = UnsizedHeader {
      UnsizedHeader -> ABlockOrBoundaryHdr ByteString
unsizedHeaderRaw    :: !(CC.ABlockOrBoundaryHdr ByteString)
    , UnsizedHeader -> SlotNo
unsizedHeaderSlotNo :: !SlotNo
    , UnsizedHeader -> ByronHash
unsizedHeaderHash   :: !ByronHash
    }

mkUnsizedHeader :: CC.EpochSlots
                -> CC.ABlockOrBoundaryHdr ByteString
                -> UnsizedHeader
mkUnsizedHeader :: EpochSlots -> ABlockOrBoundaryHdr ByteString -> UnsizedHeader
mkUnsizedHeader EpochSlots
epochSlots = \case
    CC.ABOBBlockHdr    AHeader ByteString
hdr -> AHeader ByteString -> UnsizedHeader
mkRegularUnsizedHeader AHeader ByteString
hdr
    CC.ABOBBoundaryHdr ABoundaryHeader ByteString
hdr -> SlotNo -> ABoundaryHeader ByteString -> UnsizedHeader
mkBoundaryUnsizedHeader SlotNo
slotNo ABoundaryHeader ByteString
hdr
      where
        slotNo :: SlotNo
slotNo = SlotNumber -> SlotNo
fromByronSlotNo (SlotNumber -> SlotNo) -> SlotNumber -> SlotNo
forall a b. (a -> b) -> a -> b
$
            EpochSlots -> Word64 -> SlotNumber
CC.boundaryBlockSlot EpochSlots
epochSlots (ABoundaryHeader ByteString -> Word64
forall a. ABoundaryHeader a -> Word64
CC.boundaryEpoch ABoundaryHeader ByteString
hdr)

mkRegularUnsizedHeader :: CC.AHeader ByteString -> UnsizedHeader
mkRegularUnsizedHeader :: AHeader ByteString -> UnsizedHeader
mkRegularUnsizedHeader AHeader ByteString
hdr = UnsizedHeader :: ABlockOrBoundaryHdr ByteString
-> SlotNo -> ByronHash -> UnsizedHeader
UnsizedHeader {
      unsizedHeaderRaw :: ABlockOrBoundaryHdr ByteString
unsizedHeaderRaw    = ABlockOrBoundaryHdr ByteString
hdr'
    , unsizedHeaderSlotNo :: SlotNo
unsizedHeaderSlotNo = SlotNumber -> SlotNo
fromByronSlotNo (SlotNumber -> SlotNo) -> SlotNumber -> SlotNo
forall a b. (a -> b) -> a -> b
$ AHeader ByteString -> SlotNumber
forall a. AHeader a -> SlotNumber
CC.headerSlot AHeader ByteString
hdr
    , unsizedHeaderHash :: ByronHash
unsizedHeaderHash   = ABlockOrBoundaryHdr ByteString -> ByronHash
mkByronHash ABlockOrBoundaryHdr ByteString
hdr'
    }
  where
    hdr' :: CC.ABlockOrBoundaryHdr ByteString
    hdr' :: ABlockOrBoundaryHdr ByteString
hdr' = AHeader ByteString -> ABlockOrBoundaryHdr ByteString
forall a. AHeader a -> ABlockOrBoundaryHdr a
CC.ABOBBlockHdr AHeader ByteString
hdr

-- | For a boundary header, we must be told the slot
mkBoundaryUnsizedHeader :: SlotNo
                        -> CC.ABoundaryHeader ByteString
                        -> UnsizedHeader
mkBoundaryUnsizedHeader :: SlotNo -> ABoundaryHeader ByteString -> UnsizedHeader
mkBoundaryUnsizedHeader SlotNo
slotNo ABoundaryHeader ByteString
hdr = UnsizedHeader :: ABlockOrBoundaryHdr ByteString
-> SlotNo -> ByronHash -> UnsizedHeader
UnsizedHeader {
      unsizedHeaderRaw :: ABlockOrBoundaryHdr ByteString
unsizedHeaderRaw    = ABlockOrBoundaryHdr ByteString
hdr'
    , unsizedHeaderSlotNo :: SlotNo
unsizedHeaderSlotNo = SlotNo
slotNo
    , unsizedHeaderHash :: ByronHash
unsizedHeaderHash   = ABlockOrBoundaryHdr ByteString -> ByronHash
mkByronHash ABlockOrBoundaryHdr ByteString
hdr'
    }
  where
    hdr' :: CC.ABlockOrBoundaryHdr ByteString
    hdr' :: ABlockOrBoundaryHdr ByteString
hdr' = ABoundaryHeader ByteString -> ABlockOrBoundaryHdr ByteString
forall a. ABoundaryHeader a -> ABlockOrBoundaryHdr a
CC.ABOBBoundaryHdr ABoundaryHeader ByteString
hdr

splitSizeHint :: Header ByronBlock -> (UnsizedHeader, SizeInBytes)
splitSizeHint :: Header ByronBlock -> (UnsizedHeader, Word32)
splitSizeHint ByronHeader{..} = (
      UnsizedHeader :: ABlockOrBoundaryHdr ByteString
-> SlotNo -> ByronHash -> UnsizedHeader
UnsizedHeader {
          unsizedHeaderRaw :: ABlockOrBoundaryHdr ByteString
unsizedHeaderRaw    = ABlockOrBoundaryHdr ByteString
byronHeaderRaw
        , unsizedHeaderSlotNo :: SlotNo
unsizedHeaderSlotNo = SlotNo
byronHeaderSlotNo
        , unsizedHeaderHash :: ByronHash
unsizedHeaderHash   = ByronHash
byronHeaderHash
        }
    , Word32
byronHeaderBlockSizeHint
    )

joinSizeHint :: UnsizedHeader -> SizeInBytes -> Header ByronBlock
joinSizeHint :: UnsizedHeader -> Word32 -> Header ByronBlock
joinSizeHint UnsizedHeader{ABlockOrBoundaryHdr ByteString
SlotNo
ByronHash
unsizedHeaderHash :: ByronHash
unsizedHeaderSlotNo :: SlotNo
unsizedHeaderRaw :: ABlockOrBoundaryHdr ByteString
unsizedHeaderHash :: UnsizedHeader -> ByronHash
unsizedHeaderSlotNo :: UnsizedHeader -> SlotNo
unsizedHeaderRaw :: UnsizedHeader -> ABlockOrBoundaryHdr ByteString
..} Word32
size = ByronHeader :: ABlockOrBoundaryHdr ByteString
-> SlotNo -> ByronHash -> Word32 -> Header ByronBlock
ByronHeader {
      byronHeaderRaw :: ABlockOrBoundaryHdr ByteString
byronHeaderRaw           = ABlockOrBoundaryHdr ByteString
unsizedHeaderRaw
    , byronHeaderSlotNo :: SlotNo
byronHeaderSlotNo        = SlotNo
unsizedHeaderSlotNo
    , byronHeaderHash :: ByronHash
byronHeaderHash          = ByronHash
unsizedHeaderHash
    , byronHeaderBlockSizeHint :: Word32
byronHeaderBlockSizeHint = Word32
size
    }