ouroboros-consensus-0.26.0.0: Consensus layer for the Ouroboros blockchain protocol
Safe HaskellNone
LanguageHaskell2010

Ouroboros.Consensus.HardFork.Combinator

Description

The hard fork combinator

Intended for unqualified import

Synopsis

Documentation

data Mismatch (f ∷ k → Type) (g ∷ k → Type) (xs ∷ [k]) where Source #

We have a mismatch in the index between two NS

Constructors

ML ∷ ∀ {k} (f ∷ k → Type) (x ∷ k) (g ∷ k → Type) (xs1 ∷ [k]). f x → NS g xs1 → Mismatch f g (x ': xs1)

The left is at the current x and the right is somewhere in the later xs

MR ∷ ∀ {k} (f ∷ k → Type) (xs1 ∷ [k]) (g ∷ k → Type) (x ∷ k). NS f xs1 → g x → Mismatch f g (x ': xs1)

The right is at the current x and the left is somewhere in the later xs

MS ∷ ∀ {k} (f ∷ k → Type) (g ∷ k → Type) (xs1 ∷ [k]) (x ∷ k). Mismatch f g xs1 → Mismatch f g (x ': xs1)

There is a mismatch later on in the xs

Instances

Instances details
(∀ (x ∷ k2) (y ∷ k2). LiftedCoercible p p x y) ⇒ HTrans (Mismatch p ∷ (k2 → Type) → [k2] → Type) (Mismatch p ∷ (k2 → Type) → [k2] → Type) 
Instance details

Defined in Data.SOP.Match

Methods

htrans ∷ ∀ c (xs ∷ [k2]) (ys ∷ [k2]) proxy f g. AllZipN (Prod (Mismatch p)) c xs ys ⇒ proxy c → (∀ (x ∷ k2) (y ∷ k2). c x y ⇒ f x → g y) → Mismatch p f xs → Mismatch p g ys Source #

hcoerce ∷ ∀ (f ∷ k2 → Type) (g ∷ k2 → Type) (xs ∷ [k2]) (ys ∷ [k2]). AllZipN (Prod (Mismatch p)) (LiftedCoercible f g) xs ys ⇒ Mismatch p f xs → Mismatch p g ys Source #

HAp (Mismatch f ∷ (k → Type) → [k] → Type) 
Instance details

Defined in Data.SOP.Match

Methods

hap ∷ ∀ (f0 ∷ k → Type) (g ∷ k → Type) (xs ∷ [k]). Prod (Mismatch f) (f0 -.-> g) xs → Mismatch f f0 xs → Mismatch f g xs Source #

(All (Compose Show f) xs, All (Compose Show g) xs) ⇒ Show (Mismatch f g xs) 
Instance details

Defined in Data.SOP.Match

Methods

showsPrecIntMismatch f g xs → ShowS #

showMismatch f g xs → String #

showList ∷ [Mismatch f g xs] → ShowS #

(All (Compose Eq f) xs, All (Compose Eq g) xs) ⇒ Eq (Mismatch f g xs) 
Instance details

Defined in Data.SOP.Match

Methods

(==)Mismatch f g xs → Mismatch f g xs → Bool #

(/=)Mismatch f g xs → Mismatch f g xs → Bool #

(All (Compose Eq f) xs, All (Compose Ord f) xs, All (Compose Eq g) xs, All (Compose Ord g) xs) ⇒ Ord (Mismatch f g xs) 
Instance details

Defined in Data.SOP.Match

Methods

compareMismatch f g xs → Mismatch f g xs → Ordering #

(<)Mismatch f g xs → Mismatch f g xs → Bool #

(<=)Mismatch f g xs → Mismatch f g xs → Bool #

(>)Mismatch f g xs → Mismatch f g xs → Bool #

(>=)Mismatch f g xs → Mismatch f g xs → Bool #

maxMismatch f g xs → Mismatch f g xs → Mismatch f g xs #

minMismatch f g xs → Mismatch f g xs → Mismatch f g xs #

(All (Compose NoThunks f) xs, All (Compose NoThunks g) xs) ⇒ NoThunks (Mismatch f g xs) 
Instance details

Defined in Data.SOP.Match

type Same (Mismatch f ∷ (k2 → Type) → [k2] → Type) 
Instance details

Defined in Data.SOP.Match

type Same (Mismatch f ∷ (k2 → Type) → [k2] → Type) = Mismatch f
type Prod (Mismatch f ∷ (k → Type) → [k] → Type) 
Instance details

Defined in Data.SOP.Match

type Prod (Mismatch f ∷ (k → Type) → [k] → Type) = NP ∷ (k → Type) → [k] → Type
type SListIN (Mismatch f ∷ (k → Type) → [k] → Type) 
Instance details

Defined in Data.SOP.Match

type SListIN (Mismatch f ∷ (k → Type) → [k] → Type) = SListI ∷ [k] → Constraint
type AllN (Mismatch f ∷ (k → Type) → [k] → Type) (c ∷ k → Constraint) 
Instance details

Defined in Data.SOP.Match

type AllN (Mismatch f ∷ (k → Type) → [k] → Type) (c ∷ k → Constraint) = All c

data Product2 (f ∷ TypeTypeType) (g ∷ TypeTypeType) x y Source #

Constructors

Pair2 (f x y) (g x y) 

Instances

Instances details
Generic (Product2 f g x y) 
Instance details

Defined in Data.SOP.Functors

Associated Types

type Rep (Product2 f g x y) 
Instance details

Defined in Data.SOP.Functors

type Rep (Product2 f g x y) = D1 ('MetaData "Product2" "Data.SOP.Functors" "sop-extras-0.4.0.0-inplace" 'False) (C1 ('MetaCons "Pair2" 'PrefixI 'False) (S1 ('MetaSel ('NothingMaybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (f x y)) :*: S1 ('MetaSel ('NothingMaybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (g x y))))

Methods

fromProduct2 f g x y → Rep (Product2 f g x y) x0 #

toRep (Product2 f g x y) x0 → Product2 f g x y #

(Show (f x y), Show (g x y)) ⇒ Show (Product2 f g x y) 
Instance details

Defined in Data.SOP.Functors

Methods

showsPrecIntProduct2 f g x y → ShowS #

showProduct2 f g x y → String #

showList ∷ [Product2 f g x y] → ShowS #

(Eq (f x y), Eq (g x y)) ⇒ Eq (Product2 f g x y) 
Instance details

Defined in Data.SOP.Functors

Methods

(==)Product2 f g x y → Product2 f g x y → Bool #

(/=)Product2 f g x y → Product2 f g x y → Bool #

type Rep (Product2 f g x y) 
Instance details

Defined in Data.SOP.Functors

type Rep (Product2 f g x y) = D1 ('MetaData "Product2" "Data.SOP.Functors" "sop-extras-0.4.0.0-inplace" 'False) (C1 ('MetaCons "Pair2" 'PrefixI 'False) (S1 ('MetaSel ('NothingMaybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (f x y)) :*: S1 ('MetaSel ('NothingMaybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (g x y))))

data InPairs (f ∷ k → k → Type) (xs ∷ [k]) where Source #

We have an f x y for each pair (x, y) of successive list elements

Constructors

PNil ∷ ∀ {k} (f ∷ k → k → Type) (x ∷ k). InPairs f '[x] 
PCons ∷ ∀ {k} (f ∷ k → k → Type) (x ∷ k) (y ∷ k) (zs ∷ [k]). f x y → InPairs f (y ': zs) → InPairs f (x ': (y ': zs)) 

data Telescope (g ∷ k → Type) (f ∷ k → Type) (xs ∷ [k]) where Source #

Telescope

A telescope is an extension of an NS, where every time we "go right" in the sum we have an additional value.

The Telescope API mostly follows sop-core conventions, supporting functor (hmap, hcmap), applicative (hap, hpure), foldable (hcollapse) and traversable (hsequence'). However, since Telescope is a bi-functor, it cannot reuse the sop-core classes. The naming scheme of the functions is adopted from sop-core though; for example:

bi h (c) zipWith
|  |  |    |
|  |  |    \ zipWith: the name from base
|  |  |
|  |  \ constrained: version of the function with a constraint parameter
|  |
|  \ higher order: 'Telescope' (like 'NS'/'NP') is a /higher order/ functor
|
\ bifunctor: 'Telescope' (unlike 'NS'/'NP') is a higher order /bifunctor/

In addition to the standard SOP operators, the new operators that make a Telescope a telescope are extend, retract and align; see their documentation for details.

Constructors

TZ ∷ ∀ {k} (f ∷ k → Type) (x ∷ k) (g ∷ k → Type) (xs1 ∷ [k]). !(f x) → Telescope g f (x ': xs1) 
TS ∷ ∀ {k} (g ∷ k → Type) (x ∷ k) (f ∷ k → Type) (xs1 ∷ [k]). !(g x) → !(Telescope g f xs1) → Telescope g f (x ': xs1) 

Instances

Instances details
(∀ (x ∷ k2) (y ∷ k2). LiftedCoercible g g x y) ⇒ HTrans (Telescope g ∷ (k2 → Type) → [k2] → Type) (Telescope g ∷ (k2 → Type) → [k2] → Type) 
Instance details

Defined in Data.SOP.Telescope

Methods

htrans ∷ ∀ c (xs ∷ [k2]) (ys ∷ [k2]) proxy f g0. AllZipN (Prod (Telescope g)) c xs ys ⇒ proxy c → (∀ (x ∷ k2) (y ∷ k2). c x y ⇒ f x → g0 y) → Telescope g f xs → Telescope g g0 ys Source #

hcoerce ∷ ∀ (f ∷ k2 → Type) (g0 ∷ k2 → Type) (xs ∷ [k2]) (ys ∷ [k2]). AllZipN (Prod (Telescope g)) (LiftedCoercible f g0) xs ys ⇒ Telescope g f xs → Telescope g g0 ys Source #

HAp (Telescope g ∷ (k → Type) → [k] → Type) 
Instance details

Defined in Data.SOP.Telescope

Methods

hap ∷ ∀ (f ∷ k → Type) (g0 ∷ k → Type) (xs ∷ [k]). Prod (Telescope g) (f -.-> g0) xs → Telescope g f xs → Telescope g g0 xs Source #

HSequence (Telescope g ∷ (k → Type) → [k] → Type) 
Instance details

Defined in Data.SOP.Telescope

Methods

hsequence' ∷ ∀ (xs ∷ [k]) f (g0 ∷ k → Type). (SListIN (Telescope g) xs, Applicative f) ⇒ Telescope g (f :.: g0) xs → f (Telescope g g0 xs) Source #

hctraverse' ∷ ∀ c (xs ∷ [k]) g0 proxy f f'. (AllN (Telescope g) c xs, Applicative g0) ⇒ proxy c → (∀ (a ∷ k). c a ⇒ f a → g0 (f' a)) → Telescope g f xs → g0 (Telescope g f' xs) Source #

htraverse' ∷ ∀ (xs ∷ [k]) g0 f f'. (SListIN (Telescope g) xs, Applicative g0) ⇒ (∀ (a ∷ k). f a → g0 (f' a)) → Telescope g f xs → g0 (Telescope g f' xs) Source #

HTraverse_ (Telescope g ∷ (k → Type) → [k] → Type) 
Instance details

Defined in Data.SOP.Telescope

Methods

hctraverse_ ∷ ∀ c (xs ∷ [k]) g0 proxy f. (AllN (Telescope g) c xs, Applicative g0) ⇒ proxy c → (∀ (a ∷ k). c a ⇒ f a → g0 ()) → Telescope g f xs → g0 () Source #

htraverse_ ∷ ∀ (xs ∷ [k]) g0 f. (SListIN (Telescope g) xs, Applicative g0) ⇒ (∀ (a ∷ k). f a → g0 ()) → Telescope g f xs → g0 () Source #

(All (Compose Show g) xs, All (Compose Show f) xs) ⇒ Show (Telescope g f xs) 
Instance details

Defined in Data.SOP.Telescope

Methods

showsPrecIntTelescope g f xs → ShowS #

showTelescope g f xs → String #

showList ∷ [Telescope g f xs] → ShowS #

(All (Compose Eq g) xs, All (Compose Eq f) xs) ⇒ Eq (Telescope g f xs) 
Instance details

Defined in Data.SOP.Telescope

Methods

(==)Telescope g f xs → Telescope g f xs → Bool #

(/=)Telescope g f xs → Telescope g f xs → Bool #

(All (Compose Eq g) xs, All (Compose Ord g) xs, All (Compose Eq f) xs, All (Compose Ord f) xs) ⇒ Ord (Telescope g f xs) 
Instance details

Defined in Data.SOP.Telescope

Methods

compareTelescope g f xs → Telescope g f xs → Ordering #

(<)Telescope g f xs → Telescope g f xs → Bool #

(<=)Telescope g f xs → Telescope g f xs → Bool #

(>)Telescope g f xs → Telescope g f xs → Bool #

(>=)Telescope g f xs → Telescope g f xs → Bool #

maxTelescope g f xs → Telescope g f xs → Telescope g f xs #

minTelescope g f xs → Telescope g f xs → Telescope g f xs #

(All (Compose NoThunks g) xs, All (Compose NoThunks f) xs) ⇒ NoThunks (Telescope g f xs) 
Instance details

Defined in Data.SOP.Telescope

type Same (Telescope g ∷ (k2 → Type) → [k2] → Type) 
Instance details

Defined in Data.SOP.Telescope

type Same (Telescope g ∷ (k2 → Type) → [k2] → Type) = Telescope g
type Prod (Telescope g ∷ (k → Type) → [k] → Type) 
Instance details

Defined in Data.SOP.Telescope

type Prod (Telescope g ∷ (k → Type) → [k] → Type) = NP ∷ (k → Type) → [k] → Type
type SListIN (Telescope g ∷ (k → Type) → [k] → Type) 
Instance details

Defined in Data.SOP.Telescope

type SListIN (Telescope g ∷ (k → Type) → [k] → Type) = SListI ∷ [k] → Constraint
type AllN (Telescope g ∷ (k → Type) → [k] → Type) (c ∷ k → Constraint) 
Instance details

Defined in Data.SOP.Telescope

type AllN (Telescope g ∷ (k → Type) → [k] → Type) (c ∷ k → Constraint) = All c

newtype MismatchEraInfo (xs ∷ [Type]) Source #

Constructors

MismatchEraInfo 

Fields

newtype OneEraBlock (xs ∷ [Type]) Source #

Constructors

OneEraBlock 

Fields

Instances

Instances details
CanHardFork xs ⇒ Show (OneEraBlock xs) Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.AcrossEras

Methods

showsPrecIntOneEraBlock xs → ShowS #

showOneEraBlock xs → String #

showList ∷ [OneEraBlock xs] → ShowS #

newtype OneEraGenTx (xs ∷ [Type]) Source #

Constructors

OneEraGenTx 

Fields

newtype OneEraGenTxId (xs ∷ [Type]) Source #

Constructors

OneEraGenTxId 

Instances

Instances details
CanHardFork xs ⇒ Show (OneEraGenTxId xs) Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.AcrossEras

Methods

showsPrecIntOneEraGenTxId xs → ShowS #

showOneEraGenTxId xs → String #

showList ∷ [OneEraGenTxId xs] → ShowS #

CanHardFork xs ⇒ Eq (OneEraGenTxId xs) Source #

This instance compares the underlying raw hash (toRawTxIdHash) of the TxId.

Note that this means that transactions in different eras can have equal TxIds. This should only be the case when the transaction format is backwards compatible from one era to the next.

Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.AcrossEras

Methods

(==)OneEraGenTxId xs → OneEraGenTxId xs → Bool #

(/=)OneEraGenTxId xs → OneEraGenTxId xs → Bool #

CanHardFork xs ⇒ Ord (OneEraGenTxId xs) Source #

See the corresponding Eq instance.

Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.AcrossEras

CanHardFork xs ⇒ NoThunks (OneEraGenTxId xs) Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.AcrossEras

newtype OneEraHash (xs ∷ [k]) Source #

The hash for an era

This type is special: we don't use an NS here, because the hash by itself should not allow us to differentiate between eras. If it did, the size of the hash would necessarily have to increase, and that leads to trouble. So, the type parameter xs here is merely a phantom one, and we just store the underlying raw hash.

Constructors

OneEraHash 

Instances

Instances details
Show (OneEraHash xs) Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.AcrossEras

Methods

showsPrecIntOneEraHash xs → ShowS #

showOneEraHash xs → String #

showList ∷ [OneEraHash xs] → ShowS #

Eq (OneEraHash xs) Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.AcrossEras

Methods

(==)OneEraHash xs → OneEraHash xs → Bool #

(/=)OneEraHash xs → OneEraHash xs → Bool #

Ord (OneEraHash xs) Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.AcrossEras

Methods

compareOneEraHash xs → OneEraHash xs → Ordering #

(<)OneEraHash xs → OneEraHash xs → Bool #

(<=)OneEraHash xs → OneEraHash xs → Bool #

(>)OneEraHash xs → OneEraHash xs → Bool #

(>=)OneEraHash xs → OneEraHash xs → Bool #

maxOneEraHash xs → OneEraHash xs → OneEraHash xs #

minOneEraHash xs → OneEraHash xs → OneEraHash xs #

NoThunks (OneEraHash xs) Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.AcrossEras

Condense (OneEraHash xs) Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.AcrossEras

Methods

condenseOneEraHash xs → String Source #

Serialise (OneEraHash xs) Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.AcrossEras

newtype OneEraHeader (xs ∷ [Type]) Source #

Constructors

OneEraHeader 

Fields

data HardForkForgeStateInfo (xs ∷ [Type]) where Source #

For each era in which we want to forge blocks, we have a BlockForging, and thus ForgeStateInfo.

When we update the hard fork forge state, we only update the forge state of the current era. However, the current era might not have a forge state as it lacks a BlockForging.

TODO #2766: expire past ForgeState

Constructors

CurrentEraLacksBlockForging ∷ ∀ x y (xs1 ∷ [Type]). EraIndex (x ': (y ': xs1)) → HardForkForgeStateInfo (x ': (y ': xs1))

There is no BlockForging record for the current era.

CurrentEraForgeStateUpdated ∷ ∀ (xs ∷ [Type]). OneEraForgeStateInfo xs → HardForkForgeStateInfo xs

The ForgeState of the current era was updated.

hardForkBlockForging Source #

Arguments

∷ ∀ (m ∷ TypeType) (xs ∷ [Type]). (CanHardFork xs, Monad m) 
Text

Used as the forgeLabel, the labels of the given BlockForgings will be ignored.

NonEmptyOptNP (BlockForging m) xs 
BlockForging m (HardForkBlock xs) 

pattern InjectTx ∷ (GenTx blk → Maybe (GenTx blk')) → InjectTx blk blk' Source #

newtype HardForkState (f ∷ TypeType) (xs ∷ [Type]) Source #

Generic hard fork state

This is used both for the consensus state and the ledger state.

By using a telescope with f ~ LedgerState, we will keep track of Past information for eras before the current one:

TZ currentByronState
TZ pastByronState $ TZ currentShelleyState
TZ pastByronState $ TS pastShelleyState $ TZ currentAllegraState
...

These are some intuitions on how the Telescope operations behave for this type:

extend

Suppose we have a telescope containing the ledger state. The "how to extend" argument would take, say, the final Byron state to the initial Shelley state; and "where to extend from" argument would indicate when we want to extend: when the current slot number has gone past the end of the Byron era.

retract

Suppose we have a telescope containing the consensus state. When we rewind the consensus state, we might cross a hard fork transition point. So we first retract the telescope to the era containing the slot number that we want to rewind to, and only then call rewindChainDepState on that era. Of course, retraction may fail (we might not have past consensus state to rewind to anymore); this failure would require a choice for a particular monad m.

align

Suppose we have one telescope containing the already-ticked ledger state, and another telescope containing the consensus state. Since the ledger state has already been ticked, it might have been advanced to the next era. If this happens, we should then align the consensus state with the ledger state, moving it also to the next era, before we can do the consensus header validation check. Note that in this particular example, the ledger state will always be ahead of the consensus state, never behind; alignExtend can be used in this case.

Constructors

HardForkState 

Fields

Instances

Instances details
HAp HardForkState Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.State.Instances

Methods

hap ∷ ∀ (f ∷ TypeType) (g ∷ TypeType) (xs ∷ [Type]). Prod HardForkState (f -.-> g) xs → HardForkState f xs → HardForkState g xs Source #

HCollapse HardForkState Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.State.Instances

Methods

hcollapse ∷ ∀ (xs ∷ [Type]) a. SListIN HardForkState xs ⇒ HardForkState (K a ∷ TypeType) xs → CollapseTo HardForkState a Source #

HSequence HardForkState Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.State.Instances

Methods

hsequence' ∷ ∀ (xs ∷ [Type]) f (g ∷ TypeType). (SListIN HardForkState xs, Applicative f) ⇒ HardForkState (f :.: g) xs → f (HardForkState g xs) Source #

hctraverse' ∷ ∀ c (xs ∷ [Type]) g proxy f f'. (AllN HardForkState c xs, Applicative g) ⇒ proxy c → (∀ a. c a ⇒ f a → g (f' a)) → HardForkState f xs → g (HardForkState f' xs) Source #

htraverse' ∷ ∀ (xs ∷ [Type]) g f f'. (SListIN HardForkState xs, Applicative g) ⇒ (∀ a. f a → g (f' a)) → HardForkState f xs → g (HardForkState f' xs) Source #

HTrans HardForkState HardForkState Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.State.Instances

Methods

htrans ∷ ∀ c (xs ∷ [Type]) (ys ∷ [Type]) proxy f g. AllZipN (Prod HardForkState) c xs ys ⇒ proxy c → (∀ x y. c x y ⇒ f x → g y) → HardForkState f xs → HardForkState g ys Source #

hcoerce ∷ ∀ (f ∷ TypeType) (g ∷ TypeType) (xs ∷ [Type]) (ys ∷ [Type]). AllZipN (Prod HardForkState) (LiftedCoercible f g) xs ys ⇒ HardForkState f xs → HardForkState g ys Source #

SerialiseHFC xs ⇒ DecodeDisk (HardForkBlock xs) (HardForkChainDepState xs) Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.Serialisation.SerialiseDisk

SerialiseHFC xs ⇒ EncodeDisk (HardForkBlock xs) (HardForkChainDepState xs) Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.Serialisation.SerialiseDisk

Generic (HardForkState f xs) Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.State.Types

Associated Types

type Rep (HardForkState f xs) 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.State.Types

type Rep (HardForkState f xs) = D1 ('MetaData "HardForkState" "Ouroboros.Consensus.HardFork.Combinator.State.Types" "ouroboros-consensus-0.26.0.0-inplace" 'True) (C1 ('MetaCons "HardForkState" 'PrefixI 'True) (S1 ('MetaSel ('Just "getHardForkState") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Telescope (K PastTypeType) (Current f) xs))))

Methods

fromHardForkState f xs → Rep (HardForkState f xs) x #

toRep (HardForkState f xs) x → HardForkState f xs #

(All SingleEraBlock xs, ∀ blk. SingleEraBlock blk ⇒ Show (f blk)) ⇒ Show (HardForkState f xs) Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.State.Instances

Methods

showsPrecIntHardForkState f xs → ShowS #

showHardForkState f xs → String #

showList ∷ [HardForkState f xs] → ShowS #

(All SingleEraBlock xs, ∀ blk. SingleEraBlock blk ⇒ Eq (f blk)) ⇒ Eq (HardForkState f xs) Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.State.Instances

Methods

(==)HardForkState f xs → HardForkState f xs → Bool #

(/=)HardForkState f xs → HardForkState f xs → Bool #

(All SingleEraBlock xs, ∀ blk. SingleEraBlock blk ⇒ NoThunks (f blk)) ⇒ NoThunks (HardForkState f xs) Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.State.Instances

data Ticked (HardForkChainDepState xs ∷ Type) Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.Protocol

type Prod HardForkState Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.State.Instances

type Prod HardForkState = NP ∷ (TypeType) → [Type] → Type
type SListIN HardForkState Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.State.Instances

type CollapseTo HardForkState a Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.State.Instances

type AllN HardForkState (c ∷ TypeConstraint) Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.State.Instances

type AllN HardForkState (c ∷ TypeConstraint) = All c
type Same HardForkState Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.State.Instances

type Rep (HardForkState f xs) Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.State.Types

type Rep (HardForkState f xs) = D1 ('MetaData "HardForkState" "Ouroboros.Consensus.HardFork.Combinator.State.Types" "ouroboros-consensus-0.26.0.0-inplace" 'True) (C1 ('MetaCons "HardForkState" 'PrefixI 'True) (S1 ('MetaSel ('Just "getHardForkState") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Telescope (K PastTypeType) (Current f) xs))))

initHardForkState ∷ ∀ f x (xs ∷ [Type]). f x → HardForkState f (x ': xs) Source #