{-# 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, Typeable)
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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlockHeader -> BlockHeader -> Bool
$c/= :: BlockHeader -> BlockHeader -> Bool
== :: BlockHeader -> BlockHeader -> Bool
$c== :: BlockHeader -> BlockHeader -> Bool
Eq, 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
$cto :: forall x. Rep BlockHeader x -> BlockHeader
$cfrom :: forall x. BlockHeader -> Rep BlockHeader x
Generic, Int -> BlockHeader -> ShowS
[BlockHeader] -> ShowS
BlockHeader -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlockHeader] -> ShowS
$cshowList :: [BlockHeader] -> ShowS
show :: BlockHeader -> String
$cshow :: BlockHeader -> String
showsPrec :: Int -> BlockHeader -> ShowS
$cshowsPrec :: Int -> BlockHeader -> ShowS
Show, Typeable BlockHeader
BlockHeader -> DataType
BlockHeader -> Constr
(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)
gmapMo :: 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
gmapMp :: forall (m :: * -> *).
MonadPlus 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
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BlockHeader -> m BlockHeader
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BlockHeader -> m BlockHeader
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BlockHeader -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BlockHeader -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> BlockHeader -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> BlockHeader -> [u]
gmapQr :: 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
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BlockHeader -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BlockHeader -> r
gmapT :: (forall b. Data b => b -> b) -> BlockHeader -> BlockHeader
$cgmapT :: (forall b. Data b => b -> b) -> BlockHeader -> BlockHeader
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c BlockHeader)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c BlockHeader)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BlockHeader)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BlockHeader)
dataTypeOf :: BlockHeader -> DataType
$cdataTypeOf :: BlockHeader -> DataType
toConstr :: BlockHeader -> Constr
$ctoConstr :: BlockHeader -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BlockHeader
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BlockHeader
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BlockHeader -> c BlockHeader
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BlockHeader -> c BlockHeader
Data, Typeable)

-- 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 =
    forall a. Typeable a => a -> TypeRep
typeOf BlockHeader
x
      forall a. a -> Seq a -> Seq a
<| forall a. Typeable a => a -> TypeRep
typeOf (forall a. HasCallStack => a
undefined :: Hash)
      forall a. a -> Seq a -> Seq a
<| forall a. Typeable a => a -> TypeRep
typeOf (BlockHeader
x forall s a. s -> Getting a s a -> a
^. Lens' BlockHeader Hash
bhUtxoHash :: Hash)
      forall a. a -> Seq a -> Seq a
<| forall a. Typeable a => a -> TypeRep
typeOf (BlockHeader
x forall s a. s -> Getting a s a -> a
^. Lens' BlockHeader Hash
bhDlgHash :: Hash)
      forall a. a -> Seq a -> Seq a
<| forall a. Typeable a => a -> TypeRep
typeOf (BlockHeader
x forall s a. s -> Getting a s a -> a
^. Lens' BlockHeader Hash
bhUpdHash :: Hash)
      forall a. a -> Seq a -> Seq a
<| forall a. HasTypeReps a => a -> Seq TypeRep
typeReps (BlockHeader
x forall s a. s -> Getting a s a -> a
^. Lens' BlockHeader Slot
bhSlot :: Slot)
        forall a. Semigroup a => a -> a -> a
<> forall a. HasTypeReps a => a -> Seq TypeRep
typeReps (BlockHeader
x forall s a. s -> Getting a s a -> a
^. Lens' BlockHeader VKey
bhIssuer :: VKey)
        forall a. Semigroup a => a -> a -> a
<> forall a. HasTypeReps a => a -> Seq TypeRep
typeReps (BlockHeader
x forall s a. s -> Getting a s a -> a
^. 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. 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
$cto :: forall x. Rep BlockBody x -> BlockBody
$cfrom :: forall x. BlockBody -> Rep BlockBody x
Generic, Int -> BlockBody -> ShowS
[BlockBody] -> ShowS
BlockBody -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlockBody] -> ShowS
$cshowList :: [BlockBody] -> ShowS
show :: BlockBody -> String
$cshow :: BlockBody -> String
showsPrec :: Int -> BlockBody -> ShowS
$cshowsPrec :: Int -> BlockBody -> ShowS
Show, Typeable BlockBody
BlockBody -> DataType
BlockBody -> Constr
(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)
gmapMo :: 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
gmapMp :: forall (m :: * -> *).
MonadPlus 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
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BlockBody -> m BlockBody
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BlockBody -> m BlockBody
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BlockBody -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BlockBody -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> BlockBody -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> BlockBody -> [u]
gmapQr :: 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
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BlockBody -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BlockBody -> r
gmapT :: (forall b. Data b => b -> b) -> BlockBody -> BlockBody
$cgmapT :: (forall b. Data b => b -> b) -> BlockBody -> BlockBody
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BlockBody)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BlockBody)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BlockBody)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BlockBody)
dataTypeOf :: BlockBody -> DataType
$cdataTypeOf :: BlockBody -> DataType
toConstr :: BlockBody -> Constr
$ctoConstr :: BlockBody -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BlockBody
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BlockBody
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BlockBody -> c BlockBody
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BlockBody -> c BlockBody
Data, Typeable)

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. 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
$cto :: forall x. Rep Block x -> Block
$cfrom :: forall x. Block -> Rep Block x
Generic, Int -> Block -> ShowS
[Block] -> ShowS
Block -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Block] -> ShowS
$cshowList :: [Block] -> ShowS
show :: Block -> String
$cshow :: Block -> String
showsPrec :: Int -> Block -> ShowS
$cshowsPrec :: Int -> Block -> ShowS
Show, Typeable Block
Block -> DataType
Block -> Constr
(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)
gmapMo :: 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
gmapMp :: forall (m :: * -> *).
MonadPlus 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
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Block -> m Block
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Block -> m Block
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Block -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Block -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Block -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Block -> [u]
gmapQr :: 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
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Block -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Block -> r
gmapT :: (forall b. Data b => b -> b) -> Block -> Block
$cgmapT :: (forall b. Data b => b -> b) -> Block -> Block
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Block)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Block)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Block)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Block)
dataTypeOf :: Block -> DataType
$cdataTypeOf :: Block -> DataType
toConstr :: Block -> Constr
$ctoConstr :: Block -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Block
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Block
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Block -> c Block
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Block -> c Block
Data, Typeable)

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 Hash
_bhSig = forall a. a -> Owner -> Sig a
Sig (BlockHeader -> Hash
hashHeader BlockHeader
unsignedHeader) (forall a. HasOwner a => a -> Owner
owner VKey
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 = (forall a. HasHash a => a -> Hash
hash [Tx]
utxoTransactions)
              , _bhDlgHash :: Hash
_bhDlgHash = (forall a. HasHash a => a -> Hash
hash [DCert]
delegationCerts)
              , _bhUpdHash :: Hash
_bhUpdHash = (forall a. HasHash a => a -> Hash
hash (Maybe UProp
maybeUpdateProposal, [Vote]
updateProposalVotes))
              }
            where
              dummySig :: Sig Hash
dummySig = forall a. a -> Owner -> Sig a
Sig Hash
genesisHash (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 forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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 forall s a. s -> Getting a s a -> a
^. Lens' Block BlockBody
bBody forall s a. s -> Getting a s a -> a
^. Lens' BlockBody ProtVer
bProtVer, Block
b forall s a. s -> Getting a s a -> a
^. Lens' Block BlockHeader
bHeader forall s a. s -> Getting a s a -> a
^. Lens' BlockHeader VKey
bhIssuer)

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

-- | Block update payload
bUpdPayload :: Block -> (Maybe UProp, [Vote])
bUpdPayload :: Block -> (Maybe UProp, [Vote])
bUpdPayload Block
b = (Block
b forall s a. s -> Getting a s a -> a
^. Lens' Block BlockBody
bBody forall s a. s -> Getting a s a -> a
^. Lens' BlockBody (Maybe UProp)
bUpdProp, Block
b forall s a. s -> Getting a s a -> a
^. Lens' Block BlockBody
bBody forall s a. s -> Getting a s a -> a
^. 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 forall s a. s -> Getting a s a -> a
^. Lens' Block BlockHeader
bHeader) forall a. Num a => a -> a -> a
+ BlockBody -> Natural
bBodySize (Block
b forall s a. s -> Getting a s a -> a
^. Lens' Block BlockBody
bBody)

-- | Compute the abstract size (in words) that a block body occupies.
bBodySize :: BlockBody -> Natural
bBodySize :: BlockBody -> Natural
bBodySize = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasTypeReps a => AccountingMap -> a -> Int
abstractSize AccountingMap
costs
  where
    costs :: AccountingMap
costs =
      forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ (forall a. Typeable a => a -> TypeRep
typeOf (forall a. HasCallStack => a
undefined :: Maybe UProp), Int
1)
        , (forall a. Typeable a => a -> TypeRep
typeOf (forall a. HasCallStack => a
undefined :: STag), Int
1)
        , (forall a. Typeable a => a -> TypeRep
typeOf (forall a. HasCallStack => a
undefined :: ProtVer), Int
1)
        , (forall a. Typeable a => a -> TypeRep
typeOf (forall a. HasCallStack => a
undefined :: DCert), Int
1)
        , (forall a. Typeable a => a -> TypeRep
typeOf (forall a. HasCallStack => a
undefined :: Vote), Int
1)
        , (forall a. Typeable a => a -> TypeRep
typeOf (forall a. HasCallStack => a
undefined :: Tx), Int
1)
        , (forall a. Typeable a => a -> TypeRep
typeOf (forall a. HasCallStack => a
undefined :: Wit), Int
1)
        , (forall a. Typeable a => a -> TypeRep
typeOf (forall a. HasCallStack => a
undefined :: TxIn), Int
1)
        , (forall a. Typeable a => a -> TypeRep
typeOf (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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasTypeReps a => AccountingMap -> a -> Int
abstractSize AccountingMap
costs
  where
    costs :: AccountingMap
costs =
      forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ (forall a. Typeable a => a -> TypeRep
typeOf (forall a. HasCallStack => a
undefined :: Hash), Int
1)
        , (forall a. Typeable a => a -> TypeRep
typeOf (forall a. HasCallStack => a
undefined :: Slot), Int
1)
        , (forall a. Typeable a => a -> TypeRep
typeOf (forall a. HasCallStack => a
undefined :: VKey), Int
1)
        , (forall a. Typeable a => a -> TypeRep
typeOf (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 forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Hashable a => a -> Int
H.hash (BlockHeader
bh forall s a. s -> Getting a s a -> a
^. Lens' BlockHeader Hash
bhPrevHash, BlockHeader
bh forall s a. s -> Getting a s a -> a
^. Lens' BlockHeader Slot
bhSlot, BlockHeader
bh forall s a. s -> Getting a s a -> a
^. 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 = forall a b. a -> b -> a
const Bool
False

instance HasSizeInfo Block where
  isTrivial :: Block -> Bool
isTrivial = forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a s. Getting a s a -> s -> a
view (Lens' Block BlockBody
bBody forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> BlockHeader
_bHeader forall a b. (a -> b) -> a -> b
$ Block
block)
    (BlockHeader -> Slot
_bhSlot forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> BlockHeader
_bHeader forall a b. (a -> b) -> a -> b
$ Block
block)
    (BlockHeader -> VKey
_bhIssuer forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> BlockHeader
_bHeader 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlockStats] -> ShowS
$cshowList :: [BlockStats] -> ShowS
show :: BlockStats -> String
$cshow :: BlockStats -> String
showsPrec :: Int -> BlockStats -> ShowS
$cshowsPrec :: Int -> 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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ BlockBody -> [Tx]
_bUtxo BlockBody
body
    , blockStatsDCerts :: Word
blockStatsDCerts = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ BlockBody -> [DCert]
_bDCerts BlockBody
body
    , blockStatsUpdVotes :: Word
blockStatsUpdVotes = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ BlockBody -> [Vote]
_bUpdVotes BlockBody
body
    , blockStatsUpdProp :: Word
blockStatsUpdProp = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Word
0 (forall a b. a -> b -> a
const Word
1) 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 [] = forall a. Maybe a
Nothing
chainBlockStats (BlockStats
b : [BlockStats]
bs) = forall a. a -> Maybe a
Just 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 forall a. Integral a => a -> a -> a
`div` Word
cnt
          , blockStatsDCerts :: Word
blockStatsDCerts = BlockStats -> Word
blockStatsDCerts BlockStats
sSum forall a. Integral a => a -> a -> a
`div` Word
cnt
          , blockStatsUpdVotes :: Word
blockStatsUpdVotes = BlockStats -> Word
blockStatsUpdVotes BlockStats
sSum forall a. Integral a => a -> a -> a
`div` Word
cnt
          , blockStatsUpdProp :: Word
blockStatsUpdProp = BlockStats -> Word
blockStatsUpdProp BlockStats
sSum 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 = (forall a. Ord a => a -> a -> a
min forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` BlockStats -> Word
blockStatsUtxo) BlockStats
sMin BlockStats
b'
          , blockStatsDCerts :: Word
blockStatsDCerts = (forall a. Ord a => a -> a -> a
min forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` BlockStats -> Word
blockStatsDCerts) BlockStats
sMin BlockStats
b'
          , blockStatsUpdVotes :: Word
blockStatsUpdVotes = (forall a. Ord a => a -> a -> a
min forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` BlockStats -> Word
blockStatsUpdVotes) BlockStats
sMin BlockStats
b'
          , blockStatsUpdProp :: Word
blockStatsUpdProp = (forall a. Ord a => a -> a -> a
min forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` BlockStats -> Word
blockStatsUpdProp) BlockStats
sMin BlockStats
b'
          }
        BlockStats
          { blockStatsUtxo :: Word
blockStatsUtxo = (forall a. Ord a => a -> a -> a
max forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` BlockStats -> Word
blockStatsUtxo) BlockStats
sMax BlockStats
b'
          , blockStatsDCerts :: Word
blockStatsDCerts = (forall a. Ord a => a -> a -> a
max forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` BlockStats -> Word
blockStatsDCerts) BlockStats
sMax BlockStats
b'
          , blockStatsUpdVotes :: Word
blockStatsUpdVotes = (forall a. Ord a => a -> a -> a
max forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` BlockStats -> Word
blockStatsUpdVotes) BlockStats
sMax BlockStats
b'
          , blockStatsUpdProp :: Word
blockStatsUpdProp = (forall a. Ord a => a -> a -> a
max forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` BlockStats -> Word
blockStatsUpdProp) BlockStats
sMax BlockStats
b'
          }
        BlockStats
          { blockStatsUtxo :: Word
blockStatsUtxo = (forall a. Num a => a -> a -> a
(+) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` BlockStats -> Word
blockStatsUtxo) BlockStats
sSum BlockStats
b'
          , blockStatsDCerts :: Word
blockStatsDCerts = (forall a. Num a => a -> a -> a
(+) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` BlockStats -> Word
blockStatsDCerts) BlockStats
sSum BlockStats
b'
          , blockStatsUpdVotes :: Word
blockStatsUpdVotes = (forall a. Num a => a -> a -> a
(+) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` BlockStats -> Word
blockStatsUpdVotes) BlockStats
sSum BlockStats
b'
          , blockStatsUpdProp :: Word
blockStatsUpdProp = (forall a. Num a => a -> a -> a
(+) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` BlockStats -> Word
blockStatsUpdProp) BlockStats
sSum BlockStats
b'
          }
        (Word
cnt forall a. Num a => a -> a -> a
+ Word
1)
        [BlockStats]
bs'