{-# LANGUAGE RecordWildCards #-}

module Hydra.Chain.Blockfrost.Client (
  module Hydra.Chain.Blockfrost.Client,
  module Blockfrost.Client,
) where

import Hydra.Prelude

import Blockfrost.Client (
  Block (..),
  BlockHash (..),
  BlockfrostClientT,
  Genesis (..),
  Project,
  Slot (..),
  TransactionCBOR (..),
  TxHash (..),
  TxHashCBOR (..),
  allPages,
  def,
  getBlock,
  getBlockTxsCBOR',
  getLedgerGenesis,
  listPools,
  projectFromFile,
  runBlockfrost,
  tryError,
  unBlockHash,
  unSlot,
 )
import Blockfrost.Client qualified as Blockfrost
import Cardano.Chain.Genesis (mainnetProtocolMagicId)
import Cardano.Crypto.ProtocolMagic (ProtocolMagicId (..))
import Data.Map.Strict qualified as Map
import Data.Time.Clock.POSIX
import Hydra.Cardano.Api hiding (LedgerState, fromNetworkMagic, queryGenesisParameters, txId)

import Cardano.Api.UTxO qualified as UTxO
import Cardano.Ledger.Api.PParams
import Cardano.Ledger.BaseTypes (EpochInterval (..), NonNegativeInterval, UnitInterval, boundRational, unsafeNonZero)
import Cardano.Ledger.Binary.Version (mkVersion)
import Cardano.Ledger.Coin (compactCoinOrError)
import Cardano.Ledger.Conway.Core (
  DRepVotingThresholds (..),
  PoolVotingThresholds (..),
  ppCommitteeMaxTermLengthL,
  ppCommitteeMinSizeL,
  ppDRepActivityL,
  ppDRepDepositL,
  ppDRepVotingThresholdsL,
  ppGovActionDepositL,
  ppGovActionLifetimeL,
  ppPoolVotingThresholdsL,
 )
import Cardano.Ledger.Conway.PParams (ppMinFeeRefScriptCostPerByteL)
import Cardano.Ledger.Plutus (ExUnits (..), Language (..), Prices (..))
import Cardano.Ledger.Plutus.CostModels (CostModels, mkCostModel, mkCostModels)
import Cardano.Ledger.Shelley.API (ProtVer (..))
import Cardano.Slotting.Time (RelativeTime (..), mkSlotLength)
import Control.Lens ((.~), (^.))
import Control.Retry (RetryPolicyM, capDelay, fullJitterBackoff, limitRetries, limitRetriesByCumulativeDelay, retrying)
import Data.List qualified as List
import Data.SOP.NonEmpty (nonEmptyFromList)
import Data.Set qualified as Set
import Data.Text qualified as T
import Hydra.Cardano.Api.Prelude (fromNetworkMagic)
import Hydra.Tx (ScriptRegistry, newScriptRegistry, txId)
import Money qualified
import Ouroboros.Consensus.Block (GenesisWindow (..))
import Ouroboros.Consensus.HardFork.History (Bound (..), EraEnd (..), EraParams (..), EraSummary (..), SafeZone (..), Summary (..), mkInterpreter, pattern NoPerasEnabled)

data BlockfrostException
  = TimeoutOnUTxO TxId
  | NoUTxOFound (Address ShelleyAddr)
  | FailedToDecodeAddress Text
  | ByronAddressNotSupported
  | FailedUTxOForHash Text
  | FailedEraHistory
  | AssetNameMissing
  | DeserialiseError Text
  deriving stock (Int -> BlockfrostException -> ShowS
[BlockfrostException] -> ShowS
BlockfrostException -> String
(Int -> BlockfrostException -> ShowS)
-> (BlockfrostException -> String)
-> ([BlockfrostException] -> ShowS)
-> Show BlockfrostException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BlockfrostException -> ShowS
showsPrec :: Int -> BlockfrostException -> ShowS
$cshow :: BlockfrostException -> String
show :: BlockfrostException -> String
$cshowList :: [BlockfrostException] -> ShowS
showList :: [BlockfrostException] -> ShowS
Show)

data APIBlockfrostError
  = BlockfrostError Text
  | BlockfrostClientError BlockfrostException
  | DecodeError Text
  | MissingBlockNo BlockHash
  | MissingBlockSlot (Maybe Slot)
  | BlockfrostRateLimited
  | MissingNextBlockHash BlockHash
  | NotEnoughBlockConfirmations BlockHash
  deriving stock (Int -> APIBlockfrostError -> ShowS
[APIBlockfrostError] -> ShowS
APIBlockfrostError -> String
(Int -> APIBlockfrostError -> ShowS)
-> (APIBlockfrostError -> String)
-> ([APIBlockfrostError] -> ShowS)
-> Show APIBlockfrostError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> APIBlockfrostError -> ShowS
showsPrec :: Int -> APIBlockfrostError -> ShowS
$cshow :: APIBlockfrostError -> String
show :: APIBlockfrostError -> String
$cshowList :: [APIBlockfrostError] -> ShowS
showList :: [APIBlockfrostError] -> ShowS
Show)
  deriving anyclass (Show APIBlockfrostError
Typeable APIBlockfrostError
(Typeable APIBlockfrostError, Show APIBlockfrostError) =>
(APIBlockfrostError -> SomeException)
-> (SomeException -> Maybe APIBlockfrostError)
-> (APIBlockfrostError -> String)
-> Exception APIBlockfrostError
SomeException -> Maybe APIBlockfrostError
APIBlockfrostError -> String
APIBlockfrostError -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> String) -> Exception e
$ctoException :: APIBlockfrostError -> SomeException
toException :: APIBlockfrostError -> SomeException
$cfromException :: SomeException -> Maybe APIBlockfrostError
fromException :: SomeException -> Maybe APIBlockfrostError
$cdisplayException :: APIBlockfrostError -> String
displayException :: APIBlockfrostError -> String
Exception)

isRetryable :: APIBlockfrostError -> Bool
isRetryable :: APIBlockfrostError -> Bool
isRetryable = \case
  BlockfrostError Text
_ -> Bool
True
  BlockfrostClientError BlockfrostException
_ -> Bool
False
  -- Deterministic: the same CBOR fails the same way on every retry, and both
  -- poll loops retry without limit, so this must crash rather than spin.
  DecodeError Text
_ -> Bool
False
  MissingBlockNo BlockHash
_ -> Bool
True
  MissingBlockSlot Maybe Slot
_ -> Bool
True
  APIBlockfrostError
BlockfrostRateLimited -> Bool
True
  -- next block not yet available/confirmed: poll again
  MissingNextBlockHash BlockHash
_ -> Bool
True
  NotEnoughBlockConfirmations BlockHash
_ -> Bool
True

-- * Retry logic

-- | Maximum number of retries for transient Blockfrost errors.
maxRetries :: Int
maxRetries :: Int
maxRetries = Int
10

-- | Retry policy for transient Blockfrost errors: full-jitter exponential
-- backoff with 1s base, capped at 60s, at most 'maxRetries' retries.
blockfrostRetryPolicy :: MonadIO m => RetryPolicyM m
blockfrostRetryPolicy :: forall (m :: * -> *). MonadIO m => RetryPolicyM m
blockfrostRetryPolicy = Int -> RetryPolicyM m -> RetryPolicyM m
forall (m :: * -> *).
Monad m =>
Int -> RetryPolicyM m -> RetryPolicyM m
capDelay Int
60_000_000 (Int -> RetryPolicyM m
forall (m :: * -> *). MonadIO m => Int -> RetryPolicyM m
fullJitterBackoff Int
1_000_000) RetryPolicyM m -> RetryPolicyM m -> RetryPolicyM m
forall a. Semigroup a => a -> a -> a
<> Int -> RetryPolicy
limitRetries Int
maxRetries

-- | Rate-limit retry policy for transaction submission: like
-- 'blockfrostRetryPolicy', but gives up well before the upper validity bound
-- of close/contest transactions (@now + min(contestationPeriod, maxGraceTime
-- = 200s)@, set at construction and not refreshed on retry). Retrying past
-- that point could only surface an expired-validity error instead of a timely
-- rate-limit failure the caller can react to. The cumulative delay limit only
-- kicks in once reached, so the worst case is ~120s plus one more (up to 60s)
-- delay, still below 'maxGraceTime'.
submissionRetryPolicy :: MonadIO m => RetryPolicyM m
submissionRetryPolicy :: forall (m :: * -> *). MonadIO m => RetryPolicyM m
submissionRetryPolicy = Int -> RetryPolicyM m -> RetryPolicyM m
forall (m :: * -> *).
Monad m =>
Int -> RetryPolicyM m -> RetryPolicyM m
limitRetriesByCumulativeDelay Int
120_000_000 RetryPolicyM m
forall (m :: * -> *). MonadIO m => RetryPolicyM m
blockfrostRetryPolicy

-- | Policy for awaiting eventually-consistent query results (tx inclusion,
-- indexer catch-up): full-jitter backoff capped at 10s per attempt, giving up
-- once retries have accumulated ~5 minutes of waiting. Not to be confused
-- with 'blockfrostRetryPolicy', which handles HTTP 429 inside every request.
awaitPolicy :: MonadIO m => RetryPolicyM m
awaitPolicy :: forall (m :: * -> *). MonadIO m => RetryPolicyM m
awaitPolicy =
  Int -> RetryPolicyM m -> RetryPolicyM m
forall (m :: * -> *).
Monad m =>
Int -> RetryPolicyM m -> RetryPolicyM m
limitRetriesByCumulativeDelay (Int
300 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1_000_000) (RetryPolicyM m -> RetryPolicyM m)
-> RetryPolicyM m -> RetryPolicyM m
forall a b. (a -> b) -> a -> b
$
    Int -> RetryPolicyM m -> RetryPolicyM m
forall (m :: * -> *).
Monad m =>
Int -> RetryPolicyM m -> RetryPolicyM m
capDelay Int
10_000_000 (Int -> RetryPolicyM m
forall (m :: * -> *). MonadIO m => Int -> RetryPolicyM m
fullJitterBackoff Int
1_000_000)

-- | Like 'runBlockfrostM' but with a custom rate-limit retry policy.
runBlockfrostMWith ::
  (MonadIO m, MonadThrow m) =>
  RetryPolicyM m ->
  Blockfrost.Project ->
  BlockfrostClientT IO a ->
  m a
runBlockfrostMWith :: forall (m :: * -> *) a.
(MonadIO m, MonadThrow m) =>
RetryPolicyM m -> Project -> BlockfrostClientT IO a -> m a
runBlockfrostMWith RetryPolicyM m
policy Project
prj BlockfrostClientT IO a
action = do
  Either BlockfrostError a
res <-
    RetryPolicyM m
-> (RetryStatus -> Either BlockfrostError a -> m Bool)
-> (RetryStatus -> m (Either BlockfrostError a))
-> m (Either BlockfrostError a)
forall (m :: * -> *) b.
MonadIO m =>
RetryPolicyM m
-> (RetryStatus -> b -> m Bool) -> (RetryStatus -> m b) -> m b
retrying
      RetryPolicyM m
policy
      (\RetryStatus
_ -> Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> m Bool)
-> (Either BlockfrostError a -> Bool)
-> Either BlockfrostError a
-> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either BlockfrostError a -> Bool
forall b. Either BlockfrostError b -> Bool
isRateLimited)
      (\RetryStatus
_ -> IO (Either BlockfrostError a) -> m (Either BlockfrostError a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either BlockfrostError a) -> m (Either BlockfrostError a))
-> IO (Either BlockfrostError a) -> m (Either BlockfrostError a)
forall a b. (a -> b) -> a -> b
$ Project -> BlockfrostClientT IO a -> IO (Either BlockfrostError a)
forall a.
Project -> BlockfrostClientT IO a -> IO (Either BlockfrostError a)
Blockfrost.runBlockfrost Project
prj BlockfrostClientT IO a
action)
  case Either BlockfrostError a
res of
    Right a
val -> a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
val
    Left BlockfrostError
Blockfrost.BlockfrostUsageLimitReached -> APIBlockfrostError -> m a
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO APIBlockfrostError
BlockfrostRateLimited
    Left BlockfrostError
err -> APIBlockfrostError -> m a
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (APIBlockfrostError -> m a) -> APIBlockfrostError -> m a
forall a b. (a -> b) -> a -> b
$ Text -> APIBlockfrostError
BlockfrostError (BlockfrostError -> Text
forall b a. (Show a, IsString b) => a -> b
show BlockfrostError
err)
 where
  isRateLimited :: Either Blockfrost.BlockfrostError b -> Bool
  isRateLimited :: forall b. Either BlockfrostError b -> Bool
isRateLimited = \case
    Left BlockfrostError
Blockfrost.BlockfrostUsageLimitReached -> Bool
True
    Either BlockfrostError b
_ -> Bool
False

-- | Run a Blockfrost client action, retrying when rate limited (HTTP 429)
-- using 'blockfrostRetryPolicy'. blockfrost-client does not expose the
-- Retry-After header, so the delay is blind. Gives up by throwing
-- 'BlockfrostRateLimited'.
runBlockfrostM :: (MonadIO m, MonadThrow m) => Blockfrost.Project -> BlockfrostClientT IO a -> m a
runBlockfrostM :: forall (m :: * -> *) a.
(MonadIO m, MonadThrow m) =>
Project -> BlockfrostClientT IO a -> m a
runBlockfrostM = RetryPolicyM m -> Project -> BlockfrostClientT IO a -> m a
forall (m :: * -> *) a.
(MonadIO m, MonadThrow m) =>
RetryPolicyM m -> Project -> BlockfrostClientT IO a -> m a
runBlockfrostMWith RetryPolicyM m
forall (m :: * -> *). MonadIO m => RetryPolicyM m
blockfrostRetryPolicy

-- | 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.
queryScriptRegistry ::
  NetworkId ->
  [TxId] ->
  BlockfrostClientT IO ScriptRegistry
queryScriptRegistry :: NetworkId -> [TxId] -> BlockfrostClientT IO ScriptRegistry
queryScriptRegistry NetworkId
networkId [TxId]
txIds = do
  UTxO
utxo <- NetworkId -> [TxIn] -> BlockfrostClientT IO UTxO
queryUTxOByTxIn NetworkId
networkId [TxIn]
candidates
  case UTxO -> Either NewScriptRegistryException ScriptRegistry
newScriptRegistry UTxO
utxo of
    Left NewScriptRegistryException
e -> IO ScriptRegistry -> BlockfrostClientT IO ScriptRegistry
forall a. IO a -> BlockfrostClientT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ScriptRegistry -> BlockfrostClientT IO ScriptRegistry)
-> IO ScriptRegistry -> BlockfrostClientT IO ScriptRegistry
forall a b. (a -> b) -> a -> b
$ NewScriptRegistryException -> IO ScriptRegistry
forall e a. Exception e => e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO NewScriptRegistryException
e
    Right ScriptRegistry
sr -> ScriptRegistry -> BlockfrostClientT IO ScriptRegistry
forall a. a -> BlockfrostClientT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScriptRegistry
sr
 where
  candidates :: [TxIn]
candidates = (TxId -> TxIn) -> [TxId] -> [TxIn]
forall a b. (a -> b) -> [a] -> [b]
map (\TxId
txid -> TxId -> TxIx -> TxIn
TxIn TxId
txid (Word -> TxIx
TxIx Word
0)) [TxId]
txIds

queryProtocolParameters :: MonadIO m => BlockfrostClientT m (PParams LedgerEra)
queryProtocolParameters :: forall (m :: * -> *).
MonadIO m =>
BlockfrostClientT m (PParams LedgerEra)
queryProtocolParameters = do
  ProtocolParams
pparams <- BlockfrostClientT m ProtocolParams
forall (m :: * -> *). MonadBlockfrost m => m ProtocolParams
Blockfrost.getLatestEpochProtocolParams
  let minVersion :: Natural
minVersion = Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Natural) -> Integer -> Natural
forall a b. (a -> b) -> a -> b
$ ProtocolParams
pparams ProtocolParams -> Getting Integer ProtocolParams Integer -> Integer
forall s a. s -> Getting a s a -> a
^. Getting Integer ProtocolParams Integer
forall s a. HasProtocolMinorVer s a => Lens' s a
Lens' ProtocolParams Integer
Blockfrost.protocolMinorVer
  Version
maxVersion <- IO Version -> BlockfrostClientT m Version
forall a. IO a -> BlockfrostClientT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Version -> BlockfrostClientT m Version)
-> IO Version -> BlockfrostClientT m Version
forall a b. (a -> b) -> a -> b
$ Integer -> IO Version
forall i (m :: * -> *). (Integral i, MonadFail m) => i -> m Version
mkVersion (Integer -> IO Version) -> Integer -> IO Version
forall a b. (a -> b) -> a -> b
$ ProtocolParams
pparams ProtocolParams -> Getting Integer ProtocolParams Integer -> Integer
forall s a. s -> Getting a s a -> a
^. Getting Integer ProtocolParams Integer
forall s a. HasProtocolMajorVer s a => Lens' s a
Lens' ProtocolParams Integer
Blockfrost.protocolMajorVer
  let results :: Maybe BlockfrostConversion
results = do
        NonNegativeInterval
a0 <- Rational -> Maybe NonNegativeInterval
forall r. BoundedRational r => Rational -> Maybe r
boundRational (ProtocolParams
pparams ProtocolParams
-> Getting Rational ProtocolParams Rational -> Rational
forall s a. s -> Getting a s a -> a
^. Getting Rational ProtocolParams Rational
forall s a. HasA0 s a => Lens' s a
Lens' ProtocolParams Rational
Blockfrost.a0)
        UnitInterval
rho <- Rational -> Maybe UnitInterval
forall r. BoundedRational r => Rational -> Maybe r
boundRational (ProtocolParams
pparams ProtocolParams
-> Getting Rational ProtocolParams Rational -> Rational
forall s a. s -> Getting a s a -> a
^. Getting Rational ProtocolParams Rational
forall s a. HasRho s a => Lens' s a
Lens' ProtocolParams Rational
Blockfrost.rho)
        UnitInterval
tau <- Rational -> Maybe UnitInterval
forall r. BoundedRational r => Rational -> Maybe r
boundRational (ProtocolParams
pparams ProtocolParams
-> Getting Rational ProtocolParams Rational -> Rational
forall s a. s -> Getting a s a -> a
^. Getting Rational ProtocolParams Rational
forall s a. HasTau s a => Lens' s a
Lens' ProtocolParams Rational
Blockfrost.tau)
        NonNegativeInterval
priceMemory <- forall r. BoundedRational r => Rational -> Maybe r
boundRational @NonNegativeInterval (ProtocolParams
pparams ProtocolParams
-> Getting Rational ProtocolParams Rational -> Rational
forall s a. s -> Getting a s a -> a
^. Getting Rational ProtocolParams Rational
forall s a. HasPriceMem s a => Lens' s a
Lens' ProtocolParams Rational
Blockfrost.priceMem)
        NonNegativeInterval
priceSteps <- forall r. BoundedRational r => Rational -> Maybe r
boundRational @NonNegativeInterval (ProtocolParams
pparams ProtocolParams
-> Getting Rational ProtocolParams Rational -> Rational
forall s a. s -> Getting a s a -> a
^. Getting Rational ProtocolParams Rational
forall s a. HasPriceStep s a => Lens' s a
Lens' ProtocolParams Rational
Blockfrost.priceStep)
        UnitInterval
pvtMotionNoConfidence <- forall r. BoundedRational r => Rational -> Maybe r
boundRational @UnitInterval (Rational -> Maybe UnitInterval)
-> Maybe Rational -> Maybe UnitInterval
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProtocolParams
pparams ProtocolParams
-> Getting (Maybe Rational) ProtocolParams (Maybe Rational)
-> Maybe Rational
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Rational) ProtocolParams (Maybe Rational)
forall s a. HasPvtMotionNoConfidence s a => Lens' s a
Lens' ProtocolParams (Maybe Rational)
Blockfrost.pvtMotionNoConfidence
        UnitInterval
pvtCommitteeNormal <- forall r. BoundedRational r => Rational -> Maybe r
boundRational @UnitInterval (Rational -> Maybe UnitInterval)
-> Maybe Rational -> Maybe UnitInterval
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProtocolParams
pparams ProtocolParams
-> Getting (Maybe Rational) ProtocolParams (Maybe Rational)
-> Maybe Rational
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Rational) ProtocolParams (Maybe Rational)
forall s a. HasPvtCommitteeNormal s a => Lens' s a
Lens' ProtocolParams (Maybe Rational)
Blockfrost.pvtCommitteeNormal
        UnitInterval
pvtCommitteeNoConfidence <- forall r. BoundedRational r => Rational -> Maybe r
boundRational @UnitInterval (Rational -> Maybe UnitInterval)
-> Maybe Rational -> Maybe UnitInterval
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProtocolParams
pparams ProtocolParams
-> Getting (Maybe Rational) ProtocolParams (Maybe Rational)
-> Maybe Rational
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Rational) ProtocolParams (Maybe Rational)
forall s a. HasPvtCommitteeNoConfidence s a => Lens' s a
Lens' ProtocolParams (Maybe Rational)
Blockfrost.pvtCommitteeNoConfidence
        UnitInterval
pvtHardForkInitiation <- forall r. BoundedRational r => Rational -> Maybe r
boundRational @UnitInterval (Rational -> Maybe UnitInterval)
-> Maybe Rational -> Maybe UnitInterval
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProtocolParams
pparams ProtocolParams
-> Getting (Maybe Rational) ProtocolParams (Maybe Rational)
-> Maybe Rational
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Rational) ProtocolParams (Maybe Rational)
forall s a. HasPvtHardForkInitiation s a => Lens' s a
Lens' ProtocolParams (Maybe Rational)
Blockfrost.pvtHardForkInitiation
        UnitInterval
pvtPPSecurityGroup <- forall r. BoundedRational r => Rational -> Maybe r
boundRational @UnitInterval (Rational -> Maybe UnitInterval)
-> Maybe Rational -> Maybe UnitInterval
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProtocolParams
pparams ProtocolParams
-> Getting (Maybe Rational) ProtocolParams (Maybe Rational)
-> Maybe Rational
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Rational) ProtocolParams (Maybe Rational)
forall s a. HasPvtppSecurityGroup s a => Lens' s a
Lens' ProtocolParams (Maybe Rational)
Blockfrost.pvtppSecurityGroup
        UnitInterval
dvtMotionNoConfidence <- forall r. BoundedRational r => Rational -> Maybe r
boundRational @UnitInterval (Rational -> Maybe UnitInterval)
-> Maybe Rational -> Maybe UnitInterval
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProtocolParams
pparams ProtocolParams
-> Getting (Maybe Rational) ProtocolParams (Maybe Rational)
-> Maybe Rational
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Rational) ProtocolParams (Maybe Rational)
forall s a. HasDvtMotionNoConfidence s a => Lens' s a
Lens' ProtocolParams (Maybe Rational)
Blockfrost.dvtMotionNoConfidence
        UnitInterval
dvtCommitteeNormal <- forall r. BoundedRational r => Rational -> Maybe r
boundRational @UnitInterval (Rational -> Maybe UnitInterval)
-> Maybe Rational -> Maybe UnitInterval
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProtocolParams
pparams ProtocolParams
-> Getting (Maybe Rational) ProtocolParams (Maybe Rational)
-> Maybe Rational
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Rational) ProtocolParams (Maybe Rational)
forall s a. HasDvtCommitteeNormal s a => Lens' s a
Lens' ProtocolParams (Maybe Rational)
Blockfrost.dvtCommitteeNormal
        UnitInterval
dvtCommitteeNoConfidence <- forall r. BoundedRational r => Rational -> Maybe r
boundRational @UnitInterval (Rational -> Maybe UnitInterval)
-> Maybe Rational -> Maybe UnitInterval
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProtocolParams
pparams ProtocolParams
-> Getting (Maybe Rational) ProtocolParams (Maybe Rational)
-> Maybe Rational
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Rational) ProtocolParams (Maybe Rational)
forall s a. HasDvtCommitteeNoConfidence s a => Lens' s a
Lens' ProtocolParams (Maybe Rational)
Blockfrost.dvtCommitteeNoConfidence
        UnitInterval
dvtUpdateToConstitution <- forall r. BoundedRational r => Rational -> Maybe r
boundRational @UnitInterval (Rational -> Maybe UnitInterval)
-> Maybe Rational -> Maybe UnitInterval
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProtocolParams
pparams ProtocolParams
-> Getting (Maybe Rational) ProtocolParams (Maybe Rational)
-> Maybe Rational
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Rational) ProtocolParams (Maybe Rational)
forall s a. HasDvtUpdateToConstitution s a => Lens' s a
Lens' ProtocolParams (Maybe Rational)
Blockfrost.dvtUpdateToConstitution
        UnitInterval
dvtHardForkInitiation <- forall r. BoundedRational r => Rational -> Maybe r
boundRational @UnitInterval (Rational -> Maybe UnitInterval)
-> Maybe Rational -> Maybe UnitInterval
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProtocolParams
pparams ProtocolParams
-> Getting (Maybe Rational) ProtocolParams (Maybe Rational)
-> Maybe Rational
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Rational) ProtocolParams (Maybe Rational)
forall s a. HasDvtHardForkInitiation s a => Lens' s a
Lens' ProtocolParams (Maybe Rational)
Blockfrost.dvtHardForkInitiation
        UnitInterval
dvtPPNetworkGroup <- forall r. BoundedRational r => Rational -> Maybe r
boundRational @UnitInterval (Rational -> Maybe UnitInterval)
-> Maybe Rational -> Maybe UnitInterval
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProtocolParams
pparams ProtocolParams
-> Getting (Maybe Rational) ProtocolParams (Maybe Rational)
-> Maybe Rational
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Rational) ProtocolParams (Maybe Rational)
forall s a. HasDvtPPNetworkGroup s a => Lens' s a
Lens' ProtocolParams (Maybe Rational)
Blockfrost.dvtPPNetworkGroup
        UnitInterval
dvtPPEconomicGroup <- forall r. BoundedRational r => Rational -> Maybe r
boundRational @UnitInterval (Rational -> Maybe UnitInterval)
-> Maybe Rational -> Maybe UnitInterval
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProtocolParams
pparams ProtocolParams
-> Getting (Maybe Rational) ProtocolParams (Maybe Rational)
-> Maybe Rational
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Rational) ProtocolParams (Maybe Rational)
forall s a. HasDvtPPEconomicGroup s a => Lens' s a
Lens' ProtocolParams (Maybe Rational)
Blockfrost.dvtPPEconomicGroup
        UnitInterval
dvtPPTechnicalGroup <- forall r. BoundedRational r => Rational -> Maybe r
boundRational @UnitInterval (Rational -> Maybe UnitInterval)
-> Maybe Rational -> Maybe UnitInterval
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProtocolParams
pparams ProtocolParams
-> Getting (Maybe Rational) ProtocolParams (Maybe Rational)
-> Maybe Rational
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Rational) ProtocolParams (Maybe Rational)
forall s a. HasDvtPPTechnicalGroup s a => Lens' s a
Lens' ProtocolParams (Maybe Rational)
Blockfrost.dvtPPTechnicalGroup
        UnitInterval
dvtPPGovGroup <- forall r. BoundedRational r => Rational -> Maybe r
boundRational @UnitInterval (Rational -> Maybe UnitInterval)
-> Maybe Rational -> Maybe UnitInterval
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProtocolParams
pparams ProtocolParams
-> Getting (Maybe Rational) ProtocolParams (Maybe Rational)
-> Maybe Rational
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Rational) ProtocolParams (Maybe Rational)
forall s a. HasDvtPPGovGroup s a => Lens' s a
Lens' ProtocolParams (Maybe Rational)
Blockfrost.dvtPPGovGroup
        UnitInterval
dvtTreasuryWithdrawal <- forall r. BoundedRational r => Rational -> Maybe r
boundRational @UnitInterval (Rational -> Maybe UnitInterval)
-> Maybe Rational -> Maybe UnitInterval
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProtocolParams
pparams ProtocolParams
-> Getting (Maybe Rational) ProtocolParams (Maybe Rational)
-> Maybe Rational
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Rational) ProtocolParams (Maybe Rational)
forall s a. HasDvtTreasuryWithdrawal s a => Lens' s a
Lens' ProtocolParams (Maybe Rational)
Blockfrost.dvtTreasuryWithdrawal
        Quantity
committeeMinSize <- ProtocolParams
pparams ProtocolParams
-> Getting (Maybe Quantity) ProtocolParams (Maybe Quantity)
-> Maybe Quantity
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Quantity) ProtocolParams (Maybe Quantity)
forall s a. HasCommitteeMinSize s a => Lens' s a
Lens' ProtocolParams (Maybe Quantity)
Blockfrost.committeeMinSize
        Quantity
committeeMaxTermLength <- ProtocolParams
pparams ProtocolParams
-> Getting (Maybe Quantity) ProtocolParams (Maybe Quantity)
-> Maybe Quantity
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Quantity) ProtocolParams (Maybe Quantity)
forall s a. HasCommitteeMaxTermLength s a => Lens' s a
Lens' ProtocolParams (Maybe Quantity)
Blockfrost.committeeMaxTermLength
        Quantity
govActionLifetime <- ProtocolParams
pparams ProtocolParams
-> Getting (Maybe Quantity) ProtocolParams (Maybe Quantity)
-> Maybe Quantity
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Quantity) ProtocolParams (Maybe Quantity)
forall s a. HasGovActionLifetime s a => Lens' s a
Lens' ProtocolParams (Maybe Quantity)
Blockfrost.govActionLifetime
        Coin
govActionDeposit <- Discrete' "ADA" '(1000000, 1) -> Coin
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Discrete' "ADA" '(1000000, 1) -> Coin)
-> Maybe (Discrete' "ADA" '(1000000, 1)) -> Maybe Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolParams
pparams ProtocolParams
-> Getting
     (Maybe (Discrete' "ADA" '(1000000, 1)))
     ProtocolParams
     (Maybe (Discrete' "ADA" '(1000000, 1)))
-> Maybe (Discrete' "ADA" '(1000000, 1))
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Discrete' "ADA" '(1000000, 1)))
  ProtocolParams
  (Maybe (Discrete' "ADA" '(1000000, 1)))
forall s a. HasGovActionDeposit s a => Lens' s a
Lens' ProtocolParams (Maybe (Discrete' "ADA" '(1000000, 1)))
Blockfrost.govActionDeposit
        Integer
drepDeposit <- Discrete' "ADA" '(1000000, 1) -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Discrete' "ADA" '(1000000, 1) -> Integer)
-> Maybe (Discrete' "ADA" '(1000000, 1)) -> Maybe Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolParams
pparams ProtocolParams
-> Getting
     (Maybe (Discrete' "ADA" '(1000000, 1)))
     ProtocolParams
     (Maybe (Discrete' "ADA" '(1000000, 1)))
-> Maybe (Discrete' "ADA" '(1000000, 1))
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Discrete' "ADA" '(1000000, 1)))
  ProtocolParams
  (Maybe (Discrete' "ADA" '(1000000, 1)))
forall s a. HasDrepDeposit s a => Lens' s a
Lens' ProtocolParams (Maybe (Discrete' "ADA" '(1000000, 1)))
Blockfrost.drepDeposit
        Quantity
drepActivity <- ProtocolParams
pparams ProtocolParams
-> Getting (Maybe Quantity) ProtocolParams (Maybe Quantity)
-> Maybe Quantity
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Quantity) ProtocolParams (Maybe Quantity)
forall s a. HasDrepActivity s a => Lens' s a
Lens' ProtocolParams (Maybe Quantity)
Blockfrost.drepActivity
        NonNegativeInterval
minFeeRefScriptCostPerByte <- forall r. BoundedRational r => Rational -> Maybe r
boundRational @NonNegativeInterval (Rational -> Maybe NonNegativeInterval)
-> Maybe Rational -> Maybe NonNegativeInterval
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (ProtocolParams
pparams ProtocolParams
-> Getting (Maybe Rational) ProtocolParams (Maybe Rational)
-> Maybe Rational
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Rational) ProtocolParams (Maybe Rational)
forall s a. HasMinFeeRefScriptCostPerByte s a => Lens' s a
Lens' ProtocolParams (Maybe Rational)
Blockfrost.minFeeRefScriptCostPerByte)
        BlockfrostConversion -> Maybe BlockfrostConversion
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BlockfrostConversion{Integer
Coin
UnitInterval
NonNegativeInterval
Quantity
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
$sel:a0:BlockfrostConversion :: NonNegativeInterval
$sel:rho:BlockfrostConversion :: UnitInterval
$sel:tau:BlockfrostConversion :: UnitInterval
$sel:priceMemory:BlockfrostConversion :: NonNegativeInterval
$sel:priceSteps:BlockfrostConversion :: NonNegativeInterval
$sel:pvtMotionNoConfidence:BlockfrostConversion :: UnitInterval
$sel:pvtCommitteeNormal:BlockfrostConversion :: UnitInterval
$sel:pvtCommitteeNoConfidence:BlockfrostConversion :: UnitInterval
$sel:pvtHardForkInitiation:BlockfrostConversion :: UnitInterval
$sel:pvtPPSecurityGroup:BlockfrostConversion :: UnitInterval
$sel:dvtMotionNoConfidence:BlockfrostConversion :: UnitInterval
$sel:dvtCommitteeNormal:BlockfrostConversion :: UnitInterval
$sel:dvtCommitteeNoConfidence:BlockfrostConversion :: UnitInterval
$sel:dvtUpdateToConstitution:BlockfrostConversion :: UnitInterval
$sel:dvtHardForkInitiation:BlockfrostConversion :: UnitInterval
$sel:dvtPPNetworkGroup:BlockfrostConversion :: UnitInterval
$sel:dvtPPEconomicGroup:BlockfrostConversion :: UnitInterval
$sel:dvtPPTechnicalGroup:BlockfrostConversion :: UnitInterval
$sel:dvtPPGovGroup:BlockfrostConversion :: UnitInterval
$sel:dvtTreasuryWithdrawal:BlockfrostConversion :: UnitInterval
$sel:committeeMinSize:BlockfrostConversion :: Quantity
$sel:committeeMaxTermLength:BlockfrostConversion :: Quantity
$sel:govActionLifetime:BlockfrostConversion :: Quantity
$sel:govActionDeposit:BlockfrostConversion :: Coin
$sel:drepDeposit:BlockfrostConversion :: Integer
$sel:drepActivity:BlockfrostConversion :: Quantity
$sel:minFeeRefScriptCostPerByte:BlockfrostConversion :: NonNegativeInterval
..}

  case Maybe BlockfrostConversion
results of
    Maybe BlockfrostConversion
Nothing -> IO (PParams ConwayEra) -> BlockfrostClientT m (PParams ConwayEra)
forall a. IO a -> BlockfrostClientT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (PParams ConwayEra) -> BlockfrostClientT m (PParams ConwayEra))
-> IO (PParams ConwayEra)
-> BlockfrostClientT m (PParams ConwayEra)
forall a b. (a -> b) -> a -> b
$ APIBlockfrostError -> IO (PParams ConwayEra)
forall e a. Exception e => e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (APIBlockfrostError -> IO (PParams ConwayEra))
-> APIBlockfrostError -> IO (PParams ConwayEra)
forall a b. (a -> b) -> a -> b
$ Text -> APIBlockfrostError
DecodeError Text
"Could not decode some values appropriately."
    Just BlockfrostConversion{Integer
Coin
UnitInterval
NonNegativeInterval
Quantity
$sel:a0:BlockfrostConversion :: BlockfrostConversion -> NonNegativeInterval
$sel:rho:BlockfrostConversion :: BlockfrostConversion -> UnitInterval
$sel:tau:BlockfrostConversion :: BlockfrostConversion -> UnitInterval
$sel:priceMemory:BlockfrostConversion :: BlockfrostConversion -> NonNegativeInterval
$sel:priceSteps:BlockfrostConversion :: BlockfrostConversion -> NonNegativeInterval
$sel:pvtMotionNoConfidence:BlockfrostConversion :: BlockfrostConversion -> UnitInterval
$sel:pvtCommitteeNormal:BlockfrostConversion :: BlockfrostConversion -> UnitInterval
$sel:pvtCommitteeNoConfidence:BlockfrostConversion :: BlockfrostConversion -> UnitInterval
$sel:pvtHardForkInitiation:BlockfrostConversion :: BlockfrostConversion -> UnitInterval
$sel:pvtPPSecurityGroup:BlockfrostConversion :: BlockfrostConversion -> UnitInterval
$sel:dvtMotionNoConfidence:BlockfrostConversion :: BlockfrostConversion -> UnitInterval
$sel:dvtCommitteeNormal:BlockfrostConversion :: BlockfrostConversion -> UnitInterval
$sel:dvtCommitteeNoConfidence:BlockfrostConversion :: BlockfrostConversion -> UnitInterval
$sel:dvtUpdateToConstitution:BlockfrostConversion :: BlockfrostConversion -> UnitInterval
$sel:dvtHardForkInitiation:BlockfrostConversion :: BlockfrostConversion -> UnitInterval
$sel:dvtPPNetworkGroup:BlockfrostConversion :: BlockfrostConversion -> UnitInterval
$sel:dvtPPEconomicGroup:BlockfrostConversion :: BlockfrostConversion -> UnitInterval
$sel:dvtPPTechnicalGroup:BlockfrostConversion :: BlockfrostConversion -> UnitInterval
$sel:dvtPPGovGroup:BlockfrostConversion :: BlockfrostConversion -> UnitInterval
$sel:dvtTreasuryWithdrawal:BlockfrostConversion :: BlockfrostConversion -> UnitInterval
$sel:committeeMinSize:BlockfrostConversion :: BlockfrostConversion -> Quantity
$sel:committeeMaxTermLength:BlockfrostConversion :: BlockfrostConversion -> Quantity
$sel:govActionLifetime:BlockfrostConversion :: BlockfrostConversion -> Quantity
$sel:govActionDeposit:BlockfrostConversion :: BlockfrostConversion -> Coin
$sel:drepDeposit:BlockfrostConversion :: BlockfrostConversion -> Integer
$sel:drepActivity:BlockfrostConversion :: BlockfrostConversion -> Quantity
$sel:minFeeRefScriptCostPerByte:BlockfrostConversion :: BlockfrostConversion -> NonNegativeInterval
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
..} ->
      PParams ConwayEra -> BlockfrostClientT m (PParams ConwayEra)
forall a. a -> BlockfrostClientT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PParams ConwayEra -> BlockfrostClientT m (PParams ConwayEra))
-> PParams ConwayEra -> BlockfrostClientT m (PParams ConwayEra)
forall a b. (a -> b) -> a -> b
$
        PParams ConwayEra
forall era. EraPParams era => PParams era
emptyPParams
          PParams ConwayEra
-> (PParams ConwayEra -> PParams ConwayEra) -> PParams ConwayEra
forall a b. a -> (a -> b) -> b
& (CoinPerByte -> Identity CoinPerByte)
-> PParams ConwayEra -> Identity (PParams ConwayEra)
forall era. EraPParams era => Lens' (PParams era) CoinPerByte
Lens' (PParams ConwayEra) CoinPerByte
ppTxFeePerByteL ((CoinPerByte -> Identity CoinPerByte)
 -> PParams ConwayEra -> Identity (PParams ConwayEra))
-> CoinPerByte -> PParams ConwayEra -> PParams ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ CompactForm Coin -> CoinPerByte
CoinPerByte (HasCallStack => Coin -> CompactForm Coin
Coin -> CompactForm Coin
compactCoinOrError (Integer -> Coin
Coin (ProtocolParams
pparams ProtocolParams -> Getting Integer ProtocolParams Integer -> Integer
forall s a. s -> Getting a s a -> a
^. Getting Integer ProtocolParams Integer
forall s a. HasMinFeeA s a => Lens' s a
Lens' ProtocolParams Integer
Blockfrost.minFeeA)))
          PParams ConwayEra
-> (PParams ConwayEra -> PParams ConwayEra) -> PParams ConwayEra
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> PParams ConwayEra -> Identity (PParams ConwayEra)
forall era.
(EraPParams era, HasCallStack) =>
Lens' (PParams era) Coin
Lens' (PParams ConwayEra) Coin
ppTxFeeFixedL ((Coin -> Identity Coin)
 -> PParams ConwayEra -> Identity (PParams ConwayEra))
-> Coin -> PParams ConwayEra -> PParams ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin (ProtocolParams
pparams ProtocolParams -> Getting Integer ProtocolParams Integer -> Integer
forall s a. s -> Getting a s a -> a
^. Getting Integer ProtocolParams Integer
forall s a. HasMinFeeB s a => Lens' s a
Lens' ProtocolParams Integer
Blockfrost.minFeeB)
          PParams ConwayEra
-> (PParams ConwayEra -> PParams ConwayEra) -> PParams ConwayEra
forall a b. a -> (a -> b) -> b
& (Word32 -> Identity Word32)
-> PParams ConwayEra -> Identity (PParams ConwayEra)
forall era. EraPParams era => Lens' (PParams era) Word32
Lens' (PParams ConwayEra) Word32
ppMaxBBSizeL ((Word32 -> Identity Word32)
 -> PParams ConwayEra -> Identity (PParams ConwayEra))
-> Word32 -> PParams ConwayEra -> PParams ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ProtocolParams
pparams ProtocolParams -> Getting Integer ProtocolParams Integer -> Integer
forall s a. s -> Getting a s a -> a
^. Getting Integer ProtocolParams Integer
forall s a. HasMaxBlockSize s a => Lens' s a
Lens' ProtocolParams Integer
Blockfrost.maxBlockSize)
          PParams ConwayEra
-> (PParams ConwayEra -> PParams ConwayEra) -> PParams ConwayEra
forall a b. a -> (a -> b) -> b
& (Word32 -> Identity Word32)
-> PParams ConwayEra -> Identity (PParams ConwayEra)
forall era. EraPParams era => Lens' (PParams era) Word32
Lens' (PParams ConwayEra) Word32
ppMaxTxSizeL ((Word32 -> Identity Word32)
 -> PParams ConwayEra -> Identity (PParams ConwayEra))
-> Word32 -> PParams ConwayEra -> PParams ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ProtocolParams
pparams ProtocolParams -> Getting Integer ProtocolParams Integer -> Integer
forall s a. s -> Getting a s a -> a
^. Getting Integer ProtocolParams Integer
forall s a. HasMaxTxSize s a => Lens' s a
Lens' ProtocolParams Integer
Blockfrost.maxTxSize)
          PParams ConwayEra
-> (PParams ConwayEra -> PParams ConwayEra) -> PParams ConwayEra
forall a b. a -> (a -> b) -> b
& (Word16 -> Identity Word16)
-> PParams ConwayEra -> Identity (PParams ConwayEra)
forall era. EraPParams era => Lens' (PParams era) Word16
Lens' (PParams ConwayEra) Word16
ppMaxBHSizeL ((Word16 -> Identity Word16)
 -> PParams ConwayEra -> Identity (PParams ConwayEra))
-> Word16 -> PParams ConwayEra -> PParams ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ProtocolParams
pparams ProtocolParams -> Getting Integer ProtocolParams Integer -> Integer
forall s a. s -> Getting a s a -> a
^. Getting Integer ProtocolParams Integer
forall s a. HasMaxBlockHeaderSize s a => Lens' s a
Lens' ProtocolParams Integer
Blockfrost.maxBlockHeaderSize)
          PParams ConwayEra
-> (PParams ConwayEra -> PParams ConwayEra) -> PParams ConwayEra
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> PParams ConwayEra -> Identity (PParams ConwayEra)
forall era.
(EraPParams era, HasCallStack) =>
Lens' (PParams era) Coin
Lens' (PParams ConwayEra) Coin
ppKeyDepositL ((Coin -> Identity Coin)
 -> PParams ConwayEra -> Identity (PParams ConwayEra))
-> Coin -> PParams ConwayEra -> PParams ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Discrete' "ADA" '(1000000, 1) -> Coin
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ProtocolParams
pparams ProtocolParams
-> Getting
     (Discrete' "ADA" '(1000000, 1))
     ProtocolParams
     (Discrete' "ADA" '(1000000, 1))
-> Discrete' "ADA" '(1000000, 1)
forall s a. s -> Getting a s a -> a
^. Getting
  (Discrete' "ADA" '(1000000, 1))
  ProtocolParams
  (Discrete' "ADA" '(1000000, 1))
forall s a. HasKeyDeposit s a => Lens' s a
Lens' ProtocolParams (Discrete' "ADA" '(1000000, 1))
Blockfrost.keyDeposit)
          PParams ConwayEra
-> (PParams ConwayEra -> PParams ConwayEra) -> PParams ConwayEra
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> PParams ConwayEra -> Identity (PParams ConwayEra)
forall era.
(EraPParams era, HasCallStack) =>
Lens' (PParams era) Coin
Lens' (PParams ConwayEra) Coin
ppPoolDepositL ((Coin -> Identity Coin)
 -> PParams ConwayEra -> Identity (PParams ConwayEra))
-> Coin -> PParams ConwayEra -> PParams ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Discrete' "ADA" '(1000000, 1) -> Coin
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ProtocolParams
pparams ProtocolParams
-> Getting
     (Discrete' "ADA" '(1000000, 1))
     ProtocolParams
     (Discrete' "ADA" '(1000000, 1))
-> Discrete' "ADA" '(1000000, 1)
forall s a. s -> Getting a s a -> a
^. Getting
  (Discrete' "ADA" '(1000000, 1))
  ProtocolParams
  (Discrete' "ADA" '(1000000, 1))
forall s a. HasPoolDeposit s a => Lens' s a
Lens' ProtocolParams (Discrete' "ADA" '(1000000, 1))
Blockfrost.poolDeposit)
          PParams ConwayEra
-> (PParams ConwayEra -> PParams ConwayEra) -> PParams ConwayEra
forall a b. a -> (a -> b) -> b
& (EpochInterval -> Identity EpochInterval)
-> PParams ConwayEra -> Identity (PParams ConwayEra)
forall era. EraPParams era => Lens' (PParams era) EpochInterval
Lens' (PParams ConwayEra) EpochInterval
ppEMaxL ((EpochInterval -> Identity EpochInterval)
 -> PParams ConwayEra -> Identity (PParams ConwayEra))
-> EpochInterval -> PParams ConwayEra -> PParams ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32 -> EpochInterval
EpochInterval (Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ProtocolParams
pparams ProtocolParams -> Getting Integer ProtocolParams Integer -> Integer
forall s a. s -> Getting a s a -> a
^. Getting Integer ProtocolParams Integer
forall s a. HasEMax s a => Lens' s a
Lens' ProtocolParams Integer
Blockfrost.eMax))
          PParams ConwayEra
-> (PParams ConwayEra -> PParams ConwayEra) -> PParams ConwayEra
forall a b. a -> (a -> b) -> b
& (Word16 -> Identity Word16)
-> PParams ConwayEra -> Identity (PParams ConwayEra)
forall era. EraPParams era => Lens' (PParams era) Word16
Lens' (PParams ConwayEra) Word16
ppNOptL ((Word16 -> Identity Word16)
 -> PParams ConwayEra -> Identity (PParams ConwayEra))
-> Word16 -> PParams ConwayEra -> PParams ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ProtocolParams
pparams ProtocolParams -> Getting Integer ProtocolParams Integer -> Integer
forall s a. s -> Getting a s a -> a
^. Getting Integer ProtocolParams Integer
forall s a. HasNOpt s a => Lens' s a
Lens' ProtocolParams Integer
Blockfrost.nOpt)
          PParams ConwayEra
-> (PParams ConwayEra -> PParams ConwayEra) -> PParams ConwayEra
forall a b. a -> (a -> b) -> b
& (NonNegativeInterval -> Identity NonNegativeInterval)
-> PParams ConwayEra -> Identity (PParams ConwayEra)
forall era.
EraPParams era =>
Lens' (PParams era) NonNegativeInterval
Lens' (PParams ConwayEra) NonNegativeInterval
ppA0L ((NonNegativeInterval -> Identity NonNegativeInterval)
 -> PParams ConwayEra -> Identity (PParams ConwayEra))
-> NonNegativeInterval -> PParams ConwayEra -> PParams ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ NonNegativeInterval
a0
          PParams ConwayEra
-> (PParams ConwayEra -> PParams ConwayEra) -> PParams ConwayEra
forall a b. a -> (a -> b) -> b
& (UnitInterval -> Identity UnitInterval)
-> PParams ConwayEra -> Identity (PParams ConwayEra)
forall era. EraPParams era => Lens' (PParams era) UnitInterval
Lens' (PParams ConwayEra) UnitInterval
ppRhoL ((UnitInterval -> Identity UnitInterval)
 -> PParams ConwayEra -> Identity (PParams ConwayEra))
-> UnitInterval -> PParams ConwayEra -> PParams ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ UnitInterval
rho
          PParams ConwayEra
-> (PParams ConwayEra -> PParams ConwayEra) -> PParams ConwayEra
forall a b. a -> (a -> b) -> b
& (UnitInterval -> Identity UnitInterval)
-> PParams ConwayEra -> Identity (PParams ConwayEra)
forall era. EraPParams era => Lens' (PParams era) UnitInterval
Lens' (PParams ConwayEra) UnitInterval
ppTauL ((UnitInterval -> Identity UnitInterval)
 -> PParams ConwayEra -> Identity (PParams ConwayEra))
-> UnitInterval -> PParams ConwayEra -> PParams ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ UnitInterval
tau
          PParams ConwayEra
-> (PParams ConwayEra -> PParams ConwayEra) -> PParams ConwayEra
forall a b. a -> (a -> b) -> b
& (ProtVer -> Identity ProtVer)
-> PParams ConwayEra -> Identity (PParams ConwayEra)
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams ConwayEra) ProtVer
ppProtocolVersionL ((ProtVer -> Identity ProtVer)
 -> PParams ConwayEra -> Identity (PParams ConwayEra))
-> ProtVer -> PParams ConwayEra -> PParams ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Version -> Natural -> ProtVer
ProtVer Version
maxVersion Natural
minVersion
          PParams ConwayEra
-> (PParams ConwayEra -> PParams ConwayEra) -> PParams ConwayEra
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> PParams ConwayEra -> Identity (PParams ConwayEra)
forall era.
(EraPParams era, HasCallStack) =>
Lens' (PParams era) Coin
Lens' (PParams ConwayEra) Coin
ppMinPoolCostL ((Coin -> Identity Coin)
 -> PParams ConwayEra -> Identity (PParams ConwayEra))
-> Coin -> PParams ConwayEra -> PParams ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Discrete' "ADA" '(1000000, 1) -> Coin
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ProtocolParams
pparams ProtocolParams
-> Getting
     (Discrete' "ADA" '(1000000, 1))
     ProtocolParams
     (Discrete' "ADA" '(1000000, 1))
-> Discrete' "ADA" '(1000000, 1)
forall s a. s -> Getting a s a -> a
^. Getting
  (Discrete' "ADA" '(1000000, 1))
  ProtocolParams
  (Discrete' "ADA" '(1000000, 1))
forall s a. HasMinPoolCost s a => Lens' s a
Lens' ProtocolParams (Discrete' "ADA" '(1000000, 1))
Blockfrost.minPoolCost)
          PParams ConwayEra
-> (PParams ConwayEra -> PParams ConwayEra) -> PParams ConwayEra
forall a b. a -> (a -> b) -> b
& (CoinPerByte -> Identity CoinPerByte)
-> PParams ConwayEra -> Identity (PParams ConwayEra)
forall era.
BabbageEraPParams era =>
Lens' (PParams era) CoinPerByte
Lens' (PParams ConwayEra) CoinPerByte
ppCoinsPerUTxOByteL ((CoinPerByte -> Identity CoinPerByte)
 -> PParams ConwayEra -> Identity (PParams ConwayEra))
-> CoinPerByte -> PParams ConwayEra -> PParams ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ CompactForm Coin -> CoinPerByte
CoinPerByte (HasCallStack => Coin -> CompactForm Coin
Coin -> CompactForm Coin
compactCoinOrError (Integer -> Coin
Coin (Discrete' "ADA" '(1000000, 1) -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ProtocolParams
pparams ProtocolParams
-> Getting
     (Discrete' "ADA" '(1000000, 1))
     ProtocolParams
     (Discrete' "ADA" '(1000000, 1))
-> Discrete' "ADA" '(1000000, 1)
forall s a. s -> Getting a s a -> a
^. Getting
  (Discrete' "ADA" '(1000000, 1))
  ProtocolParams
  (Discrete' "ADA" '(1000000, 1))
forall s a. HasCoinsPerUtxoSize s a => Lens' s a
Lens' ProtocolParams (Discrete' "ADA" '(1000000, 1))
Blockfrost.coinsPerUtxoSize))))
          PParams ConwayEra
-> (PParams ConwayEra -> PParams ConwayEra) -> PParams ConwayEra
forall a b. a -> (a -> b) -> b
& (CostModels -> Identity CostModels)
-> PParams ConwayEra -> Identity (PParams ConwayEra)
forall era. AlonzoEraPParams era => Lens' (PParams era) CostModels
Lens' (PParams ConwayEra) CostModels
ppCostModelsL ((CostModels -> Identity CostModels)
 -> PParams ConwayEra -> Identity (PParams ConwayEra))
-> CostModels -> PParams ConwayEra -> PParams ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ CostModelsRaw -> CostModels
convertCostModels (ProtocolParams
pparams ProtocolParams
-> Getting CostModelsRaw ProtocolParams CostModelsRaw
-> CostModelsRaw
forall s a. s -> Getting a s a -> a
^. Getting CostModelsRaw ProtocolParams CostModelsRaw
forall s a. HasCostModelsRaw s a => Lens' s a
Lens' ProtocolParams CostModelsRaw
Blockfrost.costModelsRaw)
          PParams ConwayEra
-> (PParams ConwayEra -> PParams ConwayEra) -> PParams ConwayEra
forall a b. a -> (a -> b) -> b
& (Prices -> Identity Prices)
-> PParams ConwayEra -> Identity (PParams ConwayEra)
forall era. AlonzoEraPParams era => Lens' (PParams era) Prices
Lens' (PParams ConwayEra) Prices
ppPricesL ((Prices -> Identity Prices)
 -> PParams ConwayEra -> Identity (PParams ConwayEra))
-> Prices -> PParams ConwayEra -> PParams ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ NonNegativeInterval -> NonNegativeInterval -> Prices
Prices NonNegativeInterval
priceMemory NonNegativeInterval
priceSteps
          PParams ConwayEra
-> (PParams ConwayEra -> PParams ConwayEra) -> PParams ConwayEra
forall a b. a -> (a -> b) -> b
& (ExUnits -> Identity ExUnits)
-> PParams ConwayEra -> Identity (PParams ConwayEra)
forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
Lens' (PParams ConwayEra) ExUnits
ppMaxTxExUnitsL ((ExUnits -> Identity ExUnits)
 -> PParams ConwayEra -> Identity (PParams ConwayEra))
-> ExUnits -> PParams ConwayEra -> PParams ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural -> Natural -> ExUnits
ExUnits (Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Natural) -> Integer -> Natural
forall a b. (a -> b) -> a -> b
$ Quantity -> Integer
Blockfrost.unQuantity (Quantity -> Integer) -> Quantity -> Integer
forall a b. (a -> b) -> a -> b
$ ProtocolParams
pparams ProtocolParams
-> Getting Quantity ProtocolParams Quantity -> Quantity
forall s a. s -> Getting a s a -> a
^. Getting Quantity ProtocolParams Quantity
forall s a. HasMaxTxExMem s a => Lens' s a
Lens' ProtocolParams Quantity
Blockfrost.maxTxExMem) (Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Natural) -> Integer -> Natural
forall a b. (a -> b) -> a -> b
$ Quantity -> Integer
Blockfrost.unQuantity (Quantity -> Integer) -> Quantity -> Integer
forall a b. (a -> b) -> a -> b
$ ProtocolParams
pparams ProtocolParams
-> Getting Quantity ProtocolParams Quantity -> Quantity
forall s a. s -> Getting a s a -> a
^. Getting Quantity ProtocolParams Quantity
forall s a. HasMaxTxExSteps s a => Lens' s a
Lens' ProtocolParams Quantity
Blockfrost.maxTxExSteps)
          PParams ConwayEra
-> (PParams ConwayEra -> PParams ConwayEra) -> PParams ConwayEra
forall a b. a -> (a -> b) -> b
& (ExUnits -> Identity ExUnits)
-> PParams ConwayEra -> Identity (PParams ConwayEra)
forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
Lens' (PParams ConwayEra) ExUnits
ppMaxBlockExUnitsL ((ExUnits -> Identity ExUnits)
 -> PParams ConwayEra -> Identity (PParams ConwayEra))
-> ExUnits -> PParams ConwayEra -> PParams ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural -> Natural -> ExUnits
ExUnits (Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Natural) -> Integer -> Natural
forall a b. (a -> b) -> a -> b
$ Quantity -> Integer
Blockfrost.unQuantity (Quantity -> Integer) -> Quantity -> Integer
forall a b. (a -> b) -> a -> b
$ ProtocolParams
pparams ProtocolParams
-> Getting Quantity ProtocolParams Quantity -> Quantity
forall s a. s -> Getting a s a -> a
^. Getting Quantity ProtocolParams Quantity
forall s a. HasMaxBlockExMem s a => Lens' s a
Lens' ProtocolParams Quantity
Blockfrost.maxBlockExMem) (Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Natural) -> Integer -> Natural
forall a b. (a -> b) -> a -> b
$ Quantity -> Integer
Blockfrost.unQuantity (Quantity -> Integer) -> Quantity -> Integer
forall a b. (a -> b) -> a -> b
$ ProtocolParams
pparams ProtocolParams
-> Getting Quantity ProtocolParams Quantity -> Quantity
forall s a. s -> Getting a s a -> a
^. Getting Quantity ProtocolParams Quantity
forall s a. HasMaxBlockExSteps s a => Lens' s a
Lens' ProtocolParams Quantity
Blockfrost.maxBlockExSteps)
          PParams ConwayEra
-> (PParams ConwayEra -> PParams ConwayEra) -> PParams ConwayEra
forall a b. a -> (a -> b) -> b
& (Word32 -> Identity Word32)
-> PParams ConwayEra -> Identity (PParams ConwayEra)
forall era. AlonzoEraPParams era => Lens' (PParams era) Word32
Lens' (PParams ConwayEra) Word32
ppMaxValSizeL ((Word32 -> Identity Word32)
 -> PParams ConwayEra -> Identity (PParams ConwayEra))
-> Word32 -> PParams ConwayEra -> PParams ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Quantity -> Integer
Blockfrost.unQuantity (Quantity -> Integer) -> Quantity -> Integer
forall a b. (a -> b) -> a -> b
$ ProtocolParams
pparams ProtocolParams
-> Getting Quantity ProtocolParams Quantity -> Quantity
forall s a. s -> Getting a s a -> a
^. Getting Quantity ProtocolParams Quantity
forall s a. HasMaxValSize s a => Lens' s a
Lens' ProtocolParams Quantity
Blockfrost.maxValSize)
          PParams ConwayEra
-> (PParams ConwayEra -> PParams ConwayEra) -> PParams ConwayEra
forall a b. a -> (a -> b) -> b
& (Word16 -> Identity Word16)
-> PParams ConwayEra -> Identity (PParams ConwayEra)
forall era. AlonzoEraPParams era => Lens' (PParams era) Word16
Lens' (PParams ConwayEra) Word16
ppCollateralPercentageL ((Word16 -> Identity Word16)
 -> PParams ConwayEra -> Identity (PParams ConwayEra))
-> Word16 -> PParams ConwayEra -> PParams ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ProtocolParams
pparams ProtocolParams -> Getting Integer ProtocolParams Integer -> Integer
forall s a. s -> Getting a s a -> a
^. Getting Integer ProtocolParams Integer
forall s a. HasCollateralPercent s a => Lens' s a
Lens' ProtocolParams Integer
Blockfrost.collateralPercent)
          PParams ConwayEra
-> (PParams ConwayEra -> PParams ConwayEra) -> PParams ConwayEra
forall a b. a -> (a -> b) -> b
& (Word16 -> Identity Word16)
-> PParams ConwayEra -> Identity (PParams ConwayEra)
forall era. AlonzoEraPParams era => Lens' (PParams era) Word16
Lens' (PParams ConwayEra) Word16
ppMaxCollateralInputsL ((Word16 -> Identity Word16)
 -> PParams ConwayEra -> Identity (PParams ConwayEra))
-> Word16 -> PParams ConwayEra -> PParams ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ProtocolParams
pparams ProtocolParams -> Getting Integer ProtocolParams Integer -> Integer
forall s a. s -> Getting a s a -> a
^. Getting Integer ProtocolParams Integer
forall s a. HasMaxCollateralInputs s a => Lens' s a
Lens' ProtocolParams Integer
Blockfrost.maxCollateralInputs)
          PParams ConwayEra
-> (PParams ConwayEra -> PParams ConwayEra) -> PParams ConwayEra
forall a b. a -> (a -> b) -> b
& (PoolVotingThresholds -> Identity PoolVotingThresholds)
-> PParams ConwayEra -> Identity (PParams ConwayEra)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) PoolVotingThresholds
Lens' (PParams ConwayEra) PoolVotingThresholds
ppPoolVotingThresholdsL ((PoolVotingThresholds -> Identity PoolVotingThresholds)
 -> PParams ConwayEra -> Identity (PParams ConwayEra))
-> PoolVotingThresholds -> PParams ConwayEra -> PParams ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PoolVotingThresholds{UnitInterval
pvtMotionNoConfidence :: UnitInterval
pvtMotionNoConfidence :: UnitInterval
pvtMotionNoConfidence, UnitInterval
pvtCommitteeNormal :: UnitInterval
pvtCommitteeNormal :: UnitInterval
pvtCommitteeNormal, UnitInterval
pvtCommitteeNoConfidence :: UnitInterval
pvtCommitteeNoConfidence :: UnitInterval
pvtCommitteeNoConfidence, UnitInterval
pvtHardForkInitiation :: UnitInterval
pvtHardForkInitiation :: UnitInterval
pvtHardForkInitiation, UnitInterval
pvtPPSecurityGroup :: UnitInterval
pvtPPSecurityGroup :: UnitInterval
pvtPPSecurityGroup}
          PParams ConwayEra
-> (PParams ConwayEra -> PParams ConwayEra) -> PParams ConwayEra
forall a b. a -> (a -> b) -> b
& (DRepVotingThresholds -> Identity DRepVotingThresholds)
-> PParams ConwayEra -> Identity (PParams ConwayEra)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) DRepVotingThresholds
Lens' (PParams ConwayEra) DRepVotingThresholds
ppDRepVotingThresholdsL ((DRepVotingThresholds -> Identity DRepVotingThresholds)
 -> PParams ConwayEra -> Identity (PParams ConwayEra))
-> DRepVotingThresholds -> PParams ConwayEra -> PParams ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DRepVotingThresholds{UnitInterval
dvtMotionNoConfidence :: UnitInterval
dvtMotionNoConfidence :: UnitInterval
dvtMotionNoConfidence, UnitInterval
dvtCommitteeNormal :: UnitInterval
dvtCommitteeNormal :: UnitInterval
dvtCommitteeNormal, UnitInterval
dvtCommitteeNoConfidence :: UnitInterval
dvtCommitteeNoConfidence :: UnitInterval
dvtCommitteeNoConfidence, UnitInterval
dvtUpdateToConstitution :: UnitInterval
dvtUpdateToConstitution :: UnitInterval
dvtUpdateToConstitution, UnitInterval
dvtHardForkInitiation :: UnitInterval
dvtHardForkInitiation :: UnitInterval
dvtHardForkInitiation, UnitInterval
dvtPPNetworkGroup :: UnitInterval
dvtPPNetworkGroup :: UnitInterval
dvtPPNetworkGroup, UnitInterval
dvtPPEconomicGroup :: UnitInterval
dvtPPEconomicGroup :: UnitInterval
dvtPPEconomicGroup, UnitInterval
dvtPPTechnicalGroup :: UnitInterval
dvtPPTechnicalGroup :: UnitInterval
dvtPPTechnicalGroup, UnitInterval
dvtPPGovGroup :: UnitInterval
dvtPPGovGroup :: UnitInterval
dvtPPGovGroup, UnitInterval
dvtTreasuryWithdrawal :: UnitInterval
dvtTreasuryWithdrawal :: UnitInterval
dvtTreasuryWithdrawal}
          PParams ConwayEra
-> (PParams ConwayEra -> PParams ConwayEra) -> PParams ConwayEra
forall a b. a -> (a -> b) -> b
& (Word16 -> Identity Word16)
-> PParams ConwayEra -> Identity (PParams ConwayEra)
forall era. ConwayEraPParams era => Lens' (PParams era) Word16
Lens' (PParams ConwayEra) Word16
ppCommitteeMinSizeL ((Word16 -> Identity Word16)
 -> PParams ConwayEra -> Identity (PParams ConwayEra))
-> Word16 -> PParams ConwayEra -> PParams ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Quantity -> Integer
Blockfrost.unQuantity Quantity
committeeMinSize)
          PParams ConwayEra
-> (PParams ConwayEra -> PParams ConwayEra) -> PParams ConwayEra
forall a b. a -> (a -> b) -> b
& (EpochInterval -> Identity EpochInterval)
-> PParams ConwayEra -> Identity (PParams ConwayEra)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams ConwayEra) EpochInterval
ppCommitteeMaxTermLengthL ((EpochInterval -> Identity EpochInterval)
 -> PParams ConwayEra -> Identity (PParams ConwayEra))
-> EpochInterval -> PParams ConwayEra -> PParams ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32 -> EpochInterval
EpochInterval (Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word32) -> Integer -> Word32
forall a b. (a -> b) -> a -> b
$ Quantity -> Integer
Blockfrost.unQuantity Quantity
committeeMaxTermLength)
          PParams ConwayEra
-> (PParams ConwayEra -> PParams ConwayEra) -> PParams ConwayEra
forall a b. a -> (a -> b) -> b
& (EpochInterval -> Identity EpochInterval)
-> PParams ConwayEra -> Identity (PParams ConwayEra)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams ConwayEra) EpochInterval
ppGovActionLifetimeL ((EpochInterval -> Identity EpochInterval)
 -> PParams ConwayEra -> Identity (PParams ConwayEra))
-> EpochInterval -> PParams ConwayEra -> PParams ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32 -> EpochInterval
EpochInterval (Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word32) -> Integer -> Word32
forall a b. (a -> b) -> a -> b
$ Quantity -> Integer
Blockfrost.unQuantity Quantity
govActionLifetime)
          PParams ConwayEra
-> (PParams ConwayEra -> PParams ConwayEra) -> PParams ConwayEra
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> PParams ConwayEra -> Identity (PParams ConwayEra)
forall era.
(ConwayEraPParams era, HasCallStack) =>
Lens' (PParams era) Coin
Lens' (PParams ConwayEra) Coin
ppGovActionDepositL ((Coin -> Identity Coin)
 -> PParams ConwayEra -> Identity (PParams ConwayEra))
-> Coin -> PParams ConwayEra -> PParams ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
govActionDeposit
          PParams ConwayEra
-> (PParams ConwayEra -> PParams ConwayEra) -> PParams ConwayEra
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> PParams ConwayEra -> Identity (PParams ConwayEra)
forall era. ConwayEraPParams era => Lens' (PParams era) Coin
Lens' (PParams ConwayEra) Coin
ppDRepDepositL ((Coin -> Identity Coin)
 -> PParams ConwayEra -> Identity (PParams ConwayEra))
-> Coin -> PParams ConwayEra -> PParams ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
drepDeposit
          PParams ConwayEra
-> (PParams ConwayEra -> PParams ConwayEra) -> PParams ConwayEra
forall a b. a -> (a -> b) -> b
& (EpochInterval -> Identity EpochInterval)
-> PParams ConwayEra -> Identity (PParams ConwayEra)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams ConwayEra) EpochInterval
ppDRepActivityL ((EpochInterval -> Identity EpochInterval)
 -> PParams ConwayEra -> Identity (PParams ConwayEra))
-> EpochInterval -> PParams ConwayEra -> PParams ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32 -> EpochInterval
EpochInterval (Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word32) -> Integer -> Word32
forall a b. (a -> b) -> a -> b
$ Quantity -> Integer
Blockfrost.unQuantity Quantity
drepActivity)
          PParams ConwayEra
-> (PParams ConwayEra -> PParams ConwayEra) -> PParams ConwayEra
forall a b. a -> (a -> b) -> b
& (NonNegativeInterval -> Identity NonNegativeInterval)
-> PParams ConwayEra -> Identity (PParams ConwayEra)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) NonNegativeInterval
Lens' (PParams ConwayEra) NonNegativeInterval
ppMinFeeRefScriptCostPerByteL ((NonNegativeInterval -> Identity NonNegativeInterval)
 -> PParams ConwayEra -> Identity (PParams ConwayEra))
-> NonNegativeInterval -> PParams ConwayEra -> PParams ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ NonNegativeInterval
minFeeRefScriptCostPerByte
 where
  convertCostModels :: Blockfrost.CostModelsRaw -> Cardano.Ledger.Plutus.CostModels.CostModels
  convertCostModels :: CostModelsRaw -> CostModels
convertCostModels CostModelsRaw
costModels =
    let costModelsMap :: Map ScriptType [Integer]
costModelsMap = CostModelsRaw -> Map ScriptType [Integer]
Blockfrost.unCostModelsRaw CostModelsRaw
costModels
     in ((ScriptType, [Integer]) -> CostModels)
-> [(ScriptType, [Integer])] -> CostModels
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
          ( (CostModels
forall a. Monoid a => a
mempty <>)
              (CostModels -> CostModels)
-> ((ScriptType, [Integer]) -> CostModels)
-> (ScriptType, [Integer])
-> CostModels
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( \(ScriptType
scriptType, [Integer]
v) ->
                    case ScriptType -> Maybe Language
scriptTypeToPlutusVersion ScriptType
scriptType of
                      Maybe Language
Nothing -> CostModels
forall a. Monoid a => a
mempty
                      Just Language
plutusScript ->
                        case Language -> [Int64] -> Either CostModelApplyError CostModel
mkCostModel Language
plutusScript (Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int64) -> [Integer] -> [Int64]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Integer]
v) of
                          Left CostModelApplyError
_ -> CostModels
forall a. Monoid a => a
mempty
                          Right CostModel
costModel -> Map Language CostModel -> CostModels
mkCostModels (Map Language CostModel -> CostModels)
-> Map Language CostModel -> CostModels
forall a b. (a -> b) -> a -> b
$ Language -> CostModel -> Map Language CostModel
forall k a. k -> a -> Map k a
Map.singleton Language
plutusScript CostModel
costModel
                )
          )
          (Map ScriptType [Integer] -> [(ScriptType, [Integer])]
forall k a. Map k a -> [(k, a)]
Map.toList Map ScriptType [Integer]
costModelsMap)

-- ** Helpers

toCardanoUTxO :: NetworkId -> TxIn -> Blockfrost.Address -> Maybe Blockfrost.ScriptHash -> Maybe Blockfrost.DatumHash -> [Blockfrost.Amount] -> Maybe Blockfrost.InlineDatum -> BlockfrostClientT IO UTxO
toCardanoUTxO :: NetworkId
-> TxIn
-> Address
-> Maybe ScriptHash
-> Maybe DatumHash
-> [Amount]
-> Maybe InlineDatum
-> BlockfrostClientT IO UTxO
toCardanoUTxO NetworkId
networkId TxIn
txIn Address
address Maybe ScriptHash
scriptHash Maybe DatumHash
datumHash [Amount]
amount Maybe InlineDatum
inlineDatum = do
  let addrTxt :: Text
addrTxt = Address -> Text
Blockfrost.unAddress Address
address
  let datumHash' :: Maybe Text
datumHash' = DatumHash -> Text
Blockfrost.unDatumHash (DatumHash -> Text) -> Maybe DatumHash -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe DatumHash
datumHash
  let inlineDatum' :: Maybe Text
inlineDatum' = ScriptDatumCBOR -> Text
Blockfrost._scriptDatumCborCbor (ScriptDatumCBOR -> Text)
-> (InlineDatum -> ScriptDatumCBOR) -> InlineDatum -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InlineDatum -> ScriptDatumCBOR
Blockfrost.unInlineDatum (InlineDatum -> Text) -> Maybe InlineDatum -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe InlineDatum
inlineDatum
  Value
val <- [Amount] -> BlockfrostClientT IO Value
toCardanoValue [Amount]
amount
  Maybe PlutusScript
plutusScript <- BlockfrostClientT IO (Maybe PlutusScript)
-> (ScriptHash -> BlockfrostClientT IO (Maybe PlutusScript))
-> Maybe ScriptHash
-> BlockfrostClientT IO (Maybe PlutusScript)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe PlutusScript -> BlockfrostClientT IO (Maybe PlutusScript)
forall a. a -> BlockfrostClientT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe PlutusScript
forall a. Maybe a
Nothing) (Text -> BlockfrostClientT IO (Maybe PlutusScript)
queryScript (Text -> BlockfrostClientT IO (Maybe PlutusScript))
-> (ScriptHash -> Text)
-> ScriptHash
-> BlockfrostClientT IO (Maybe PlutusScript)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptHash -> Text
Blockfrost.unScriptHash) Maybe ScriptHash
scriptHash
  TxOut CtxUTxO
o <- NetworkId
-> Text
-> Value
-> Maybe Text
-> Maybe Text
-> Maybe PlutusScript
-> BlockfrostClientT IO (TxOut CtxUTxO)
forall ctx.
NetworkId
-> Text
-> Value
-> Maybe Text
-> Maybe Text
-> Maybe PlutusScript
-> BlockfrostClientT IO (TxOut ctx)
toCardanoTxOut NetworkId
networkId Text
addrTxt Value
val Maybe Text
datumHash' Maybe Text
inlineDatum' Maybe PlutusScript
plutusScript
  UTxO -> BlockfrostClientT IO UTxO
forall a. a -> BlockfrostClientT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UTxO -> BlockfrostClientT IO UTxO)
-> UTxO -> BlockfrostClientT IO UTxO
forall a b. (a -> b) -> a -> b
$ TxIn -> TxOut CtxUTxO -> UTxO
forall era. TxIn -> TxOut CtxUTxO era -> UTxO era
UTxO.singleton TxIn
txIn TxOut CtxUTxO
o

scriptTypeToPlutusVersion :: Blockfrost.ScriptType -> Maybe Language
scriptTypeToPlutusVersion :: ScriptType -> Maybe Language
scriptTypeToPlutusVersion = \case
  ScriptType
Blockfrost.PlutusV1 -> Language -> Maybe Language
forall a. a -> Maybe a
Just Language
PlutusV1
  ScriptType
Blockfrost.PlutusV2 -> Language -> Maybe Language
forall a. a -> Maybe a
Just Language
PlutusV2
  ScriptType
Blockfrost.PlutusV3 -> Language -> Maybe Language
forall a. a -> Maybe a
Just Language
PlutusV3
  ScriptType
Blockfrost.Timelock -> Maybe Language
forall a. Maybe a
Nothing

toCardanoPoolId :: Blockfrost.PoolId -> Hash StakePoolKey
toCardanoPoolId :: PoolId -> Hash StakePoolKey
toCardanoPoolId (Blockfrost.PoolId Text
textPoolId) =
  case ByteString -> Either RawBytesHexError (Hash StakePoolKey)
forall a.
SerialiseAsRawBytes a =>
ByteString -> Either RawBytesHexError a
deserialiseFromRawBytesHex (Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
textPoolId) of
    Left RawBytesHexError
err -> Text -> Hash StakePoolKey
forall a t. (HasCallStack, IsText t) => t -> a
error (RawBytesHexError -> Text
forall b a. (Show a, IsString b) => a -> b
show RawBytesHexError
err)
    Right Hash StakePoolKey
pool -> Hash StakePoolKey
pool

toCardanoTxIn :: Text -> Integer -> TxIn
toCardanoTxIn :: Text -> Integer -> TxIn
toCardanoTxIn Text
txHash Integer
i =
  case ByteString -> Either RawBytesHexError TxId
forall a.
SerialiseAsRawBytes a =>
ByteString -> Either RawBytesHexError a
deserialiseFromRawBytesHex (Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
txHash) of
    Left RawBytesHexError
err -> Text -> TxIn
forall a t. (HasCallStack, IsText t) => t -> a
error (RawBytesHexError -> Text
forall b a. (Show a, IsString b) => a -> b
show RawBytesHexError
err)
    Right TxId
txid -> TxId -> TxIx -> TxIn
TxIn TxId
txid (Word -> TxIx
TxIx (Integer -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i))

toCardanoTxOut :: NetworkId -> Text -> Value -> Maybe Text -> Maybe Text -> Maybe PlutusScript -> BlockfrostClientT IO (TxOut ctx)
toCardanoTxOut :: forall ctx.
NetworkId
-> Text
-> Value
-> Maybe Text
-> Maybe Text
-> Maybe PlutusScript
-> BlockfrostClientT IO (TxOut ctx)
toCardanoTxOut NetworkId
networkId Text
addrTxt Value
val Maybe Text
mDatumHash Maybe Text
mInlineDatum Maybe PlutusScript
plutusScript = do
  TxOutDatum ctx
datum <-
    case Maybe Text
mInlineDatum of
      Maybe Text
Nothing ->
        case Maybe Text
mDatumHash of
          Maybe Text
Nothing -> TxOutDatum ctx -> BlockfrostClientT IO (TxOutDatum ctx)
forall a. a -> BlockfrostClientT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TxOutDatum ctx
forall ctx. TxOutDatum ctx
TxOutDatumNone
          Just Text
datumHash -> TxOutDatum ctx -> BlockfrostClientT IO (TxOutDatum ctx)
forall a. a -> BlockfrostClientT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxOutDatum ctx -> BlockfrostClientT IO (TxOutDatum ctx))
-> TxOutDatum ctx -> BlockfrostClientT IO (TxOutDatum ctx)
forall a b. (a -> b) -> a -> b
$ Hash ScriptData -> TxOutDatum ctx
forall ctx. Hash ScriptData -> TxOutDatum ctx
TxOutDatumHash (String -> Hash ScriptData
forall a. IsString a => String -> a
fromString (String -> Hash ScriptData) -> String -> Hash ScriptData
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
datumHash)
      Just Text
cborDatum ->
        -- NOTE: The Blockfrost API returns inline datums as base16 encoded CBOR.
        case Text -> Either String ByteString
forall (f :: * -> *). MonadFail f => Text -> f ByteString
decodeBase16 Text
cborDatum :: Either String ByteString of
          Left String
err ->
            IO (TxOutDatum ctx) -> BlockfrostClientT IO (TxOutDatum ctx)
forall a. IO a -> BlockfrostClientT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TxOutDatum ctx) -> BlockfrostClientT IO (TxOutDatum ctx))
-> IO (TxOutDatum ctx) -> BlockfrostClientT IO (TxOutDatum ctx)
forall a b. (a -> b) -> a -> b
$ APIBlockfrostError -> IO (TxOutDatum ctx)
forall e a. Exception e => e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (APIBlockfrostError -> IO (TxOutDatum ctx))
-> APIBlockfrostError -> IO (TxOutDatum ctx)
forall a b. (a -> b) -> a -> b
$ BlockfrostException -> APIBlockfrostError
BlockfrostClientError (BlockfrostException -> APIBlockfrostError)
-> BlockfrostException -> APIBlockfrostError
forall a b. (a -> b) -> a -> b
$ Text -> BlockfrostException
DeserialiseError (Text -> BlockfrostException) -> Text -> BlockfrostException
forall a b. (a -> b) -> a -> b
$ Text
"Failed to decode inline datum " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cborDatum Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. ToText a => a -> Text
toText String
err
          Right ByteString
rawCborDatum ->
            case AsType HashableScriptData
-> ByteString -> Either DecoderError HashableScriptData
forall a.
SerialiseAsCBOR a =>
AsType a -> ByteString -> Either DecoderError a
deserialiseFromCBOR (Proxy HashableScriptData -> AsType HashableScriptData
forall t. HasTypeProxy t => Proxy t -> AsType t
proxyToAsType (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @HashableScriptData)) ByteString
rawCborDatum of
              Left DecoderError
err ->
                IO (TxOutDatum ctx) -> BlockfrostClientT IO (TxOutDatum ctx)
forall a. IO a -> BlockfrostClientT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TxOutDatum ctx) -> BlockfrostClientT IO (TxOutDatum ctx))
-> IO (TxOutDatum ctx) -> BlockfrostClientT IO (TxOutDatum ctx)
forall a b. (a -> b) -> a -> b
$ APIBlockfrostError -> IO (TxOutDatum ctx)
forall e a. Exception e => e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (APIBlockfrostError -> IO (TxOutDatum ctx))
-> APIBlockfrostError -> IO (TxOutDatum ctx)
forall a b. (a -> b) -> a -> b
$ BlockfrostException -> APIBlockfrostError
BlockfrostClientError (BlockfrostException -> APIBlockfrostError)
-> BlockfrostException -> APIBlockfrostError
forall a b. (a -> b) -> a -> b
$ Text -> BlockfrostException
DeserialiseError (Text -> BlockfrostException) -> Text -> BlockfrostException
forall a b. (a -> b) -> a -> b
$ Text
"Failed to deserialise inline datum " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cborDatum Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DecoderError -> Text
forall b a. (Show a, IsString b) => a -> b
show DecoderError
err
              Right HashableScriptData
hashableScriptData -> TxOutDatum ctx -> BlockfrostClientT IO (TxOutDatum ctx)
forall a. a -> BlockfrostClientT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxOutDatum ctx -> BlockfrostClientT IO (TxOutDatum ctx))
-> TxOutDatum ctx -> BlockfrostClientT IO (TxOutDatum ctx)
forall a b. (a -> b) -> a -> b
$ HashableScriptData -> TxOutDatum ctx
forall ctx. HashableScriptData -> TxOutDatum ctx
TxOutDatumInline HashableScriptData
hashableScriptData
  case Maybe PlutusScript
plutusScript of
    Maybe PlutusScript
Nothing -> do
      case Text -> Maybe AddressInEra
toCardanoAddress Text
addrTxt of
        Maybe AddressInEra
Nothing -> IO (TxOut ctx) -> BlockfrostClientT IO (TxOut ctx)
forall a. IO a -> BlockfrostClientT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TxOut ctx) -> BlockfrostClientT IO (TxOut ctx))
-> IO (TxOut ctx) -> BlockfrostClientT IO (TxOut ctx)
forall a b. (a -> b) -> a -> b
$ APIBlockfrostError -> IO (TxOut ctx)
forall e a. Exception e => e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (APIBlockfrostError -> IO (TxOut ctx))
-> APIBlockfrostError -> IO (TxOut ctx)
forall a b. (a -> b) -> a -> b
$ BlockfrostException -> APIBlockfrostError
BlockfrostClientError (BlockfrostException -> APIBlockfrostError)
-> BlockfrostException -> APIBlockfrostError
forall a b. (a -> b) -> a -> b
$ Text -> BlockfrostException
FailedToDecodeAddress Text
addrTxt
        Just AddressInEra
addr -> TxOut ctx -> BlockfrostClientT IO (TxOut ctx)
forall a. a -> BlockfrostClientT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxOut ctx -> BlockfrostClientT IO (TxOut ctx))
-> TxOut ctx -> BlockfrostClientT IO (TxOut ctx)
forall a b. (a -> b) -> a -> b
$ AddressInEra
-> Value -> TxOutDatum ctx -> ReferenceScript -> TxOut ctx
forall ctx.
AddressInEra
-> Value -> TxOutDatum ctx -> ReferenceScript -> TxOut ctx
TxOut AddressInEra
addr Value
val TxOutDatum ctx
datum ReferenceScript
ReferenceScriptNone
    Just PlutusScript
script -> TxOut ctx -> BlockfrostClientT IO (TxOut ctx)
forall a. a -> BlockfrostClientT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxOut ctx -> BlockfrostClientT IO (TxOut ctx))
-> TxOut ctx -> BlockfrostClientT IO (TxOut ctx)
forall a b. (a -> b) -> a -> b
$ AddressInEra
-> Value -> TxOutDatum ctx -> ReferenceScript -> TxOut ctx
forall ctx.
AddressInEra
-> Value -> TxOutDatum ctx -> ReferenceScript -> TxOut ctx
TxOut (PlutusScript -> AddressInEra
scriptAddr PlutusScript
script) Value
val TxOutDatum ctx
datum (PlutusScript -> ReferenceScript
forall lang.
IsPlutusScriptLanguage lang =>
PlutusScript lang -> ReferenceScript
mkScriptRef PlutusScript
script)
 where
  scriptAddr :: PlutusScript -> AddressInEra
scriptAddr PlutusScript
script =
    ShelleyBasedEra Era
-> NetworkId
-> PaymentCredential
-> StakeAddressReference
-> AddressInEra
forall era.
ShelleyBasedEra era
-> NetworkId
-> PaymentCredential
-> StakeAddressReference
-> AddressInEra era
makeShelleyAddressInEra
      ShelleyBasedEra Era
forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra
      NetworkId
networkId
      (ScriptHash -> PaymentCredential
PaymentCredentialByScript (ScriptHash -> PaymentCredential)
-> ScriptHash -> PaymentCredential
forall a b. (a -> b) -> a -> b
$ Script PlutusScriptV3 -> ScriptHash
forall lang. Script lang -> ScriptHash
hashScript (Script PlutusScriptV3 -> ScriptHash)
-> Script PlutusScriptV3 -> ScriptHash
forall a b. (a -> b) -> a -> b
$ PlutusScript -> Script PlutusScriptV3
PlutusScript PlutusScript
script)
      StakeAddressReference
NoStakeAddress

toCardanoPolicyIdAndAssetName :: Text -> BlockfrostClientT IO (PolicyId, AssetName)
toCardanoPolicyIdAndAssetName :: Text -> BlockfrostClientT IO (PolicyId, AssetName)
toCardanoPolicyIdAndAssetName Text
pid = do
  Blockfrost.AssetDetails{PolicyId
_assetDetailsPolicyId :: PolicyId
$sel:_assetDetailsPolicyId:AssetDetails :: AssetDetails -> PolicyId
_assetDetailsPolicyId, Maybe Text
_assetDetailsAssetName :: Maybe Text
$sel:_assetDetailsAssetName:AssetDetails :: AssetDetails -> Maybe Text
_assetDetailsAssetName} <- AssetId -> BlockfrostClientT IO AssetDetails
forall (m :: * -> *).
MonadBlockfrost m =>
AssetId -> m AssetDetails
Blockfrost.getAssetDetails (Text -> AssetId
Blockfrost.mkAssetId Text
pid)
  case ByteString -> Either RawBytesHexError PolicyId
forall a.
SerialiseAsRawBytes a =>
ByteString -> Either RawBytesHexError a
deserialiseFromRawBytesHex (Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ PolicyId -> Text
Blockfrost.unPolicyId PolicyId
_assetDetailsPolicyId) of
    Left RawBytesHexError
err -> IO (PolicyId, AssetName)
-> BlockfrostClientT IO (PolicyId, AssetName)
forall a. IO a -> BlockfrostClientT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (PolicyId, AssetName)
 -> BlockfrostClientT IO (PolicyId, AssetName))
-> IO (PolicyId, AssetName)
-> BlockfrostClientT IO (PolicyId, AssetName)
forall a b. (a -> b) -> a -> b
$ APIBlockfrostError -> IO (PolicyId, AssetName)
forall e a. Exception e => e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (APIBlockfrostError -> IO (PolicyId, AssetName))
-> APIBlockfrostError -> IO (PolicyId, AssetName)
forall a b. (a -> b) -> a -> b
$ BlockfrostException -> APIBlockfrostError
BlockfrostClientError (BlockfrostException -> APIBlockfrostError)
-> BlockfrostException -> APIBlockfrostError
forall a b. (a -> b) -> a -> b
$ Text -> BlockfrostException
DeserialiseError (RawBytesHexError -> Text
forall b a. (Show a, IsString b) => a -> b
show RawBytesHexError
err)
    Right PolicyId
p ->
      case Maybe Text
_assetDetailsAssetName of
        Maybe Text
Nothing -> IO (PolicyId, AssetName)
-> BlockfrostClientT IO (PolicyId, AssetName)
forall a. IO a -> BlockfrostClientT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (PolicyId, AssetName)
 -> BlockfrostClientT IO (PolicyId, AssetName))
-> IO (PolicyId, AssetName)
-> BlockfrostClientT IO (PolicyId, AssetName)
forall a b. (a -> b) -> a -> b
$ APIBlockfrostError -> IO (PolicyId, AssetName)
forall e a. Exception e => e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (APIBlockfrostError -> IO (PolicyId, AssetName))
-> APIBlockfrostError -> IO (PolicyId, AssetName)
forall a b. (a -> b) -> a -> b
$ BlockfrostException -> APIBlockfrostError
BlockfrostClientError BlockfrostException
AssetNameMissing
        Just Text
assetName ->
          case ByteString -> Either RawBytesHexError AssetName
forall a.
SerialiseAsRawBytes a =>
ByteString -> Either RawBytesHexError a
deserialiseFromRawBytesHex (Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
assetName) of
            Left RawBytesHexError
err -> IO (PolicyId, AssetName)
-> BlockfrostClientT IO (PolicyId, AssetName)
forall a. IO a -> BlockfrostClientT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (PolicyId, AssetName)
 -> BlockfrostClientT IO (PolicyId, AssetName))
-> IO (PolicyId, AssetName)
-> BlockfrostClientT IO (PolicyId, AssetName)
forall a b. (a -> b) -> a -> b
$ APIBlockfrostError -> IO (PolicyId, AssetName)
forall e a. Exception e => e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (APIBlockfrostError -> IO (PolicyId, AssetName))
-> APIBlockfrostError -> IO (PolicyId, AssetName)
forall a b. (a -> b) -> a -> b
$ BlockfrostException -> APIBlockfrostError
BlockfrostClientError (BlockfrostException -> APIBlockfrostError)
-> BlockfrostException -> APIBlockfrostError
forall a b. (a -> b) -> a -> b
$ Text -> BlockfrostException
DeserialiseError (RawBytesHexError -> Text
forall b a. (Show a, IsString b) => a -> b
show RawBytesHexError
err)
            Right AssetName
asset -> (PolicyId, AssetName) -> BlockfrostClientT IO (PolicyId, AssetName)
forall a. a -> BlockfrostClientT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PolicyId
p, AssetName
asset)

toCardanoValue :: [Blockfrost.Amount] -> BlockfrostClientT IO Value
toCardanoValue :: [Amount] -> BlockfrostClientT IO Value
toCardanoValue = (Amount -> BlockfrostClientT IO Value)
-> [Amount] -> BlockfrostClientT IO Value
forall b (m :: * -> *) (f :: * -> *) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM Amount -> BlockfrostClientT IO Value
convertAmount
 where
  convertAmount :: Blockfrost.Amount -> BlockfrostClientT IO Value
  convertAmount :: Amount -> BlockfrostClientT IO Value
convertAmount (Blockfrost.AdaAmount Lovelaces
lovelaces) =
    Value -> BlockfrostClientT IO Value
forall a. a -> BlockfrostClientT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> BlockfrostClientT IO Value)
-> Value -> BlockfrostClientT IO Value
forall a b. (a -> b) -> a -> b
$
      [Item Value] -> Value
forall l. IsList l => [Item l] -> l
fromList
        [
          ( AssetId
AdaAssetId
          , Integer -> Quantity
Quantity (Discrete' "ADA" '(1000000, 1) -> Integer
forall a. Integral a => a -> Integer
toInteger Discrete' "ADA" '(1000000, 1)
Lovelaces
lovelaces)
          )
        ]
  convertAmount (Blockfrost.AssetAmount SomeDiscrete
money) = do
    let currency :: Text
currency = SomeDiscrete -> Text
Money.someDiscreteCurrency SomeDiscrete
money
    (PolicyId
cardanoPolicyId, AssetName
assetName) <- Text -> BlockfrostClientT IO (PolicyId, AssetName)
toCardanoPolicyIdAndAssetName Text
currency
    Value -> BlockfrostClientT IO Value
forall a. a -> BlockfrostClientT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> BlockfrostClientT IO Value)
-> Value -> BlockfrostClientT IO Value
forall a b. (a -> b) -> a -> b
$
      [Item Value] -> Value
forall l. IsList l => [Item l] -> l
fromList
        [
          ( PolicyId -> AssetName -> AssetId
AssetId
              PolicyId
cardanoPolicyId
              AssetName
assetName
          , Integer -> Quantity
Quantity (SomeDiscrete -> Integer
Money.someDiscreteAmount SomeDiscrete
money)
          )
        ]

toCardanoAddress :: Text -> Maybe AddressInEra
toCardanoAddress :: Text -> Maybe AddressInEra
toCardanoAddress Text
addrTxt =
  Address ShelleyAddr -> AddressInEra
ShelleyAddressInEra (Address ShelleyAddr -> AddressInEra)
-> Maybe (Address ShelleyAddr) -> Maybe AddressInEra
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AsType (Address ShelleyAddr) -> Text -> Maybe (Address ShelleyAddr)
forall addr.
SerialiseAddress addr =>
AsType addr -> Text -> Maybe addr
deserialiseAddress (AsType ShelleyAddr -> AsType (Address ShelleyAddr)
forall addrtype. AsType addrtype -> AsType (Address addrtype)
AsAddress AsType ShelleyAddr
AsShelleyAddr) Text
addrTxt

toCardanoNetworkId :: Integer -> NetworkId
toCardanoNetworkId :: Integer -> NetworkId
toCardanoNetworkId Integer
magic =
  if Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
magic Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== ProtocolMagicId -> Word32
unProtocolMagicId ProtocolMagicId
mainnetProtocolMagicId
    then NetworkId
Mainnet
    else NetworkMagic -> NetworkId
Testnet (Word32 -> NetworkMagic
NetworkMagic (Integer -> Word32
forall a. Num a => Integer -> a
fromInteger Integer
magic))

toCardanoSystemStart :: Blockfrost.Genesis -> SystemStart
toCardanoSystemStart :: Genesis -> SystemStart
toCardanoSystemStart Blockfrost.Genesis{NominalDiffTime
_genesisSystemStart :: NominalDiffTime
$sel:_genesisSystemStart:Genesis :: Genesis -> NominalDiffTime
_genesisSystemStart} =
  UTCTime -> SystemStart
SystemStart (UTCTime -> SystemStart) -> UTCTime -> SystemStart
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> UTCTime
posixSecondsToUTCTime NominalDiffTime
_genesisSystemStart

data BlockfrostConversion
  = BlockfrostConversion
  { BlockfrostConversion -> NonNegativeInterval
a0 :: NonNegativeInterval
  , BlockfrostConversion -> UnitInterval
rho :: UnitInterval
  , BlockfrostConversion -> UnitInterval
tau :: UnitInterval
  , BlockfrostConversion -> NonNegativeInterval
priceMemory :: NonNegativeInterval
  , BlockfrostConversion -> NonNegativeInterval
priceSteps :: NonNegativeInterval
  , BlockfrostConversion -> UnitInterval
pvtMotionNoConfidence :: UnitInterval
  , BlockfrostConversion -> UnitInterval
pvtCommitteeNormal :: UnitInterval
  , BlockfrostConversion -> UnitInterval
pvtCommitteeNoConfidence :: UnitInterval
  , BlockfrostConversion -> UnitInterval
pvtHardForkInitiation :: UnitInterval
  , BlockfrostConversion -> UnitInterval
pvtPPSecurityGroup :: UnitInterval
  , BlockfrostConversion -> UnitInterval
dvtMotionNoConfidence :: UnitInterval
  , BlockfrostConversion -> UnitInterval
dvtCommitteeNormal :: UnitInterval
  , BlockfrostConversion -> UnitInterval
dvtCommitteeNoConfidence :: UnitInterval
  , BlockfrostConversion -> UnitInterval
dvtUpdateToConstitution :: UnitInterval
  , BlockfrostConversion -> UnitInterval
dvtHardForkInitiation :: UnitInterval
  , BlockfrostConversion -> UnitInterval
dvtPPNetworkGroup :: UnitInterval
  , BlockfrostConversion -> UnitInterval
dvtPPEconomicGroup :: UnitInterval
  , BlockfrostConversion -> UnitInterval
dvtPPTechnicalGroup :: UnitInterval
  , BlockfrostConversion -> UnitInterval
dvtPPGovGroup :: UnitInterval
  , BlockfrostConversion -> UnitInterval
dvtTreasuryWithdrawal :: UnitInterval
  , BlockfrostConversion -> Quantity
committeeMinSize :: Blockfrost.Quantity
  , BlockfrostConversion -> Quantity
committeeMaxTermLength :: Blockfrost.Quantity
  , BlockfrostConversion -> Quantity
govActionLifetime :: Blockfrost.Quantity
  , BlockfrostConversion -> Coin
govActionDeposit :: Coin
  , BlockfrostConversion -> Integer
drepDeposit :: Integer
  , BlockfrostConversion -> Quantity
drepActivity :: Blockfrost.Quantity
  , BlockfrostConversion -> NonNegativeInterval
minFeeRefScriptCostPerByte :: NonNegativeInterval
  }

toCardanoGenesisParameters :: Blockfrost.Genesis -> GenesisParameters ShelleyEra
toCardanoGenesisParameters :: Genesis -> GenesisParameters ShelleyEra
toCardanoGenesisParameters Genesis
bfGenesis =
  GenesisParameters
    { protocolParamSlotsPerKESPeriod :: Int
protocolParamSlotsPerKESPeriod = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
_genesisSlotsPerKesPeriod
    , protocolParamUpdateQuorum :: Int
protocolParamUpdateQuorum = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
_genesisUpdateQuorum
    , protocolParamMaxLovelaceSupply :: Coin
protocolParamMaxLovelaceSupply = Discrete' "ADA" '(1000000, 1) -> Coin
forall a b. (Integral a, Num b) => a -> b
fromIntegral Discrete' "ADA" '(1000000, 1)
Lovelaces
_genesisMaxLovelaceSupply
    , protocolParamSecurity :: NonZero Word64
protocolParamSecurity = Word64 -> NonZero Word64
forall a. a -> NonZero a
unsafeNonZero (Word64 -> NonZero Word64) -> Word64 -> NonZero Word64
forall a b. (a -> b) -> a -> b
$ Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
_genesisSecurityParam
    , protocolParamActiveSlotsCoefficient :: Rational
protocolParamActiveSlotsCoefficient = Rational
_genesisActiveSlotsCoefficient
    , protocolParamSystemStart :: UTCTime
protocolParamSystemStart = NominalDiffTime -> UTCTime
posixSecondsToUTCTime NominalDiffTime
_genesisSystemStart
    , protocolParamNetworkId :: NetworkId
protocolParamNetworkId = NetworkMagic -> NetworkId
fromNetworkMagic (NetworkMagic -> NetworkId) -> NetworkMagic -> NetworkId
forall a b. (a -> b) -> a -> b
$ Word32 -> NetworkMagic
NetworkMagic (Word32 -> NetworkMagic) -> Word32 -> NetworkMagic
forall a b. (a -> b) -> a -> b
$ Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
_genesisNetworkMagic
    , protocolParamMaxKESEvolutions :: Int
protocolParamMaxKESEvolutions = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
_genesisMaxKesEvolutions
    , protocolParamEpochLength :: EpochSize
protocolParamEpochLength = Word64 -> EpochSize
EpochSize (Word64 -> EpochSize) -> Word64 -> EpochSize
forall a b. (a -> b) -> a -> b
$ Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
_genesisEpochLength
    , protocolParamSlotLength :: NominalDiffTime
protocolParamSlotLength = Integer -> NominalDiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
_genesisSlotLength
    , protocolInitialUpdateableProtocolParameters :: PParams (ShelleyLedgerEra ShelleyEra)
protocolInitialUpdateableProtocolParameters = PParams ShelleyEra
PParams (ShelleyLedgerEra ShelleyEra)
forall a. Default a => a
def
    }
 where
  Blockfrost.Genesis
    { Rational
_genesisActiveSlotsCoefficient :: Rational
$sel:_genesisActiveSlotsCoefficient:Genesis :: Genesis -> Rational
_genesisActiveSlotsCoefficient
    , Integer
_genesisUpdateQuorum :: Integer
$sel:_genesisUpdateQuorum:Genesis :: Genesis -> Integer
_genesisUpdateQuorum
    , Lovelaces
_genesisMaxLovelaceSupply :: Lovelaces
$sel:_genesisMaxLovelaceSupply:Genesis :: Genesis -> Lovelaces
_genesisMaxLovelaceSupply
    , Integer
_genesisNetworkMagic :: Integer
$sel:_genesisNetworkMagic:Genesis :: Genesis -> Integer
_genesisNetworkMagic
    , Integer
_genesisEpochLength :: Integer
$sel:_genesisEpochLength:Genesis :: Genesis -> Integer
_genesisEpochLength
    , NominalDiffTime
$sel:_genesisSystemStart:Genesis :: Genesis -> NominalDiffTime
_genesisSystemStart :: NominalDiffTime
_genesisSystemStart
    , Integer
_genesisSlotsPerKesPeriod :: Integer
$sel:_genesisSlotsPerKesPeriod:Genesis :: Genesis -> Integer
_genesisSlotsPerKesPeriod
    , Integer
_genesisSlotLength :: Integer
$sel:_genesisSlotLength:Genesis :: Genesis -> Integer
_genesisSlotLength
    , Integer
_genesisMaxKesEvolutions :: Integer
$sel:_genesisMaxKesEvolutions:Genesis :: Genesis -> Integer
_genesisMaxKesEvolutions
    , Integer
_genesisSecurityParam :: Integer
$sel:_genesisSecurityParam:Genesis :: Genesis -> Integer
_genesisSecurityParam
    } = Genesis
bfGenesis

submitTransaction :: MonadIO m => Tx -> BlockfrostClientT m Blockfrost.TxHash
submitTransaction :: forall (m :: * -> *). MonadIO m => Tx -> BlockfrostClientT m TxHash
submitTransaction Tx
tx = CBORString -> BlockfrostClientT m TxHash
forall (m :: * -> *). MonadBlockfrost m => CBORString -> m TxHash
Blockfrost.submitTx (CBORString -> BlockfrostClientT m TxHash)
-> CBORString -> BlockfrostClientT m TxHash
forall a b. (a -> b) -> a -> b
$ ByteString -> CBORString
Blockfrost.CBORString (ByteString -> CBORString) -> ByteString -> CBORString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
forall l s. LazyStrict l s => s -> l
fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Tx -> ByteString
forall a. SerialiseAsCBOR a => a -> ByteString
serialiseToCBOR Tx
tx

----------------
-- Queries --
----------------

queryEraHistory :: BlockfrostClientT IO EraHistory
queryEraHistory :: BlockfrostClientT IO EraHistory
queryEraHistory = do
  [NetworkEraSummary]
eras' <- BlockfrostClientT IO [NetworkEraSummary]
forall (m :: * -> *). MonadBlockfrost m => m [NetworkEraSummary]
Blockfrost.getNetworkEras
  let eras :: [NetworkEraSummary]
eras = (NetworkEraSummary -> Bool)
-> [NetworkEraSummary] -> [NetworkEraSummary]
forall a. (a -> Bool) -> [a] -> [a]
filter NetworkEraSummary -> Bool
isEmptyEra [NetworkEraSummary]
eras'
  let summary :: [EraSummary]
summary = NetworkEraSummary -> EraSummary
mkEra (NetworkEraSummary -> EraSummary)
-> [NetworkEraSummary] -> [EraSummary]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [NetworkEraSummary]
eras
  case [EraSummary]
-> Maybe (NonEmpty (CardanoEras StandardCrypto) EraSummary)
forall (xs :: [*]) a. SListI xs => [a] -> Maybe (NonEmpty xs a)
nonEmptyFromList [EraSummary]
summary of
    Maybe (NonEmpty (CardanoEras StandardCrypto) EraSummary)
Nothing ->
      IO EraHistory -> BlockfrostClientT IO EraHistory
forall a. IO a -> BlockfrostClientT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO EraHistory -> BlockfrostClientT IO EraHistory)
-> IO EraHistory -> BlockfrostClientT IO EraHistory
forall a b. (a -> b) -> a -> b
$ APIBlockfrostError -> IO EraHistory
forall e a. Exception e => e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (APIBlockfrostError -> IO EraHistory)
-> APIBlockfrostError -> IO EraHistory
forall a b. (a -> b) -> a -> b
$ BlockfrostException -> APIBlockfrostError
BlockfrostClientError BlockfrostException
FailedEraHistory
    Just NonEmpty (CardanoEras StandardCrypto) EraSummary
s -> EraHistory -> BlockfrostClientT IO EraHistory
forall a. a -> BlockfrostClientT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EraHistory -> BlockfrostClientT IO EraHistory)
-> EraHistory -> BlockfrostClientT IO EraHistory
forall a b. (a -> b) -> a -> b
$ Interpreter (CardanoEras StandardCrypto) -> EraHistory
forall (xs :: [*]).
(CardanoBlock StandardCrypto ~ HardForkBlock xs) =>
Interpreter xs -> EraHistory
EraHistory (Summary (CardanoEras StandardCrypto)
-> Interpreter (CardanoEras StandardCrypto)
forall (xs :: [*]). Summary xs -> Interpreter xs
mkInterpreter (Summary (CardanoEras StandardCrypto)
 -> Interpreter (CardanoEras StandardCrypto))
-> Summary (CardanoEras StandardCrypto)
-> Interpreter (CardanoEras StandardCrypto)
forall a b. (a -> b) -> a -> b
$ NonEmpty (CardanoEras StandardCrypto) EraSummary
-> Summary (CardanoEras StandardCrypto)
forall (xs :: [*]). NonEmpty xs EraSummary -> Summary xs
Summary NonEmpty (CardanoEras StandardCrypto) EraSummary
s)
 where
  mkBound :: NetworkEraBound -> Bound
mkBound Blockfrost.NetworkEraBound{Epoch
_boundEpoch :: Epoch
$sel:_boundEpoch:NetworkEraBound :: NetworkEraBound -> Epoch
_boundEpoch, Slot
_boundSlot :: Slot
$sel:_boundSlot:NetworkEraBound :: NetworkEraBound -> Slot
_boundSlot, NominalDiffTime
_boundTime :: NominalDiffTime
$sel:_boundTime:NetworkEraBound :: NetworkEraBound -> NominalDiffTime
_boundTime} =
    Bound
      { boundTime :: RelativeTime
boundTime = NominalDiffTime -> RelativeTime
RelativeTime NominalDiffTime
_boundTime
      , boundSlot :: SlotNo
boundSlot = Word64 -> SlotNo
SlotNo (Word64 -> SlotNo) -> Word64 -> SlotNo
forall a b. (a -> b) -> a -> b
$ Slot -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Slot
_boundSlot
      , boundEpoch :: EpochNo
boundEpoch = Word64 -> EpochNo
EpochNo (Word64 -> EpochNo) -> Word64 -> EpochNo
forall a b. (a -> b) -> a -> b
$ Epoch -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Epoch
_boundEpoch
      , boundPerasRound :: PerasEnabled PerasRoundNo
boundPerasRound = PerasEnabled PerasRoundNo
forall a. PerasEnabled a
NoPerasEnabled
      }
  mkEraParams :: NetworkEraParameters -> EraParams
mkEraParams Blockfrost.NetworkEraParameters{EpochLength
_parametersEpochLength :: EpochLength
$sel:_parametersEpochLength:NetworkEraParameters :: NetworkEraParameters -> EpochLength
_parametersEpochLength, NominalDiffTime
_parametersSlotLength :: NominalDiffTime
$sel:_parametersSlotLength:NetworkEraParameters :: NetworkEraParameters -> NominalDiffTime
_parametersSlotLength, Word64
_parametersSafeZone :: Word64
$sel:_parametersSafeZone:NetworkEraParameters :: NetworkEraParameters -> Word64
_parametersSafeZone} =
    EraParams
      { eraEpochSize :: EpochSize
eraEpochSize = Word64 -> EpochSize
EpochSize (Word64 -> EpochSize) -> Word64 -> EpochSize
forall a b. (a -> b) -> a -> b
$ EpochLength -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral EpochLength
_parametersEpochLength
      , eraSlotLength :: SlotLength
eraSlotLength = NominalDiffTime -> SlotLength
mkSlotLength NominalDiffTime
_parametersSlotLength
      , eraSafeZone :: SafeZone
eraSafeZone = Word64 -> SafeZone
StandardSafeZone Word64
_parametersSafeZone
      , eraGenesisWin :: GenesisWindow
eraGenesisWin = Word64 -> GenesisWindow
GenesisWindow Word64
_parametersSafeZone
      , eraPerasRoundLength :: PerasEnabled PerasRoundLength
eraPerasRoundLength = PerasEnabled PerasRoundLength
forall a. PerasEnabled a
NoPerasEnabled
      }
  mkEra :: NetworkEraSummary -> EraSummary
mkEra Blockfrost.NetworkEraSummary{NetworkEraBound
_networkEraStart :: NetworkEraBound
$sel:_networkEraStart:NetworkEraSummary :: NetworkEraSummary -> NetworkEraBound
_networkEraStart, NetworkEraBound
_networkEraEnd :: NetworkEraBound
$sel:_networkEraEnd:NetworkEraSummary :: NetworkEraSummary -> NetworkEraBound
_networkEraEnd, NetworkEraParameters
_networkEraParameters :: NetworkEraParameters
$sel:_networkEraParameters:NetworkEraSummary :: NetworkEraSummary -> NetworkEraParameters
_networkEraParameters} =
    EraSummary
      { eraStart :: Bound
eraStart = NetworkEraBound -> Bound
mkBound NetworkEraBound
_networkEraStart
      , eraEnd :: EraEnd
eraEnd = Bound -> EraEnd
EraEnd (Bound -> EraEnd) -> Bound -> EraEnd
forall a b. (a -> b) -> a -> b
$ NetworkEraBound -> Bound
mkBound NetworkEraBound
_networkEraEnd
      , eraParams :: EraParams
eraParams = NetworkEraParameters -> EraParams
mkEraParams NetworkEraParameters
_networkEraParameters
      }
  isEmptyEra :: NetworkEraSummary -> Bool
isEmptyEra
    Blockfrost.NetworkEraSummary
      { $sel:_networkEraStart:NetworkEraSummary :: NetworkEraSummary -> NetworkEraBound
_networkEraStart = Blockfrost.NetworkEraBound{$sel:_boundTime:NetworkEraBound :: NetworkEraBound -> NominalDiffTime
_boundTime = NominalDiffTime
boundStart}
      , $sel:_networkEraEnd:NetworkEraSummary :: NetworkEraSummary -> NetworkEraBound
_networkEraEnd = Blockfrost.NetworkEraBound{$sel:_boundTime:NetworkEraBound :: NetworkEraBound -> NominalDiffTime
_boundTime = NominalDiffTime
boundEnd}
      , NetworkEraParameters
$sel:_networkEraParameters:NetworkEraSummary :: NetworkEraSummary -> NetworkEraParameters
_networkEraParameters :: NetworkEraParameters
_networkEraParameters
      } = NominalDiffTime
boundStart NominalDiffTime -> NominalDiffTime -> Bool
forall a. Eq a => a -> a -> Bool
/= NominalDiffTime
0 Bool -> Bool -> Bool
&& NominalDiffTime
boundEnd NominalDiffTime -> NominalDiffTime -> Bool
forall a. Eq a => a -> a -> Bool
/= NominalDiffTime
0

-- | Query the Blockfrost API to get the 'UTxO' for 'TxIn' and convert to cardano 'UTxO'.
-- Awaits the tx being indexed by Blockfrost (eventual consistency), retrying
-- with 'awaitPolicy' before giving up with 'FailedUTxOForHash'.
queryUTxOByTxIn :: NetworkId -> [TxIn] -> BlockfrostClientT IO UTxO
queryUTxOByTxIn :: NetworkId -> [TxIn] -> BlockfrostClientT IO UTxO
queryUTxOByTxIn NetworkId
networkId =
  (TxIn -> BlockfrostClientT IO UTxO)
-> [TxIn] -> BlockfrostClientT IO UTxO
forall b (m :: * -> *) (f :: * -> *) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM (\(TxIn TxId
txid TxIx
_) -> Text -> BlockfrostClientT IO UTxO
awaitTxUtxos (TxId -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText TxId
txid))
 where
  awaitTxUtxos :: Text -> BlockfrostClientT IO UTxO
awaitTxUtxos Text
txHash = do
    Blockfrost.TransactionUtxos{[UtxoOutput]
_transactionUtxosOutputs :: [UtxoOutput]
$sel:_transactionUtxosOutputs:TransactionUtxos :: TransactionUtxos -> [UtxoOutput]
_transactionUtxosOutputs} <-
      (Either BlockfrostError TransactionUtxos -> Maybe TransactionUtxos)
-> BlockfrostException
-> BlockfrostClientT IO (Either BlockfrostError TransactionUtxos)
-> BlockfrostClientT IO TransactionUtxos
forall a b.
(a -> Maybe b)
-> BlockfrostException
-> BlockfrostClientT IO a
-> BlockfrostClientT IO b
awaitOrThrow Either BlockfrostError TransactionUtxos -> Maybe TransactionUtxos
forall l r. Either l r -> Maybe r
rightToMaybe (Text -> BlockfrostException
FailedUTxOForHash Text
txHash) (BlockfrostClientT IO TransactionUtxos
-> BlockfrostClientT IO (Either BlockfrostError TransactionUtxos)
forall e (m :: * -> *) a. MonadError e m => m a -> m (Either e a)
Blockfrost.tryError (BlockfrostClientT IO TransactionUtxos
 -> BlockfrostClientT IO (Either BlockfrostError TransactionUtxos))
-> BlockfrostClientT IO TransactionUtxos
-> BlockfrostClientT IO (Either BlockfrostError TransactionUtxos)
forall a b. (a -> b) -> a -> b
$ TxHash -> BlockfrostClientT IO TransactionUtxos
forall (m :: * -> *).
MonadBlockfrost m =>
TxHash -> m TransactionUtxos
Blockfrost.getTxUtxos (Text -> TxHash
Blockfrost.TxHash Text
txHash))
    (UtxoOutput -> BlockfrostClientT IO UTxO)
-> [UtxoOutput] -> BlockfrostClientT IO UTxO
forall b (m :: * -> *) (f :: * -> *) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM
      ( \Blockfrost.UtxoOutput{Integer
_utxoOutputOutputIndex :: Integer
$sel:_utxoOutputOutputIndex:UtxoOutput :: UtxoOutput -> Integer
_utxoOutputOutputIndex, Address
_utxoOutputAddress :: Address
$sel:_utxoOutputAddress:UtxoOutput :: UtxoOutput -> Address
_utxoOutputAddress, [Amount]
_utxoOutputAmount :: [Amount]
$sel:_utxoOutputAmount:UtxoOutput :: UtxoOutput -> [Amount]
_utxoOutputAmount, Maybe DatumHash
_utxoOutputDataHash :: Maybe DatumHash
$sel:_utxoOutputDataHash:UtxoOutput :: UtxoOutput -> Maybe DatumHash
_utxoOutputDataHash, Maybe InlineDatum
_utxoOutputInlineDatum :: Maybe InlineDatum
$sel:_utxoOutputInlineDatum:UtxoOutput :: UtxoOutput -> Maybe InlineDatum
_utxoOutputInlineDatum, Maybe ScriptHash
_utxoOutputReferenceScriptHash :: Maybe ScriptHash
$sel:_utxoOutputReferenceScriptHash:UtxoOutput :: UtxoOutput -> Maybe ScriptHash
_utxoOutputReferenceScriptHash} ->
          let txIn :: TxIn
txIn = Text -> Integer -> TxIn
toCardanoTxIn Text
txHash Integer
_utxoOutputOutputIndex
           in NetworkId
-> TxIn
-> Address
-> Maybe ScriptHash
-> Maybe DatumHash
-> [Amount]
-> Maybe InlineDatum
-> BlockfrostClientT IO UTxO
toCardanoUTxO NetworkId
networkId TxIn
txIn Address
_utxoOutputAddress Maybe ScriptHash
_utxoOutputReferenceScriptHash Maybe DatumHash
_utxoOutputDataHash [Amount]
_utxoOutputAmount Maybe InlineDatum
_utxoOutputInlineDatum
      )
      [UtxoOutput]
_transactionUtxosOutputs

queryScript :: Text -> BlockfrostClientT IO (Maybe PlutusScript)
queryScript :: Text -> BlockfrostClientT IO (Maybe PlutusScript)
queryScript Text
scriptHashTxt = do
  Blockfrost.ScriptCBOR{Maybe Text
_scriptCborCbor :: Maybe Text
$sel:_scriptCborCbor:ScriptCBOR :: ScriptCBOR -> Maybe Text
_scriptCborCbor} <- ScriptHash -> BlockfrostClientT IO ScriptCBOR
forall (m :: * -> *).
MonadBlockfrost m =>
ScriptHash -> m ScriptCBOR
Blockfrost.getScriptCBOR (ScriptHash -> BlockfrostClientT IO ScriptCBOR)
-> ScriptHash -> BlockfrostClientT IO ScriptCBOR
forall a b. (a -> b) -> a -> b
$ Text -> ScriptHash
Blockfrost.ScriptHash Text
scriptHashTxt
  case Maybe Text
_scriptCborCbor of
    Maybe Text
Nothing -> Maybe PlutusScript -> BlockfrostClientT IO (Maybe PlutusScript)
forall a. a -> BlockfrostClientT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe PlutusScript
forall a. Maybe a
Nothing
    Just Text
fullScriptCBOR ->
      case Text -> Either String ByteString
forall (f :: * -> *). MonadFail f => Text -> f ByteString
decodeBase16 Text
fullScriptCBOR :: Either String ByteString of
        Left String
_ -> Maybe PlutusScript -> BlockfrostClientT IO (Maybe PlutusScript)
forall a. a -> BlockfrostClientT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe PlutusScript
forall a. Maybe a
Nothing
        Right ByteString
bytes ->
          case AsType PlutusScript
-> ByteString -> Either DecoderError PlutusScript
forall a.
SerialiseAsCBOR a =>
AsType a -> ByteString -> Either DecoderError a
deserialiseFromCBOR (Proxy PlutusScript -> AsType PlutusScript
forall t. HasTypeProxy t => Proxy t -> AsType t
proxyToAsType (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @PlutusScript)) ByteString
bytes of
            Left DecoderError
_ -> Maybe PlutusScript -> BlockfrostClientT IO (Maybe PlutusScript)
forall a. a -> BlockfrostClientT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe PlutusScript
forall a. Maybe a
Nothing
            Right PlutusScript
plutusScript -> Maybe PlutusScript -> BlockfrostClientT IO (Maybe PlutusScript)
forall a. a -> BlockfrostClientT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe PlutusScript -> BlockfrostClientT IO (Maybe PlutusScript))
-> Maybe PlutusScript -> BlockfrostClientT IO (Maybe PlutusScript)
forall a b. (a -> b) -> a -> b
$ PlutusScript -> Maybe PlutusScript
forall a. a -> Maybe a
Just PlutusScript
plutusScript

-- | 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.
queryUTxO :: NetworkId -> [Address ShelleyAddr] -> BlockfrostClientT IO UTxO
queryUTxO :: NetworkId -> [Address ShelleyAddr] -> BlockfrostClientT IO UTxO
queryUTxO NetworkId
networkId [Address ShelleyAddr]
addresses = do
  let address :: Address
address = Text -> Address
Blockfrost.Address (Text -> Address)
-> (Address ShelleyAddr -> Text) -> Address ShelleyAddr -> Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address ShelleyAddr -> Text
forall addr. SerialiseAddress addr => addr -> Text
serialiseAddress (Address ShelleyAddr -> Address) -> Address ShelleyAddr -> Address
forall a b. (a -> b) -> a -> b
$ [Address ShelleyAddr] -> Address ShelleyAddr
forall a. HasCallStack => [a] -> a
List.head [Address ShelleyAddr]
addresses
  [AddressUtxo]
utxoWithAddresses <-
    (Paged -> BlockfrostClientT IO [AddressUtxo])
-> BlockfrostClientT IO [AddressUtxo]
forall (m :: * -> *) a. Monad m => (Paged -> m [a]) -> m [a]
Blockfrost.allPages (\Paged
p -> Address -> Paged -> SortOrder -> BlockfrostClientT IO [AddressUtxo]
forall (m :: * -> *).
MonadBlockfrost m =>
Address -> Paged -> SortOrder -> m [AddressUtxo]
Blockfrost.getAddressUtxos' Address
address Paged
p SortOrder
forall a. Default a => a
Blockfrost.def)
      BlockfrostClientT IO [AddressUtxo]
-> (BlockfrostError -> BlockfrostClientT IO [AddressUtxo])
-> BlockfrostClientT IO [AddressUtxo]
forall a.
BlockfrostClientT IO a
-> (BlockfrostError -> BlockfrostClientT IO a)
-> BlockfrostClientT IO a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` \case
        Blockfrost.BlockfrostNotFound Text
_ ->
          [AddressUtxo] -> BlockfrostClientT IO [AddressUtxo]
forall a. a -> BlockfrostClientT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        BlockfrostError
err ->
          BlockfrostError -> BlockfrostClientT IO [AddressUtxo]
forall a. BlockfrostError -> BlockfrostClientT IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError BlockfrostError
err

  (AddressUtxo -> BlockfrostClientT IO UTxO)
-> [AddressUtxo] -> BlockfrostClientT IO UTxO
forall b (m :: * -> *) (f :: * -> *) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM
    ( \Blockfrost.AddressUtxo
        { Address
_addressUtxoAddress :: Address
$sel:_addressUtxoAddress:AddressUtxo :: AddressUtxo -> Address
Blockfrost._addressUtxoAddress
        , $sel:_addressUtxoTxHash:AddressUtxo :: AddressUtxo -> TxHash
Blockfrost._addressUtxoTxHash = Blockfrost.TxHash{Text
unTxHash :: Text
$sel:unTxHash:TxHash :: TxHash -> Text
unTxHash}
        , Integer
_addressUtxoOutputIndex :: Integer
$sel:_addressUtxoOutputIndex:AddressUtxo :: AddressUtxo -> Integer
Blockfrost._addressUtxoOutputIndex
        , [Amount]
_addressUtxoAmount :: [Amount]
$sel:_addressUtxoAmount:AddressUtxo :: AddressUtxo -> [Amount]
Blockfrost._addressUtxoAmount
        , BlockHash
_addressUtxoBlock :: BlockHash
$sel:_addressUtxoBlock:AddressUtxo :: AddressUtxo -> BlockHash
Blockfrost._addressUtxoBlock
        , Maybe DatumHash
_addressUtxoDataHash :: Maybe DatumHash
$sel:_addressUtxoDataHash:AddressUtxo :: AddressUtxo -> Maybe DatumHash
Blockfrost._addressUtxoDataHash
        , Maybe InlineDatum
_addressUtxoInlineDatum :: Maybe InlineDatum
$sel:_addressUtxoInlineDatum:AddressUtxo :: AddressUtxo -> Maybe InlineDatum
Blockfrost._addressUtxoInlineDatum
        , Maybe ScriptHash
_addressUtxoReferenceScriptHash :: Maybe ScriptHash
$sel:_addressUtxoReferenceScriptHash:AddressUtxo :: AddressUtxo -> Maybe ScriptHash
Blockfrost._addressUtxoReferenceScriptHash
        } ->
          let txin :: TxIn
txin = Text -> Integer -> TxIn
toCardanoTxIn Text
unTxHash Integer
_addressUtxoOutputIndex
           in NetworkId
-> TxIn
-> Address
-> Maybe ScriptHash
-> Maybe DatumHash
-> [Amount]
-> Maybe InlineDatum
-> BlockfrostClientT IO UTxO
toCardanoUTxO NetworkId
networkId TxIn
txin Address
_addressUtxoAddress Maybe ScriptHash
_addressUtxoReferenceScriptHash Maybe DatumHash
_addressUtxoDataHash [Amount]
_addressUtxoAmount Maybe InlineDatum
_addressUtxoInlineDatum
    )
    [AddressUtxo]
utxoWithAddresses

queryUTxOFor :: NetworkId -> VerificationKey PaymentKey -> BlockfrostClientT IO UTxO
queryUTxOFor :: NetworkId
-> VerificationKey PaymentKey -> BlockfrostClientT IO UTxO
queryUTxOFor NetworkId
networkId VerificationKey PaymentKey
vk =
  case NetworkId -> VerificationKey PaymentKey -> AddressInEra
forall era.
IsShelleyBasedEra era =>
NetworkId -> VerificationKey PaymentKey -> AddressInEra era
mkVkAddress NetworkId
networkId VerificationKey PaymentKey
vk of
    ShelleyAddressInEra Address ShelleyAddr
addr ->
      NetworkId -> [Address ShelleyAddr] -> BlockfrostClientT IO UTxO
queryUTxO NetworkId
networkId [Address ShelleyAddr
addr]
    ByronAddressInEra{} ->
      IO UTxO -> BlockfrostClientT IO UTxO
forall a. IO a -> BlockfrostClientT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UTxO -> BlockfrostClientT IO UTxO)
-> IO UTxO -> BlockfrostClientT IO UTxO
forall a b. (a -> b) -> a -> b
$ APIBlockfrostError -> IO UTxO
forall e a. Exception e => e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (APIBlockfrostError -> IO UTxO) -> APIBlockfrostError -> IO UTxO
forall a b. (a -> b) -> a -> b
$ BlockfrostException -> APIBlockfrostError
BlockfrostClientError BlockfrostException
ByronAddressNotSupported

-- | Query the Blockfrost API for 'Genesis'
queryGenesisParameters :: BlockfrostClientT IO Blockfrost.Genesis
queryGenesisParameters :: BlockfrostClientT IO Genesis
queryGenesisParameters = BlockfrostClientT IO Genesis
forall (m :: * -> *). MonadBlockfrost m => m Genesis
Blockfrost.getLedgerGenesis

-- | Query the Blockfrost API for 'Genesis' and convert to cardano 'ChainPoint'.
queryTip :: BlockfrostClientT IO ChainPoint
queryTip :: BlockfrostClientT IO ChainPoint
queryTip = do
  Blockfrost.Block
    { Maybe Integer
_blockHeight :: Maybe Integer
$sel:_blockHeight:Block :: Block -> Maybe Integer
_blockHeight
    , BlockHash
_blockHash :: BlockHash
$sel:_blockHash:Block :: Block -> BlockHash
_blockHash
    , Maybe Slot
_blockSlot :: Maybe Slot
$sel:_blockSlot:Block :: Block -> Maybe Slot
_blockSlot
    } <-
    BlockfrostClientT IO Block
forall (m :: * -> *). MonadBlockfrost m => m Block
Blockfrost.getLatestBlock
  let slotAndBlockNumber :: Maybe (Slot, Integer)
slotAndBlockNumber = do
        Slot
blockSlot <- Maybe Slot
_blockSlot
        Integer
blockNumber <- Maybe Integer
_blockHeight
        (Slot, Integer) -> Maybe (Slot, Integer)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Slot
blockSlot, Integer
blockNumber)
  case Maybe (Slot, Integer)
slotAndBlockNumber of
    Maybe (Slot, Integer)
Nothing -> ChainPoint -> BlockfrostClientT IO ChainPoint
forall a. a -> BlockfrostClientT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChainPoint -> BlockfrostClientT IO ChainPoint)
-> ChainPoint -> BlockfrostClientT IO ChainPoint
forall a b. (a -> b) -> a -> b
$ ChainTip -> ChainPoint
chainTipToChainPoint ChainTip
ChainTipAtGenesis
    Just (Slot
blockSlot, Integer
blockNo) -> do
      let Blockfrost.BlockHash Text
blockHash = BlockHash
_blockHash
      ChainPoint -> BlockfrostClientT IO ChainPoint
forall a. a -> BlockfrostClientT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChainPoint -> BlockfrostClientT IO ChainPoint)
-> ChainPoint -> BlockfrostClientT IO ChainPoint
forall a b. (a -> b) -> a -> b
$
        ChainTip -> ChainPoint
chainTipToChainPoint (ChainTip -> ChainPoint) -> ChainTip -> ChainPoint
forall a b. (a -> b) -> a -> b
$
          SlotNo -> Hash BlockHeader -> BlockNo -> ChainTip
ChainTip
            (Word64 -> SlotNo
SlotNo (Word64 -> SlotNo) -> Word64 -> SlotNo
forall a b. (a -> b) -> a -> b
$ Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word64) -> Integer -> Word64
forall a b. (a -> b) -> a -> b
$ Slot -> Integer
Blockfrost.unSlot Slot
blockSlot)
            (String -> Hash BlockHeader
forall a. IsString a => String -> a
fromString (String -> Hash BlockHeader) -> String -> Hash BlockHeader
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
blockHash)
            (Word64 -> BlockNo
BlockNo (Word64 -> BlockNo) -> Word64 -> BlockNo
forall a b. (a -> b) -> a -> b
$ Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
blockNo)

queryStakePools ::
  BlockfrostClientT IO (Set PoolId)
queryStakePools :: BlockfrostClientT IO (Set (Hash StakePoolKey))
queryStakePools = do
  [PoolId]
stakePools' <- BlockfrostClientT IO [PoolId]
forall (m :: * -> *). MonadBlockfrost m => m [PoolId]
Blockfrost.listPools
  Set (Hash StakePoolKey)
-> BlockfrostClientT IO (Set (Hash StakePoolKey))
forall a. a -> BlockfrostClientT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set (Hash StakePoolKey)
 -> BlockfrostClientT IO (Set (Hash StakePoolKey)))
-> Set (Hash StakePoolKey)
-> BlockfrostClientT IO (Set (Hash StakePoolKey))
forall a b. (a -> b) -> a -> b
$ [Hash StakePoolKey] -> Set (Hash StakePoolKey)
forall a. Ord a => [a] -> Set a
Set.fromList (PoolId -> Hash StakePoolKey
toCardanoPoolId (PoolId -> Hash StakePoolKey) -> [PoolId] -> [Hash StakePoolKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PoolId]
stakePools')

awaitTransaction :: NetworkId -> Tx -> VerificationKey PaymentKey -> BlockfrostClientT IO UTxO
awaitTransaction :: NetworkId
-> Tx -> VerificationKey PaymentKey -> BlockfrostClientT IO UTxO
awaitTransaction NetworkId
networkId Tx
tx VerificationKey PaymentKey
vk = do
  NetworkId
-> [Address ShelleyAddr] -> Tx -> BlockfrostClientT IO UTxO
awaitUTxO NetworkId
networkId [NetworkId
-> PaymentCredential
-> StakeAddressReference
-> Address ShelleyAddr
makeShelleyAddress NetworkId
networkId (Hash PaymentKey -> PaymentCredential
PaymentCredentialByKey (Hash PaymentKey -> PaymentCredential)
-> Hash PaymentKey -> PaymentCredential
forall a b. (a -> b) -> a -> b
$ VerificationKey PaymentKey -> Hash PaymentKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey PaymentKey
vk) StakeAddressReference
NoStakeAddress] Tx
tx

-- | Run an action with 'awaitPolicy' until the projection yields a result,
-- throwing the given 'BlockfrostException' once retries are exhausted.
-- Blockfrost is eventually consistent, so queries can lag recently submitted
-- transactions.
awaitOrThrow ::
  (a -> Maybe b) ->
  BlockfrostException ->
  BlockfrostClientT IO a ->
  BlockfrostClientT IO b
awaitOrThrow :: forall a b.
(a -> Maybe b)
-> BlockfrostException
-> BlockfrostClientT IO a
-> BlockfrostClientT IO b
awaitOrThrow a -> Maybe b
project BlockfrostException
err BlockfrostClientT IO a
action =
  RetryPolicyM (BlockfrostClientT IO)
-> (RetryStatus -> a -> BlockfrostClientT IO Bool)
-> (RetryStatus -> BlockfrostClientT IO a)
-> BlockfrostClientT IO a
forall (m :: * -> *) b.
MonadIO m =>
RetryPolicyM m
-> (RetryStatus -> b -> m Bool) -> (RetryStatus -> m b) -> m b
retrying RetryPolicyM (BlockfrostClientT IO)
forall (m :: * -> *). MonadIO m => RetryPolicyM m
awaitPolicy (\RetryStatus
_ -> Bool -> BlockfrostClientT IO Bool
forall a. a -> BlockfrostClientT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> BlockfrostClientT IO Bool)
-> (a -> Bool) -> a -> BlockfrostClientT IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe b -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe b -> Bool) -> (a -> Maybe b) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe b
project) (BlockfrostClientT IO a -> RetryStatus -> BlockfrostClientT IO a
forall a b. a -> b -> a
const BlockfrostClientT IO a
action)
    BlockfrostClientT IO a
-> (a -> BlockfrostClientT IO b) -> BlockfrostClientT IO b
forall a b.
BlockfrostClientT IO a
-> (a -> BlockfrostClientT IO b) -> BlockfrostClientT IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BlockfrostClientT IO b
-> (b -> BlockfrostClientT IO b)
-> Maybe b
-> BlockfrostClientT IO b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (IO b -> BlockfrostClientT IO b
forall a. IO a -> BlockfrostClientT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO b -> BlockfrostClientT IO b)
-> (APIBlockfrostError -> IO b)
-> APIBlockfrostError
-> BlockfrostClientT IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APIBlockfrostError -> IO b
forall e a. Exception e => e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (APIBlockfrostError -> BlockfrostClientT IO b)
-> APIBlockfrostError -> BlockfrostClientT IO b
forall a b. (a -> b) -> a -> b
$ BlockfrostException -> APIBlockfrostError
BlockfrostClientError BlockfrostException
err) b -> BlockfrostClientT IO b
forall a. a -> BlockfrostClientT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Maybe b -> BlockfrostClientT IO b)
-> (a -> Maybe b) -> a -> BlockfrostClientT IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe b
project

-- | Wait for the transaction to be included and return its outputs paying to
-- the given addresses, awaiting until an address query reflects them. An empty
-- result is not a failure: the tx pays nothing to those addresses, and only
-- inclusion is awaited.
awaitUTxO ::
  -- | Network id
  NetworkId ->
  -- | Addresses we are interested in
  [Address ShelleyAddr] ->
  -- | Transaction to await
  Tx ->
  BlockfrostClientT IO UTxO
awaitUTxO :: NetworkId
-> [Address ShelleyAddr] -> Tx -> BlockfrostClientT IO UTxO
awaitUTxO NetworkId
networkId [Address ShelleyAddr]
addresses Tx
tx = do
  BlockfrostClientT IO ()
awaitIncluded
  Bool -> BlockfrostClientT IO () -> BlockfrostClientT IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (UTxO -> Bool
forall era. UTxO era -> Bool
UTxO.null UTxO
wantedUTxO) BlockfrostClientT IO ()
awaitVisible
  UTxO -> BlockfrostClientT IO UTxO
forall a. a -> BlockfrostClientT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UTxO
wantedUTxO
 where
  txid :: TxIdType Tx
txid = Tx -> TxIdType Tx
forall tx. IsTx tx => tx -> TxIdType tx
txId Tx
tx

  wantedUTxO :: UTxO
wantedUTxO =
    (TxOut CtxUTxO -> Bool) -> UTxO -> UTxO
forall era. (TxOut CtxUTxO era -> Bool) -> UTxO era -> UTxO era
UTxO.filter
      ( \(TxOut AddressInEra
addr Value
_ TxOutDatum CtxUTxO
_ ReferenceScript
_) -> case AddressInEra
addr of
          ShelleyAddressInEra Address ShelleyAddr
sh -> Address ShelleyAddr
sh Address ShelleyAddr -> [Address ShelleyAddr] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` [Address ShelleyAddr]
addresses
          ByronAddressInEra{} -> Bool
False
      )
      (Tx -> UTxO
utxoFromTx Tx
tx)

  awaitIncluded :: BlockfrostClientT IO ()
awaitIncluded = do
    BlockfrostClientT IO Transaction -> BlockfrostClientT IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BlockfrostClientT IO Transaction -> BlockfrostClientT IO ())
-> BlockfrostClientT IO Transaction -> BlockfrostClientT IO ()
forall a b. (a -> b) -> a -> b
$ (Either BlockfrostError Transaction -> Maybe Transaction)
-> BlockfrostException
-> BlockfrostClientT IO (Either BlockfrostError Transaction)
-> BlockfrostClientT IO Transaction
forall a b.
(a -> Maybe b)
-> BlockfrostException
-> BlockfrostClientT IO a
-> BlockfrostClientT IO b
awaitOrThrow Either BlockfrostError Transaction -> Maybe Transaction
forall l r. Either l r -> Maybe r
rightToMaybe (TxId -> BlockfrostException
TimeoutOnUTxO TxIdType Tx
TxId
txid) (BlockfrostClientT IO Transaction
-> BlockfrostClientT IO (Either BlockfrostError Transaction)
forall e (m :: * -> *) a. MonadError e m => m a -> m (Either e a)
Blockfrost.tryError (BlockfrostClientT IO Transaction
 -> BlockfrostClientT IO (Either BlockfrostError Transaction))
-> BlockfrostClientT IO Transaction
-> BlockfrostClientT IO (Either BlockfrostError Transaction)
forall a b. (a -> b) -> a -> b
$ TxHash -> BlockfrostClientT IO Transaction
forall (m :: * -> *). MonadBlockfrost m => TxHash -> m Transaction
Blockfrost.getTx (Text -> TxHash
Blockfrost.TxHash (Text -> TxHash) -> Text -> TxHash
forall a b. (a -> b) -> a -> b
$ TxId -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText TxIdType Tx
TxId
txid))

  -- NOTE: The address endpoint lags the tx endpoint, so inclusion alone does
  -- not guarantee the next address query reflects this tx. Wait until it does,
  -- since callers build follow-up transactions from what they query next.
  awaitVisible :: BlockfrostClientT IO ()
awaitVisible =
    BlockfrostClientT IO () -> BlockfrostClientT IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BlockfrostClientT IO () -> BlockfrostClientT IO ())
-> BlockfrostClientT IO () -> BlockfrostClientT IO ()
forall a b. (a -> b) -> a -> b
$ (Either BlockfrostError UTxO -> Maybe ())
-> BlockfrostException
-> BlockfrostClientT IO (Either BlockfrostError UTxO)
-> BlockfrostClientT IO ()
forall a b.
(a -> Maybe b)
-> BlockfrostException
-> BlockfrostClientT IO a
-> BlockfrostClientT IO b
awaitOrThrow Either BlockfrostError UTxO -> Maybe ()
visible (TxId -> BlockfrostException
TimeoutOnUTxO TxIdType Tx
TxId
txid) (BlockfrostClientT IO UTxO
-> BlockfrostClientT IO (Either BlockfrostError UTxO)
forall e (m :: * -> *) a. MonadError e m => m a -> m (Either e a)
Blockfrost.tryError (BlockfrostClientT IO UTxO
 -> BlockfrostClientT IO (Either BlockfrostError UTxO))
-> BlockfrostClientT IO UTxO
-> BlockfrostClientT IO (Either BlockfrostError UTxO)
forall a b. (a -> b) -> a -> b
$ NetworkId -> [Address ShelleyAddr] -> BlockfrostClientT IO UTxO
queryUTxO NetworkId
networkId [Address ShelleyAddr]
addresses)
   where
    visible :: Either BlockfrostError UTxO -> Maybe ()
visible = \case
      Right UTxO
utxo' | UTxO -> Set TxIn
forall era. UTxO era -> Set TxIn
UTxO.inputSet UTxO
wantedUTxO Set TxIn -> Set TxIn -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` UTxO -> Set TxIn
forall era. UTxO era -> Set TxIn
UTxO.inputSet UTxO
utxo' -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
      Either BlockfrostError UTxO
_ -> Maybe ()
forall a. Maybe a
Nothing