Safe Haskell | None |
---|---|
Language | Haskell2010 |
Synopsis
- runChainIndexEffects :: RunRequirements -> Eff '[ ChainIndexQueryEffect , ChainIndexControlEffect , BeamEffect Sqlite ] a -> IO ( Either ChainIndexError a)
- handleChainIndexEffects :: ( LastMember IO effs, Member ( LogMsg ChainIndexLog ) effs) => RunRequirements -> Eff ( ChainIndexQueryEffect ': ( ChainIndexControlEffect ': ( BeamEffect Sqlite ': effs))) a -> Eff effs ( Either ChainIndexError a)
-
data
RunRequirements
=
RunRequirements
{
- trace :: Trace IO ( PrettyObject ChainIndexLog )
- stateTVar :: TVar ChainIndexState
- pool :: Pool Connection
- securityParam :: Int
- pageOf :: Eq a => PageQuery a -> Set a -> Page a
-
data
PageQuery
a =
PageQuery
{
- pageQuerySize :: PageSize
- pageQueryLastItem :: Maybe a
- newtype PageSize = PageSize { }
-
data
Page
a =
Page
{
- currentPageQuery :: PageQuery a
- nextPageQuery :: Maybe ( PageQuery a)
- pageItems :: [a]
- data OutputDatum
- data Address = Address { }
- newtype Value = Value { }
- newtype BlockId = BlockId { }
-
data
ChainIndexTxOutputs
- = InvalidTx ( Maybe ChainIndexTxOut )
- | ValidTx [ ChainIndexTxOut ]
-
data
ChainIndexTxOut
=
ChainIndexTxOut
{
- citoAddress :: CardanoAddress
- citoValue :: Value
- citoDatum :: OutputDatum
- citoRefScript :: ReferenceScript
- data ReferenceScript
- fromReferenceScript :: ReferenceScript -> Maybe (Versioned Script )
-
data
ChainIndexTx
=
ChainIndexTx
{
- _citxTxId :: TxId
- _citxInputs :: [TxIn]
- _citxOutputs :: ChainIndexTxOutputs
- _citxValidRange :: !SlotRange
- _citxData :: Map DatumHash Datum
- _citxRedeemers :: Redeemers
- _citxScripts :: Map ScriptHash (Versioned Script )
- _citxCardanoTx :: Maybe CardanoTx
- _InvalidTx :: Prism' ChainIndexTxOutputs ( Maybe ChainIndexTxOut )
- _ValidTx :: Prism' ChainIndexTxOutputs [ ChainIndexTxOut ]
-
data
Tip
- = TipAtGenesis
-
|
Tip
{
- tipSlot :: Slot
- tipBlockId :: BlockId
- tipBlockNo :: BlockNumber
- newtype BlockNumber = BlockNumber { }
- citxCardanoTx :: Lens' ChainIndexTx ( Maybe CardanoTx)
- citxData :: Lens' ChainIndexTx ( Map DatumHash Datum )
- citxInputs :: Lens' ChainIndexTx [TxIn]
- citxOutputs :: Lens' ChainIndexTx ChainIndexTxOutputs
- citxRedeemers :: Lens' ChainIndexTx Redeemers
- citxScripts :: Lens' ChainIndexTx ( Map ScriptHash (Versioned Script ))
- citxTxId :: Lens' ChainIndexTx TxId
- citxValidRange :: Lens' ChainIndexTx SlotRange
- blockId :: Block -> BlockId
-
data
Point
- = PointAtGenesis
-
|
Point
{
- pointSlot :: Slot
- pointBlockId :: BlockId
- data TxOutBalance = TxOutBalance { }
-
data
TxConfirmedState
=
TxConfirmedState
{
- timesConfirmed :: Sum Int
- blockAdded :: Last BlockNumber
- validity :: Last TxValidity
-
data
TxIdState
=
TxIdState
{
- txnsConfirmed :: Map TxId TxConfirmedState
- txnsDeleted :: Map TxId ( Sum Int )
- data TxStatusFailure
-
data
Diagnostics
=
Diagnostics
{
- numTransactions :: Integer
- numScripts :: Integer
- numAddresses :: Integer
- numAssetClasses :: Integer
- numUnspentOutputs :: Int
- numUnmatchedInputs :: Int
- someTransactions :: [ TxId ]
- unspentTxOuts :: [ ChainIndexTxOut ]
- data TxOutState
- type TxOutStatus = RollbackState TxOutState
- data RollbackState a
- type TxStatus = RollbackState ()
- newtype Depth = Depth { }
-
data
TxValidity
- = TxValid
- | TxInvalid
- | UnknownValidity
- _PointAtGenesis :: Prism' Point ()
- _Point :: Prism' Point (Slot, BlockId )
- tipAsPoint :: Tip -> Point
- pointsToTip :: Point -> Tip -> Bool
- txOutStatusTxOutState :: TxOutStatus -> Maybe TxOutState
- liftTxOutStatus :: TxOutStatus -> TxStatus
- data TxUtxoBalance = TxUtxoBalance { }
- tobSpentOutputs :: Lens' TxOutBalance ( Map TxOutRef TxId )
- tobUnspentOutputs :: Lens' TxOutBalance ( Set TxOutRef )
-
data
ChainSyncBlock
=
Block
{
- blockTip :: Tip
- blockTxs :: [( ChainIndexTx , TxProcessOption )]
-
newtype
TxProcessOption
=
TxProcessOption
{
- tpoStoreTx :: Bool
- tubUnmatchedSpentInputs :: Lens' TxUtxoBalance ( Set TxOutRef )
- tubUnspentOutputs :: Lens' TxUtxoBalance ( Set TxOutRef )
-
data
RollbackFailed
- = RollbackNoTip
-
|
TipMismatch
{
- foundTip :: Tip
- targetPoint :: Point
- | OldPointNotFound Point
- data InsertUtxoFailed
-
data
ChainIndexError
- = InsertionFailed InsertUtxoFailed
- | RollbackFailed RollbackFailed
- | ResumeNotSupported
- | QueryFailedNoTip
- | BeamEffectError BeamError
- | ToCardanoError ToCardanoError
- txOuts :: ChainIndexTx -> [ ChainIndexTxOut ]
- txOutRefs :: ChainIndexTx -> [ TxOutRef ]
- txOutsWithRef :: ChainIndexTx -> [( ChainIndexTxOut , TxOutRef )]
- txOutRefMap :: ChainIndexTx -> Map TxOutRef ( ChainIndexTxOut , ChainIndexTx )
- txOutRefMapForAddr :: CardanoAddress -> ChainIndexTx -> Map TxOutRef ( ChainIndexTxOut , ChainIndexTx )
- validityFromChainIndex :: ChainIndexTx -> TxValidity
- fromOnChainTx :: OnChainTx -> ChainIndexTx
- txRedeemersWithHash :: ChainIndexTx -> Map RedeemerHash Redeemer
-
data
ChainIndexQueryEffect
r
where
- DatumFromHash :: DatumHash -> ChainIndexQueryEffect ( Maybe Datum )
- ValidatorFromHash :: ValidatorHash -> ChainIndexQueryEffect ( Maybe (Versioned Validator ))
- MintingPolicyFromHash :: MintingPolicyHash -> ChainIndexQueryEffect ( Maybe (Versioned MintingPolicy ))
- RedeemerFromHash :: RedeemerHash -> ChainIndexQueryEffect ( Maybe Redeemer )
- StakeValidatorFromHash :: StakeValidatorHash -> ChainIndexQueryEffect ( Maybe (Versioned StakeValidator ))
- UnspentTxOutFromRef :: TxOutRef -> ChainIndexQueryEffect ( Maybe DecoratedTxOut)
- TxOutFromRef :: TxOutRef -> ChainIndexQueryEffect ( Maybe DecoratedTxOut)
- TxFromTxId :: TxId -> ChainIndexQueryEffect ( Maybe ChainIndexTx )
- UtxoSetMembership :: TxOutRef -> ChainIndexQueryEffect IsUtxoResponse
- UtxoSetAtAddress :: PageQuery TxOutRef -> Credential -> ChainIndexQueryEffect UtxosResponse
- UnspentTxOutSetAtAddress :: PageQuery TxOutRef -> Credential -> ChainIndexQueryEffect ( QueryResponse [( TxOutRef , DecoratedTxOut)])
- DatumsAtAddress :: PageQuery TxOutRef -> Credential -> ChainIndexQueryEffect ( QueryResponse [ Datum ])
- UtxoSetWithCurrency :: PageQuery TxOutRef -> AssetClass -> ChainIndexQueryEffect UtxosResponse
- TxsFromTxIds :: [ TxId ] -> ChainIndexQueryEffect [ ChainIndexTx ]
- TxoSetAtAddress :: PageQuery TxOutRef -> Credential -> ChainIndexQueryEffect TxosResponse
- GetTip :: ChainIndexQueryEffect Tip
-
data
ChainIndexControlEffect
r
where
- AppendBlocks :: [ ChainSyncBlock ] -> ChainIndexControlEffect ()
- Rollback :: Point -> ChainIndexControlEffect ()
- ResumeSync :: Point -> ChainIndexControlEffect ()
- CollectGarbage :: ChainIndexControlEffect ()
- GetDiagnostics :: ChainIndexControlEffect Diagnostics
- datumFromHash :: forall effs. Member ChainIndexQueryEffect effs => DatumHash -> Eff effs ( Maybe Datum )
- validatorFromHash :: forall effs. Member ChainIndexQueryEffect effs => ValidatorHash -> Eff effs ( Maybe (Versioned Validator ))
- mintingPolicyFromHash :: forall effs. Member ChainIndexQueryEffect effs => MintingPolicyHash -> Eff effs ( Maybe (Versioned MintingPolicy ))
- redeemerFromHash :: forall effs. Member ChainIndexQueryEffect effs => RedeemerHash -> Eff effs ( Maybe Redeemer )
- stakeValidatorFromHash :: forall effs. Member ChainIndexQueryEffect effs => StakeValidatorHash -> Eff effs ( Maybe (Versioned StakeValidator ))
- unspentTxOutFromRef :: forall effs. Member ChainIndexQueryEffect effs => TxOutRef -> Eff effs ( Maybe DecoratedTxOut)
- txOutFromRef :: forall effs. Member ChainIndexQueryEffect effs => TxOutRef -> Eff effs ( Maybe DecoratedTxOut)
- txFromTxId :: forall effs. Member ChainIndexQueryEffect effs => TxId -> Eff effs ( Maybe ChainIndexTx )
- utxoSetMembership :: forall effs. Member ChainIndexQueryEffect effs => TxOutRef -> Eff effs IsUtxoResponse
- utxoSetAtAddress :: forall effs. Member ChainIndexQueryEffect effs => PageQuery TxOutRef -> Credential -> Eff effs UtxosResponse
- unspentTxOutSetAtAddress :: forall effs. Member ChainIndexQueryEffect effs => PageQuery TxOutRef -> Credential -> Eff effs ( QueryResponse [( TxOutRef , DecoratedTxOut)])
- datumsAtAddress :: forall effs. Member ChainIndexQueryEffect effs => PageQuery TxOutRef -> Credential -> Eff effs ( QueryResponse [ Datum ])
- utxoSetWithCurrency :: forall effs. Member ChainIndexQueryEffect effs => PageQuery TxOutRef -> AssetClass -> Eff effs UtxosResponse
- txsFromTxIds :: forall effs. Member ChainIndexQueryEffect effs => [ TxId ] -> Eff effs [ ChainIndexTx ]
- txoSetAtAddress :: forall effs. Member ChainIndexQueryEffect effs => PageQuery TxOutRef -> Credential -> Eff effs TxosResponse
- getTip :: forall effs. Member ChainIndexQueryEffect effs => Eff effs Tip
- appendBlocks :: forall effs. Member ChainIndexControlEffect effs => [ ChainSyncBlock ] -> Eff effs ()
- rollback :: forall effs. Member ChainIndexControlEffect effs => Point -> Eff effs ()
- resumeSync :: forall effs. Member ChainIndexControlEffect effs => Point -> Eff effs ()
- collectGarbage :: forall effs. Member ChainIndexControlEffect effs => Eff effs ()
- getDiagnostics :: forall effs. Member ChainIndexControlEffect effs => Eff effs Diagnostics
- data InsertUtxoPosition
-
data
ChainIndexLog
- = InsertionSuccess Tip InsertUtxoPosition
- | ConversionFailed FromCardanoError
- | RollbackSuccess Tip
- | Err ChainIndexError
- | TxNotFound TxId
- | TxOutNotFound TxOutRef
- | TipIsGenesis
- | NoDatumScriptAddr ChainIndexTxOut
- | BeamLogItem BeamLog
-
data
UtxoState
a =
UtxoState
{
- _usTxUtxoData :: a
- _usTip :: Tip
-
data
ReduceBlockCountResult
a
- = BlockCountNotReduced
-
|
ReduceBlockCountResult
{
- reducedIndex :: UtxoIndex a
- combinedState :: UtxoState a
-
data
RollbackResult
a =
RollbackResult
{
- newTip :: Tip
- rolledBackIndex :: UtxoIndex a
- data InsertUtxoSuccess a = InsertUtxoSuccess { }
- type UtxoIndex a = FingerTree ( BlockCount , UtxoState a) ( UtxoState a)
-
newtype
BlockCount
=
BlockCount
{
- getBlockCount :: Int
- usTip :: forall a. Lens' ( UtxoState a) Tip
- usTxUtxoData :: forall a a. Lens ( UtxoState a) ( UtxoState a) a a
- utxoState :: Monoid a => UtxoIndex a -> UtxoState a
- utxoBlockCount :: Monoid a => UtxoIndex a -> Int
- tip :: UtxoState a -> Tip
- viewTip :: Monoid a => UtxoIndex a -> Tip
- insert :: ( Monoid a, Eq a) => UtxoState a -> UtxoIndex a -> Either InsertUtxoFailed ( InsertUtxoSuccess a)
- rollbackWith :: Monoid a => ( UtxoIndex a -> UtxoIndex a -> UtxoIndex a) -> Point -> UtxoIndex a -> Either RollbackFailed ( RollbackResult a)
- reduceBlockCount :: Monoid a => Depth -> UtxoIndex a -> ReduceBlockCountResult a
- pointLessThanTip :: Point -> Tip -> Bool
- initialStatus :: OnChainTx -> TxStatus
- increaseDepth :: TxStatus -> TxStatus
- chainConstant :: Depth
- dropOlder :: Monoid a => BlockNumber -> UtxoIndex a -> UtxoIndex a
- transactionStatus :: BlockNumber -> TxIdState -> TxId -> Either TxStatusFailure TxStatus
- transactionOutputStatus :: BlockNumber -> TxIdState -> TxOutBalance -> TxOutRef -> Either TxStatusFailure TxOutStatus
- transactionOutputState :: TxOutBalance -> TxOutRef -> Maybe TxOutState
- unspentOutputs :: UtxoState TxOutBalance -> Set TxOutRef
- spentOutputs :: UtxoState TxOutBalance -> Set TxOutRef
- type ChainIndexState = UtxoIndex TxUtxoBalance
- getResumePoints :: Member ( BeamEffect Sqlite ) effs => Eff effs [ ChainPoint ]
- handleQuery :: ( Member ( State ChainIndexState ) effs, Member ( BeamEffect Sqlite ) effs, Member ( Error ChainIndexError ) effs, Member ( LogMsg ChainIndexLog ) effs) => ChainIndexQueryEffect ~> Eff effs
- handleControl :: forall effs. ( Member ( State ChainIndexState ) effs, Member ( Reader Depth ) effs, Member ( BeamEffect Sqlite ) effs, Member ( Error ChainIndexError ) effs, Member ( LogMsg ChainIndexLog ) effs) => ChainIndexControlEffect ~> Eff effs
- restoreStateFromDb :: Member ( BeamEffect Sqlite ) effs => Eff effs ChainIndexState
Documentation
runChainIndexEffects :: RunRequirements -> Eff '[ ChainIndexQueryEffect , ChainIndexControlEffect , BeamEffect Sqlite ] a -> IO ( Either ChainIndexError a) Source #
Run the chain index effects.
handleChainIndexEffects :: ( LastMember IO effs, Member ( LogMsg ChainIndexLog ) effs) => RunRequirements -> Eff ( ChainIndexQueryEffect ': ( ChainIndexControlEffect ': ( BeamEffect Sqlite ': effs))) a -> Eff effs ( Either ChainIndexError a) Source #
Handle the chain index effects from the set of all effects.
data RunRequirements Source #
The required arguments to run the chain index effects.
RunRequirements | |
|
Query parameters for pagination.
PageQuery | |
|
Instances
Instances
Part of a collection.
Instances
data OutputDatum Source #
The datum attached to an output: either nothing; a datum hash; or the datum itself (an "inline datum").
Instances
Address with two kinds of credentials, normal and staking.
Instances
A cryptocurrency value. This is a map from
CurrencySymbol
s to a
quantity of that currency.
Operations on currencies are usually implemented
pointwise
. That is,
we apply the operation to the quantities for each currency in turn. So
when we add two
Value
s the resulting
Value
has, for each currency,
the sum of the quantities of
that particular
currency in the argument
Value
. The effect of this is that the currencies in the
Value
are "independent",
and are operated on separately.
Whenever we need to get the quantity of a currency in a
Value
where there
is no explicit quantity of that currency in the
Value
, then the quantity is
taken to be zero.
See note [Currencies] for more details.
Instances
Instances
Eq BlockId | |
Ord BlockId | |
Show BlockId | |
Generic BlockId | |
ToJSON BlockId | |
FromJSON BlockId | |
ToSchema BlockId Source # | |
Defined in Plutus.ChainIndex.Types declareNamedSchema :: Proxy BlockId -> Declare ( Definitions Schema ) NamedSchema Source # |
|
Pretty BlockId | |
HasDbType BlockId Source # | |
type Rep BlockId | |
Defined in Ledger.Blockchain
type
Rep
BlockId
=
D1
('
MetaData
"BlockId" "Ledger.Blockchain" "plutus-ledger-1.2.0.0-5ZNFySGahCv2fMTEPkrA76" '
True
) (
C1
('
MetaCons
"BlockId" '
PrefixI
'
True
) (
S1
('
MetaSel
('
Just
"getBlockId") '
NoSourceUnpackedness
'
NoSourceStrictness
'
DecidedLazy
) (
Rec0
ByteString
)))
|
|
type DbType BlockId Source # | |
Defined in Plutus.ChainIndex.DbSchema |
data ChainIndexTxOutputs Source #
List of outputs of a transaction. There is only an optional collateral output if the transaction is invalid.
InvalidTx ( Maybe ChainIndexTxOut ) |
The transaction is invalid so there is maybe a collateral output. |
ValidTx [ ChainIndexTxOut ] |
Instances
data ChainIndexTxOut Source #
ChainIndexTxOut | |
|
Instances
data ReferenceScript Source #
Instances
fromReferenceScript :: ReferenceScript -> Maybe (Versioned Script ) Source #
data ChainIndexTx Source #
ChainIndexTx | |
|
Instances
The tip of the chain index.
TipAtGenesis | |
Tip | |
|
Instances
newtype BlockNumber Source #
Instances
citxCardanoTx :: Lens' ChainIndexTx ( Maybe CardanoTx) Source #
citxInputs :: Lens' ChainIndexTx [TxIn] Source #
citxScripts :: Lens' ChainIndexTx ( Map ScriptHash (Versioned Script )) Source #
citxValidRange :: Lens' ChainIndexTx SlotRange Source #
When performing a rollback the chain sync protocol does not provide a block number where to resume from.
PointAtGenesis | |
Point | |
|
Instances
Eq Point Source # | |
Ord Point Source # | |
Defined in Plutus.ChainIndex.Types |
|
Show Point Source # | |
Generic Point Source # | |
Semigroup Point Source # | |
Monoid Point Source # | |
ToJSON Point Source # | |
FromJSON Point Source # | |
Pretty Point Source # | |
type Rep Point Source # | |
Defined in Plutus.ChainIndex.Types
type
Rep
Point
=
D1
('
MetaData
"Point" "Plutus.ChainIndex.Types" "plutus-chain-index-core-1.2.0.0-vEgAIGWZqMIuVHBPih2W5" '
False
) (
C1
('
MetaCons
"PointAtGenesis" '
PrefixI
'
False
) (
U1
::
Type
->
Type
)
:+:
C1
('
MetaCons
"Point" '
PrefixI
'
True
) (
S1
('
MetaSel
('
Just
"pointSlot") '
NoSourceUnpackedness
'
NoSourceStrictness
'
DecidedStrict
) (
Rec0
Slot)
:*:
S1
('
MetaSel
('
Just
"pointBlockId") '
NoSourceUnpackedness
'
NoSourceStrictness
'
DecidedStrict
) (
Rec0
BlockId
)))
|
data TxOutBalance Source #
The effect of a transaction (or a number of them) on the tx output set.
TxOutBalance | |
|
Instances
data TxConfirmedState Source #
TxConfirmedState | |
|
Instances
TxIdState | |
|
Instances
Eq TxIdState Source # | |
Show TxIdState Source # | |
Generic TxIdState Source # | |
Semigroup TxIdState Source # | |
Monoid TxIdState Source # | |
type Rep TxIdState Source # | |
Defined in Plutus.ChainIndex.Types
type
Rep
TxIdState
=
D1
('
MetaData
"TxIdState" "Plutus.ChainIndex.Types" "plutus-chain-index-core-1.2.0.0-vEgAIGWZqMIuVHBPih2W5" '
False
) (
C1
('
MetaCons
"TxIdState" '
PrefixI
'
True
) (
S1
('
MetaSel
('
Just
"txnsConfirmed") '
NoSourceUnpackedness
'
NoSourceStrictness
'
DecidedStrict
) (
Rec0
(
Map
TxId
TxConfirmedState
))
:*:
S1
('
MetaSel
('
Just
"txnsDeleted") '
NoSourceUnpackedness
'
NoSourceStrictness
'
DecidedStrict
) (
Rec0
(
Map
TxId
(
Sum
Int
)))))
|
data TxStatusFailure Source #
Datatype returned when we couldn't get the state of a tx or a tx output.
TxIdStateInvalid BlockNumber TxId TxIdState |
We couldn't return the status because the
|
TxOutBalanceStateInvalid BlockNumber TxOutRef TxOutBalance |
We couldn't return the status because the
|
InvalidRollbackAttempt BlockNumber TxId TxIdState |
Instances
Eq TxStatusFailure Source # | |
Defined in Plutus.ChainIndex.Types (==) :: TxStatusFailure -> TxStatusFailure -> Bool Source # (/=) :: TxStatusFailure -> TxStatusFailure -> Bool Source # |
|
Show TxStatusFailure Source # | |
Defined in Plutus.ChainIndex.Types |
data Diagnostics Source #
Diagnostics | |
|
Instances
data TxOutState Source #
Instances
type TxOutStatus = RollbackState TxOutState Source #
data RollbackState a Source #
The rollback state of a Cardano transaction
Unknown |
The transaction is not on the chain. That's all we can say. |
TentativelyConfirmed Depth TxValidity a |
The transaction is on the chain, n blocks deep. It can still be rolled back. |
Committed TxValidity a |
The transaction is on the chain. It cannot be rolled back anymore. |
Instances
type TxStatus = RollbackState () Source #
The status of a Cardano transaction
How many blocks deep the tx is on the chain
Instances
Enum Depth Source # | |
Defined in Plutus.ChainIndex.Types succ :: Depth -> Depth Source # pred :: Depth -> Depth Source # toEnum :: Int -> Depth Source # fromEnum :: Depth -> Int Source # enumFrom :: Depth -> [ Depth ] Source # enumFromThen :: Depth -> Depth -> [ Depth ] Source # enumFromTo :: Depth -> Depth -> [ Depth ] Source # enumFromThenTo :: Depth -> Depth -> Depth -> [ Depth ] Source # |
|
Eq Depth Source # | |
Integral Depth Source # | |
Defined in Plutus.ChainIndex.Types |
|
Num Depth Source # | |
Ord Depth Source # | |
Defined in Plutus.ChainIndex.Types |
|
Real Depth Source # | |
Defined in Plutus.ChainIndex.Types toRational :: Depth -> Rational Source # |
|
Show Depth Source # | |
Generic Depth Source # | |
ToJSON Depth Source # | |
FromJSON Depth Source # | |
Pretty Depth Source # | |
MeetSemiLattice Depth Source # | |
type Rep Depth Source # | |
Defined in Plutus.ChainIndex.Types |
data TxValidity Source #
Validity of a transaction that has been added to the ledger
Instances
_PointAtGenesis :: Prism' Point () Source #
tipAsPoint :: Tip -> Point Source #
txOutStatusTxOutState :: TxOutStatus -> Maybe TxOutState Source #
Maybe extract the
TxOutState
(Spent or Unspent) of a
TxOutStatus
.
liftTxOutStatus :: TxOutStatus -> TxStatus Source #
Converts a
TxOutStatus
to a
TxStatus
. Possible since a transaction
output belongs to a transaction.
Note, however, that we can't convert a
TxStatus
to a
TxOutStatus
.
data TxUtxoBalance Source #
The effect of a transaction (or a number of them) on the utxo set.
TxUtxoBalance | |
|
Instances
tobSpentOutputs :: Lens' TxOutBalance ( Map TxOutRef TxId ) Source #
tobUnspentOutputs :: Lens' TxOutBalance ( Set TxOutRef ) Source #
data ChainSyncBlock Source #
A block of transactions to be synced.
Block | |
|
Instances
Show ChainSyncBlock Source # | |
Defined in Plutus.ChainIndex.Types |
newtype TxProcessOption Source #
User-customizable options to process a transaction. See #73 for more motivations.
TxProcessOption | |
|
Instances
Show TxProcessOption Source # | |
Defined in Plutus.ChainIndex.Types |
|
Default TxProcessOption Source # | |
Defined in Plutus.ChainIndex.Types |
data RollbackFailed Source #
Reason why the
rollback
operation failed
RollbackNoTip |
Rollback failed because the utxo index had no tip (not synchronised) |
TipMismatch |
Unable to roll back to
|
|
|
OldPointNotFound Point |
Unable to find the old tip |
Instances
data InsertUtxoFailed Source #
UTXO state could not be inserted into the chain index
DuplicateBlock Tip |
Insertion failed as there was already a block with the given number |
InsertUtxoNoTip |
The
|
Instances
data ChainIndexError Source #
InsertionFailed InsertUtxoFailed | |
RollbackFailed RollbackFailed | |
ResumeNotSupported | |
QueryFailedNoTip |
Query failed because the chain index does not have a tip (not synchronised with node) |
BeamEffectError BeamError | |
ToCardanoError ToCardanoError |
Instances
txOuts :: ChainIndexTx -> [ ChainIndexTxOut ] Source #
Get tx outputs from tx.
txOutRefs :: ChainIndexTx -> [ TxOutRef ] Source #
Get tx output references from tx.
txOutsWithRef :: ChainIndexTx -> [( ChainIndexTxOut , TxOutRef )] Source #
Get tx output references and tx outputs from tx.
txOutRefMap :: ChainIndexTx -> Map TxOutRef ( ChainIndexTxOut , ChainIndexTx ) Source #
Get
Map
of tx outputs references to tx.
txOutRefMapForAddr :: CardanoAddress -> ChainIndexTx -> Map TxOutRef ( ChainIndexTxOut , ChainIndexTx ) Source #
Get
Map
of tx outputs from tx for a specific address.
fromOnChainTx :: OnChainTx -> ChainIndexTx Source #
Convert a
OnChainTx
to a
ChainIndexTx
. An invalid
OnChainTx
will not
produce any
ChainIndexTx
outputs and the collateral inputs of the
OnChainTx
will be the inputs of the
ChainIndexTx
.
Cardano api transactions store validity internally. Our emulated blockchain stores validity outside of the transactions, so we need to make sure these match up.
data ChainIndexQueryEffect r where Source #
DatumFromHash :: DatumHash -> ChainIndexQueryEffect ( Maybe Datum ) |
Get the datum from a datum hash (if available) |
ValidatorFromHash :: ValidatorHash -> ChainIndexQueryEffect ( Maybe (Versioned Validator )) |
Get the validator from a validator hash (if available) |
MintingPolicyFromHash :: MintingPolicyHash -> ChainIndexQueryEffect ( Maybe (Versioned MintingPolicy )) |
Get the monetary policy from an MPS hash (if available) |
RedeemerFromHash :: RedeemerHash -> ChainIndexQueryEffect ( Maybe Redeemer ) |
Get the redeemer from a redeemer hash (if available) |
StakeValidatorFromHash :: StakeValidatorHash -> ChainIndexQueryEffect ( Maybe (Versioned StakeValidator )) |
Get the stake validator from a stake validator hash (if available) |
UnspentTxOutFromRef :: TxOutRef -> ChainIndexQueryEffect ( Maybe DecoratedTxOut) |
Get the TxOut from a TxOutRef (if available) |
TxOutFromRef :: TxOutRef -> ChainIndexQueryEffect ( Maybe DecoratedTxOut) |
Get the TxOut from a TxOutRef (if available) |
TxFromTxId :: TxId -> ChainIndexQueryEffect ( Maybe ChainIndexTx ) |
Get the transaction for a tx ID |
UtxoSetMembership :: TxOutRef -> ChainIndexQueryEffect IsUtxoResponse |
Whether a tx output is part of the UTXO set |
UtxoSetAtAddress :: PageQuery TxOutRef -> Credential -> ChainIndexQueryEffect UtxosResponse |
Unspent outputs located at addresses with the given credential. |
UnspentTxOutSetAtAddress :: PageQuery TxOutRef -> Credential -> ChainIndexQueryEffect ( QueryResponse [( TxOutRef , DecoratedTxOut)]) |
Get the unspent txouts located at an address This is to avoid multiple queries from chain-index when using utxosAt |
DatumsAtAddress :: PageQuery TxOutRef -> Credential -> ChainIndexQueryEffect ( QueryResponse [ Datum ]) |
get the datums located at addresses with the given credential. |
UtxoSetWithCurrency :: PageQuery TxOutRef -> AssetClass -> ChainIndexQueryEffect UtxosResponse |
Unspent outputs containing a specific currency (
Note that requesting unspent outputs containing Ada should not return anything, as this request will always return all unspent outputs. |
TxsFromTxIds :: [ TxId ] -> ChainIndexQueryEffect [ ChainIndexTx ] |
Get the transactions for a list of tx IDs. |
TxoSetAtAddress :: PageQuery TxOutRef -> Credential -> ChainIndexQueryEffect TxosResponse |
Outputs located at addresses with the given credential. |
GetTip :: ChainIndexQueryEffect Tip |
Get the tip of the chain index |
data ChainIndexControlEffect r where Source #
AppendBlocks :: [ ChainSyncBlock ] -> ChainIndexControlEffect () |
Add new blocks to the chain index. |
Rollback :: Point -> ChainIndexControlEffect () |
Roll back to a previous state (previous tip) |
ResumeSync :: Point -> ChainIndexControlEffect () |
Resume syncing from a certain point |
CollectGarbage :: ChainIndexControlEffect () |
Delete all data that is not covered by current UTxOs. |
GetDiagnostics :: ChainIndexControlEffect Diagnostics |
datumFromHash :: forall effs. Member ChainIndexQueryEffect effs => DatumHash -> Eff effs ( Maybe Datum ) Source #
validatorFromHash :: forall effs. Member ChainIndexQueryEffect effs => ValidatorHash -> Eff effs ( Maybe (Versioned Validator )) Source #
mintingPolicyFromHash :: forall effs. Member ChainIndexQueryEffect effs => MintingPolicyHash -> Eff effs ( Maybe (Versioned MintingPolicy )) Source #
redeemerFromHash :: forall effs. Member ChainIndexQueryEffect effs => RedeemerHash -> Eff effs ( Maybe Redeemer ) Source #
stakeValidatorFromHash :: forall effs. Member ChainIndexQueryEffect effs => StakeValidatorHash -> Eff effs ( Maybe (Versioned StakeValidator )) Source #
unspentTxOutFromRef :: forall effs. Member ChainIndexQueryEffect effs => TxOutRef -> Eff effs ( Maybe DecoratedTxOut) Source #
txOutFromRef :: forall effs. Member ChainIndexQueryEffect effs => TxOutRef -> Eff effs ( Maybe DecoratedTxOut) Source #
txFromTxId :: forall effs. Member ChainIndexQueryEffect effs => TxId -> Eff effs ( Maybe ChainIndexTx ) Source #
utxoSetMembership :: forall effs. Member ChainIndexQueryEffect effs => TxOutRef -> Eff effs IsUtxoResponse Source #
utxoSetAtAddress :: forall effs. Member ChainIndexQueryEffect effs => PageQuery TxOutRef -> Credential -> Eff effs UtxosResponse Source #
unspentTxOutSetAtAddress :: forall effs. Member ChainIndexQueryEffect effs => PageQuery TxOutRef -> Credential -> Eff effs ( QueryResponse [( TxOutRef , DecoratedTxOut)]) Source #
datumsAtAddress :: forall effs. Member ChainIndexQueryEffect effs => PageQuery TxOutRef -> Credential -> Eff effs ( QueryResponse [ Datum ]) Source #
utxoSetWithCurrency :: forall effs. Member ChainIndexQueryEffect effs => PageQuery TxOutRef -> AssetClass -> Eff effs UtxosResponse Source #
txsFromTxIds :: forall effs. Member ChainIndexQueryEffect effs => [ TxId ] -> Eff effs [ ChainIndexTx ] Source #
txoSetAtAddress :: forall effs. Member ChainIndexQueryEffect effs => PageQuery TxOutRef -> Credential -> Eff effs TxosResponse Source #
appendBlocks :: forall effs. Member ChainIndexControlEffect effs => [ ChainSyncBlock ] -> Eff effs () Source #
resumeSync :: forall effs. Member ChainIndexControlEffect effs => Point -> Eff effs () Source #
collectGarbage :: forall effs. Member ChainIndexControlEffect effs => Eff effs () Source #
getDiagnostics :: forall effs. Member ChainIndexControlEffect effs => Eff effs Diagnostics Source #
data InsertUtxoPosition Source #
Outcome of inserting a
UtxoState
into the utxo index
InsertAtEnd |
The utxo state was added to the end. Returns the new index |
InsertBeforeEnd |
The utxo state was added somewhere before the end. Returns the new index and the tip |
Instances
data ChainIndexLog Source #
Instances
UTXO / ledger state, kept in memory. We are only interested in the UTXO set, everything else is stored on disk. This is OK because we don't need to validate transactions when they come in.
UtxoState | |
|
Instances
data ReduceBlockCountResult a Source #
data RollbackResult a Source #
RollbackResult | |
|
data InsertUtxoSuccess a Source #
Instances
Pretty ( InsertUtxoSuccess a) Source # | |
Defined in Plutus.ChainIndex.UtxoState pretty :: InsertUtxoSuccess a -> Doc ann Source # prettyList :: [ InsertUtxoSuccess a] -> Doc ann Source # |
type UtxoIndex a = FingerTree ( BlockCount , UtxoState a) ( UtxoState a) Source #
newtype BlockCount Source #
Instances
Semigroup BlockCount Source # | |
Defined in Plutus.ChainIndex.UtxoState (<>) :: BlockCount -> BlockCount -> BlockCount Source # sconcat :: NonEmpty BlockCount -> BlockCount Source # stimes :: Integral b => b -> BlockCount -> BlockCount Source # |
|
Monoid BlockCount Source # | |
Defined in Plutus.ChainIndex.UtxoState mempty :: BlockCount Source # mappend :: BlockCount -> BlockCount -> BlockCount Source # mconcat :: [ BlockCount ] -> BlockCount Source # |
|
Monoid a => Measured ( BlockCount , UtxoState a) ( UtxoState a) Source # | |
Defined in Plutus.ChainIndex.UtxoState |
insert :: ( Monoid a, Eq a) => UtxoState a -> UtxoIndex a -> Either InsertUtxoFailed ( InsertUtxoSuccess a) Source #
Insert a
UtxoState
into the index
:: Monoid a | |
=> ( UtxoIndex a -> UtxoIndex a -> UtxoIndex a) |
Calculate the new index given the index before and the index after the rollback point. |
-> Point | |
-> UtxoIndex a | |
-> Either RollbackFailed ( RollbackResult a) |
Perform a rollback on the utxo index, with a callback to calculate the new index.
reduceBlockCount :: Monoid a => Depth -> UtxoIndex a -> ReduceBlockCountResult a Source #
pointLessThanTip :: Point -> Tip -> Bool Source #
Is the given point earlier than the provided tip. Yes, if the point is the genersis point, no if the tip is the genesis point, otherwise, just compare the slots.
initialStatus :: OnChainTx -> TxStatus Source #
The
TxStatus
of a transaction right after it was added to the chain
increaseDepth :: TxStatus -> TxStatus Source #
Increase the depth of a tentatively confirmed transaction
chainConstant :: Depth Source #
The depth (in blocks) after which a transaction cannot be rolled back anymore
dropOlder :: Monoid a => BlockNumber -> UtxoIndex a -> UtxoIndex a Source #
Drop everything older than
BlockNumber
in the index.
transactionStatus :: BlockNumber -> TxIdState -> TxId -> Either TxStatusFailure TxStatus Source #
Given the current block, compute the status for the given transaction by checking to see if it has been deleted.
transactionOutputStatus Source #
:: BlockNumber |
Current block number for inspecting the state of the transaction output |
-> TxIdState |
Information on the state of a transaction. Needed for determining its status. |
-> TxOutBalance |
Balance of spent and unspent transaction outputs. |
-> TxOutRef |
Target transaction output for inspecting its state. |
-> Either TxStatusFailure TxOutStatus |
Given the current block, compute the status for the given transaction output by getting the state of the transaction that produced it and checking if the output is spent or unspent.
unspentOutputs :: UtxoState TxOutBalance -> Set TxOutRef Source #
The UTXO set
spentOutputs :: UtxoState TxOutBalance -> Set TxOutRef Source #
The spent output set
type ChainIndexState = UtxoIndex TxUtxoBalance Source #
getResumePoints :: Member ( BeamEffect Sqlite ) effs => Eff effs [ ChainPoint ] Source #
handleQuery :: ( Member ( State ChainIndexState ) effs, Member ( BeamEffect Sqlite ) effs, Member ( Error ChainIndexError ) effs, Member ( LogMsg ChainIndexLog ) effs) => ChainIndexQueryEffect ~> Eff effs Source #
handleControl :: forall effs. ( Member ( State ChainIndexState ) effs, Member ( Reader Depth ) effs, Member ( BeamEffect Sqlite ) effs, Member ( Error ChainIndexError ) effs, Member ( LogMsg ChainIndexLog ) effs) => ChainIndexControlEffect ~> Eff effs Source #
restoreStateFromDb :: Member ( BeamEffect Sqlite ) effs => Eff effs ChainIndexState Source #