Safe Haskell | Safe-Inferred |
---|---|
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), ShelleyBlock (Praos c) (ConwayEra c)]
- module Ouroboros.Consensus.Shelley.Eras
- type ShelleyBasedLedgerEras c = '[ShelleyEra c, AllegraEra c, MaryEra c, AlonzoEra c, BabbageEra c, ConwayEra c]
- 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
- pattern BlockConway ∷ ShelleyBlock (Praos c) (ConwayEra 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
- pattern ApplyTxErrConway ∷ ApplyTxErr (ShelleyBlock (Praos c) (ConwayEra 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
- pattern LedgerErrorConway ∷ LedgerError (ShelleyBlock (Praos c) (ConwayEra 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 OtherHeaderEnvelopeErrorConway ∷ OtherHeaderEnvelopeError (ShelleyBlock (Praos c) (ConwayEra 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 TipInfoConway ∷ TipInfo (ShelleyBlock (Praos c) (ConwayEra 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)) → PartialLedgerConfig (ShelleyBlock (Praos c) (ConwayEra 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 ChainDepStateConway ∷ ChainDepState (BlockProtocol (ShelleyBlock (Praos c) (ConwayEra 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 {}
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), ShelleyBlock (Praos c) (ConwayEra c)] Source #
type ShelleyBasedLedgerEras c = '[ShelleyEra c, AllegraEra c, MaryEra c, AlonzoEra c, BabbageEra c, ConwayEra 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
, BlockShelley
, etc.
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 | |
pattern BlockConway ∷ ShelleyBlock (Praos c) (ConwayEra 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 | |
pattern ApplyTxErrConway ∷ ApplyTxErr (ShelleyBlock (Praos c) (ConwayEra c)) → CardanoApplyTxErr c |
Instances
A generalized transaction, GenTx
, identifier.
Instances
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 | |
pattern LedgerErrorConway ∷ LedgerError (ShelleyBlock (Praos c) (ConwayEra 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 #
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 TipInfoConway ∷ TipInfo (ShelleyBlock (Praos c) (ConwayEra 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 ⇒ Show (OneEraTipInfo xs) | |
Defined in Ouroboros.Consensus.HardFork.Combinator.AcrossEras showsPrec ∷ Int → OneEraTipInfo xs → ShowS # show ∷ OneEraTipInfo xs → String # showList ∷ [OneEraTipInfo xs] → ShowS # | |
CanHardFork xs ⇒ Eq (OneEraTipInfo xs) | |
Defined in Ouroboros.Consensus.HardFork.Combinator.AcrossEras (==) ∷ OneEraTipInfo xs → OneEraTipInfo xs → Bool # (/=) ∷ OneEraTipInfo xs → OneEraTipInfo xs → Bool # | |
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
.
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. |