ouroboros-consensus-protocol-0.9.0.0: Cardano consensus protocols
Safe HaskellSafe-Inferred
LanguageHaskell2010

Ouroboros.Consensus.Protocol.TPraos

Description

Transitional Praos.

Transitional praos allows for the overlaying of Praos with an overlay schedule determining slots to be produced by BFT

Synopsis

Documentation

newtype MaxMajorProtVer Source #

The maximum major protocol version.

Must be at least the current major protocol version. For Cardano mainnet, the Shelley era has major protocol verison 2.

Constructors

MaxMajorProtVer 

Instances

Instances details
Generic MaxMajorProtVer Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.Praos.Common

Associated Types

type Rep MaxMajorProtVerTypeType #

Show MaxMajorProtVer Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.Praos.Common

Eq MaxMajorProtVer Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.Praos.Common

NoThunks MaxMajorProtVer Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.Praos.Common

type Rep MaxMajorProtVer Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.Praos.Common

type Rep MaxMajorProtVer = D1 ('MetaData "MaxMajorProtVer" "Ouroboros.Consensus.Protocol.Praos.Common" "ouroboros-consensus-protocol-0.9.0.0-inplace" 'True) (C1 ('MetaCons "MaxMajorProtVer" 'PrefixI 'True) (S1 ('MetaSel ('Just "getMaxMajorProtVer") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Version)))

data PraosChainSelectView c Source #

View of the tip of a header fragment for chain selection.

Instances

Instances details
Generic (PraosChainSelectView c) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.Praos.Common

Associated Types

type Rep (PraosChainSelectView c) ∷ TypeType #

Crypto c ⇒ Show (PraosChainSelectView c) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.Praos.Common

Crypto c ⇒ Eq (PraosChainSelectView c) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.Praos.Common

Crypto c ⇒ Ord (PraosChainSelectView c) Source #

We order between chains as follows:

  1. By chain length, with longer chains always preferred.
  2. If the tip of each chain was issued by the same agent and they have the same slot number, prefer the chain whose tip has the highest ocert issue number.
  3. By a VRF value from the chain tip, with lower values preferred. See pTieBreakVRFValue for which one is used.

IMPORTANT: This is not a complete picture of the Praos chain order, do also consult the documentation of ChainOrder.

Instance details

Defined in Ouroboros.Consensus.Protocol.Praos.Common

Crypto c ⇒ NoThunks (PraosChainSelectView c) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.Praos.Common

Crypto c ⇒ ChainOrder (PraosChainSelectView c) Source #

IMPORTANT: This is not a SimpleChainOrder; rather, there are PraosChainSelectViews a, b such that a < b, but not $ preferCandidate cfg a b, namely for cfg = RestrictedVRFTiebreaker.

Rules

Concretely, we have preferCandidate cfg ours cand based on the following lexicographical criteria:

  1. Chain length, with longer chains always preferred.
  2. If the tip of each chain was issued by the same agent and had the same slot number, then we prefer the candidate if it has a higher ocert issue number.

    Note that this condition is equivalent to the VRFs being identical, as the VRF is a deterministic function of the issuer VRF key, the slot and the epoch nonce, and VRFs are collision-resistant.

  3. Depending on the VRFTiebreakerFlavor:

    • If UnrestrictedVRFTiebreaker: Compare via a VRF value from the chain tip, with lower values preferred. See pTieBreakVRFValue for which one is used.
    • If RestrictedVRFTiebreaker maxDist: Only do the VRF comparison (as in the previous step) if the slot numbers differ by at most maxDist.

Non-transitivity of RestrictedVRFTiebreaker

When using cfg = RestrictedVRFTiebreaker maxDist, the chain order is not transitive. As an example, suppose maxDist = 5 and consider three PraosChainSelectViews with the same chain length and pairwise different issuers and, as well as

abc
Slot036
VRF321

Then we have preferCandidate cfg a b and preferCandidate b c, but not preferCandidate a c (despite a < c).

Rationale for the rules

  1. The abstract Consensus layer requires that we first compare based on chain length (see Chain extension precedence in ChainOrder).
  1. Consider the scenario where the hot key of a block issuer was compromised, and the attacker is now minting blocks using that identity. The actual block issuer can use their cold key to issue a new hot key with a higher opcert issue number and set up a new pool. Due to this tiebreaker rule, the blocks minted by that pool will take precedence (allowing the actual block issuer to decide on eg the block contents and the predecessor) over blocks with the same block and slot number minted by the attacker, and they will end up on the honest chain quickly, which means that the adversary can't extend any chain containing such a block as it would violate the monotonicity requirement on opcert issue numbers.

    See "3.7 Block Validity and Operational Key Certificates" in "Design Specification for Delegation and Incentives in Cardano" by Kant et al for more context.

  2. The main motivation to do VRF comparisons is to avoid the "Frankfurt problem":

    With only the first two rules for the chain order, almost all blocks with equal block number are equally preferrable. Consider two block issuers minting blocks in very nearby slots. As we never change our selection from one chain to an equally preferrable one, the first block to arrive at another pool is the one to be adopted, and will be extended the next time the pool is elected if no blocks with a higher block number arrive in the meantime. We observed that this effectively incentivizes block producers to concentrate geographically (historically, in Frankfurt) in order to minimize their diffusion times. This works against the goal of geographic decentralisation.

    Also, with the VRF tiebreaker, a block with a somewhat lower propagation speed has a random chance to be selected instead of the one that arrived first by pools before the next block is forged.

    See VRFTiebreakerFlavor for more context on the exact conditions under which the VRF comparison takes place.

Instance details

Defined in Ouroboros.Consensus.Protocol.Praos.Common

type Rep (PraosChainSelectView c) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.Praos.Common

type Rep (PraosChainSelectView c) = D1 ('MetaData "PraosChainSelectView" "Ouroboros.Consensus.Protocol.Praos.Common" "ouroboros-consensus-protocol-0.9.0.0-inplace" 'False) (C1 ('MetaCons "PraosChainSelectView" 'PrefixI 'True) ((S1 ('MetaSel ('Just "csvChainLength") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 BlockNo) :*: S1 ('MetaSel ('Just "csvSlotNo") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 SlotNo)) :*: (S1 ('MetaSel ('Just "csvIssuer") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (VKey 'BlockIssuer c)) :*: (S1 ('MetaSel ('Just "csvIssueNo") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Word64) :*: S1 ('MetaSel ('Just "csvTieBreakVRF") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (OutputVRF (VRF c)))))))
type ChainOrderConfig (PraosChainSelectView c) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.Praos.Common

data TPraos c Source #

Instances

Instances details
Generic (ConsensusConfig (TPraos c)) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.TPraos

Associated Types

type Rep (ConsensusConfig (TPraos c)) ∷ TypeType #

PraosCrypto c ⇒ NoThunks (ConsensusConfig (TPraos c)) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.TPraos

PraosCrypto c ⇒ ConsensusProtocol (TPraos c) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.TPraos

PraosCrypto c ⇒ PraosProtocolSupportsNode (TPraos c) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.TPraos

c1 ~ c2 ⇒ TranslateProto (TPraos c1) (Praos c2) Source #

We can translate between TPraos and Praos, provided:

  • They share the same HASH algorithm
  • They share the same ADDRHASH algorithm
  • They share the same DSIGN verification keys
  • They share the same VRF verification keys
Instance details

Defined in Ouroboros.Consensus.Protocol.Praos

type Rep (ConsensusConfig (TPraos c)) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.TPraos

type Rep (ConsensusConfig (TPraos c)) = D1 ('MetaData "ConsensusConfig" "Ouroboros.Consensus.Protocol.TPraos" "ouroboros-consensus-protocol-0.9.0.0-inplace" 'False) (C1 ('MetaCons "TPraosConfig" 'PrefixI 'True) (S1 ('MetaSel ('Just "tpraosParams") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 TPraosParams) :*: S1 ('MetaSel ('Just "tpraosEpochInfo") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (EpochInfo (Except PastHorizonException)))))
type CanBeLeader (TPraos c) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.TPraos

type ChainDepState (TPraos c) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.TPraos

data ConsensusConfig (TPraos c) Source #

Static configuration

Instance details

Defined in Ouroboros.Consensus.Protocol.TPraos

type IsLeader (TPraos c) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.TPraos

type LedgerView (TPraos c) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.TPraos

type SelectView (TPraos c) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.TPraos

type ValidateView (TPraos c) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.TPraos

type ValidationErr (TPraos c) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.TPraos

type PraosProtocolSupportsNodeCrypto (TPraos c) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.TPraos

data TPraosFields c toSign Source #

Constructors

TPraosFields 

Fields

Instances

Instances details
Generic (TPraosFields c toSign) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.TPraos

Associated Types

type Rep (TPraosFields c toSign) ∷ TypeType #

Methods

fromTPraosFields c toSign → Rep (TPraosFields c toSign) x #

toRep (TPraosFields c toSign) x → TPraosFields c toSign #

(Show toSign, PraosCrypto c) ⇒ Show (TPraosFields c toSign) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.TPraos

Methods

showsPrecIntTPraosFields c toSign → ShowS #

showTPraosFields c toSign → String #

showList ∷ [TPraosFields c toSign] → ShowS #

(NoThunks toSign, PraosCrypto c) ⇒ NoThunks (TPraosFields c toSign) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.TPraos

(Condense toSign, PraosCrypto c) ⇒ Condense (TPraosFields c toSign) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.TPraos

Methods

condenseTPraosFields c toSign → String Source #

type Rep (TPraosFields c toSign) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.TPraos

type Rep (TPraosFields c toSign) = D1 ('MetaData "TPraosFields" "Ouroboros.Consensus.Protocol.TPraos" "ouroboros-consensus-protocol-0.9.0.0-inplace" 'False) (C1 ('MetaCons "TPraosFields" 'PrefixI 'True) (S1 ('MetaSel ('Just "tpraosSignature") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (SignedKES c toSign)) :*: S1 ('MetaSel ('Just "tpraosToSign") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 toSign)))

data TPraosIsLeader c Source #

Assembled proof that the issuer has the right to issue a block in the selected slot.

Constructors

TPraosIsLeader 

Fields

Instances

Instances details
Generic (TPraosIsLeader c) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.TPraos

Associated Types

type Rep (TPraosIsLeader c) ∷ TypeType #

Methods

fromTPraosIsLeader c → Rep (TPraosIsLeader c) x #

toRep (TPraosIsLeader c) x → TPraosIsLeader c #

PraosCrypto c ⇒ NoThunks (TPraosIsLeader c) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.TPraos

type Rep (TPraosIsLeader c) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.TPraos

type Rep (TPraosIsLeader c) = D1 ('MetaData "TPraosIsLeader" "Ouroboros.Consensus.Protocol.TPraos" "ouroboros-consensus-protocol-0.9.0.0-inplace" 'False) (C1 ('MetaCons "TPraosIsLeader" 'PrefixI 'True) (S1 ('MetaSel ('Just "tpraosIsLeaderEta") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (CertifiedVRF c Nonce)) :*: (S1 ('MetaSel ('Just "tpraosIsLeaderProof") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (CertifiedVRF c Natural)) :*: S1 ('MetaSel ('Just "tpraosIsLeaderGenVRFHash") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (Hash c (VerKeyVRF c)))))))

data TPraosParams Source #

TPraos parameters that are node independent

Constructors

TPraosParams 

Fields

Instances

Instances details
Generic TPraosParams Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.TPraos

Associated Types

type Rep TPraosParamsTypeType #

NoThunks TPraosParams Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.TPraos

type Rep TPraosParams Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.TPraos

type Rep TPraosParams = D1 ('MetaData "TPraosParams" "Ouroboros.Consensus.Protocol.TPraos" "ouroboros-consensus-protocol-0.9.0.0-inplace" 'False) (C1 ('MetaCons "TPraosParams" 'PrefixI 'True) (((S1 ('MetaSel ('Just "tpraosSlotsPerKESPeriod") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Word64) :*: S1 ('MetaSel ('Just "tpraosLeaderF") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 ActiveSlotCoeff)) :*: (S1 ('MetaSel ('Just "tpraosSecurityParam") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 SecurityParam) :*: (S1 ('MetaSel ('Just "tpraosMaxKESEvo") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Word64) :*: S1 ('MetaSel ('Just "tpraosQuorum") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Word64)))) :*: ((S1 ('MetaSel ('Just "tpraosMaxMajorPV") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 MaxMajorProtVer) :*: S1 ('MetaSel ('Just "tpraosMaxLovelaceSupply") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Word64)) :*: (S1 ('MetaSel ('Just "tpraosNetworkId") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Network) :*: (S1 ('MetaSel ('Just "tpraosInitialNonce") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Nonce) :*: S1 ('MetaSel ('Just "tpraosSystemStart") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 SystemStart))))))

data TPraosState c Source #

Transitional Praos consensus state.

In addition to the ChainDepState provided by the ledger, we track the slot number of the last applied header.

Instances

Instances details
Generic (TPraosState c) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.TPraos

Associated Types

type Rep (TPraosState c) ∷ TypeType #

Methods

fromTPraosState c → Rep (TPraosState c) x #

toRep (TPraosState c) x → TPraosState c #

Show (TPraosState c) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.TPraos

Methods

showsPrecIntTPraosState c → ShowS #

showTPraosState c → String #

showList ∷ [TPraosState c] → ShowS #

PraosCrypto c ⇒ FromCBOR (TPraosState c) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.TPraos

PraosCrypto c ⇒ ToCBOR (TPraosState c) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.TPraos

Methods

toCBORTPraosState c → Encoding Source #

encodedSizeExpr ∷ (∀ t. ToCBOR t ⇒ Proxy t → Size) → Proxy (TPraosState c) → Size Source #

encodedListSizeExpr ∷ (∀ t. ToCBOR t ⇒ Proxy t → Size) → Proxy [TPraosState c] → Size Source #

Eq (TPraosState c) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.TPraos

Methods

(==)TPraosState c → TPraosState c → Bool #

(/=)TPraosState c → TPraosState c → Bool #

PraosCrypto c ⇒ NoThunks (TPraosState c) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.TPraos

PraosCrypto c ⇒ Serialise (TPraosState c) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.TPraos

type Rep (TPraosState c) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.TPraos

type Rep (TPraosState c) = D1 ('MetaData "TPraosState" "Ouroboros.Consensus.Protocol.TPraos" "ouroboros-consensus-protocol-0.9.0.0-inplace" 'False) (C1 ('MetaCons "TPraosState" 'PrefixI 'True) (S1 ('MetaSel ('Just "tpraosStateLastSlot") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (WithOrigin SlotNo)) :*: S1 ('MetaSel ('Just "tpraosStateChainDepState") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (ChainDepState c))))
data Ticked (TPraosState c) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.TPraos

data TPraosToSign c Source #

Fields arising from transitional praos execution which must be included in the block signature.

Constructors

TPraosToSign 

Fields

  • tpraosToSignIssuerVKVKey 'BlockIssuer c

    Verification key for the issuer of this block.

    Note that unlike in Classic/BFT where we have a key for the genesis delegate on whose behalf we are issuing this block, this key corresponds to the stake pool/core node actually forging the block.

  • tpraosToSignVrfVKVerKeyVRF c
     
  • tpraosToSignEtaCertifiedVRF c Nonce

    Verifiable result containing the updated nonce value.

  • tpraosToSignLeaderCertifiedVRF c Natural

    Verifiable proof of the leader value, used to determine whether the node has the right to issue a block in this slot.

    We include a value here even for blocks forged under the BFT schedule. It is not required that such a value be verifiable (though by default it will be verifiably correct, but unused.)

  • tpraosToSignOCertOCert c

    Lightweight delegation certificate mapping the cold (DSIGN) key to the online KES key.

Instances

Instances details
Generic (TPraosToSign c) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.TPraos

Associated Types

type Rep (TPraosToSign c) ∷ TypeType #

Methods

fromTPraosToSign c → Rep (TPraosToSign c) x #

toRep (TPraosToSign c) x → TPraosToSign c #

PraosCrypto c ⇒ Show (TPraosToSign c) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.TPraos

Methods

showsPrecIntTPraosToSign c → ShowS #

showTPraosToSign c → String #

showList ∷ [TPraosToSign c] → ShowS #

PraosCrypto c ⇒ NoThunks (TPraosToSign c) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.TPraos

type Rep (TPraosToSign c) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.TPraos

type Rep (TPraosToSign c) = D1 ('MetaData "TPraosToSign" "Ouroboros.Consensus.Protocol.TPraos" "ouroboros-consensus-protocol-0.9.0.0-inplace" 'False) (C1 ('MetaCons "TPraosToSign" 'PrefixI 'True) ((S1 ('MetaSel ('Just "tpraosToSignIssuerVK") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (VKey 'BlockIssuer c)) :*: S1 ('MetaSel ('Just "tpraosToSignVrfVK") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (VerKeyVRF c))) :*: (S1 ('MetaSel ('Just "tpraosToSignEta") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (CertifiedVRF c Nonce)) :*: (S1 ('MetaSel ('Just "tpraosToSignLeader") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (CertifiedVRF c Natural)) :*: S1 ('MetaSel ('Just "tpraosToSignOCert") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (OCert c))))))

type TPraosValidateView c = BHeader c Source #

Because we are using the executable spec, rather than implementing the protocol directly here, we have a fixed header type rather than an abstraction. So our validate view is fixed to this.

forgeTPraosFields ∷ (PraosCrypto c, KESignable c toSign, Monad m) ⇒ HotKey c m → CanBeLeader (TPraos c) → IsLeader (TPraos c) → (TPraosToSign c → toSign) → m (TPraosFields c toSign) Source #

mkTPraosParams Source #

Arguments

MaxMajorProtVer 
Nonce

Initial nonce

ShelleyGenesis era 
TPraosParams 

Crypto

class (Crypto c, DSignable c (OCertSignable c), KESignable c (BHBody c), VRFSignable c Seed) ⇒ PraosCrypto c Source #

Instances

Instances details
PraosCrypto StandardCrypto 
Instance details

Defined in Cardano.Protocol.TPraos.API

data StandardCrypto Source #

The same crypto used on the net

CannotForge

data TPraosCannotForge c Source #

Expresses that, whilst we believe ourselves to be a leader for this slot, we are nonetheless unable to forge a block.

Constructors

TPraosCannotForgeKeyNotUsableYet

The KES key in our operational certificate can't be used because the current (wall clock) period is before the start period of the key. current KES period.

Note: the opposite case, i.e., the wall clock period being after the end period of the key, is caught when trying to update the key in updateForgeState.

Fields

  • !KESPeriod

    Current KES period according to the wallclock slot, i.e., the KES period in which we want to use the key.

  • !KESPeriod

    Start KES period of the KES key.

TPraosCannotForgeWrongVRF !(Hash c (VerKeyVRF c)) !(Hash c (VerKeyVRF c))

We are a genesis delegate, but our VRF key (second argument) does not match the registered key for that delegate (first argument).

Instances

Instances details
Generic (TPraosCannotForge c) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.TPraos

Associated Types

type Rep (TPraosCannotForge c) ∷ TypeType #

PraosCrypto c ⇒ Show (TPraosCannotForge c) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.TPraos

type Rep (TPraosCannotForge c) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.TPraos

type Rep (TPraosCannotForge c) = D1 ('MetaData "TPraosCannotForge" "Ouroboros.Consensus.Protocol.TPraos" "ouroboros-consensus-protocol-0.9.0.0-inplace" 'False) (C1 ('MetaCons "TPraosCannotForgeKeyNotUsableYet" 'PrefixI 'False) (S1 ('MetaSel ('NothingMaybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 KESPeriod) :*: S1 ('MetaSel ('NothingMaybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 KESPeriod)) :+: C1 ('MetaCons "TPraosCannotForgeWrongVRF" 'PrefixI 'False) (S1 ('MetaSel ('NothingMaybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Hash c (VerKeyVRF c))) :*: S1 ('MetaSel ('NothingMaybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Hash c (VerKeyVRF c)))))

tpraosCheckCanForge Source #

Arguments

ConsensusConfig (TPraos c) 
Hash c (VerKeyVRF c)

Precomputed hash of the VRF verification key

SlotNo 
IsLeader (TPraos c) 
KESInfo 
Either (TPraosCannotForge c) () 

Type instances

data family ConsensusConfig p Source #

Static configuration required to run the consensus protocol

Every method in the ConsensusProtocol class takes the consensus configuration as a parameter, so having this as a data family rather than a type family resolves most ambiguity.

Defined out of the class so that protocols can define this type without having to define the entire protocol at the same time (or indeed in the same module).

Instances

Instances details
Generic (ConsensusConfig (Praos c)) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.Praos

Associated Types

type Rep (ConsensusConfig (Praos c)) ∷ TypeType #

Generic (ConsensusConfig (TPraos c)) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.TPraos

Associated Types

type Rep (ConsensusConfig (TPraos c)) ∷ TypeType #

PraosCrypto c ⇒ NoThunks (ConsensusConfig (Praos c)) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.Praos

PraosCrypto c ⇒ NoThunks (ConsensusConfig (TPraos c)) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.TPraos

type Rep (ConsensusConfig (Praos c)) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.Praos

type Rep (ConsensusConfig (Praos c)) = D1 ('MetaData "ConsensusConfig" "Ouroboros.Consensus.Protocol.Praos" "ouroboros-consensus-protocol-0.9.0.0-inplace" 'False) (C1 ('MetaCons "PraosConfig" 'PrefixI 'True) (S1 ('MetaSel ('Just "praosParams") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 PraosParams) :*: S1 ('MetaSel ('Just "praosEpochInfo") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (EpochInfo (Except PastHorizonException)))))
type Rep (ConsensusConfig (TPraos c)) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.TPraos

type Rep (ConsensusConfig (TPraos c)) = D1 ('MetaData "ConsensusConfig" "Ouroboros.Consensus.Protocol.TPraos" "ouroboros-consensus-protocol-0.9.0.0-inplace" 'False) (C1 ('MetaCons "TPraosConfig" 'PrefixI 'True) (S1 ('MetaSel ('Just "tpraosParams") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 TPraosParams) :*: S1 ('MetaSel ('Just "tpraosEpochInfo") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (EpochInfo (Except PastHorizonException)))))
data ConsensusConfig (Praos c) Source #

Static configuration

Instance details

Defined in Ouroboros.Consensus.Protocol.Praos

data ConsensusConfig (TPraos c) Source #

Static configuration

Instance details

Defined in Ouroboros.Consensus.Protocol.TPraos

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 forecastFor (ledgerViewForecastAt cfg st) slot must equal protocolLedgerView cfg (applyChainTick cfg slot st). Thus a 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

Instances details
Show (Ticked ()) 
Instance details

Defined in Ouroboros.Consensus.Ticked

Methods

showsPrecIntTicked () → ShowS #

showTicked () → String #

showList ∷ [Ticked ()] → ShowS #

Show (Ticked (f a)) ⇒ Show ((Ticked :.: f) a) 
Instance details

Defined in Ouroboros.Consensus.Ticked

Methods

showsPrecInt → (Ticked :.: f) a → ShowS #

show ∷ (Ticked :.: f) a → String #

showList ∷ [(Ticked :.: f) a] → ShowS #

NoThunks (Ticked (f a)) ⇒ NoThunks ((Ticked :.: f) a) 
Instance details

Defined in Ouroboros.Consensus.Ticked

data Ticked () 
Instance details

Defined in Ouroboros.Consensus.Ticked

type HeaderHash (Ticked l ∷ Type) 
Instance details

Defined in Ouroboros.Consensus.Ticked

type HeaderHash (Ticked l ∷ Type) = HeaderHash l
data Ticked (PraosState c) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.Praos

data Ticked (TPraosState c) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.TPraos