Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Synopsis
- type Ix = Word
- data Addr
- type TxOut = (Addr, Amount)
- type TxIn = (TxId, Ix)
- data family TxId tx
- data Tx where
- data family Header blk
- data family StorageConfig blk
- data family CodecConfig blk
- data family BlockConfig blk
- data family Ticked st
- data family LedgerState blk
- data family Validated x
- data family GenTx blk
- data family BlockQuery blk ∷ Type → Type
- data MockState blk = MockState {}
- type AddrDist = Map Addr NodeId
- type SimpleBlock c ext = SimpleBlock' c ext ext
- data SimpleBlock' c ext ext' = SimpleBlock {
- simpleHeader ∷ Header (SimpleBlock' c ext ext')
- simpleBody ∷ SimpleBody
- data SimpleBody = SimpleBody {}
- class (HashAlgorithm (SimpleHash c), Typeable c) ⇒ SimpleCrypto c where
- type SimpleHash c ∷ Type
- type SimpleHeader c ext = Header (SimpleBlock c ext)
- data SimpleStdHeader c ext = SimpleStdHeader {}
- data SimpleLedgerConfig c ext = SimpleLedgerConfig {}
- class (SimpleCrypto c, Typeable ext, Show (MockLedgerConfig c ext), NoThunks (MockLedgerConfig c ext)) ⇒ MockProtocolSpecific c ext where
- type MockLedgerConfig c ext ∷ Type
- data SimpleMockCrypto
- data SimpleStandardCrypto
- data SignedSimpleBft c c' = SignedSimpleBft {
- signedSimpleBft ∷ SimpleStdHeader c (SimpleBftExt c c')
- type SimpleBftBlock c c' = SimpleBlock c (SimpleBftExt c c')
- newtype SimpleBftExt c c' = SimpleBftExt {
- simpleBftExt ∷ BftFields c' (SignedSimpleBft c c')
- type SimpleBftHeader c c' = SimpleHeader c (SimpleBftExt c c')
- data SignedSimplePBft c c' = SignedSimplePBft {
- signedSimplePBft ∷ SimpleStdHeader c (SimplePBftExt c c')
- type SimplePBftBlock c c' = SimpleBlock c (SimplePBftExt c c')
- newtype SimplePBftExt c c' = SimplePBftExt {
- simplePBftExt ∷ PBftFields c' (SignedSimplePBft c c')
- type SimplePBftHeader c c' = SimpleHeader c (SimplePBftExt c c')
- data SignedSimplePraos c c' = SignedSimplePraos {}
- type SimplePraosBlock c c' = SimpleBlock c (SimplePraosExt c c')
- newtype SimplePraosExt c c' = SimplePraosExt {
- simplePraosExt ∷ PraosFields c' (SignedSimplePraos c c')
- type SimplePraosHeader c c' = SimpleHeader c (SimplePraosExt c c')
- data PraosCryptoUnused
- type SimplePraosRuleBlock c = SimpleBlock c SimplePraosRuleExt
- newtype SimplePraosRuleExt = SimplePraosRuleExt {}
- type SimplePraosRuleHeader c = SimpleHeader c SimplePraosRuleExt
- newtype ForgeExt c ext = ForgeExt {
- forgeExt ∷ TopLevelConfig (SimpleBlock c ext) → IsLeader (BlockProtocol (SimpleBlock c ext)) → SimpleBlock' c ext () → SimpleBlock c ext
- data StakeHolder
- newtype StakeDist = StakeDist {}
- data MockConfig = MockConfig {}
- data MockError blk
- = MockExpired !SlotNo !SlotNo
- | MockUtxoError UtxoError
- | MockInvalidHash (ChainHash blk) (ChainHash blk)
- | MockTxSizeTooBig ByteSize32 ByteSize32
- type Amount = Word
- data Expiry
- type Utxo = Map TxIn TxOut
- class HasMockTxs a where
- getMockTxs ∷ a → [Tx]
- data UtxoError
- genesisUtxo ∷ AddrDist → Utxo
- mkAddrDist ∷ NumCoreNodes → AddrDist
- countSimpleGenTxs ∷ SimpleBlock c ext → Word64
- matchesSimpleHeader ∷ SimpleCrypto c ⇒ Header (SimpleBlock' c ext ext') → SimpleBlock' c ext ext'' → Bool
- mkSimpleHeader ∷ SimpleCrypto c ⇒ (ext' → Encoding) → SimpleStdHeader c ext → ext' → Header (SimpleBlock' c ext ext')
- genesisSimpleLedgerState ∷ AddrDist → LedgerState (SimpleBlock c ext)
- updateSimpleLedgerState ∷ (SimpleCrypto c, Typeable ext) ⇒ LedgerConfig (SimpleBlock c ext) → SimpleBlock c ext → TickedLedgerState (SimpleBlock c ext) → Except (MockError (SimpleBlock c ext)) (LedgerState (SimpleBlock c ext))
- genTxSize ∷ GenTx (SimpleBlock c ext) → ByteSize32
- mkSimpleGenTx ∷ Tx → GenTx (SimpleBlock c ext)
- decodeSimpleHeader ∷ SimpleCrypto c ⇒ (ext' → Encoding) → (∀ s. Decoder s ext') → ∀ s. Decoder s (Header (SimpleBlock' c ext ext'))
- encodeSimpleHeader ∷ (ext' → Encoding) → Header (SimpleBlock' c ext ext') → Encoding
- simpleBlockBinaryBlockInfo ∷ (SimpleCrypto c, Serialise ext', Typeable ext, Typeable ext') ⇒ SimpleBlock' c ext ext' → BinaryBlockInfo
- simpleBlockCapacity ∷ ByteSize32
- forgeBftExt ∷ ∀ c c'. (SimpleCrypto c, BftCrypto c', Signable (BftDSIGN c') (SignedSimpleBft c c')) ⇒ ForgeExt c (SimpleBftExt c c')
- forgePBftExt ∷ ∀ c c'. (SimpleCrypto c, PBftCrypto c', Signable (PBftDSIGN c') (SignedSimplePBft c c'), ContextDSIGN (PBftDSIGN c') ~ ()) ⇒ ForgeExt c (SimplePBftExt c c')
- forgePraosExt ∷ ∀ c c'. (SimpleCrypto c, PraosCrypto c', Signable (PraosKES c') (SignedSimplePraos c c')) ⇒ HotKey c' → ForgeExt c (SimplePraosExt c c')
- forgePraosRuleExt ∷ SimpleCrypto c ⇒ ForgeExt c SimplePraosRuleExt
- forgeSimple ∷ ∀ c ext. SimpleCrypto c ⇒ ForgeExt c ext → TopLevelConfig (SimpleBlock c ext) → BlockNo → SlotNo → TickedLedgerState (SimpleBlock c ext) → [GenTx (SimpleBlock c ext)] → IsLeader (BlockProtocol (SimpleBlock c ext)) → SimpleBlock c ext
- equalStakeDist ∷ AddrDist → StakeDist
- genesisStakeDist ∷ AddrDist → StakeDist
- relativeStakes ∷ Map StakeHolder Amount → StakeDist
- stakeWithDefault ∷ Rational → CoreNodeId → StakeDist → Rational
- totalStakes ∷ Map Addr NodeId → Utxo → Map StakeHolder Amount
- defaultMockConfig ∷ MockConfig
- updateMockState ∷ (GetPrevHash blk, HasMockTxs blk) ⇒ MockConfig → blk → MockState blk → Except (MockError blk) (MockState blk)
- updateMockTip ∷ GetPrevHash blk ⇒ Header blk → MockState blk → Except (MockError blk) (MockState blk)
- updateMockUTxO ∷ HasMockTxs a ⇒ MockConfig → SlotNo → a → MockState blk → Except (MockError blk) (MockState blk)
- checkTxSize ∷ MockConfig → Tx → Except (MockError blk) ByteSize32
- txSize ∷ Tx → ByteSize32
- genesisMockState ∷ AddrDist → MockState blk
- confirmed ∷ HasMockTxs a ⇒ a → Set TxId
- txIns ∷ HasMockTxs a ⇒ a → Set TxIn
- txOuts ∷ HasMockTxs a ⇒ a → Utxo
- updateUtxo ∷ HasMockTxs a ⇒ a → Utxo → Except UtxoError Utxo
- genesisTx ∷ AddrDist → Tx
Documentation
Mock address
Instances
IsString Addr Source # | |
Defined in Ouroboros.Consensus.Mock.Ledger.Address fromString ∷ String → Addr # | |
Show Addr Source # | |
FromCBOR Addr Source # | |
ToCBOR Addr Source # | |
NFData Addr Source # | |
Defined in Ouroboros.Consensus.Mock.Ledger.Address | |
Eq Addr Source # | |
Ord Addr Source # | |
NoThunks Addr Source # | |
Condense Addr Source # | |
Serialise Addr Source # | |
A generalized transaction, GenTx
, identifier.
Instances
Instances
Generic Tx Source # | |
Show Tx Source # | |
ToCBOR Tx Source # | |
NFData Tx Source # | |
Defined in Ouroboros.Consensus.Mock.Ledger.UTxO | |
Eq Tx Source # | |
Ord Tx Source # | |
NoThunks Tx Source # | |
Condense Tx Source # | |
HasMockTxs Tx Source # | |
Defined in Ouroboros.Consensus.Mock.Ledger.UTxO getMockTxs ∷ Tx → [Tx] Source # | |
Serialise Tx Source # | |
type Rep Tx Source # | |
Defined in Ouroboros.Consensus.Mock.Ledger.UTxO type Rep Tx = D1 ('MetaData "Tx" "Ouroboros.Consensus.Mock.Ledger.UTxO" "ouroboros-consensus-0.21.0.0-inplace-unstable-mock-block" 'False) (C1 ('MetaCons "UnsafeTx" 'PrefixI 'False) (S1 ('MetaSel ('Nothing ∷ Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Expiry) :*: (S1 ('MetaSel ('Nothing ∷ Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Set TxIn)) :*: S1 ('MetaSel ('Nothing ∷ Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [TxOut])))) |
data family Header blk Source #
Instances
data family StorageConfig blk Source #
Config needed for the
NodeInitStorage
class. Defined here to
avoid circular dependencies.
Instances
data family CodecConfig blk Source #
Static configuration required for serialisation and deserialisation of types pertaining to this type of block.
Data family instead of type family to get better type inference.
Instances
Generic (CodecConfig (SimpleBlock c ext)) Source # | |
Defined in Ouroboros.Consensus.Mock.Ledger.Block type Rep (CodecConfig (SimpleBlock c ext)) ∷ Type → Type # from ∷ CodecConfig (SimpleBlock c ext) → Rep (CodecConfig (SimpleBlock c ext)) x # to ∷ Rep (CodecConfig (SimpleBlock c ext)) x → CodecConfig (SimpleBlock c ext) # | |
NoThunks (CodecConfig (SimpleBlock c ext)) Source # | |
Defined in Ouroboros.Consensus.Mock.Ledger.Block noThunks ∷ Context → CodecConfig (SimpleBlock c ext) → IO (Maybe ThunkInfo) Source # wNoThunks ∷ Context → CodecConfig (SimpleBlock c ext) → IO (Maybe ThunkInfo) Source # showTypeOf ∷ Proxy (CodecConfig (SimpleBlock c ext)) → String Source # | |
type Rep (CodecConfig (SimpleBlock c ext)) Source # | |
Defined in Ouroboros.Consensus.Mock.Ledger.Block | |
data CodecConfig (SimpleBlock c ext) Source # | |
Defined in Ouroboros.Consensus.Mock.Ledger.Block |
data family BlockConfig blk Source #
Static configuration required to work with this type of blocks
Instances
data family Ticked st Source #
" Ticked " piece of state, either LedgerState
or ChainDepState
Ticking refers to the passage of time (the ticking of the clock). When a
piece of state is marked as ticked, it means that time-related changes have
been applied to the state. There are exactly two methods in the interface
that do that: tickChainDepState
and
applyChainTickLedgerResult
.
Also note that a successful forecast
must equal
forecastFor
(ledgerViewForecastAt
cfg st)
slot
. Thus a
protocolLedgerView
cfg
(applyChainTick
cfg slot st)LedgerView
can only be projected
from a Ticked
state, but cannot itself be ticked.
Some examples of time related changes:
- Scheduled delegations might have been applied in Byron
- New leader schedule computed for Shelley
- Transition from Byron to Shelley activated in the hard fork combinator.
- Nonces switched out at the start of a new epoch.
Instances
data family LedgerState blk Source #
Ledger state associated with a block
This is the Consensus notion of a ledger state. Each block type is
associated with one of the Ledger types for the ledger state. Virtually
every concept in this codebase revolves around this type, or the referenced
blk
. Whenever we use the type variable l
, we intend to denote that the
expected instantiation is either a LedgerState
or some wrapper over it
(like the ExtLedgerState
).
The main operations we can do with a LedgerState
are ticking (defined in
IsLedger
), and applying a block (defined in
ApplyBlock
).
Instances
data family Validated x Source #
" Validated " transaction or block
The ledger defines how to validate transactions and blocks. It's possible the type before and after validation may be distinct (eg Alonzo transactions), which originally motivated this family.
We also gain the related benefit that certain interface functions, such as those that reapply blocks, can have a more precise type now. TODO
Similarly, the Node-to-Client mini protocols can explicitly indicate that the
client trusts the blocks from the local server, by having the server send
Validated
blocks to the client. TODO
Note that validation has different implications for a transaction than for a block. In particular, a validated transaction can be " reapplied " to different ledger states, whereas a validated block must only be " reapplied " to the exact same ledger state (eg as part of rebuilding from an on-disk ledger snapshot).
Since the ledger defines validation, see the ledger details for concrete
examples of what determines the validity (wrt to a LedgerState
) of a
transaction and/or block. Example properties include: a transaction's claimed
inputs exist and are still unspent, a block carries a sufficient
cryptographic signature, etc.
Instances
data family GenTx blk Source #
Generalized transaction
The mempool (and, accordingly, blocks) consist of "generalized transactions"; this could be "proper" transactions (transferring funds) but also other kinds of things such as update proposals, delegations, etc.
Instances
data family BlockQuery blk ∷ Type → Type Source #
Different queries supported by the ledger, indexed by the result type.
Instances
Instances
Generic (MockState blk) Source # | |
StandardHash blk ⇒ Show (MockState blk) Source # | |
StandardHash blk ⇒ Eq (MockState blk) Source # | |
StandardHash blk ⇒ NoThunks (MockState blk) Source # | |
Serialise (HeaderHash blk) ⇒ Serialise (MockState blk) Source # | |
type Rep (MockState blk) Source # | |
Defined in Ouroboros.Consensus.Mock.Ledger.State type Rep (MockState blk) = D1 ('MetaData "MockState" "Ouroboros.Consensus.Mock.Ledger.State" "ouroboros-consensus-0.21.0.0-inplace-unstable-mock-block" 'False) (C1 ('MetaCons "MockState" 'PrefixI 'True) (S1 ('MetaSel ('Just "mockUtxo") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Utxo) :*: (S1 ('MetaSel ('Just "mockConfirmed") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Set TxId)) :*: S1 ('MetaSel ('Just "mockTip") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Point blk))))) |
type AddrDist = Map Addr NodeId Source #
Mapping from addresses to node IDs
This is needed in order to assign stake to nodes.
type SimpleBlock c ext = SimpleBlock' c ext ext Source #
data SimpleBlock' c ext ext' Source #
SimpleBlock | |
|
Instances
data SimpleBody Source #
Instances
class (HashAlgorithm (SimpleHash c), Typeable c) ⇒ SimpleCrypto c Source #
type SimpleHash c ∷ Type Source #
Instances
type SimpleHeader c ext = Header (SimpleBlock c ext) Source #
data SimpleStdHeader c ext Source #
SimpleStdHeader | |
|
Instances
data SimpleLedgerConfig c ext Source #
SimpleLedgerConfig | |
|
Instances
class (SimpleCrypto c, Typeable ext, Show (MockLedgerConfig c ext), NoThunks (MockLedgerConfig c ext)) ⇒ MockProtocolSpecific c ext Source #
type MockLedgerConfig c ext ∷ Type Source #
Instances
SimpleCrypto c ⇒ MockProtocolSpecific c SimplePraosRuleExt Source # | |
(SimpleCrypto c, Typeable c') ⇒ MockProtocolSpecific c (SimpleBftExt c c') Source # | |
Defined in Ouroboros.Consensus.Mock.Ledger.Block.BFT type MockLedgerConfig c (SimpleBftExt c c') Source # | |
(SimpleCrypto c, PBftCrypto c') ⇒ MockProtocolSpecific c (SimplePBftExt c c') Source # | |
Defined in Ouroboros.Consensus.Mock.Ledger.Block.PBFT type MockLedgerConfig c (SimplePBftExt c c') Source # | |
(SimpleCrypto c, Typeable c') ⇒ MockProtocolSpecific c (SimplePraosExt c c') Source # | |
Defined in Ouroboros.Consensus.Mock.Ledger.Block.Praos type MockLedgerConfig c (SimplePraosExt c c') Source # |
data SimpleMockCrypto Source #
Instances
data SimpleStandardCrypto Source #
Instances
data SignedSimpleBft c c' Source #
Part of the block that gets signed
Instances
type SimpleBftBlock c c' = SimpleBlock c (SimpleBftExt c c') Source #
Simple block extended with the fields required for BFT
c
is crypto used for the block itself
c'
is crypto used for the consensus protocol
newtype SimpleBftExt c c' Source #
Block extension required for BFT
SimpleBftExt | |
|
Instances
type SimpleBftHeader c c' = SimpleHeader c (SimpleBftExt c c') Source #
Header for BFT
data SignedSimplePBft c c' Source #
Part of the block that gets signed
We just sign the standard header, i.e., without the PBFT extensions. In particular, the signature does not cover the issuer.
The signature does not cover the body explicitly, but since the standard header includes a hash of the body, the signature covers the body implicitly.
Instances
type SimplePBftBlock c c' = SimpleBlock c (SimplePBftExt c c') Source #
Simple block extended with the fields required for PBFT
c
is crypto used for the block itself
c'
is crypto used for the consensus protocol
newtype SimplePBftExt c c' Source #
Block extension required for PBFT
SimplePBftExt | |
|
Instances
type SimplePBftHeader c c' = SimpleHeader c (SimplePBftExt c c') Source #
Header for PBFT
data SignedSimplePraos c c' Source #
Part of the block that gets signed
TODO: Right now we sign all of the extra Praos fields. This may or may not be needed. https://github.com/IntersectMBO/cardano-ledger/issues/530 Of course, this Praos is merely a proof of concept so it doesn't really matter either way; we include them here primarily to show that we can.
SignedSimplePraos | |
|
Instances
(SimpleCrypto c, PraosCrypto c') ⇒ ToCBOR (SignedSimplePraos c c') Source # | |
Defined in Ouroboros.Consensus.Mock.Ledger.Block.Praos toCBOR ∷ SignedSimplePraos c c' → Encoding Source # encodedSizeExpr ∷ (∀ t. ToCBOR t ⇒ Proxy t → Size) → Proxy (SignedSimplePraos c c') → Size Source # encodedListSizeExpr ∷ (∀ t. ToCBOR t ⇒ Proxy t → Size) → Proxy [SignedSimplePraos c c'] → Size Source # | |
(SimpleCrypto c, PraosCrypto c') ⇒ SignableRepresentation (SignedSimplePraos c c') Source # | |
type SimplePraosBlock c c' = SimpleBlock c (SimplePraosExt c c') Source #
Simple block extended with the fields required for Praos
c
is crypto used for the block itself
c'
is crypto used for the consensus protocol
newtype SimplePraosExt c c' Source #
Block extension required for Praos
SimplePraosExt | |
|
Instances
type SimplePraosHeader c c' = SimpleHeader c (SimplePraosExt c c') Source #
Header for Proas
data PraosCryptoUnused Source #
Instances
type SimplePraosRuleBlock c = SimpleBlock c SimplePraosRuleExt Source #
Simple block extended with the fields required for Praos
c
is crypto used for the block itself
With an explicit leader schedule we need no crypto for the consensus protocol.
This is an example of a block which is not an instance of SignedBlock
.
newtype SimplePraosRuleExt Source #
Required extension
The WithLeaderSchedule
doesn't require anything in the block header.
We add the CoreNodeId
just so that we can check that the schedule matches
the chain.
Instances
type SimplePraosRuleHeader c = SimpleHeader c SimplePraosRuleExt Source #
Header for Proas
newtype ForgeExt c ext Source #
Construct the protocol specific part of the block
This is used in forgeSimple
, which takes care of the generic part of the
mock block.
Note: this is a newtype and not a type class to allow for things in the closure. For example, if Praos had to use a stateful KES key, it could refer to it in its closure.
ForgeExt | |
|
data StakeHolder Source #
StakeCore CoreNodeId | Stake of a core node |
StakeEverybodyElse | Stake for everybody else (we don't need to distinguish) |
Instances
Show StakeHolder Source # | |
Defined in Ouroboros.Consensus.Mock.Ledger.Stake showsPrec ∷ Int → StakeHolder → ShowS # show ∷ StakeHolder → String # showList ∷ [StakeHolder] → ShowS # | |
Eq StakeHolder Source # | |
Defined in Ouroboros.Consensus.Mock.Ledger.Stake (==) ∷ StakeHolder → StakeHolder → Bool # (/=) ∷ StakeHolder → StakeHolder → Bool # | |
Ord StakeHolder Source # | |
Defined in Ouroboros.Consensus.Mock.Ledger.Stake compare ∷ StakeHolder → StakeHolder → Ordering # (<) ∷ StakeHolder → StakeHolder → Bool # (<=) ∷ StakeHolder → StakeHolder → Bool # (>) ∷ StakeHolder → StakeHolder → Bool # (>=) ∷ StakeHolder → StakeHolder → Bool # max ∷ StakeHolder → StakeHolder → StakeHolder # min ∷ StakeHolder → StakeHolder → StakeHolder # |
In the mock setup, only core nodes have stake
INVARIANT: The rationals should sum to 1.
data MockConfig Source #
Parameters needed to validate blocks/txs
Instances
Generic MockConfig Source # | |
Defined in Ouroboros.Consensus.Mock.Ledger.State type Rep MockConfig ∷ Type → Type # from ∷ MockConfig → Rep MockConfig x # to ∷ Rep MockConfig x → MockConfig # | |
Show MockConfig Source # | |
Defined in Ouroboros.Consensus.Mock.Ledger.State | |
Eq MockConfig Source # | |
Defined in Ouroboros.Consensus.Mock.Ledger.State (==) ∷ MockConfig → MockConfig → Bool # (/=) ∷ MockConfig → MockConfig → Bool # | |
NoThunks MockConfig Source # | |
Defined in Ouroboros.Consensus.Mock.Ledger.State | |
type Rep MockConfig Source # | |
Defined in Ouroboros.Consensus.Mock.Ledger.State type Rep MockConfig = D1 ('MetaData "MockConfig" "Ouroboros.Consensus.Mock.Ledger.State" "ouroboros-consensus-0.21.0.0-inplace-unstable-mock-block" 'False) (C1 ('MetaCons "MockConfig" 'PrefixI 'True) (S1 ('MetaSel ('Just "mockCfgMaxTxSize") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe ByteSize32)))) |
MockExpired !SlotNo !SlotNo | The transaction expired in the first |
MockUtxoError UtxoError | |
MockInvalidHash (ChainHash blk) (ChainHash blk) | |
MockTxSizeTooBig ByteSize32 ByteSize32 |
Instances
Instances
Generic Expiry Source # | |
Show Expiry Source # | |
NFData Expiry Source # | |
Defined in Ouroboros.Consensus.Mock.Ledger.UTxO | |
Eq Expiry Source # | |
Ord Expiry Source # | |
NoThunks Expiry Source # | |
Condense Expiry Source # | |
Serialise Expiry Source # | |
type Rep Expiry Source # | |
Defined in Ouroboros.Consensus.Mock.Ledger.UTxO type Rep Expiry = D1 ('MetaData "Expiry" "Ouroboros.Consensus.Mock.Ledger.UTxO" "ouroboros-consensus-0.21.0.0-inplace-unstable-mock-block" 'False) (C1 ('MetaCons "DoNotExpire" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "ExpireAtOnsetOf" 'PrefixI 'False) (S1 ('MetaSel ('Nothing ∷ Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 SlotNo))) |
class HasMockTxs a where Source #
getMockTxs ∷ a → [Tx] Source #
The transactions in the order they are to be applied
Instances
HasMockTxs SimpleBody Source # | |
Defined in Ouroboros.Consensus.Mock.Ledger.Block getMockTxs ∷ SimpleBody → [Tx] Source # | |
HasMockTxs Tx Source # | |
Defined in Ouroboros.Consensus.Mock.Ledger.UTxO getMockTxs ∷ Tx → [Tx] Source # | |
HasMockTxs (GenTx (SimpleBlock p c)) Source # | |
Defined in Ouroboros.Consensus.Mock.Ledger.Block getMockTxs ∷ GenTx (SimpleBlock p c) → [Tx] Source # | |
HasMockTxs a ⇒ HasMockTxs (Chain a) Source # | |
Defined in Ouroboros.Consensus.Mock.Ledger.UTxO getMockTxs ∷ Chain a → [Tx] Source # | |
HasMockTxs a ⇒ HasMockTxs [a] Source # | |
Defined in Ouroboros.Consensus.Mock.Ledger.UTxO getMockTxs ∷ [a] → [Tx] Source # | |
HasMockTxs (SimpleBlock' c ext ext') Source # | |
Defined in Ouroboros.Consensus.Mock.Ledger.Block getMockTxs ∷ SimpleBlock' c ext ext' → [Tx] Source # |
Instances
Generic UtxoError Source # | |
Show UtxoError Source # | |
Eq UtxoError Source # | |
NoThunks UtxoError Source # | |
Condense UtxoError Source # | |
Serialise UtxoError Source # | |
type Rep UtxoError Source # | |
Defined in Ouroboros.Consensus.Mock.Ledger.UTxO type Rep UtxoError = D1 ('MetaData "UtxoError" "Ouroboros.Consensus.Mock.Ledger.UTxO" "ouroboros-consensus-0.21.0.0-inplace-unstable-mock-block" 'False) (C1 ('MetaCons "MissingInput" 'PrefixI 'False) (S1 ('MetaSel ('Nothing ∷ Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TxIn)) :+: C1 ('MetaCons "InputOutputMismatch" 'PrefixI 'False) (S1 ('MetaSel ('Nothing ∷ Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Amount) :*: S1 ('MetaSel ('Nothing ∷ Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Amount))) |
genesisUtxo ∷ AddrDist → Utxo Source #
mkAddrDist ∷ NumCoreNodes → AddrDist Source #
Construct address to node ID mapping
countSimpleGenTxs ∷ SimpleBlock c ext → Word64 Source #
matchesSimpleHeader ∷ SimpleCrypto c ⇒ Header (SimpleBlock' c ext ext') → SimpleBlock' c ext ext'' → Bool Source #
Check whether the block matches the header
mkSimpleHeader ∷ SimpleCrypto c ⇒ (ext' → Encoding) → SimpleStdHeader c ext → ext' → Header (SimpleBlock' c ext ext') Source #
Create a header by hashing the header without hash and adding to the resulting value.
genesisSimpleLedgerState ∷ AddrDist → LedgerState (SimpleBlock c ext) Source #
updateSimpleLedgerState ∷ (SimpleCrypto c, Typeable ext) ⇒ LedgerConfig (SimpleBlock c ext) → SimpleBlock c ext → TickedLedgerState (SimpleBlock c ext) → Except (MockError (SimpleBlock c ext)) (LedgerState (SimpleBlock c ext)) Source #
genTxSize ∷ GenTx (SimpleBlock c ext) → ByteSize32 Source #
mkSimpleGenTx ∷ Tx → GenTx (SimpleBlock c ext) Source #
decodeSimpleHeader ∷ SimpleCrypto c ⇒ (ext' → Encoding) → (∀ s. Decoder s ext') → ∀ s. Decoder s (Header (SimpleBlock' c ext ext')) Source #
encodeSimpleHeader ∷ (ext' → Encoding) → Header (SimpleBlock' c ext ext') → Encoding Source #
simpleBlockBinaryBlockInfo ∷ (SimpleCrypto c, Serialise ext', Typeable ext, Typeable ext') ⇒ SimpleBlock' c ext ext' → BinaryBlockInfo Source #
forgeBftExt ∷ ∀ c c'. (SimpleCrypto c, BftCrypto c', Signable (BftDSIGN c') (SignedSimpleBft c c')) ⇒ ForgeExt c (SimpleBftExt c c') Source #
forgePBftExt ∷ ∀ c c'. (SimpleCrypto c, PBftCrypto c', Signable (PBftDSIGN c') (SignedSimplePBft c c'), ContextDSIGN (PBftDSIGN c') ~ ()) ⇒ ForgeExt c (SimplePBftExt c c') Source #
forgePraosExt ∷ ∀ c c'. (SimpleCrypto c, PraosCrypto c', Signable (PraosKES c') (SignedSimplePraos c c')) ⇒ HotKey c' → ForgeExt c (SimplePraosExt c c') Source #
∷ ∀ c ext. SimpleCrypto c | |
⇒ ForgeExt c ext | |
→ TopLevelConfig (SimpleBlock c ext) | |
→ BlockNo | Current block number |
→ SlotNo | Current slot number |
→ TickedLedgerState (SimpleBlock c ext) | Current ledger |
→ [GenTx (SimpleBlock c ext)] | Txs to include |
→ IsLeader (BlockProtocol (SimpleBlock c ext)) | |
→ SimpleBlock c ext |
equalStakeDist ∷ AddrDist → StakeDist Source #
Stake distribution where every address has equal state
genesisStakeDist ∷ AddrDist → StakeDist Source #
Genesis stake distribution
totalStakes ∷ Map Addr NodeId → Utxo → Map StakeHolder Amount Source #
Compute stakes of all nodes
The Nothing
value holds the total stake of all addresses that don't
get mapped to a NodeId.
updateMockState ∷ (GetPrevHash blk, HasMockTxs blk) ⇒ MockConfig → blk → MockState blk → Except (MockError blk) (MockState blk) Source #
updateMockTip ∷ GetPrevHash blk ⇒ Header blk → MockState blk → Except (MockError blk) (MockState blk) Source #
updateMockUTxO ∷ HasMockTxs a ⇒ MockConfig → SlotNo → a → MockState blk → Except (MockError blk) (MockState blk) Source #
checkTxSize ∷ MockConfig → Tx → Except (MockError blk) ByteSize32 Source #
txSize ∷ Tx → ByteSize32 Source #
genesisMockState ∷ AddrDist → MockState blk Source #
confirmed ∷ HasMockTxs a ⇒ a → Set TxId Source #
confirmed
stands for all the transaction hashes present in the given
collection.
txOuts ∷ HasMockTxs a ⇒ a → Utxo Source #
updateUtxo ∷ HasMockTxs a ⇒ a → Utxo → Except UtxoError Utxo Source #
Update the Utxo with the transactions from the given a
, by removing the
inputs and adding the outputs.