{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Cardano.Ledger.BlockHeader where

import Cardano.Ledger.BaseTypes (ProtVer (..), SlotNo, StrictMaybe (..), getVersion32, mkVersion32)
import Cardano.Ledger.Block
import Cardano.Ledger.Core
import Control.DeepSeq (NFData)
import Data.Maybe (fromMaybe)
import Data.Word (Word32)
import GHC.Generics (Generic)
import Lens.Micro

data TestBlockHeader
  = TestBlockHeader
  { TestBlockHeader -> KeyHash BlockIssuer
tbhIssuer :: KeyHash BlockIssuer
  , TestBlockHeader -> Word32
tbhBSize :: Word32
  , TestBlockHeader -> Int
tbhHSize :: Int
  , TestBlockHeader -> Hash HASH EraIndependentBlockBody
tbhBHash :: Hash HASH EraIndependentBlockBody
  , TestBlockHeader -> SlotNo
tbhSlot :: SlotNo
  , TestBlockHeader -> BlockHeaderVersionInfo
tbhVersionInfo :: BlockHeaderVersionInfo
  , TestBlockHeader -> StrictMaybe EbReferencesAnnouncement
tbhEbRefsAnn :: StrictMaybe EbReferencesAnnouncement
  }
  deriving ((forall x. TestBlockHeader -> Rep TestBlockHeader x)
-> (forall x. Rep TestBlockHeader x -> TestBlockHeader)
-> Generic TestBlockHeader
forall x. Rep TestBlockHeader x -> TestBlockHeader
forall x. TestBlockHeader -> Rep TestBlockHeader x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TestBlockHeader -> Rep TestBlockHeader x
from :: forall x. TestBlockHeader -> Rep TestBlockHeader x
$cto :: forall x. Rep TestBlockHeader x -> TestBlockHeader
to :: forall x. Rep TestBlockHeader x -> TestBlockHeader
Generic)

instance NFData TestBlockHeader

instance Era era => EraBlockHeader TestBlockHeader era where
  blockIssuerBlockHeaderG :: SimpleGetter (Block TestBlockHeader era) (KeyHash BlockIssuer)
blockIssuerBlockHeaderG = (TestBlockHeader -> Const r TestBlockHeader)
-> Block TestBlockHeader era -> Const r (Block TestBlockHeader era)
forall h era (f :: * -> *).
Functor f =>
(h -> f h) -> Block h era -> f (Block h era)
blockHeaderL ((TestBlockHeader -> Const r TestBlockHeader)
 -> Block TestBlockHeader era
 -> Const r (Block TestBlockHeader era))
-> ((KeyHash BlockIssuer -> Const r (KeyHash BlockIssuer))
    -> TestBlockHeader -> Const r TestBlockHeader)
-> (KeyHash BlockIssuer -> Const r (KeyHash BlockIssuer))
-> Block TestBlockHeader era
-> Const r (Block TestBlockHeader era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TestBlockHeader -> KeyHash BlockIssuer)
-> SimpleGetter TestBlockHeader (KeyHash BlockIssuer)
forall s a. (s -> a) -> SimpleGetter s a
to TestBlockHeader -> KeyHash BlockIssuer
tbhIssuer
  blockHeaderSizeBlockHeaderG :: SimpleGetter (Block TestBlockHeader era) Int
blockHeaderSizeBlockHeaderG = (TestBlockHeader -> Const r TestBlockHeader)
-> Block TestBlockHeader era -> Const r (Block TestBlockHeader era)
forall h era (f :: * -> *).
Functor f =>
(h -> f h) -> Block h era -> f (Block h era)
blockHeaderL ((TestBlockHeader -> Const r TestBlockHeader)
 -> Block TestBlockHeader era
 -> Const r (Block TestBlockHeader era))
-> ((Int -> Const r Int)
    -> TestBlockHeader -> Const r TestBlockHeader)
-> (Int -> Const r Int)
-> Block TestBlockHeader era
-> Const r (Block TestBlockHeader era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TestBlockHeader -> Int) -> SimpleGetter TestBlockHeader Int
forall s a. (s -> a) -> SimpleGetter s a
to TestBlockHeader -> Int
tbhHSize
  blockBodySizeBlockHeaderL :: Lens' (Block TestBlockHeader era) Word32
blockBodySizeBlockHeaderL =
    (TestBlockHeader -> f TestBlockHeader)
-> Block TestBlockHeader era -> f (Block TestBlockHeader era)
forall h era (f :: * -> *).
Functor f =>
(h -> f h) -> Block h era -> f (Block h era)
blockHeaderL ((TestBlockHeader -> f TestBlockHeader)
 -> Block TestBlockHeader era -> f (Block TestBlockHeader era))
-> ((Word32 -> f Word32) -> TestBlockHeader -> f TestBlockHeader)
-> (Word32 -> f Word32)
-> Block TestBlockHeader era
-> f (Block TestBlockHeader era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TestBlockHeader -> Word32)
-> (TestBlockHeader -> Word32 -> TestBlockHeader)
-> Lens TestBlockHeader TestBlockHeader Word32 Word32
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TestBlockHeader -> Word32
tbhBSize (\TestBlockHeader
bh Word32
sz -> TestBlockHeader
bh {tbhBSize = sz})
  blockBodyHashBlockHeaderL :: Lens'
  (Block TestBlockHeader era) (Hash HASH EraIndependentBlockBody)
blockBodyHashBlockHeaderL =
    (TestBlockHeader -> f TestBlockHeader)
-> Block TestBlockHeader era -> f (Block TestBlockHeader era)
forall h era (f :: * -> *).
Functor f =>
(h -> f h) -> Block h era -> f (Block h era)
blockHeaderL ((TestBlockHeader -> f TestBlockHeader)
 -> Block TestBlockHeader era -> f (Block TestBlockHeader era))
-> ((Hash HASH EraIndependentBlockBody
     -> f (Hash HASH EraIndependentBlockBody))
    -> TestBlockHeader -> f TestBlockHeader)
-> (Hash HASH EraIndependentBlockBody
    -> f (Hash HASH EraIndependentBlockBody))
-> Block TestBlockHeader era
-> f (Block TestBlockHeader era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TestBlockHeader -> Hash HASH EraIndependentBlockBody)
-> (TestBlockHeader
    -> Hash HASH EraIndependentBlockBody -> TestBlockHeader)
-> Lens
     TestBlockHeader
     TestBlockHeader
     (Hash HASH EraIndependentBlockBody)
     (Hash HASH EraIndependentBlockBody)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TestBlockHeader -> Hash HASH EraIndependentBlockBody
tbhBHash (\TestBlockHeader
bh Hash HASH EraIndependentBlockBody
h -> TestBlockHeader
bh {tbhBHash = h})
  slotNoBlockHeaderL :: Lens' (Block TestBlockHeader era) SlotNo
slotNoBlockHeaderL =
    (TestBlockHeader -> f TestBlockHeader)
-> Block TestBlockHeader era -> f (Block TestBlockHeader era)
forall h era (f :: * -> *).
Functor f =>
(h -> f h) -> Block h era -> f (Block h era)
blockHeaderL ((TestBlockHeader -> f TestBlockHeader)
 -> Block TestBlockHeader era -> f (Block TestBlockHeader era))
-> ((SlotNo -> f SlotNo) -> TestBlockHeader -> f TestBlockHeader)
-> (SlotNo -> f SlotNo)
-> Block TestBlockHeader era
-> f (Block TestBlockHeader era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TestBlockHeader -> SlotNo)
-> (TestBlockHeader -> SlotNo -> TestBlockHeader)
-> Lens TestBlockHeader TestBlockHeader SlotNo SlotNo
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TestBlockHeader -> SlotNo
tbhSlot (\TestBlockHeader
hb SlotNo
sn -> TestBlockHeader
hb {tbhSlot = sn})

instance Era era => TPraosEraBlockHeader TestBlockHeader era

instance Era era => PraosEraBlockHeader TestBlockHeader era where
  protVerBlockHeaderL :: Lens' (Block TestBlockHeader era) ProtVer
protVerBlockHeaderL =
    (BlockHeaderVersionInfo -> f BlockHeaderVersionInfo)
-> Block TestBlockHeader era -> f (Block TestBlockHeader era)
forall h era.
LeiosEraBlockHeader h era =>
Lens' (Block h era) BlockHeaderVersionInfo
Lens' (Block TestBlockHeader era) BlockHeaderVersionInfo
versionInfoBlockHeaderL
      ((BlockHeaderVersionInfo -> f BlockHeaderVersionInfo)
 -> Block TestBlockHeader era -> f (Block TestBlockHeader era))
-> ((ProtVer -> f ProtVer)
    -> BlockHeaderVersionInfo -> f BlockHeaderVersionInfo)
-> (ProtVer -> f ProtVer)
-> Block TestBlockHeader era
-> f (Block TestBlockHeader era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BlockHeaderVersionInfo -> ProtVer)
-> (BlockHeaderVersionInfo -> ProtVer -> BlockHeaderVersionInfo)
-> Lens
     BlockHeaderVersionInfo BlockHeaderVersionInfo ProtVer ProtVer
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
        (\(BlockHeaderVersionInfo Word32
major Word32
minor) -> Version -> Word32 -> ProtVer
ProtVer (Version -> Maybe Version -> Version
forall a. a -> Maybe a -> a
fromMaybe Version
forall a. Bounded a => a
maxBound (Word32 -> Maybe Version
forall (m :: * -> *). MonadFail m => Word32 -> m Version
mkVersion32 Word32
major)) Word32
minor)
        (\BlockHeaderVersionInfo
_ (ProtVer Version
major Word32
minor) -> Word32 -> Word32 -> BlockHeaderVersionInfo
BlockHeaderVersionInfo (Version -> Word32
getVersion32 Version
major) Word32
minor)

instance Era era => LeiosEraBlockHeader TestBlockHeader era where
  versionInfoBlockHeaderL :: Lens' (Block TestBlockHeader era) BlockHeaderVersionInfo
versionInfoBlockHeaderL = (TestBlockHeader -> f TestBlockHeader)
-> Block TestBlockHeader era -> f (Block TestBlockHeader era)
forall h era (f :: * -> *).
Functor f =>
(h -> f h) -> Block h era -> f (Block h era)
blockHeaderL ((TestBlockHeader -> f TestBlockHeader)
 -> Block TestBlockHeader era -> f (Block TestBlockHeader era))
-> ((BlockHeaderVersionInfo -> f BlockHeaderVersionInfo)
    -> TestBlockHeader -> f TestBlockHeader)
-> (BlockHeaderVersionInfo -> f BlockHeaderVersionInfo)
-> Block TestBlockHeader era
-> f (Block TestBlockHeader era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TestBlockHeader -> BlockHeaderVersionInfo)
-> (TestBlockHeader -> BlockHeaderVersionInfo -> TestBlockHeader)
-> Lens
     TestBlockHeader
     TestBlockHeader
     BlockHeaderVersionInfo
     BlockHeaderVersionInfo
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TestBlockHeader -> BlockHeaderVersionInfo
tbhVersionInfo (\TestBlockHeader
bh BlockHeaderVersionInfo
vi -> TestBlockHeader
bh {tbhVersionInfo = vi})
  ebReferencesAnnouncementBlockHeaderL :: Lens'
  (Block TestBlockHeader era) (StrictMaybe EbReferencesAnnouncement)
ebReferencesAnnouncementBlockHeaderL =
    (TestBlockHeader -> f TestBlockHeader)
-> Block TestBlockHeader era -> f (Block TestBlockHeader era)
forall h era (f :: * -> *).
Functor f =>
(h -> f h) -> Block h era -> f (Block h era)
blockHeaderL ((TestBlockHeader -> f TestBlockHeader)
 -> Block TestBlockHeader era -> f (Block TestBlockHeader era))
-> ((StrictMaybe EbReferencesAnnouncement
     -> f (StrictMaybe EbReferencesAnnouncement))
    -> TestBlockHeader -> f TestBlockHeader)
-> (StrictMaybe EbReferencesAnnouncement
    -> f (StrictMaybe EbReferencesAnnouncement))
-> Block TestBlockHeader era
-> f (Block TestBlockHeader era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TestBlockHeader -> StrictMaybe EbReferencesAnnouncement)
-> (TestBlockHeader
    -> StrictMaybe EbReferencesAnnouncement -> TestBlockHeader)
-> Lens
     TestBlockHeader
     TestBlockHeader
     (StrictMaybe EbReferencesAnnouncement)
     (StrictMaybe EbReferencesAnnouncement)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TestBlockHeader -> StrictMaybe EbReferencesAnnouncement
tbhEbRefsAnn (\TestBlockHeader
hb StrictMaybe EbReferencesAnnouncement
ma -> TestBlockHeader
hb {tbhEbRefsAnn = ma})

mkTestBlockHeaderNoNonce ::
  forall era h.
  EraBlockHeader h era => Block h era -> TestBlockHeader
mkTestBlockHeaderNoNonce :: forall era h.
EraBlockHeader h era =>
Block h era -> TestBlockHeader
mkTestBlockHeaderNoNonce Block h era
block =
  TestBlockHeader
    { tbhIssuer :: KeyHash BlockIssuer
tbhIssuer = Block h era
block Block h era
-> Getting
     (KeyHash BlockIssuer) (Block h era) (KeyHash BlockIssuer)
-> KeyHash BlockIssuer
forall s a. s -> Getting a s a -> a
^. Getting (KeyHash BlockIssuer) (Block h era) (KeyHash BlockIssuer)
SimpleGetter (Block h era) (KeyHash BlockIssuer)
forall h era.
EraBlockHeader h era =>
SimpleGetter (Block h era) (KeyHash BlockIssuer)
blockIssuerBlockHeaderG
    , tbhHSize :: Int
tbhHSize = Block h era
block Block h era -> Getting Int (Block h era) Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int (Block h era) Int
SimpleGetter (Block h era) Int
forall h era.
EraBlockHeader h era =>
SimpleGetter (Block h era) Int
blockHeaderSizeBlockHeaderG
    , tbhBSize :: Word32
tbhBSize = Block h era
block Block h era -> Getting Word32 (Block h era) Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. Getting Word32 (Block h era) Word32
forall h era. EraBlockHeader h era => Lens' (Block h era) Word32
Lens' (Block h era) Word32
blockBodySizeBlockHeaderL
    , tbhBHash :: Hash HASH EraIndependentBlockBody
tbhBHash = Block h era
block Block h era
-> Getting
     (Hash HASH EraIndependentBlockBody)
     (Block h era)
     (Hash HASH EraIndependentBlockBody)
-> Hash HASH EraIndependentBlockBody
forall s a. s -> Getting a s a -> a
^. Getting
  (Hash HASH EraIndependentBlockBody)
  (Block h era)
  (Hash HASH EraIndependentBlockBody)
forall h era.
EraBlockHeader h era =>
Lens' (Block h era) (Hash HASH EraIndependentBlockBody)
Lens' (Block h era) (Hash HASH EraIndependentBlockBody)
blockBodyHashBlockHeaderL
    , tbhSlot :: SlotNo
tbhSlot = Block h era
block Block h era -> Getting SlotNo (Block h era) SlotNo -> SlotNo
forall s a. s -> Getting a s a -> a
^. Getting SlotNo (Block h era) SlotNo
forall h era. EraBlockHeader h era => Lens' (Block h era) SlotNo
Lens' (Block h era) SlotNo
slotNoBlockHeaderL
    , tbhVersionInfo :: BlockHeaderVersionInfo
tbhVersionInfo = Word32 -> Word32 -> BlockHeaderVersionInfo
BlockHeaderVersionInfo (Version -> Word32
getVersion32 (forall era. Era era => Version
eraProtVerLow @era)) Word32
0
    , tbhEbRefsAnn :: StrictMaybe EbReferencesAnnouncement
tbhEbRefsAnn = StrictMaybe EbReferencesAnnouncement
forall a. StrictMaybe a
SNothing
    }