{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

module Byron.Spec.Chain.STS.Block where

import Byron.Spec.Ledger.Core (Hash (Hash), Sig (Sig), Slot, VKey, hash, owner)
import Byron.Spec.Ledger.Delegation
import Byron.Spec.Ledger.UTxO (Tx, TxIn, TxOut, Wit)
import Byron.Spec.Ledger.Update (ProtVer, STag, UProp, Vote)
import Data.AbstractSize
import Data.ByteString (ByteString)
import Data.Data (Data)
import Data.Function (on)
import qualified Data.Hashable as H
import qualified Data.Map.Strict as Map
import Data.Sequence ((<|))
import Data.Typeable (typeOf)
import GHC.Generics (Generic)
import Lens.Micro ((^.))
import Lens.Micro.Extras (view)
import Lens.Micro.TH (makeLenses)
import Numeric.Natural (Natural)
import Test.Control.State.Transition.Generator

data BlockHeader = BlockHeader
  { BlockHeader -> Hash
_bhPrevHash :: !Hash
  -- ^ Hash of the previous block header, or 'genesisHash' in case of
  -- the first block in a chain.
  , BlockHeader -> Slot
_bhSlot :: !Slot
  -- ^ Absolute slot for which the block was generated.
  , BlockHeader -> VKey
_bhIssuer :: !VKey
  -- ^ Block issuer.
  , BlockHeader -> Sig Hash
_bhSig :: !(Sig Hash)
  -- ^ Part of the block header which must be signed.
  , BlockHeader -> Hash
_bhUtxoHash :: !Hash
  -- ^ UTxO hash
  , BlockHeader -> Hash
_bhDlgHash :: !Hash
  -- ^ Delegation hash
  , BlockHeader -> Hash
_bhUpdHash :: !Hash
  -- ^ Update payload hash
  }
  deriving (BlockHeader -> BlockHeader -> Bool
(BlockHeader -> BlockHeader -> Bool)
-> (BlockHeader -> BlockHeader -> Bool) -> Eq BlockHeader
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BlockHeader -> BlockHeader -> Bool
== :: BlockHeader -> BlockHeader -> Bool
$c/= :: BlockHeader -> BlockHeader -> Bool
/= :: BlockHeader -> BlockHeader -> Bool
Eq, (forall x. BlockHeader -> Rep BlockHeader x)
-> (forall x. Rep BlockHeader x -> BlockHeader)
-> Generic BlockHeader
forall x. Rep BlockHeader x -> BlockHeader
forall x. BlockHeader -> Rep BlockHeader x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BlockHeader -> Rep BlockHeader x
from :: forall x. BlockHeader -> Rep BlockHeader x
$cto :: forall x. Rep BlockHeader x -> BlockHeader
to :: forall x. Rep BlockHeader x -> BlockHeader
Generic, Int -> BlockHeader -> ShowS
[BlockHeader] -> ShowS
BlockHeader -> String
(Int -> BlockHeader -> ShowS)
-> (BlockHeader -> String)
-> ([BlockHeader] -> ShowS)
-> Show BlockHeader
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BlockHeader -> ShowS
showsPrec :: Int -> BlockHeader -> ShowS
$cshow :: BlockHeader -> String
show :: BlockHeader -> String
$cshowList :: [BlockHeader] -> ShowS
showList :: [BlockHeader] -> ShowS
Show, Typeable BlockHeader
Typeable BlockHeader =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> BlockHeader -> c BlockHeader)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c BlockHeader)
-> (BlockHeader -> Constr)
-> (BlockHeader -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c BlockHeader))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c BlockHeader))
-> ((forall b. Data b => b -> b) -> BlockHeader -> BlockHeader)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> BlockHeader -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> BlockHeader -> r)
-> (forall u. (forall d. Data d => d -> u) -> BlockHeader -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> BlockHeader -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> BlockHeader -> m BlockHeader)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> BlockHeader -> m BlockHeader)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> BlockHeader -> m BlockHeader)
-> Data BlockHeader
BlockHeader -> Constr
BlockHeader -> DataType
(forall b. Data b => b -> b) -> BlockHeader -> BlockHeader
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> BlockHeader -> u
forall u. (forall d. Data d => d -> u) -> BlockHeader -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BlockHeader -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BlockHeader -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BlockHeader -> m BlockHeader
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BlockHeader -> m BlockHeader
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BlockHeader
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BlockHeader -> c BlockHeader
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BlockHeader)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c BlockHeader)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BlockHeader -> c BlockHeader
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BlockHeader -> c BlockHeader
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BlockHeader
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BlockHeader
$ctoConstr :: BlockHeader -> Constr
toConstr :: BlockHeader -> Constr
$cdataTypeOf :: BlockHeader -> DataType
dataTypeOf :: BlockHeader -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BlockHeader)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BlockHeader)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c BlockHeader)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c BlockHeader)
$cgmapT :: (forall b. Data b => b -> b) -> BlockHeader -> BlockHeader
gmapT :: (forall b. Data b => b -> b) -> BlockHeader -> BlockHeader
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BlockHeader -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BlockHeader -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BlockHeader -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BlockHeader -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> BlockHeader -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> BlockHeader -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BlockHeader -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BlockHeader -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BlockHeader -> m BlockHeader
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BlockHeader -> m BlockHeader
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BlockHeader -> m BlockHeader
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BlockHeader -> m BlockHeader
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BlockHeader -> m BlockHeader
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BlockHeader -> m BlockHeader
Data)

-- TODO: BlockVersion – the protocol (block) version that created the block
-- TODO: SoftwareVersion – the software version that created the block

makeLenses ''BlockHeader

-- We declare a specific instance here to avoid recursing into cardano-crypto
instance HasTypeReps BlockHeader where
  typeReps :: BlockHeader -> Seq TypeRep
typeReps BlockHeader
x =
    BlockHeader -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf BlockHeader
x
      TypeRep -> Seq TypeRep -> Seq TypeRep
forall a. a -> Seq a -> Seq a
<| Hash -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (Hash
forall a. HasCallStack => a
undefined :: Hash)
      TypeRep -> Seq TypeRep -> Seq TypeRep
forall a. a -> Seq a -> Seq a
<| Hash -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (BlockHeader
x BlockHeader -> Getting Hash BlockHeader Hash -> Hash
forall s a. s -> Getting a s a -> a
^. Getting Hash BlockHeader Hash
Lens' BlockHeader Hash
bhUtxoHash :: Hash)
      TypeRep -> Seq TypeRep -> Seq TypeRep
forall a. a -> Seq a -> Seq a
<| Hash -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (BlockHeader
x BlockHeader -> Getting Hash BlockHeader Hash -> Hash
forall s a. s -> Getting a s a -> a
^. Getting Hash BlockHeader Hash
Lens' BlockHeader Hash
bhDlgHash :: Hash)
      TypeRep -> Seq TypeRep -> Seq TypeRep
forall a. a -> Seq a -> Seq a
<| Hash -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (BlockHeader
x BlockHeader -> Getting Hash BlockHeader Hash -> Hash
forall s a. s -> Getting a s a -> a
^. Getting Hash BlockHeader Hash
Lens' BlockHeader Hash
bhUpdHash :: Hash)
      TypeRep -> Seq TypeRep -> Seq TypeRep
forall a. a -> Seq a -> Seq a
<| Slot -> Seq TypeRep
forall a. HasTypeReps a => a -> Seq TypeRep
typeReps (BlockHeader
x BlockHeader -> Getting Slot BlockHeader Slot -> Slot
forall s a. s -> Getting a s a -> a
^. Getting Slot BlockHeader Slot
Lens' BlockHeader Slot
bhSlot :: Slot)
        Seq TypeRep -> Seq TypeRep -> Seq TypeRep
forall a. Semigroup a => a -> a -> a
<> VKey -> Seq TypeRep
forall a. HasTypeReps a => a -> Seq TypeRep
typeReps (BlockHeader
x BlockHeader -> Getting VKey BlockHeader VKey -> VKey
forall s a. s -> Getting a s a -> a
^. Getting VKey BlockHeader VKey
Lens' BlockHeader VKey
bhIssuer :: VKey)
        Seq TypeRep -> Seq TypeRep -> Seq TypeRep
forall a. Semigroup a => a -> a -> a
<> Sig Hash -> Seq TypeRep
forall a. HasTypeReps a => a -> Seq TypeRep
typeReps (BlockHeader
x BlockHeader
-> Getting (Sig Hash) BlockHeader (Sig Hash) -> Sig Hash
forall s a. s -> Getting a s a -> a
^. Getting (Sig Hash) BlockHeader (Sig Hash)
Lens' BlockHeader (Sig Hash)
bhSig :: Sig Hash)

data BlockBody = BlockBody
  { BlockBody -> [DCert]
_bDCerts :: ![DCert]
  -- ^ Delegation certificates
  , BlockBody -> [Tx]
_bUtxo :: ![Tx]
  -- ^ UTxO payload
  , BlockBody -> Maybe UProp
_bUpdProp :: !(Maybe UProp)
  -- ^ Update proposal payload
  , BlockBody -> [Vote]
_bUpdVotes :: ![Vote]
  -- ^ Update votes payload
  , BlockBody -> ProtVer
_bProtVer :: !ProtVer
  -- ^ Protocol version
  }
  deriving ((forall x. BlockBody -> Rep BlockBody x)
-> (forall x. Rep BlockBody x -> BlockBody) -> Generic BlockBody
forall x. Rep BlockBody x -> BlockBody
forall x. BlockBody -> Rep BlockBody x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BlockBody -> Rep BlockBody x
from :: forall x. BlockBody -> Rep BlockBody x
$cto :: forall x. Rep BlockBody x -> BlockBody
to :: forall x. Rep BlockBody x -> BlockBody
Generic, Int -> BlockBody -> ShowS
[BlockBody] -> ShowS
BlockBody -> String
(Int -> BlockBody -> ShowS)
-> (BlockBody -> String)
-> ([BlockBody] -> ShowS)
-> Show BlockBody
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BlockBody -> ShowS
showsPrec :: Int -> BlockBody -> ShowS
$cshow :: BlockBody -> String
show :: BlockBody -> String
$cshowList :: [BlockBody] -> ShowS
showList :: [BlockBody] -> ShowS
Show, Typeable BlockBody
Typeable BlockBody =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> BlockBody -> c BlockBody)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c BlockBody)
-> (BlockBody -> Constr)
-> (BlockBody -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c BlockBody))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BlockBody))
-> ((forall b. Data b => b -> b) -> BlockBody -> BlockBody)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> BlockBody -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> BlockBody -> r)
-> (forall u. (forall d. Data d => d -> u) -> BlockBody -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> BlockBody -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> BlockBody -> m BlockBody)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> BlockBody -> m BlockBody)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> BlockBody -> m BlockBody)
-> Data BlockBody
BlockBody -> Constr
BlockBody -> DataType
(forall b. Data b => b -> b) -> BlockBody -> BlockBody
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> BlockBody -> u
forall u. (forall d. Data d => d -> u) -> BlockBody -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BlockBody -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BlockBody -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BlockBody -> m BlockBody
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BlockBody -> m BlockBody
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BlockBody
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BlockBody -> c BlockBody
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BlockBody)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BlockBody)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BlockBody -> c BlockBody
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BlockBody -> c BlockBody
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BlockBody
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BlockBody
$ctoConstr :: BlockBody -> Constr
toConstr :: BlockBody -> Constr
$cdataTypeOf :: BlockBody -> DataType
dataTypeOf :: BlockBody -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BlockBody)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BlockBody)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BlockBody)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BlockBody)
$cgmapT :: (forall b. Data b => b -> b) -> BlockBody -> BlockBody
gmapT :: (forall b. Data b => b -> b) -> BlockBody -> BlockBody
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BlockBody -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BlockBody -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BlockBody -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BlockBody -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> BlockBody -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> BlockBody -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BlockBody -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BlockBody -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BlockBody -> m BlockBody
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BlockBody -> m BlockBody
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BlockBody -> m BlockBody
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BlockBody -> m BlockBody
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BlockBody -> m BlockBody
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BlockBody -> m BlockBody
Data)

makeLenses ''BlockBody

instance HasTypeReps BlockBody

-- | A block in the chain. The specification only models regular blocks since
-- epoch boundary blocks will be largely ignored in the Byron-Shelley bridge.
data Block = Block
  { Block -> BlockHeader
_bHeader :: BlockHeader
  , Block -> BlockBody
_bBody :: BlockBody
  }
  deriving ((forall x. Block -> Rep Block x)
-> (forall x. Rep Block x -> Block) -> Generic Block
forall x. Rep Block x -> Block
forall x. Block -> Rep Block x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Block -> Rep Block x
from :: forall x. Block -> Rep Block x
$cto :: forall x. Rep Block x -> Block
to :: forall x. Rep Block x -> Block
Generic, Int -> Block -> ShowS
[Block] -> ShowS
Block -> String
(Int -> Block -> ShowS)
-> (Block -> String) -> ([Block] -> ShowS) -> Show Block
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Block -> ShowS
showsPrec :: Int -> Block -> ShowS
$cshow :: Block -> String
show :: Block -> String
$cshowList :: [Block] -> ShowS
showList :: [Block] -> ShowS
Show, Typeable Block
Typeable Block =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Block -> c Block)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Block)
-> (Block -> Constr)
-> (Block -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Block))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Block))
-> ((forall b. Data b => b -> b) -> Block -> Block)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Block -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Block -> r)
-> (forall u. (forall d. Data d => d -> u) -> Block -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Block -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Block -> m Block)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Block -> m Block)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Block -> m Block)
-> Data Block
Block -> Constr
Block -> DataType
(forall b. Data b => b -> b) -> Block -> Block
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Block -> u
forall u. (forall d. Data d => d -> u) -> Block -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Block -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Block -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Block -> m Block
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Block -> m Block
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Block
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Block -> c Block
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Block)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Block)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Block -> c Block
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Block -> c Block
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Block
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Block
$ctoConstr :: Block -> Constr
toConstr :: Block -> Constr
$cdataTypeOf :: Block -> DataType
dataTypeOf :: Block -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Block)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Block)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Block)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Block)
$cgmapT :: (forall b. Data b => b -> b) -> Block -> Block
gmapT :: (forall b. Data b => b -> b) -> Block -> Block
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Block -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Block -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Block -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Block -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Block -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Block -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Block -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Block -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Block -> m Block
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Block -> m Block
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Block -> m Block
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Block -> m Block
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Block -> m Block
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Block -> m Block
Data)

makeLenses ''Block

instance HasTypeReps Block

mkBlock ::
  -- | Hash of the previous block
  Hash ->
  -- | Current slot
  Slot ->
  -- | Issuer
  VKey ->
  -- | Protocol version
  ProtVer ->
  -- | Delegation certificates
  [DCert] ->
  -- | Update proposal
  Maybe UProp ->
  -- | Votes on update proposals
  [Vote] ->
  -- | UTxO payload
  [Tx] ->
  Block
mkBlock :: Hash
-> Slot
-> VKey
-> ProtVer
-> [DCert]
-> Maybe UProp
-> [Vote]
-> [Tx]
-> Block
mkBlock
  Hash
prevHash
  Slot
currentSlot
  VKey
issuer
  ProtVer
version
  [DCert]
delegationCerts
  Maybe UProp
maybeUpdateProposal
  [Vote]
updateProposalVotes
  [Tx]
utxoTransactions = BlockHeader -> BlockBody -> Block
Block BlockHeader
signedHeader BlockBody
body
    where
      signedHeader :: BlockHeader
signedHeader =
        BlockHeader
unsignedHeader {_bhSig = Sig (hashHeader unsignedHeader) (owner issuer)}
        where
          unsignedHeader :: BlockHeader
unsignedHeader =
            BlockHeader
              { _bhPrevHash :: Hash
_bhPrevHash = Hash
prevHash
              , _bhSlot :: Slot
_bhSlot = Slot
currentSlot
              , _bhIssuer :: VKey
_bhIssuer = VKey
issuer
              , _bhSig :: Sig Hash
_bhSig = Sig Hash
dummySig
              , _bhUtxoHash :: Hash
_bhUtxoHash = ([Tx] -> Hash
forall a. HasHash a => a -> Hash
hash [Tx]
utxoTransactions)
              , _bhDlgHash :: Hash
_bhDlgHash = ([DCert] -> Hash
forall a. HasHash a => a -> Hash
hash [DCert]
delegationCerts)
              , _bhUpdHash :: Hash
_bhUpdHash = ((Maybe UProp, [Vote]) -> Hash
forall a. HasHash a => a -> Hash
hash (Maybe UProp
maybeUpdateProposal, [Vote]
updateProposalVotes))
              }
            where
              dummySig :: Sig Hash
dummySig = Hash -> Owner -> Sig Hash
forall a. a -> Owner -> Sig a
Sig Hash
genesisHash (VKey -> Owner
forall a. HasOwner a => a -> Owner
owner VKey
issuer)

      body :: BlockBody
body =
        BlockBody
          { _bProtVer :: ProtVer
_bProtVer = ProtVer
version
          , _bDCerts :: [DCert]
_bDCerts = [DCert]
delegationCerts
          , _bUpdProp :: Maybe UProp
_bUpdProp = Maybe UProp
maybeUpdateProposal
          , _bUpdVotes :: [Vote]
_bUpdVotes = [Vote]
updateProposalVotes
          , _bUtxo :: [Tx]
_bUtxo = [Tx]
utxoTransactions
          }

-- | Dummy genesis hash.
genesisHash :: Hash
-- Not sure we need a concrete hash in the specs ...
genesisHash :: Hash
genesisHash = Maybe Int -> Hash
Hash (Maybe Int -> Hash) -> Maybe Int -> Hash
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
forall a. Hashable a => a -> Int
H.hash (ByteString
"" :: ByteString)

-- | Protocol version endorsment
bEndorsment :: Block -> (ProtVer, VKey)
bEndorsment :: Block -> (ProtVer, VKey)
bEndorsment Block
b = (Block
b Block -> Getting BlockBody Block BlockBody -> BlockBody
forall s a. s -> Getting a s a -> a
^. Getting BlockBody Block BlockBody
Lens' Block BlockBody
bBody BlockBody -> Getting ProtVer BlockBody ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. Getting ProtVer BlockBody ProtVer
Lens' BlockBody ProtVer
bProtVer, Block
b Block -> Getting BlockHeader Block BlockHeader -> BlockHeader
forall s a. s -> Getting a s a -> a
^. Getting BlockHeader Block BlockHeader
Lens' Block BlockHeader
bHeader BlockHeader -> Getting VKey BlockHeader VKey -> VKey
forall s a. s -> Getting a s a -> a
^. Getting VKey BlockHeader VKey
Lens' BlockHeader VKey
bhIssuer)

-- | Slot the block is published in
bSlot :: Block -> Slot
bSlot :: Block -> Slot
bSlot Block
b = Block
b Block -> Getting BlockHeader Block BlockHeader -> BlockHeader
forall s a. s -> Getting a s a -> a
^. Getting BlockHeader Block BlockHeader
Lens' Block BlockHeader
bHeader BlockHeader -> Getting Slot BlockHeader Slot -> Slot
forall s a. s -> Getting a s a -> a
^. Getting Slot BlockHeader Slot
Lens' BlockHeader Slot
bhSlot

-- | Block update payload
bUpdPayload :: Block -> (Maybe UProp, [Vote])
bUpdPayload :: Block -> (Maybe UProp, [Vote])
bUpdPayload Block
b = (Block
b Block -> Getting BlockBody Block BlockBody -> BlockBody
forall s a. s -> Getting a s a -> a
^. Getting BlockBody Block BlockBody
Lens' Block BlockBody
bBody BlockBody
-> Getting (Maybe UProp) BlockBody (Maybe UProp) -> Maybe UProp
forall s a. s -> Getting a s a -> a
^. Getting (Maybe UProp) BlockBody (Maybe UProp)
Lens' BlockBody (Maybe UProp)
bUpdProp, Block
b Block -> Getting BlockBody Block BlockBody -> BlockBody
forall s a. s -> Getting a s a -> a
^. Getting BlockBody Block BlockBody
Lens' Block BlockBody
bBody BlockBody -> Getting [Vote] BlockBody [Vote] -> [Vote]
forall s a. s -> Getting a s a -> a
^. Getting [Vote] BlockBody [Vote]
Lens' BlockBody [Vote]
bUpdVotes)

-- | Compute the abstract size (in words) that a block takes.
bSize :: Block -> Natural
bSize :: Block -> Natural
bSize Block
b = BlockHeader -> Natural
bHeaderSize (Block
b Block -> Getting BlockHeader Block BlockHeader -> BlockHeader
forall s a. s -> Getting a s a -> a
^. Getting BlockHeader Block BlockHeader
Lens' Block BlockHeader
bHeader) Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ BlockBody -> Natural
bBodySize (Block
b Block -> Getting BlockBody Block BlockBody -> BlockBody
forall s a. s -> Getting a s a -> a
^. Getting BlockBody Block BlockBody
Lens' Block BlockBody
bBody)

-- | Compute the abstract size (in words) that a block body occupies.
bBodySize :: BlockBody -> Natural
bBodySize :: BlockBody -> Natural
bBodySize = Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Natural) -> (BlockBody -> Int) -> BlockBody -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccountingMap -> BlockBody -> Int
forall a. HasTypeReps a => AccountingMap -> a -> Int
abstractSize AccountingMap
costs
  where
    costs :: AccountingMap
costs =
      [(TypeRep, Int)] -> AccountingMap
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ (Maybe UProp -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (Maybe UProp
forall a. HasCallStack => a
undefined :: Maybe UProp), Int
1)
        , (String -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (String
forall a. HasCallStack => a
undefined :: STag), Int
1)
        , (ProtVer -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (ProtVer
forall a. HasCallStack => a
undefined :: ProtVer), Int
1)
        , (DCert -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (DCert
forall a. HasCallStack => a
undefined :: DCert), Int
1)
        , (Vote -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (Vote
forall a. HasCallStack => a
undefined :: Vote), Int
1)
        , (Tx -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (Tx
forall a. HasCallStack => a
undefined :: Tx), Int
1)
        , (Wit -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (Wit
forall a. HasCallStack => a
undefined :: Wit), Int
1)
        , (TxIn -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (TxIn
forall a. HasCallStack => a
undefined :: TxIn), Int
1)
        , (TxOut -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (TxOut
forall a. HasCallStack => a
undefined :: TxOut), Int
1)
        ]

-- | Compute the abstract size (in words) that a block header occupies.
bHeaderSize :: BlockHeader -> Natural
bHeaderSize :: BlockHeader -> Natural
bHeaderSize = Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Natural) -> (BlockHeader -> Int) -> BlockHeader -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccountingMap -> BlockHeader -> Int
forall a. HasTypeReps a => AccountingMap -> a -> Int
abstractSize AccountingMap
costs
  where
    costs :: AccountingMap
costs =
      [(TypeRep, Int)] -> AccountingMap
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ (Hash -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (Hash
forall a. HasCallStack => a
undefined :: Hash), Int
1)
        , (Slot -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (Slot
forall a. HasCallStack => a
undefined :: Slot), Int
1)
        , (VKey -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (VKey
forall a. HasCallStack => a
undefined :: VKey), Int
1)
        , (Sig Hash -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (Sig Hash
forall a. HasCallStack => a
undefined :: Sig Hash), Int
1)
        ]

-- | Computes the hash of a header.
hashHeader :: BlockHeader -> Hash
hashHeader :: BlockHeader -> Hash
hashHeader BlockHeader
bh = Maybe Int -> Hash
Hash (Maybe Int -> Hash) -> Maybe Int -> Hash
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ (Hash, Slot, VKey) -> Int
forall a. Hashable a => a -> Int
H.hash (BlockHeader
bh BlockHeader -> Getting Hash BlockHeader Hash -> Hash
forall s a. s -> Getting a s a -> a
^. Getting Hash BlockHeader Hash
Lens' BlockHeader Hash
bhPrevHash, BlockHeader
bh BlockHeader -> Getting Slot BlockHeader Slot -> Slot
forall s a. s -> Getting a s a -> a
^. Getting Slot BlockHeader Slot
Lens' BlockHeader Slot
bhSlot, BlockHeader
bh BlockHeader -> Getting VKey BlockHeader VKey -> VKey
forall s a. s -> Getting a s a -> a
^. Getting VKey BlockHeader VKey
Lens' BlockHeader VKey
bhIssuer)

-- | Computes the hash of the header.
bhToSign :: BlockHeader -> Hash
bhToSign :: BlockHeader -> Hash
bhToSign = BlockHeader -> Hash
hashHeader

bhHash :: BlockHeader -> Hash
bhHash :: BlockHeader -> Hash
bhHash = BlockHeader -> Hash
hashHeader

-- | Checks if a block is an epoch boundary block.
--
-- The function always returns False because tests will be performed
-- only against chains without EBBs.
bIsEBB :: Block -> Bool
bIsEBB :: Block -> Bool
bIsEBB = Bool -> Block -> Bool
forall a b. a -> b -> a
const Bool
False

instance HasSizeInfo Block where
  isTrivial :: Block -> Bool
isTrivial = [DCert] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([DCert] -> Bool) -> (Block -> [DCert]) -> Block -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting [DCert] Block [DCert] -> Block -> [DCert]
forall a s. Getting a s a -> s -> a
view ((BlockBody -> Const [DCert] BlockBody)
-> Block -> Const [DCert] Block
Lens' Block BlockBody
bBody ((BlockBody -> Const [DCert] BlockBody)
 -> Block -> Const [DCert] Block)
-> (([DCert] -> Const [DCert] [DCert])
    -> BlockBody -> Const [DCert] BlockBody)
-> Getting [DCert] Block [DCert]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([DCert] -> Const [DCert] [DCert])
-> BlockBody -> Const [DCert] BlockBody
Lens' BlockBody [DCert]
bDCerts)

-- | Update a field of the block body, recomputing the hashes to get a valid
-- block.
updateBody ::
  Block ->
  (BlockBody -> BlockBody) ->
  Block
updateBody :: Block -> (BlockBody -> BlockBody) -> Block
updateBody Block
block BlockBody -> BlockBody
bodyUpdate =
  Hash
-> Slot
-> VKey
-> ProtVer
-> [DCert]
-> Maybe UProp
-> [Vote]
-> [Tx]
-> Block
mkBlock
    (BlockHeader -> Hash
_bhPrevHash (BlockHeader -> Hash) -> (Block -> BlockHeader) -> Block -> Hash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> BlockHeader
_bHeader (Block -> Hash) -> Block -> Hash
forall a b. (a -> b) -> a -> b
$ Block
block)
    (BlockHeader -> Slot
_bhSlot (BlockHeader -> Slot) -> (Block -> BlockHeader) -> Block -> Slot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> BlockHeader
_bHeader (Block -> Slot) -> Block -> Slot
forall a b. (a -> b) -> a -> b
$ Block
block)
    (BlockHeader -> VKey
_bhIssuer (BlockHeader -> VKey) -> (Block -> BlockHeader) -> Block -> VKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> BlockHeader
_bHeader (Block -> VKey) -> Block -> VKey
forall a b. (a -> b) -> a -> b
$ Block
block)
    (BlockBody -> ProtVer
_bProtVer BlockBody
newBody)
    (BlockBody -> [DCert]
_bDCerts BlockBody
newBody)
    (BlockBody -> Maybe UProp
_bUpdProp BlockBody
newBody)
    (BlockBody -> [Vote]
_bUpdVotes BlockBody
newBody)
    (BlockBody -> [Tx]
_bUtxo BlockBody
newBody)
  where
    newBody :: BlockBody
newBody = BlockBody -> BlockBody
bodyUpdate (Block -> BlockBody
_bBody Block
block)

--------------------------------------------------------------------------------
-- Block statistics
--------------------------------------------------------------------------------

data BlockStats = BlockStats
  { BlockStats -> Word
blockStatsUtxo :: Word
  -- ^ Number of regular transactions
  , BlockStats -> Word
blockStatsDCerts :: Word
  -- ^ Number of delegation certificates
  , BlockStats -> Word
blockStatsUpdVotes :: Word
  -- ^ Number of update votes
  , BlockStats -> Word
blockStatsUpdProp :: Word
  -- ^ Number of update proposals
  --
  -- For a single block this will be 0 or 1.
  }
  deriving (Int -> BlockStats -> ShowS
[BlockStats] -> ShowS
BlockStats -> String
(Int -> BlockStats -> ShowS)
-> (BlockStats -> String)
-> ([BlockStats] -> ShowS)
-> Show BlockStats
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BlockStats -> ShowS
showsPrec :: Int -> BlockStats -> ShowS
$cshow :: BlockStats -> String
show :: BlockStats -> String
$cshowList :: [BlockStats] -> ShowS
showList :: [BlockStats] -> ShowS
Show)

-- | Count number of transactions in the block
--
-- Returns the number of
--
-- * Regular transactions
-- * Delegation certificates
-- * Update votes
-- * Update proposals (0 or 1)
blockStats :: Block -> BlockStats
blockStats :: Block -> BlockStats
blockStats (Block BlockHeader
_header BlockBody
body) =
  BlockStats
    { blockStatsUtxo :: Word
blockStatsUtxo = Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> ([Tx] -> Int) -> [Tx] -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tx] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Tx] -> Word) -> [Tx] -> Word
forall a b. (a -> b) -> a -> b
$ BlockBody -> [Tx]
_bUtxo BlockBody
body
    , blockStatsDCerts :: Word
blockStatsDCerts = Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> ([DCert] -> Int) -> [DCert] -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DCert] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([DCert] -> Word) -> [DCert] -> Word
forall a b. (a -> b) -> a -> b
$ BlockBody -> [DCert]
_bDCerts BlockBody
body
    , blockStatsUpdVotes :: Word
blockStatsUpdVotes = Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> ([Vote] -> Int) -> [Vote] -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Vote] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Vote] -> Word) -> [Vote] -> Word
forall a b. (a -> b) -> a -> b
$ BlockBody -> [Vote]
_bUpdVotes BlockBody
body
    , blockStatsUpdProp :: Word
blockStatsUpdProp = Word -> (UProp -> Word) -> Maybe UProp -> Word
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Word
0 (Word -> UProp -> Word
forall a b. a -> b -> a
const Word
1) (Maybe UProp -> Word) -> Maybe UProp -> Word
forall a b. (a -> b) -> a -> b
$ BlockBody -> Maybe UProp
_bUpdProp BlockBody
body
    }

-- | Block stats for an entire chain
--
-- Computes minimum, maximum, and average values.
--
-- Returns 'Nothing' for the empty chain.
chainBlockStats :: [BlockStats] -> Maybe (BlockStats, BlockStats, BlockStats)
chainBlockStats :: [BlockStats] -> Maybe (BlockStats, BlockStats, BlockStats)
chainBlockStats [] = Maybe (BlockStats, BlockStats, BlockStats)
forall a. Maybe a
Nothing
chainBlockStats (BlockStats
b : [BlockStats]
bs) = (BlockStats, BlockStats, BlockStats)
-> Maybe (BlockStats, BlockStats, BlockStats)
forall a. a -> Maybe a
Just ((BlockStats, BlockStats, BlockStats)
 -> Maybe (BlockStats, BlockStats, BlockStats))
-> (BlockStats, BlockStats, BlockStats)
-> Maybe (BlockStats, BlockStats, BlockStats)
forall a b. (a -> b) -> a -> b
$ BlockStats
-> BlockStats
-> BlockStats
-> Word
-> [BlockStats]
-> (BlockStats, BlockStats, BlockStats)
go BlockStats
b BlockStats
b BlockStats
b Word
1 [BlockStats]
bs
  where
    go ::
      BlockStats -> -- Minimum
      BlockStats -> -- Maximum
      BlockStats -> -- Sum
      Word -> -- Count
      [BlockStats] ->
      (BlockStats, BlockStats, BlockStats)
    go :: BlockStats
-> BlockStats
-> BlockStats
-> Word
-> [BlockStats]
-> (BlockStats, BlockStats, BlockStats)
go !BlockStats
sMin !BlockStats
sMax !BlockStats
sSum !Word
cnt [] =
      ( BlockStats
sMin
      , BlockStats
sMax
      , BlockStats
          { blockStatsUtxo :: Word
blockStatsUtxo = BlockStats -> Word
blockStatsUtxo BlockStats
sSum Word -> Word -> Word
forall a. Integral a => a -> a -> a
`div` Word
cnt
          , blockStatsDCerts :: Word
blockStatsDCerts = BlockStats -> Word
blockStatsDCerts BlockStats
sSum Word -> Word -> Word
forall a. Integral a => a -> a -> a
`div` Word
cnt
          , blockStatsUpdVotes :: Word
blockStatsUpdVotes = BlockStats -> Word
blockStatsUpdVotes BlockStats
sSum Word -> Word -> Word
forall a. Integral a => a -> a -> a
`div` Word
cnt
          , blockStatsUpdProp :: Word
blockStatsUpdProp = BlockStats -> Word
blockStatsUpdProp BlockStats
sSum Word -> Word -> Word
forall a. Integral a => a -> a -> a
`div` Word
cnt
          }
      )
    go !BlockStats
sMin !BlockStats
sMax !BlockStats
sSum !Word
cnt (BlockStats
b' : [BlockStats]
bs') =
      BlockStats
-> BlockStats
-> BlockStats
-> Word
-> [BlockStats]
-> (BlockStats, BlockStats, BlockStats)
go
        BlockStats
          { blockStatsUtxo :: Word
blockStatsUtxo = (Word -> Word -> Word
forall a. Ord a => a -> a -> a
min (Word -> Word -> Word)
-> (BlockStats -> Word) -> BlockStats -> BlockStats -> Word
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` BlockStats -> Word
blockStatsUtxo) BlockStats
sMin BlockStats
b'
          , blockStatsDCerts :: Word
blockStatsDCerts = (Word -> Word -> Word
forall a. Ord a => a -> a -> a
min (Word -> Word -> Word)
-> (BlockStats -> Word) -> BlockStats -> BlockStats -> Word
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` BlockStats -> Word
blockStatsDCerts) BlockStats
sMin BlockStats
b'
          , blockStatsUpdVotes :: Word
blockStatsUpdVotes = (Word -> Word -> Word
forall a. Ord a => a -> a -> a
min (Word -> Word -> Word)
-> (BlockStats -> Word) -> BlockStats -> BlockStats -> Word
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` BlockStats -> Word
blockStatsUpdVotes) BlockStats
sMin BlockStats
b'
          , blockStatsUpdProp :: Word
blockStatsUpdProp = (Word -> Word -> Word
forall a. Ord a => a -> a -> a
min (Word -> Word -> Word)
-> (BlockStats -> Word) -> BlockStats -> BlockStats -> Word
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` BlockStats -> Word
blockStatsUpdProp) BlockStats
sMin BlockStats
b'
          }
        BlockStats
          { blockStatsUtxo :: Word
blockStatsUtxo = (Word -> Word -> Word
forall a. Ord a => a -> a -> a
max (Word -> Word -> Word)
-> (BlockStats -> Word) -> BlockStats -> BlockStats -> Word
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` BlockStats -> Word
blockStatsUtxo) BlockStats
sMax BlockStats
b'
          , blockStatsDCerts :: Word
blockStatsDCerts = (Word -> Word -> Word
forall a. Ord a => a -> a -> a
max (Word -> Word -> Word)
-> (BlockStats -> Word) -> BlockStats -> BlockStats -> Word
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` BlockStats -> Word
blockStatsDCerts) BlockStats
sMax BlockStats
b'
          , blockStatsUpdVotes :: Word
blockStatsUpdVotes = (Word -> Word -> Word
forall a. Ord a => a -> a -> a
max (Word -> Word -> Word)
-> (BlockStats -> Word) -> BlockStats -> BlockStats -> Word
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` BlockStats -> Word
blockStatsUpdVotes) BlockStats
sMax BlockStats
b'
          , blockStatsUpdProp :: Word
blockStatsUpdProp = (Word -> Word -> Word
forall a. Ord a => a -> a -> a
max (Word -> Word -> Word)
-> (BlockStats -> Word) -> BlockStats -> BlockStats -> Word
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` BlockStats -> Word
blockStatsUpdProp) BlockStats
sMax BlockStats
b'
          }
        BlockStats
          { blockStatsUtxo :: Word
blockStatsUtxo = (Word -> Word -> Word
forall a. Num a => a -> a -> a
(+) (Word -> Word -> Word)
-> (BlockStats -> Word) -> BlockStats -> BlockStats -> Word
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` BlockStats -> Word
blockStatsUtxo) BlockStats
sSum BlockStats
b'
          , blockStatsDCerts :: Word
blockStatsDCerts = (Word -> Word -> Word
forall a. Num a => a -> a -> a
(+) (Word -> Word -> Word)
-> (BlockStats -> Word) -> BlockStats -> BlockStats -> Word
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` BlockStats -> Word
blockStatsDCerts) BlockStats
sSum BlockStats
b'
          , blockStatsUpdVotes :: Word
blockStatsUpdVotes = (Word -> Word -> Word
forall a. Num a => a -> a -> a
(+) (Word -> Word -> Word)
-> (BlockStats -> Word) -> BlockStats -> BlockStats -> Word
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` BlockStats -> Word
blockStatsUpdVotes) BlockStats
sSum BlockStats
b'
          , blockStatsUpdProp :: Word
blockStatsUpdProp = (Word -> Word -> Word
forall a. Num a => a -> a -> a
(+) (Word -> Word -> Word)
-> (BlockStats -> Word) -> BlockStats -> BlockStats -> Word
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` BlockStats -> Word
blockStatsUpdProp) BlockStats
sSum BlockStats
b'
          }
        (Word
cnt Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1)
        [BlockStats]
bs'