Safe Haskell | None |
---|---|
Language | Haskell2010 |
Synopsis
- type CardanoEras c = ByronBlock ': CardanoShelleyEras c
- type CardanoShelleyEras c = '[ ShelleyBlock ( TPraos c) ( ShelleyEra c), ShelleyBlock ( TPraos c) ( AllegraEra c), ShelleyBlock ( TPraos c) ( MaryEra c), ShelleyBlock ( TPraos c) ( AlonzoEra c), ShelleyBlock ( Praos c) ( BabbageEra c)]
- module Ouroboros.Consensus.Shelley.Eras
- type CardanoBlock c = HardForkBlock ( CardanoEras c)
-
data
HardForkBlock
(xs :: [
Type
])
where
- pattern BlockAllegra :: ShelleyBlock ( TPraos c) ( AllegraEra c) -> CardanoBlock c
- pattern BlockAlonzo :: ShelleyBlock ( TPraos c) ( AlonzoEra c) -> CardanoBlock c
- pattern BlockByron :: ByronBlock -> CardanoBlock c
- pattern BlockMary :: ShelleyBlock ( TPraos c) ( MaryEra c) -> CardanoBlock c
- pattern BlockShelley :: ShelleyBlock ( TPraos c) ( ShelleyEra c) -> CardanoBlock c
- pattern BlockBabbage :: ShelleyBlock ( Praos c) ( BabbageEra c) -> CardanoBlock c
- type CardanoHeader c = Header ( CardanoBlock c)
- data family Header blk
- type CardanoApplyTxErr c = HardForkApplyTxErr ( CardanoEras c)
- type CardanoGenTx c = GenTx ( CardanoBlock c)
- type CardanoGenTxId c = GenTxId ( CardanoBlock c)
- data family GenTx blk
-
data
HardForkApplyTxErr
(xs :: [
Type
])
where
- pattern ApplyTxErrAllegra :: ApplyTxErr ( ShelleyBlock ( TPraos c) ( AllegraEra c)) -> CardanoApplyTxErr c
- pattern ApplyTxErrAlonzo :: ApplyTxErr ( ShelleyBlock ( TPraos c) ( AlonzoEra c)) -> CardanoApplyTxErr c
- pattern ApplyTxErrByron :: ApplyTxErr ByronBlock -> CardanoApplyTxErr c
- pattern ApplyTxErrMary :: ApplyTxErr ( ShelleyBlock ( TPraos c) ( MaryEra c)) -> CardanoApplyTxErr c
- pattern ApplyTxErrShelley :: ApplyTxErr ( ShelleyBlock ( TPraos c) ( ShelleyEra c)) -> CardanoApplyTxErr c
- pattern ApplyTxErrWrongEra :: EraMismatch -> CardanoApplyTxErr c
- pattern ApplyTxErrBabbage :: ApplyTxErr ( ShelleyBlock ( Praos c) ( BabbageEra c)) -> CardanoApplyTxErr c
- data family TxId tx
- type CardanoLedgerError c = HardForkLedgerError ( CardanoEras c)
-
data
HardForkLedgerError
(xs :: [
Type
])
where
- pattern LedgerErrorAllegra :: LedgerError ( ShelleyBlock ( TPraos c) ( AllegraEra c)) -> CardanoLedgerError c
- pattern LedgerErrorAlonzo :: LedgerError ( ShelleyBlock ( TPraos c) ( AlonzoEra c)) -> CardanoLedgerError c
- pattern LedgerErrorByron :: LedgerError ByronBlock -> CardanoLedgerError c
- pattern LedgerErrorMary :: LedgerError ( ShelleyBlock ( TPraos c) ( MaryEra c)) -> CardanoLedgerError c
- pattern LedgerErrorShelley :: LedgerError ( ShelleyBlock ( TPraos c) ( ShelleyEra c)) -> CardanoLedgerError c
- pattern LedgerErrorWrongEra :: EraMismatch -> CardanoLedgerError c
- pattern LedgerErrorBabbage :: LedgerError ( ShelleyBlock ( Praos c) ( BabbageEra c)) -> CardanoLedgerError c
- type CardanoOtherHeaderEnvelopeError c = HardForkEnvelopeErr ( CardanoEras c)
-
data
HardForkEnvelopeErr
(xs :: [
Type
])
where
- pattern OtherHeaderEnvelopeErrorAllegra :: OtherHeaderEnvelopeError ( ShelleyBlock ( TPraos c) ( AllegraEra c)) -> CardanoOtherHeaderEnvelopeError c
- pattern OtherHeaderEnvelopeErrorBabbage :: OtherHeaderEnvelopeError ( ShelleyBlock ( Praos c) ( BabbageEra c)) -> CardanoOtherHeaderEnvelopeError c
- pattern OtherHeaderEnvelopeErrorAlonzo :: OtherHeaderEnvelopeError ( ShelleyBlock ( TPraos c) ( AlonzoEra c)) -> CardanoOtherHeaderEnvelopeError c
- pattern OtherHeaderEnvelopeErrorByron :: OtherHeaderEnvelopeError ByronBlock -> CardanoOtherHeaderEnvelopeError c
- pattern OtherHeaderEnvelopeErrorMary :: OtherHeaderEnvelopeError ( ShelleyBlock ( TPraos c) ( MaryEra c)) -> CardanoOtherHeaderEnvelopeError c
- pattern OtherHeaderEnvelopeErrorShelley :: OtherHeaderEnvelopeError ( ShelleyBlock ( TPraos c) ( ShelleyEra c)) -> CardanoOtherHeaderEnvelopeError c
- pattern OtherHeaderEnvelopeErrorWrongEra :: EraMismatch -> CardanoOtherHeaderEnvelopeError c
- type CardanoTipInfo c = OneEraTipInfo ( CardanoEras c)
-
data
OneEraTipInfo
(xs :: [
Type
])
where
- pattern TipInfoAllegra :: TipInfo ( ShelleyBlock ( TPraos c) ( AllegraEra c)) -> CardanoTipInfo c
- pattern TipInfoAlonzo :: TipInfo ( ShelleyBlock ( TPraos c) ( AlonzoEra c)) -> CardanoTipInfo c
- pattern TipInfoByron :: TipInfo ByronBlock -> CardanoTipInfo c
- pattern TipInfoBabbage :: TipInfo ( ShelleyBlock ( Praos c) ( BabbageEra c)) -> CardanoTipInfo c
- pattern TipInfoMary :: TipInfo ( ShelleyBlock ( TPraos c) ( MaryEra c)) -> CardanoTipInfo c
- pattern TipInfoShelley :: TipInfo ( ShelleyBlock ( TPraos c) ( ShelleyEra c)) -> CardanoTipInfo c
- data family BlockQuery blk :: Type -> Type
- type CardanoQuery c = BlockQuery ( CardanoBlock c)
- type CardanoQueryResult c = HardForkQueryResult ( CardanoEras c)
-
data
Either
a b
where
- pattern QueryResultSuccess :: result -> CardanoQueryResult c result
- pattern QueryResultEraMismatch :: EraMismatch -> CardanoQueryResult c result
- type CardanoCodecConfig c = CodecConfig ( CardanoBlock c)
- data family CodecConfig blk
- data family BlockConfig blk
- type CardanoBlockConfig c = BlockConfig ( CardanoBlock c)
- type CardanoStorageConfig c = StorageConfig ( CardanoBlock c)
- data family StorageConfig blk
- type CardanoConsensusConfig c = ConsensusConfig ( HardForkProtocol ( CardanoEras c))
- data family ConsensusConfig p
- type CardanoLedgerConfig c = HardForkLedgerConfig ( CardanoEras c)
-
data
HardForkLedgerConfig
(xs :: [
Type
])
where
- pattern CardanoLedgerConfig :: PartialLedgerConfig ByronBlock -> PartialLedgerConfig ( ShelleyBlock ( TPraos c) ( ShelleyEra c)) -> PartialLedgerConfig ( ShelleyBlock ( TPraos c) ( AllegraEra c)) -> PartialLedgerConfig ( ShelleyBlock ( TPraos c) ( MaryEra c)) -> PartialLedgerConfig ( ShelleyBlock ( TPraos c) ( AlonzoEra c)) -> PartialLedgerConfig ( ShelleyBlock ( Praos c) ( BabbageEra c)) -> CardanoLedgerConfig c
- type CardanoLedgerState c = LedgerState ( CardanoBlock c)
- data family LedgerState blk
- type CardanoChainDepState c = HardForkChainDepState ( CardanoEras c)
-
data
HardForkState
(f ::
Type
->
Type
) (xs :: [
Type
])
where
- pattern ChainDepStateAllegra :: ChainDepState ( BlockProtocol ( ShelleyBlock ( TPraos c) ( AllegraEra c))) -> CardanoChainDepState c
- pattern ChainDepStateAlonzo :: ChainDepState ( BlockProtocol ( ShelleyBlock ( TPraos c) ( AlonzoEra c))) -> CardanoChainDepState c
- pattern ChainDepStateBabbage :: ChainDepState ( BlockProtocol ( ShelleyBlock ( Praos c) ( BabbageEra c))) -> CardanoChainDepState c
- pattern ChainDepStateByron :: ChainDepState ( BlockProtocol ByronBlock ) -> CardanoChainDepState c
- pattern ChainDepStateMary :: ChainDepState ( BlockProtocol ( ShelleyBlock ( TPraos c) ( MaryEra c))) -> CardanoChainDepState c
- pattern ChainDepStateShelley :: ChainDepState ( BlockProtocol ( ShelleyBlock ( TPraos c) ( ShelleyEra c))) -> CardanoChainDepState c
-
data
EraMismatch
=
EraMismatch
{
- ledgerEraName :: ! Text
- otherEraName :: ! Text
Eras
type CardanoEras c = ByronBlock ': CardanoShelleyEras c Source #
The eras in the Cardano blockchain.
We parameterise over the crypto used in the post-Byron eras:
c
.
TODO: parameterise ByronBlock over crypto too
type CardanoShelleyEras c = '[ ShelleyBlock ( TPraos c) ( ShelleyEra c), ShelleyBlock ( TPraos c) ( AllegraEra c), ShelleyBlock ( TPraos c) ( MaryEra c), ShelleyBlock ( TPraos c) ( AlonzoEra c), ShelleyBlock ( Praos c) ( BabbageEra c)] Source #
Block
type CardanoBlock c = HardForkBlock ( CardanoEras c) Source #
The Cardano block.
Thanks to the pattern synonyms, you can treat this as a sum type with
constructors
BlockByron
and
BlockShelley
.
f :: CardanoBlock c -> _ f (BlockByron b) = _ f (BlockShelley s) = _ f (BlockAllegra a) = _ f (BlockMary m) = _ f (BlockAlonzo m) = _
data HardForkBlock (xs :: [ Type ]) where Source #
pattern BlockAllegra :: ShelleyBlock ( TPraos c) ( AllegraEra c) -> CardanoBlock c | |
pattern BlockAlonzo :: ShelleyBlock ( TPraos c) ( AlonzoEra c) -> CardanoBlock c | |
pattern BlockByron :: ByronBlock -> CardanoBlock c | |
pattern BlockMary :: ShelleyBlock ( TPraos c) ( MaryEra c) -> CardanoBlock c | |
pattern BlockShelley :: ShelleyBlock ( TPraos c) ( ShelleyEra c) -> CardanoBlock c | |
pattern BlockBabbage :: ShelleyBlock ( Praos c) ( BabbageEra c) -> CardanoBlock c |
Instances
Headers
type CardanoHeader c = Header ( CardanoBlock c) Source #
The Cardano header.
data family Header blk Source #
Instances
Generalised transactions
type CardanoApplyTxErr c = HardForkApplyTxErr ( CardanoEras c) Source #
An error resulting from applying a
CardanoGenTx
to the ledger.
Thanks to the pattern synonyms, you can treat this as a sum type with
constructors
ApplyTxByronErr
,
ApplyTxErrShelley
, and
ApplyTxErrWrongEra
.
toText :: CardanoApplyTxErr c -> Text toText (ApplyTxErrByron b) = byronApplyTxErrToText b toText (ApplyTxErrShelley s) = shelleyApplyTxErrToText s toText (ApplyTxErrAllegra a) = allegraApplyTxErrToText a toText (ApplyTxErrMary m) = maryApplyTxErrToText m toText (ApplyTxErrWrongEra eraMismatch) = "Transaction from the " <> otherEraName eraMismatch <> " era applied to a ledger from the " <> ledgerEraName eraMismatch <> " era"
type CardanoGenTx c = GenTx ( CardanoBlock c) Source #
The Cardano transaction.
type CardanoGenTxId c = GenTxId ( CardanoBlock c) Source #
The ID of a Cardano transaction.
data family GenTx blk Source #
Generalized transaction
The mempool (and, accordingly, blocks) consist of "generalized transactions"; this could be "proper" transactions (transferring funds) but also other kinds of things such as update proposals, delegations, etc.
Instances
data HardForkApplyTxErr (xs :: [ Type ]) where Source #
pattern ApplyTxErrAllegra :: ApplyTxErr ( ShelleyBlock ( TPraos c) ( AllegraEra c)) -> CardanoApplyTxErr c | |
pattern ApplyTxErrAlonzo :: ApplyTxErr ( ShelleyBlock ( TPraos c) ( AlonzoEra c)) -> CardanoApplyTxErr c | |
pattern ApplyTxErrByron :: ApplyTxErr ByronBlock -> CardanoApplyTxErr c | |
pattern ApplyTxErrMary :: ApplyTxErr ( ShelleyBlock ( TPraos c) ( MaryEra c)) -> CardanoApplyTxErr c | |
pattern ApplyTxErrShelley :: ApplyTxErr ( ShelleyBlock ( TPraos c) ( ShelleyEra c)) -> CardanoApplyTxErr c | |
pattern ApplyTxErrWrongEra :: EraMismatch -> CardanoApplyTxErr c | |
pattern ApplyTxErrBabbage :: ApplyTxErr ( ShelleyBlock ( Praos c) ( BabbageEra c)) -> CardanoApplyTxErr c |
Instances
A generalized transaction,
GenTx
, identifier.
Instances
type Rep ( TxId ( GenTx ( HardForkBlock xs))) | |
Defined in Ouroboros.Consensus.HardFork.Combinator.Mempool
type
Rep
(
TxId
(
GenTx
(
HardForkBlock
xs))) =
D1
('
MetaData
"TxId" "Ouroboros.Consensus.HardFork.Combinator.Mempool" "ouroboros-consensus-0.1.0.1-DT4Cvwf63DZKctsEvaJqCU" '
True
) (
C1
('
MetaCons
"HardForkGenTxId" '
PrefixI
'
True
) (
S1
('
MetaSel
('
Just
"getHardForkGenTxId") '
NoSourceUnpackedness
'
NoSourceStrictness
'
DecidedLazy
) (
Rec0
(
OneEraGenTxId
xs))))
|
|
newtype TxId ( GenTx ( HardForkBlock xs)) | |
|
|
data TxId ( GenTx ByronBlock ) | |
Defined in Ouroboros.Consensus.Byron.Ledger.Mempool
data
TxId
(
GenTx
ByronBlock
)
|
|
newtype TxId ( GenTx ( ShelleyBlock proto era)) | |
Defined in Ouroboros.Consensus.Shelley.Ledger.Mempool |
LedgerError
type CardanoLedgerError c = HardForkLedgerError ( CardanoEras c) Source #
An error resulting from applying a
CardanoBlock
to the ledger.
Thanks to the pattern synonyms, you can treat this as a sum type with
constructors
LedgerErrorByron
,
LedgerErrorShelley
, and
LedgerErrorWrongEra
.
toText :: CardanoLedgerError c -> Text toText (LedgerErrorByron b) = byronLedgerErrorToText b toText (LedgerErrorShelley s) = shelleyLedgerErrorToText s toText (LedgerErrorAllegra a) = allegraLedgerErrorToText a toText (LedgerErrorMary m) = maryLedgerErrorToText m toText (LedgerErrorWrongEra eraMismatch) = "Block from the " <> otherEraName eraMismatch <> " era applied to a ledger from the " <> ledgerEraName eraMismatch <> " era"
data HardForkLedgerError (xs :: [ Type ]) where Source #
pattern LedgerErrorAllegra :: LedgerError ( ShelleyBlock ( TPraos c) ( AllegraEra c)) -> CardanoLedgerError c | |
pattern LedgerErrorAlonzo :: LedgerError ( ShelleyBlock ( TPraos c) ( AlonzoEra c)) -> CardanoLedgerError c | |
pattern LedgerErrorByron :: LedgerError ByronBlock -> CardanoLedgerError c | |
pattern LedgerErrorMary :: LedgerError ( ShelleyBlock ( TPraos c) ( MaryEra c)) -> CardanoLedgerError c | |
pattern LedgerErrorShelley :: LedgerError ( ShelleyBlock ( TPraos c) ( ShelleyEra c)) -> CardanoLedgerError c | |
pattern LedgerErrorWrongEra :: EraMismatch -> CardanoLedgerError c | |
pattern LedgerErrorBabbage :: LedgerError ( ShelleyBlock ( Praos c) ( BabbageEra c)) -> CardanoLedgerError c |
Instances
OtherEnvelopeError
type CardanoOtherHeaderEnvelopeError c = HardForkEnvelopeErr ( CardanoEras c) Source #
An error resulting from validating a
CardanoHeader
.
data HardForkEnvelopeErr (xs :: [ Type ]) where Source #
pattern OtherHeaderEnvelopeErrorAllegra :: OtherHeaderEnvelopeError ( ShelleyBlock ( TPraos c) ( AllegraEra c)) -> CardanoOtherHeaderEnvelopeError c | |
pattern OtherHeaderEnvelopeErrorBabbage :: OtherHeaderEnvelopeError ( ShelleyBlock ( Praos c) ( BabbageEra c)) -> CardanoOtherHeaderEnvelopeError c | |
pattern OtherHeaderEnvelopeErrorAlonzo :: OtherHeaderEnvelopeError ( ShelleyBlock ( TPraos c) ( AlonzoEra c)) -> CardanoOtherHeaderEnvelopeError c | |
pattern OtherHeaderEnvelopeErrorByron :: OtherHeaderEnvelopeError ByronBlock -> CardanoOtherHeaderEnvelopeError c | |
pattern OtherHeaderEnvelopeErrorMary :: OtherHeaderEnvelopeError ( ShelleyBlock ( TPraos c) ( MaryEra c)) -> CardanoOtherHeaderEnvelopeError c | |
pattern OtherHeaderEnvelopeErrorShelley :: OtherHeaderEnvelopeError ( ShelleyBlock ( TPraos c) ( ShelleyEra c)) -> CardanoOtherHeaderEnvelopeError c | |
pattern OtherHeaderEnvelopeErrorWrongEra :: EraMismatch -> CardanoOtherHeaderEnvelopeError c |
Instances
TipInfo
type CardanoTipInfo c = OneEraTipInfo ( CardanoEras c) Source #
The
TipInfo
of the Cardano chain.
data OneEraTipInfo (xs :: [ Type ]) where Source #
pattern TipInfoAllegra :: TipInfo ( ShelleyBlock ( TPraos c) ( AllegraEra c)) -> CardanoTipInfo c | |
pattern TipInfoAlonzo :: TipInfo ( ShelleyBlock ( TPraos c) ( AlonzoEra c)) -> CardanoTipInfo c | |
pattern TipInfoByron :: TipInfo ByronBlock -> CardanoTipInfo c | |
pattern TipInfoBabbage :: TipInfo ( ShelleyBlock ( Praos c) ( BabbageEra c)) -> CardanoTipInfo c | |
pattern TipInfoMary :: TipInfo ( ShelleyBlock ( TPraos c) ( MaryEra c)) -> CardanoTipInfo c | |
pattern TipInfoShelley :: TipInfo ( ShelleyBlock ( TPraos c) ( ShelleyEra c)) -> CardanoTipInfo c |
Instances
CanHardFork xs => Eq ( OneEraTipInfo xs) | |
Defined in Ouroboros.Consensus.HardFork.Combinator.AcrossEras (==) :: OneEraTipInfo xs -> OneEraTipInfo xs -> Bool Source # (/=) :: OneEraTipInfo xs -> OneEraTipInfo xs -> Bool Source # |
|
CanHardFork xs => Show ( OneEraTipInfo xs) | |
CanHardFork xs => NoThunks ( OneEraTipInfo xs) | |
Query
data family BlockQuery blk :: Type -> Type Source #
Different queries supported by the ledger, indexed by the result type.
Instances
type CardanoQuery c = BlockQuery ( CardanoBlock c) Source #
The
Query
of Cardano chain.
type CardanoQueryResult c = HardForkQueryResult ( CardanoEras c) Source #
The result of a
CardanoQuery
Thanks to the pattern synonyms, you can treat this as a sum type with
constructors
QueryResultSuccess
and
QueryResultEraMismatch
.
data Either a b where Source #
The
Either
type represents values with two possibilities: a value of
type
is either
Either
a b
or
Left
a
.
Right
b
The
Either
type is sometimes used to represent a value which is
either correct or an error; by convention, the
Left
constructor is
used to hold an error value and the
Right
constructor is used to
hold a correct value (mnemonic: "right" also means "correct").
Examples
The type
is the type of values which can be either
a
Either
String
Int
String
or an
Int
. The
Left
constructor can be used only on
String
s, and the
Right
constructor can be used only on
Int
s:
>>>
let s = Left "foo" :: Either String Int
>>>
s
Left "foo">>>
let n = Right 3 :: Either String Int
>>>
n
Right 3>>>
:type s
s :: Either String Int>>>
:type n
n :: Either String Int
The
fmap
from our
Functor
instance will ignore
Left
values, but
will apply the supplied function to values contained in a
Right
:
>>>
let s = Left "foo" :: Either String Int
>>>
let n = Right 3 :: Either String Int
>>>
fmap (*2) s
Left "foo">>>
fmap (*2) n
Right 6
The
Monad
instance for
Either
allows us to chain together multiple
actions which may fail, and fail overall if any of the individual
steps failed. First we'll write a function that can either parse an
Int
from a
Char
, or fail.
>>>
import Data.Char ( digitToInt, isDigit )
>>>
:{
let parseEither :: Char -> Either String Int parseEither c | isDigit c = Right (digitToInt c) | otherwise = Left "parse error">>>
:}
The following should work, since both
'1'
and
'2'
can be
parsed as
Int
s.
>>>
:{
let parseMultiple :: Either String Int parseMultiple = do x <- parseEither '1' y <- parseEither '2' return (x + y)>>>
:}
>>>
parseMultiple
Right 3
But the following should fail overall, since the first operation where
we attempt to parse
'm'
as an
Int
will fail:
>>>
:{
let parseMultiple :: Either String Int parseMultiple = do x <- parseEither 'm' y <- parseEither '2' return (x + y)>>>
:}
>>>
parseMultiple
Left "parse error"
pattern QueryResultSuccess :: result -> CardanoQueryResult c result | |
pattern QueryResultEraMismatch :: EraMismatch -> CardanoQueryResult c result |
A query from a different era than the ledger's era was sent. |
Instances
Hashable2 Either | |
MonadError e ( Either e) | |
Defined in Control.Monad.Error.Class throwError :: e -> Either e a Source # catchError :: Either e a -> (e -> Either e a) -> Either e a Source # |
|
( Lift a, Lift b) => Lift ( Either a b :: Type ) | |
Monad ( Either e) |
Since: base-4.4.0.0 |
Functor ( Either a) |
Since: base-3.0 |
Applicative ( Either e) |
Since: base-3.0 |
Defined in Data.Either |
|
Foldable ( Either a) |
Since: base-4.7.0.0 |
Defined in Data.Foldable fold :: Monoid m => Either a m -> m Source # foldMap :: Monoid m => (a0 -> m) -> Either a a0 -> m Source # foldMap' :: Monoid m => (a0 -> m) -> Either a a0 -> m Source # foldr :: (a0 -> b -> b) -> b -> Either a a0 -> b Source # foldr' :: (a0 -> b -> b) -> b -> Either a a0 -> b Source # foldl :: (b -> a0 -> b) -> b -> Either a a0 -> b Source # foldl' :: (b -> a0 -> b) -> b -> Either a a0 -> b Source # foldr1 :: (a0 -> a0 -> a0) -> Either a a0 -> a0 Source # foldl1 :: (a0 -> a0 -> a0) -> Either a a0 -> a0 Source # toList :: Either a a0 -> [a0] Source # null :: Either a a0 -> Bool Source # length :: Either a a0 -> Int Source # elem :: Eq a0 => a0 -> Either a a0 -> Bool Source # maximum :: Ord a0 => Either a a0 -> a0 Source # minimum :: Ord a0 => Either a a0 -> a0 Source # |
|
Traversable ( Either a) |
Since: base-4.7.0.0 |
Defined in Data.Traversable traverse :: Applicative f => (a0 -> f b) -> Either a a0 -> f ( Either a b) Source # sequenceA :: Applicative f => Either a (f a0) -> f ( Either a a0) Source # mapM :: Monad m => (a0 -> m b) -> Either a a0 -> m ( Either a b) Source # sequence :: Monad m => Either a (m a0) -> m ( Either a a0) Source # |
|
MonadFailure ( Either a) | |
Hashable a => Hashable1 ( Either a) | |
Defined in Data.Hashable.Class |
|
Generic1 ( Either a :: Type -> Type ) |
Since: base-4.6.0.0 |
MonadBaseControl ( Either e) ( Either e) | |
( Eq a, Eq b) => Eq ( Either a b) |
Since: base-2.1 |
( Ord a, Ord b) => Ord ( Either a b) |
Since: base-2.1 |
Defined in Data.Either compare :: Either a b -> Either a b -> Ordering Source # (<) :: Either a b -> Either a b -> Bool Source # (<=) :: Either a b -> Either a b -> Bool Source # (>) :: Either a b -> Either a b -> Bool Source # (>=) :: Either a b -> Either a b -> Bool Source # |
|
( Read a, Read b) => Read ( Either a b) |
Since: base-3.0 |
( Show a, Show b) => Show ( Either a b) |
Since: base-3.0 |
Generic ( Either a b) |
Since: base-4.6.0.0 |
Semigroup ( Either a b) |
Since: base-4.9.0.0 |
( Structured a, Structured b) => Structured ( Either a b) | |
Defined in Distribution.Utils.Structured |
|
( Hashable a, Hashable b) => Hashable ( Either a b) | |
( ToCBOR a, ToCBOR b) => ToCBOR ( Either a b) | |
( FromCBOR a, FromCBOR b) => FromCBOR ( Either a b) | |
MonoFunctor ( Either a b) | |
MonoFoldable ( Either a b) | |
Defined in Data.MonoTraversable ofoldMap :: Monoid m => ( Element ( Either a b) -> m) -> Either a b -> m Source # ofoldr :: ( Element ( Either a b) -> b0 -> b0) -> b0 -> Either a b -> b0 Source # ofoldl' :: (a0 -> Element ( Either a b) -> a0) -> a0 -> Either a b -> a0 Source # otoList :: Either a b -> [ Element ( Either a b)] Source # oall :: ( Element ( Either a b) -> Bool ) -> Either a b -> Bool Source # oany :: ( Element ( Either a b) -> Bool ) -> Either a b -> Bool Source # onull :: Either a b -> Bool Source # olength :: Either a b -> Int Source # olength64 :: Either a b -> Int64 Source # ocompareLength :: Integral i => Either a b -> i -> Ordering Source # otraverse_ :: Applicative f => ( Element ( Either a b) -> f b0) -> Either a b -> f () Source # ofor_ :: Applicative f => Either a b -> ( Element ( Either a b) -> f b0) -> f () Source # omapM_ :: Applicative m => ( Element ( Either a b) -> m ()) -> Either a b -> m () Source # oforM_ :: Applicative m => Either a b -> ( Element ( Either a b) -> m ()) -> m () Source # ofoldlM :: Monad m => (a0 -> Element ( Either a b) -> m a0) -> a0 -> Either a b -> m a0 Source # ofoldMap1Ex :: Semigroup m => ( Element ( Either a b) -> m) -> Either a b -> m Source # ofoldr1Ex :: ( Element ( Either a b) -> Element ( Either a b) -> Element ( Either a b)) -> Either a b -> Element ( Either a b) Source # ofoldl1Ex' :: ( Element ( Either a b) -> Element ( Either a b) -> Element ( Either a b)) -> Either a b -> Element ( Either a b) Source # headEx :: Either a b -> Element ( Either a b) Source # lastEx :: Either a b -> Element ( Either a b) Source # unsafeHead :: Either a b -> Element ( Either a b) Source # unsafeLast :: Either a b -> Element ( Either a b) Source # maximumByEx :: ( Element ( Either a b) -> Element ( Either a b) -> Ordering ) -> Either a b -> Element ( Either a b) Source # minimumByEx :: ( Element ( Either a b) -> Element ( Either a b) -> Ordering ) -> Either a b -> Element ( Either a b) Source # oelem :: Element ( Either a b) -> Either a b -> Bool Source # onotElem :: Element ( Either a b) -> Either a b -> Bool Source # |
|
MonoTraversable ( Either a b) | |
MonoPointed ( Either a b) | |
( NoThunks a, NoThunks b) => NoThunks ( Either a b) | |
( Serialise a, Serialise b) => Serialise ( Either a b) |
Since: serialise-0.2.0.0 |
( Ord a, Ord b) => Ord ( Either a b) | |
Defined in PlutusTx.Ord compare :: Either a b -> Either a b -> Ordering Source # (<) :: Either a b -> Either a b -> Bool Source # (<=) :: Either a b -> Either a b -> Bool Source # (>) :: Either a b -> Either a b -> Bool Source # (>=) :: Either a b -> Either a b -> Bool Source # |
|
Recursive ( Either a b) | |
Defined in Data.Functor.Foldable project :: Either a b -> Base ( Either a b) ( Either a b) Source # cata :: ( Base ( Either a b) a0 -> a0) -> Either a b -> a0 Source # para :: ( Base ( Either a b) ( Either a b, a0) -> a0) -> Either a b -> a0 Source # gpara :: ( Corecursive ( Either a b), Comonad w) => ( forall b0. Base ( Either a b) (w b0) -> w ( Base ( Either a b) b0)) -> ( Base ( Either a b) ( EnvT ( Either a b) w a0) -> a0) -> Either a b -> a0 Source # prepro :: Corecursive ( Either a b) => ( forall b0. Base ( Either a b) b0 -> Base ( Either a b) b0) -> ( Base ( Either a b) a0 -> a0) -> Either a b -> a0 Source # gprepro :: ( Corecursive ( Either a b), Comonad w) => ( forall b0. Base ( Either a b) (w b0) -> w ( Base ( Either a b) b0)) -> ( forall c. Base ( Either a b) c -> Base ( Either a b) c) -> ( Base ( Either a b) (w a0) -> a0) -> Either a b -> a0 Source # |
|
Corecursive ( Either a b) | |
Defined in Data.Functor.Foldable embed :: Base ( Either a b) ( Either a b) -> Either a b Source # ana :: (a0 -> Base ( Either a b) a0) -> a0 -> Either a b Source # apo :: (a0 -> Base ( Either a b) ( Either ( Either a b) a0)) -> a0 -> Either a b Source # postpro :: Recursive ( Either a b) => ( forall b0. Base ( Either a b) b0 -> Base ( Either a b) b0) -> (a0 -> Base ( Either a b) a0) -> a0 -> Either a b Source # gpostpro :: ( Recursive ( Either a b), Monad m) => ( forall b0. m ( Base ( Either a b) b0) -> Base ( Either a b) (m b0)) -> ( forall c. Base ( Either a b) c -> Base ( Either a b) c) -> (a0 -> Base ( Either a b) (m a0)) -> a0 -> Either a b Source # |
|
(a ~ a', b ~ b') => Each ( Either a a') ( Either b b') a b |
Since: microlens-0.4.11 |
type Failure ( Either a) | |
Defined in Basement.Monad |
|
type StM ( Either e) a | |
Defined in Control.Monad.Trans.Control |
|
type Rep1 ( Either a :: Type -> Type ) | |
Defined in GHC.Generics
type
Rep1
(
Either
a ::
Type
->
Type
) =
D1
('
MetaData
"Either" "Data.Either" "base" '
False
) (
C1
('
MetaCons
"Left" '
PrefixI
'
False
) (
S1
('
MetaSel
('
Nothing
::
Maybe
Symbol
) '
NoSourceUnpackedness
'
NoSourceStrictness
'
DecidedLazy
) (
Rec0
a))
:+:
C1
('
MetaCons
"Right" '
PrefixI
'
False
) (
S1
('
MetaSel
('
Nothing
::
Maybe
Symbol
) '
NoSourceUnpackedness
'
NoSourceStrictness
'
DecidedLazy
)
Par1
))
|
|
type Rep ( Either a b) | |
Defined in GHC.Generics
type
Rep
(
Either
a b) =
D1
('
MetaData
"Either" "Data.Either" "base" '
False
) (
C1
('
MetaCons
"Left" '
PrefixI
'
False
) (
S1
('
MetaSel
('
Nothing
::
Maybe
Symbol
) '
NoSourceUnpackedness
'
NoSourceStrictness
'
DecidedLazy
) (
Rec0
a))
:+:
C1
('
MetaCons
"Right" '
PrefixI
'
False
) (
S1
('
MetaSel
('
Nothing
::
Maybe
Symbol
) '
NoSourceUnpackedness
'
NoSourceStrictness
'
DecidedLazy
) (
Rec0
b)))
|
|
type Element ( Either a b) | |
Defined in Data.MonoTraversable |
|
type Base ( Either a b) |
Example boring stub for non-recursive data types |
CodecConfig
type CardanoCodecConfig c = CodecConfig ( CardanoBlock c) Source #
The
CodecConfig
for
CardanoBlock
.
Thanks to the pattern synonyms, you can treat this as the product of
the Byron, Shelley, ...
CodecConfig
s.
data family CodecConfig blk Source #
Static configuration required for serialisation and deserialisation of types pertaining to this type of block.
Data family instead of type family to get better type inference.
Instances
BlockConfig
data family BlockConfig blk Source #
Static configuration required to work with this type of blocks
Instances
type CardanoBlockConfig c = BlockConfig ( CardanoBlock c) Source #
The
BlockConfig
for
CardanoBlock
.
Thanks to the pattern synonyms, you can treat this as the product of
the Byron, Shelley, ...
BlockConfig
s.
StorageConfig
type CardanoStorageConfig c = StorageConfig ( CardanoBlock c) Source #
The
StorageConfig
for
CardanoBlock
.
Thanks to the pattern synonyms, you can treat this as the product of
the Byron, Shelley, ...
StorageConfig
s.
data family StorageConfig blk Source #
Config needed for the
NodeInitStorage
class. Defined here to
avoid circular dependencies.
Instances
ConsensusConfig
type CardanoConsensusConfig c = ConsensusConfig ( HardForkProtocol ( CardanoEras c)) Source #
The
ConsensusConfig
for
CardanoBlock
.
Thanks to the pattern synonyms, you can treat this as the product of the
Byron, Shelley, ...
PartialConsensusConfig
s.
NOTE: not
ConsensusConfig
, but
PartialConsensusConfig
.
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
LedgerConfig
type CardanoLedgerConfig c = HardForkLedgerConfig ( CardanoEras c) Source #
The
LedgerConfig
for
CardanoBlock
.
Thanks to the pattern synonyms, you can treat this as the product of the
Byron, Shelley, ...
PartialLedgerConfig
s.
NOTE: not
LedgerConfig
, but
PartialLedgerConfig
.
data HardForkLedgerConfig (xs :: [ Type ]) where Source #
pattern CardanoLedgerConfig :: PartialLedgerConfig ByronBlock -> PartialLedgerConfig ( ShelleyBlock ( TPraos c) ( ShelleyEra c)) -> PartialLedgerConfig ( ShelleyBlock ( TPraos c) ( AllegraEra c)) -> PartialLedgerConfig ( ShelleyBlock ( TPraos c) ( MaryEra c)) -> PartialLedgerConfig ( ShelleyBlock ( TPraos c) ( AlonzoEra c)) -> PartialLedgerConfig ( ShelleyBlock ( Praos c) ( BabbageEra c)) -> CardanoLedgerConfig c |
Instances
Generic ( HardForkLedgerConfig xs) | |
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) | |
|
|
type Rep ( HardForkLedgerConfig xs) | |
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))))
|
LedgerState
type CardanoLedgerState c = LedgerState ( CardanoBlock c) Source #
The
LedgerState
for
CardanoBlock
.
NOTE: the
CardanoLedgerState
contains more than just the current era's
LedgerState
. We don't give access to those internal details through the
pattern synonyms. This is also the reason the pattern synonyms are not
bidirectional.
data family LedgerState blk Source #
Ledger state associated with a block
Instances
ChainDepState
type CardanoChainDepState c = HardForkChainDepState ( CardanoEras c) Source #
The
ChainDepState
for
CardanoBlock
.
NOTE: the
CardanoChainDepState
contains more than just the current era's
ChainDepState
. We don't give access to those internal details through the
pattern synonyms. This is also the reason the pattern synonyms are not
bidirectional.
data HardForkState (f :: Type -> Type ) (xs :: [ Type ]) where Source #
Generic hard fork state
This is used both for the consensus state and the ledger state.
pattern ChainDepStateAllegra :: ChainDepState ( BlockProtocol ( ShelleyBlock ( TPraos c) ( AllegraEra c))) -> CardanoChainDepState c | |
pattern ChainDepStateAlonzo :: ChainDepState ( BlockProtocol ( ShelleyBlock ( TPraos c) ( AlonzoEra c))) -> CardanoChainDepState c | |
pattern ChainDepStateBabbage :: ChainDepState ( BlockProtocol ( ShelleyBlock ( Praos c) ( BabbageEra c))) -> CardanoChainDepState c | |
pattern ChainDepStateByron :: ChainDepState ( BlockProtocol ByronBlock ) -> CardanoChainDepState c | |
pattern ChainDepStateMary :: ChainDepState ( BlockProtocol ( ShelleyBlock ( TPraos c) ( MaryEra c))) -> CardanoChainDepState c | |
pattern ChainDepStateShelley :: ChainDepState ( BlockProtocol ( ShelleyBlock ( TPraos c) ( ShelleyEra c))) -> CardanoChainDepState c |
Instances
data Ticked ( HardForkChainDepState xs) | |
|
|
type SListIN HardForkState | |
type Prod HardForkState | |
type AllN HardForkState (c :: Type -> Constraint ) | |
type CollapseTo HardForkState a | |
EraMismatch
data EraMismatch Source #
Extra info for errors caused by applying a block, header, transaction, or query from one era to a ledger from a different era.
EraMismatch | |
|
Instances
Eq EraMismatch | |
Defined in Ouroboros.Consensus.HardFork.Combinator.AcrossEras (==) :: EraMismatch -> EraMismatch -> Bool Source # (/=) :: EraMismatch -> EraMismatch -> Bool Source # |
|
Show EraMismatch | |
Generic EraMismatch | |
Defined in Ouroboros.Consensus.HardFork.Combinator.AcrossEras from :: EraMismatch -> Rep EraMismatch x Source # to :: Rep EraMismatch x -> EraMismatch Source # |
|
type Rep EraMismatch | |
Defined in Ouroboros.Consensus.HardFork.Combinator.AcrossEras
type
Rep
EraMismatch
=
D1
('
MetaData
"EraMismatch" "Ouroboros.Consensus.HardFork.Combinator.AcrossEras" "ouroboros-consensus-0.1.0.1-DT4Cvwf63DZKctsEvaJqCU" '
False
) (
C1
('
MetaCons
"EraMismatch" '
PrefixI
'
True
) (
S1
('
MetaSel
('
Just
"ledgerEraName") '
NoSourceUnpackedness
'
SourceStrict
'
DecidedStrict
) (
Rec0
Text
)
:*:
S1
('
MetaSel
('
Just
"otherEraName") '
NoSourceUnpackedness
'
SourceStrict
'
DecidedStrict
) (
Rec0
Text
)))
|