Safe Haskell | None |
---|---|
Language | Haskell2010 |
The hard fork combinator
Intended for unqualified import
Synopsis
- type Except e = ExceptT e Identity
-
data
EpochInfo
(m ::
Type
->
Type
) =
EpochInfo
{
- epochInfoSize_ :: HasCallStack => EpochNo -> m EpochSize
- epochInfoFirst_ :: HasCallStack => EpochNo -> m SlotNo
- epochInfoEpoch_ :: HasCallStack => SlotNo -> m EpochNo
- epochInfoSlotToRelativeTime_ :: HasCallStack => SlotNo -> m RelativeTime
- epochInfoSlotLength_ :: HasCallStack => SlotNo -> m SlotLength
-
newtype
LedgerEraInfo
blk =
LedgerEraInfo
{
- getLedgerEraInfo :: SingleEraInfo blk
-
data
SingleEraInfo
blk =
SingleEraInfo
{
- singleEraName :: ! Text
- data Product2 f g x y = Pair2 (f x y) (g x y)
- data family Ticked st :: Type
- data family NestedCtxt_ blk :: ( Type -> Type ) -> Type -> Type
- data family Header blk :: Type
- data family StorageConfig blk :: Type
- data family CodecConfig blk :: Type
- data family BlockConfig blk :: Type
- data family ConsensusConfig p :: Type
- data family LedgerState blk :: Type
- data family Validated x :: Type
- data family TxId tx :: Type
- data family GenTx blk :: Type
-
class
IsNonEmpty
xs
where
- isNonEmpty :: proxy xs -> ProofNonEmpty xs
-
data
ProofNonEmpty
:: [a] ->
Type
where
- ProofNonEmpty :: Proxy x -> Proxy xs -> ProofNonEmpty (x ': xs)
- data PastHorizonException
- newtype WrapPartialConsensusConfig blk = WrapPartialConsensusConfig { }
- newtype WrapPartialLedgerConfig blk = WrapPartialLedgerConfig { }
-
class
(
UpdateLedger
blk,
NoThunks
(
PartialLedgerConfig
blk)) =>
HasPartialLedgerConfig
blk
where
- type PartialLedgerConfig blk :: Type
- completeLedgerConfig :: proxy blk -> EpochInfo ( Except PastHorizonException ) -> PartialLedgerConfig blk -> LedgerConfig blk
-
class
(
ConsensusProtocol
p,
NoThunks
(
PartialConsensusConfig
p)) =>
HasPartialConsensusConfig
p
where
- type PartialConsensusConfig p :: Type
- completeConsensusConfig :: proxy p -> EpochInfo ( Except PastHorizonException ) -> PartialConsensusConfig p -> ConsensusConfig p
- toPartialConsensusConfig :: proxy p -> ConsensusConfig p -> PartialConsensusConfig p
- data InPairs (f :: k -> k -> Type ) (xs :: [k]) where
- data Telescope (g :: k -> Type ) (f :: k -> Type ) (xs :: [k]) where
- data Mismatch :: (k -> Type ) -> (k -> Type ) -> [k] -> Type where
-
newtype
HardForkState
f xs =
HardForkState
{
- getHardForkState :: Telescope ( K Past ) ( Current f) xs
-
data
EraTranslation
xs =
EraTranslation
{
- translateLedgerState :: InPairs ( RequiringBoth WrapLedgerConfig ( Translate LedgerState )) xs
- translateChainDepState :: InPairs ( RequiringBoth WrapConsensusConfig ( Translate WrapChainDepState )) xs
- translateLedgerView :: InPairs ( RequiringBoth WrapLedgerConfig ( TranslateForecast LedgerState WrapLedgerView )) xs
- trivialEraTranslation :: EraTranslation '[blk]
- type InjectValidatedTx = InjectPolyTx WrapValidatedGenTx
- type InjectTx = InjectPolyTx GenTx
- pattern InjectValidatedTx :: ( WrapValidatedGenTx blk -> Maybe ( WrapValidatedGenTx blk')) -> InjectValidatedTx blk blk'
- pattern InjectTx :: ( GenTx blk -> Maybe ( GenTx blk')) -> InjectTx blk blk'
- cannotInjectTx :: InjectTx blk blk'
- cannotInjectValidatedTx :: InjectValidatedTx blk blk'
- data family BlockQuery blk :: Type -> Type
-
newtype
EraIndex
xs =
EraIndex
{
- getEraIndex :: NS ( K ()) xs
-
class
(
LedgerSupportsProtocol
blk,
InspectLedger
blk,
LedgerSupportsMempool
blk,
HasTxId
(
GenTx
blk),
QueryLedger
blk,
HasPartialConsensusConfig
(
BlockProtocol
blk),
HasPartialLedgerConfig
blk,
ConvertRawHash
blk,
ReconstructNestedCtxt
Header
blk,
CommonProtocolParams
blk,
LedgerSupportsPeerSelection
blk,
ConfigSupportsNode
blk,
NodeInitStorage
blk,
BlockSupportsMetrics
blk,
Eq
(
GenTx
blk),
Eq
(
Validated
(
GenTx
blk)),
Eq
(
ApplyTxErr
blk),
Show
blk,
Show
(
Header
blk),
Show
(
CannotForge
blk),
Show
(
ForgeStateInfo
blk),
Show
(
ForgeStateUpdateError
blk)) =>
SingleEraBlock
blk
where
- singleEraTransition :: PartialLedgerConfig blk -> EraParams -> Bound -> LedgerState blk -> Maybe EpochNo
- singleEraInfo :: proxy blk -> SingleEraInfo blk
- proxySingle :: Proxy SingleEraBlock
- singleEraTransition' :: SingleEraBlock blk => WrapPartialLedgerConfig blk -> EraParams -> Bound -> LedgerState blk -> Maybe EpochNo
- eraIndexEmpty :: EraIndex '[] -> Void
- eraIndexFromNS :: SListI xs => NS f xs -> EraIndex xs
- eraIndexFromIndex :: Index xs blk -> EraIndex xs
- eraIndexZero :: EraIndex (x ': xs)
- eraIndexSucc :: EraIndex xs -> EraIndex (x ': xs)
- eraIndexToInt :: EraIndex xs -> Int
- initHardForkState :: f x -> HardForkState f (x ': xs)
-
data
WithBlockNo
(f :: k ->
Type
) (a :: k) =
WithBlockNo
{
- getBlockNo :: BlockNo
- dropBlockNo :: f a
-
data
AcrossEraSelection
::
Type
->
Type
->
Type
where
- CompareBlockNo :: AcrossEraSelection x y
- SelectSameProtocol :: BlockProtocol x ~ BlockProtocol y => AcrossEraSelection x y
- CustomChainSel :: ( SelectView ( BlockProtocol x) -> SelectView ( BlockProtocol y) -> Ordering ) -> AcrossEraSelection x y
- acrossEraSelection :: All SingleEraBlock xs => Tails AcrossEraSelection xs -> WithBlockNo ( NS WrapSelectView ) xs -> WithBlockNo ( NS WrapSelectView ) xs -> Ordering
- mapWithBlockNo :: (f x -> g y) -> WithBlockNo f x -> WithBlockNo g y
-
class
SingleEraBlock
blk =>
NoHardForks
blk
where
- getEraParams :: TopLevelConfig blk -> EraParams
- toPartialLedgerConfig :: proxy blk -> LedgerConfig blk -> PartialLedgerConfig blk
- noHardForksEpochInfo :: ( Monad m, NoHardForks blk) => TopLevelConfig blk -> EpochInfo m
- class ( All SingleEraBlock xs, Typeable xs, IsNonEmpty xs) => CanHardFork xs where
- type HardForkLedgerView = HardForkLedgerView_ WrapLedgerView
-
data
HardForkLedgerView_
f xs =
HardForkLedgerView
{
- hardForkLedgerViewTransition :: ! TransitionInfo
- hardForkLedgerViewPerEra :: !( HardForkState f xs)
- newtype MismatchEraInfo xs = MismatchEraInfo { }
- newtype OneEraHash (xs :: [k]) = OneEraHash { }
-
newtype
OneEraTipInfo
xs =
OneEraTipInfo
{
- getOneEraTipInfo :: NS WrapTipInfo xs
-
newtype
OneEraHeader
xs =
OneEraHeader
{
- getOneEraHeader :: NS Header xs
-
newtype
OneEraGenTxId
xs =
OneEraGenTxId
{
- getOneEraGenTxId :: NS WrapGenTxId xs
-
newtype
OneEraGenTx
xs =
OneEraGenTx
{
- getOneEraGenTx :: NS GenTx xs
-
newtype
OneEraBlock
xs =
OneEraBlock
{
- getOneEraBlock :: NS I xs
- newtype OneEraApplyTxErr xs = OneEraApplyTxErr { }
- newtype PerEraStorageConfig xs = PerEraStorageConfig { }
- newtype PerEraLedgerConfig xs = PerEraLedgerConfig { }
- newtype PerEraConsensusConfig xs = PerEraConsensusConfig { }
- newtype PerEraCodecConfig xs = PerEraCodecConfig { }
- newtype PerEraBlockConfig xs = PerEraBlockConfig { }
-
data
HardForkLedgerConfig
xs =
HardForkLedgerConfig
{
- hardForkLedgerConfigShape :: !( Shape xs)
- hardForkLedgerConfigPerEra :: !( PerEraLedgerConfig xs)
-
newtype
HardForkBlock
xs =
HardForkBlock
{
- getHardForkBlock :: OneEraBlock xs
- data HardForkProtocol (xs :: [ Type ])
- completeLedgerConfig' :: forall blk. HasPartialLedgerConfig blk => EpochInfo ( Except PastHorizonException ) -> WrapPartialLedgerConfig blk -> LedgerConfig blk
- completeLedgerConfig'' :: forall blk. HasPartialLedgerConfig blk => EpochInfo ( Except PastHorizonException ) -> WrapPartialLedgerConfig blk -> WrapLedgerConfig blk
- completeConsensusConfig' :: forall blk. HasPartialConsensusConfig ( BlockProtocol blk) => EpochInfo ( Except PastHorizonException ) -> WrapPartialConsensusConfig blk -> ConsensusConfig ( BlockProtocol blk)
- completeConsensusConfig'' :: forall blk. HasPartialConsensusConfig ( BlockProtocol blk) => EpochInfo ( Except PastHorizonException ) -> WrapPartialConsensusConfig blk -> WrapConsensusConfig blk
- distribLedgerConfig :: CanHardFork xs => EpochInfo ( Except PastHorizonException ) -> LedgerConfig ( HardForkBlock xs) -> NP WrapLedgerConfig xs
- distribTopLevelConfig :: All SingleEraBlock xs => EpochInfo ( Except PastHorizonException ) -> TopLevelConfig ( HardForkBlock xs) -> NP TopLevelConfig xs
- distribAnnTip :: SListI xs => AnnTip ( HardForkBlock xs) -> NS AnnTip xs
- undistribAnnTip :: SListI xs => NS AnnTip xs -> AnnTip ( HardForkBlock xs)
- data HardForkValidationErr xs
- type HardForkCanBeLeader xs = SomeErasCanBeLeader xs
- type HardForkIsLeader xs = OneEraIsLeader xs
- type HardForkChainDepState xs = HardForkState WrapChainDepState xs
-
data
HardForkLedgerUpdate
xs
- = HardForkUpdateInEra ( OneEraLedgerUpdate xs)
- | HardForkUpdateTransitionConfirmed ( EraIndex xs) ( EraIndex xs) EpochNo
- | HardForkUpdateTransitionDone ( EraIndex xs) ( EraIndex xs) EpochNo
- | HardForkUpdateTransitionRolledBack ( EraIndex xs) ( EraIndex xs)
-
data
HardForkLedgerWarning
xs
- = HardForkWarningInEra ( OneEraLedgerWarning xs)
- | HardForkWarningTransitionMismatch ( EraIndex xs) EraParams EpochNo
- | HardForkWarningTransitionInFinalEra ( EraIndex xs) EpochNo
- | HardForkWarningTransitionUnconfirmed ( EraIndex xs)
- | HardForkWarningTransitionReconfirmed ( EraIndex xs) ( EraIndex xs) EpochNo EpochNo
-
data
AnnForecast
state view blk =
AnnForecast
{
- annForecast :: Forecast (view blk)
- annForecastState :: state blk
- annForecastTip :: WithOrigin SlotNo
- annForecastEnd :: Maybe Bound
- data HardForkEnvelopeErr xs
- data HardForkLedgerError xs
- mkHardForkForecast :: forall state view xs. SListI xs => InPairs ( TranslateForecast state view) xs -> HardForkState ( AnnForecast state view) xs -> Forecast ( HardForkLedgerView_ view xs)
-
data
HardForkApplyTxErr
xs
- = HardForkApplyTxErrFromEra !( OneEraApplyTxErr xs)
- | HardForkApplyTxErrWrongEra !( MismatchEraInfo xs)
- hardForkApplyTxErrToEither :: HardForkApplyTxErr xs -> Either ( MismatchEraInfo xs) ( OneEraApplyTxErr xs)
- hardForkApplyTxErrFromEither :: Either ( MismatchEraInfo xs) ( OneEraApplyTxErr xs) -> HardForkApplyTxErr xs
-
data
QueryHardFork
xs result
where
- GetInterpreter :: QueryHardFork xs ( Interpreter xs)
- GetCurrentEra :: QueryHardFork xs ( EraIndex xs)
-
data
QueryAnytime
result
where
- GetEraStart :: QueryAnytime ( Maybe Bound )
-
data
QueryIfCurrent
:: [
Type
] ->
Type
->
Type
where
- QZ :: BlockQuery x result -> QueryIfCurrent (x ': xs) result
- QS :: QueryIfCurrent xs result -> QueryIfCurrent (x ': xs) result
- type HardForkQueryResult xs = Either ( MismatchEraInfo xs)
- getHardForkQuery :: BlockQuery ( HardForkBlock xs) result -> ( forall result'. (result :~: HardForkQueryResult xs result') -> QueryIfCurrent xs result' -> r) -> ( forall x' xs'. (xs :~: (x' ': xs')) -> ProofNonEmpty xs' -> QueryAnytime result -> EraIndex xs -> r) -> ( forall x' xs'. (xs :~: (x' ': xs')) -> ProofNonEmpty xs' -> QueryHardFork xs result -> r) -> r
- encodeQueryAnytimeResult :: QueryAnytime result -> result -> Encoding
- decodeQueryAnytimeResult :: QueryAnytime result -> forall s. Decoder s result
- encodeQueryHardForkResult :: SListI xs => QueryHardFork xs result -> result -> Encoding
- decodeQueryHardForkResult :: SListI xs => QueryHardFork xs result -> forall s. Decoder s result
- hardForkQueryInfo :: All SingleEraBlock xs => QueryIfCurrent xs result -> NS SingleEraInfo xs
-
data
HardForkForgeStateInfo
xs
where
- CurrentEraLacksBlockForging :: EraIndex (x ': (y ': xs)) -> HardForkForgeStateInfo (x ': (y ': xs))
- CurrentEraForgeStateUpdated :: OneEraForgeStateInfo xs -> HardForkForgeStateInfo xs
- hardForkBlockForging :: forall m xs. ( CanHardFork xs, Monad m) => Text -> NonEmptyOptNP ( BlockForging m) xs -> BlockForging m ( HardForkBlock xs)
Documentation
data EpochInfo (m :: Type -> Type ) Source #
Information about epochs
Different epochs may have different sizes and different slot lengths. This
information is encapsulated by
EpochInfo
. It is parameterized over a monad
m
because the information about how long each epoch is may depend on
information derived from the blockchain itself. It ultimately requires acess
to state, and so either uses the monad for that or uses the monad to reify
failure due to cached state information being too stale for the current
query.
EpochInfo | |
|
newtype LedgerEraInfo blk Source #
Additional newtype wrapper around
SingleEraInfo
This is primarily useful for use in error messages: it marks which era info came from the ledger, and which came from a tx block header/etc.
Instances
Eq ( LedgerEraInfo blk) Source # | |
Defined in Ouroboros.Consensus.HardFork.Combinator.Info (==) :: LedgerEraInfo blk -> LedgerEraInfo blk -> Bool Source # (/=) :: LedgerEraInfo blk -> LedgerEraInfo blk -> Bool Source # |
|
Show ( LedgerEraInfo blk) Source # | |
Defined in Ouroboros.Consensus.HardFork.Combinator.Info |
|
NoThunks ( LedgerEraInfo blk) Source # | |
Defined in Ouroboros.Consensus.HardFork.Combinator.Info |
|
Serialise ( LedgerEraInfo blk) Source # | |
Defined in Ouroboros.Consensus.HardFork.Combinator.Info encode :: LedgerEraInfo blk -> Encoding Source # decode :: Decoder s ( LedgerEraInfo blk) Source # encodeList :: [ LedgerEraInfo blk] -> Encoding Source # decodeList :: Decoder s [ LedgerEraInfo blk] Source # |
data SingleEraInfo blk Source #
Information about an era (mostly for type errors)
Instances
data Product2 f g x y Source #
Pair2 (f x y) (g x y) |
Instances
( Eq (f x y), Eq (g x y)) => Eq ( Product2 f g x y) Source # | |
( Show (f x y), Show (g x y)) => Show ( Product2 f g x y) Source # | |
Generic ( Product2 f g x y) Source # | |
type Rep ( Product2 f g x y) Source # | |
Defined in Ouroboros.Consensus.HardFork.Combinator.Util.Functors
type
Rep
(
Product2
f g x y) =
D1
('
MetaData
"Product2" "Ouroboros.Consensus.HardFork.Combinator.Util.Functors" "ouroboros-consensus-0.1.0.1-DT4Cvwf63DZKctsEvaJqCU" '
False
) (
C1
('
MetaCons
"Pair2" '
PrefixI
'
False
) (
S1
('
MetaSel
('
Nothing
::
Maybe
Symbol
) '
NoSourceUnpackedness
'
NoSourceStrictness
'
DecidedLazy
) (
Rec0
(f x y))
:*:
S1
('
MetaSel
('
Nothing
::
Maybe
Symbol
) '
NoSourceUnpackedness
'
NoSourceStrictness
'
DecidedLazy
) (
Rec0
(g x y))))
|
data family Ticked st :: Type Source #
" Ticked " piece of state (
LedgerState
,
LedgerView
,
ChainIndepState
)
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 (or forecast).
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 NestedCtxt_ blk :: ( Type -> Type ) -> Type -> Type Source #
Context identifying what kind of block we have
In almost all places we will use
NestedCtxt
rather than
NestedCtxt_
.
Instances
data family Header blk :: Type Source #
Instances
data family StorageConfig blk :: Type Source #
Config needed for the
NodeInitStorage
class. Defined here to
avoid circular dependencies.
Instances
data family CodecConfig blk :: Type 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
data family BlockConfig blk :: Type Source #
Static configuration required to work with this type of blocks
Instances
Isomorphic BlockConfig Source # | |
Defined in Ouroboros.Consensus.HardFork.Combinator.Embed.Unary project :: NoHardForks blk => BlockConfig ( HardForkBlock '[blk]) -> BlockConfig blk Source # inject :: NoHardForks blk => BlockConfig blk -> BlockConfig ( HardForkBlock '[blk]) Source # |
|
NoThunks ( BlockConfig ( DualBlock m a)) Source # | |
CanHardFork xs => NoThunks ( BlockConfig ( HardForkBlock xs)) Source # | |
Defined in Ouroboros.Consensus.HardFork.Combinator.Basics noThunks :: Context -> BlockConfig ( HardForkBlock xs) -> IO ( Maybe ThunkInfo ) Source # wNoThunks :: Context -> BlockConfig ( HardForkBlock xs) -> IO ( Maybe ThunkInfo ) Source # showTypeOf :: Proxy ( BlockConfig ( HardForkBlock xs)) -> String Source # |
|
newtype BlockConfig ( HardForkBlock xs) Source # | |
|
|
data BlockConfig ( DualBlock m a) Source # | |
Defined in Ouroboros.Consensus.Ledger.Dual |
data family ConsensusConfig p :: Type 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
data family LedgerState blk :: Type Source #
Ledger state associated with a block
Instances
data family Validated x :: Type 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 TxId tx :: Type Source #
A generalized transaction,
GenTx
, identifier.
Instances
data family GenTx blk :: Type 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
class IsNonEmpty xs where Source #
isNonEmpty :: proxy xs -> ProofNonEmpty xs Source #
Instances
IsNonEmpty (x ': xs :: [a]) Source # | |
Defined in Ouroboros.Consensus.Util.SOP isNonEmpty :: proxy (x ': xs) -> ProofNonEmpty (x ': xs) Source # |
data ProofNonEmpty :: [a] -> Type where Source #
ProofNonEmpty :: Proxy x -> Proxy xs -> ProofNonEmpty (x ': xs) |
data PastHorizonException Source #
We tried to convert something that is past the horizon
That is, we tried to convert something that is past the point in time beyond which we lack information due to uncertainty about the next hard fork.
Instances
newtype WrapPartialConsensusConfig blk Source #
Instances
NoThunks ( PartialConsensusConfig ( BlockProtocol blk)) => NoThunks ( WrapPartialConsensusConfig blk) Source # | |
newtype WrapPartialLedgerConfig blk Source #
Instances
NoThunks ( PartialLedgerConfig blk) => NoThunks ( WrapPartialLedgerConfig blk) Source # | |
class ( UpdateLedger blk, NoThunks ( PartialLedgerConfig blk)) => HasPartialLedgerConfig blk where Source #
Partial ledger config
Nothing
type PartialLedgerConfig blk :: Type Source #
type PartialLedgerConfig blk = LedgerConfig blk
completeLedgerConfig :: proxy blk -> EpochInfo ( Except PastHorizonException ) -> PartialLedgerConfig blk -> LedgerConfig blk Source #
Construct
LedgerConfig
from
PartialLedgerCfg
NOTE: The
EpochInfo
provided will have limited range, any attempt to
look past its horizon will result in a pure
PastHorizonException
.
The horizon is determined by the tip of the ledger
state
(not view)
from which the
EpochInfo
is derived.
default completeLedgerConfig :: PartialLedgerConfig blk ~ LedgerConfig blk => proxy blk -> EpochInfo ( Except PastHorizonException ) -> PartialLedgerConfig blk -> LedgerConfig blk Source #
class ( ConsensusProtocol p, NoThunks ( PartialConsensusConfig p)) => HasPartialConsensusConfig p where Source #
Partial consensus config
Nothing
type PartialConsensusConfig p :: Type Source #
type PartialConsensusConfig p = ConsensusConfig p
completeConsensusConfig :: proxy p -> EpochInfo ( Except PastHorizonException ) -> PartialConsensusConfig p -> ConsensusConfig p Source #
Construct
ConsensusConfig
from
PartialConsensusConfig
See comments for
completeLedgerConfig
for some details about the
EpochInfo
.
default completeConsensusConfig :: PartialConsensusConfig p ~ ConsensusConfig p => proxy p -> EpochInfo ( Except PastHorizonException ) -> PartialConsensusConfig p -> ConsensusConfig p Source #
toPartialConsensusConfig :: proxy p -> ConsensusConfig p -> PartialConsensusConfig p Source #
Construct partial consensus config from full consensus config
NOTE: This is basically just losing
EpochInfo
, but that is constant
anyway when we are dealing with a single era.
default toPartialConsensusConfig :: PartialConsensusConfig p ~ ConsensusConfig p => proxy p -> ConsensusConfig p -> PartialConsensusConfig p Source #
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
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.
Blockchain intuition: think of
g
as representing some kind of past state,
and
f
some kind of current state. Then depending on how many hard fork
transitions we have had, we might either have, say
TZ currentByronState TS pastByronState $ TZ currentShelleyState TS pastByronState $ TS pastShelleyState $ TZ currentGoguenState
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.
TZ :: !(f x) -> Telescope g f (x ': xs) | |
TS :: !(g x) -> !( Telescope g f xs) -> Telescope g f (x ': xs) |
Instances
HAp ( Telescope g :: (k -> Type ) -> [k] -> Type ) Source # | |
HTraverse_ ( Telescope g :: (k -> Type ) -> [k] -> Type ) Source # | |
Defined in Ouroboros.Consensus.HardFork.Combinator.Util.Telescope hctraverse_ :: forall c (xs :: l) g0 proxy f. ( AllN ( Telescope g) c xs, Applicative g0) => proxy c -> ( forall (a :: k0). c a => f a -> g0 ()) -> Telescope g f xs -> g0 () Source # htraverse_ :: forall (xs :: l) g0 f. ( SListIN ( Telescope g) xs, Applicative g0) => ( forall (a :: k0). f a -> g0 ()) -> Telescope g f xs -> g0 () Source # |
|
HSequence ( Telescope g :: (k -> Type ) -> [k] -> Type ) Source # | |
Defined in Ouroboros.Consensus.HardFork.Combinator.Util.Telescope hsequence' :: forall (xs :: l) f (g0 :: k0 -> Type ). ( SListIN ( Telescope g) xs, Applicative f) => Telescope g (f :.: g0) xs -> f ( Telescope g g0 xs) Source # hctraverse' :: forall c (xs :: l) g0 proxy f f'. ( AllN ( Telescope g) c xs, Applicative g0) => proxy c -> ( forall (a :: k0). c a => f a -> g0 (f' a)) -> Telescope g f xs -> g0 ( Telescope g f' xs) Source # htraverse' :: forall (xs :: l) g0 f f'. ( SListIN ( Telescope g) xs, Applicative g0) => ( forall (a :: k0). f a -> g0 (f' a)) -> Telescope g f xs -> g0 ( Telescope g f' xs) Source # |
|
( All ( Compose Eq g) xs, All ( Compose Eq f) xs) => Eq ( Telescope g f xs) Source # | |
( 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) Source # | |
Defined in Ouroboros.Consensus.HardFork.Combinator.Util.Telescope compare :: Telescope g f xs -> Telescope g f xs -> Ordering Source # (<) :: Telescope g f xs -> Telescope g f xs -> Bool Source # (<=) :: Telescope g f xs -> Telescope g f xs -> Bool Source # (>) :: Telescope g f xs -> Telescope g f xs -> Bool Source # (>=) :: Telescope g f xs -> Telescope g f xs -> Bool Source # max :: Telescope g f xs -> Telescope g f xs -> Telescope g f xs Source # min :: Telescope g f xs -> Telescope g f xs -> Telescope g f xs Source # |
|
( All ( Compose Show g) xs, All ( Compose Show f) xs) => Show ( Telescope g f xs) Source # | |
( All ( Compose NoThunks g) xs, All ( Compose NoThunks f) xs) => NoThunks ( Telescope g f xs) Source # | |
type Prod ( Telescope g :: (k -> Type ) -> [k] -> Type ) Source # | |
type SListIN ( Telescope g :: (k -> Type ) -> [k] -> Type ) Source # | |
type AllN ( Telescope g :: (k -> Type ) -> [k] -> Type ) (c :: k -> Constraint ) Source # | |
data Mismatch :: (k -> Type ) -> (k -> Type ) -> [k] -> Type where Source #
ML :: f x -> NS g xs -> Mismatch f g (x ': xs) | |
MR :: NS f xs -> g x -> Mismatch f g (x ': xs) | |
MS :: Mismatch f g xs -> Mismatch f g (x ': xs) |
Instances
newtype HardForkState f xs Source #
Generic hard fork state
This is used both for the consensus state and the ledger state.
HardForkState | |
|
Instances
data EraTranslation xs Source #
Instances
NoThunks ( EraTranslation xs) Source # | |
trivialEraTranslation :: EraTranslation '[blk] Source #
type InjectTx = InjectPolyTx GenTx Source #
pattern InjectValidatedTx :: ( WrapValidatedGenTx blk -> Maybe ( WrapValidatedGenTx blk')) -> InjectValidatedTx blk blk' Source #
InjectPolyTx
at type
InjectValidatedTx
pattern InjectTx :: ( GenTx blk -> Maybe ( GenTx blk')) -> InjectTx blk blk' Source #
InjectPolyTx
at type
InjectTx
cannotInjectTx :: InjectTx blk blk' Source #
cannotInjectPolyTx
at type
InjectTx
cannotInjectValidatedTx :: InjectValidatedTx blk blk' Source #
cannotInjectPolyTx
at type
InjectValidatedTx
data family BlockQuery blk :: Type -> Type Source #
Different queries supported by the ledger, indexed by the result type.
Instances
EraIndex | |
|
class ( LedgerSupportsProtocol blk, InspectLedger blk, LedgerSupportsMempool blk, HasTxId ( GenTx blk), QueryLedger blk, HasPartialConsensusConfig ( BlockProtocol blk), HasPartialLedgerConfig blk, ConvertRawHash blk, ReconstructNestedCtxt Header blk, CommonProtocolParams blk, LedgerSupportsPeerSelection blk, ConfigSupportsNode blk, NodeInitStorage blk, BlockSupportsMetrics blk, Eq ( GenTx blk), Eq ( Validated ( GenTx blk)), Eq ( ApplyTxErr blk), Show blk, Show ( Header blk), Show ( CannotForge blk), Show ( ForgeStateInfo blk), Show ( ForgeStateUpdateError blk)) => SingleEraBlock blk where Source #
Blocks from which we can assemble a hard fork
:: PartialLedgerConfig blk | |
-> EraParams |
Current era parameters |
-> Bound |
Start of this era |
-> LedgerState blk | |
-> Maybe EpochNo |
Era transition
This should only report the transition point once it is stable (rollback cannot affect it anymore).
Since we need this to construct the
HardForkSummary
(and hence the
EpochInfo
), this takes the
partial
config, not the full config
(or we'd end up with a catch-22).
singleEraInfo :: proxy blk -> SingleEraInfo blk Source #
Era information (for use in error messages)
singleEraTransition' :: SingleEraBlock blk => WrapPartialLedgerConfig blk -> EraParams -> Bound -> LedgerState blk -> Maybe EpochNo Source #
eraIndexEmpty :: EraIndex '[] -> Void Source #
eraIndexFromIndex :: Index xs blk -> EraIndex xs Source #
eraIndexZero :: EraIndex (x ': xs) Source #
eraIndexSucc :: EraIndex xs -> EraIndex (x ': xs) Source #
eraIndexToInt :: EraIndex xs -> Int Source #
initHardForkState :: f x -> HardForkState f (x ': xs) Source #
data WithBlockNo (f :: k -> Type ) (a :: k) Source #
WithBlockNo | |
|
Instances
data AcrossEraSelection :: Type -> Type -> Type where Source #
CompareBlockNo :: AcrossEraSelection x y |
Just compare block numbers This is a useful default when two eras run totally different consensus protocols, and we just want to choose the longer chain. |
SelectSameProtocol :: BlockProtocol x ~ BlockProtocol y => AcrossEraSelection x y |
Two eras running the same protocol
In this case, we can just call
NOTE: We require that the eras have the same
protocol
, not merely the
same
|
CustomChainSel :: ( SelectView ( BlockProtocol x) -> SelectView ( BlockProtocol y) -> Ordering ) -> AcrossEraSelection x y |
Custom chain selection This is the most general form, and allows to override chain selection for the specific combination of two eras with a custom comparison function. |
acrossEraSelection :: All SingleEraBlock xs => Tails AcrossEraSelection xs -> WithBlockNo ( NS WrapSelectView ) xs -> WithBlockNo ( NS WrapSelectView ) xs -> Ordering Source #
mapWithBlockNo :: (f x -> g y) -> WithBlockNo f x -> WithBlockNo g y Source #
class SingleEraBlock blk => NoHardForks blk where Source #
getEraParams :: TopLevelConfig blk -> EraParams Source #
Extract
EraParams
from the top-level config
The HFC itself does not care about this, as it must be given the full shape across all eras.
toPartialLedgerConfig :: proxy blk -> LedgerConfig blk -> PartialLedgerConfig blk Source #
Construct partial ledger config from full ledger config
See also
toPartialConsensusConfig
noHardForksEpochInfo :: ( Monad m, NoHardForks blk) => TopLevelConfig blk -> EpochInfo m Source #
class ( All SingleEraBlock xs, Typeable xs, IsNonEmpty xs) => CanHardFork xs where Source #
hardForkEraTranslation :: EraTranslation xs Source #
hardForkChainSel :: Tails AcrossEraSelection xs Source #
hardForkInjectTxs :: InPairs ( RequiringBoth WrapLedgerConfig ( Product2 InjectTx InjectValidatedTx )) xs Source #
Instances
SingleEraBlock blk => CanHardFork '[blk] Source # | |
Defined in Ouroboros.Consensus.HardFork.Combinator.Abstract.CanHardFork hardForkEraTranslation :: EraTranslation '[blk] Source # hardForkChainSel :: Tails AcrossEraSelection '[blk] Source # hardForkInjectTxs :: InPairs ( RequiringBoth WrapLedgerConfig ( Product2 InjectTx InjectValidatedTx )) '[blk] Source # |
data HardForkLedgerView_ f xs Source #
HardForkLedgerView | |
|
Instances
( SListI xs, Show ( Ticked a)) => Show ( Ticked ( HardForkLedgerView_ ( K a :: Type -> Type ) xs)) Source # | |
( SListI xs, Show a) => Show ( HardForkLedgerView_ ( K a :: Type -> Type ) xs) Source # | |
CanHardFork xs => Show ( HardForkLedgerView_ WrapLedgerView xs) Source # | |
Defined in Ouroboros.Consensus.HardFork.Combinator.Protocol.LedgerView showsPrec :: Int -> HardForkLedgerView_ WrapLedgerView xs -> ShowS Source # show :: HardForkLedgerView_ WrapLedgerView xs -> String Source # showList :: [ HardForkLedgerView_ WrapLedgerView xs] -> ShowS Source # |
|
data Ticked ( HardForkLedgerView_ f xs) Source # | |
Defined in Ouroboros.Consensus.HardFork.Combinator.Protocol.LedgerView |
newtype MismatchEraInfo xs Source #
MismatchEraInfo | |
|
Instances
All SingleEraBlock xs => Eq ( MismatchEraInfo xs) Source # | |
Defined in Ouroboros.Consensus.HardFork.Combinator.AcrossEras (==) :: MismatchEraInfo xs -> MismatchEraInfo xs -> Bool Source # (/=) :: MismatchEraInfo xs -> MismatchEraInfo xs -> Bool Source # |
|
All SingleEraBlock xs => Show ( MismatchEraInfo xs) Source # | |
CanHardFork xs => NoThunks ( MismatchEraInfo xs) Source # | |
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.
Instances
newtype OneEraTipInfo xs Source #
Instances
CanHardFork xs => Eq ( OneEraTipInfo xs) Source # | |
Defined in Ouroboros.Consensus.HardFork.Combinator.AcrossEras (==) :: OneEraTipInfo xs -> OneEraTipInfo xs -> Bool Source # (/=) :: OneEraTipInfo xs -> OneEraTipInfo xs -> Bool Source # |
|
CanHardFork xs => Show ( OneEraTipInfo xs) Source # | |
CanHardFork xs => NoThunks ( OneEraTipInfo xs) Source # | |
newtype OneEraHeader xs Source #
OneEraHeader | |
|
Instances
CanHardFork xs => Show ( OneEraHeader xs) Source # | |
CanHardFork xs => NoThunks ( OneEraHeader xs) Source # | |
newtype OneEraGenTxId xs Source #
Instances
CanHardFork xs => Eq ( OneEraGenTxId xs) Source # | |
Defined in Ouroboros.Consensus.HardFork.Combinator.AcrossEras (==) :: OneEraGenTxId xs -> OneEraGenTxId xs -> Bool Source # (/=) :: OneEraGenTxId xs -> OneEraGenTxId xs -> Bool Source # |
|
CanHardFork xs => Ord ( OneEraGenTxId xs) Source # | |
Defined in Ouroboros.Consensus.HardFork.Combinator.AcrossEras compare :: OneEraGenTxId xs -> OneEraGenTxId xs -> Ordering Source # (<) :: OneEraGenTxId xs -> OneEraGenTxId xs -> Bool Source # (<=) :: OneEraGenTxId xs -> OneEraGenTxId xs -> Bool Source # (>) :: OneEraGenTxId xs -> OneEraGenTxId xs -> Bool Source # (>=) :: OneEraGenTxId xs -> OneEraGenTxId xs -> Bool Source # max :: OneEraGenTxId xs -> OneEraGenTxId xs -> OneEraGenTxId xs Source # min :: OneEraGenTxId xs -> OneEraGenTxId xs -> OneEraGenTxId xs Source # |
|
CanHardFork xs => Show ( OneEraGenTxId xs) Source # | |
CanHardFork xs => NoThunks ( OneEraGenTxId xs) Source # | |
newtype OneEraGenTx xs Source #
OneEraGenTx | |
|
Instances
CanHardFork xs => Eq ( OneEraGenTx xs) Source # | |
Defined in Ouroboros.Consensus.HardFork.Combinator.AcrossEras (==) :: OneEraGenTx xs -> OneEraGenTx xs -> Bool Source # (/=) :: OneEraGenTx xs -> OneEraGenTx xs -> Bool Source # |
|
CanHardFork xs => Show ( OneEraGenTx xs) Source # | |
CanHardFork xs => NoThunks ( OneEraGenTx xs) Source # | |
newtype OneEraBlock xs Source #
OneEraBlock | |
|
Instances
CanHardFork xs => Show ( OneEraBlock xs) Source # | |
newtype OneEraApplyTxErr xs Source #
Instances
CanHardFork xs => Eq ( OneEraApplyTxErr xs) Source # | |
Defined in Ouroboros.Consensus.HardFork.Combinator.AcrossEras (==) :: OneEraApplyTxErr xs -> OneEraApplyTxErr xs -> Bool Source # (/=) :: OneEraApplyTxErr xs -> OneEraApplyTxErr xs -> Bool Source # |
|
CanHardFork xs => Show ( OneEraApplyTxErr xs) Source # | |
newtype PerEraStorageConfig xs Source #
Instances
CanHardFork xs => NoThunks ( PerEraStorageConfig xs) Source # | |
newtype PerEraLedgerConfig xs Source #
Instances
CanHardFork xs => NoThunks ( PerEraLedgerConfig xs) Source # | |
newtype PerEraConsensusConfig xs Source #
Instances
CanHardFork xs => NoThunks ( PerEraConsensusConfig xs) Source # | |
newtype PerEraCodecConfig xs Source #
Instances
CanHardFork xs => NoThunks ( PerEraCodecConfig xs) Source # | |
newtype PerEraBlockConfig xs Source #
Instances
CanHardFork xs => NoThunks ( PerEraBlockConfig xs) Source # | |
data HardForkLedgerConfig xs Source #
HardForkLedgerConfig | |
|
Instances
Generic ( HardForkLedgerConfig xs) Source # | |
Defined in Ouroboros.Consensus.HardFork.Combinator.Basics from :: HardForkLedgerConfig xs -> Rep ( HardForkLedgerConfig xs) x Source # to :: Rep ( HardForkLedgerConfig xs) x -> HardForkLedgerConfig xs Source # |
|
CanHardFork xs => NoThunks ( HardForkLedgerConfig xs) Source # | |
|
|
type Rep ( HardForkLedgerConfig xs) Source # | |
Defined in Ouroboros.Consensus.HardFork.Combinator.Basics
type
Rep
(
HardForkLedgerConfig
xs) =
D1
('
MetaData
"HardForkLedgerConfig" "Ouroboros.Consensus.HardFork.Combinator.Basics" "ouroboros-consensus-0.1.0.1-DT4Cvwf63DZKctsEvaJqCU" '
False
) (
C1
('
MetaCons
"HardForkLedgerConfig" '
PrefixI
'
True
) (
S1
('
MetaSel
('
Just
"hardForkLedgerConfigShape") '
NoSourceUnpackedness
'
SourceStrict
'
DecidedStrict
) (
Rec0
(
Shape
xs))
:*:
S1
('
MetaSel
('
Just
"hardForkLedgerConfigPerEra") '
NoSourceUnpackedness
'
SourceStrict
'
DecidedStrict
) (
Rec0
(
PerEraLedgerConfig
xs))))
|
newtype HardForkBlock xs Source #
Instances
data HardForkProtocol (xs :: [ Type ]) Source #
Instances
completeLedgerConfig' :: forall blk. HasPartialLedgerConfig blk => EpochInfo ( Except PastHorizonException ) -> WrapPartialLedgerConfig blk -> LedgerConfig blk Source #
completeLedgerConfig'' :: forall blk. HasPartialLedgerConfig blk => EpochInfo ( Except PastHorizonException ) -> WrapPartialLedgerConfig blk -> WrapLedgerConfig blk Source #
completeConsensusConfig' :: forall blk. HasPartialConsensusConfig ( BlockProtocol blk) => EpochInfo ( Except PastHorizonException ) -> WrapPartialConsensusConfig blk -> ConsensusConfig ( BlockProtocol blk) Source #
completeConsensusConfig'' :: forall blk. HasPartialConsensusConfig ( BlockProtocol blk) => EpochInfo ( Except PastHorizonException ) -> WrapPartialConsensusConfig blk -> WrapConsensusConfig blk Source #
distribLedgerConfig :: CanHardFork xs => EpochInfo ( Except PastHorizonException ) -> LedgerConfig ( HardForkBlock xs) -> NP WrapLedgerConfig xs Source #
distribTopLevelConfig :: All SingleEraBlock xs => EpochInfo ( Except PastHorizonException ) -> TopLevelConfig ( HardForkBlock xs) -> NP TopLevelConfig xs Source #
distribAnnTip :: SListI xs => AnnTip ( HardForkBlock xs) -> NS AnnTip xs Source #
undistribAnnTip :: SListI xs => NS AnnTip xs -> AnnTip ( HardForkBlock xs) Source #
data HardForkValidationErr xs Source #
HardForkValidationErrFromEra ( OneEraValidationErr xs) |
Validation error from one of the eras |
HardForkValidationErrWrongEra ( MismatchEraInfo xs) |
We tried to apply a block from the wrong era |
Instances
type HardForkCanBeLeader xs = SomeErasCanBeLeader xs Source #
We have one or more
BlockForging
s, and thus
CanBeLeader
proofs, for
each era in which we can forge blocks.
type HardForkIsLeader xs = OneEraIsLeader xs Source #
We are a leader if we have a proof from one of the eras
type HardForkChainDepState xs = HardForkState WrapChainDepState xs Source #
data HardForkLedgerUpdate xs Source #
HardForkUpdateInEra ( OneEraLedgerUpdate xs) | |
HardForkUpdateTransitionConfirmed ( EraIndex xs) ( EraIndex xs) EpochNo |
Hard fork transition got confirmed |
HardForkUpdateTransitionDone ( EraIndex xs) ( EraIndex xs) EpochNo |
Hard fork transition happened
We record the
|
HardForkUpdateTransitionRolledBack ( EraIndex xs) ( EraIndex xs) |
The hard fork transition rolled back |
Instances
CanHardFork xs => Eq ( HardForkLedgerUpdate xs) Source # | |
Defined in Ouroboros.Consensus.HardFork.Combinator.Ledger (==) :: HardForkLedgerUpdate xs -> HardForkLedgerUpdate xs -> Bool Source # (/=) :: HardForkLedgerUpdate xs -> HardForkLedgerUpdate xs -> Bool Source # |
|
CanHardFork xs => Show ( HardForkLedgerUpdate xs) Source # | |
|
|
CanHardFork xs => Condense ( HardForkLedgerUpdate xs) Source # | |
Defined in Ouroboros.Consensus.HardFork.Combinator.Ledger condense :: HardForkLedgerUpdate xs -> String Source # |
data HardForkLedgerWarning xs Source #
HardForkWarningInEra ( OneEraLedgerWarning xs) |
Warning from the underlying era |
HardForkWarningTransitionMismatch ( EraIndex xs) EraParams EpochNo |
The transition to the next era does not match the
The
|
HardForkWarningTransitionInFinalEra ( EraIndex xs) EpochNo |
Transition in the final era The final era should never confirm any transitions. For clarity, we also record the index of that final era. |
HardForkWarningTransitionUnconfirmed ( EraIndex xs) |
An already-confirmed transition got un-confirmed |
HardForkWarningTransitionReconfirmed ( EraIndex xs) ( EraIndex xs) EpochNo EpochNo |
An already-confirmed transition got changed
We record the indices of the era we are transitioning from and to,
as well as the old and new
|
Instances
CanHardFork xs => Eq ( HardForkLedgerWarning xs) Source # | |
Defined in Ouroboros.Consensus.HardFork.Combinator.Ledger (==) :: HardForkLedgerWarning xs -> HardForkLedgerWarning xs -> Bool Source # (/=) :: HardForkLedgerWarning xs -> HardForkLedgerWarning xs -> Bool Source # |
|
CanHardFork xs => Show ( HardForkLedgerWarning xs) Source # | |
|
data AnnForecast state view blk Source #
Forecast annotated with details about the ledger it was derived from
AnnForecast | |
|
data HardForkEnvelopeErr xs Source #
HardForkEnvelopeErrFromEra ( OneEraEnvelopeErr xs) |
Validation error from one of the eras |
HardForkEnvelopeErrWrongEra ( MismatchEraInfo xs) |
We tried to apply a block from the wrong era |
Instances
data HardForkLedgerError xs Source #
HardForkLedgerErrorFromEra ( OneEraLedgerError xs) |
Validation error from one of the eras |
HardForkLedgerErrorWrongEra ( MismatchEraInfo xs) |
We tried to apply a block from the wrong era |
Instances
mkHardForkForecast :: forall state view xs. SListI xs => InPairs ( TranslateForecast state view) xs -> HardForkState ( AnnForecast state view) xs -> Forecast ( HardForkLedgerView_ view xs) Source #
Change a telescope of a forecast into a forecast of a telescope
data HardForkApplyTxErr xs Source #
HardForkApplyTxErrFromEra !( OneEraApplyTxErr xs) |
Validation error from one of the eras |
HardForkApplyTxErrWrongEra !( MismatchEraInfo xs) |
We tried to apply a block from the wrong era |
Instances
hardForkApplyTxErrToEither :: HardForkApplyTxErr xs -> Either ( MismatchEraInfo xs) ( OneEraApplyTxErr xs) Source #
hardForkApplyTxErrFromEither :: Either ( MismatchEraInfo xs) ( OneEraApplyTxErr xs) -> HardForkApplyTxErr xs Source #
data QueryHardFork xs result where Source #
GetInterpreter :: QueryHardFork xs ( Interpreter xs) | |
GetCurrentEra :: QueryHardFork xs ( EraIndex xs) |
Instances
All SingleEraBlock xs => ShowQuery ( QueryHardFork xs) Source # | |
Defined in Ouroboros.Consensus.HardFork.Combinator.Ledger.Query showResult :: QueryHardFork xs result -> result -> String Source # |
|
SameDepIndex ( QueryHardFork xs) Source # | |
Defined in Ouroboros.Consensus.HardFork.Combinator.Ledger.Query sameDepIndex :: QueryHardFork xs a -> QueryHardFork xs b -> Maybe (a :~: b) Source # |
|
Show ( QueryHardFork xs result) Source # | |
data QueryAnytime result where Source #
GetEraStart :: QueryAnytime ( Maybe Bound ) |
Instances
ShowQuery QueryAnytime Source # | |
Defined in Ouroboros.Consensus.HardFork.Combinator.Ledger.Query showResult :: QueryAnytime result -> result -> String Source # |
|
SameDepIndex QueryAnytime Source # | |
Defined in Ouroboros.Consensus.HardFork.Combinator.Ledger.Query sameDepIndex :: QueryAnytime a -> QueryAnytime b -> Maybe (a :~: b) Source # |
|
Show ( QueryAnytime result) Source # | |
Serialise ( Some QueryAnytime ) Source # | |
Defined in Ouroboros.Consensus.HardFork.Combinator.Ledger.Query encode :: Some QueryAnytime -> Encoding Source # decode :: Decoder s ( Some QueryAnytime ) Source # encodeList :: [ Some QueryAnytime ] -> Encoding Source # decodeList :: Decoder s [ Some QueryAnytime ] Source # |
data QueryIfCurrent :: [ Type ] -> Type -> Type where Source #
QZ :: BlockQuery x result -> QueryIfCurrent (x ': xs) result | |
QS :: QueryIfCurrent xs result -> QueryIfCurrent (x ': xs) result |
Instances
All SingleEraBlock xs => ShowQuery ( QueryIfCurrent xs) Source # | |
Defined in Ouroboros.Consensus.HardFork.Combinator.Ledger.Query showResult :: QueryIfCurrent xs result -> result -> String Source # |
|
All SingleEraBlock xs => SameDepIndex ( QueryIfCurrent xs) Source # | |
Defined in Ouroboros.Consensus.HardFork.Combinator.Ledger.Query sameDepIndex :: QueryIfCurrent xs a -> QueryIfCurrent xs b -> Maybe (a :~: b) Source # |
|
All SingleEraBlock xs => Show ( QueryIfCurrent xs result) Source # | |
type HardForkQueryResult xs = Either ( MismatchEraInfo xs) Source #
getHardForkQuery :: BlockQuery ( HardForkBlock xs) result -> ( forall result'. (result :~: HardForkQueryResult xs result') -> QueryIfCurrent xs result' -> r) -> ( forall x' xs'. (xs :~: (x' ': xs')) -> ProofNonEmpty xs' -> QueryAnytime result -> EraIndex xs -> r) -> ( forall x' xs'. (xs :~: (x' ': xs')) -> ProofNonEmpty xs' -> QueryHardFork xs result -> r) -> r Source #
encodeQueryAnytimeResult :: QueryAnytime result -> result -> Encoding Source #
decodeQueryAnytimeResult :: QueryAnytime result -> forall s. Decoder s result Source #
encodeQueryHardForkResult :: SListI xs => QueryHardFork xs result -> result -> Encoding Source #
decodeQueryHardForkResult :: SListI xs => QueryHardFork xs result -> forall s. Decoder s result Source #
hardForkQueryInfo :: All SingleEraBlock xs => QueryIfCurrent xs result -> NS SingleEraInfo xs Source #
data HardForkForgeStateInfo xs 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
CurrentEraLacksBlockForging :: EraIndex (x ': (y ': xs)) -> HardForkForgeStateInfo (x ': (y ': xs)) |
There is no
|
CurrentEraForgeStateUpdated :: OneEraForgeStateInfo xs -> HardForkForgeStateInfo xs |
The
|
Instances
CanHardFork xs => Show ( HardForkForgeStateInfo xs) Source # | |
|
:: forall m xs. ( CanHardFork xs, Monad m) | |
=> Text |
Used as the
|
-> NonEmptyOptNP ( BlockForging m) xs | |
-> BlockForging m ( HardForkBlock xs) |