{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeApplications #-}

-- | The Leios types that the storage layer needs: hashes, points, endorser
-- block bodies and their sizes.
--
-- This is the slice of the Leios prototype's types that
-- "Ouroboros.Consensus.Storage.LeiosDB" depends on. The rest of the Leios
-- machinery (announcements, fetch, voting, certificates) extends this module
-- as it lands.
module Ouroboros.Consensus.Leios.Types
  ( -- * Hashes
    EndorserBlockHash
  , RankingBlockHash (..)
  , toRankingBlockHash
  , TxHash

    -- * Transactions
  , LeiosTx (..)
  , encodeLeiosTx
  , decodeLeiosTx

    -- * Points
  , LeiosPoint (..)
  , encodeLeiosPoint
  , decodeLeiosPoint
  , prettyLeiosPoint

    -- * Elections
  , ElectionId (..)

    -- * Votes
  , LeiosVote (..)
  , encodeLeiosVote
  , decodeLeiosVote

    -- * Endorser blocks
  , BytesSize
  , EndorserBlock -- opaque
  , TxOffset
  , mkEndorserBlock
  , endorserBlockFromTxBytes
  , endorserBlockHash
  , endorserBlockReferences
  , encodeEndorserBlock
  , decodeEndorserBlock
  , sizeEndorserBlockReference
  , encodeEndorserBlockSize
  , referencesCapacity
  , maxEndorserBlockBytesSize
  , maxTxsPerEndorserBlock

    -- * Header checks
  , milliseconds32ToNominalDiffTime
  , minCertificationSlot
  ) where

import Cardano.Binary (FromCBOR (..), ToCBOR (..), decodeNestedCborBytes, encodeNestedCborBytes)
import Cardano.Binary.FixedSizeCodec (decodeFixedSized, encodeFixedSized)
import Cardano.Crypto.Hash
  ( Hash
  , castHash
  , hashFromBytesShort
  , hashSize
  , hashToBytes
  , hashToStringAsHex
  , hashWith
  )
import Cardano.Crypto.Leios (LeiosSeatId (..), LeiosSignature)
import Cardano.Crypto.Util (SignableRepresentation (..))
import Cardano.Ledger.BaseTypes (Milliseconds32 (..))
import Cardano.Ledger.Binary
  ( Annotator (..)
  , DecCBOR (..)
  , EncCBOR (..)
  , FullByteString (..)
  , Version
  , toPlainDecoder
  , toPlainEncoding
  )
import Cardano.Ledger.Binary.Plain (decodeRecordNamed)
import Cardano.Ledger.Core (eraProtVerLow)
import Cardano.Ledger.Dijkstra (DijkstraEra)
import qualified Cardano.Ledger.Dijkstra.Block.Endorser as Ledger
import Cardano.Ledger.Hashes
  ( EraIndependentBlockHeader
  , EraIndependentEbReferences
  , EraIndependentTx
  , HASH
  , SafeToHash (originalBytesSize)
  , extractHash
  , hashAnnotated
  , unsafeMakeSafeHash
  )
import Cardano.Ledger.Keys (KeyHash, KeyRole (BlockIssuer))
import Cardano.Slotting.Slot (SlotNo (..))
import Cardano.Slotting.Time (SlotLength, slotLengthToMillisec)
import Codec.CBOR.Decoding (Decoder)
import qualified Codec.CBOR.Decoding as CBOR
import Codec.CBOR.Encoding (Encoding)
import qualified Codec.CBOR.Encoding as CBOR
import Codec.Serialise (Serialise (..))
import Control.DeepSeq (NFData)
import Control.Monad (when)
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import Data.Foldable (toList)
import Data.List.NonEmpty (NonEmpty)
import Data.Maybe (fromMaybe)
import Data.Proxy (Proxy (..))
import qualified Data.Text as T
import Data.Time (NominalDiffTime)
import Data.Word (Word32)
import GHC.Generics (Generic)
import qualified GHC.IsList as IsList
import NoThunks.Class (NoThunks)
import Ouroboros.Consensus.Block.Abstract (ConvertRawHash (toShortRawHash), HeaderHash)
import Ouroboros.Consensus.Ledger.SupportsMempool (ByteSize32 (..))
import Ouroboros.Consensus.Util (ShowProxy (..))

-- * Hashes

-- | The hash of an endorser block, as ranking blocks announce it.
type EndorserBlockHash = Hash HASH EraIndependentEbReferences

-- | The hash of a ranking block's header, which votes sign.
--
-- Ranking blocks are Praos blocks, whose 'HeaderHash' depends on 'blk'. Use
-- 'toRankingBlockHash' to convert it to this monomorphic type.
newtype RankingBlockHash = MkRankingBlockHash
  { RankingBlockHash -> Hash HASH EraIndependentBlockHeader
unRankingBlockHash :: Hash HASH EraIndependentBlockHeader
  }
  deriving stock (RankingBlockHash -> RankingBlockHash -> Bool
(RankingBlockHash -> RankingBlockHash -> Bool)
-> (RankingBlockHash -> RankingBlockHash -> Bool)
-> Eq RankingBlockHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RankingBlockHash -> RankingBlockHash -> Bool
== :: RankingBlockHash -> RankingBlockHash -> Bool
$c/= :: RankingBlockHash -> RankingBlockHash -> Bool
/= :: RankingBlockHash -> RankingBlockHash -> Bool
Eq, Eq RankingBlockHash
Eq RankingBlockHash =>
(RankingBlockHash -> RankingBlockHash -> Ordering)
-> (RankingBlockHash -> RankingBlockHash -> Bool)
-> (RankingBlockHash -> RankingBlockHash -> Bool)
-> (RankingBlockHash -> RankingBlockHash -> Bool)
-> (RankingBlockHash -> RankingBlockHash -> Bool)
-> (RankingBlockHash -> RankingBlockHash -> RankingBlockHash)
-> (RankingBlockHash -> RankingBlockHash -> RankingBlockHash)
-> Ord RankingBlockHash
RankingBlockHash -> RankingBlockHash -> Bool
RankingBlockHash -> RankingBlockHash -> Ordering
RankingBlockHash -> RankingBlockHash -> RankingBlockHash
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RankingBlockHash -> RankingBlockHash -> Ordering
compare :: RankingBlockHash -> RankingBlockHash -> Ordering
$c< :: RankingBlockHash -> RankingBlockHash -> Bool
< :: RankingBlockHash -> RankingBlockHash -> Bool
$c<= :: RankingBlockHash -> RankingBlockHash -> Bool
<= :: RankingBlockHash -> RankingBlockHash -> Bool
$c> :: RankingBlockHash -> RankingBlockHash -> Bool
> :: RankingBlockHash -> RankingBlockHash -> Bool
$c>= :: RankingBlockHash -> RankingBlockHash -> Bool
>= :: RankingBlockHash -> RankingBlockHash -> Bool
$cmax :: RankingBlockHash -> RankingBlockHash -> RankingBlockHash
max :: RankingBlockHash -> RankingBlockHash -> RankingBlockHash
$cmin :: RankingBlockHash -> RankingBlockHash -> RankingBlockHash
min :: RankingBlockHash -> RankingBlockHash -> RankingBlockHash
Ord, (forall x. RankingBlockHash -> Rep RankingBlockHash x)
-> (forall x. Rep RankingBlockHash x -> RankingBlockHash)
-> Generic RankingBlockHash
forall x. Rep RankingBlockHash x -> RankingBlockHash
forall x. RankingBlockHash -> Rep RankingBlockHash x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RankingBlockHash -> Rep RankingBlockHash x
from :: forall x. RankingBlockHash -> Rep RankingBlockHash x
$cto :: forall x. Rep RankingBlockHash x -> RankingBlockHash
to :: forall x. Rep RankingBlockHash x -> RankingBlockHash
Generic)
  deriving newtype (Int -> RankingBlockHash -> ShowS
[RankingBlockHash] -> ShowS
RankingBlockHash -> String
(Int -> RankingBlockHash -> ShowS)
-> (RankingBlockHash -> String)
-> ([RankingBlockHash] -> ShowS)
-> Show RankingBlockHash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RankingBlockHash -> ShowS
showsPrec :: Int -> RankingBlockHash -> ShowS
$cshow :: RankingBlockHash -> String
show :: RankingBlockHash -> String
$cshowList :: [RankingBlockHash] -> ShowS
showList :: [RankingBlockHash] -> ShowS
Show, Context -> RankingBlockHash -> IO (Maybe ThunkInfo)
Proxy RankingBlockHash -> String
(Context -> RankingBlockHash -> IO (Maybe ThunkInfo))
-> (Context -> RankingBlockHash -> IO (Maybe ThunkInfo))
-> (Proxy RankingBlockHash -> String)
-> NoThunks RankingBlockHash
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> RankingBlockHash -> IO (Maybe ThunkInfo)
noThunks :: Context -> RankingBlockHash -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> RankingBlockHash -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> RankingBlockHash -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy RankingBlockHash -> String
showTypeOf :: Proxy RankingBlockHash -> String
NoThunks, Typeable RankingBlockHash
Typeable RankingBlockHash =>
(RankingBlockHash -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy RankingBlockHash -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [RankingBlockHash] -> Size)
-> ToCBOR RankingBlockHash
RankingBlockHash -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [RankingBlockHash] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy RankingBlockHash -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
$ctoCBOR :: RankingBlockHash -> Encoding
toCBOR :: RankingBlockHash -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy RankingBlockHash -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy RankingBlockHash -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [RankingBlockHash] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [RankingBlockHash] -> Size
ToCBOR, Typeable RankingBlockHash
Typeable RankingBlockHash =>
(forall s. Decoder s RankingBlockHash)
-> (Proxy RankingBlockHash -> Text) -> FromCBOR RankingBlockHash
Proxy RankingBlockHash -> Text
forall s. Decoder s RankingBlockHash
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s RankingBlockHash
fromCBOR :: forall s. Decoder s RankingBlockHash
$clabel :: Proxy RankingBlockHash -> Text
label :: Proxy RankingBlockHash -> Text
FromCBOR)

-- | Used by Leios voting, which signs the hash's bytes.
instance SignableRepresentation RankingBlockHash where
  getSignableRepresentation :: RankingBlockHash -> ByteString
getSignableRepresentation = Hash HASH EraIndependentBlockHeader -> ByteString
forall h a. Hash h a -> ByteString
hashToBytes (Hash HASH EraIndependentBlockHeader -> ByteString)
-> (RankingBlockHash -> Hash HASH EraIndependentBlockHeader)
-> RankingBlockHash
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RankingBlockHash -> Hash HASH EraIndependentBlockHeader
unRankingBlockHash

-- | Convert a ranking block's 'HeaderHash'. It must be the same length as a
-- 'RankingBlockHash', ie 32 bytes.
--
-- TODO Rule out a 'HeaderHash' of another size at compile time, as Peras does
-- with @HashSize blk ~ 32@, without requiring it of every 'RunNode' block.
toRankingBlockHash :: ConvertRawHash blk => Proxy blk -> HeaderHash blk -> RankingBlockHash
toRankingBlockHash :: forall blk.
ConvertRawHash blk =>
Proxy blk -> HeaderHash blk -> RankingBlockHash
toRankingBlockHash Proxy blk
p HeaderHash blk
h =
  Hash HASH EraIndependentBlockHeader -> RankingBlockHash
MkRankingBlockHash (Hash HASH EraIndependentBlockHeader -> RankingBlockHash)
-> Hash HASH EraIndependentBlockHeader -> RankingBlockHash
forall a b. (a -> b) -> a -> b
$
    Hash HASH EraIndependentBlockHeader
-> Maybe (Hash HASH EraIndependentBlockHeader)
-> Hash HASH EraIndependentBlockHeader
forall a. a -> Maybe a -> a
fromMaybe (String -> Hash HASH EraIndependentBlockHeader
forall a. HasCallStack => String -> a
error String
"toRankingBlockHash: header hash of the wrong size") (Maybe (Hash HASH EraIndependentBlockHeader)
 -> Hash HASH EraIndependentBlockHeader)
-> Maybe (Hash HASH EraIndependentBlockHeader)
-> Hash HASH EraIndependentBlockHeader
forall a b. (a -> b) -> a -> b
$
      ShortByteString -> Maybe (Hash HASH EraIndependentBlockHeader)
forall h a. HashAlgorithm h => ShortByteString -> Maybe (Hash h a)
hashFromBytesShort (Proxy blk -> HeaderHash blk -> ShortByteString
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> ShortByteString
forall (proxy :: * -> *).
proxy blk -> HeaderHash blk -> ShortByteString
toShortRawHash Proxy blk
p HeaderHash blk
h)

-- | The hash of a transaction an endorser block references. It hashes all of the
-- transaction's bytes, witnesses included, unlike the ledger's @TxId@ and so
-- the mempool's 'Ouroboros.Consensus.Ledger.SupportsMempool.GenTxId', which
-- hash only the transaction's body.
type TxHash = Hash HASH EraIndependentTx

-- * Transactions

-- | A Leios transaction, as the CBOR bytes of the ledger's transaction.
--
-- Its codec wraps those bytes as CBOR-in-CBOR, so receiving a transaction does
-- not decode it.
--
-- TODO ChainSel and Leios voting will need a way to actually decode the
-- transaction: a per-block-type decoder that takes the ledger state resulting
-- from the announcing ranking block, whose era is the one the endorser block
-- was announced in.
newtype LeiosTx = MkLeiosTx {LeiosTx -> ByteString
leiosTxBytes :: ByteString}
  deriving stock (LeiosTx -> LeiosTx -> Bool
(LeiosTx -> LeiosTx -> Bool)
-> (LeiosTx -> LeiosTx -> Bool) -> Eq LeiosTx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LeiosTx -> LeiosTx -> Bool
== :: LeiosTx -> LeiosTx -> Bool
$c/= :: LeiosTx -> LeiosTx -> Bool
/= :: LeiosTx -> LeiosTx -> Bool
Eq, Int -> LeiosTx -> ShowS
[LeiosTx] -> ShowS
LeiosTx -> String
(Int -> LeiosTx -> ShowS)
-> (LeiosTx -> String) -> ([LeiosTx] -> ShowS) -> Show LeiosTx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LeiosTx -> ShowS
showsPrec :: Int -> LeiosTx -> ShowS
$cshow :: LeiosTx -> String
show :: LeiosTx -> String
$cshowList :: [LeiosTx] -> ShowS
showList :: [LeiosTx] -> ShowS
Show)

instance ShowProxy LeiosTx where showProxy :: Proxy LeiosTx -> String
showProxy Proxy LeiosTx
_ = String
"LeiosTx"

encodeLeiosTx :: LeiosTx -> Encoding
encodeLeiosTx :: LeiosTx -> Encoding
encodeLeiosTx (MkLeiosTx ByteString
bytes) = ByteString -> Encoding
encodeNestedCborBytes (ByteString -> ByteString
BSL.fromStrict ByteString
bytes)

decodeLeiosTx :: Decoder s LeiosTx
decodeLeiosTx :: forall s. Decoder s LeiosTx
decodeLeiosTx = ByteString -> LeiosTx
MkLeiosTx (ByteString -> LeiosTx)
-> Decoder s ByteString -> Decoder s LeiosTx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s ByteString
forall s. Decoder s ByteString
decodeNestedCborBytes

-- * Points

-- | Uniquely identifies an endorser block in Leios. Could use 'Block SlotNo
-- EndorserBlockHash' eventually, but a dedicated type is better to explore.
data LeiosPoint = MkLeiosPoint {LeiosPoint -> SlotNo
pointSlotNo :: SlotNo, LeiosPoint -> Hash HASH EraIndependentEbReferences
pointEbHash :: EndorserBlockHash}
  deriving stock (LeiosPoint -> LeiosPoint -> Bool
(LeiosPoint -> LeiosPoint -> Bool)
-> (LeiosPoint -> LeiosPoint -> Bool) -> Eq LeiosPoint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LeiosPoint -> LeiosPoint -> Bool
== :: LeiosPoint -> LeiosPoint -> Bool
$c/= :: LeiosPoint -> LeiosPoint -> Bool
/= :: LeiosPoint -> LeiosPoint -> Bool
Eq, Eq LeiosPoint
Eq LeiosPoint =>
(LeiosPoint -> LeiosPoint -> Ordering)
-> (LeiosPoint -> LeiosPoint -> Bool)
-> (LeiosPoint -> LeiosPoint -> Bool)
-> (LeiosPoint -> LeiosPoint -> Bool)
-> (LeiosPoint -> LeiosPoint -> Bool)
-> (LeiosPoint -> LeiosPoint -> LeiosPoint)
-> (LeiosPoint -> LeiosPoint -> LeiosPoint)
-> Ord LeiosPoint
LeiosPoint -> LeiosPoint -> Bool
LeiosPoint -> LeiosPoint -> Ordering
LeiosPoint -> LeiosPoint -> LeiosPoint
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: LeiosPoint -> LeiosPoint -> Ordering
compare :: LeiosPoint -> LeiosPoint -> Ordering
$c< :: LeiosPoint -> LeiosPoint -> Bool
< :: LeiosPoint -> LeiosPoint -> Bool
$c<= :: LeiosPoint -> LeiosPoint -> Bool
<= :: LeiosPoint -> LeiosPoint -> Bool
$c> :: LeiosPoint -> LeiosPoint -> Bool
> :: LeiosPoint -> LeiosPoint -> Bool
$c>= :: LeiosPoint -> LeiosPoint -> Bool
>= :: LeiosPoint -> LeiosPoint -> Bool
$cmax :: LeiosPoint -> LeiosPoint -> LeiosPoint
max :: LeiosPoint -> LeiosPoint -> LeiosPoint
$cmin :: LeiosPoint -> LeiosPoint -> LeiosPoint
min :: LeiosPoint -> LeiosPoint -> LeiosPoint
Ord, (forall x. LeiosPoint -> Rep LeiosPoint x)
-> (forall x. Rep LeiosPoint x -> LeiosPoint) -> Generic LeiosPoint
forall x. Rep LeiosPoint x -> LeiosPoint
forall x. LeiosPoint -> Rep LeiosPoint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LeiosPoint -> Rep LeiosPoint x
from :: forall x. LeiosPoint -> Rep LeiosPoint x
$cto :: forall x. Rep LeiosPoint x -> LeiosPoint
to :: forall x. Rep LeiosPoint x -> LeiosPoint
Generic)
  deriving anyclass Context -> LeiosPoint -> IO (Maybe ThunkInfo)
Proxy LeiosPoint -> String
(Context -> LeiosPoint -> IO (Maybe ThunkInfo))
-> (Context -> LeiosPoint -> IO (Maybe ThunkInfo))
-> (Proxy LeiosPoint -> String)
-> NoThunks LeiosPoint
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> LeiosPoint -> IO (Maybe ThunkInfo)
noThunks :: Context -> LeiosPoint -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> LeiosPoint -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> LeiosPoint -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy LeiosPoint -> String
showTypeOf :: Proxy LeiosPoint -> String
NoThunks

instance ShowProxy LeiosPoint where showProxy :: Proxy LeiosPoint -> String
showProxy Proxy LeiosPoint
_ = String
"LeiosPoint"

instance Show LeiosPoint where
  show :: LeiosPoint -> String
show = LeiosPoint -> String
prettyLeiosPoint

encodeLeiosPoint :: LeiosPoint -> Encoding
encodeLeiosPoint :: LeiosPoint -> Encoding
encodeLeiosPoint (MkLeiosPoint SlotNo
ebSlot Hash HASH EraIndependentEbReferences
ebHash) =
  Word -> Encoding
CBOR.encodeListLen Word
2
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SlotNo -> Encoding
forall a. Serialise a => a -> Encoding
encode SlotNo
ebSlot
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Hash HASH EraIndependentEbReferences -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Hash HASH EraIndependentEbReferences
ebHash

decodeLeiosPoint :: Decoder s LeiosPoint
decodeLeiosPoint :: forall s. Decoder s LeiosPoint
decodeLeiosPoint =
  Text
-> (LeiosPoint -> Int)
-> Decoder s LeiosPoint
-> Decoder s LeiosPoint
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed (String -> Text
T.pack String
"LeiosPoint") (Int -> LeiosPoint -> Int
forall a b. a -> b -> a
const Int
2) (Decoder s LeiosPoint -> Decoder s LeiosPoint)
-> Decoder s LeiosPoint -> Decoder s LeiosPoint
forall a b. (a -> b) -> a -> b
$
    SlotNo -> Hash HASH EraIndependentEbReferences -> LeiosPoint
MkLeiosPoint (SlotNo -> Hash HASH EraIndependentEbReferences -> LeiosPoint)
-> Decoder s SlotNo
-> Decoder s (Hash HASH EraIndependentEbReferences -> LeiosPoint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s SlotNo
forall s. Decoder s SlotNo
forall a s. Serialise a => Decoder s a
decode Decoder s (Hash HASH EraIndependentEbReferences -> LeiosPoint)
-> Decoder s (Hash HASH EraIndependentEbReferences)
-> Decoder s LeiosPoint
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Hash HASH EraIndependentEbReferences)
forall s. Decoder s (Hash HASH EraIndependentEbReferences)
forall a s. FromCBOR a => Decoder s a
fromCBOR

prettyLeiosPoint :: LeiosPoint -> String
prettyLeiosPoint :: LeiosPoint -> String
prettyLeiosPoint (MkLeiosPoint (SlotNo Word64
slotNo) Hash HASH EraIndependentEbReferences
ebHash) =
  String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. Show a => a -> String
show Word64
slotNo String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Hash HASH EraIndependentEbReferences -> String
forall h a. Hash h a -> String
hashToStringAsHex Hash HASH EraIndependentEbReferences
ebHash String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

-- * Elections

-- | A ranking block leadership election: a slot and the pool it elected.
--
-- This is unrelated to the 'Ouroboros.Consensus.Committee.Crypto.ElectionId'
-- type family, which identifies an election of a voting committee. We do not
-- anticipate a module using both.
--
-- The derived 'Ord' orders by slot first, which pruning relies on.
data ElectionId = ElectionId
  { ElectionId -> SlotNo
electionSlot :: !SlotNo
  , ElectionId -> KeyHash BlockIssuer
electionElectee :: !(KeyHash BlockIssuer)
  }
  deriving stock (ElectionId -> ElectionId -> Bool
(ElectionId -> ElectionId -> Bool)
-> (ElectionId -> ElectionId -> Bool) -> Eq ElectionId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ElectionId -> ElectionId -> Bool
== :: ElectionId -> ElectionId -> Bool
$c/= :: ElectionId -> ElectionId -> Bool
/= :: ElectionId -> ElectionId -> Bool
Eq, Eq ElectionId
Eq ElectionId =>
(ElectionId -> ElectionId -> Ordering)
-> (ElectionId -> ElectionId -> Bool)
-> (ElectionId -> ElectionId -> Bool)
-> (ElectionId -> ElectionId -> Bool)
-> (ElectionId -> ElectionId -> Bool)
-> (ElectionId -> ElectionId -> ElectionId)
-> (ElectionId -> ElectionId -> ElectionId)
-> Ord ElectionId
ElectionId -> ElectionId -> Bool
ElectionId -> ElectionId -> Ordering
ElectionId -> ElectionId -> ElectionId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ElectionId -> ElectionId -> Ordering
compare :: ElectionId -> ElectionId -> Ordering
$c< :: ElectionId -> ElectionId -> Bool
< :: ElectionId -> ElectionId -> Bool
$c<= :: ElectionId -> ElectionId -> Bool
<= :: ElectionId -> ElectionId -> Bool
$c> :: ElectionId -> ElectionId -> Bool
> :: ElectionId -> ElectionId -> Bool
$c>= :: ElectionId -> ElectionId -> Bool
>= :: ElectionId -> ElectionId -> Bool
$cmax :: ElectionId -> ElectionId -> ElectionId
max :: ElectionId -> ElectionId -> ElectionId
$cmin :: ElectionId -> ElectionId -> ElectionId
min :: ElectionId -> ElectionId -> ElectionId
Ord, Int -> ElectionId -> ShowS
[ElectionId] -> ShowS
ElectionId -> String
(Int -> ElectionId -> ShowS)
-> (ElectionId -> String)
-> ([ElectionId] -> ShowS)
-> Show ElectionId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ElectionId -> ShowS
showsPrec :: Int -> ElectionId -> ShowS
$cshow :: ElectionId -> String
show :: ElectionId -> String
$cshowList :: [ElectionId] -> ShowS
showList :: [ElectionId] -> ShowS
Show, (forall x. ElectionId -> Rep ElectionId x)
-> (forall x. Rep ElectionId x -> ElectionId) -> Generic ElectionId
forall x. Rep ElectionId x -> ElectionId
forall x. ElectionId -> Rep ElectionId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ElectionId -> Rep ElectionId x
from :: forall x. ElectionId -> Rep ElectionId x
$cto :: forall x. Rep ElectionId x -> ElectionId
to :: forall x. Rep ElectionId x -> ElectionId
Generic)
  deriving anyclass Context -> ElectionId -> IO (Maybe ThunkInfo)
Proxy ElectionId -> String
(Context -> ElectionId -> IO (Maybe ThunkInfo))
-> (Context -> ElectionId -> IO (Maybe ThunkInfo))
-> (Proxy ElectionId -> String)
-> NoThunks ElectionId
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> ElectionId -> IO (Maybe ThunkInfo)
noThunks :: Context -> ElectionId -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> ElectionId -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> ElectionId -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy ElectionId -> String
showTypeOf :: Proxy ElectionId -> String
NoThunks

-- * Votes

-- | A vote for a Leios announcement.
data LeiosVote = MkLeiosVote
  { LeiosVote -> RankingBlockHash
voteAnnouncingRbHash :: !RankingBlockHash
  -- ^ the 'HeaderHash' of the ranking block ('s header) that carries the
  -- announcement
  , LeiosVote -> LeiosSeatId
voteSeatId :: !LeiosSeatId
  -- ^ the voter's seat in the committee
  , LeiosVote -> SigDSIGN LeiosDSIGN
voteSignature :: !LeiosSignature
  -- ^ The voter's signature of 'voteAnnouncingRbHash'.
  }
  deriving stock (LeiosVote -> LeiosVote -> Bool
(LeiosVote -> LeiosVote -> Bool)
-> (LeiosVote -> LeiosVote -> Bool) -> Eq LeiosVote
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LeiosVote -> LeiosVote -> Bool
== :: LeiosVote -> LeiosVote -> Bool
$c/= :: LeiosVote -> LeiosVote -> Bool
/= :: LeiosVote -> LeiosVote -> Bool
Eq, Int -> LeiosVote -> ShowS
[LeiosVote] -> ShowS
LeiosVote -> String
(Int -> LeiosVote -> ShowS)
-> (LeiosVote -> String)
-> ([LeiosVote] -> ShowS)
-> Show LeiosVote
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LeiosVote -> ShowS
showsPrec :: Int -> LeiosVote -> ShowS
$cshow :: LeiosVote -> String
show :: LeiosVote -> String
$cshowList :: [LeiosVote] -> ShowS
showList :: [LeiosVote] -> ShowS
Show, (forall x. LeiosVote -> Rep LeiosVote x)
-> (forall x. Rep LeiosVote x -> LeiosVote) -> Generic LeiosVote
forall x. Rep LeiosVote x -> LeiosVote
forall x. LeiosVote -> Rep LeiosVote x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LeiosVote -> Rep LeiosVote x
from :: forall x. LeiosVote -> Rep LeiosVote x
$cto :: forall x. Rep LeiosVote x -> LeiosVote
to :: forall x. Rep LeiosVote x -> LeiosVote
Generic)
  deriving anyclass Context -> LeiosVote -> IO (Maybe ThunkInfo)
Proxy LeiosVote -> String
(Context -> LeiosVote -> IO (Maybe ThunkInfo))
-> (Context -> LeiosVote -> IO (Maybe ThunkInfo))
-> (Proxy LeiosVote -> String)
-> NoThunks LeiosVote
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> LeiosVote -> IO (Maybe ThunkInfo)
noThunks :: Context -> LeiosVote -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> LeiosVote -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> LeiosVote -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy LeiosVote -> String
showTypeOf :: Proxy LeiosVote -> String
NoThunks

instance ShowProxy LeiosVote where showProxy :: Proxy LeiosVote -> String
showProxy Proxy LeiosVote
_ = String
"LeiosVote"

encodeLeiosVote :: LeiosVote -> Encoding
encodeLeiosVote :: LeiosVote -> Encoding
encodeLeiosVote (MkLeiosVote RankingBlockHash
rbHash LeiosSeatId
seat SigDSIGN LeiosDSIGN
signature) =
  Word -> Encoding
CBOR.encodeListLen Word
3
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> RankingBlockHash -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR RankingBlockHash
rbHash
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word16 -> Encoding
CBOR.encodeWord16 (LeiosSeatId -> Word16
leiosSeatIndex LeiosSeatId
seat)
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SigDSIGN LeiosDSIGN -> Encoding
forall a. FixedSizeCodec a => a -> Encoding
encodeFixedSized SigDSIGN LeiosDSIGN
signature

decodeLeiosVote :: Decoder s LeiosVote
decodeLeiosVote :: forall s. Decoder s LeiosVote
decodeLeiosVote =
  Text
-> (LeiosVote -> Int) -> Decoder s LeiosVote -> Decoder s LeiosVote
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed (String -> Text
T.pack String
"LeiosVote") (Int -> LeiosVote -> Int
forall a b. a -> b -> a
const Int
3) (Decoder s LeiosVote -> Decoder s LeiosVote)
-> Decoder s LeiosVote -> Decoder s LeiosVote
forall a b. (a -> b) -> a -> b
$
    RankingBlockHash -> LeiosSeatId -> SigDSIGN LeiosDSIGN -> LeiosVote
MkLeiosVote (RankingBlockHash
 -> LeiosSeatId -> SigDSIGN LeiosDSIGN -> LeiosVote)
-> Decoder s RankingBlockHash
-> Decoder s (LeiosSeatId -> SigDSIGN LeiosDSIGN -> LeiosVote)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s RankingBlockHash
forall s. Decoder s RankingBlockHash
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s (LeiosSeatId -> SigDSIGN LeiosDSIGN -> LeiosVote)
-> Decoder s LeiosSeatId
-> Decoder s (SigDSIGN LeiosDSIGN -> LeiosVote)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word16 -> LeiosSeatId
LeiosSeatId (Word16 -> LeiosSeatId)
-> Decoder s Word16 -> Decoder s LeiosSeatId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word16
forall s. Decoder s Word16
CBOR.decodeWord16) Decoder s (SigDSIGN LeiosDSIGN -> LeiosVote)
-> Decoder s (SigDSIGN LeiosDSIGN) -> Decoder s LeiosVote
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (SigDSIGN LeiosDSIGN)
forall a s. FixedSizeCodec a => Decoder s a
decodeFixedSized

-- * Endorser blocks

type BytesSize = Word32

-- | An endorser block in the Leios overlay protocol. It endorses transactions
-- by naming a list of 'TxHash' and 'BytesSize' pairs. Construct using
-- 'mkEndorserBlock'.
--
-- A compatibility layer over the ledger's 'Ledger.EbReferences': consensus
-- sees only this module's functions, never the ledger's representation.
newtype EndorserBlock = MkEndorserBlock Ledger.EbReferences
  deriving stock (forall x. EndorserBlock -> Rep EndorserBlock x)
-> (forall x. Rep EndorserBlock x -> EndorserBlock)
-> Generic EndorserBlock
forall x. Rep EndorserBlock x -> EndorserBlock
forall x. EndorserBlock -> Rep EndorserBlock x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EndorserBlock -> Rep EndorserBlock x
from :: forall x. EndorserBlock -> Rep EndorserBlock x
$cto :: forall x. Rep EndorserBlock x -> EndorserBlock
to :: forall x. Rep EndorserBlock x -> EndorserBlock
Generic
  deriving newtype (EndorserBlock -> EndorserBlock -> Bool
(EndorserBlock -> EndorserBlock -> Bool)
-> (EndorserBlock -> EndorserBlock -> Bool) -> Eq EndorserBlock
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EndorserBlock -> EndorserBlock -> Bool
== :: EndorserBlock -> EndorserBlock -> Bool
$c/= :: EndorserBlock -> EndorserBlock -> Bool
/= :: EndorserBlock -> EndorserBlock -> Bool
Eq, Int -> EndorserBlock -> ShowS
[EndorserBlock] -> ShowS
EndorserBlock -> String
(Int -> EndorserBlock -> ShowS)
-> (EndorserBlock -> String)
-> ([EndorserBlock] -> ShowS)
-> Show EndorserBlock
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EndorserBlock -> ShowS
showsPrec :: Int -> EndorserBlock -> ShowS
$cshow :: EndorserBlock -> String
show :: EndorserBlock -> String
$cshowList :: [EndorserBlock] -> ShowS
showList :: [EndorserBlock] -> ShowS
Show, EndorserBlock -> ()
(EndorserBlock -> ()) -> NFData EndorserBlock
forall a. (a -> ()) -> NFData a
$crnf :: EndorserBlock -> ()
rnf :: EndorserBlock -> ()
NFData, Context -> EndorserBlock -> IO (Maybe ThunkInfo)
Proxy EndorserBlock -> String
(Context -> EndorserBlock -> IO (Maybe ThunkInfo))
-> (Context -> EndorserBlock -> IO (Maybe ThunkInfo))
-> (Proxy EndorserBlock -> String)
-> NoThunks EndorserBlock
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> EndorserBlock -> IO (Maybe ThunkInfo)
noThunks :: Context -> EndorserBlock -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> EndorserBlock -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> EndorserBlock -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy EndorserBlock -> String
showTypeOf :: Proxy EndorserBlock -> String
NoThunks)

instance ShowProxy EndorserBlock where showProxy :: Proxy EndorserBlock -> String
showProxy Proxy EndorserBlock
_ = String
"EndorserBlock"

-- | The protocol version endorser blocks are encoded at.
--
-- NOTE: We do not intend to use endorser blocks across eras, encoded or not.
endorserBlockVersion :: Version
endorserBlockVersion :: Version
endorserBlockVersion = forall era. Era era => Version
eraProtVerLow @DijkstraEra

-- | An endorser block naming these transactions, in this order.
mkEndorserBlock :: [(TxHash, BytesSize)] -> EndorserBlock
mkEndorserBlock :: [(TxHash, Word32)] -> EndorserBlock
mkEndorserBlock =
  EbReferences -> EndorserBlock
MkEndorserBlock
    (EbReferences -> EndorserBlock)
-> ([(TxHash, Word32)] -> EbReferences)
-> [(TxHash, Word32)]
-> EndorserBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> OMap (SafeHash EraIndependentTx) Word32 -> EbReferences
Ledger.mkEbReferences Version
endorserBlockVersion
    (OMap (SafeHash EraIndependentTx) Word32 -> EbReferences)
-> ([(TxHash, Word32)] -> OMap (SafeHash EraIndependentTx) Word32)
-> [(TxHash, Word32)]
-> EbReferences
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(SafeHash EraIndependentTx, Word32)]
-> OMap (SafeHash EraIndependentTx) Word32
[Item (OMap (SafeHash EraIndependentTx) Word32)]
-> OMap (SafeHash EraIndependentTx) Word32
forall l. IsList l => [Item l] -> l
IsList.fromList
    ([(SafeHash EraIndependentTx, Word32)]
 -> OMap (SafeHash EraIndependentTx) Word32)
-> ([(TxHash, Word32)] -> [(SafeHash EraIndependentTx, Word32)])
-> [(TxHash, Word32)]
-> OMap (SafeHash EraIndependentTx) Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TxHash, Word32) -> (SafeHash EraIndependentTx, Word32))
-> [(TxHash, Word32)] -> [(SafeHash EraIndependentTx, Word32)]
forall a b. (a -> b) -> [a] -> [b]
map (\(TxHash
txHash, Word32
txSize) -> (TxHash -> SafeHash EraIndependentTx
forall i. Hash HASH i -> SafeHash i
unsafeMakeSafeHash TxHash
txHash, Word32
txSize))

-- | The endorser block naming the transactions with these bytes, in this
-- order. It names each by the 'TxHash' and the length of its bytes.
endorserBlockFromTxBytes :: NonEmpty ByteString -> EndorserBlock
endorserBlockFromTxBytes :: NonEmpty ByteString -> EndorserBlock
endorserBlockFromTxBytes =
  [(TxHash, Word32)] -> EndorserBlock
mkEndorserBlock ([(TxHash, Word32)] -> EndorserBlock)
-> (NonEmpty ByteString -> [(TxHash, Word32)])
-> NonEmpty ByteString
-> EndorserBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> (TxHash, Word32))
-> [ByteString] -> [(TxHash, Word32)]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> (TxHash, Word32)
reference ([ByteString] -> [(TxHash, Word32)])
-> (NonEmpty ByteString -> [ByteString])
-> NonEmpty ByteString
-> [(TxHash, Word32)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty ByteString -> [ByteString]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
 where
  reference :: ByteString -> (TxHash, BytesSize)
  reference :: ByteString -> (TxHash, Word32)
reference ByteString
bytes = (Hash HASH ByteString -> TxHash
forall h a b. Hash h a -> Hash h b
castHash (Hash HASH ByteString -> TxHash) -> Hash HASH ByteString -> TxHash
forall a b. (a -> b) -> a -> b
$ forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
hashWith @HASH ByteString -> ByteString
forall a. a -> a
id ByteString
bytes, Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
bytes)

-- | The position of a transaction in its endorser block.
type TxOffset = Int

-- | The hash ranking blocks announce for the endorser block: that of its
-- encoding.
endorserBlockHash :: EndorserBlock -> EndorserBlockHash
endorserBlockHash :: EndorserBlock -> Hash HASH EraIndependentEbReferences
endorserBlockHash (MkEndorserBlock EbReferences
references) = SafeHash EraIndependentEbReferences
-> Hash HASH EraIndependentEbReferences
forall i. SafeHash i -> Hash HASH i
extractHash (SafeHash EraIndependentEbReferences
 -> Hash HASH EraIndependentEbReferences)
-> SafeHash EraIndependentEbReferences
-> Hash HASH EraIndependentEbReferences
forall a b. (a -> b) -> a -> b
$ EbReferences -> SafeHash EraIndependentEbReferences
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated EbReferences
references

-- | The transactions an endorser block names, in order.
endorserBlockReferences :: EndorserBlock -> [(TxHash, BytesSize)]
endorserBlockReferences :: EndorserBlock -> [(TxHash, Word32)]
endorserBlockReferences (MkEndorserBlock EbReferences
references) =
  ((SafeHash EraIndependentTx, Word32) -> (TxHash, Word32))
-> [(SafeHash EraIndependentTx, Word32)] -> [(TxHash, Word32)]
forall a b. (a -> b) -> [a] -> [b]
map (\(SafeHash EraIndependentTx
txHash, Word32
txSize) -> (SafeHash EraIndependentTx -> TxHash
forall i. SafeHash i -> Hash HASH i
extractHash SafeHash EraIndependentTx
txHash, Word32
txSize))
    ([(SafeHash EraIndependentTx, Word32)] -> [(TxHash, Word32)])
-> (OMap (SafeHash EraIndependentTx) Word32
    -> [(SafeHash EraIndependentTx, Word32)])
-> OMap (SafeHash EraIndependentTx) Word32
-> [(TxHash, Word32)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OMap (SafeHash EraIndependentTx) Word32
-> [(SafeHash EraIndependentTx, Word32)]
OMap (SafeHash EraIndependentTx) Word32
-> [Item (OMap (SafeHash EraIndependentTx) Word32)]
forall l. IsList l => l -> [Item l]
IsList.toList
    (OMap (SafeHash EraIndependentTx) Word32 -> [(TxHash, Word32)])
-> OMap (SafeHash EraIndependentTx) Word32 -> [(TxHash, Word32)]
forall a b. (a -> b) -> a -> b
$ EbReferences -> OMap (SafeHash EraIndependentTx) Word32
Ledger.getEbReferences EbReferences
references

-- | The bytes one reference occupies for a transaction of the given size: the
-- hash and the size, exactly as 'encodeEndorserBlock' writes them.
--
-- Also used on the Dijkstra transaction measure, so the mempool charges a
-- transaction what it will actually cost in the reference list rather than an
-- approximation of it.
sizeEndorserBlockReference :: ByteSize32 -> ByteSize32
sizeEndorserBlockReference :: ByteSize32 -> ByteSize32
sizeEndorserBlockReference (ByteSize32 Word32
txSize) =
  Word32 -> ByteSize32
ByteSize32 (Word32 -> ByteSize32) -> Word32 -> ByteSize32
forall a b. (a -> b) -> a -> b
$ Word32 -> Word32
cborBytesSize Word32
txHashSize Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32 -> Word32
forall i. Integral i => i -> Word32
cborIntBytesSize Word32
txSize
 where
  txHashSize :: Word32
txHashSize = Word -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy HASH -> Word
forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
hashSize (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @HASH))

  cborBytesSize :: Word32 -> Word32
cborBytesSize Word32
len = Word32 -> Word32
forall i. Integral i => i -> Word32
cborIntBytesSize Word32
len Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
len

-- | Encode an endorser block as the ledger does: a CBOR map from each
-- transaction hash to the size of that transaction.
--
-- The mempool charges each transaction 'sizeEndorserBlockReference', and
-- 'referencesCapacity' subtracts the framing around the references. If the
-- encoding changes, both must change with it.
encodeEndorserBlock :: EndorserBlock -> Encoding
encodeEndorserBlock :: EndorserBlock -> Encoding
encodeEndorserBlock (MkEndorserBlock EbReferences
references) =
  Version -> Encoding -> Encoding
toPlainEncoding Version
endorserBlockVersion (Encoding -> Encoding) -> Encoding -> Encoding
forall a b. (a -> b) -> a -> b
$ EbReferences -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR EbReferences
references

-- | The inverse of 'encodeEndorserBlock', given the whole input it decoded
-- from, not just the endorser block's bytes: the ledger's annotator slices
-- them by the byte offsets of this decoder's run. Like the ledger, it rejects
-- an empty map of transaction references and one naming a transaction twice.
-- It also rejects one whose bytes exceed 'maxEndorserBlockBytesSize'. It can
-- tell only after decoding them (if endorser blocks were wrapped as
-- CBOR-in-CBOR, it would know their length before decoding them, even from an
-- indefinite-length byte string), since a CBOR map gives its number of entries
-- rather than of bytes. So the byte limit of the message carrying it must keep
-- small the work it does before then, eg
-- 'Ouroboros.Consensus.MiniProtocol.LeiosFetch.Type.byteLimitsLeiosFetch'.
--
-- The endorser block keeps its slice of those bytes, so its hash and encoding
-- are of the bytes received.
decodeEndorserBlock :: Decoder s (BSL.ByteString -> EndorserBlock)
decodeEndorserBlock :: forall s. Decoder s (ByteString -> EndorserBlock)
decodeEndorserBlock = do
  start <- Decoder s Int64
forall s. Decoder s Int64
CBOR.peekByteOffset
  eb <-
    toPlainDecoder Nothing endorserBlockVersion $
      (. Full)
        -- The annotator only slices the bytes, which cannot fail.
        . (either (\DecoderError
e -> String -> EndorserBlock
forall a. HasCallStack => String -> a
error (String
"Impossible, endorser block decoder failed: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> DecoderError -> String
forall a. Show a => a -> String
show DecoderError
e)) MkEndorserBlock .)
        . runAnnotator
        <$> decCBOR
  end <- CBOR.peekByteOffset
  -- Nothing currently bounds the number of references more tightly than this
  -- bound on the bytes does, ie by 'maxTxsPerEndorserBlock'.
  when (end - start > fromIntegral maxEndorserBlockBytesSize) $
    fail $
      "endorser block of "
        <> show (end - start)
        <> " bytes exceeds "
        <> show maxEndorserBlockBytesSize
  pure eb

-- | The most bytes 'encodeEndorserBlock' writes besides the references, for an
-- endorser block that 'mkEndorserBlock' built: its map header. Each
-- reference's own CBOR headers count towards 'sizeEndorserBlockReference'
-- instead. The map header widens with the reference count as
-- 'cborIntBytesSize' does, never narrowing, and the count fits 'BytesSize', so
-- the header of 'maxBound' references is the widest.
maxFramingSize :: BytesSize
maxFramingSize :: Word32
maxFramingSize = Word32 -> Word32
forall i. Integral i => i -> Word32
cborIntBytesSize (Word32
forall a. Bounded a => a
maxBound :: BytesSize)

-- | The references capacity a @maxEndorserBlockReferencesSize@ parameter
-- yields: the parameter minus the framing 'encodeEndorserBlock' writes ahead of the
-- references. A parameter smaller than the framing exhausts the capacity, so
-- no reference fits, rather than wrapping around to \"no limit\".
referencesCapacity :: BytesSize -> BytesSize
referencesCapacity :: Word32 -> Word32
referencesCapacity Word32
paramLimit = Word32
paramLimit Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32 -> Word32 -> Word32
forall a. Ord a => a -> a -> a
min Word32
paramLimit Word32
maxFramingSize

-- | The design ceiling on an endorser block's encoding: what the node will
-- forge, serve and size its buffers for.
--
-- TODO Nothing yet keeps the @maxEndorserBlockReferencesSize@ protocol
-- parameter within it, so a larger value would let an honest peer send an
-- endorser block that 'decodeEndorserBlock' rejects. Make it the
-- constitution's guardrail on that parameter, and refuse to run with a
-- parameter above it.
maxEndorserBlockBytesSize :: BytesSize
maxEndorserBlockBytesSize :: Word32
maxEndorserBlockBytesSize = Word32
600 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
1000

-- | The most transactions an endorser block may name, given
-- 'maxEndorserBlockBytesSize'. Each reference takes at least as many bytes as
-- 'sizeEndorserBlockReference' charges a transaction of size 0, however it is
-- encoded.
--
-- It derives from the design ceiling and not from the protocol parameter,
-- since the buffers it sizes are allocated before any ledger state is in reach.
maxTxsPerEndorserBlock :: Int
maxTxsPerEndorserBlock :: Int
maxTxsPerEndorserBlock =
  Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ Word32
maxEndorserBlockBytesSize Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`div` Word32
minItemSize
 where
  ByteSize32 Word32
minItemSize = ByteSize32 -> ByteSize32
sizeEndorserBlockReference (Word32 -> ByteSize32
ByteSize32 Word32
0)

-- | The size of 'encodeEndorserBlock': of the bytes the endorser block was
-- received in, or of the ledger's encoding of one this node built.
encodeEndorserBlockSize :: EndorserBlock -> BytesSize
encodeEndorserBlockSize :: EndorserBlock -> Word32
encodeEndorserBlockSize (MkEndorserBlock EbReferences
references) = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ EbReferences -> Int
forall t. SafeToHash t => t -> Int
originalBytesSize EbReferences
references

-- | Length of a unsigned integer if it were encoded in a "flattened format".
-- See 'encodeInteger'.
cborIntBytesSize :: Integral i => i -> BytesSize
cborIntBytesSize :: forall i. Integral i => i -> Word32
cborIntBytesSize i
n
  | i
n i -> i -> Bool
forall a. Ord a => a -> a -> Bool
< i
24 = Word32
1
  | i
n i -> i -> Bool
forall a. Ord a => a -> a -> Bool
< i
0x100 = Word32
2
  | i
n i -> i -> Bool
forall a. Ord a => a -> a -> Bool
< i
0x10000 = Word32
3
  | Bool
otherwise = Word32
5

-- * Header checks

-- | A duration the ledger gives in milliseconds.
milliseconds32ToNominalDiffTime :: Milliseconds32 -> NominalDiffTime
milliseconds32ToNominalDiffTime :: Milliseconds32 -> NominalDiffTime
milliseconds32ToNominalDiffTime (Milliseconds32 Word32
ms) = Word32 -> NominalDiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
ms NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Fractional a => a -> a -> a
/ NominalDiffTime
1000

-- | The earliest slot at which a block may certify an endorser block announced
-- in the given slot.
--
-- The announcement, voting and diffusion periods must all have elapsed. They
-- are wall-clock durations, so the gap rounds up to whole slots: a block is
-- forged at its slot's onset, so the answer is the first slot whose onset is far
-- enough after the announcement.
minCertificationSlot ::
  SlotLength ->
  -- | Announcement period length
  Milliseconds32 ->
  -- | Vote period length
  Milliseconds32 ->
  -- | Diffusion period length
  Milliseconds32 ->
  -- | Slot of the announcing block
  SlotNo ->
  SlotNo
minCertificationSlot :: SlotLength
-> Milliseconds32
-> Milliseconds32
-> Milliseconds32
-> SlotNo
-> SlotNo
minCertificationSlot SlotLength
slotLength Milliseconds32
announcement Milliseconds32
vote Milliseconds32
diffusion SlotNo
announcingSlot =
  SlotNo
announcingSlot SlotNo -> SlotNo -> SlotNo
forall a. Num a => a -> a -> a
+ Word64 -> SlotNo
SlotNo (Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Integer
totalMs Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
slotMs Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
slotMs))
 where
  totalMs :: Integer
totalMs = Integer
3 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Milliseconds32 -> Integer
ms Milliseconds32
announcement Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Milliseconds32 -> Integer
ms Milliseconds32
vote Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Milliseconds32 -> Integer
ms Milliseconds32
diffusion
  ms :: Milliseconds32 -> Integer
ms = Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word32 -> Integer)
-> (Milliseconds32 -> Word32) -> Milliseconds32 -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Milliseconds32 -> Word32
unMilliseconds32
  slotMs :: Integer
slotMs = case SlotLength -> Integer
slotLengthToMillisec SlotLength
slotLength of
    Integer
0 -> String -> Integer
forall a. HasCallStack => String -> a
error String
"minCertificationSlot: zero slot length"
    Integer
n -> Integer
n