Safe Haskell | Safe-Inferred |
---|---|
Language | GHC2021 |
Hydra.Chain.Blockfrost.Client
Synopsis
- data BlockfrostException
- newtype APIBlockfrostError = BlockfrostError BlockfrostException
- data BlockfrostConversion = BlockfrostConversion {
- a0 :: NonNegativeInterval
- rho :: UnitInterval
- tau :: UnitInterval
- priceMemory :: NonNegativeInterval
- priceSteps :: NonNegativeInterval
- pvtMotionNoConfidence :: UnitInterval
- pvtCommitteeNormal :: UnitInterval
- pvtCommitteeNoConfidence :: UnitInterval
- pvtHardForkInitiation :: UnitInterval
- pvtPPSecurityGroup :: UnitInterval
- dvtMotionNoConfidence :: UnitInterval
- dvtCommitteeNormal :: UnitInterval
- dvtCommitteeNoConfidence :: UnitInterval
- dvtUpdateToConstitution :: UnitInterval
- dvtHardForkInitiation :: UnitInterval
- dvtPPNetworkGroup :: UnitInterval
- dvtPPEconomicGroup :: UnitInterval
- dvtPPTechnicalGroup :: UnitInterval
- dvtPPGovGroup :: UnitInterval
- dvtTreasuryWithdrawal :: UnitInterval
- committeeMinSize :: Quantity
- committeeMaxTermLength :: Quantity
- govActionLifetime :: Quantity
- govActionDeposit :: Coin
- drepDeposit :: Integer
- drepActivity :: Quantity
- minFeeRefScriptCostPerByte :: NonNegativeInterval
- queryGenesisParameters :: BlockfrostClientT IO Genesis
- queryUTxOByTxIn :: NetworkId -> Text -> BlockfrostClientT IO UTxO
- queryScriptRegistry :: [TxId] -> BlockfrostClientT IO ScriptRegistry
- runBlockfrostM :: (MonadIO m, MonadThrow m) => Project -> BlockfrostClientT IO a -> m a
- toCardanoNetworkId :: Integer -> NetworkId
- queryProtocolParameters :: MonadIO m => BlockfrostClientT m (PParams LedgerEra)
- scriptTypeToPlutusVersion :: ScriptType -> Maybe Language
- toCardanoUTxO :: NetworkId -> TxIn -> Address -> Maybe ScriptHash -> Maybe DatumHash -> [Amount] -> Maybe InlineDatum -> BlockfrostClientT IO (UTxO' (TxOut ctx))
- toCardanoValue :: [Amount] -> BlockfrostClientT IO Value
- queryScript :: Text -> BlockfrostClientT IO (Maybe PlutusScript)
- toCardanoTxOut :: NetworkId -> Text -> Value -> Maybe Text -> Maybe Text -> Maybe PlutusScript -> BlockfrostClientT IO (TxOut ctx)
- toCardanoPoolId :: PoolId -> Hash StakePoolKey
- toCardanoTxIn :: Text -> Integer -> TxIn
- toCardanoAddress :: Text -> Maybe AddressInEra
- toCardanoPolicyIdAndAssetName :: Text -> BlockfrostClientT IO (PolicyId, AssetName)
- toCardanoGenesisParameters :: Genesis -> GenesisParameters ShelleyEra
- submitTransaction :: MonadIO m => Tx -> BlockfrostClientT m TxHash
- queryEraHistory :: BlockfrostClientT IO EraHistory
- queryUTxO :: NetworkId -> [Address ShelleyAddr] -> BlockfrostClientT IO UTxO
- queryUTxOFor :: VerificationKey PaymentKey -> BlockfrostClientT IO UTxO
- querySystemStart :: BlockfrostClientT IO SystemStart
- queryTip :: BlockfrostClientT IO ChainPoint
- queryStakePools :: BlockfrostClientT IO (Set PoolId)
- awaitTransaction :: Tx -> BlockfrostClientT IO UTxO
- awaitUTxO :: NetworkId -> [Address ShelleyAddr] -> TxId -> Int -> BlockfrostClientT IO UTxO
- data Block = Block {
- _blockTime :: POSIXTime
- _blockHeight :: Maybe Integer
- _blockHash :: BlockHash
- _blockSlot :: Maybe Slot
- _blockEpoch :: Maybe Epoch
- _blockEpochSlot :: Maybe Integer
- _blockSlotLeader :: Text
- _blockSize :: Integer
- _blockTxCount :: Integer
- _blockOutput :: Maybe Lovelaces
- _blockFees :: Maybe Lovelaces
- _blockBlockVrf :: Maybe Text
- _blockOpCert :: Maybe Text
- _blockOpCertCounter :: Maybe Quantity
- _blockPreviousBlock :: Maybe BlockHash
- _blockNextBlock :: Maybe BlockHash
- _blockConfirmations :: Integer
- newtype Slot = Slot Integer
- newtype BlockHash = BlockHash Text
- data BlockfrostClientT (m :: Type -> Type) a
- data Genesis = Genesis {
- _genesisActiveSlotsCoefficient :: Rational
- _genesisUpdateQuorum :: Integer
- _genesisMaxLovelaceSupply :: Lovelaces
- _genesisNetworkMagic :: Integer
- _genesisEpochLength :: Integer
- _genesisSystemStart :: POSIXTime
- _genesisSlotsPerKesPeriod :: Integer
- _genesisSlotLength :: Integer
- _genesisMaxKesEvolutions :: Integer
- _genesisSecurityParam :: Integer
- data Project
- newtype TransactionCBOR = TransactionCBOR {}
- newtype TxHashCBOR = TxHashCBOR {
- getTxHashCBOR :: (TxHash, TransactionCBOR)
- tryError :: MonadError e m => m a -> m (Either e a)
- allPages :: Monad m => (Paged -> m [a]) -> m [a]
- def :: Default a => a
- getBlock :: MonadBlockfrost m => Either Integer BlockHash -> m Block
- getBlockTxsCBOR' :: MonadBlockfrost m => Either Integer BlockHash -> Paged -> SortOrder -> m [TxHashCBOR]
- getLedgerGenesis :: MonadBlockfrost m => m Genesis
- listPools :: MonadBlockfrost m => m [PoolId]
- projectFromFile :: FilePath -> IO Project
- runBlockfrost :: Project -> BlockfrostClientT IO a -> IO (Either BlockfrostError a)
- unBlockHash :: BlockHash -> Text
- unSlot :: Slot -> Integer
Documentation
data BlockfrostException Source #
Constructors
TimeoutOnUTxO TxId | |
FailedToDecodeAddress Text | |
ByronAddressNotSupported | |
FailedUTxOForHash Text | |
FailedEraHistory | |
AssetNameMissing | |
DeserialiseError Text | |
DecodeError Text | |
BlockfrostAPIError Text |
Instances
Exception BlockfrostException Source # | |
Defined in Hydra.Chain.Blockfrost.Client | |
Show BlockfrostException Source # | |
Defined in Hydra.Chain.Blockfrost.Client |
newtype APIBlockfrostError Source #
Constructors
BlockfrostError BlockfrostException |
Instances
Exception APIBlockfrostError Source # | |
Defined in Hydra.Chain.Blockfrost.Client Methods toException :: APIBlockfrostError -> SomeException Source # fromException :: SomeException -> Maybe APIBlockfrostError Source # | |
Show APIBlockfrostError Source # | |
Defined in Hydra.Chain.Blockfrost.Client |
data BlockfrostConversion Source #
Constructors
BlockfrostConversion | |
Fields
|
queryGenesisParameters :: BlockfrostClientT IO Genesis Source #
Query the Blockfrost API for Genesis
queryUTxOByTxIn :: NetworkId -> Text -> BlockfrostClientT IO UTxO Source #
Query the Blockfrost API to get the UTxO'
for TxIn
and convert to cardano UTxO'
.
queryScriptRegistry :: [TxId] -> BlockfrostClientT IO ScriptRegistry Source #
Query for TxIn
s in the search for outputs containing all the reference
scripts of the ScriptRegistry
.
This is implemented by repeated querying until we have all necessary reference scripts as we do only know the transaction id, not the indices.
Can throw at least NewScriptRegistryException
on failure.
runBlockfrostM :: (MonadIO m, MonadThrow m) => Project -> BlockfrostClientT IO a -> m a Source #
toCardanoNetworkId :: Integer -> NetworkId Source #
queryProtocolParameters :: MonadIO m => BlockfrostClientT m (PParams LedgerEra) Source #
scriptTypeToPlutusVersion :: ScriptType -> Maybe Language Source #
toCardanoUTxO :: NetworkId -> TxIn -> Address -> Maybe ScriptHash -> Maybe DatumHash -> [Amount] -> Maybe InlineDatum -> BlockfrostClientT IO (UTxO' (TxOut ctx)) Source #
toCardanoValue :: [Amount] -> BlockfrostClientT IO Value Source #
queryScript :: Text -> BlockfrostClientT IO (Maybe PlutusScript) Source #
toCardanoTxOut :: NetworkId -> Text -> Value -> Maybe Text -> Maybe Text -> Maybe PlutusScript -> BlockfrostClientT IO (TxOut ctx) Source #
toCardanoPoolId :: PoolId -> Hash StakePoolKey Source #
toCardanoTxIn :: Text -> Integer -> TxIn Source #
toCardanoAddress :: Text -> Maybe AddressInEra Source #
toCardanoPolicyIdAndAssetName :: Text -> BlockfrostClientT IO (PolicyId, AssetName) Source #
toCardanoGenesisParameters :: Genesis -> GenesisParameters ShelleyEra Source #
submitTransaction :: MonadIO m => Tx -> BlockfrostClientT m TxHash Source #
queryEraHistory :: BlockfrostClientT IO EraHistory Source #
queryUTxO :: NetworkId -> [Address ShelleyAddr] -> BlockfrostClientT IO UTxO Source #
Query the Blockfrost API for address UTxO and convert to cardano UTxO'
.
NOTE: We accept the address list here to be compatible with cardano-api but in
fact this is a single address query always.
queryUTxOFor :: VerificationKey PaymentKey -> BlockfrostClientT IO UTxO Source #
querySystemStart :: BlockfrostClientT IO SystemStart Source #
queryTip :: BlockfrostClientT IO ChainPoint Source #
Query the Blockfrost API for Genesis
and convert to cardano ChainPoint
.
queryStakePools :: BlockfrostClientT IO (Set PoolId) Source #
awaitTransaction :: Tx -> BlockfrostClientT IO UTxO Source #
Arguments
:: NetworkId | Network id |
-> [Address ShelleyAddr] | Address we are interested in |
-> TxId | Last transaction ID to await |
-> Int | Number of seconds to wait |
-> BlockfrostClientT IO UTxO |
Await for specific UTxO at address - the one that is produced by the given TxId
.
Constructors
Block | |
Fields
|
Instances
Instances
Instances
data BlockfrostClientT (m :: Type -> Type) a #
Instances
Constructors
Instances
Instances
IsString Project | |
Defined in Blockfrost.Auth Methods fromString :: String -> Project Source # | |
Generic Project | |
Show Project | |
Eq Project | |
Monad m => MonadReader ClientConfig (BlockfrostClientT m) | |
Defined in Blockfrost.Client.Types Methods ask :: BlockfrostClientT m ClientConfig Source # local :: (ClientConfig -> ClientConfig) -> BlockfrostClientT m a -> BlockfrostClientT m a Source # reader :: (ClientConfig -> a) -> BlockfrostClientT m a Source # | |
type Rep Project | |
Defined in Blockfrost.Auth type Rep Project = D1 ('MetaData "Project" "Blockfrost.Auth" "blockfrost-api-0.12.2.0-K3zul2bL2BIIjD1KpIwbKT" 'False) (C1 ('MetaCons "Project" 'PrefixI 'True) (S1 ('MetaSel ('Just "projectEnv") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Env) :*: S1 ('MetaSel ('Just "projectId") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text))) |
newtype TransactionCBOR #
Constructors
TransactionCBOR | |
Fields |
Instances
newtype TxHashCBOR #
Constructors
TxHashCBOR | |
Fields
|
Instances
tryError :: MonadError e m => m a -> m (Either e a) Source #
MonadError
analogue to the try
function.
getBlockTxsCBOR' :: MonadBlockfrost m => Either Integer BlockHash -> Paged -> SortOrder -> m [TxHashCBOR] #
getLedgerGenesis :: MonadBlockfrost m => m Genesis #
projectFromFile :: FilePath -> IO Project #
runBlockfrost :: Project -> BlockfrostClientT IO a -> IO (Either BlockfrostError a) #
unBlockHash :: BlockHash -> Text #