Safe Haskell | None |
---|---|
Language | Haskell2010 |
Queries from local clients to the node.
Synopsis
- data QueryInMode result where
- QueryCurrentEra :: QueryInMode AnyCardanoEra
- QueryInEra :: forall era result1. QueryInEra era result1 -> QueryInMode (Either EraMismatch result1)
- QueryEraHistory :: QueryInMode EraHistory
- QuerySystemStart :: QueryInMode SystemStart
- QueryChainBlockNo :: QueryInMode (WithOrigin BlockNo)
- QueryChainPoint :: QueryInMode ChainPoint
- data QueryInEra era result where
- QueryByronUpdateState :: QueryInEra ByronEra ByronUpdateState
- QueryInShelleyBasedEra :: forall era result. ShelleyBasedEra era -> QueryInShelleyBasedEra era result -> QueryInEra era result
- data QueryInShelleyBasedEra era result where
- QueryEpoch :: forall era. QueryInShelleyBasedEra era EpochNo
- QueryGenesisParameters :: forall era. QueryInShelleyBasedEra era (GenesisParameters ShelleyEra)
- QueryProtocolParameters :: forall era. QueryInShelleyBasedEra era (PParams (ShelleyLedgerEra era))
- QueryProtocolParametersUpdate :: forall era. QueryInShelleyBasedEra era (Map (Hash GenesisKey) ProtocolParametersUpdate)
- QueryStakeDistribution :: forall era. QueryInShelleyBasedEra era (Map (Hash StakePoolKey) Rational)
- QueryUTxO :: forall era. QueryUTxOFilter -> QueryInShelleyBasedEra era (UTxO era)
- QueryStakeAddresses :: forall era. Set StakeCredential -> NetworkId -> QueryInShelleyBasedEra era (Map StakeAddress Coin, Map StakeAddress PoolId)
- QueryStakePools :: forall era. QueryInShelleyBasedEra era (Set PoolId)
- QueryStakePoolParameters :: forall era. Set PoolId -> QueryInShelleyBasedEra era (Map PoolId StakePoolParameters)
- QueryDebugLedgerState :: forall era. QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
- QueryProtocolState :: forall era. QueryInShelleyBasedEra era (ProtocolState era)
- QueryCurrentEpochState :: forall era. QueryInShelleyBasedEra era (SerialisedCurrentEpochState era)
- QueryPoolState :: forall era. Maybe (Set PoolId) -> QueryInShelleyBasedEra era (SerialisedPoolState era)
- QueryPoolDistribution :: forall era. Maybe (Set PoolId) -> QueryInShelleyBasedEra era (SerialisedPoolDistribution era)
- QueryStakeSnapshot :: forall era. Maybe (Set PoolId) -> QueryInShelleyBasedEra era (SerialisedStakeSnapshots era)
- QueryStakeDelegDeposits :: forall era. Set StakeCredential -> QueryInShelleyBasedEra era (Map StakeCredential Coin)
- QueryAccountState :: forall era. QueryInShelleyBasedEra era AccountState
- QueryConstitution :: forall era. QueryInShelleyBasedEra era (Constitution (ShelleyLedgerEra era))
- QueryGovState :: forall era. QueryInShelleyBasedEra era (GovState (ShelleyLedgerEra era))
- QueryDRepState :: forall era. Set (Credential 'DRepRole StandardCrypto) -> QueryInShelleyBasedEra era (Map (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto))
- QueryDRepStakeDistr :: forall era. Set (DRep StandardCrypto) -> QueryInShelleyBasedEra era (Map (DRep StandardCrypto) Coin)
- QuerySPOStakeDistr :: forall era. Set (KeyHash 'StakePool StandardCrypto) -> QueryInShelleyBasedEra era (Map (KeyHash 'StakePool StandardCrypto) Coin)
- QueryCommitteeMembersState :: forall era. Set (Credential 'ColdCommitteeRole StandardCrypto) -> Set (Credential 'HotCommitteeRole StandardCrypto) -> Set MemberStatus -> QueryInShelleyBasedEra era (CommitteeMembersState StandardCrypto)
- QueryStakeVoteDelegatees :: forall era. Set StakeCredential -> QueryInShelleyBasedEra era (Map StakeCredential (DRep StandardCrypto))
- data QueryUTxOFilter
- newtype UTxO era = UTxO {}
- data UTxOInAnyEra where
- UTxOInAnyEra :: forall era. CardanoEra era -> UTxO era -> UTxOInAnyEra
- toConsensusQuery :: CardanoBlock StandardCrypto ~ block => QueryInMode result -> Some (Query block)
- fromConsensusQueryResult :: (HasCallStack, CardanoBlock StandardCrypto ~ block) => QueryInMode result -> Query block result' -> result' -> result
- newtype SerialisedDebugLedgerState era = SerialisedDebugLedgerState (Serialised (NewEpochState (ShelleyLedgerEra era)))
- newtype ProtocolState era = ProtocolState (Serialised (ChainDepState (ConsensusProtocol era)))
- decodeProtocolState :: FromCBOR (ChainDepState (ConsensusProtocol era)) => ProtocolState era -> Either (ByteString, DecoderError) (ChainDepState (ConsensusProtocol era))
- newtype DebugLedgerState era = DebugLedgerState {}
- decodeDebugLedgerState :: FromCBOR (DebugLedgerState era) => SerialisedDebugLedgerState era -> Either (ByteString, DecoderError) (DebugLedgerState era)
- newtype SerialisedCurrentEpochState era = SerialisedCurrentEpochState (Serialised (EpochState (ShelleyLedgerEra era)))
- newtype CurrentEpochState era = CurrentEpochState (EpochState (ShelleyLedgerEra era))
- decodeCurrentEpochState :: ShelleyBasedEra era -> SerialisedCurrentEpochState era -> Either DecoderError (CurrentEpochState era)
- newtype SerialisedPoolState era = SerialisedPoolState (Serialised (PState (ShelleyLedgerEra era)))
- newtype PoolState era = PoolState (PState (ShelleyLedgerEra era))
- decodePoolState :: (Era (ShelleyLedgerEra era), DecCBOR (PState (ShelleyLedgerEra era))) => SerialisedPoolState era -> Either DecoderError (PoolState era)
- newtype SerialisedPoolDistribution era = SerialisedPoolDistribution (Serialised (PoolDistr (EraCrypto (ShelleyLedgerEra era))))
- newtype PoolDistribution era = PoolDistribution {
- unPoolDistr :: PoolDistr (EraCrypto (ShelleyLedgerEra era))
- decodePoolDistribution :: Crypto (EraCrypto (ShelleyLedgerEra era)) => ShelleyBasedEra era -> SerialisedPoolDistribution era -> Either DecoderError (PoolDistribution era)
- newtype SerialisedStakeSnapshots era = SerialisedStakeSnapshots (Serialised (StakeSnapshots (EraCrypto (ShelleyLedgerEra era))))
- newtype StakeSnapshot era = StakeSnapshot (StakeSnapshots (EraCrypto (ShelleyLedgerEra era)))
- decodeStakeSnapshot :: FromCBOR (StakeSnapshots (EraCrypto (ShelleyLedgerEra era))) => SerialisedStakeSnapshots era -> Either DecoderError (StakeSnapshot era)
- data EraHistory where
- EraHistory :: forall (xs :: [Type]). CardanoBlock StandardCrypto ~ HardForkBlock xs => Interpreter xs -> EraHistory
- newtype SystemStart = SystemStart {}
- newtype LedgerEpochInfo = LedgerEpochInfo {}
- toLedgerEpochInfo :: EraHistory -> LedgerEpochInfo
- newtype SlotsInEpoch = SlotsInEpoch Word64
- newtype SlotsToEpochEnd = SlotsToEpochEnd Word64
- slotToEpoch :: SlotNo -> EraHistory -> Either PastHorizonException (EpochNo, SlotsInEpoch, SlotsToEpochEnd)
- data family LedgerState blk
- getProgress :: SlotNo -> EraHistory -> Either PastHorizonException (RelativeTime, SlotLength)
- getSlotForRelativeTime :: RelativeTime -> EraHistory -> Either PastHorizonException SlotNo
- toLedgerUTxO :: ShelleyBasedEra era -> UTxO era -> UTxO (ShelleyLedgerEra era)
- fromLedgerUTxO :: ShelleyBasedEra era -> UTxO (ShelleyLedgerEra era) -> UTxO era
Queries
data QueryInMode result where Source #
QueryCurrentEra :: QueryInMode AnyCardanoEra | |
QueryInEra :: forall era result1. QueryInEra era result1 -> QueryInMode (Either EraMismatch result1) | |
QueryEraHistory :: QueryInMode EraHistory | |
QuerySystemStart :: QueryInMode SystemStart | |
QueryChainBlockNo :: QueryInMode (WithOrigin BlockNo) | |
QueryChainPoint :: QueryInMode ChainPoint |
Instances
Show (QueryInMode result) Source # | |
Defined in Cardano.Api.Query | |
NodeToClientVersionOf (QueryInMode result) Source # | |
Defined in Cardano.Api.Query nodeToClientVersionOf :: QueryInMode result -> NodeToClientVersion Source # |
data QueryInEra era result where Source #
QueryByronUpdateState :: QueryInEra ByronEra ByronUpdateState | |
QueryInShelleyBasedEra :: forall era result. ShelleyBasedEra era -> QueryInShelleyBasedEra era result -> QueryInEra era result |
Instances
Show (QueryInEra era result) Source # | |
Defined in Cardano.Api.Query | |
NodeToClientVersionOf (QueryInEra era result) Source # | |
Defined in Cardano.Api.Query nodeToClientVersionOf :: QueryInEra era result -> NodeToClientVersion Source # |
data QueryInShelleyBasedEra era result where Source #
Instances
Show (QueryInShelleyBasedEra era result) Source # | |
Defined in Cardano.Api.Query | |
NodeToClientVersionOf (QueryInShelleyBasedEra era result) Source # | Mapping for queries in Shelley-based eras returning minimal node-to-client protocol versions. More information about queries versioning can be found: * https://ouroboros-network.cardano.intersectmbo.org/ouroboros-network/Ouroboros-Network-NodeToClient.html#t:NodeToClientVersion * https://ouroboros-consensus.cardano.intersectmbo.org/docs/for-developers/QueryVersioning/#implementation |
Defined in Cardano.Api.Query nodeToClientVersionOf :: QueryInShelleyBasedEra era result -> NodeToClientVersion Source # |
data QueryUTxOFilter Source #
Getting the whole UTxO is obviously not efficient since the result can be huge. Filtering by address is also not efficient because it requires a linear search.
The QueryUTxOFilterByTxIn
is efficient since it fits with the structure of
the UTxO (which is indexed by TxIn
).
QueryUTxOWhole | O(n) time and space for utxo size n |
QueryUTxOByAddress (Set AddressAny) | O(n) time, O(m) space for utxo size n, and address set size m |
QueryUTxOByTxIn (Set TxIn) | O(m log n) time, O(m) space for utxo size n, and address set size m |
Instances
Show QueryUTxOFilter Source # | |
Defined in Cardano.Api.Query | |
NodeToClientVersionOf QueryUTxOFilter Source # | |
Defined in Cardano.Api.Query | |
Eq QueryUTxOFilter Source # | |
Defined in Cardano.Api.Query (==) :: QueryUTxOFilter -> QueryUTxOFilter -> Bool Source # (/=) :: QueryUTxOFilter -> QueryUTxOFilter -> Bool Source # |
Instances
(IsShelleyBasedEra era, FromJSON (TxOut CtxUTxO era)) => FromJSON (UTxO era) Source # | |
Defined in Cardano.Api.Query parseJSON :: Value -> Parser (UTxO era) # parseJSONList :: Value -> Parser [UTxO era] # omittedField :: Maybe (UTxO era) # | |
IsCardanoEra era => ToJSON (UTxO era) Source # | |
Defined in Cardano.Api.Query | |
Show (UTxO era) Source # | |
Eq (UTxO era) Source # | |
data UTxOInAnyEra where Source #
UTxOInAnyEra :: forall era. CardanoEra era -> UTxO era -> UTxOInAnyEra |
Instances
Show UTxOInAnyEra Source # | |
Defined in Cardano.Api.Query |
Internal conversion functions
toConsensusQuery :: CardanoBlock StandardCrypto ~ block => QueryInMode result -> Some (Query block) Source #
fromConsensusQueryResult :: (HasCallStack, CardanoBlock StandardCrypto ~ block) => QueryInMode result -> Query block result' -> result' -> result Source #
Wrapper types used in queries
newtype SerialisedDebugLedgerState era Source #
newtype ProtocolState era Source #
decodeProtocolState :: FromCBOR (ChainDepState (ConsensusProtocol era)) => ProtocolState era -> Either (ByteString, DecoderError) (ChainDepState (ConsensusProtocol era)) Source #
newtype DebugLedgerState era Source #
Instances
IsShelleyBasedEra era => ToJSON (DebugLedgerState era) Source # | |
Defined in Cardano.Api.Query.Types toJSON :: DebugLedgerState era -> Value # toEncoding :: DebugLedgerState era -> Encoding # toJSONList :: [DebugLedgerState era] -> Value # toEncodingList :: [DebugLedgerState era] -> Encoding # omitField :: DebugLedgerState era -> Bool # | |
IsShelleyBasedEra era => FromCBOR (DebugLedgerState era) Source # | |
Defined in Cardano.Api.Query.Types |
decodeDebugLedgerState :: FromCBOR (DebugLedgerState era) => SerialisedDebugLedgerState era -> Either (ByteString, DecoderError) (DebugLedgerState era) Source #
newtype SerialisedCurrentEpochState era Source #
newtype CurrentEpochState era Source #
decodeCurrentEpochState :: ShelleyBasedEra era -> SerialisedCurrentEpochState era -> Either DecoderError (CurrentEpochState era) Source #
newtype SerialisedPoolState era Source #
SerialisedPoolState (Serialised (PState (ShelleyLedgerEra era))) |
decodePoolState :: (Era (ShelleyLedgerEra era), DecCBOR (PState (ShelleyLedgerEra era))) => SerialisedPoolState era -> Either DecoderError (PoolState era) Source #
newtype SerialisedPoolDistribution era Source #
newtype PoolDistribution era Source #
decodePoolDistribution :: Crypto (EraCrypto (ShelleyLedgerEra era)) => ShelleyBasedEra era -> SerialisedPoolDistribution era -> Either DecoderError (PoolDistribution era) Source #
newtype SerialisedStakeSnapshots era Source #
newtype StakeSnapshot era Source #
StakeSnapshot (StakeSnapshots (EraCrypto (ShelleyLedgerEra era))) |
decodeStakeSnapshot :: FromCBOR (StakeSnapshots (EraCrypto (ShelleyLedgerEra era))) => SerialisedStakeSnapshots era -> Either DecoderError (StakeSnapshot era) Source #
data EraHistory where Source #
EraHistory :: forall (xs :: [Type]). CardanoBlock StandardCrypto ~ HardForkBlock xs => Interpreter xs -> EraHistory |
newtype SystemStart Source #
System start
Slots are counted from the system start.
Instances
newtype LedgerEpochInfo Source #
newtype SlotsInEpoch Source #
newtype SlotsToEpochEnd Source #
slotToEpoch :: SlotNo -> EraHistory -> Either PastHorizonException (EpochNo, SlotsInEpoch, SlotsToEpochEnd) Source #
data family LedgerState blk Source #
Ledger state associated with a block
This is the Consensus notion of a ledger state. Each block type is
associated with one of the Ledger types for the ledger state. Virtually
every concept in this codebase revolves around this type, or the referenced
blk
. Whenever we use the type variable l
, we intend to denote that the
expected instantiation is either a LedgerState
or some wrapper over it
(like the ExtLedgerState
).
The main operations we can do with a LedgerState
are ticking (defined in
IsLedger
), and applying a block (defined in
ApplyBlock
).
Instances
Inject LedgerState | |||||||||
Defined in Ouroboros.Consensus.HardFork.Combinator.Embed.Nary inject :: forall x (xs :: [Type]). CanHardFork xs => Exactly xs Bound -> Index xs x -> LedgerState x -> LedgerState (HardForkBlock xs) Source # | |||||||||
Isomorphic LedgerState | |||||||||
Defined in Ouroboros.Consensus.HardFork.Combinator.Embed.Unary project :: NoHardForks blk => LedgerState (HardForkBlock '[blk]) -> LedgerState blk Source # inject :: NoHardForks blk => LedgerState blk -> LedgerState (HardForkBlock '[blk]) Source # | |||||||||
CanHardFork xs => Show (LedgerState (HardForkBlock xs)) | |||||||||
Defined in Ouroboros.Consensus.HardFork.Combinator.Basics showsPrec :: Int -> LedgerState (HardForkBlock xs) -> ShowS Source # show :: LedgerState (HardForkBlock xs) -> String Source # showList :: [LedgerState (HardForkBlock xs)] -> ShowS Source # | |||||||||
Bridge m a => Show (LedgerState (DualBlock m a)) | |||||||||
Defined in Ouroboros.Consensus.Ledger.Dual | |||||||||
CanHardFork xs => Eq (LedgerState (HardForkBlock xs)) | |||||||||
Defined in Ouroboros.Consensus.HardFork.Combinator.Basics (==) :: LedgerState (HardForkBlock xs) -> LedgerState (HardForkBlock xs) -> Bool Source # (/=) :: LedgerState (HardForkBlock xs) -> LedgerState (HardForkBlock xs) -> Bool Source # | |||||||||
Bridge m a => Eq (LedgerState (DualBlock m a)) | |||||||||
Defined in Ouroboros.Consensus.Ledger.Dual (==) :: LedgerState (DualBlock m a) -> LedgerState (DualBlock m a) -> Bool Source # (/=) :: LedgerState (DualBlock m a) -> LedgerState (DualBlock m a) -> Bool Source # | |||||||||
CanHardFork xs => NoThunks (LedgerState (HardForkBlock xs)) | |||||||||
Defined in Ouroboros.Consensus.HardFork.Combinator.Basics noThunks :: Context -> LedgerState (HardForkBlock xs) -> IO (Maybe ThunkInfo) # wNoThunks :: Context -> LedgerState (HardForkBlock xs) -> IO (Maybe ThunkInfo) # showTypeOf :: Proxy (LedgerState (HardForkBlock xs)) -> String # | |||||||||
NoThunks (LedgerState (DualBlock m a)) | |||||||||
Defined in Ouroboros.Consensus.Ledger.Dual noThunks :: Context -> LedgerState (DualBlock m a) -> IO (Maybe ThunkInfo) # wNoThunks :: Context -> LedgerState (DualBlock m a) -> IO (Maybe ThunkInfo) # showTypeOf :: Proxy (LedgerState (DualBlock m a)) -> String # | |||||||||
NoThunks (Ticked (LedgerState (DualBlock m a))) | |||||||||
Defined in Ouroboros.Consensus.Ledger.Dual | |||||||||
Bridge m a => GetTip (LedgerState (DualBlock m a)) | |||||||||
Defined in Ouroboros.Consensus.Ledger.Dual getTip :: LedgerState (DualBlock m a) -> Point (LedgerState (DualBlock m a)) Source # | |||||||||
Bridge m a => GetTip (Ticked (LedgerState (DualBlock m a))) | |||||||||
Defined in Ouroboros.Consensus.Ledger.Dual getTip :: Ticked (LedgerState (DualBlock m a)) -> Point (Ticked (LedgerState (DualBlock m a))) Source # | |||||||||
Bridge m a => IsLedger (LedgerState (DualBlock m a)) | |||||||||
Defined in Ouroboros.Consensus.Ledger.Dual
applyChainTickLedgerResult :: LedgerCfg (LedgerState (DualBlock m a)) -> SlotNo -> LedgerState (DualBlock m a) -> LedgerResult (LedgerState (DualBlock m a)) (Ticked (LedgerState (DualBlock m a))) Source # | |||||||||
Bridge m a => ApplyBlock (LedgerState (DualBlock m a)) (DualBlock m a) | |||||||||
Defined in Ouroboros.Consensus.Ledger.Dual applyBlockLedgerResult :: LedgerCfg (LedgerState (DualBlock m a)) -> DualBlock m a -> Ticked (LedgerState (DualBlock m a)) -> Except (LedgerErr (LedgerState (DualBlock m a))) (LedgerResult (LedgerState (DualBlock m a)) (LedgerState (DualBlock m a))) Source # reapplyBlockLedgerResult :: LedgerCfg (LedgerState (DualBlock m a)) -> DualBlock m a -> Ticked (LedgerState (DualBlock m a)) -> LedgerResult (LedgerState (DualBlock m a)) (LedgerState (DualBlock m a)) Source # | |||||||||
Isomorphic (Ticked :.: LedgerState) | |||||||||
Defined in Ouroboros.Consensus.HardFork.Combinator.Embed.Unary project :: NoHardForks blk => (Ticked :.: LedgerState) (HardForkBlock '[blk]) -> (Ticked :.: LedgerState) blk Source # inject :: NoHardForks blk => (Ticked :.: LedgerState) blk -> (Ticked :.: LedgerState) (HardForkBlock '[blk]) Source # | |||||||||
data LedgerState ByronBlock | |||||||||
type HeaderHash (LedgerState blk :: Type) | |||||||||
Defined in Ouroboros.Consensus.Ledger.Basics | |||||||||
type TranslationError era (LedgerState :.: ShelleyBlock proto) | |||||||||
Defined in Ouroboros.Consensus.Shelley.ShelleyHFC | |||||||||
type Rep (LedgerState ByronBlock) | |||||||||
Defined in Ouroboros.Consensus.Byron.Ledger.Ledger type Rep (LedgerState ByronBlock) = D1 ('MetaData "LedgerState" "Ouroboros.Consensus.Byron.Ledger.Ledger" "ouroboros-consensus-cardano-0.20.0.0-2bd9b95213c4ce1ce608f7e1fa75ab5517c5c68b93059f91e3d89fedcdadeff3" 'False) (C1 ('MetaCons "ByronLedgerState" 'PrefixI 'True) (S1 ('MetaSel ('Just "byronLedgerTipBlockNo") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (WithOrigin BlockNo)) :*: (S1 ('MetaSel ('Just "byronLedgerState") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 ChainValidationState) :*: S1 ('MetaSel ('Just "byronLedgerTransition") 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 ByronTransition)))) | |||||||||
type Rep (LedgerState (ShelleyBlock proto era)) | |||||||||
Defined in Ouroboros.Consensus.Shelley.Ledger.Ledger type Rep (LedgerState (ShelleyBlock proto era)) = D1 ('MetaData "LedgerState" "Ouroboros.Consensus.Shelley.Ledger.Ledger" "ouroboros-consensus-cardano-0.20.0.0-2bd9b95213c4ce1ce608f7e1fa75ab5517c5c68b93059f91e3d89fedcdadeff3" 'False) (C1 ('MetaCons "ShelleyLedgerState" 'PrefixI 'True) (S1 ('MetaSel ('Just "shelleyLedgerTip") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (WithOrigin (ShelleyTip proto era))) :*: (S1 ('MetaSel ('Just "shelleyLedgerState") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (NewEpochState era)) :*: S1 ('MetaSel ('Just "shelleyLedgerTransition") 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 ShelleyTransition)))) | |||||||||
type Rep (Ticked (LedgerState (HardForkBlock xs))) | |||||||||
Defined in Ouroboros.Consensus.HardFork.Combinator.Ledger type Rep (Ticked (LedgerState (HardForkBlock xs))) = D1 ('MetaData "Ticked" "Ouroboros.Consensus.HardFork.Combinator.Ledger" "ouroboros-consensus-0.21.0.0-96a81cb4588538917e2e1bd1565d867fc48490e88747b2693485d823f16f2133" 'False) (C1 ('MetaCons "TickedHardForkLedgerState" 'PrefixI 'True) (S1 ('MetaSel ('Just "tickedHardForkLedgerStateTransition") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 TransitionInfo) :*: S1 ('MetaSel ('Just "tickedHardForkLedgerStatePerEra") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (HardForkState (Ticked :.: LedgerState) xs)))) | |||||||||
type Rep (Ticked (LedgerState ByronBlock)) | |||||||||
Defined in Ouroboros.Consensus.Byron.Ledger.Ledger type Rep (Ticked (LedgerState ByronBlock)) = D1 ('MetaData "Ticked" "Ouroboros.Consensus.Byron.Ledger.Ledger" "ouroboros-consensus-cardano-0.20.0.0-2bd9b95213c4ce1ce608f7e1fa75ab5517c5c68b93059f91e3d89fedcdadeff3" 'False) (C1 ('MetaCons "TickedByronLedgerState" 'PrefixI 'True) (S1 ('MetaSel ('Just "tickedByronLedgerState") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 ChainValidationState) :*: S1 ('MetaSel ('Just "untickedByronLedgerTransition") 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 ByronTransition))) | |||||||||
type Rep (Ticked (LedgerState (ShelleyBlock proto era))) | |||||||||
Defined in Ouroboros.Consensus.Shelley.Ledger.Ledger type Rep (Ticked (LedgerState (ShelleyBlock proto era))) = D1 ('MetaData "Ticked" "Ouroboros.Consensus.Shelley.Ledger.Ledger" "ouroboros-consensus-cardano-0.20.0.0-2bd9b95213c4ce1ce608f7e1fa75ab5517c5c68b93059f91e3d89fedcdadeff3" 'False) (C1 ('MetaCons "TickedShelleyLedgerState" 'PrefixI 'True) (S1 ('MetaSel ('Just "untickedShelleyLedgerTip") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (WithOrigin (ShelleyTip proto era))) :*: (S1 ('MetaSel ('Just "tickedShelleyLedgerTransition") 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 ShelleyTransition) :*: S1 ('MetaSel ('Just "tickedShelleyLedgerState") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (NewEpochState era))))) | |||||||||
type AuxLedgerEvent (LedgerState (HardForkBlock xs)) | |||||||||
type AuxLedgerEvent (LedgerState (DualBlock m a)) | |||||||||
Defined in Ouroboros.Consensus.Ledger.Dual | |||||||||
type AuxLedgerEvent (LedgerState ByronBlock) | |||||||||
Defined in Ouroboros.Consensus.Byron.Ledger.Ledger | |||||||||
type AuxLedgerEvent (LedgerState (ShelleyBlock proto era)) | |||||||||
Defined in Ouroboros.Consensus.Shelley.Ledger.Ledger | |||||||||
type LedgerCfg (LedgerState (HardForkBlock xs)) | |||||||||
type LedgerCfg (LedgerState (DualBlock m a)) | |||||||||
Defined in Ouroboros.Consensus.Ledger.Dual | |||||||||
type LedgerCfg (LedgerState ByronBlock) | |||||||||
Defined in Ouroboros.Consensus.Byron.Ledger.Ledger | |||||||||
type LedgerCfg (LedgerState (ShelleyBlock proto era)) | |||||||||
Defined in Ouroboros.Consensus.Shelley.Ledger.Ledger | |||||||||
type LedgerErr (LedgerState (HardForkBlock xs)) | |||||||||
type LedgerErr (LedgerState (DualBlock m a)) | |||||||||
Defined in Ouroboros.Consensus.Ledger.Dual | |||||||||
type LedgerErr (LedgerState ByronBlock) | |||||||||
Defined in Ouroboros.Consensus.Byron.Ledger.Ledger | |||||||||
type LedgerErr (LedgerState (ShelleyBlock proto era)) | |||||||||
Defined in Ouroboros.Consensus.Shelley.Ledger.Ledger | |||||||||
newtype LedgerState (HardForkBlock xs) | |||||||||
data Ticked (LedgerState (HardForkBlock xs)) | |||||||||
data Ticked (LedgerState (DualBlock m a)) | |||||||||
Defined in Ouroboros.Consensus.Ledger.Dual | |||||||||
data Ticked (LedgerState ByronBlock) | The ticked Byron ledger state | ||||||||
data Ticked (LedgerState (ShelleyBlock proto era)) | Ticking only affects the state itself | ||||||||
Defined in Ouroboros.Consensus.Shelley.Ledger.Ledger data Ticked (LedgerState (ShelleyBlock proto era)) = TickedShelleyLedgerState {
| |||||||||
data LedgerState (DualBlock m a) | |||||||||
Defined in Ouroboros.Consensus.Ledger.Dual | |||||||||
data LedgerState (ShelleyBlock proto era) | |||||||||
Defined in Ouroboros.Consensus.Shelley.Ledger.Ledger data LedgerState (ShelleyBlock proto era) = ShelleyLedgerState {
|
getProgress :: SlotNo -> EraHistory -> Either PastHorizonException (RelativeTime, SlotLength) Source #
getSlotForRelativeTime :: RelativeTime -> EraHistory -> Either PastHorizonException SlotNo Source #
Returns the slot number for provided relative time from SystemStart
Internal conversion functions
toLedgerUTxO :: ShelleyBasedEra era -> UTxO era -> UTxO (ShelleyLedgerEra era) Source #
fromLedgerUTxO :: ShelleyBasedEra era -> UTxO (ShelleyLedgerEra era) -> UTxO era Source #