{-# LANGUAGE RecordWildCards #-}

module Hydra.Chain.Blockfrost.Client where

import Hydra.Prelude

import Blockfrost.Client (
  BlockfrostClientT,
  runBlockfrost,
 )
import Blockfrost.Client qualified as Blockfrost
import Data.Map.Strict qualified as Map
import Data.Time.Clock.POSIX
import Hydra.Cardano.Api hiding (LedgerState, fromNetworkMagic)

import Cardano.Api.UTxO qualified as UTxO
import Cardano.Ledger.Api.PParams
import Cardano.Ledger.BaseTypes (EpochInterval (..), EpochSize (..), NonNegativeInterval, UnitInterval, boundRational)
import Cardano.Ledger.Binary.Version (mkVersion)
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 (mkSlotLength)
import Control.Lens ((.~), (^.))
import Data.Default (def)
import Data.SOP.NonEmpty (NonEmpty (..))
import Data.Set qualified as Set
import Hydra.Cardano.Api.Prelude (StakePoolKey, fromNetworkMagic)
import Hydra.Chain.ScriptRegistry (buildScriptPublishingTxs)
import Hydra.Tx (txId)
import Money qualified
import Ouroboros.Consensus.Block (GenesisWindow (..))
import Ouroboros.Consensus.Cardano.Block (CardanoEras)
import Ouroboros.Consensus.HardFork.History (EraEnd (..), EraParams (..), EraSummary (..), SafeZone (..), Summary (..), initBound, mkInterpreter)

data APIBlockfrostError
  = BlockfrostError Text
  | DecodeError Text
  deriving (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, 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)

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 Project
prj BlockfrostClientT IO a
action = do
  Either BlockfrostError a
result <- 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)
runBlockfrost Project
prj BlockfrostClientT IO a
action
  case Either BlockfrostError a
result of
    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 (Text -> APIBlockfrostError
BlockfrostError (Text -> APIBlockfrostError) -> Text -> APIBlockfrostError
forall a b. (a -> b) -> a -> b
$ BlockfrostError -> Text
forall b a. (Show a, IsString b) => a -> b
show BlockfrostError
err)
    Right a
val -> a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
val

publishHydraScripts ::
  -- | The path where the Blockfrost project token hash is stored.
  FilePath ->
  -- | Keys assumed to hold funds to pay for the publishing transaction.
  SigningKey PaymentKey ->
  IO [TxId]
publishHydraScripts :: String -> SigningKey PaymentKey -> IO [TxId]
publishHydraScripts String
projectPath SigningKey PaymentKey
sk = do
  Project
prj <- String -> IO Project
Blockfrost.projectFromFile String
projectPath
  Project -> BlockfrostClientT IO [TxId] -> IO [TxId]
forall (m :: * -> *) a.
(MonadIO m, MonadThrow m) =>
Project -> BlockfrostClientT IO a -> m a
runBlockfrostM Project
prj (BlockfrostClientT IO [TxId] -> IO [TxId])
-> BlockfrostClientT IO [TxId] -> IO [TxId]
forall a b. (a -> b) -> a -> b
$ do
    genesis :: Genesis
genesis@Blockfrost.Genesis
      { $sel:_genesisNetworkMagic:Genesis :: Genesis -> Integer
_genesisNetworkMagic = Integer
networkMagic
      , $sel:_genesisSystemStart:Genesis :: Genesis -> NominalDiffTime
_genesisSystemStart = NominalDiffTime
systemStart'
      } <-
      BlockfrostClientT IO Genesis
forall (m :: * -> *). MonadBlockfrost m => m Genesis
Blockfrost.getLedgerGenesis
    PParams StandardConway
pparams <- BlockfrostClientT IO (PParams StandardConway)
BlockfrostClientT IO (PParams LedgerEra)
forall (m :: * -> *).
MonadIO m =>
BlockfrostClientT m (PParams LedgerEra)
toCardanoPParams
    let address :: Address
address = Text -> Address
Blockfrost.Address (Integer -> Text
vkAddress Integer
networkMagic)
    let networkId :: NetworkId
networkId = Integer -> NetworkId
toCardanoNetworkMagic Integer
networkMagic
    let changeAddress :: AddressInEra Era
changeAddress = NetworkId -> VerificationKey PaymentKey -> AddressInEra Era
forall era.
IsShelleyBasedEra era =>
NetworkId -> VerificationKey PaymentKey -> AddressInEra era
mkVkAddress NetworkId
networkId VerificationKey PaymentKey
vk
    [PoolId]
stakePools' <- BlockfrostClientT IO [PoolId]
forall (m :: * -> *). MonadBlockfrost m => m [PoolId]
Blockfrost.listPools
    let stakePools :: Set (Hash StakePoolKey)
stakePools = [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')
    let systemStart :: SystemStart
systemStart = UTCTime -> SystemStart
SystemStart (UTCTime -> SystemStart) -> UTCTime -> SystemStart
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> UTCTime
posixSecondsToUTCTime NominalDiffTime
systemStart'
    let eraHistory :: EraHistory
eraHistory = Genesis -> EraHistory
mkEraHistory Genesis
genesis
    [AddressUtxo]
utxo <- Address -> BlockfrostClientT IO [AddressUtxo]
forall (m :: * -> *).
MonadBlockfrost m =>
Address -> m [AddressUtxo]
Blockfrost.getAddressUtxos Address
address
    let cardanoUTxO :: UTxO' (TxOut CtxUTxO)
cardanoUTxO = [AddressUtxo] -> AddressInEra Era -> UTxO' (TxOut CtxUTxO)
toCardanoUTxO [AddressUtxo]
utxo AddressInEra Era
changeAddress

    [Tx]
txs <- IO [Tx] -> BlockfrostClientT IO [Tx]
forall a. IO a -> BlockfrostClientT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Tx] -> BlockfrostClientT IO [Tx])
-> IO [Tx] -> BlockfrostClientT IO [Tx]
forall a b. (a -> b) -> a -> b
$ PParams LedgerEra
-> SystemStart
-> NetworkId
-> EraHistory
-> Set (Hash StakePoolKey)
-> UTxO' (TxOut CtxUTxO)
-> SigningKey PaymentKey
-> IO [Tx]
buildScriptPublishingTxs PParams StandardConway
PParams LedgerEra
pparams SystemStart
systemStart NetworkId
networkId EraHistory
eraHistory Set (Hash StakePoolKey)
stakePools UTxO' (TxOut CtxUTxO)
cardanoUTxO SigningKey PaymentKey
sk
    [Tx]
-> (Tx -> BlockfrostClientT IO TxId) -> BlockfrostClientT IO [TxId]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Tx]
txs ((Tx -> BlockfrostClientT IO TxId) -> BlockfrostClientT IO [TxId])
-> (Tx -> BlockfrostClientT IO TxId) -> BlockfrostClientT IO [TxId]
forall a b. (a -> b) -> a -> b
$ \(Tx
tx :: Tx) -> do
      BlockfrostClientT IO TxHash -> BlockfrostClientT IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BlockfrostClientT IO TxHash -> BlockfrostClientT IO ())
-> BlockfrostClientT IO TxHash -> BlockfrostClientT IO ()
forall a b. (a -> b) -> a -> b
$ CBORString -> BlockfrostClientT IO TxHash
forall (m :: * -> *). MonadBlockfrost m => CBORString -> m TxHash
Blockfrost.submitTx (CBORString -> BlockfrostClientT IO TxHash)
-> CBORString -> BlockfrostClientT IO 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
      TxId -> BlockfrostClientT IO TxId
forall a. a -> BlockfrostClientT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxId -> BlockfrostClientT IO TxId)
-> TxId -> BlockfrostClientT IO TxId
forall a b. (a -> b) -> a -> b
$ Tx -> TxIdType Tx
forall tx. IsTx tx => tx -> TxIdType tx
txId Tx
tx
 where
  vk :: VerificationKey PaymentKey
vk = SigningKey PaymentKey -> VerificationKey PaymentKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey PaymentKey
sk

  vkAddress :: Integer -> Text
vkAddress Integer
networkMagic = NetworkId -> VerificationKey PaymentKey -> Text
textAddrOf (Integer -> NetworkId
toCardanoNetworkMagic Integer
networkMagic) VerificationKey PaymentKey
vk

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 AsType (Hash StakePoolKey)
-> ByteString -> Either RawBytesHexError (Hash StakePoolKey)
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either RawBytesHexError a
deserialiseFromRawBytesHex (AsType StakePoolKey -> AsType (Hash StakePoolKey)
forall a. AsType a -> AsType (Hash a)
AsHash AsType StakePoolKey
AsStakePoolKey) (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

toCardanoUTxO :: [Blockfrost.AddressUtxo] -> AddressInEra -> UTxO' (TxOut CtxUTxO)
toCardanoUTxO :: [AddressUtxo] -> AddressInEra Era -> UTxO' (TxOut CtxUTxO)
toCardanoUTxO [AddressUtxo]
utxos AddressInEra Era
addr = [(TxIn, TxOut CtxUTxO)] -> UTxO' (TxOut CtxUTxO)
forall out. [(TxIn, out)] -> UTxO' out
UTxO.fromPairs (AddressUtxo -> (TxIn, TxOut CtxUTxO)
toEntry (AddressUtxo -> (TxIn, TxOut CtxUTxO))
-> [AddressUtxo] -> [(TxIn, TxOut CtxUTxO)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AddressUtxo]
utxos)
 where
  toEntry :: Blockfrost.AddressUtxo -> (TxIn, TxOut CtxUTxO)
  toEntry :: AddressUtxo -> (TxIn, TxOut CtxUTxO)
toEntry AddressUtxo
utxo = (AddressUtxo -> TxIn
toCardanoTxIn AddressUtxo
utxo, AddressUtxo -> AddressInEra Era -> TxOut CtxUTxO
toCardanoTxOut AddressUtxo
utxo AddressInEra Era
addr)

toCardanoTxIn :: Blockfrost.AddressUtxo -> TxIn
toCardanoTxIn :: AddressUtxo -> TxIn
toCardanoTxIn Blockfrost.AddressUtxo{$sel:_addressUtxoTxHash:AddressUtxo :: AddressUtxo -> TxHash
_addressUtxoTxHash = Blockfrost.TxHash{Text
unTxHash :: Text
$sel:unTxHash:TxHash :: TxHash -> Text
unTxHash}, Integer
_addressUtxoOutputIndex :: Integer
$sel:_addressUtxoOutputIndex:AddressUtxo :: AddressUtxo -> Integer
_addressUtxoOutputIndex} =
  case AsType TxId -> ByteString -> Either RawBytesHexError TxId
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either RawBytesHexError a
deserialiseFromRawBytesHex AsType TxId
AsTxId (Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
unTxHash) 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
_addressUtxoOutputIndex))

-- REVIEW! TxOutDatumNone and ReferenceScriptNone
toCardanoTxOut :: Blockfrost.AddressUtxo -> AddressInEra -> TxOut CtxUTxO
toCardanoTxOut :: AddressUtxo -> AddressInEra Era -> TxOut CtxUTxO
toCardanoTxOut AddressUtxo
addrUTxO AddressInEra Era
addr =
  AddressInEra Era
-> Value -> TxOutDatum CtxUTxO -> ReferenceScript -> TxOut CtxUTxO
forall ctx.
AddressInEra Era
-> Value -> TxOutDatum ctx -> ReferenceScript -> TxOut ctx
TxOut AddressInEra Era
addr ([Amount] -> Value
toCardanoValue [Amount]
_addressUtxoAmount) TxOutDatum CtxUTxO
forall ctx. TxOutDatum ctx
TxOutDatumNone ReferenceScript
ReferenceScriptNone
 where
  Blockfrost.AddressUtxo{[Amount]
_addressUtxoAmount :: [Amount]
$sel:_addressUtxoAmount:AddressUtxo :: AddressUtxo -> [Amount]
_addressUtxoAmount, Maybe DatumHash
_addressUtxoDataHash :: Maybe DatumHash
$sel:_addressUtxoDataHash:AddressUtxo :: AddressUtxo -> Maybe DatumHash
_addressUtxoDataHash, Maybe InlineDatum
_addressUtxoInlineDatum :: Maybe InlineDatum
$sel:_addressUtxoInlineDatum:AddressUtxo :: AddressUtxo -> Maybe InlineDatum
_addressUtxoInlineDatum, Maybe ScriptHash
_addressUtxoReferenceScriptHash :: Maybe ScriptHash
$sel:_addressUtxoReferenceScriptHash:AddressUtxo :: AddressUtxo -> Maybe ScriptHash
_addressUtxoReferenceScriptHash} = AddressUtxo
addrUTxO

toCardanoPolicyId :: Text -> PolicyId
toCardanoPolicyId :: Text -> PolicyId
toCardanoPolicyId Text
pid =
  case AsType PolicyId -> ByteString -> Either RawBytesHexError PolicyId
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either RawBytesHexError a
deserialiseFromRawBytesHex AsType PolicyId
AsPolicyId (Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
pid) of
    Left RawBytesHexError
err -> Text -> PolicyId
forall a t. (HasCallStack, IsText t) => t -> a
error (RawBytesHexError -> Text
forall b a. (Show a, IsString b) => a -> b
show RawBytesHexError
err)
    Right PolicyId
p -> PolicyId
p

toCardanoAssetName :: Text -> AssetName
toCardanoAssetName :: Text -> AssetName
toCardanoAssetName = ByteString -> AssetName
AssetName (ByteString -> AssetName)
-> (Text -> ByteString) -> Text -> AssetName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8

toCardanoValue :: [Blockfrost.Amount] -> Value
toCardanoValue :: [Amount] -> Value
toCardanoValue = (Amount -> Value) -> [Amount] -> Value
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Amount -> Value
forall {l}. (Item l ~ (AssetId, Quantity), IsList l) => Amount -> l
convertAmount
 where
  convertAmount :: Amount -> l
convertAmount (Blockfrost.AdaAmount Lovelaces
lovelaces) =
    [Item l] -> l
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) =
    let currency :: Text
currency = SomeDiscrete -> Text
Money.someDiscreteCurrency SomeDiscrete
money
     in [Item l] -> l
forall l. IsList l => [Item l] -> l
fromList
          [
            ( PolicyId -> AssetName -> AssetId
AssetId
                (Text -> PolicyId
toCardanoPolicyId Text
currency)
                (Text -> AssetName
toCardanoAssetName Text
currency)
            , Integer -> Quantity
Quantity (SomeDiscrete -> Integer
Money.someDiscreteAmount SomeDiscrete
money)
            )
          ]

-- ** Helpers

unwrapAddress :: AddressInEra -> Text
unwrapAddress :: AddressInEra Era -> Text
unwrapAddress = \case
  ShelleyAddressInEra Address ShelleyAddr
addr -> Address ShelleyAddr -> Text
forall a. SerialiseAsBech32 a => a -> Text
serialiseToBech32 Address ShelleyAddr
addr
  ByronAddressInEra{} -> Text -> Text
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"Byron."

textAddrOf :: NetworkId -> VerificationKey PaymentKey -> Text
textAddrOf :: NetworkId -> VerificationKey PaymentKey -> Text
textAddrOf NetworkId
networkId VerificationKey PaymentKey
vk = AddressInEra Era -> Text
unwrapAddress (forall era.
IsShelleyBasedEra era =>
NetworkId -> VerificationKey PaymentKey -> AddressInEra era
mkVkAddress @Era NetworkId
networkId VerificationKey PaymentKey
vk)

toCardanoNetworkMagic :: Integer -> NetworkId
toCardanoNetworkMagic :: Integer -> NetworkId
toCardanoNetworkMagic = \case
  Integer
0 -> NetworkId
Mainnet
  Integer
magicNbr -> NetworkMagic -> NetworkId
Testnet (Word32 -> NetworkMagic
NetworkMagic (Integer -> Word32
forall a. Num a => Integer -> a
fromInteger Integer
magicNbr))

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
  }

toCardanoPParams :: MonadIO m => BlockfrostClientT m (PParams LedgerEra)
toCardanoPParams :: forall (m :: * -> *).
MonadIO m =>
BlockfrostClientT m (PParams LedgerEra)
toCardanoPParams = do
  ProtocolParams
pparams <- BlockfrostClientT m ProtocolParams
forall (m :: * -> *). MonadBlockfrost m => m ProtocolParams
Blockfrost.getLatestEpochProtocolParams
  Version
minVersion <- 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. HasProtocolMinorVer s a => Lens' s a
Lens' ProtocolParams Integer
Blockfrost.protocolMinorVer
  let maxVersion :: Natural
maxVersion = 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. 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
$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
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
..}

  case Maybe BlockfrostConversion
results of
    Maybe BlockfrostConversion
Nothing -> IO (PParams StandardConway)
-> BlockfrostClientT m (PParams StandardConway)
forall a. IO a -> BlockfrostClientT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (PParams StandardConway)
 -> BlockfrostClientT m (PParams StandardConway))
-> IO (PParams StandardConway)
-> BlockfrostClientT m (PParams StandardConway)
forall a b. (a -> b) -> a -> b
$ APIBlockfrostError -> IO (PParams StandardConway)
forall e a. Exception e => e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (APIBlockfrostError -> IO (PParams StandardConway))
-> APIBlockfrostError -> IO (PParams StandardConway)
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 StandardConway
-> BlockfrostClientT m (PParams StandardConway)
forall a. a -> BlockfrostClientT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PParams StandardConway
 -> BlockfrostClientT m (PParams StandardConway))
-> PParams StandardConway
-> BlockfrostClientT m (PParams StandardConway)
forall a b. (a -> b) -> a -> b
$
        PParams StandardConway
forall era. EraPParams era => PParams era
emptyPParams
          PParams StandardConway
-> (PParams StandardConway -> PParams StandardConway)
-> PParams StandardConway
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> PParams StandardConway -> Identity (PParams StandardConway)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams StandardConway) Coin
ppMinFeeAL ((Coin -> Identity Coin)
 -> PParams StandardConway -> Identity (PParams StandardConway))
-> Coin -> PParams StandardConway -> PParams StandardConway
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 (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 StandardConway
-> (PParams StandardConway -> PParams StandardConway)
-> PParams StandardConway
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> PParams StandardConway -> Identity (PParams StandardConway)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams StandardConway) Coin
ppMinFeeBL ((Coin -> Identity Coin)
 -> PParams StandardConway -> Identity (PParams StandardConway))
-> Coin -> PParams StandardConway -> PParams StandardConway
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 (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 StandardConway
-> (PParams StandardConway -> PParams StandardConway)
-> PParams StandardConway
forall a b. a -> (a -> b) -> b
& (Word32 -> Identity Word32)
-> PParams StandardConway -> Identity (PParams StandardConway)
forall era. EraPParams era => Lens' (PParams era) Word32
Lens' (PParams StandardConway) Word32
ppMaxBBSizeL ((Word32 -> Identity Word32)
 -> PParams StandardConway -> Identity (PParams StandardConway))
-> Word32 -> PParams StandardConway -> PParams StandardConway
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 StandardConway
-> (PParams StandardConway -> PParams StandardConway)
-> PParams StandardConway
forall a b. a -> (a -> b) -> b
& (Word32 -> Identity Word32)
-> PParams StandardConway -> Identity (PParams StandardConway)
forall era. EraPParams era => Lens' (PParams era) Word32
Lens' (PParams StandardConway) Word32
ppMaxTxSizeL ((Word32 -> Identity Word32)
 -> PParams StandardConway -> Identity (PParams StandardConway))
-> Word32 -> PParams StandardConway -> PParams StandardConway
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 StandardConway
-> (PParams StandardConway -> PParams StandardConway)
-> PParams StandardConway
forall a b. a -> (a -> b) -> b
& (Word16 -> Identity Word16)
-> PParams StandardConway -> Identity (PParams StandardConway)
forall era. EraPParams era => Lens' (PParams era) Word16
Lens' (PParams StandardConway) Word16
ppMaxBHSizeL ((Word16 -> Identity Word16)
 -> PParams StandardConway -> Identity (PParams StandardConway))
-> Word16 -> PParams StandardConway -> PParams StandardConway
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 StandardConway
-> (PParams StandardConway -> PParams StandardConway)
-> PParams StandardConway
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> PParams StandardConway -> Identity (PParams StandardConway)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams StandardConway) Coin
ppKeyDepositL ((Coin -> Identity Coin)
 -> PParams StandardConway -> Identity (PParams StandardConway))
-> Coin -> PParams StandardConway -> PParams StandardConway
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 StandardConway
-> (PParams StandardConway -> PParams StandardConway)
-> PParams StandardConway
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> PParams StandardConway -> Identity (PParams StandardConway)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams StandardConway) Coin
ppPoolDepositL ((Coin -> Identity Coin)
 -> PParams StandardConway -> Identity (PParams StandardConway))
-> Coin -> PParams StandardConway -> PParams StandardConway
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 StandardConway
-> (PParams StandardConway -> PParams StandardConway)
-> PParams StandardConway
forall a b. a -> (a -> b) -> b
& (EpochInterval -> Identity EpochInterval)
-> PParams StandardConway -> Identity (PParams StandardConway)
forall era. EraPParams era => Lens' (PParams era) EpochInterval
Lens' (PParams StandardConway) EpochInterval
ppEMaxL ((EpochInterval -> Identity EpochInterval)
 -> PParams StandardConway -> Identity (PParams StandardConway))
-> EpochInterval
-> PParams StandardConway
-> PParams StandardConway
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 StandardConway
-> (PParams StandardConway -> PParams StandardConway)
-> PParams StandardConway
forall a b. a -> (a -> b) -> b
& (Word16 -> Identity Word16)
-> PParams StandardConway -> Identity (PParams StandardConway)
forall era. EraPParams era => Lens' (PParams era) Word16
Lens' (PParams StandardConway) Word16
ppNOptL ((Word16 -> Identity Word16)
 -> PParams StandardConway -> Identity (PParams StandardConway))
-> Word16 -> PParams StandardConway -> PParams StandardConway
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 StandardConway
-> (PParams StandardConway -> PParams StandardConway)
-> PParams StandardConway
forall a b. a -> (a -> b) -> b
& (NonNegativeInterval -> Identity NonNegativeInterval)
-> PParams StandardConway -> Identity (PParams StandardConway)
forall era.
EraPParams era =>
Lens' (PParams era) NonNegativeInterval
Lens' (PParams StandardConway) NonNegativeInterval
ppA0L ((NonNegativeInterval -> Identity NonNegativeInterval)
 -> PParams StandardConway -> Identity (PParams StandardConway))
-> NonNegativeInterval
-> PParams StandardConway
-> PParams StandardConway
forall s t a b. ASetter s t a b -> b -> s -> t
.~ NonNegativeInterval
a0
          PParams StandardConway
-> (PParams StandardConway -> PParams StandardConway)
-> PParams StandardConway
forall a b. a -> (a -> b) -> b
& (UnitInterval -> Identity UnitInterval)
-> PParams StandardConway -> Identity (PParams StandardConway)
forall era. EraPParams era => Lens' (PParams era) UnitInterval
Lens' (PParams StandardConway) UnitInterval
ppRhoL ((UnitInterval -> Identity UnitInterval)
 -> PParams StandardConway -> Identity (PParams StandardConway))
-> UnitInterval -> PParams StandardConway -> PParams StandardConway
forall s t a b. ASetter s t a b -> b -> s -> t
.~ UnitInterval
rho
          PParams StandardConway
-> (PParams StandardConway -> PParams StandardConway)
-> PParams StandardConway
forall a b. a -> (a -> b) -> b
& (UnitInterval -> Identity UnitInterval)
-> PParams StandardConway -> Identity (PParams StandardConway)
forall era. EraPParams era => Lens' (PParams era) UnitInterval
Lens' (PParams StandardConway) UnitInterval
ppTauL ((UnitInterval -> Identity UnitInterval)
 -> PParams StandardConway -> Identity (PParams StandardConway))
-> UnitInterval -> PParams StandardConway -> PParams StandardConway
forall s t a b. ASetter s t a b -> b -> s -> t
.~ UnitInterval
tau
          PParams StandardConway
-> (PParams StandardConway -> PParams StandardConway)
-> PParams StandardConway
forall a b. a -> (a -> b) -> b
& (ProtVer -> Identity ProtVer)
-> PParams StandardConway -> Identity (PParams StandardConway)
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams StandardConway) ProtVer
ppProtocolVersionL ((ProtVer -> Identity ProtVer)
 -> PParams StandardConway -> Identity (PParams StandardConway))
-> ProtVer -> PParams StandardConway -> PParams StandardConway
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Version -> Natural -> ProtVer
ProtVer Version
minVersion Natural
maxVersion
          PParams StandardConway
-> (PParams StandardConway -> PParams StandardConway)
-> PParams StandardConway
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> PParams StandardConway -> Identity (PParams StandardConway)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams StandardConway) Coin
ppMinPoolCostL ((Coin -> Identity Coin)
 -> PParams StandardConway -> Identity (PParams StandardConway))
-> Coin -> PParams StandardConway -> PParams StandardConway
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 StandardConway
-> (PParams StandardConway -> PParams StandardConway)
-> PParams StandardConway
forall a b. a -> (a -> b) -> b
& (CoinPerByte -> Identity CoinPerByte)
-> PParams StandardConway -> Identity (PParams StandardConway)
forall era.
BabbageEraPParams era =>
Lens' (PParams era) CoinPerByte
Lens' (PParams StandardConway) CoinPerByte
ppCoinsPerUTxOByteL ((CoinPerByte -> Identity CoinPerByte)
 -> PParams StandardConway -> Identity (PParams StandardConway))
-> CoinPerByte -> PParams StandardConway -> PParams StandardConway
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin -> CoinPerByte
CoinPerByte (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. HasCoinsPerUtxoSize s a => Lens' s a
Lens' ProtocolParams (Discrete' "ADA" '(1000000, 1))
Blockfrost.coinsPerUtxoSize))
          PParams StandardConway
-> (PParams StandardConway -> PParams StandardConway)
-> PParams StandardConway
forall a b. a -> (a -> b) -> b
& (CostModels -> Identity CostModels)
-> PParams StandardConway -> Identity (PParams StandardConway)
forall era. AlonzoEraPParams era => Lens' (PParams era) CostModels
Lens' (PParams StandardConway) CostModels
ppCostModelsL ((CostModels -> Identity CostModels)
 -> PParams StandardConway -> Identity (PParams StandardConway))
-> CostModels -> PParams StandardConway -> PParams StandardConway
forall s t a b. ASetter s t a b -> b -> s -> t
.~ CostModels -> CostModels
convertCostModels (ProtocolParams
pparams ProtocolParams
-> Getting CostModels ProtocolParams CostModels -> CostModels
forall s a. s -> Getting a s a -> a
^. Getting CostModels ProtocolParams CostModels
forall s a. HasCostModels s a => Lens' s a
Lens' ProtocolParams CostModels
Blockfrost.costModels)
          PParams StandardConway
-> (PParams StandardConway -> PParams StandardConway)
-> PParams StandardConway
forall a b. a -> (a -> b) -> b
& (Prices -> Identity Prices)
-> PParams StandardConway -> Identity (PParams StandardConway)
forall era. AlonzoEraPParams era => Lens' (PParams era) Prices
Lens' (PParams StandardConway) Prices
ppPricesL ((Prices -> Identity Prices)
 -> PParams StandardConway -> Identity (PParams StandardConway))
-> Prices -> PParams StandardConway -> PParams StandardConway
forall s t a b. ASetter s t a b -> b -> s -> t
.~ NonNegativeInterval -> NonNegativeInterval -> Prices
Prices NonNegativeInterval
priceMemory NonNegativeInterval
priceSteps
          PParams StandardConway
-> (PParams StandardConway -> PParams StandardConway)
-> PParams StandardConway
forall a b. a -> (a -> b) -> b
& (ExUnits -> Identity ExUnits)
-> PParams StandardConway -> Identity (PParams StandardConway)
forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
Lens' (PParams StandardConway) ExUnits
ppMaxTxExUnitsL ((ExUnits -> Identity ExUnits)
 -> PParams StandardConway -> Identity (PParams StandardConway))
-> ExUnits -> PParams StandardConway -> PParams StandardConway
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. HasMaxTxExSteps s a => Lens' s a
Lens' ProtocolParams Quantity
Blockfrost.maxTxExSteps) (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)
          PParams StandardConway
-> (PParams StandardConway -> PParams StandardConway)
-> PParams StandardConway
forall a b. a -> (a -> b) -> b
& (ExUnits -> Identity ExUnits)
-> PParams StandardConway -> Identity (PParams StandardConway)
forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
Lens' (PParams StandardConway) ExUnits
ppMaxBlockExUnitsL ((ExUnits -> Identity ExUnits)
 -> PParams StandardConway -> Identity (PParams StandardConway))
-> ExUnits -> PParams StandardConway -> PParams StandardConway
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. HasMaxBlockExSteps s a => Lens' s a
Lens' ProtocolParams Quantity
Blockfrost.maxBlockExSteps) (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)
          PParams StandardConway
-> (PParams StandardConway -> PParams StandardConway)
-> PParams StandardConway
forall a b. a -> (a -> b) -> b
& (Natural -> Identity Natural)
-> PParams StandardConway -> Identity (PParams StandardConway)
forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
Lens' (PParams StandardConway) Natural
ppMaxValSizeL ((Natural -> Identity Natural)
 -> PParams StandardConway -> Identity (PParams StandardConway))
-> Natural -> PParams StandardConway -> PParams StandardConway
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Natural
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 StandardConway
-> (PParams StandardConway -> PParams StandardConway)
-> PParams StandardConway
forall a b. a -> (a -> b) -> b
& (Natural -> Identity Natural)
-> PParams StandardConway -> Identity (PParams StandardConway)
forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
Lens' (PParams StandardConway) Natural
ppCollateralPercentageL ((Natural -> Identity Natural)
 -> PParams StandardConway -> Identity (PParams StandardConway))
-> Natural -> PParams StandardConway -> PParams StandardConway
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Natural
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 StandardConway
-> (PParams StandardConway -> PParams StandardConway)
-> PParams StandardConway
forall a b. a -> (a -> b) -> b
& (Natural -> Identity Natural)
-> PParams StandardConway -> Identity (PParams StandardConway)
forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
Lens' (PParams StandardConway) Natural
ppMaxCollateralInputsL ((Natural -> Identity Natural)
 -> PParams StandardConway -> Identity (PParams StandardConway))
-> Natural -> PParams StandardConway -> PParams StandardConway
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Natural
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 StandardConway
-> (PParams StandardConway -> PParams StandardConway)
-> PParams StandardConway
forall a b. a -> (a -> b) -> b
& (PoolVotingThresholds -> Identity PoolVotingThresholds)
-> PParams StandardConway -> Identity (PParams StandardConway)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) PoolVotingThresholds
Lens' (PParams StandardConway) PoolVotingThresholds
ppPoolVotingThresholdsL ((PoolVotingThresholds -> Identity PoolVotingThresholds)
 -> PParams StandardConway -> Identity (PParams StandardConway))
-> PoolVotingThresholds
-> PParams StandardConway
-> PParams StandardConway
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 StandardConway
-> (PParams StandardConway -> PParams StandardConway)
-> PParams StandardConway
forall a b. a -> (a -> b) -> b
& (DRepVotingThresholds -> Identity DRepVotingThresholds)
-> PParams StandardConway -> Identity (PParams StandardConway)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) DRepVotingThresholds
Lens' (PParams StandardConway) DRepVotingThresholds
ppDRepVotingThresholdsL ((DRepVotingThresholds -> Identity DRepVotingThresholds)
 -> PParams StandardConway -> Identity (PParams StandardConway))
-> DRepVotingThresholds
-> PParams StandardConway
-> PParams StandardConway
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 StandardConway
-> (PParams StandardConway -> PParams StandardConway)
-> PParams StandardConway
forall a b. a -> (a -> b) -> b
& (Natural -> Identity Natural)
-> PParams StandardConway -> Identity (PParams StandardConway)
forall era. ConwayEraPParams era => Lens' (PParams era) Natural
Lens' (PParams StandardConway) Natural
ppCommitteeMinSizeL ((Natural -> Identity Natural)
 -> PParams StandardConway -> Identity (PParams StandardConway))
-> Natural -> PParams StandardConway -> PParams StandardConway
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Quantity -> Integer
Blockfrost.unQuantity Quantity
committeeMinSize)
          PParams StandardConway
-> (PParams StandardConway -> PParams StandardConway)
-> PParams StandardConway
forall a b. a -> (a -> b) -> b
& (EpochInterval -> Identity EpochInterval)
-> PParams StandardConway -> Identity (PParams StandardConway)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams StandardConway) EpochInterval
ppCommitteeMaxTermLengthL ((EpochInterval -> Identity EpochInterval)
 -> PParams StandardConway -> Identity (PParams StandardConway))
-> EpochInterval
-> PParams StandardConway
-> PParams StandardConway
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 StandardConway
-> (PParams StandardConway -> PParams StandardConway)
-> PParams StandardConway
forall a b. a -> (a -> b) -> b
& (EpochInterval -> Identity EpochInterval)
-> PParams StandardConway -> Identity (PParams StandardConway)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams StandardConway) EpochInterval
ppGovActionLifetimeL ((EpochInterval -> Identity EpochInterval)
 -> PParams StandardConway -> Identity (PParams StandardConway))
-> EpochInterval
-> PParams StandardConway
-> PParams StandardConway
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 StandardConway
-> (PParams StandardConway -> PParams StandardConway)
-> PParams StandardConway
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> PParams StandardConway -> Identity (PParams StandardConway)
forall era. ConwayEraPParams era => Lens' (PParams era) Coin
Lens' (PParams StandardConway) Coin
ppGovActionDepositL ((Coin -> Identity Coin)
 -> PParams StandardConway -> Identity (PParams StandardConway))
-> Coin -> PParams StandardConway -> PParams StandardConway
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
govActionDeposit
          PParams StandardConway
-> (PParams StandardConway -> PParams StandardConway)
-> PParams StandardConway
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> PParams StandardConway -> Identity (PParams StandardConway)
forall era. ConwayEraPParams era => Lens' (PParams era) Coin
Lens' (PParams StandardConway) Coin
ppDRepDepositL ((Coin -> Identity Coin)
 -> PParams StandardConway -> Identity (PParams StandardConway))
-> Coin -> PParams StandardConway -> PParams StandardConway
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 StandardConway
-> (PParams StandardConway -> PParams StandardConway)
-> PParams StandardConway
forall a b. a -> (a -> b) -> b
& (EpochInterval -> Identity EpochInterval)
-> PParams StandardConway -> Identity (PParams StandardConway)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams StandardConway) EpochInterval
ppDRepActivityL ((EpochInterval -> Identity EpochInterval)
 -> PParams StandardConway -> Identity (PParams StandardConway))
-> EpochInterval
-> PParams StandardConway
-> PParams StandardConway
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 StandardConway
-> (PParams StandardConway -> PParams StandardConway)
-> PParams StandardConway
forall a b. a -> (a -> b) -> b
& (NonNegativeInterval -> Identity NonNegativeInterval)
-> PParams StandardConway -> Identity (PParams StandardConway)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) NonNegativeInterval
Lens' (PParams StandardConway) NonNegativeInterval
ppMinFeeRefScriptCostPerByteL ((NonNegativeInterval -> Identity NonNegativeInterval)
 -> PParams StandardConway -> Identity (PParams StandardConway))
-> NonNegativeInterval
-> PParams StandardConway
-> PParams StandardConway
forall s t a b. ASetter s t a b -> b -> s -> t
.~ NonNegativeInterval
minFeeRefScriptCostPerByte
 where
  convertCostModels :: Blockfrost.CostModels -> CostModels
  convertCostModels :: CostModels -> CostModels
convertCostModels CostModels
costModels =
    let costModelsMap :: Map ScriptType (Map Text Integer)
costModelsMap = CostModels -> Map ScriptType (Map Text Integer)
Blockfrost.unCostModels CostModels
costModels
     in ((ScriptType, Map Text Integer) -> CostModels)
-> [(ScriptType, Map Text 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, Map Text Integer) -> CostModels)
-> (ScriptType, Map Text Integer)
-> CostModels
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( \(ScriptType
scriptType, Map Text 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
<$> Map Text Integer -> [Integer]
forall k a. Map k a -> [a]
Map.elems Map Text 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 (Map Text Integer)
-> [(ScriptType, Map Text Integer)]
forall k a. Map k a -> [(k, a)]
Map.toList Map ScriptType (Map Text Integer)
costModelsMap)

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 :: Int
protocolParamSecurity = Integer -> Int
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 StandardShelley
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
$sel:_genesisNetworkMagic:Genesis :: Genesis -> Integer
_genesisNetworkMagic :: 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

mkEraHistory :: Blockfrost.Genesis -> EraHistory
mkEraHistory :: Genesis -> EraHistory
mkEraHistory Genesis
genesis = 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)
summary)
 where
  Blockfrost.Genesis
    { Integer
$sel:_genesisNetworkMagic:Genesis :: Genesis -> Integer
_genesisNetworkMagic :: Integer
_genesisNetworkMagic
    , NominalDiffTime
$sel:_genesisSystemStart:Genesis :: Genesis -> NominalDiffTime
_genesisSystemStart :: NominalDiffTime
_genesisSystemStart
    , Integer
$sel:_genesisSlotLength:Genesis :: Genesis -> Integer
_genesisSlotLength :: Integer
_genesisSlotLength
    , Integer
$sel:_genesisEpochLength:Genesis :: Genesis -> Integer
_genesisEpochLength :: Integer
_genesisEpochLength
    } = Genesis
genesis

  summary :: Summary (CardanoEras StandardCrypto)
  summary :: Summary (CardanoEras StandardCrypto)
summary =
    NonEmpty (CardanoEras StandardCrypto) EraSummary
-> Summary (CardanoEras StandardCrypto)
forall (xs :: [*]). NonEmpty xs EraSummary -> Summary xs
Summary (NonEmpty (CardanoEras StandardCrypto) EraSummary
 -> Summary (CardanoEras StandardCrypto))
-> (EraSummary -> NonEmpty (CardanoEras StandardCrypto) EraSummary)
-> EraSummary
-> Summary (CardanoEras StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EraSummary -> NonEmpty (CardanoEras StandardCrypto) EraSummary
forall a x (xs1 :: [*]). a -> NonEmpty (x : xs1) a
NonEmptyOne (EraSummary -> Summary (CardanoEras StandardCrypto))
-> EraSummary -> Summary (CardanoEras StandardCrypto)
forall a b. (a -> b) -> a -> b
$
      EraSummary
        { eraStart :: Bound
eraStart = Bound
initBound
        , eraEnd :: EraEnd
eraEnd = EraEnd
EraUnbounded
        , EraParams
eraParams :: EraParams
eraParams :: EraParams
eraParams
        }

  eraParams :: EraParams
eraParams =
    EraParams
      { eraEpochSize :: EpochSize
eraEpochSize = 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
      , eraSlotLength :: SlotLength
eraSlotLength = NominalDiffTime -> SlotLength
mkSlotLength (NominalDiffTime -> SlotLength) -> NominalDiffTime -> SlotLength
forall a b. (a -> b) -> a -> b
$ Integer -> NominalDiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
_genesisSlotLength
      , eraSafeZone :: SafeZone
eraSafeZone = SafeZone
UnsafeIndefiniteSafeZone
      , eraGenesisWin :: GenesisWindow
eraGenesisWin = Word64 -> GenesisWindow
GenesisWindow Word64
1
      }