diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,74 @@ +# Version [0.13.0.0](https://github.com/blockfrost/blockfrost-haskell/compare/client-0.12.0.0...client-0.13.0.0) (2026-04-15) + +* Changes + * Retry logic added + + Client will retry most transient errors like connection timeouts, + up to 5 times with exponential backoff. This can be customized + via `clientConfigRetryPolicy` field of `ClientConfig`. See [`Control.Retry`](https://hackage.haskell.org/package/retry/docs/Control-Retry.html#g:5) + for available options. + + * `type ClientConfig = (ClientEnv, Project)` is now + + ``` + data ClientConfig = + ClientConfig + { clientConfigClientEnv :: ClientEnv + , clientConfigProject :: Project + , clientConfigRetryPolicy :: RetryPolicy + , clientConfigRetryJudge :: RetryStatus -> BlockfrostError -> RetryAction + } + ``` + last two fields are populated with `defaultRetryPolicy` and `defaultRetryJudge`. + + * `ipfsAdd` + * no longer throws `BlockfrostError "File not found"` + * no longer checks if the file exists + * no longer prints `"Uploading: "` message to stdout + +# Version [0.12.0.0](https://github.com/blockfrost/blockfrost-haskell/compare/client-0.11.0.0...client-0.12.0.0) (2026-02-02) + +* Changes + * Fix `MempoolUTxOInput` `address` field from `Text` to `Maybe Text` [#83](https://github.com/blockfrost/blockfrost-haskell/issues/83) [#84](https://github.com/blockfrost/blockfrost-haskell/pull/84) + * Mempool API functions adjusted to not require passing in `Project` [#85](https://github.com/blockfrost/blockfrost-haskell/pull/85) + * Previous `getMempoolTransactions prj def def` is now simply `getMempoolTransactions` and a principled + variant `getMempoolTransactions'` is provided accepting page and sort order parameters + (for example `allPages $ \p -> getMempoolTransactions' p def`). + * Similar for `getMempoolTransactionsByAddress`. + * `getMempoolTransaction` now simply doesn't require passing `Project` + +# Version [0.11.0.0](https://github.com/blockfrost/blockfrost-haskell/compare/client-0.10.0.0...client-0.11.0.0) (2025-12-02) + +* Changes + * Add `CustomURL` to `Env`, to allow arbitrary Blockfrost instance [#79](https://github.com/blockfrost/blockfrost-haskell/pull/79) + * `BlockfrostNotFound` constructor of `BlockfrostError` is now `BlockfrostNotFound Text` + containing path that resulted in 404 error [#81](https://github.com/blockfrost/blockfrost-haskell/pull/81) + * Drop `Sanchonet` `Env` [#79](https://github.com/blockfrost/blockfrost-haskell/pull/79) + +# Version [0.10.0.0](https://github.com/blockfrost/blockfrost-haskell/compare/client-0.9.2.0...client-0.10.0.0) (2025-06-03) + +* Additions + * Governance support [#77](https://github.com/blockfrost/blockfrost-haskell/pull/77) + * `AccountInfo` extended with `drepId` field [#77](https://github.com/blockfrost/blockfrost-haskell/pull/77) + +# Version [0.9.2.0](https://github.com/blockfrost/blockfrost-haskell/compare/client-0.9.1.0...client-0.9.2.0) (2025-04-07) + +* Additions + * `getBlockTxsCBOR` for `/blocks/:hash_or_number/txs/cbor` endpoint [#73](https://github.com/blockfrost/blockfrost-haskell/pull/73) [#75](https://github.com/blockfrost/blockfrost-haskell/pull/75) + * `getLatestBlockTxsCBOR` for `/blocks/latest/txs/cbor` endpoint [#73](https://github.com/blockfrost/blockfrost-haskell/pull/73) [#75](https://github.com/blockfrost/blockfrost-haskell/pull/75) + + +# Version [0.9.1.0](https://github.com/blockfrost/blockfrost-haskell/compare/client-0.9.0.0...client-0.9.1.0) (2024-09-25) + +* Fix return type of `getTxCBOR` from `[TransactionCBOR]` to `TransactionCBOR`. + +# Version [0.9.0.0](https://github.com/blockfrost/blockfrost-haskell/compare/client-0.8.0.1...client-0.9.0.0) (2024-09-19) + +* Additions + * `ProtocolParams` extended with Conway related protocol parameters and raw cost models [#59](https://github.com/blockfrost/blockfrost-haskell/pull/59) + * Mempool endpoints [#62](https://github.com/blockfrost/blockfrost-haskell/pull/62) + * `getTxCBOR` for `/txs/:hash/cbor` [#63](https://github.com/blockfrost/blockfrost-haskell/pull/63) + # Version [0.8.0.1](https://github.com/blockfrost/blockfrost-haskell/compare/client-0.8.0.0...client-0.8.0.1) (2024-01-16) * GHC 9.6.3 compatibility @@ -11,8 +82,8 @@ * `listPoolsExtended` for `/pools/extended` * `/utils` API * `deriveShelleyAddress` for `/utils/addresses/xpub/:xpub/:role/:index` - * `evaluateTx` for `/utils/txs/evaluate` endpoint - * `evaluateTxUTXOs` for `/utils/txs/evaluate/utxos` endpoint + * `txEvaluate` for `/utils/txs/evaluate` endpoint + * `txEvaluateUTXOs` for `/utils/txs/evaluate/utxos` endpoint # Version [0.7.1.1](https://github.com/blockfrost/blockfrost-haskell/compare/v0.7.1.0...client-0.7.1.1) (2023-01-10) diff --git a/blockfrost-client.cabal b/blockfrost-client.cabal --- a/blockfrost-client.cabal +++ b/blockfrost-client.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: blockfrost-client -version: 0.8.0.1 +version: 0.13.0.0 synopsis: blockfrost.io basic client description: Simple Blockfrost clients for use with transformers or mtl homepage: https://github.com/blockfrost/blockfrost-haskell @@ -35,6 +35,7 @@ common libstuff default-language: Haskell2010 + default-extensions: DuplicateRecordFields ghc-options: -Wall -Wunused-packages -fno-specialize -- ^ this helps quite a lot @@ -56,7 +57,9 @@ , Blockfrost.Client.Cardano.Assets , Blockfrost.Client.Cardano.Blocks , Blockfrost.Client.Cardano.Epochs + , Blockfrost.Client.Cardano.Governance , Blockfrost.Client.Cardano.Ledger + , Blockfrost.Client.Cardano.Mempool , Blockfrost.Client.Cardano.Metadata , Blockfrost.Client.Cardano.Network , Blockfrost.Client.Cardano.Pools @@ -66,14 +69,14 @@ , Blockfrost.Client.IPFS , Blockfrost.Client.NutLink build-depends: base >= 4.7 && < 5 - , blockfrost-api >= 0.9 - , blockfrost-client-core ^>= 0.6 + , blockfrost-api >= 0.15 + , blockfrost-client-core ^>= 0.8 , bytestring - , directory , data-default , filepath , text , mtl + , retry >= 0.9 && < 0.10 , servant >= 0.18 && < 0.21 , servant-client , servant-client-core diff --git a/example/Main.hs b/example/Main.hs --- a/example/Main.hs +++ b/example/Main.hs @@ -3,7 +3,8 @@ module Main where -import Blockfrost.Client +import Blockfrost.Client hiding (NutLinkAPI(..)) +import Control.Monad.IO.Class main = do -- reads token from BLOCKFROST_TOKEN_PATH @@ -18,5 +19,45 @@ -- variant accepting @Paged@ and @SortOrder@ arguments -- getAccountRewards' "gonnaFail" (page 10) desc - pure (latestBlocks, ers) - print res + + allMempoolTxs <- + allPages $ \p -> getMempoolTransactions' p def + + if null allMempoolTxs + then return $ (latestBlocks, ers, allMempoolTxs, Nothing) + else do let lastTxInMempool = TxHash . unTxHashObject $ last allMempoolTxs + lastMempoolTx <- getMempoolTransaction lastTxInMempool + + return (latestBlocks, ers, allMempoolTxs, Just lastMempoolTx) + + case res of + Left e -> print e + Right ((latestBlocks, ers, allMempoolTxs, lastMempoolTx)) -> do + print "Latest blocks:" + print latestBlocks + putStrLn "" + print "Account rewards (expected to error):" + print ers + putStrLn "" + print "All mempool transactions (mempool potentially empty):" + print allMempoolTxs + putStrLn "" + print "Last mempool transaction (if any):" + print lastMempoolTx + putStrLn "" + + case lastMempoolTx of + Nothing -> print "No mempool transactions found." + Just mempoolTx -> do + case _inputs mempoolTx of + [] -> print "No mempool transaction inputs found" -- Should be impossible + (inp:_) -> do + case _address inp of + Nothing -> print "Input has no address" + Just addr -> do + mempoolTxByAddress <- + runBlockfrost prj + $ getMempoolTransactionsByAddress + (Address addr) + print "Mempool transactions by address:" + print mempoolTxByAddress diff --git a/src/Blockfrost/Client.hs b/src/Blockfrost/Client.hs --- a/src/Blockfrost/Client.hs +++ b/src/Blockfrost/Client.hs @@ -60,6 +60,8 @@ , getLatestBlock , getLatestBlockTxs , getLatestBlockTxs' + , getLatestBlockTxsCBOR + , getLatestBlockTxsCBOR' , getBlock , getBlockSlot , getBlockEpochSlot @@ -69,6 +71,8 @@ , getPreviousBlocks' , getBlockTxs , getBlockTxs' + , getBlockTxsCBOR + , getBlockTxsCBOR' , getBlockAffectedAddresses' , getBlockAffectedAddresses -- Cardano - Epochs @@ -88,6 +92,25 @@ , getEpochBlocksByPool , getEpochBlocksByPool' , getEpochProtocolParams + -- Cardano - Governance + , getDReps + , getDReps' + , getDRep + , getDRepDelegators + , getDRepDelegators' + , getDRepMetadata + , getDRepUpdates + , getDRepUpdates' + , getDRepVotes + , getDRepVotes' + , getProposals + , getProposals' + , getProposal + , getParamProposal + , getWithdrawalProposal + , getProposalVotes + , getProposalVotes' + , getProposalMetadata -- Cardano - Ledger , getLedgerGenesis -- Cardano - Metadata @@ -97,6 +120,12 @@ , getTxMetadataByLabelJSON' , getTxMetadataByLabelCBOR , getTxMetadataByLabelCBOR' + -- Cardano - Mempool + , getMempoolTransactions + , getMempoolTransactions' + , getMempoolTransaction + , getMempoolTransactionsByAddress + , getMempoolTransactionsByAddress' -- Cardano - Network , getNetworkInfo , getNetworkEras @@ -140,6 +169,7 @@ , getTxPoolUpdates , getTxPoolRetiring , getTxMetadataJSON + , getTxCBOR , getTxMetadataCBOR , getTxRedeemers , submitTx @@ -176,7 +206,9 @@ import Blockfrost.Client.Cardano.Assets import Blockfrost.Client.Cardano.Blocks import Blockfrost.Client.Cardano.Epochs +import Blockfrost.Client.Cardano.Governance import Blockfrost.Client.Cardano.Ledger +import Blockfrost.Client.Cardano.Mempool import Blockfrost.Client.Cardano.Metadata import Blockfrost.Client.Cardano.Network import Blockfrost.Client.Cardano.Pools diff --git a/src/Blockfrost/Client/Cardano/Blocks.hs b/src/Blockfrost/Client/Cardano/Blocks.hs --- a/src/Blockfrost/Client/Cardano/Blocks.hs +++ b/src/Blockfrost/Client/Cardano/Blocks.hs @@ -4,6 +4,8 @@ ( getLatestBlock , getLatestBlockTxs , getLatestBlockTxs' + , getLatestBlockTxsCBOR + , getLatestBlockTxsCBOR' , getBlock , getBlockSlot , getBlockEpochSlot @@ -13,6 +15,8 @@ , getPreviousBlocks' , getBlockTxs , getBlockTxs' + , getBlockTxsCBOR + , getBlockTxsCBOR' , getBlockAffectedAddresses' , getBlockAffectedAddresses ) where @@ -47,6 +51,22 @@ getLatestBlockTxs :: MonadBlockfrost m => m [TxHash] getLatestBlockTxs = getLatestBlockTxs' def def +getLatestBlockTxsCBOR_ :: MonadBlockfrost m => Project -> Paged -> SortOrder -> m [TxHashCBOR] +getLatestBlockTxsCBOR_ = _latestTxsCBOR . blocksClient + +-- | Return the transactions within the block, including CBOR. +-- Allows custom paging and ordering using 'Paged' and 'SortOrder'. +getLatestBlockTxsCBOR' :: MonadBlockfrost m => Paged -> SortOrder -> m [TxHashCBOR] +getLatestBlockTxsCBOR' pg s = go (\p -> getLatestBlockTxsCBOR_ p pg s) + +-- | Return the transactions within the block, including CBOR. +-- +-- Queries 100 entries. To query all entries use 'Blockfrost.Client.Core.allPages' +-- with principled variant of this function (suffixed with @'@) +-- that accepts 'Paged' argument. +getLatestBlockTxsCBOR :: MonadBlockfrost m => m [TxHashCBOR] +getLatestBlockTxsCBOR = getLatestBlockTxsCBOR' def def + getBlock_ :: MonadBlockfrost m => Project -> Either Integer BlockHash -> m Block getBlock_ = _block . blocksClient @@ -115,6 +135,22 @@ -- that accepts 'Paged' argument. getBlockTxs :: MonadBlockfrost m => Either Integer BlockHash -> m [TxHash] getBlockTxs a = getBlockTxs' a def def + +getBlockTxsCBOR_ :: MonadBlockfrost m => Project -> Either Integer BlockHash -> Paged -> SortOrder -> m [TxHashCBOR] +getBlockTxsCBOR_ = _blockTxsCBOR . blocksClient + +-- | Return the transactions within the block, including CBOR. +-- Allows custom paging and ordering using 'Paged' and 'SortOrder'. +getBlockTxsCBOR' :: MonadBlockfrost m => Either Integer BlockHash -> Paged -> SortOrder -> m [TxHashCBOR] +getBlockTxsCBOR' a pg s = go (\p -> getBlockTxsCBOR_ p a pg s) + +-- | Return the transactions within the block, including CBOR. +-- +-- Queries 100 entries. To query all entries use 'Blockfrost.Client.Core.allPages' +-- with principled variant of this function (suffixed with @'@) +-- that accepts 'Paged' argument. +getBlockTxsCBOR :: MonadBlockfrost m => Either Integer BlockHash -> m [TxHashCBOR] +getBlockTxsCBOR a = getBlockTxsCBOR' a def def getBlockAffectedAddresses_ :: MonadBlockfrost m => Project -> Either Integer BlockHash -> Paged -> m [(Address, [TxHash])] getBlockAffectedAddresses_ = _blockAffectedAddresses . blocksClient diff --git a/src/Blockfrost/Client/Cardano/Governance.hs b/src/Blockfrost/Client/Cardano/Governance.hs new file mode 100644 --- /dev/null +++ b/src/Blockfrost/Client/Cardano/Governance.hs @@ -0,0 +1,167 @@ +-- | Governance queries + +module Blockfrost.Client.Cardano.Governance + ( getDReps + , getDReps' + , getDRep + , getDRepDelegators + , getDRepDelegators' + , getDRepMetadata + , getDRepUpdates + , getDRepUpdates' + , getDRepVotes + , getDRepVotes' + , getProposals + , getProposals' + , getProposal + , getParamProposal + , getWithdrawalProposal + , getProposalVotes + , getProposalVotes' + , getProposalMetadata + ) where + +import Blockfrost.API +import Blockfrost.Client.Types +import Blockfrost.Types + +governanceClient :: MonadBlockfrost m => Project -> GovernanceAPI (AsClientT m) +governanceClient = fromServant . _governance . cardanoClient + +getDReps_ :: MonadBlockfrost m => Project -> Paged -> SortOrder -> m [DRep] +getDReps_ = _dreps . governanceClient + +-- | Return the information about Delegate Representatives (DReps). +-- Allows custom paging and ordering using 'Paged' and 'SortOrder'. +getDReps' :: MonadBlockfrost m => Paged -> SortOrder -> m [DRep] +getDReps' pg s = go (\p -> getDReps_ p pg s) + +-- | Return the information about Delegate Representatives (DReps). +-- +-- Queries 100 entries. To query all entries use 'Blockfrost.Client.Core.allPages' +-- with principled variant of this function (suffixed with @'@) +-- that accepts 'Paged' argument. +getDReps :: MonadBlockfrost m => m [DRep] +getDReps = getDReps' def def + +getDRep_ :: MonadBlockfrost m => Project -> DRepId -> m DRepInfo +getDRep_ = _drep . governanceClient + +-- | Return the information about specific Delegate Representative (DRep). +getDRep :: MonadBlockfrost m => DRepId -> m DRepInfo +getDRep d = go (`getDRep_` d) + +getDRepDelegators_ :: MonadBlockfrost m => Project -> DRepId -> Paged -> SortOrder -> m [DRepDelegator] +getDRepDelegators_ = _drepDelegators . governanceClient + +-- | Get a list of DRep delegators +-- Allows custom paging and ordering using 'Paged' and 'SortOrder'. +getDRepDelegators' :: MonadBlockfrost m => DRepId -> Paged -> SortOrder -> m [DRepDelegator] +getDRepDelegators' d pg s = go (\p -> getDRepDelegators_ p d pg s) + +-- | Get a list of DRep delegators +-- +-- Queries 100 entries. To query all entries use 'Blockfrost.Client.Core.allPages' +-- with principled variant of this function (suffixed with @'@) +-- that accepts 'Paged' argument. +getDRepDelegators :: MonadBlockfrost m => DRepId -> m [DRepDelegator] +getDRepDelegators d = getDRepDelegators' d def def + +getDRepMetadata_ :: MonadBlockfrost m => Project -> DRepId -> m DRepMeta +getDRepMetadata_ = _drepMetadata . governanceClient + +-- | Get DRep metadata information. +getDRepMetadata :: MonadBlockfrost m => DRepId -> m DRepMeta +getDRepMetadata d = go (`getDRepMetadata_` d) + +getDRepUpdates_ :: MonadBlockfrost m => Project -> DRepId -> Paged -> SortOrder -> m [DRepUpdate] +getDRepUpdates_ = _drepUpdates . governanceClient + +-- | Get a list of certificate updates to the DRep. +-- Allows custom paging and ordering using 'Paged' and 'SortOrder'. +getDRepUpdates' :: MonadBlockfrost m => DRepId -> Paged -> SortOrder -> m [DRepUpdate] +getDRepUpdates' d pg s = go (\p -> getDRepUpdates_ p d pg s) + +-- | Get a list of certificate updates to the DRep. +-- +-- Queries 100 entries. To query all entries use 'Blockfrost.Client.Core.allPages' +-- with principled variant of this function (suffixed with @'@) +-- that accepts 'Paged' argument. +getDRepUpdates :: MonadBlockfrost m => DRepId -> m [DRepUpdate] +getDRepUpdates d = getDRepUpdates' d def def + +getDRepVotes_ :: MonadBlockfrost m => Project -> DRepId -> Paged -> SortOrder -> m [DRepVote] +getDRepVotes_ = _drepVotes . governanceClient + +-- | Get a history of DReps votes. +-- Allows custom paging and ordering using 'Paged' and 'SortOrder'. +getDRepVotes' :: MonadBlockfrost m => DRepId -> Paged -> SortOrder -> m [DRepVote] +getDRepVotes' d pg s = go (\p -> getDRepVotes_ p d pg s) + +-- | Get a history of DReps votes. +-- +-- Queries 100 entries. To query all entries use 'Blockfrost.Client.Core.allPages' +-- with principled variant of this function (suffixed with @'@) +-- that accepts 'Paged' argument. +getDRepVotes :: MonadBlockfrost m => DRepId -> m [DRepVote] +getDRepVotes d = getDRepVotes' d def def + +getProposals_ :: MonadBlockfrost m => Project -> Paged -> SortOrder -> m [Proposal] +getProposals_ = _proposals . governanceClient + +-- | Get a history of DReps proposals. +-- Allows custom paging and ordering using 'Paged' and 'SortOrder'. +getProposals' :: MonadBlockfrost m => Paged -> SortOrder -> m [Proposal] +getProposals' pg s = go (\p -> getProposals_ p pg s) + +-- | Get a history of DReps proposals. +-- +-- Queries 100 entries. To query all entries use 'Blockfrost.Client.Core.allPages' +-- with principled variant of this function (suffixed with @'@) +-- that accepts 'Paged' argument. +getProposals :: MonadBlockfrost m => m [Proposal] +getProposals = getProposals' def def + +getProposal_ :: MonadBlockfrost m => Project -> TxHash -> Integer -> m ProposalInfo +getProposal_ = _proposal . governanceClient + +-- | Get a proposal details. +getProposal :: MonadBlockfrost m => TxHash -> Integer -> m ProposalInfo +getProposal txHash certIdx = go (\p -> getProposal_ p txHash certIdx) + +getParamProposal_ :: MonadBlockfrost m => Project -> TxHash -> Integer -> m ParamProposal +getParamProposal_ = _paramProposal . governanceClient + +-- | Get a parameter proposal details. +getParamProposal :: MonadBlockfrost m => TxHash -> Integer -> m ParamProposal +getParamProposal txHash certIdx = go (\p -> getParamProposal_ p txHash certIdx) + +getWithdrawalProposal_ :: MonadBlockfrost m => Project -> TxHash -> Integer -> m [WithdrawalProposal] +getWithdrawalProposal_ = _withdrawalProposal . governanceClient + +-- | Get a witdhrawal proposal details. +getWithdrawalProposal :: MonadBlockfrost m => TxHash -> Integer -> m [WithdrawalProposal] +getWithdrawalProposal txHash certIdx = go (\p -> getWithdrawalProposal_ p txHash certIdx) + +getProposalVotes_ :: MonadBlockfrost m => Project -> TxHash -> Integer -> Paged -> SortOrder -> m [ProposalVote] +getProposalVotes_ = _proposalVotes . governanceClient + +-- | Get a history of DReps proposals. +-- Allows custom paging and ordering using 'Paged' and 'SortOrder'. +getProposalVotes' :: MonadBlockfrost m => TxHash -> Integer -> Paged -> SortOrder -> m [ProposalVote] +getProposalVotes' txHash certIdx pg s = go (\p -> getProposalVotes_ p txHash certIdx pg s) + +-- | Get a history of DReps proposals. +-- +-- Queries 100 entries. To query all entries use 'Blockfrost.Client.Core.allPages' +-- with principled variant of this function (suffixed with @'@) +-- that accepts 'Paged' argument. +getProposalVotes :: MonadBlockfrost m => TxHash -> Integer -> m [ProposalVote] +getProposalVotes txHash certIdx = getProposalVotes' txHash certIdx def def + +getProposalMetadata_ :: MonadBlockfrost m => Project -> TxHash -> Integer -> m ProposalMeta +getProposalMetadata_ = _proposalMeta . governanceClient + +-- | Get a parameter proposal details. +getProposalMetadata :: MonadBlockfrost m => TxHash -> Integer -> m ProposalMeta +getProposalMetadata txHash certIdx = go (\p -> getProposalMetadata_ p txHash certIdx) diff --git a/src/Blockfrost/Client/Cardano/Mempool.hs b/src/Blockfrost/Client/Cardano/Mempool.hs new file mode 100644 --- /dev/null +++ b/src/Blockfrost/Client/Cardano/Mempool.hs @@ -0,0 +1,57 @@ +-- | Mempool queries + +module Blockfrost.Client.Cardano.Mempool + ( getMempoolTransactions + , getMempoolTransactions' + , getMempoolTransaction + , getMempoolTransactionsByAddress + , getMempoolTransactionsByAddress' + ) where + +import Blockfrost.API +import Blockfrost.Client.Types +import Blockfrost.Types + +mempoolClient :: MonadBlockfrost m => Project -> MempoolAPI (AsClientT m) +mempoolClient = fromServant . _mempool . cardanoClient + +getMempoolTransactions_ :: MonadBlockfrost m => Project -> Paged -> SortOrder -> m [TxHashObject] +getMempoolTransactions_ = _mempoolTransactions . mempoolClient + +-- | Get a list of transactions currently in Blockfrost.io mempool +-- Allows custom paging and ordering using 'Paged' and 'SortOrder'. +getMempoolTransactions' :: MonadBlockfrost m => Paged -> SortOrder -> m [TxHashObject] +getMempoolTransactions' pg s = go (\p -> getMempoolTransactions_ p pg s) + +-- | Get a list of transactions currently in Blockfrost.io mempool +-- +-- Queries 100 entries. To query all entries use 'Blockfrost.Client.Core.allPages' +-- with principled variant of this function (suffixed with @'@) +-- that accepts 'Paged' argument. +getMempoolTransactions :: MonadBlockfrost m => m [TxHashObject] +getMempoolTransactions = getMempoolTransactions' def def + +getMempoolTransaction_ :: MonadBlockfrost m => Project -> TxHash -> m MempoolTransaction +getMempoolTransaction_ = _specificTransaction . mempoolClient + +-- | Get details about a specific @MempoolTransaction@ +getMempoolTransaction :: MonadBlockfrost m => TxHash -> m MempoolTransaction +getMempoolTransaction t = go (`getMempoolTransaction_` t) + +getMempoolTransactionsByAddress_ :: MonadBlockfrost m => Project -> Address -> Paged -> SortOrder -> m [TxHashObject] +getMempoolTransactionsByAddress_ = _specificAddress . mempoolClient + +-- | Get a list of transactions currently in Blockfrost.io mempool +-- where at least one of the transaction inputs or outputs belongs to the address. +-- Allows custom paging and ordering using 'Paged' and 'SortOrder'. +getMempoolTransactionsByAddress' :: MonadBlockfrost m => Address -> Paged -> SortOrder -> m [TxHashObject] +getMempoolTransactionsByAddress' addr pg s = go (\p -> getMempoolTransactionsByAddress_ p addr pg s) + +-- | Get a list of transactions currently in Blockfrost.io mempool +-- where at least one of the transaction inputs or outputs belongs to the address. +-- +-- Queries 100 entries. To query all entries use 'Blockfrost.Client.Core.allPages' +-- with principled variant of this function (suffixed with @'@) +-- that accepts 'Paged' argument. +getMempoolTransactionsByAddress :: MonadBlockfrost m => Address -> m [TxHashObject] +getMempoolTransactionsByAddress addr = go (\p -> getMempoolTransactionsByAddress_ p addr def def) diff --git a/src/Blockfrost/Client/Cardano/Pools.hs b/src/Blockfrost/Client/Cardano/Pools.hs --- a/src/Blockfrost/Client/Cardano/Pools.hs +++ b/src/Blockfrost/Client/Cardano/Pools.hs @@ -117,7 +117,7 @@ getPoolHistory p = getPoolHistory' p def def getPoolMetadata_ :: MonadBlockfrost m => Project -> PoolId -> m (Maybe PoolMetadata) -getPoolMetadata_ = _getPoolMetadata . poolsClient +getPoolMetadata_ p pid = getMetadata <$> _getPoolMetadata (poolsClient p) pid -- | Get stake pool metadata getPoolMetadata :: MonadBlockfrost m => PoolId -> m (Maybe PoolMetadata) diff --git a/src/Blockfrost/Client/Cardano/Transactions.hs b/src/Blockfrost/Client/Cardano/Transactions.hs --- a/src/Blockfrost/Client/Cardano/Transactions.hs +++ b/src/Blockfrost/Client/Cardano/Transactions.hs @@ -11,13 +11,14 @@ , getTxPoolUpdates , getTxPoolRetiring , getTxMetadataJSON + , getTxCBOR , getTxMetadataCBOR , submitTx ) where import Blockfrost.API import Blockfrost.Client.Types -import Blockfrost.Types +import Blockfrost.Types hiding (MempoolTransaction(..)) transactionsClient :: MonadBlockfrost m => Project -> TransactionsAPI (AsClientT m) transactionsClient = fromServant . _transactions . cardanoClient @@ -91,6 +92,13 @@ -- | Get transaction metadata in JSON getTxMetadataJSON :: MonadBlockfrost m => TxHash -> m [TransactionMetaJSON] getTxMetadataJSON t = go (`getTxMetadataJSON_` t) + +getTxCBOR_ :: MonadBlockfrost m => Project -> TxHash -> m TransactionCBOR +getTxCBOR_ = _txCBOR . transactionsClient + +-- | Get transaction in CBOR +getTxCBOR :: MonadBlockfrost m => TxHash -> m TransactionCBOR +getTxCBOR t = go (`getTxCBOR_` t) getTxMetadataCBOR_ :: MonadBlockfrost m => Project -> TxHash -> m [TransactionMetaCBOR] getTxMetadataCBOR_ = _txMetadataCBOR . transactionsClient diff --git a/src/Blockfrost/Client/IPFS.hs b/src/Blockfrost/Client/IPFS.hs --- a/src/Blockfrost/Client/IPFS.hs +++ b/src/Blockfrost/Client/IPFS.hs @@ -15,28 +15,19 @@ import Blockfrost.API import Blockfrost.Client.Types import Blockfrost.Types -import Control.Monad.Except (MonadError, throwError) -import Control.Monad.IO.Class (liftIO) import Data.ByteString.Lazy (ByteString) import Data.Text (Text) import qualified Data.Text -import qualified System.Directory import qualified System.FilePath ipfsAdd_ :: MonadBlockfrost m => Project -> (ByteString, Form) -> m IPFSAdd ipfsAdd_ = _add . ipfsClient -- | Add a file or directory to IPFS -ipfsAdd :: (MonadError BlockfrostError m, MonadBlockfrost m) => FilePath -> m IPFSAdd +ipfsAdd :: MonadBlockfrost m => FilePath -> m IPFSAdd ipfsAdd fp = do - hasFile <- liftIO $ System.Directory.doesFileExist fp - if hasFile - then do - liftIO $ putStrLn $ "Uploading: " ++ fp - let fn = Data.Text.pack $ System.FilePath.takeBaseName fp - go (\proj -> ipfsAdd_ proj ("suchBoundary", (Form fn fp))) - else - throwError (BlockfrostError "No such file") + let fn = Data.Text.pack $ System.FilePath.takeBaseName fp + go (\proj -> ipfsAdd_ proj ("suchBoundary", (Form fn fp))) ipfsGateway_ :: MonadBlockfrost m => Project -> Text -> m IPFSData ipfsGateway_ = _gateway . ipfsClient diff --git a/src/Blockfrost/Client/NutLink.hs b/src/Blockfrost/Client/NutLink.hs --- a/src/Blockfrost/Client/NutLink.hs +++ b/src/Blockfrost/Client/NutLink.hs @@ -12,7 +12,7 @@ import Blockfrost.API import Blockfrost.Client.Types -import Blockfrost.Types +import Blockfrost.Types hiding (MempoolUTxOInput(..)) import Data.Text (Text) nutlinkListAddress_ :: MonadBlockfrost m => Project -> Address-> m NutlinkAddress diff --git a/src/Blockfrost/Client/Types.hs b/src/Blockfrost/Client/Types.hs --- a/src/Blockfrost/Client/Types.hs +++ b/src/Blockfrost/Client/Types.hs @@ -2,11 +2,17 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE Rank2Types #-} module Blockfrost.Client.Types ( BlockfrostClient , BlockfrostError (..) , ClientConfig + , defaultRetryPolicy + , endlessRetryPolicy + , defaultRetryJudge , runBlockfrost , apiClient , api0Client @@ -30,6 +36,7 @@ import Control.Monad.Except import Control.Monad.Reader +import Control.Retry import Data.Default import Servant.API.Generic @@ -39,8 +46,26 @@ import Blockfrost.API import Blockfrost.Client.Core -type ClientConfig = (ClientEnv, Project) +data ClientConfig = + ClientConfig + { clientConfigClientEnv :: ClientEnv + , clientConfigProject :: Project + , clientConfigRetryPolicy :: RetryPolicy + , clientConfigRetryJudge :: RetryStatus -> BlockfrostError -> RetryAction + } +defaultRetryPolicy :: RetryPolicy +defaultRetryPolicy = exponentialBackoff (1000 * 1000) <> limitRetries 5 + +endlessRetryPolicy :: RetryPolicy +endlessRetryPolicy = exponentialBackoff (1000 * 1000) + +defaultRetryJudge + :: RetryStatus + -> BlockfrostError + -> RetryAction +defaultRetryJudge _retryStatus err = retriableError err + newtype BlockfrostClientT m a = BlockfrostClientT { unBlockfrostClientT :: ExceptT BlockfrostError @@ -62,13 +87,33 @@ instance MonadIO m => MonadBlockfrost (BlockfrostClientT m) where liftBlockfrostClient act = BlockfrostClientT $ do - (env, _proj) <- ask - liftIO (runClientM act env) - >>= either - (throwError . fromServantClientError) - pure + clientConfig <- ask + liftIO + $ withRetry + clientConfig + $ runClientM act (clientConfigClientEnv clientConfig) + >>= either + (throwError . fromServantClientError) + pure getConf = BlockfrostClientT ask +withRetry + :: ClientConfig + -> IO (Either ClientError a) + -> IO (Either ClientError a) +withRetry ClientConfig{..} act = + retryingDynamic + clientConfigRetryPolicy + (\retryStatus -> \case + Right{} -> pure DontRetry + Left err -> + pure + $ clientConfigRetryJudge + retryStatus + (fromServantClientError err) + ) + (const act) + instance MonadBlockfrost ClientM where liftBlockfrostClient = id getConf = newClientConfig @@ -76,11 +121,16 @@ instance MonadBlockfrost IO where liftBlockfrostClient act = getConf - >>= \(env, _prj) -> - runClientM act env - >>= either - (error . show) - pure + >>= \clientConfig -> + withRetry + clientConfig + ( runClientM + act + (clientConfigClientEnv clientConfig) + ) + >>= either + (error . show) + pure getConf = newClientConfig apiClient @@ -110,24 +160,37 @@ -> BlockfrostClientT m a -> m (Either BlockfrostError a) runBlockfrostClientT proj act = do - env <- liftIO $ newEnvByProject proj - flip runReaderT (env, proj) + cc <- liftIO $ mkClientConfig proj + flip runReaderT cc $ runExceptT $ unBlockfrostClientT act -- | Build default `ClientConfig` using BLOCKFROST_TOKEN_PATH environment variable newClientConfig :: MonadIO m => m ClientConfig -newClientConfig = liftIO $ do - prj <- projectFromEnv - env <- newEnvByProject prj - pure (env, prj) +newClientConfig = + liftIO + $ projectFromEnv >>= mkClientConfig +mkClientConfig + :: MonadIO m + => Project + -> m ClientConfig +mkClientConfig prj = do + env <- liftIO $ newEnvByProject prj + pure + $ ClientConfig + { clientConfigClientEnv = env + , clientConfigProject = prj + , clientConfigRetryPolicy = defaultRetryPolicy + , clientConfigRetryJudge = defaultRetryJudge + } + -- | Helper go :: MonadBlockfrost m => (Project -> m a) -> m a -go act = getConf >>= act . snd +go act = getConf >>= act . clientConfigProject -- Until mtl > 2.2.2 -- https://github.com/haskell/mtl/pull/66