{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Cardano.Rpc.Server.Internal.UtxoRpc.Type
  ( utxoRpcPParamsToProtocolParams
  , utxoToUtxoRpcAnyUtxoData
  , anyUtxoDataUtxoRpcToUtxo
  , txOutToUtxoRpcTxOutput
  , utxoRpcTxOutputToTxOut
  , protocolParamsToUtxoRpcPParams
  , simpleScriptToUtxoRpcNativeScript
  , mkChainPointMsg
  )
where

import Cardano.Api.Address
import Cardano.Api.Block
import Cardano.Api.Era
import Cardano.Api.Error
import Cardano.Api.Experimental.Era
import Cardano.Api.HasTypeProxy
import Cardano.Api.Ledger qualified as L
import Cardano.Api.Monad.Error
import Cardano.Api.Plutus
import Cardano.Api.Serialise.Cbor
import Cardano.Api.Serialise.Raw
import Cardano.Api.Tx
import Cardano.Api.Value
import Cardano.Rpc.Proto.Api.UtxoRpc.Query qualified as UtxoRpc
import Cardano.Rpc.Server.Internal.Orphans ()

import Cardano.Binary qualified as CBOR
import Cardano.Ledger.Api qualified as L
import Cardano.Ledger.BaseTypes (WithOrigin (..))
import Cardano.Ledger.BaseTypes qualified as L
import Cardano.Ledger.Conway.Core qualified as L
import Cardano.Ledger.Conway.PParams qualified as L
import Cardano.Ledger.Plutus qualified as L

import RIO hiding (toList)

import Data.ByteString.Short qualified as SBS
import Data.Default
import Data.Map.Strict qualified as M
import Data.ProtoLens (defMessage)
import Data.Text qualified as T
import Data.Text.Encoding qualified as T
import GHC.IsList
import Network.GRPC.Spec

protocolParamsToUtxoRpcPParams
  :: forall era
   . Era era
  -> L.PParams (LedgerEra era)
  -> Proto UtxoRpc.PParams
protocolParamsToUtxoRpcPParams :: forall era. Era era -> PParams (LedgerEra era) -> Proto PParams
protocolParamsToUtxoRpcPParams Era era
era PParams (LedgerEra era)
pparams = Era era
-> (EraCommonConstraints era => Proto PParams) -> Proto PParams
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
era ((EraCommonConstraints era => Proto PParams) -> Proto PParams)
-> (EraCommonConstraints era => Proto PParams) -> Proto PParams
forall a b. (a -> b) -> a -> b
$ do
  let Map Language [Int64]
pparamsCostModels :: Map L.Language [Int64] =
        CostModel -> [Int64]
L.getCostModelParams (CostModel -> [Int64])
-> Map Language CostModel -> Map Language [Int64]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PParams (LedgerEra era)
pparams PParams (LedgerEra era)
-> Getting
     (Map Language CostModel)
     (PParams (LedgerEra era))
     (Map Language CostModel)
-> Map Language CostModel
forall s a. s -> Getting a s a -> a
^. (CostModels -> Const (Map Language CostModel) CostModels)
-> PParams (LedgerEra era)
-> Const (Map Language CostModel) (PParams (LedgerEra era))
forall era. AlonzoEraPParams era => Lens' (PParams era) CostModels
Lens' (PParams (LedgerEra era)) CostModels
L.ppCostModelsL ((CostModels -> Const (Map Language CostModel) CostModels)
 -> PParams (LedgerEra era)
 -> Const (Map Language CostModel) (PParams (LedgerEra era)))
-> ((Map Language CostModel
     -> Const (Map Language CostModel) (Map Language CostModel))
    -> CostModels -> Const (Map Language CostModel) CostModels)
-> Getting
     (Map Language CostModel)
     (PParams (LedgerEra era))
     (Map Language CostModel)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CostModels -> Map Language CostModel)
-> SimpleGetter CostModels (Map Language CostModel)
forall s a. (s -> a) -> SimpleGetter s a
to CostModels -> Map Language CostModel
L.costModelsValid
      PoolVotingThresholds
poolVotingThresholds :: L.PoolVotingThresholds =
        PParams (LedgerEra era)
pparams PParams (LedgerEra era)
-> Getting
     PoolVotingThresholds (PParams (LedgerEra era)) PoolVotingThresholds
-> PoolVotingThresholds
forall s a. s -> Getting a s a -> a
^. Getting
  PoolVotingThresholds (PParams (LedgerEra era)) PoolVotingThresholds
forall era.
ConwayEraPParams era =>
Lens' (PParams era) PoolVotingThresholds
Lens' (PParams (LedgerEra era)) PoolVotingThresholds
L.ppPoolVotingThresholdsL
      DRepVotingThresholds
drepVotingThresholds :: L.DRepVotingThresholds =
        PParams (LedgerEra era)
pparams PParams (LedgerEra era)
-> Getting
     DRepVotingThresholds (PParams (LedgerEra era)) DRepVotingThresholds
-> DRepVotingThresholds
forall s a. s -> Getting a s a -> a
^. Getting
  DRepVotingThresholds (PParams (LedgerEra era)) DRepVotingThresholds
forall era.
ConwayEraPParams era =>
Lens' (PParams era) DRepVotingThresholds
Lens' (PParams (LedgerEra era)) DRepVotingThresholds
L.ppDRepVotingThresholdsL
  Proto PParams
forall a. Default a => a
def
    Proto PParams -> (Proto PParams -> Proto PParams) -> Proto PParams
forall a b. a -> (a -> b) -> b
& ASetter (Proto PParams) (Proto PParams) Word64 Word64
#coinsPerUtxoByte ASetter (Proto PParams) (Proto PParams) Word64 Word64
-> Word64 -> Proto PParams -> Proto PParams
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams (LedgerEra era)
pparams PParams (LedgerEra era)
-> Getting Word64 (PParams (LedgerEra era)) Word64 -> Word64
forall s a. s -> Getting a s a -> a
^. (CoinPerByte -> Const Word64 CoinPerByte)
-> PParams (LedgerEra era)
-> Const Word64 (PParams (LedgerEra era))
forall era.
BabbageEraPParams era =>
Lens' (PParams era) CoinPerByte
Lens' (PParams (LedgerEra era)) CoinPerByte
L.ppCoinsPerUTxOByteL ((CoinPerByte -> Const Word64 CoinPerByte)
 -> PParams (LedgerEra era)
 -> Const Word64 (PParams (LedgerEra era)))
-> ((Word64 -> Const Word64 Word64)
    -> CoinPerByte -> Const Word64 CoinPerByte)
-> Getting Word64 (PParams (LedgerEra era)) Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CoinPerByte -> Coin) -> SimpleGetter CoinPerByte Coin
forall s a. (s -> a) -> SimpleGetter s a
to CoinPerByte -> Coin
L.unCoinPerByte Getting Word64 CoinPerByte Coin
-> ((Word64 -> Const Word64 Word64) -> Coin -> Const Word64 Coin)
-> (Word64 -> Const Word64 Word64)
-> CoinPerByte
-> Const Word64 CoinPerByte
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Word64) -> SimpleGetter Coin Word64
forall s a. (s -> a) -> SimpleGetter s a
to Coin -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    Proto PParams -> (Proto PParams -> Proto PParams) -> Proto PParams
forall a b. a -> (a -> b) -> b
& ASetter (Proto PParams) (Proto PParams) Word64 Word64
#maxTxSize ASetter (Proto PParams) (Proto PParams) Word64 Word64
-> Word64 -> Proto PParams -> Proto PParams
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams (LedgerEra era)
pparams PParams (LedgerEra era)
-> Getting Word64 (PParams (LedgerEra era)) Word64 -> Word64
forall s a. s -> Getting a s a -> a
^. (Word32 -> Const Word64 Word32)
-> PParams (LedgerEra era)
-> Const Word64 (PParams (LedgerEra era))
forall era. EraPParams era => Lens' (PParams era) Word32
Lens' (PParams (LedgerEra era)) Word32
L.ppMaxTxSizeL ((Word32 -> Const Word64 Word32)
 -> PParams (LedgerEra era)
 -> Const Word64 (PParams (LedgerEra era)))
-> ((Word64 -> Const Word64 Word64)
    -> Word32 -> Const Word64 Word32)
-> Getting Word64 (PParams (LedgerEra era)) Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Word64) -> SimpleGetter Word32 Word64
forall s a. (s -> a) -> SimpleGetter s a
to Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    Proto PParams -> (Proto PParams -> Proto PParams) -> Proto PParams
forall a b. a -> (a -> b) -> b
& ASetter (Proto PParams) (Proto PParams) Word64 Word64
#minFeeCoefficient ASetter (Proto PParams) (Proto PParams) Word64 Word64
-> Word64 -> Proto PParams -> Proto PParams
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams (LedgerEra era)
pparams PParams (LedgerEra era)
-> Getting Word64 (PParams (LedgerEra era)) Word64 -> Word64
forall s a. s -> Getting a s a -> a
^. (Coin -> Const Word64 Coin)
-> PParams (LedgerEra era)
-> Const Word64 (PParams (LedgerEra era))
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams (LedgerEra era)) Coin
L.ppMinFeeBL ((Coin -> Const Word64 Coin)
 -> PParams (LedgerEra era)
 -> Const Word64 (PParams (LedgerEra era)))
-> ((Word64 -> Const Word64 Word64) -> Coin -> Const Word64 Coin)
-> Getting Word64 (PParams (LedgerEra era)) Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Word64) -> SimpleGetter Coin Word64
forall s a. (s -> a) -> SimpleGetter s a
to Coin -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    Proto PParams -> (Proto PParams -> Proto PParams) -> Proto PParams
forall a b. a -> (a -> b) -> b
& ASetter (Proto PParams) (Proto PParams) Word64 Word64
#minFeeConstant ASetter (Proto PParams) (Proto PParams) Word64 Word64
-> Word64 -> Proto PParams -> Proto PParams
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams (LedgerEra era)
pparams PParams (LedgerEra era)
-> Getting Word64 (PParams (LedgerEra era)) Word64 -> Word64
forall s a. s -> Getting a s a -> a
^. (Coin -> Const Word64 Coin)
-> PParams (LedgerEra era)
-> Const Word64 (PParams (LedgerEra era))
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams (LedgerEra era)) Coin
L.ppMinFeeAL ((Coin -> Const Word64 Coin)
 -> PParams (LedgerEra era)
 -> Const Word64 (PParams (LedgerEra era)))
-> ((Word64 -> Const Word64 Word64) -> Coin -> Const Word64 Coin)
-> Getting Word64 (PParams (LedgerEra era)) Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Word64) -> SimpleGetter Coin Word64
forall s a. (s -> a) -> SimpleGetter s a
to Coin -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    Proto PParams -> (Proto PParams -> Proto PParams) -> Proto PParams
forall a b. a -> (a -> b) -> b
& ASetter (Proto PParams) (Proto PParams) Word64 Word64
#maxBlockBodySize ASetter (Proto PParams) (Proto PParams) Word64 Word64
-> Word64 -> Proto PParams -> Proto PParams
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams (LedgerEra era)
pparams PParams (LedgerEra era)
-> Getting Word64 (PParams (LedgerEra era)) Word64 -> Word64
forall s a. s -> Getting a s a -> a
^. (Word32 -> Const Word64 Word32)
-> PParams (LedgerEra era)
-> Const Word64 (PParams (LedgerEra era))
forall era. EraPParams era => Lens' (PParams era) Word32
Lens' (PParams (LedgerEra era)) Word32
L.ppMaxBBSizeL ((Word32 -> Const Word64 Word32)
 -> PParams (LedgerEra era)
 -> Const Word64 (PParams (LedgerEra era)))
-> ((Word64 -> Const Word64 Word64)
    -> Word32 -> Const Word64 Word32)
-> Getting Word64 (PParams (LedgerEra era)) Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Word64) -> SimpleGetter Word32 Word64
forall s a. (s -> a) -> SimpleGetter s a
to Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    Proto PParams -> (Proto PParams -> Proto PParams) -> Proto PParams
forall a b. a -> (a -> b) -> b
& ASetter (Proto PParams) (Proto PParams) Word64 Word64
#maxBlockHeaderSize ASetter (Proto PParams) (Proto PParams) Word64 Word64
-> Word64 -> Proto PParams -> Proto PParams
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams (LedgerEra era)
pparams PParams (LedgerEra era)
-> Getting Word64 (PParams (LedgerEra era)) Word64 -> Word64
forall s a. s -> Getting a s a -> a
^. (Word16 -> Const Word64 Word16)
-> PParams (LedgerEra era)
-> Const Word64 (PParams (LedgerEra era))
forall era. EraPParams era => Lens' (PParams era) Word16
Lens' (PParams (LedgerEra era)) Word16
L.ppMaxBHSizeL ((Word16 -> Const Word64 Word16)
 -> PParams (LedgerEra era)
 -> Const Word64 (PParams (LedgerEra era)))
-> ((Word64 -> Const Word64 Word64)
    -> Word16 -> Const Word64 Word16)
-> Getting Word64 (PParams (LedgerEra era)) Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word16 -> Word64) -> SimpleGetter Word16 Word64
forall s a. (s -> a) -> SimpleGetter s a
to Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    Proto PParams -> (Proto PParams -> Proto PParams) -> Proto PParams
forall a b. a -> (a -> b) -> b
& ASetter (Proto PParams) (Proto PParams) Word64 Word64
#stakeKeyDeposit ASetter (Proto PParams) (Proto PParams) Word64 Word64
-> Word64 -> Proto PParams -> Proto PParams
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams (LedgerEra era)
pparams PParams (LedgerEra era)
-> Getting Word64 (PParams (LedgerEra era)) Word64 -> Word64
forall s a. s -> Getting a s a -> a
^. (Coin -> Const Word64 Coin)
-> PParams (LedgerEra era)
-> Const Word64 (PParams (LedgerEra era))
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams (LedgerEra era)) Coin
L.ppKeyDepositL ((Coin -> Const Word64 Coin)
 -> PParams (LedgerEra era)
 -> Const Word64 (PParams (LedgerEra era)))
-> ((Word64 -> Const Word64 Word64) -> Coin -> Const Word64 Coin)
-> Getting Word64 (PParams (LedgerEra era)) Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Word64) -> SimpleGetter Coin Word64
forall s a. (s -> a) -> SimpleGetter s a
to Coin -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    Proto PParams -> (Proto PParams -> Proto PParams) -> Proto PParams
forall a b. a -> (a -> b) -> b
& ASetter (Proto PParams) (Proto PParams) Word64 Word64
#poolDeposit ASetter (Proto PParams) (Proto PParams) Word64 Word64
-> Word64 -> Proto PParams -> Proto PParams
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams (LedgerEra era)
pparams PParams (LedgerEra era)
-> Getting Word64 (PParams (LedgerEra era)) Word64 -> Word64
forall s a. s -> Getting a s a -> a
^. (Coin -> Const Word64 Coin)
-> PParams (LedgerEra era)
-> Const Word64 (PParams (LedgerEra era))
forall era.
(EraPParams era, HasCallStack) =>
Lens' (PParams era) Coin
Lens' (PParams (LedgerEra era)) Coin
L.ppPoolDepositL ((Coin -> Const Word64 Coin)
 -> PParams (LedgerEra era)
 -> Const Word64 (PParams (LedgerEra era)))
-> ((Word64 -> Const Word64 Word64) -> Coin -> Const Word64 Coin)
-> Getting Word64 (PParams (LedgerEra era)) Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Word64) -> SimpleGetter Coin Word64
forall s a. (s -> a) -> SimpleGetter s a
to Coin -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    Proto PParams -> (Proto PParams -> Proto PParams) -> Proto PParams
forall a b. a -> (a -> b) -> b
& ASetter (Proto PParams) (Proto PParams) Word64 Word64
#poolRetirementEpochBound ASetter (Proto PParams) (Proto PParams) Word64 Word64
-> Word64 -> Proto PParams -> Proto PParams
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams (LedgerEra era)
pparams PParams (LedgerEra era)
-> Getting Word64 (PParams (LedgerEra era)) Word64 -> Word64
forall s a. s -> Getting a s a -> a
^. (EpochInterval -> Const Word64 EpochInterval)
-> PParams (LedgerEra era)
-> Const Word64 (PParams (LedgerEra era))
forall era. EraPParams era => Lens' (PParams era) EpochInterval
Lens' (PParams (LedgerEra era)) EpochInterval
L.ppEMaxL ((EpochInterval -> Const Word64 EpochInterval)
 -> PParams (LedgerEra era)
 -> Const Word64 (PParams (LedgerEra era)))
-> ((Word64 -> Const Word64 Word64)
    -> EpochInterval -> Const Word64 EpochInterval)
-> Getting Word64 (PParams (LedgerEra era)) Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EpochInterval -> Word32) -> SimpleGetter EpochInterval Word32
forall s a. (s -> a) -> SimpleGetter s a
to EpochInterval -> Word32
L.unEpochInterval Getting Word64 EpochInterval Word32
-> ((Word64 -> Const Word64 Word64)
    -> Word32 -> Const Word64 Word32)
-> (Word64 -> Const Word64 Word64)
-> EpochInterval
-> Const Word64 EpochInterval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Word64) -> SimpleGetter Word32 Word64
forall s a. (s -> a) -> SimpleGetter s a
to Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    Proto PParams -> (Proto PParams -> Proto PParams) -> Proto PParams
forall a b. a -> (a -> b) -> b
& ASetter (Proto PParams) (Proto PParams) Word64 Word64
#desiredNumberOfPools ASetter (Proto PParams) (Proto PParams) Word64 Word64
-> Word64 -> Proto PParams -> Proto PParams
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams (LedgerEra era)
pparams PParams (LedgerEra era)
-> Getting Word64 (PParams (LedgerEra era)) Word64 -> Word64
forall s a. s -> Getting a s a -> a
^. (Word16 -> Const Word64 Word16)
-> PParams (LedgerEra era)
-> Const Word64 (PParams (LedgerEra era))
forall era. EraPParams era => Lens' (PParams era) Word16
Lens' (PParams (LedgerEra era)) Word16
L.ppNOptL ((Word16 -> Const Word64 Word16)
 -> PParams (LedgerEra era)
 -> Const Word64 (PParams (LedgerEra era)))
-> ((Word64 -> Const Word64 Word64)
    -> Word16 -> Const Word64 Word16)
-> Getting Word64 (PParams (LedgerEra era)) Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word16 -> Word64) -> SimpleGetter Word16 Word64
forall s a. (s -> a) -> SimpleGetter s a
to Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    Proto PParams -> (Proto PParams -> Proto PParams) -> Proto PParams
forall a b. a -> (a -> b) -> b
& ASetter
  (Proto PParams)
  (Proto PParams)
  (Proto RationalNumber)
  (Proto RationalNumber)
#poolInfluence ASetter
  (Proto PParams)
  (Proto PParams)
  (Proto RationalNumber)
  (Proto RationalNumber)
-> Proto RationalNumber -> Proto PParams -> Proto PParams
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams (LedgerEra era)
pparams PParams (LedgerEra era)
-> Getting
     (Proto RationalNumber)
     (PParams (LedgerEra era))
     (Proto RationalNumber)
-> Proto RationalNumber
forall s a. s -> Getting a s a -> a
^. (NonNegativeInterval
 -> Const (Proto RationalNumber) NonNegativeInterval)
-> PParams (LedgerEra era)
-> Const (Proto RationalNumber) (PParams (LedgerEra era))
forall era.
EraPParams era =>
Lens' (PParams era) NonNegativeInterval
Lens' (PParams (LedgerEra era)) NonNegativeInterval
L.ppA0L ((NonNegativeInterval
  -> Const (Proto RationalNumber) NonNegativeInterval)
 -> PParams (LedgerEra era)
 -> Const (Proto RationalNumber) (PParams (LedgerEra era)))
-> ((Proto RationalNumber
     -> Const (Proto RationalNumber) (Proto RationalNumber))
    -> NonNegativeInterval
    -> Const (Proto RationalNumber) NonNegativeInterval)
-> Getting
     (Proto RationalNumber)
     (PParams (LedgerEra era))
     (Proto RationalNumber)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonNegativeInterval -> Rational)
-> SimpleGetter NonNegativeInterval Rational
forall s a. (s -> a) -> SimpleGetter s a
to NonNegativeInterval -> Rational
forall r. BoundedRational r => r -> Rational
L.unboundRational Getting (Proto RationalNumber) NonNegativeInterval Rational
-> ((Proto RationalNumber
     -> Const (Proto RationalNumber) (Proto RationalNumber))
    -> Rational -> Const (Proto RationalNumber) Rational)
-> (Proto RationalNumber
    -> Const (Proto RationalNumber) (Proto RationalNumber))
-> NonNegativeInterval
-> Const (Proto RationalNumber) NonNegativeInterval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Proto RationalNumber)
-> SimpleGetter Rational (Proto RationalNumber)
forall s a. (s -> a) -> SimpleGetter s a
to Rational -> Proto RationalNumber
forall t s. Inject t s => t -> s
inject
    Proto PParams -> (Proto PParams -> Proto PParams) -> Proto PParams
forall a b. a -> (a -> b) -> b
& ASetter
  (Proto PParams)
  (Proto PParams)
  (Proto RationalNumber)
  (Proto RationalNumber)
#monetaryExpansion ASetter
  (Proto PParams)
  (Proto PParams)
  (Proto RationalNumber)
  (Proto RationalNumber)
-> Proto RationalNumber -> Proto PParams -> Proto PParams
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams (LedgerEra era)
pparams PParams (LedgerEra era)
-> Getting
     (Proto RationalNumber)
     (PParams (LedgerEra era))
     (Proto RationalNumber)
-> Proto RationalNumber
forall s a. s -> Getting a s a -> a
^. (UnitInterval -> Const (Proto RationalNumber) UnitInterval)
-> PParams (LedgerEra era)
-> Const (Proto RationalNumber) (PParams (LedgerEra era))
forall era. EraPParams era => Lens' (PParams era) UnitInterval
Lens' (PParams (LedgerEra era)) UnitInterval
L.ppRhoL ((UnitInterval -> Const (Proto RationalNumber) UnitInterval)
 -> PParams (LedgerEra era)
 -> Const (Proto RationalNumber) (PParams (LedgerEra era)))
-> ((Proto RationalNumber
     -> Const (Proto RationalNumber) (Proto RationalNumber))
    -> UnitInterval -> Const (Proto RationalNumber) UnitInterval)
-> Getting
     (Proto RationalNumber)
     (PParams (LedgerEra era))
     (Proto RationalNumber)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnitInterval -> Rational) -> SimpleGetter UnitInterval Rational
forall s a. (s -> a) -> SimpleGetter s a
to UnitInterval -> Rational
forall r. BoundedRational r => r -> Rational
L.unboundRational Getting (Proto RationalNumber) UnitInterval Rational
-> ((Proto RationalNumber
     -> Const (Proto RationalNumber) (Proto RationalNumber))
    -> Rational -> Const (Proto RationalNumber) Rational)
-> (Proto RationalNumber
    -> Const (Proto RationalNumber) (Proto RationalNumber))
-> UnitInterval
-> Const (Proto RationalNumber) UnitInterval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Proto RationalNumber)
-> SimpleGetter Rational (Proto RationalNumber)
forall s a. (s -> a) -> SimpleGetter s a
to Rational -> Proto RationalNumber
forall t s. Inject t s => t -> s
inject
    Proto PParams -> (Proto PParams -> Proto PParams) -> Proto PParams
forall a b. a -> (a -> b) -> b
& ASetter
  (Proto PParams)
  (Proto PParams)
  (Proto RationalNumber)
  (Proto RationalNumber)
#treasuryExpansion ASetter
  (Proto PParams)
  (Proto PParams)
  (Proto RationalNumber)
  (Proto RationalNumber)
-> Proto RationalNumber -> Proto PParams -> Proto PParams
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams (LedgerEra era)
pparams PParams (LedgerEra era)
-> Getting
     (Proto RationalNumber)
     (PParams (LedgerEra era))
     (Proto RationalNumber)
-> Proto RationalNumber
forall s a. s -> Getting a s a -> a
^. (UnitInterval -> Const (Proto RationalNumber) UnitInterval)
-> PParams (LedgerEra era)
-> Const (Proto RationalNumber) (PParams (LedgerEra era))
forall era. EraPParams era => Lens' (PParams era) UnitInterval
Lens' (PParams (LedgerEra era)) UnitInterval
L.ppTauL ((UnitInterval -> Const (Proto RationalNumber) UnitInterval)
 -> PParams (LedgerEra era)
 -> Const (Proto RationalNumber) (PParams (LedgerEra era)))
-> ((Proto RationalNumber
     -> Const (Proto RationalNumber) (Proto RationalNumber))
    -> UnitInterval -> Const (Proto RationalNumber) UnitInterval)
-> Getting
     (Proto RationalNumber)
     (PParams (LedgerEra era))
     (Proto RationalNumber)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnitInterval -> Rational) -> SimpleGetter UnitInterval Rational
forall s a. (s -> a) -> SimpleGetter s a
to UnitInterval -> Rational
forall r. BoundedRational r => r -> Rational
L.unboundRational Getting (Proto RationalNumber) UnitInterval Rational
-> ((Proto RationalNumber
     -> Const (Proto RationalNumber) (Proto RationalNumber))
    -> Rational -> Const (Proto RationalNumber) Rational)
-> (Proto RationalNumber
    -> Const (Proto RationalNumber) (Proto RationalNumber))
-> UnitInterval
-> Const (Proto RationalNumber) UnitInterval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Proto RationalNumber)
-> SimpleGetter Rational (Proto RationalNumber)
forall s a. (s -> a) -> SimpleGetter s a
to Rational -> Proto RationalNumber
forall t s. Inject t s => t -> s
inject
    Proto PParams -> (Proto PParams -> Proto PParams) -> Proto PParams
forall a b. a -> (a -> b) -> b
& ASetter (Proto PParams) (Proto PParams) Word64 Word64
#minPoolCost ASetter (Proto PParams) (Proto PParams) Word64 Word64
-> Word64 -> Proto PParams -> Proto PParams
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams (LedgerEra era)
pparams PParams (LedgerEra era)
-> Getting Word64 (PParams (LedgerEra era)) Word64 -> Word64
forall s a. s -> Getting a s a -> a
^. (Coin -> Const Word64 Coin)
-> PParams (LedgerEra era)
-> Const Word64 (PParams (LedgerEra era))
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams (LedgerEra era)) Coin
L.ppMinPoolCostL ((Coin -> Const Word64 Coin)
 -> PParams (LedgerEra era)
 -> Const Word64 (PParams (LedgerEra era)))
-> ((Word64 -> Const Word64 Word64) -> Coin -> Const Word64 Coin)
-> Getting Word64 (PParams (LedgerEra era)) Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Word64) -> SimpleGetter Coin Word64
forall s a. (s -> a) -> SimpleGetter s a
to Coin -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    Proto PParams -> (Proto PParams -> Proto PParams) -> Proto PParams
forall a b. a -> (a -> b) -> b
& (Proto ProtocolVersion -> Identity (Proto ProtocolVersion))
-> Proto PParams -> Identity (Proto PParams)
#protocolVersion ((Proto ProtocolVersion -> Identity (Proto ProtocolVersion))
 -> Proto PParams -> Identity (Proto PParams))
-> ((Word32 -> Identity Word32)
    -> Proto ProtocolVersion -> Identity (Proto ProtocolVersion))
-> ASetter (Proto PParams) (Proto PParams) Word32 Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Identity Word32)
-> Proto ProtocolVersion -> Identity (Proto ProtocolVersion)
#major ASetter (Proto PParams) (Proto PParams) Word32 Word32
-> Word32 -> Proto PParams -> Proto PParams
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams (LedgerEra era)
pparams PParams (LedgerEra era)
-> Getting Word32 (PParams (LedgerEra era)) Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. (ProtVer -> Const Word32 ProtVer)
-> PParams (LedgerEra era)
-> Const Word32 (PParams (LedgerEra era))
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams (LedgerEra era)) ProtVer
L.ppProtocolVersionL ((ProtVer -> Const Word32 ProtVer)
 -> PParams (LedgerEra era)
 -> Const Word32 (PParams (LedgerEra era)))
-> ((Word32 -> Const Word32 Word32)
    -> ProtVer -> Const Word32 ProtVer)
-> Getting Word32 (PParams (LedgerEra era)) Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtVer -> Version) -> SimpleGetter ProtVer Version
forall s a. (s -> a) -> SimpleGetter s a
to ProtVer -> Version
L.pvMajor Getting Word32 ProtVer Version
-> ((Word32 -> Const Word32 Word32)
    -> Version -> Const Word32 Version)
-> (Word32 -> Const Word32 Word32)
-> ProtVer
-> Const Word32 ProtVer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Version -> Word32) -> SimpleGetter Version Word32
forall s a. (s -> a) -> SimpleGetter s a
to Version -> Word32
forall i. Integral i => Version -> i
L.getVersion
    Proto PParams -> (Proto PParams -> Proto PParams) -> Proto PParams
forall a b. a -> (a -> b) -> b
& (Proto ProtocolVersion -> Identity (Proto ProtocolVersion))
-> Proto PParams -> Identity (Proto PParams)
#protocolVersion ((Proto ProtocolVersion -> Identity (Proto ProtocolVersion))
 -> Proto PParams -> Identity (Proto PParams))
-> ((Word32 -> Identity Word32)
    -> Proto ProtocolVersion -> Identity (Proto ProtocolVersion))
-> ASetter (Proto PParams) (Proto PParams) Word32 Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Identity Word32)
-> Proto ProtocolVersion -> Identity (Proto ProtocolVersion)
#minor ASetter (Proto PParams) (Proto PParams) Word32 Word32
-> Word32 -> Proto PParams -> Proto PParams
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams (LedgerEra era)
pparams PParams (LedgerEra era)
-> Getting Word32 (PParams (LedgerEra era)) Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. (ProtVer -> Const Word32 ProtVer)
-> PParams (LedgerEra era)
-> Const Word32 (PParams (LedgerEra era))
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams (LedgerEra era)) ProtVer
L.ppProtocolVersionL ((ProtVer -> Const Word32 ProtVer)
 -> PParams (LedgerEra era)
 -> Const Word32 (PParams (LedgerEra era)))
-> ((Word32 -> Const Word32 Word32)
    -> ProtVer -> Const Word32 ProtVer)
-> Getting Word32 (PParams (LedgerEra era)) Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtVer -> Natural) -> SimpleGetter ProtVer Natural
forall s a. (s -> a) -> SimpleGetter s a
to ProtVer -> Natural
L.pvMinor Getting Word32 ProtVer Natural
-> ((Word32 -> Const Word32 Word32)
    -> Natural -> Const Word32 Natural)
-> (Word32 -> Const Word32 Word32)
-> ProtVer
-> Const Word32 ProtVer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Natural -> Word32) -> SimpleGetter Natural Word32
forall s a. (s -> a) -> SimpleGetter s a
to Natural -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    Proto PParams -> (Proto PParams -> Proto PParams) -> Proto PParams
forall a b. a -> (a -> b) -> b
& ASetter (Proto PParams) (Proto PParams) Word64 Word64
#maxValueSize ASetter (Proto PParams) (Proto PParams) Word64 Word64
-> Word64 -> Proto PParams -> Proto PParams
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams (LedgerEra era)
pparams PParams (LedgerEra era)
-> Getting Word64 (PParams (LedgerEra era)) Word64 -> Word64
forall s a. s -> Getting a s a -> a
^. (Natural -> Const Word64 Natural)
-> PParams (LedgerEra era)
-> Const Word64 (PParams (LedgerEra era))
forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
Lens' (PParams (LedgerEra era)) Natural
L.ppMaxValSizeL ((Natural -> Const Word64 Natural)
 -> PParams (LedgerEra era)
 -> Const Word64 (PParams (LedgerEra era)))
-> ((Word64 -> Const Word64 Word64)
    -> Natural -> Const Word64 Natural)
-> Getting Word64 (PParams (LedgerEra era)) Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Natural -> Word64) -> SimpleGetter Natural Word64
forall s a. (s -> a) -> SimpleGetter s a
to Natural -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    Proto PParams -> (Proto PParams -> Proto PParams) -> Proto PParams
forall a b. a -> (a -> b) -> b
& ASetter (Proto PParams) (Proto PParams) Word64 Word64
#collateralPercentage ASetter (Proto PParams) (Proto PParams) Word64 Word64
-> Word64 -> Proto PParams -> Proto PParams
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams (LedgerEra era)
pparams PParams (LedgerEra era)
-> Getting Word64 (PParams (LedgerEra era)) Word64 -> Word64
forall s a. s -> Getting a s a -> a
^. (Natural -> Const Word64 Natural)
-> PParams (LedgerEra era)
-> Const Word64 (PParams (LedgerEra era))
forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
Lens' (PParams (LedgerEra era)) Natural
L.ppCollateralPercentageL ((Natural -> Const Word64 Natural)
 -> PParams (LedgerEra era)
 -> Const Word64 (PParams (LedgerEra era)))
-> ((Word64 -> Const Word64 Word64)
    -> Natural -> Const Word64 Natural)
-> Getting Word64 (PParams (LedgerEra era)) Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Natural -> Word64) -> SimpleGetter Natural Word64
forall s a. (s -> a) -> SimpleGetter s a
to Natural -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    Proto PParams -> (Proto PParams -> Proto PParams) -> Proto PParams
forall a b. a -> (a -> b) -> b
& ASetter (Proto PParams) (Proto PParams) Word64 Word64
#maxCollateralInputs ASetter (Proto PParams) (Proto PParams) Word64 Word64
-> Word64 -> Proto PParams -> Proto PParams
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams (LedgerEra era)
pparams PParams (LedgerEra era)
-> Getting Word64 (PParams (LedgerEra era)) Word64 -> Word64
forall s a. s -> Getting a s a -> a
^. (Natural -> Const Word64 Natural)
-> PParams (LedgerEra era)
-> Const Word64 (PParams (LedgerEra era))
forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
Lens' (PParams (LedgerEra era)) Natural
L.ppMaxCollateralInputsL ((Natural -> Const Word64 Natural)
 -> PParams (LedgerEra era)
 -> Const Word64 (PParams (LedgerEra era)))
-> ((Word64 -> Const Word64 Word64)
    -> Natural -> Const Word64 Natural)
-> Getting Word64 (PParams (LedgerEra era)) Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Natural -> Word64) -> SimpleGetter Natural Word64
forall s a. (s -> a) -> SimpleGetter s a
to Natural -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    Proto PParams -> (Proto PParams -> Proto PParams) -> Proto PParams
forall a b. a -> (a -> b) -> b
& (Proto CostModels -> Identity (Proto CostModels))
-> Proto PParams -> Identity (Proto PParams)
#costModels ((Proto CostModels -> Identity (Proto CostModels))
 -> Proto PParams -> Identity (Proto PParams))
-> (([Int64] -> Identity [Int64])
    -> Proto CostModels -> Identity (Proto CostModels))
-> ([Int64] -> Identity [Int64])
-> Proto PParams
-> Identity (Proto PParams)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Proto CostModel -> Identity (Proto CostModel))
-> Proto CostModels -> Identity (Proto CostModels)
#plutusV1 ((Proto CostModel -> Identity (Proto CostModel))
 -> Proto CostModels -> Identity (Proto CostModels))
-> (([Int64] -> Identity [Int64])
    -> Proto CostModel -> Identity (Proto CostModel))
-> ([Int64] -> Identity [Int64])
-> Proto CostModels
-> Identity (Proto CostModels)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Int64] -> Identity [Int64])
-> Proto CostModel -> Identity (Proto CostModel)
#values (([Int64] -> Identity [Int64])
 -> Proto PParams -> Identity (Proto PParams))
-> [Int64] -> Proto PParams -> Proto PParams
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ([[Int64]] -> [Int64]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[Int64]] -> [Int64])
-> (Maybe [Int64] -> [[Int64]]) -> Maybe [Int64] -> [Int64]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [Int64] -> [[Int64]]
forall a. Maybe a -> [a]
maybeToList) (Language -> Map Language [Int64] -> Maybe [Int64]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Language
L.PlutusV1 Map Language [Int64]
pparamsCostModels)
    Proto PParams -> (Proto PParams -> Proto PParams) -> Proto PParams
forall a b. a -> (a -> b) -> b
& (Proto CostModels -> Identity (Proto CostModels))
-> Proto PParams -> Identity (Proto PParams)
#costModels ((Proto CostModels -> Identity (Proto CostModels))
 -> Proto PParams -> Identity (Proto PParams))
-> (([Int64] -> Identity [Int64])
    -> Proto CostModels -> Identity (Proto CostModels))
-> ([Int64] -> Identity [Int64])
-> Proto PParams
-> Identity (Proto PParams)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Proto CostModel -> Identity (Proto CostModel))
-> Proto CostModels -> Identity (Proto CostModels)
#plutusV2 ((Proto CostModel -> Identity (Proto CostModel))
 -> Proto CostModels -> Identity (Proto CostModels))
-> (([Int64] -> Identity [Int64])
    -> Proto CostModel -> Identity (Proto CostModel))
-> ([Int64] -> Identity [Int64])
-> Proto CostModels
-> Identity (Proto CostModels)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Int64] -> Identity [Int64])
-> Proto CostModel -> Identity (Proto CostModel)
#values (([Int64] -> Identity [Int64])
 -> Proto PParams -> Identity (Proto PParams))
-> [Int64] -> Proto PParams -> Proto PParams
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ([[Int64]] -> [Int64]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[Int64]] -> [Int64])
-> (Maybe [Int64] -> [[Int64]]) -> Maybe [Int64] -> [Int64]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [Int64] -> [[Int64]]
forall a. Maybe a -> [a]
maybeToList) (Language -> Map Language [Int64] -> Maybe [Int64]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Language
L.PlutusV2 Map Language [Int64]
pparamsCostModels)
    Proto PParams -> (Proto PParams -> Proto PParams) -> Proto PParams
forall a b. a -> (a -> b) -> b
& (Proto CostModels -> Identity (Proto CostModels))
-> Proto PParams -> Identity (Proto PParams)
#costModels ((Proto CostModels -> Identity (Proto CostModels))
 -> Proto PParams -> Identity (Proto PParams))
-> (([Int64] -> Identity [Int64])
    -> Proto CostModels -> Identity (Proto CostModels))
-> ([Int64] -> Identity [Int64])
-> Proto PParams
-> Identity (Proto PParams)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Proto CostModel -> Identity (Proto CostModel))
-> Proto CostModels -> Identity (Proto CostModels)
#plutusV3 ((Proto CostModel -> Identity (Proto CostModel))
 -> Proto CostModels -> Identity (Proto CostModels))
-> (([Int64] -> Identity [Int64])
    -> Proto CostModel -> Identity (Proto CostModel))
-> ([Int64] -> Identity [Int64])
-> Proto CostModels
-> Identity (Proto CostModels)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Int64] -> Identity [Int64])
-> Proto CostModel -> Identity (Proto CostModel)
#values (([Int64] -> Identity [Int64])
 -> Proto PParams -> Identity (Proto PParams))
-> [Int64] -> Proto PParams -> Proto PParams
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ([[Int64]] -> [Int64]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[Int64]] -> [Int64])
-> (Maybe [Int64] -> [[Int64]]) -> Maybe [Int64] -> [Int64]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [Int64] -> [[Int64]]
forall a. Maybe a -> [a]
maybeToList) (Language -> Map Language [Int64] -> Maybe [Int64]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Language
L.PlutusV3 Map Language [Int64]
pparamsCostModels)
    Proto PParams -> (Proto PParams -> Proto PParams) -> Proto PParams
forall a b. a -> (a -> b) -> b
& (Proto CostModels -> Identity (Proto CostModels))
-> Proto PParams -> Identity (Proto PParams)
#costModels ((Proto CostModels -> Identity (Proto CostModels))
 -> Proto PParams -> Identity (Proto PParams))
-> (([Int64] -> Identity [Int64])
    -> Proto CostModels -> Identity (Proto CostModels))
-> ([Int64] -> Identity [Int64])
-> Proto PParams
-> Identity (Proto PParams)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Proto CostModel -> Identity (Proto CostModel))
-> Proto CostModels -> Identity (Proto CostModels)
#plutusV4 ((Proto CostModel -> Identity (Proto CostModel))
 -> Proto CostModels -> Identity (Proto CostModels))
-> (([Int64] -> Identity [Int64])
    -> Proto CostModel -> Identity (Proto CostModel))
-> ([Int64] -> Identity [Int64])
-> Proto CostModels
-> Identity (Proto CostModels)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Int64] -> Identity [Int64])
-> Proto CostModel -> Identity (Proto CostModel)
#values (([Int64] -> Identity [Int64])
 -> Proto PParams -> Identity (Proto PParams))
-> [Int64] -> Proto PParams -> Proto PParams
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ([[Int64]] -> [Int64]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[Int64]] -> [Int64])
-> (Maybe [Int64] -> [[Int64]]) -> Maybe [Int64] -> [Int64]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [Int64] -> [[Int64]]
forall a. Maybe a -> [a]
maybeToList) (Language -> Map Language [Int64] -> Maybe [Int64]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Language
L.PlutusV4 Map Language [Int64]
pparamsCostModels)
    Proto PParams -> (Proto PParams -> Proto PParams) -> Proto PParams
forall a b. a -> (a -> b) -> b
& (Proto ExPrices -> Identity (Proto ExPrices))
-> Proto PParams -> Identity (Proto PParams)
#prices ((Proto ExPrices -> Identity (Proto ExPrices))
 -> Proto PParams -> Identity (Proto PParams))
-> ((Proto RationalNumber -> Identity (Proto RationalNumber))
    -> Proto ExPrices -> Identity (Proto ExPrices))
-> ASetter
     (Proto PParams)
     (Proto PParams)
     (Proto RationalNumber)
     (Proto RationalNumber)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Proto RationalNumber -> Identity (Proto RationalNumber))
-> Proto ExPrices -> Identity (Proto ExPrices)
#steps ASetter
  (Proto PParams)
  (Proto PParams)
  (Proto RationalNumber)
  (Proto RationalNumber)
-> Proto RationalNumber -> Proto PParams -> Proto PParams
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams (LedgerEra era)
pparams PParams (LedgerEra era)
-> Getting
     (Proto RationalNumber)
     (PParams (LedgerEra era))
     (Proto RationalNumber)
-> Proto RationalNumber
forall s a. s -> Getting a s a -> a
^. (Prices -> Const (Proto RationalNumber) Prices)
-> PParams (LedgerEra era)
-> Const (Proto RationalNumber) (PParams (LedgerEra era))
forall era. AlonzoEraPParams era => Lens' (PParams era) Prices
Lens' (PParams (LedgerEra era)) Prices
L.ppPricesL ((Prices -> Const (Proto RationalNumber) Prices)
 -> PParams (LedgerEra era)
 -> Const (Proto RationalNumber) (PParams (LedgerEra era)))
-> ((Proto RationalNumber
     -> Const (Proto RationalNumber) (Proto RationalNumber))
    -> Prices -> Const (Proto RationalNumber) Prices)
-> Getting
     (Proto RationalNumber)
     (PParams (LedgerEra era))
     (Proto RationalNumber)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Prices -> NonNegativeInterval)
-> SimpleGetter Prices NonNegativeInterval
forall s a. (s -> a) -> SimpleGetter s a
to Prices -> NonNegativeInterval
L.prSteps Getting (Proto RationalNumber) Prices NonNegativeInterval
-> ((Proto RationalNumber
     -> Const (Proto RationalNumber) (Proto RationalNumber))
    -> NonNegativeInterval
    -> Const (Proto RationalNumber) NonNegativeInterval)
-> (Proto RationalNumber
    -> Const (Proto RationalNumber) (Proto RationalNumber))
-> Prices
-> Const (Proto RationalNumber) Prices
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonNegativeInterval -> Rational)
-> SimpleGetter NonNegativeInterval Rational
forall s a. (s -> a) -> SimpleGetter s a
to NonNegativeInterval -> Rational
forall r. BoundedRational r => r -> Rational
L.unboundRational Getting (Proto RationalNumber) NonNegativeInterval Rational
-> ((Proto RationalNumber
     -> Const (Proto RationalNumber) (Proto RationalNumber))
    -> Rational -> Const (Proto RationalNumber) Rational)
-> (Proto RationalNumber
    -> Const (Proto RationalNumber) (Proto RationalNumber))
-> NonNegativeInterval
-> Const (Proto RationalNumber) NonNegativeInterval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Proto RationalNumber)
-> SimpleGetter Rational (Proto RationalNumber)
forall s a. (s -> a) -> SimpleGetter s a
to Rational -> Proto RationalNumber
forall t s. Inject t s => t -> s
inject
    Proto PParams -> (Proto PParams -> Proto PParams) -> Proto PParams
forall a b. a -> (a -> b) -> b
& (Proto ExPrices -> Identity (Proto ExPrices))
-> Proto PParams -> Identity (Proto PParams)
#prices ((Proto ExPrices -> Identity (Proto ExPrices))
 -> Proto PParams -> Identity (Proto PParams))
-> ((Proto RationalNumber -> Identity (Proto RationalNumber))
    -> Proto ExPrices -> Identity (Proto ExPrices))
-> ASetter
     (Proto PParams)
     (Proto PParams)
     (Proto RationalNumber)
     (Proto RationalNumber)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Proto RationalNumber -> Identity (Proto RationalNumber))
-> Proto ExPrices -> Identity (Proto ExPrices)
#memory ASetter
  (Proto PParams)
  (Proto PParams)
  (Proto RationalNumber)
  (Proto RationalNumber)
-> Proto RationalNumber -> Proto PParams -> Proto PParams
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams (LedgerEra era)
pparams PParams (LedgerEra era)
-> Getting
     (Proto RationalNumber)
     (PParams (LedgerEra era))
     (Proto RationalNumber)
-> Proto RationalNumber
forall s a. s -> Getting a s a -> a
^. (Prices -> Const (Proto RationalNumber) Prices)
-> PParams (LedgerEra era)
-> Const (Proto RationalNumber) (PParams (LedgerEra era))
forall era. AlonzoEraPParams era => Lens' (PParams era) Prices
Lens' (PParams (LedgerEra era)) Prices
L.ppPricesL ((Prices -> Const (Proto RationalNumber) Prices)
 -> PParams (LedgerEra era)
 -> Const (Proto RationalNumber) (PParams (LedgerEra era)))
-> ((Proto RationalNumber
     -> Const (Proto RationalNumber) (Proto RationalNumber))
    -> Prices -> Const (Proto RationalNumber) Prices)
-> Getting
     (Proto RationalNumber)
     (PParams (LedgerEra era))
     (Proto RationalNumber)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Prices -> NonNegativeInterval)
-> SimpleGetter Prices NonNegativeInterval
forall s a. (s -> a) -> SimpleGetter s a
to Prices -> NonNegativeInterval
L.prMem Getting (Proto RationalNumber) Prices NonNegativeInterval
-> ((Proto RationalNumber
     -> Const (Proto RationalNumber) (Proto RationalNumber))
    -> NonNegativeInterval
    -> Const (Proto RationalNumber) NonNegativeInterval)
-> (Proto RationalNumber
    -> Const (Proto RationalNumber) (Proto RationalNumber))
-> Prices
-> Const (Proto RationalNumber) Prices
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonNegativeInterval -> Rational)
-> SimpleGetter NonNegativeInterval Rational
forall s a. (s -> a) -> SimpleGetter s a
to NonNegativeInterval -> Rational
forall r. BoundedRational r => r -> Rational
L.unboundRational Getting (Proto RationalNumber) NonNegativeInterval Rational
-> ((Proto RationalNumber
     -> Const (Proto RationalNumber) (Proto RationalNumber))
    -> Rational -> Const (Proto RationalNumber) Rational)
-> (Proto RationalNumber
    -> Const (Proto RationalNumber) (Proto RationalNumber))
-> NonNegativeInterval
-> Const (Proto RationalNumber) NonNegativeInterval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Proto RationalNumber)
-> SimpleGetter Rational (Proto RationalNumber)
forall s a. (s -> a) -> SimpleGetter s a
to Rational -> Proto RationalNumber
forall t s. Inject t s => t -> s
inject
    Proto PParams -> (Proto PParams -> Proto PParams) -> Proto PParams
forall a b. a -> (a -> b) -> b
& ASetter
  (Proto PParams) (Proto PParams) (Proto ExUnits) (Proto ExUnits)
#maxExecutionUnitsPerTransaction ASetter
  (Proto PParams) (Proto PParams) (Proto ExUnits) (Proto ExUnits)
-> Proto ExUnits -> Proto PParams -> Proto PParams
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams (LedgerEra era)
pparams PParams (LedgerEra era)
-> Getting
     (Proto ExUnits) (PParams (LedgerEra era)) (Proto ExUnits)
-> Proto ExUnits
forall s a. s -> Getting a s a -> a
^. (ExUnits -> Const (Proto ExUnits) ExUnits)
-> PParams (LedgerEra era)
-> Const (Proto ExUnits) (PParams (LedgerEra era))
forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
Lens' (PParams (LedgerEra era)) ExUnits
L.ppMaxTxExUnitsL ((ExUnits -> Const (Proto ExUnits) ExUnits)
 -> PParams (LedgerEra era)
 -> Const (Proto ExUnits) (PParams (LedgerEra era)))
-> ((Proto ExUnits -> Const (Proto ExUnits) (Proto ExUnits))
    -> ExUnits -> Const (Proto ExUnits) ExUnits)
-> Getting
     (Proto ExUnits) (PParams (LedgerEra era)) (Proto ExUnits)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExUnits -> Proto ExUnits) -> SimpleGetter ExUnits (Proto ExUnits)
forall s a. (s -> a) -> SimpleGetter s a
to ExUnits -> Proto ExUnits
forall t s. Inject t s => t -> s
inject
    Proto PParams -> (Proto PParams -> Proto PParams) -> Proto PParams
forall a b. a -> (a -> b) -> b
& ASetter
  (Proto PParams) (Proto PParams) (Proto ExUnits) (Proto ExUnits)
#maxExecutionUnitsPerBlock ASetter
  (Proto PParams) (Proto PParams) (Proto ExUnits) (Proto ExUnits)
-> Proto ExUnits -> Proto PParams -> Proto PParams
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams (LedgerEra era)
pparams PParams (LedgerEra era)
-> Getting
     (Proto ExUnits) (PParams (LedgerEra era)) (Proto ExUnits)
-> Proto ExUnits
forall s a. s -> Getting a s a -> a
^. (ExUnits -> Const (Proto ExUnits) ExUnits)
-> PParams (LedgerEra era)
-> Const (Proto ExUnits) (PParams (LedgerEra era))
forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
Lens' (PParams (LedgerEra era)) ExUnits
L.ppMaxBlockExUnitsL ((ExUnits -> Const (Proto ExUnits) ExUnits)
 -> PParams (LedgerEra era)
 -> Const (Proto ExUnits) (PParams (LedgerEra era)))
-> ((Proto ExUnits -> Const (Proto ExUnits) (Proto ExUnits))
    -> ExUnits -> Const (Proto ExUnits) ExUnits)
-> Getting
     (Proto ExUnits) (PParams (LedgerEra era)) (Proto ExUnits)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExUnits -> Proto ExUnits) -> SimpleGetter ExUnits (Proto ExUnits)
forall s a. (s -> a) -> SimpleGetter s a
to ExUnits -> Proto ExUnits
forall t s. Inject t s => t -> s
inject
    Proto PParams -> (Proto PParams -> Proto PParams) -> Proto PParams
forall a b. a -> (a -> b) -> b
& ASetter
  (Proto PParams)
  (Proto PParams)
  (Proto RationalNumber)
  (Proto RationalNumber)
#minFeeScriptRefCostPerByte
      ASetter
  (Proto PParams)
  (Proto PParams)
  (Proto RationalNumber)
  (Proto RationalNumber)
-> Proto RationalNumber -> Proto PParams -> Proto PParams
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams (LedgerEra era)
pparams PParams (LedgerEra era)
-> Getting
     (Proto RationalNumber)
     (PParams (LedgerEra era))
     (Proto RationalNumber)
-> Proto RationalNumber
forall s a. s -> Getting a s a -> a
^. (NonNegativeInterval
 -> Const (Proto RationalNumber) NonNegativeInterval)
-> PParams (LedgerEra era)
-> Const (Proto RationalNumber) (PParams (LedgerEra era))
forall era.
ConwayEraPParams era =>
Lens' (PParams era) NonNegativeInterval
Lens' (PParams (LedgerEra era)) NonNegativeInterval
L.ppMinFeeRefScriptCostPerByteL ((NonNegativeInterval
  -> Const (Proto RationalNumber) NonNegativeInterval)
 -> PParams (LedgerEra era)
 -> Const (Proto RationalNumber) (PParams (LedgerEra era)))
-> ((Proto RationalNumber
     -> Const (Proto RationalNumber) (Proto RationalNumber))
    -> NonNegativeInterval
    -> Const (Proto RationalNumber) NonNegativeInterval)
-> Getting
     (Proto RationalNumber)
     (PParams (LedgerEra era))
     (Proto RationalNumber)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonNegativeInterval -> Rational)
-> SimpleGetter NonNegativeInterval Rational
forall s a. (s -> a) -> SimpleGetter s a
to NonNegativeInterval -> Rational
forall r. BoundedRational r => r -> Rational
L.unboundRational Getting (Proto RationalNumber) NonNegativeInterval Rational
-> ((Proto RationalNumber
     -> Const (Proto RationalNumber) (Proto RationalNumber))
    -> Rational -> Const (Proto RationalNumber) Rational)
-> (Proto RationalNumber
    -> Const (Proto RationalNumber) (Proto RationalNumber))
-> NonNegativeInterval
-> Const (Proto RationalNumber) NonNegativeInterval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Proto RationalNumber)
-> SimpleGetter Rational (Proto RationalNumber)
forall s a. (s -> a) -> SimpleGetter s a
to Rational -> Proto RationalNumber
forall t s. Inject t s => t -> s
inject
    Proto PParams -> (Proto PParams -> Proto PParams) -> Proto PParams
forall a b. a -> (a -> b) -> b
& (Proto VotingThresholds -> Identity (Proto VotingThresholds))
-> Proto PParams -> Identity (Proto PParams)
#poolVotingThresholds ((Proto VotingThresholds -> Identity (Proto VotingThresholds))
 -> Proto PParams -> Identity (Proto PParams))
-> (([Proto RationalNumber] -> Identity [Proto RationalNumber])
    -> Proto VotingThresholds -> Identity (Proto VotingThresholds))
-> ([Proto RationalNumber] -> Identity [Proto RationalNumber])
-> Proto PParams
-> Identity (Proto PParams)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Proto RationalNumber] -> Identity [Proto RationalNumber])
-> Proto VotingThresholds -> Identity (Proto VotingThresholds)
#thresholds
      (([Proto RationalNumber] -> Identity [Proto RationalNumber])
 -> Proto PParams -> Identity (Proto PParams))
-> [Proto RationalNumber] -> Proto PParams -> Proto PParams
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ( Rational -> Proto RationalNumber
forall t s. Inject t s => t -> s
inject (Rational -> Proto RationalNumber)
-> (UnitInterval -> Rational)
-> UnitInterval
-> Proto RationalNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitInterval -> Rational
forall r. BoundedRational r => r -> Rational
L.unboundRational
             -- order taken from https://github.com/cardano-foundation/CIPs/blob/acb4b2348c968003dfc370cd3769615bfca1f159/CIP-1694/README.md#requirements
             (UnitInterval -> Proto RationalNumber)
-> [UnitInterval] -> [Proto RationalNumber]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ PoolVotingThresholds
poolVotingThresholds PoolVotingThresholds
-> Getting UnitInterval PoolVotingThresholds UnitInterval
-> UnitInterval
forall s a. s -> Getting a s a -> a
^. Getting UnitInterval PoolVotingThresholds UnitInterval
Lens' PoolVotingThresholds UnitInterval
L.pvtMotionNoConfidenceL
                 , PoolVotingThresholds
poolVotingThresholds PoolVotingThresholds
-> Getting UnitInterval PoolVotingThresholds UnitInterval
-> UnitInterval
forall s a. s -> Getting a s a -> a
^. Getting UnitInterval PoolVotingThresholds UnitInterval
Lens' PoolVotingThresholds UnitInterval
L.pvtCommitteeNormalL
                 , PoolVotingThresholds
poolVotingThresholds PoolVotingThresholds
-> Getting UnitInterval PoolVotingThresholds UnitInterval
-> UnitInterval
forall s a. s -> Getting a s a -> a
^. Getting UnitInterval PoolVotingThresholds UnitInterval
Lens' PoolVotingThresholds UnitInterval
L.pvtCommitteeNoConfidenceL
                 , PoolVotingThresholds
poolVotingThresholds PoolVotingThresholds
-> Getting UnitInterval PoolVotingThresholds UnitInterval
-> UnitInterval
forall s a. s -> Getting a s a -> a
^. Getting UnitInterval PoolVotingThresholds UnitInterval
Lens' PoolVotingThresholds UnitInterval
L.pvtHardForkInitiationL
                 , PoolVotingThresholds
poolVotingThresholds PoolVotingThresholds
-> Getting UnitInterval PoolVotingThresholds UnitInterval
-> UnitInterval
forall s a. s -> Getting a s a -> a
^. Getting UnitInterval PoolVotingThresholds UnitInterval
Lens' PoolVotingThresholds UnitInterval
L.pvtPPSecurityGroupL
                 ]
         )
    Proto PParams -> (Proto PParams -> Proto PParams) -> Proto PParams
forall a b. a -> (a -> b) -> b
& (Proto VotingThresholds -> Identity (Proto VotingThresholds))
-> Proto PParams -> Identity (Proto PParams)
#drepVotingThresholds ((Proto VotingThresholds -> Identity (Proto VotingThresholds))
 -> Proto PParams -> Identity (Proto PParams))
-> (([Proto RationalNumber] -> Identity [Proto RationalNumber])
    -> Proto VotingThresholds -> Identity (Proto VotingThresholds))
-> ([Proto RationalNumber] -> Identity [Proto RationalNumber])
-> Proto PParams
-> Identity (Proto PParams)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Proto RationalNumber] -> Identity [Proto RationalNumber])
-> Proto VotingThresholds -> Identity (Proto VotingThresholds)
#thresholds
      (([Proto RationalNumber] -> Identity [Proto RationalNumber])
 -> Proto PParams -> Identity (Proto PParams))
-> [Proto RationalNumber] -> Proto PParams -> Proto PParams
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ( Rational -> Proto RationalNumber
forall t s. Inject t s => t -> s
inject (Rational -> Proto RationalNumber)
-> (UnitInterval -> Rational)
-> UnitInterval
-> Proto RationalNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitInterval -> Rational
forall r. BoundedRational r => r -> Rational
L.unboundRational
             -- order taken from https://github.com/cardano-foundation/CIPs/blob/acb4b2348c968003dfc370cd3769615bfca1f159/CIP-1694/README.md#requirements
             (UnitInterval -> Proto RationalNumber)
-> [UnitInterval] -> [Proto RationalNumber]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ DRepVotingThresholds
drepVotingThresholds DRepVotingThresholds
-> Getting UnitInterval DRepVotingThresholds UnitInterval
-> UnitInterval
forall s a. s -> Getting a s a -> a
^. Getting UnitInterval DRepVotingThresholds UnitInterval
Lens' DRepVotingThresholds UnitInterval
L.dvtMotionNoConfidenceL
                 , DRepVotingThresholds
drepVotingThresholds DRepVotingThresholds
-> Getting UnitInterval DRepVotingThresholds UnitInterval
-> UnitInterval
forall s a. s -> Getting a s a -> a
^. Getting UnitInterval DRepVotingThresholds UnitInterval
Lens' DRepVotingThresholds UnitInterval
L.dvtCommitteeNormalL
                 , DRepVotingThresholds
drepVotingThresholds DRepVotingThresholds
-> Getting UnitInterval DRepVotingThresholds UnitInterval
-> UnitInterval
forall s a. s -> Getting a s a -> a
^. Getting UnitInterval DRepVotingThresholds UnitInterval
Lens' DRepVotingThresholds UnitInterval
L.dvtCommitteeNoConfidenceL
                 , DRepVotingThresholds
drepVotingThresholds DRepVotingThresholds
-> Getting UnitInterval DRepVotingThresholds UnitInterval
-> UnitInterval
forall s a. s -> Getting a s a -> a
^. Getting UnitInterval DRepVotingThresholds UnitInterval
Lens' DRepVotingThresholds UnitInterval
L.dvtUpdateToConstitutionL
                 , DRepVotingThresholds
drepVotingThresholds DRepVotingThresholds
-> Getting UnitInterval DRepVotingThresholds UnitInterval
-> UnitInterval
forall s a. s -> Getting a s a -> a
^. Getting UnitInterval DRepVotingThresholds UnitInterval
Lens' DRepVotingThresholds UnitInterval
L.dvtHardForkInitiationL
                 , DRepVotingThresholds
drepVotingThresholds DRepVotingThresholds
-> Getting UnitInterval DRepVotingThresholds UnitInterval
-> UnitInterval
forall s a. s -> Getting a s a -> a
^. Getting UnitInterval DRepVotingThresholds UnitInterval
Lens' DRepVotingThresholds UnitInterval
L.dvtPPNetworkGroupL
                 , DRepVotingThresholds
drepVotingThresholds DRepVotingThresholds
-> Getting UnitInterval DRepVotingThresholds UnitInterval
-> UnitInterval
forall s a. s -> Getting a s a -> a
^. Getting UnitInterval DRepVotingThresholds UnitInterval
Lens' DRepVotingThresholds UnitInterval
L.dvtPPEconomicGroupL
                 , DRepVotingThresholds
drepVotingThresholds DRepVotingThresholds
-> Getting UnitInterval DRepVotingThresholds UnitInterval
-> UnitInterval
forall s a. s -> Getting a s a -> a
^. Getting UnitInterval DRepVotingThresholds UnitInterval
Lens' DRepVotingThresholds UnitInterval
L.dvtPPTechnicalGroupL
                 , DRepVotingThresholds
drepVotingThresholds DRepVotingThresholds
-> Getting UnitInterval DRepVotingThresholds UnitInterval
-> UnitInterval
forall s a. s -> Getting a s a -> a
^. Getting UnitInterval DRepVotingThresholds UnitInterval
Lens' DRepVotingThresholds UnitInterval
L.dvtPPGovGroupL
                 , DRepVotingThresholds
drepVotingThresholds DRepVotingThresholds
-> Getting UnitInterval DRepVotingThresholds UnitInterval
-> UnitInterval
forall s a. s -> Getting a s a -> a
^. Getting UnitInterval DRepVotingThresholds UnitInterval
Lens' DRepVotingThresholds UnitInterval
L.dvtTreasuryWithdrawalL
                 ]
         )
    Proto PParams -> (Proto PParams -> Proto PParams) -> Proto PParams
forall a b. a -> (a -> b) -> b
& ASetter (Proto PParams) (Proto PParams) Word32 Word32
#minCommitteeSize ASetter (Proto PParams) (Proto PParams) Word32 Word32
-> Word32 -> Proto PParams -> Proto PParams
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams (LedgerEra era)
pparams PParams (LedgerEra era)
-> Getting Word32 (PParams (LedgerEra era)) Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. (Natural -> Const Word32 Natural)
-> PParams (LedgerEra era)
-> Const Word32 (PParams (LedgerEra era))
forall era. ConwayEraPParams era => Lens' (PParams era) Natural
Lens' (PParams (LedgerEra era)) Natural
L.ppCommitteeMinSizeL ((Natural -> Const Word32 Natural)
 -> PParams (LedgerEra era)
 -> Const Word32 (PParams (LedgerEra era)))
-> ((Word32 -> Const Word32 Word32)
    -> Natural -> Const Word32 Natural)
-> Getting Word32 (PParams (LedgerEra era)) Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Natural -> Word32) -> SimpleGetter Natural Word32
forall s a. (s -> a) -> SimpleGetter s a
to Natural -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    Proto PParams -> (Proto PParams -> Proto PParams) -> Proto PParams
forall a b. a -> (a -> b) -> b
& ASetter (Proto PParams) (Proto PParams) Word64 Word64
#committeeTermLimit
      ASetter (Proto PParams) (Proto PParams) Word64 Word64
-> Word64 -> Proto PParams -> Proto PParams
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams (LedgerEra era)
pparams PParams (LedgerEra era)
-> Getting Word64 (PParams (LedgerEra era)) Word64 -> Word64
forall s a. s -> Getting a s a -> a
^. (EpochInterval -> Const Word64 EpochInterval)
-> PParams (LedgerEra era)
-> Const Word64 (PParams (LedgerEra era))
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams (LedgerEra era)) EpochInterval
L.ppCommitteeMaxTermLengthL ((EpochInterval -> Const Word64 EpochInterval)
 -> PParams (LedgerEra era)
 -> Const Word64 (PParams (LedgerEra era)))
-> ((Word64 -> Const Word64 Word64)
    -> EpochInterval -> Const Word64 EpochInterval)
-> Getting Word64 (PParams (LedgerEra era)) Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EpochInterval -> Word32) -> SimpleGetter EpochInterval Word32
forall s a. (s -> a) -> SimpleGetter s a
to EpochInterval -> Word32
L.unEpochInterval Getting Word64 EpochInterval Word32
-> ((Word64 -> Const Word64 Word64)
    -> Word32 -> Const Word64 Word32)
-> (Word64 -> Const Word64 Word64)
-> EpochInterval
-> Const Word64 EpochInterval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Word64) -> SimpleGetter Word32 Word64
forall s a. (s -> a) -> SimpleGetter s a
to Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    Proto PParams -> (Proto PParams -> Proto PParams) -> Proto PParams
forall a b. a -> (a -> b) -> b
& ASetter (Proto PParams) (Proto PParams) Word64 Word64
#governanceActionValidityPeriod
      ASetter (Proto PParams) (Proto PParams) Word64 Word64
-> Word64 -> Proto PParams -> Proto PParams
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams (LedgerEra era)
pparams PParams (LedgerEra era)
-> Getting Word64 (PParams (LedgerEra era)) Word64 -> Word64
forall s a. s -> Getting a s a -> a
^. (EpochInterval -> Const Word64 EpochInterval)
-> PParams (LedgerEra era)
-> Const Word64 (PParams (LedgerEra era))
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams (LedgerEra era)) EpochInterval
L.ppGovActionLifetimeL ((EpochInterval -> Const Word64 EpochInterval)
 -> PParams (LedgerEra era)
 -> Const Word64 (PParams (LedgerEra era)))
-> ((Word64 -> Const Word64 Word64)
    -> EpochInterval -> Const Word64 EpochInterval)
-> Getting Word64 (PParams (LedgerEra era)) Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EpochInterval -> Word32) -> SimpleGetter EpochInterval Word32
forall s a. (s -> a) -> SimpleGetter s a
to EpochInterval -> Word32
L.unEpochInterval Getting Word64 EpochInterval Word32
-> ((Word64 -> Const Word64 Word64)
    -> Word32 -> Const Word64 Word32)
-> (Word64 -> Const Word64 Word64)
-> EpochInterval
-> Const Word64 EpochInterval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Word64) -> SimpleGetter Word32 Word64
forall s a. (s -> a) -> SimpleGetter s a
to Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    Proto PParams -> (Proto PParams -> Proto PParams) -> Proto PParams
forall a b. a -> (a -> b) -> b
& ASetter (Proto PParams) (Proto PParams) Word64 Word64
#governanceActionDeposit ASetter (Proto PParams) (Proto PParams) Word64 Word64
-> Word64 -> Proto PParams -> Proto PParams
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams (LedgerEra era)
pparams PParams (LedgerEra era)
-> Getting Word64 (PParams (LedgerEra era)) Word64 -> Word64
forall s a. s -> Getting a s a -> a
^. (Coin -> Const Word64 Coin)
-> PParams (LedgerEra era)
-> Const Word64 (PParams (LedgerEra era))
forall era. ConwayEraPParams era => Lens' (PParams era) Coin
Lens' (PParams (LedgerEra era)) Coin
L.ppGovActionDepositL ((Coin -> Const Word64 Coin)
 -> PParams (LedgerEra era)
 -> Const Word64 (PParams (LedgerEra era)))
-> ((Word64 -> Const Word64 Word64) -> Coin -> Const Word64 Coin)
-> Getting Word64 (PParams (LedgerEra era)) Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Word64) -> SimpleGetter Coin Word64
forall s a. (s -> a) -> SimpleGetter s a
to Coin -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    Proto PParams -> (Proto PParams -> Proto PParams) -> Proto PParams
forall a b. a -> (a -> b) -> b
& ASetter (Proto PParams) (Proto PParams) Word64 Word64
#drepDeposit ASetter (Proto PParams) (Proto PParams) Word64 Word64
-> Word64 -> Proto PParams -> Proto PParams
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams (LedgerEra era)
pparams PParams (LedgerEra era)
-> Getting Word64 (PParams (LedgerEra era)) Word64 -> Word64
forall s a. s -> Getting a s a -> a
^. (Coin -> Const Word64 Coin)
-> PParams (LedgerEra era)
-> Const Word64 (PParams (LedgerEra era))
forall era. ConwayEraPParams era => Lens' (PParams era) Coin
Lens' (PParams (LedgerEra era)) Coin
L.ppDRepDepositL ((Coin -> Const Word64 Coin)
 -> PParams (LedgerEra era)
 -> Const Word64 (PParams (LedgerEra era)))
-> ((Word64 -> Const Word64 Word64) -> Coin -> Const Word64 Coin)
-> Getting Word64 (PParams (LedgerEra era)) Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Word64) -> SimpleGetter Coin Word64
forall s a. (s -> a) -> SimpleGetter s a
to Coin -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    Proto PParams -> (Proto PParams -> Proto PParams) -> Proto PParams
forall a b. a -> (a -> b) -> b
& ASetter (Proto PParams) (Proto PParams) Word64 Word64
#drepInactivityPeriod ASetter (Proto PParams) (Proto PParams) Word64 Word64
-> Word64 -> Proto PParams -> Proto PParams
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams (LedgerEra era)
pparams PParams (LedgerEra era)
-> Getting Word64 (PParams (LedgerEra era)) Word64 -> Word64
forall s a. s -> Getting a s a -> a
^. (EpochInterval -> Const Word64 EpochInterval)
-> PParams (LedgerEra era)
-> Const Word64 (PParams (LedgerEra era))
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams (LedgerEra era)) EpochInterval
L.ppDRepActivityL ((EpochInterval -> Const Word64 EpochInterval)
 -> PParams (LedgerEra era)
 -> Const Word64 (PParams (LedgerEra era)))
-> ((Word64 -> Const Word64 Word64)
    -> EpochInterval -> Const Word64 EpochInterval)
-> Getting Word64 (PParams (LedgerEra era)) Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EpochInterval -> Word32) -> SimpleGetter EpochInterval Word32
forall s a. (s -> a) -> SimpleGetter s a
to EpochInterval -> Word32
L.unEpochInterval Getting Word64 EpochInterval Word32
-> ((Word64 -> Const Word64 Word64)
    -> Word32 -> Const Word64 Word32)
-> (Word64 -> Const Word64 Word64)
-> EpochInterval
-> Const Word64 EpochInterval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Word64) -> SimpleGetter Word32 Word64
forall s a. (s -> a) -> SimpleGetter s a
to Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

utxoRpcPParamsToProtocolParams
  :: Era era
  -> Proto UtxoRpc.PParams
  -> Either String (L.PParams (ShelleyLedgerEra era))
utxoRpcPParamsToProtocolParams :: forall era.
Era era
-> Proto PParams -> Either String (PParams (ShelleyLedgerEra era))
utxoRpcPParamsToProtocolParams Era era
era Proto PParams
pp = ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era =>
    Either String (PParams (ShelleyLedgerEra era)))
-> Either String (PParams (ShelleyLedgerEra era))
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints (Era era -> ConwayEraOnwards era
forall era. Era era -> ConwayEraOnwards era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
era) ((ConwayEraOnwardsConstraints era =>
  Either String (PParams (ShelleyLedgerEra era)))
 -> Either String (PParams (ShelleyLedgerEra era)))
-> (ConwayEraOnwardsConstraints era =>
    Either String (PParams (ShelleyLedgerEra era)))
-> Either String (PParams (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$ do
  PParams (ShelleyLedgerEra era)
forall a. Default a => a
def
    PParams (ShelleyLedgerEra era)
-> (PParams (ShelleyLedgerEra era)
    -> Either String (PParams (ShelleyLedgerEra era)))
-> Either String (PParams (ShelleyLedgerEra era))
forall a b. a -> (a -> b) -> b
& [PParams (ShelleyLedgerEra era)
 -> Either String (PParams (ShelleyLedgerEra era))]
-> PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall (m :: * -> *) a. Monad m => [a -> m a] -> a -> m a
appFuns
      [ PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          (PParams (ShelleyLedgerEra era)
 -> Either String (PParams (ShelleyLedgerEra era)))
-> (PParams (ShelleyLedgerEra era)
    -> PParams (ShelleyLedgerEra era))
-> PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CoinPerByte -> Identity CoinPerByte)
-> PParams (ShelleyLedgerEra era)
-> Identity (PParams (ShelleyLedgerEra era))
forall era.
BabbageEraPParams era =>
Lens' (PParams era) CoinPerByte
Lens' (PParams (ShelleyLedgerEra era)) CoinPerByte
L.ppCoinsPerUTxOByteL ((CoinPerByte -> Identity CoinPerByte)
 -> PParams (ShelleyLedgerEra era)
 -> Identity (PParams (ShelleyLedgerEra era)))
-> CoinPerByte
-> PParams (ShelleyLedgerEra era)
-> PParams (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proto PParams
pp Proto PParams
-> Getting CoinPerByte (Proto PParams) CoinPerByte -> CoinPerByte
forall s a. s -> Getting a s a -> a
^. (Word64 -> Const CoinPerByte Word64)
-> Proto PParams -> Const CoinPerByte (Proto PParams)
#coinsPerUtxoByte ((Word64 -> Const CoinPerByte Word64)
 -> Proto PParams -> Const CoinPerByte (Proto PParams))
-> ((CoinPerByte -> Const CoinPerByte CoinPerByte)
    -> Word64 -> Const CoinPerByte Word64)
-> Getting CoinPerByte (Proto PParams) CoinPerByte
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Integer) -> SimpleGetter Word64 Integer
forall s a. (s -> a) -> SimpleGetter s a
to Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Getting CoinPerByte Word64 Integer
-> ((CoinPerByte -> Const CoinPerByte CoinPerByte)
    -> Integer -> Const CoinPerByte Integer)
-> (CoinPerByte -> Const CoinPerByte CoinPerByte)
-> Word64
-> Const CoinPerByte Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Coin) -> SimpleGetter Integer Coin
forall s a. (s -> a) -> SimpleGetter s a
to Integer -> Coin
L.Coin Getting CoinPerByte Integer Coin
-> ((CoinPerByte -> Const CoinPerByte CoinPerByte)
    -> Coin -> Const CoinPerByte Coin)
-> (CoinPerByte -> Const CoinPerByte CoinPerByte)
-> Integer
-> Const CoinPerByte Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> CoinPerByte) -> SimpleGetter Coin CoinPerByte
forall s a. (s -> a) -> SimpleGetter s a
to Coin -> CoinPerByte
L.CoinPerByte)
      , PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PParams (ShelleyLedgerEra era)
 -> Either String (PParams (ShelleyLedgerEra era)))
-> (PParams (ShelleyLedgerEra era)
    -> PParams (ShelleyLedgerEra era))
-> PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Word32 -> Identity Word32)
-> PParams (ShelleyLedgerEra era)
-> Identity (PParams (ShelleyLedgerEra era))
forall era. EraPParams era => Lens' (PParams era) Word32
Lens' (PParams (ShelleyLedgerEra era)) Word32
L.ppMaxTxSizeL ((Word32 -> Identity Word32)
 -> PParams (ShelleyLedgerEra era)
 -> Identity (PParams (ShelleyLedgerEra era)))
-> Word32
-> PParams (ShelleyLedgerEra era)
-> PParams (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proto PParams
pp Proto PParams -> Getting Word32 (Proto PParams) Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. (Word64 -> Const Word32 Word64)
-> Proto PParams -> Const Word32 (Proto PParams)
#maxTxSize ((Word64 -> Const Word32 Word64)
 -> Proto PParams -> Const Word32 (Proto PParams))
-> ((Word32 -> Const Word32 Word32)
    -> Word64 -> Const Word32 Word64)
-> Getting Word32 (Proto PParams) Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Word32) -> SimpleGetter Word64 Word32
forall s a. (s -> a) -> SimpleGetter s a
to Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
      , PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PParams (ShelleyLedgerEra era)
 -> Either String (PParams (ShelleyLedgerEra era)))
-> (PParams (ShelleyLedgerEra era)
    -> PParams (ShelleyLedgerEra era))
-> PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Coin -> Identity Coin)
-> PParams (ShelleyLedgerEra era)
-> Identity (PParams (ShelleyLedgerEra era))
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams (ShelleyLedgerEra era)) Coin
L.ppMinFeeBL ((Coin -> Identity Coin)
 -> PParams (ShelleyLedgerEra era)
 -> Identity (PParams (ShelleyLedgerEra era)))
-> Coin
-> PParams (ShelleyLedgerEra era)
-> PParams (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proto PParams
pp Proto PParams -> Getting Coin (Proto PParams) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. (Word64 -> Const Coin Word64)
-> Proto PParams -> Const Coin (Proto PParams)
#minFeeCoefficient ((Word64 -> Const Coin Word64)
 -> Proto PParams -> Const Coin (Proto PParams))
-> ((Coin -> Const Coin Coin) -> Word64 -> Const Coin Word64)
-> Getting Coin (Proto PParams) Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Coin) -> SimpleGetter Word64 Coin
forall s a. (s -> a) -> SimpleGetter s a
to Word64 -> Coin
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
      , PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PParams (ShelleyLedgerEra era)
 -> Either String (PParams (ShelleyLedgerEra era)))
-> (PParams (ShelleyLedgerEra era)
    -> PParams (ShelleyLedgerEra era))
-> PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Coin -> Identity Coin)
-> PParams (ShelleyLedgerEra era)
-> Identity (PParams (ShelleyLedgerEra era))
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams (ShelleyLedgerEra era)) Coin
L.ppMinFeeAL ((Coin -> Identity Coin)
 -> PParams (ShelleyLedgerEra era)
 -> Identity (PParams (ShelleyLedgerEra era)))
-> Coin
-> PParams (ShelleyLedgerEra era)
-> PParams (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proto PParams
pp Proto PParams -> Getting Coin (Proto PParams) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. (Word64 -> Const Coin Word64)
-> Proto PParams -> Const Coin (Proto PParams)
#minFeeConstant ((Word64 -> Const Coin Word64)
 -> Proto PParams -> Const Coin (Proto PParams))
-> ((Coin -> Const Coin Coin) -> Word64 -> Const Coin Word64)
-> Getting Coin (Proto PParams) Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Coin) -> SimpleGetter Word64 Coin
forall s a. (s -> a) -> SimpleGetter s a
to Word64 -> Coin
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
      , PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PParams (ShelleyLedgerEra era)
 -> Either String (PParams (ShelleyLedgerEra era)))
-> (PParams (ShelleyLedgerEra era)
    -> PParams (ShelleyLedgerEra era))
-> PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Word32 -> Identity Word32)
-> PParams (ShelleyLedgerEra era)
-> Identity (PParams (ShelleyLedgerEra era))
forall era. EraPParams era => Lens' (PParams era) Word32
Lens' (PParams (ShelleyLedgerEra era)) Word32
L.ppMaxBBSizeL ((Word32 -> Identity Word32)
 -> PParams (ShelleyLedgerEra era)
 -> Identity (PParams (ShelleyLedgerEra era)))
-> Word32
-> PParams (ShelleyLedgerEra era)
-> PParams (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proto PParams
pp Proto PParams -> Getting Word32 (Proto PParams) Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. (Word64 -> Const Word32 Word64)
-> Proto PParams -> Const Word32 (Proto PParams)
#maxBlockBodySize ((Word64 -> Const Word32 Word64)
 -> Proto PParams -> Const Word32 (Proto PParams))
-> ((Word32 -> Const Word32 Word32)
    -> Word64 -> Const Word32 Word64)
-> Getting Word32 (Proto PParams) Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Word32) -> SimpleGetter Word64 Word32
forall s a. (s -> a) -> SimpleGetter s a
to Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
      , PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PParams (ShelleyLedgerEra era)
 -> Either String (PParams (ShelleyLedgerEra era)))
-> (PParams (ShelleyLedgerEra era)
    -> PParams (ShelleyLedgerEra era))
-> PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Word16 -> Identity Word16)
-> PParams (ShelleyLedgerEra era)
-> Identity (PParams (ShelleyLedgerEra era))
forall era. EraPParams era => Lens' (PParams era) Word16
Lens' (PParams (ShelleyLedgerEra era)) Word16
L.ppMaxBHSizeL ((Word16 -> Identity Word16)
 -> PParams (ShelleyLedgerEra era)
 -> Identity (PParams (ShelleyLedgerEra era)))
-> Word16
-> PParams (ShelleyLedgerEra era)
-> PParams (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proto PParams
pp Proto PParams -> Getting Word16 (Proto PParams) Word16 -> Word16
forall s a. s -> Getting a s a -> a
^. (Word64 -> Const Word16 Word64)
-> Proto PParams -> Const Word16 (Proto PParams)
#maxBlockHeaderSize ((Word64 -> Const Word16 Word64)
 -> Proto PParams -> Const Word16 (Proto PParams))
-> ((Word16 -> Const Word16 Word16)
    -> Word64 -> Const Word16 Word64)
-> Getting Word16 (Proto PParams) Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Word16) -> SimpleGetter Word64 Word16
forall s a. (s -> a) -> SimpleGetter s a
to Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
      , PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PParams (ShelleyLedgerEra era)
 -> Either String (PParams (ShelleyLedgerEra era)))
-> (PParams (ShelleyLedgerEra era)
    -> PParams (ShelleyLedgerEra era))
-> PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Coin -> Identity Coin)
-> PParams (ShelleyLedgerEra era)
-> Identity (PParams (ShelleyLedgerEra era))
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams (ShelleyLedgerEra era)) Coin
L.ppKeyDepositL ((Coin -> Identity Coin)
 -> PParams (ShelleyLedgerEra era)
 -> Identity (PParams (ShelleyLedgerEra era)))
-> Coin
-> PParams (ShelleyLedgerEra era)
-> PParams (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proto PParams
pp Proto PParams -> Getting Coin (Proto PParams) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. (Word64 -> Const Coin Word64)
-> Proto PParams -> Const Coin (Proto PParams)
#stakeKeyDeposit ((Word64 -> Const Coin Word64)
 -> Proto PParams -> Const Coin (Proto PParams))
-> ((Coin -> Const Coin Coin) -> Word64 -> Const Coin Word64)
-> Getting Coin (Proto PParams) Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Coin) -> SimpleGetter Word64 Coin
forall s a. (s -> a) -> SimpleGetter s a
to Word64 -> Coin
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
      , PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PParams (ShelleyLedgerEra era)
 -> Either String (PParams (ShelleyLedgerEra era)))
-> (PParams (ShelleyLedgerEra era)
    -> PParams (ShelleyLedgerEra era))
-> PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Coin -> Identity Coin)
-> PParams (ShelleyLedgerEra era)
-> Identity (PParams (ShelleyLedgerEra era))
forall era.
(EraPParams era, HasCallStack) =>
Lens' (PParams era) Coin
Lens' (PParams (ShelleyLedgerEra era)) Coin
L.ppPoolDepositL ((Coin -> Identity Coin)
 -> PParams (ShelleyLedgerEra era)
 -> Identity (PParams (ShelleyLedgerEra era)))
-> Coin
-> PParams (ShelleyLedgerEra era)
-> PParams (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proto PParams
pp Proto PParams -> Getting Coin (Proto PParams) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. (Word64 -> Const Coin Word64)
-> Proto PParams -> Const Coin (Proto PParams)
#poolDeposit ((Word64 -> Const Coin Word64)
 -> Proto PParams -> Const Coin (Proto PParams))
-> ((Coin -> Const Coin Coin) -> Word64 -> Const Coin Word64)
-> Getting Coin (Proto PParams) Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Coin) -> SimpleGetter Word64 Coin
forall s a. (s -> a) -> SimpleGetter s a
to Word64 -> Coin
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
      , PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PParams (ShelleyLedgerEra era)
 -> Either String (PParams (ShelleyLedgerEra era)))
-> (PParams (ShelleyLedgerEra era)
    -> PParams (ShelleyLedgerEra era))
-> PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((EpochInterval -> Identity EpochInterval)
-> PParams (ShelleyLedgerEra era)
-> Identity (PParams (ShelleyLedgerEra era))
forall era. EraPParams era => Lens' (PParams era) EpochInterval
Lens' (PParams (ShelleyLedgerEra era)) EpochInterval
L.ppEMaxL ((EpochInterval -> Identity EpochInterval)
 -> PParams (ShelleyLedgerEra era)
 -> Identity (PParams (ShelleyLedgerEra era)))
-> EpochInterval
-> PParams (ShelleyLedgerEra era)
-> PParams (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proto PParams
pp Proto PParams
-> Getting EpochInterval (Proto PParams) EpochInterval
-> EpochInterval
forall s a. s -> Getting a s a -> a
^. (Word64 -> Const EpochInterval Word64)
-> Proto PParams -> Const EpochInterval (Proto PParams)
#poolRetirementEpochBound ((Word64 -> Const EpochInterval Word64)
 -> Proto PParams -> Const EpochInterval (Proto PParams))
-> ((EpochInterval -> Const EpochInterval EpochInterval)
    -> Word64 -> Const EpochInterval Word64)
-> Getting EpochInterval (Proto PParams) EpochInterval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Word32) -> SimpleGetter Word64 Word32
forall s a. (s -> a) -> SimpleGetter s a
to Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Getting EpochInterval Word64 Word32
-> ((EpochInterval -> Const EpochInterval EpochInterval)
    -> Word32 -> Const EpochInterval Word32)
-> (EpochInterval -> Const EpochInterval EpochInterval)
-> Word64
-> Const EpochInterval Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> EpochInterval) -> SimpleGetter Word32 EpochInterval
forall s a. (s -> a) -> SimpleGetter s a
to Word32 -> EpochInterval
L.EpochInterval)
      , PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PParams (ShelleyLedgerEra era)
 -> Either String (PParams (ShelleyLedgerEra era)))
-> (PParams (ShelleyLedgerEra era)
    -> PParams (ShelleyLedgerEra era))
-> PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Word16 -> Identity Word16)
-> PParams (ShelleyLedgerEra era)
-> Identity (PParams (ShelleyLedgerEra era))
forall era. EraPParams era => Lens' (PParams era) Word16
Lens' (PParams (ShelleyLedgerEra era)) Word16
L.ppNOptL ((Word16 -> Identity Word16)
 -> PParams (ShelleyLedgerEra era)
 -> Identity (PParams (ShelleyLedgerEra era)))
-> Word16
-> PParams (ShelleyLedgerEra era)
-> PParams (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proto PParams
pp Proto PParams -> Getting Word16 (Proto PParams) Word16 -> Word16
forall s a. s -> Getting a s a -> a
^. (Word64 -> Const Word16 Word64)
-> Proto PParams -> Const Word16 (Proto PParams)
#desiredNumberOfPools ((Word64 -> Const Word16 Word64)
 -> Proto PParams -> Const Word16 (Proto PParams))
-> ((Word16 -> Const Word16 Word16)
    -> Word64 -> Const Word16 Word64)
-> Getting Word16 (Proto PParams) Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Word16) -> SimpleGetter Word64 Word16
forall s a. (s -> a) -> SimpleGetter s a
to Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
      , \PParams (ShelleyLedgerEra era)
r -> do
          poolInfluence <- Proto PParams
pp Proto PParams
-> Getting
     (Maybe NonNegativeInterval)
     (Proto PParams)
     (Maybe NonNegativeInterval)
-> Maybe NonNegativeInterval
forall s a. s -> Getting a s a -> a
^. (Proto RationalNumber
 -> Const (Maybe NonNegativeInterval) (Proto RationalNumber))
-> Proto PParams
-> Const (Maybe NonNegativeInterval) (Proto PParams)
#poolInfluence ((Proto RationalNumber
  -> Const (Maybe NonNegativeInterval) (Proto RationalNumber))
 -> Proto PParams
 -> Const (Maybe NonNegativeInterval) (Proto PParams))
-> ((Maybe NonNegativeInterval
     -> Const (Maybe NonNegativeInterval) (Maybe NonNegativeInterval))
    -> Proto RationalNumber
    -> Const (Maybe NonNegativeInterval) (Proto RationalNumber))
-> Getting
     (Maybe NonNegativeInterval)
     (Proto PParams)
     (Maybe NonNegativeInterval)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Proto RationalNumber -> Rational)
-> SimpleGetter (Proto RationalNumber) Rational
forall s a. (s -> a) -> SimpleGetter s a
to Proto RationalNumber -> Rational
forall t s. Inject t s => t -> s
inject Getting (Maybe NonNegativeInterval) (Proto RationalNumber) Rational
-> ((Maybe NonNegativeInterval
     -> Const (Maybe NonNegativeInterval) (Maybe NonNegativeInterval))
    -> Rational -> Const (Maybe NonNegativeInterval) Rational)
-> (Maybe NonNegativeInterval
    -> Const (Maybe NonNegativeInterval) (Maybe NonNegativeInterval))
-> Proto RationalNumber
-> Const (Maybe NonNegativeInterval) (Proto RationalNumber)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Maybe NonNegativeInterval)
-> SimpleGetter Rational (Maybe NonNegativeInterval)
forall s a. (s -> a) -> SimpleGetter s a
to Rational -> Maybe NonNegativeInterval
forall r. BoundedRational r => Rational -> Maybe r
L.boundRational Maybe NonNegativeInterval
-> String -> Either String NonNegativeInterval
forall e (m :: * -> *) a. MonadError e m => Maybe a -> e -> m a
?! String
"Invalid poolInfluence"
          pure $ set L.ppA0L poolInfluence r
      , \PParams (ShelleyLedgerEra era)
r -> do
          monetaryExpansion <-
            Proto PParams
pp Proto PParams
-> Getting
     (Maybe UnitInterval) (Proto PParams) (Maybe UnitInterval)
-> Maybe UnitInterval
forall s a. s -> Getting a s a -> a
^. (Proto RationalNumber
 -> Const (Maybe UnitInterval) (Proto RationalNumber))
-> Proto PParams -> Const (Maybe UnitInterval) (Proto PParams)
#monetaryExpansion ((Proto RationalNumber
  -> Const (Maybe UnitInterval) (Proto RationalNumber))
 -> Proto PParams -> Const (Maybe UnitInterval) (Proto PParams))
-> ((Maybe UnitInterval
     -> Const (Maybe UnitInterval) (Maybe UnitInterval))
    -> Proto RationalNumber
    -> Const (Maybe UnitInterval) (Proto RationalNumber))
-> Getting
     (Maybe UnitInterval) (Proto PParams) (Maybe UnitInterval)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Proto RationalNumber -> Rational)
-> SimpleGetter (Proto RationalNumber) Rational
forall s a. (s -> a) -> SimpleGetter s a
to Proto RationalNumber -> Rational
forall t s. Inject t s => t -> s
inject Getting (Maybe UnitInterval) (Proto RationalNumber) Rational
-> ((Maybe UnitInterval
     -> Const (Maybe UnitInterval) (Maybe UnitInterval))
    -> Rational -> Const (Maybe UnitInterval) Rational)
-> (Maybe UnitInterval
    -> Const (Maybe UnitInterval) (Maybe UnitInterval))
-> Proto RationalNumber
-> Const (Maybe UnitInterval) (Proto RationalNumber)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Maybe UnitInterval)
-> SimpleGetter Rational (Maybe UnitInterval)
forall s a. (s -> a) -> SimpleGetter s a
to Rational -> Maybe UnitInterval
forall r. BoundedRational r => Rational -> Maybe r
L.boundRational Maybe UnitInterval -> String -> Either String UnitInterval
forall e (m :: * -> *) a. MonadError e m => Maybe a -> e -> m a
?! String
"Invalid monetaryExpansion"
          pure $ set L.ppRhoL monetaryExpansion r
      , \PParams (ShelleyLedgerEra era)
r -> do
          treasuryExpansion <-
            Proto PParams
pp Proto PParams
-> Getting
     (Maybe UnitInterval) (Proto PParams) (Maybe UnitInterval)
-> Maybe UnitInterval
forall s a. s -> Getting a s a -> a
^. (Proto RationalNumber
 -> Const (Maybe UnitInterval) (Proto RationalNumber))
-> Proto PParams -> Const (Maybe UnitInterval) (Proto PParams)
#treasuryExpansion ((Proto RationalNumber
  -> Const (Maybe UnitInterval) (Proto RationalNumber))
 -> Proto PParams -> Const (Maybe UnitInterval) (Proto PParams))
-> ((Maybe UnitInterval
     -> Const (Maybe UnitInterval) (Maybe UnitInterval))
    -> Proto RationalNumber
    -> Const (Maybe UnitInterval) (Proto RationalNumber))
-> Getting
     (Maybe UnitInterval) (Proto PParams) (Maybe UnitInterval)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Proto RationalNumber -> Rational)
-> SimpleGetter (Proto RationalNumber) Rational
forall s a. (s -> a) -> SimpleGetter s a
to Proto RationalNumber -> Rational
forall t s. Inject t s => t -> s
inject Getting (Maybe UnitInterval) (Proto RationalNumber) Rational
-> ((Maybe UnitInterval
     -> Const (Maybe UnitInterval) (Maybe UnitInterval))
    -> Rational -> Const (Maybe UnitInterval) Rational)
-> (Maybe UnitInterval
    -> Const (Maybe UnitInterval) (Maybe UnitInterval))
-> Proto RationalNumber
-> Const (Maybe UnitInterval) (Proto RationalNumber)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Maybe UnitInterval)
-> SimpleGetter Rational (Maybe UnitInterval)
forall s a. (s -> a) -> SimpleGetter s a
to Rational -> Maybe UnitInterval
forall r. BoundedRational r => Rational -> Maybe r
L.boundRational Maybe UnitInterval -> String -> Either String UnitInterval
forall e (m :: * -> *) a. MonadError e m => Maybe a -> e -> m a
?! String
"Invalid treasuryExpansion"
          pure $ set L.ppTauL treasuryExpansion r
      , PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PParams (ShelleyLedgerEra era)
 -> Either String (PParams (ShelleyLedgerEra era)))
-> (PParams (ShelleyLedgerEra era)
    -> PParams (ShelleyLedgerEra era))
-> PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Coin -> Identity Coin)
-> PParams (ShelleyLedgerEra era)
-> Identity (PParams (ShelleyLedgerEra era))
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams (ShelleyLedgerEra era)) Coin
L.ppMinPoolCostL ((Coin -> Identity Coin)
 -> PParams (ShelleyLedgerEra era)
 -> Identity (PParams (ShelleyLedgerEra era)))
-> Coin
-> PParams (ShelleyLedgerEra era)
-> PParams (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proto PParams
pp Proto PParams -> Getting Coin (Proto PParams) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. (Word64 -> Const Coin Word64)
-> Proto PParams -> Const Coin (Proto PParams)
#minPoolCost ((Word64 -> Const Coin Word64)
 -> Proto PParams -> Const Coin (Proto PParams))
-> ((Coin -> Const Coin Coin) -> Word64 -> Const Coin Word64)
-> Getting Coin (Proto PParams) Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Coin) -> SimpleGetter Word64 Coin
forall s a. (s -> a) -> SimpleGetter s a
to Word64 -> Coin
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
      , \PParams (ShelleyLedgerEra era)
r -> do
          major <- Word64 -> Either String Version
forall (m :: * -> *). MonadFail m => Word64 -> m Version
L.mkVersion64 (Word64 -> Either String Version)
-> Word64 -> Either String Version
forall a b. (a -> b) -> a -> b
$ Proto PParams
pp Proto PParams -> Getting Word64 (Proto PParams) Word64 -> Word64
forall s a. s -> Getting a s a -> a
^. (Proto ProtocolVersion -> Const Word64 (Proto ProtocolVersion))
-> Proto PParams -> Const Word64 (Proto PParams)
#protocolVersion ((Proto ProtocolVersion -> Const Word64 (Proto ProtocolVersion))
 -> Proto PParams -> Const Word64 (Proto PParams))
-> ((Word64 -> Const Word64 Word64)
    -> Proto ProtocolVersion -> Const Word64 (Proto ProtocolVersion))
-> Getting Word64 (Proto PParams) Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Const Word64 Word32)
-> Proto ProtocolVersion -> Const Word64 (Proto ProtocolVersion)
#major ((Word32 -> Const Word64 Word32)
 -> Proto ProtocolVersion -> Const Word64 (Proto ProtocolVersion))
-> ((Word64 -> Const Word64 Word64)
    -> Word32 -> Const Word64 Word32)
-> (Word64 -> Const Word64 Word64)
-> Proto ProtocolVersion
-> Const Word64 (Proto ProtocolVersion)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Word64) -> SimpleGetter Word32 Word64
forall s a. (s -> a) -> SimpleGetter s a
to Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
          pure $ set (L.ppProtocolVersionL . pvMajorL) major r
      , PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PParams (ShelleyLedgerEra era)
 -> Either String (PParams (ShelleyLedgerEra era)))
-> (PParams (ShelleyLedgerEra era)
    -> PParams (ShelleyLedgerEra era))
-> PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ProtVer -> Identity ProtVer)
-> PParams (ShelleyLedgerEra era)
-> Identity (PParams (ShelleyLedgerEra era))
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams (ShelleyLedgerEra era)) ProtVer
L.ppProtocolVersionL ((ProtVer -> Identity ProtVer)
 -> PParams (ShelleyLedgerEra era)
 -> Identity (PParams (ShelleyLedgerEra era)))
-> ((Natural -> Identity Natural) -> ProtVer -> Identity ProtVer)
-> (Natural -> Identity Natural)
-> PParams (ShelleyLedgerEra era)
-> Identity (PParams (ShelleyLedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Natural -> Identity Natural) -> ProtVer -> Identity ProtVer
Lens' ProtVer Natural
pvMinorL ((Natural -> Identity Natural)
 -> PParams (ShelleyLedgerEra era)
 -> Identity (PParams (ShelleyLedgerEra era)))
-> Natural
-> PParams (ShelleyLedgerEra era)
-> PParams (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proto PParams
pp Proto PParams -> Getting Natural (Proto PParams) Natural -> Natural
forall s a. s -> Getting a s a -> a
^. (Proto ProtocolVersion -> Const Natural (Proto ProtocolVersion))
-> Proto PParams -> Const Natural (Proto PParams)
#protocolVersion ((Proto ProtocolVersion -> Const Natural (Proto ProtocolVersion))
 -> Proto PParams -> Const Natural (Proto PParams))
-> ((Natural -> Const Natural Natural)
    -> Proto ProtocolVersion -> Const Natural (Proto ProtocolVersion))
-> Getting Natural (Proto PParams) Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Const Natural Word32)
-> Proto ProtocolVersion -> Const Natural (Proto ProtocolVersion)
#minor ((Word32 -> Const Natural Word32)
 -> Proto ProtocolVersion -> Const Natural (Proto ProtocolVersion))
-> ((Natural -> Const Natural Natural)
    -> Word32 -> Const Natural Word32)
-> (Natural -> Const Natural Natural)
-> Proto ProtocolVersion
-> Const Natural (Proto ProtocolVersion)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Natural) -> SimpleGetter Word32 Natural
forall s a. (s -> a) -> SimpleGetter s a
to Word32 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
      , PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PParams (ShelleyLedgerEra era)
 -> Either String (PParams (ShelleyLedgerEra era)))
-> (PParams (ShelleyLedgerEra era)
    -> PParams (ShelleyLedgerEra era))
-> PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Natural -> Identity Natural)
-> PParams (ShelleyLedgerEra era)
-> Identity (PParams (ShelleyLedgerEra era))
forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
Lens' (PParams (ShelleyLedgerEra era)) Natural
L.ppMaxValSizeL ((Natural -> Identity Natural)
 -> PParams (ShelleyLedgerEra era)
 -> Identity (PParams (ShelleyLedgerEra era)))
-> Natural
-> PParams (ShelleyLedgerEra era)
-> PParams (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proto PParams
pp Proto PParams -> Getting Natural (Proto PParams) Natural -> Natural
forall s a. s -> Getting a s a -> a
^. (Word64 -> Const Natural Word64)
-> Proto PParams -> Const Natural (Proto PParams)
#maxValueSize ((Word64 -> Const Natural Word64)
 -> Proto PParams -> Const Natural (Proto PParams))
-> ((Natural -> Const Natural Natural)
    -> Word64 -> Const Natural Word64)
-> Getting Natural (Proto PParams) Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Natural) -> SimpleGetter Word64 Natural
forall s a. (s -> a) -> SimpleGetter s a
to Word64 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
      , PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PParams (ShelleyLedgerEra era)
 -> Either String (PParams (ShelleyLedgerEra era)))
-> (PParams (ShelleyLedgerEra era)
    -> PParams (ShelleyLedgerEra era))
-> PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Natural -> Identity Natural)
-> PParams (ShelleyLedgerEra era)
-> Identity (PParams (ShelleyLedgerEra era))
forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
Lens' (PParams (ShelleyLedgerEra era)) Natural
L.ppCollateralPercentageL ((Natural -> Identity Natural)
 -> PParams (ShelleyLedgerEra era)
 -> Identity (PParams (ShelleyLedgerEra era)))
-> Natural
-> PParams (ShelleyLedgerEra era)
-> PParams (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proto PParams
pp Proto PParams -> Getting Natural (Proto PParams) Natural -> Natural
forall s a. s -> Getting a s a -> a
^. (Word64 -> Const Natural Word64)
-> Proto PParams -> Const Natural (Proto PParams)
#collateralPercentage ((Word64 -> Const Natural Word64)
 -> Proto PParams -> Const Natural (Proto PParams))
-> ((Natural -> Const Natural Natural)
    -> Word64 -> Const Natural Word64)
-> Getting Natural (Proto PParams) Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Natural) -> SimpleGetter Word64 Natural
forall s a. (s -> a) -> SimpleGetter s a
to Word64 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
      , PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PParams (ShelleyLedgerEra era)
 -> Either String (PParams (ShelleyLedgerEra era)))
-> (PParams (ShelleyLedgerEra era)
    -> PParams (ShelleyLedgerEra era))
-> PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Natural -> Identity Natural)
-> PParams (ShelleyLedgerEra era)
-> Identity (PParams (ShelleyLedgerEra era))
forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
Lens' (PParams (ShelleyLedgerEra era)) Natural
L.ppMaxCollateralInputsL ((Natural -> Identity Natural)
 -> PParams (ShelleyLedgerEra era)
 -> Identity (PParams (ShelleyLedgerEra era)))
-> Natural
-> PParams (ShelleyLedgerEra era)
-> PParams (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proto PParams
pp Proto PParams -> Getting Natural (Proto PParams) Natural -> Natural
forall s a. s -> Getting a s a -> a
^. (Word64 -> Const Natural Word64)
-> Proto PParams -> Const Natural (Proto PParams)
#maxCollateralInputs ((Word64 -> Const Natural Word64)
 -> Proto PParams -> Const Natural (Proto PParams))
-> ((Natural -> Const Natural Natural)
    -> Word64 -> Const Natural Word64)
-> Getting Natural (Proto PParams) Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Natural) -> SimpleGetter Word64 Natural
forall s a. (s -> a) -> SimpleGetter s a
to Word64 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
      , \PParams (ShelleyLedgerEra era)
r -> (CostModelApplyError -> String)
-> Either CostModelApplyError (PParams (ShelleyLedgerEra era))
-> Either String (PParams (ShelleyLedgerEra era))
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first CostModelApplyError -> String
forall a. Show a => a -> String
show (Either CostModelApplyError (PParams (ShelleyLedgerEra era))
 -> Either String (PParams (ShelleyLedgerEra era)))
-> Either CostModelApplyError (PParams (ShelleyLedgerEra era))
-> Either String (PParams (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$ do
          cm1 <- Language -> [Int64] -> Either CostModelApplyError CostModel
L.mkCostModel Language
L.PlutusV1 ([Int64] -> Either CostModelApplyError CostModel)
-> [Int64] -> Either CostModelApplyError CostModel
forall a b. (a -> b) -> a -> b
$ Proto PParams
pp Proto PParams -> Getting [Int64] (Proto PParams) [Int64] -> [Int64]
forall s a. s -> Getting a s a -> a
^. (Proto CostModels -> Const [Int64] (Proto CostModels))
-> Proto PParams -> Const [Int64] (Proto PParams)
#costModels ((Proto CostModels -> Const [Int64] (Proto CostModels))
 -> Proto PParams -> Const [Int64] (Proto PParams))
-> (([Int64] -> Const [Int64] [Int64])
    -> Proto CostModels -> Const [Int64] (Proto CostModels))
-> Getting [Int64] (Proto PParams) [Int64]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Proto CostModel -> Const [Int64] (Proto CostModel))
-> Proto CostModels -> Const [Int64] (Proto CostModels)
#plutusV1 ((Proto CostModel -> Const [Int64] (Proto CostModel))
 -> Proto CostModels -> Const [Int64] (Proto CostModels))
-> (([Int64] -> Const [Int64] [Int64])
    -> Proto CostModel -> Const [Int64] (Proto CostModel))
-> ([Int64] -> Const [Int64] [Int64])
-> Proto CostModels
-> Const [Int64] (Proto CostModels)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Int64] -> Const [Int64] [Int64])
-> Proto CostModel -> Const [Int64] (Proto CostModel)
#values
          cm2 <- L.mkCostModel L.PlutusV2 $ pp ^. #costModels . #plutusV2 . #values
          cm3 <- L.mkCostModel L.PlutusV3 $ pp ^. #costModels . #plutusV3 . #values
          cm4 <- L.mkCostModel L.PlutusV4 $ pp ^. #costModels . #plutusV4 . #values
          -- do not add empty cost models
          let nonEmptyCostModels =
                [(Language, CostModel)] -> Map Language CostModel
[Item (Map Language CostModel)] -> Map Language CostModel
forall l. IsList l => [Item l] -> l
fromList ([(Language, CostModel)] -> Map Language CostModel)
-> ((CostModel -> Maybe (Language, CostModel))
    -> [(Language, CostModel)])
-> (CostModel -> Maybe (Language, CostModel))
-> Map Language CostModel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CostModel -> Maybe (Language, CostModel))
 -> [CostModel] -> [(Language, CostModel)])
-> [CostModel]
-> (CostModel -> Maybe (Language, CostModel))
-> [(Language, CostModel)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (CostModel -> Maybe (Language, CostModel))
-> [CostModel] -> [(Language, CostModel)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [Item [CostModel]
CostModel
cm1, Item [CostModel]
CostModel
cm2, Item [CostModel]
CostModel
cm3, Item [CostModel]
CostModel
cm4] ((CostModel -> Maybe (Language, CostModel))
 -> Map Language CostModel)
-> (CostModel -> Maybe (Language, CostModel))
-> Map Language CostModel
forall a b. (a -> b) -> a -> b
$ \CostModel
cm ->
                  if Bool -> Bool
not ([Int64] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Int64] -> Bool) -> [Int64] -> Bool
forall a b. (a -> b) -> a -> b
$ CostModel -> [Int64]
L.getCostModelParams CostModel
cm)
                    then (Language, CostModel) -> Maybe (Language, CostModel)
forall a. a -> Maybe a
Just (CostModel -> Language
L.getCostModelLanguage CostModel
cm, CostModel
cm)
                    else Maybe (Language, CostModel)
forall a. Maybe a
Nothing
          pure $
            r & L.ppCostModelsL .~ L.mkCostModels nonEmptyCostModels
      , \PParams (ShelleyLedgerEra era)
r -> do
          steps <- Proto PParams
pp Proto PParams
-> Getting
     (Maybe NonNegativeInterval)
     (Proto PParams)
     (Maybe NonNegativeInterval)
-> Maybe NonNegativeInterval
forall s a. s -> Getting a s a -> a
^. (Proto ExPrices
 -> Const (Maybe NonNegativeInterval) (Proto ExPrices))
-> Proto PParams
-> Const (Maybe NonNegativeInterval) (Proto PParams)
#prices ((Proto ExPrices
  -> Const (Maybe NonNegativeInterval) (Proto ExPrices))
 -> Proto PParams
 -> Const (Maybe NonNegativeInterval) (Proto PParams))
-> ((Maybe NonNegativeInterval
     -> Const (Maybe NonNegativeInterval) (Maybe NonNegativeInterval))
    -> Proto ExPrices
    -> Const (Maybe NonNegativeInterval) (Proto ExPrices))
-> Getting
     (Maybe NonNegativeInterval)
     (Proto PParams)
     (Maybe NonNegativeInterval)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Proto RationalNumber
 -> Const (Maybe NonNegativeInterval) (Proto RationalNumber))
-> Proto ExPrices
-> Const (Maybe NonNegativeInterval) (Proto ExPrices)
#steps ((Proto RationalNumber
  -> Const (Maybe NonNegativeInterval) (Proto RationalNumber))
 -> Proto ExPrices
 -> Const (Maybe NonNegativeInterval) (Proto ExPrices))
-> ((Maybe NonNegativeInterval
     -> Const (Maybe NonNegativeInterval) (Maybe NonNegativeInterval))
    -> Proto RationalNumber
    -> Const (Maybe NonNegativeInterval) (Proto RationalNumber))
-> (Maybe NonNegativeInterval
    -> Const (Maybe NonNegativeInterval) (Maybe NonNegativeInterval))
-> Proto ExPrices
-> Const (Maybe NonNegativeInterval) (Proto ExPrices)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Proto RationalNumber -> Rational)
-> SimpleGetter (Proto RationalNumber) Rational
forall s a. (s -> a) -> SimpleGetter s a
to Proto RationalNumber -> Rational
forall t s. Inject t s => t -> s
inject Getting (Maybe NonNegativeInterval) (Proto RationalNumber) Rational
-> ((Maybe NonNegativeInterval
     -> Const (Maybe NonNegativeInterval) (Maybe NonNegativeInterval))
    -> Rational -> Const (Maybe NonNegativeInterval) Rational)
-> (Maybe NonNegativeInterval
    -> Const (Maybe NonNegativeInterval) (Maybe NonNegativeInterval))
-> Proto RationalNumber
-> Const (Maybe NonNegativeInterval) (Proto RationalNumber)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Maybe NonNegativeInterval)
-> SimpleGetter Rational (Maybe NonNegativeInterval)
forall s a. (s -> a) -> SimpleGetter s a
to Rational -> Maybe NonNegativeInterval
forall r. BoundedRational r => Rational -> Maybe r
L.boundRational Maybe NonNegativeInterval
-> String -> Either String NonNegativeInterval
forall e (m :: * -> *) a. MonadError e m => Maybe a -> e -> m a
?! String
"Invalid prices.steps"
          mem <- pp ^. #prices . #memory . to inject . to L.boundRational ?! "Invalid prices.mem"
          pure $
            r
              & L.ppPricesL . prStepsL .~ steps
              & L.ppPricesL . prMemL .~ mem
      , PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PParams (ShelleyLedgerEra era)
 -> Either String (PParams (ShelleyLedgerEra era)))
-> (PParams (ShelleyLedgerEra era)
    -> PParams (ShelleyLedgerEra era))
-> PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ExUnits -> Identity ExUnits)
-> PParams (ShelleyLedgerEra era)
-> Identity (PParams (ShelleyLedgerEra era))
forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
Lens' (PParams (ShelleyLedgerEra era)) ExUnits
L.ppMaxTxExUnitsL ((ExUnits -> Identity ExUnits)
 -> PParams (ShelleyLedgerEra era)
 -> Identity (PParams (ShelleyLedgerEra era)))
-> ExUnits
-> PParams (ShelleyLedgerEra era)
-> PParams (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proto PParams
pp Proto PParams -> Getting ExUnits (Proto PParams) ExUnits -> ExUnits
forall s a. s -> Getting a s a -> a
^. (Proto ExUnits -> Const ExUnits (Proto ExUnits))
-> Proto PParams -> Const ExUnits (Proto PParams)
#maxExecutionUnitsPerTransaction ((Proto ExUnits -> Const ExUnits (Proto ExUnits))
 -> Proto PParams -> Const ExUnits (Proto PParams))
-> ((ExUnits -> Const ExUnits ExUnits)
    -> Proto ExUnits -> Const ExUnits (Proto ExUnits))
-> Getting ExUnits (Proto PParams) ExUnits
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Proto ExUnits -> ExUnits) -> SimpleGetter (Proto ExUnits) ExUnits
forall s a. (s -> a) -> SimpleGetter s a
to Proto ExUnits -> ExUnits
forall t s. Inject t s => t -> s
inject)
      , PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PParams (ShelleyLedgerEra era)
 -> Either String (PParams (ShelleyLedgerEra era)))
-> (PParams (ShelleyLedgerEra era)
    -> PParams (ShelleyLedgerEra era))
-> PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ExUnits -> Identity ExUnits)
-> PParams (ShelleyLedgerEra era)
-> Identity (PParams (ShelleyLedgerEra era))
forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
Lens' (PParams (ShelleyLedgerEra era)) ExUnits
L.ppMaxBlockExUnitsL ((ExUnits -> Identity ExUnits)
 -> PParams (ShelleyLedgerEra era)
 -> Identity (PParams (ShelleyLedgerEra era)))
-> ExUnits
-> PParams (ShelleyLedgerEra era)
-> PParams (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proto PParams
pp Proto PParams -> Getting ExUnits (Proto PParams) ExUnits -> ExUnits
forall s a. s -> Getting a s a -> a
^. (Proto ExUnits -> Const ExUnits (Proto ExUnits))
-> Proto PParams -> Const ExUnits (Proto PParams)
#maxExecutionUnitsPerBlock ((Proto ExUnits -> Const ExUnits (Proto ExUnits))
 -> Proto PParams -> Const ExUnits (Proto PParams))
-> ((ExUnits -> Const ExUnits ExUnits)
    -> Proto ExUnits -> Const ExUnits (Proto ExUnits))
-> Getting ExUnits (Proto PParams) ExUnits
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Proto ExUnits -> ExUnits) -> SimpleGetter (Proto ExUnits) ExUnits
forall s a. (s -> a) -> SimpleGetter s a
to Proto ExUnits -> ExUnits
forall t s. Inject t s => t -> s
inject)
      , \PParams (ShelleyLedgerEra era)
r -> do
          minFeeScriptRefCostPerByte <-
            Proto PParams
pp
              Proto PParams
-> Getting
     (Maybe NonNegativeInterval)
     (Proto PParams)
     (Maybe NonNegativeInterval)
-> Maybe NonNegativeInterval
forall s a. s -> Getting a s a -> a
^. (Proto RationalNumber
 -> Const (Maybe NonNegativeInterval) (Proto RationalNumber))
-> Proto PParams
-> Const (Maybe NonNegativeInterval) (Proto PParams)
#minFeeScriptRefCostPerByte ((Proto RationalNumber
  -> Const (Maybe NonNegativeInterval) (Proto RationalNumber))
 -> Proto PParams
 -> Const (Maybe NonNegativeInterval) (Proto PParams))
-> ((Maybe NonNegativeInterval
     -> Const (Maybe NonNegativeInterval) (Maybe NonNegativeInterval))
    -> Proto RationalNumber
    -> Const (Maybe NonNegativeInterval) (Proto RationalNumber))
-> Getting
     (Maybe NonNegativeInterval)
     (Proto PParams)
     (Maybe NonNegativeInterval)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Proto RationalNumber -> Rational)
-> SimpleGetter (Proto RationalNumber) Rational
forall s a. (s -> a) -> SimpleGetter s a
to Proto RationalNumber -> Rational
forall t s. Inject t s => t -> s
inject Getting (Maybe NonNegativeInterval) (Proto RationalNumber) Rational
-> ((Maybe NonNegativeInterval
     -> Const (Maybe NonNegativeInterval) (Maybe NonNegativeInterval))
    -> Rational -> Const (Maybe NonNegativeInterval) Rational)
-> (Maybe NonNegativeInterval
    -> Const (Maybe NonNegativeInterval) (Maybe NonNegativeInterval))
-> Proto RationalNumber
-> Const (Maybe NonNegativeInterval) (Proto RationalNumber)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Maybe NonNegativeInterval)
-> SimpleGetter Rational (Maybe NonNegativeInterval)
forall s a. (s -> a) -> SimpleGetter s a
to Rational -> Maybe NonNegativeInterval
forall r. BoundedRational r => Rational -> Maybe r
L.boundRational Maybe NonNegativeInterval
-> String -> Either String NonNegativeInterval
forall e (m :: * -> *) a. MonadError e m => Maybe a -> e -> m a
?! String
"Invalid minFeeScriptRefCostPerByte"
          pure $ set L.ppMinFeeRefScriptCostPerByteL minFeeScriptRefCostPerByte r
      , \PParams (ShelleyLedgerEra era)
r -> do
          let thresholds :: [Proto RationalNumber]
thresholds = Proto PParams
pp Proto PParams
-> Getting
     [Proto RationalNumber] (Proto PParams) [Proto RationalNumber]
-> [Proto RationalNumber]
forall s a. s -> Getting a s a -> a
^. (Proto VotingThresholds
 -> Const [Proto RationalNumber] (Proto VotingThresholds))
-> Proto PParams -> Const [Proto RationalNumber] (Proto PParams)
#poolVotingThresholds ((Proto VotingThresholds
  -> Const [Proto RationalNumber] (Proto VotingThresholds))
 -> Proto PParams -> Const [Proto RationalNumber] (Proto PParams))
-> (([Proto RationalNumber]
     -> Const [Proto RationalNumber] [Proto RationalNumber])
    -> Proto VotingThresholds
    -> Const [Proto RationalNumber] (Proto VotingThresholds))
-> Getting
     [Proto RationalNumber] (Proto PParams) [Proto RationalNumber]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Proto RationalNumber]
 -> Const [Proto RationalNumber] [Proto RationalNumber])
-> Proto VotingThresholds
-> Const [Proto RationalNumber] (Proto VotingThresholds)
#thresholds
          Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Proto RationalNumber] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Proto RationalNumber]
thresholds Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
5) (Either String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$
            String -> Either String ()
forall a. String -> Either String a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> Either String ()) -> String -> Either String ()
forall a b. (a -> b) -> a -> b
$
              String
"Invalid number of thresholds: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show ([Proto RationalNumber] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Proto RationalNumber]
thresholds)
          [ motionNoConfidence
            , committeeNormal
            , committeeNoConfidence
            , hardForkInitiation
            , ppSecurityGroup
            ] <-
            ((Maybe UnitInterval -> Either String UnitInterval,
  Maybe UnitInterval)
 -> Either String UnitInterval)
-> [(Maybe UnitInterval -> Either String UnitInterval,
     Maybe UnitInterval)]
-> Either String [UnitInterval]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (((Maybe UnitInterval -> Either String UnitInterval)
 -> Maybe UnitInterval -> Either String UnitInterval)
-> (Maybe UnitInterval -> Either String UnitInterval,
    Maybe UnitInterval)
-> Either String UnitInterval
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Maybe UnitInterval -> Either String UnitInterval)
-> Maybe UnitInterval -> Either String UnitInterval
forall a b. (a -> b) -> a -> b
($))
              ([(Maybe UnitInterval -> Either String UnitInterval,
   Maybe UnitInterval)]
 -> Either String [UnitInterval])
-> ([Maybe UnitInterval]
    -> [(Maybe UnitInterval -> Either String UnitInterval,
         Maybe UnitInterval)])
-> [Maybe UnitInterval]
-> Either String [UnitInterval]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe UnitInterval -> Either String UnitInterval]
-> [Maybe UnitInterval]
-> [(Maybe UnitInterval -> Either String UnitInterval,
     Maybe UnitInterval)]
forall a b. [a] -> [b] -> [(a, b)]
zip
                [ (Maybe UnitInterval -> String -> Either String UnitInterval
forall e (m :: * -> *) a. MonadError e m => Maybe a -> e -> m a
?! String
"Invalid value in poolVotingThresholds: motionNoConfidence")
                , (Maybe UnitInterval -> String -> Either String UnitInterval
forall e (m :: * -> *) a. MonadError e m => Maybe a -> e -> m a
?! String
"Invalid value in poolVotingThresholds: committeeNormal")
                , (Maybe UnitInterval -> String -> Either String UnitInterval
forall e (m :: * -> *) a. MonadError e m => Maybe a -> e -> m a
?! String
"Invalid value in poolVotingThresholds: committeeNoConfidence")
                , (Maybe UnitInterval -> String -> Either String UnitInterval
forall e (m :: * -> *) a. MonadError e m => Maybe a -> e -> m a
?! String
"Invalid value in poolVotingThresholds: hardForkInitiation")
                , (Maybe UnitInterval -> String -> Either String UnitInterval
forall e (m :: * -> *) a. MonadError e m => Maybe a -> e -> m a
?! String
"Invalid value in poolVotingThresholds: ppSecurityGroup")
                ]
              ([Maybe UnitInterval] -> Either String [UnitInterval])
-> [Maybe UnitInterval] -> Either String [UnitInterval]
forall a b. (a -> b) -> a -> b
$ (Proto RationalNumber -> Maybe UnitInterval)
-> [Proto RationalNumber] -> [Maybe UnitInterval]
forall a b. (a -> b) -> [a] -> [b]
map (Rational -> Maybe UnitInterval
forall r. BoundedRational r => Rational -> Maybe r
L.boundRational (Rational -> Maybe UnitInterval)
-> (Proto RationalNumber -> Rational)
-> Proto RationalNumber
-> Maybe UnitInterval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proto RationalNumber -> Rational
forall t s. Inject t s => t -> s
inject) [Proto RationalNumber]
thresholds
          pure $
            r
              & L.ppPoolVotingThresholdsL . L.pvtMotionNoConfidenceL .~ motionNoConfidence
              & L.ppPoolVotingThresholdsL . L.pvtCommitteeNormalL .~ committeeNormal
              & L.ppPoolVotingThresholdsL . L.pvtCommitteeNoConfidenceL .~ committeeNoConfidence
              & L.ppPoolVotingThresholdsL . L.pvtHardForkInitiationL .~ hardForkInitiation
              & L.ppPoolVotingThresholdsL . L.pvtPPSecurityGroupL .~ ppSecurityGroup
      , \PParams (ShelleyLedgerEra era)
r -> do
          let thresholds :: [Proto RationalNumber]
thresholds = Proto PParams
pp Proto PParams
-> Getting
     [Proto RationalNumber] (Proto PParams) [Proto RationalNumber]
-> [Proto RationalNumber]
forall s a. s -> Getting a s a -> a
^. (Proto VotingThresholds
 -> Const [Proto RationalNumber] (Proto VotingThresholds))
-> Proto PParams -> Const [Proto RationalNumber] (Proto PParams)
#drepVotingThresholds ((Proto VotingThresholds
  -> Const [Proto RationalNumber] (Proto VotingThresholds))
 -> Proto PParams -> Const [Proto RationalNumber] (Proto PParams))
-> (([Proto RationalNumber]
     -> Const [Proto RationalNumber] [Proto RationalNumber])
    -> Proto VotingThresholds
    -> Const [Proto RationalNumber] (Proto VotingThresholds))
-> Getting
     [Proto RationalNumber] (Proto PParams) [Proto RationalNumber]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Proto RationalNumber]
 -> Const [Proto RationalNumber] [Proto RationalNumber])
-> Proto VotingThresholds
-> Const [Proto RationalNumber] (Proto VotingThresholds)
#thresholds
          Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Proto RationalNumber] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Proto RationalNumber]
thresholds Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
10) (Either String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$
            String -> Either String ()
forall a. String -> Either String a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> Either String ()) -> String -> Either String ()
forall a b. (a -> b) -> a -> b
$
              String
"Invalid number of thresholds: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show ([Proto RationalNumber] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Proto RationalNumber]
thresholds)
          [ motionNoConfidence
            , committeeNormal
            , committeeNoConfidence
            , updateToConstitution
            , hardforkInitiation
            , ppNetworkGroup
            , ppEcomonicGroup
            , ppTechnicalGroup
            , ppGovGroup
            , treasuryWithdrawal
            ] <-
            ((Maybe UnitInterval -> Either String UnitInterval,
  Maybe UnitInterval)
 -> Either String UnitInterval)
-> [(Maybe UnitInterval -> Either String UnitInterval,
     Maybe UnitInterval)]
-> Either String [UnitInterval]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (((Maybe UnitInterval -> Either String UnitInterval)
 -> Maybe UnitInterval -> Either String UnitInterval)
-> (Maybe UnitInterval -> Either String UnitInterval,
    Maybe UnitInterval)
-> Either String UnitInterval
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Maybe UnitInterval -> Either String UnitInterval)
-> Maybe UnitInterval -> Either String UnitInterval
forall a b. (a -> b) -> a -> b
($))
              ([(Maybe UnitInterval -> Either String UnitInterval,
   Maybe UnitInterval)]
 -> Either String [UnitInterval])
-> ([Maybe UnitInterval]
    -> [(Maybe UnitInterval -> Either String UnitInterval,
         Maybe UnitInterval)])
-> [Maybe UnitInterval]
-> Either String [UnitInterval]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe UnitInterval -> Either String UnitInterval]
-> [Maybe UnitInterval]
-> [(Maybe UnitInterval -> Either String UnitInterval,
     Maybe UnitInterval)]
forall a b. [a] -> [b] -> [(a, b)]
zip
                [ (Maybe UnitInterval -> String -> Either String UnitInterval
forall e (m :: * -> *) a. MonadError e m => Maybe a -> e -> m a
?! String
"Invalid value in drepVotingThresholds: motionNoConfidence")
                , (Maybe UnitInterval -> String -> Either String UnitInterval
forall e (m :: * -> *) a. MonadError e m => Maybe a -> e -> m a
?! String
"Invalid value in drepVotingThresholds: committeeNormal")
                , (Maybe UnitInterval -> String -> Either String UnitInterval
forall e (m :: * -> *) a. MonadError e m => Maybe a -> e -> m a
?! String
"Invalid value in drepVotingThresholds: committeeNoConfidence")
                , (Maybe UnitInterval -> String -> Either String UnitInterval
forall e (m :: * -> *) a. MonadError e m => Maybe a -> e -> m a
?! String
"Invalid value in drepVotingThresholds: updateToConstitution")
                , (Maybe UnitInterval -> String -> Either String UnitInterval
forall e (m :: * -> *) a. MonadError e m => Maybe a -> e -> m a
?! String
"Invalid value in drepVotingThresholds: hardforkInitiation")
                , (Maybe UnitInterval -> String -> Either String UnitInterval
forall e (m :: * -> *) a. MonadError e m => Maybe a -> e -> m a
?! String
"Invalid value in drepVotingThresholds: ppNetworkGroup")
                , (Maybe UnitInterval -> String -> Either String UnitInterval
forall e (m :: * -> *) a. MonadError e m => Maybe a -> e -> m a
?! String
"Invalid value in drepVotingThresholds: ppEcomonicGroup")
                , (Maybe UnitInterval -> String -> Either String UnitInterval
forall e (m :: * -> *) a. MonadError e m => Maybe a -> e -> m a
?! String
"Invalid value in drepVotingThresholds: ppTechnicalGroup")
                , (Maybe UnitInterval -> String -> Either String UnitInterval
forall e (m :: * -> *) a. MonadError e m => Maybe a -> e -> m a
?! String
"Invalid value in drepVotingThresholds: ppGovGroup")
                , (Maybe UnitInterval -> String -> Either String UnitInterval
forall e (m :: * -> *) a. MonadError e m => Maybe a -> e -> m a
?! String
"Invalid value in drepVotingThresholds: treasuryWithdrawal")
                ]
              ([Maybe UnitInterval] -> Either String [UnitInterval])
-> [Maybe UnitInterval] -> Either String [UnitInterval]
forall a b. (a -> b) -> a -> b
$ (Proto RationalNumber -> Maybe UnitInterval)
-> [Proto RationalNumber] -> [Maybe UnitInterval]
forall a b. (a -> b) -> [a] -> [b]
map (Rational -> Maybe UnitInterval
forall r. BoundedRational r => Rational -> Maybe r
L.boundRational (Rational -> Maybe UnitInterval)
-> (Proto RationalNumber -> Rational)
-> Proto RationalNumber
-> Maybe UnitInterval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proto RationalNumber -> Rational
forall t s. Inject t s => t -> s
inject) [Proto RationalNumber]
thresholds
          pure $
            r
              & L.ppDRepVotingThresholdsL . L.dvtMotionNoConfidenceL .~ motionNoConfidence
              & L.ppDRepVotingThresholdsL . L.dvtCommitteeNormalL .~ committeeNormal
              & L.ppDRepVotingThresholdsL . L.dvtCommitteeNoConfidenceL .~ committeeNoConfidence
              & L.ppDRepVotingThresholdsL . L.dvtUpdateToConstitutionL .~ updateToConstitution
              & L.ppDRepVotingThresholdsL . L.dvtHardForkInitiationL .~ hardforkInitiation
              & L.ppDRepVotingThresholdsL . L.dvtPPNetworkGroupL .~ ppNetworkGroup
              & L.ppDRepVotingThresholdsL . L.dvtPPEconomicGroupL .~ ppEcomonicGroup
              & L.ppDRepVotingThresholdsL . L.dvtPPTechnicalGroupL .~ ppTechnicalGroup
              & L.ppDRepVotingThresholdsL . L.dvtPPGovGroupL .~ ppGovGroup
              & L.ppDRepVotingThresholdsL . L.dvtTreasuryWithdrawalL .~ treasuryWithdrawal
      , PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PParams (ShelleyLedgerEra era)
 -> Either String (PParams (ShelleyLedgerEra era)))
-> (PParams (ShelleyLedgerEra era)
    -> PParams (ShelleyLedgerEra era))
-> PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Natural -> Identity Natural)
-> PParams (ShelleyLedgerEra era)
-> Identity (PParams (ShelleyLedgerEra era))
forall era. ConwayEraPParams era => Lens' (PParams era) Natural
Lens' (PParams (ShelleyLedgerEra era)) Natural
L.ppCommitteeMinSizeL ((Natural -> Identity Natural)
 -> PParams (ShelleyLedgerEra era)
 -> Identity (PParams (ShelleyLedgerEra era)))
-> Natural
-> PParams (ShelleyLedgerEra era)
-> PParams (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proto PParams
pp Proto PParams -> Getting Natural (Proto PParams) Natural -> Natural
forall s a. s -> Getting a s a -> a
^. (Word32 -> Const Natural Word32)
-> Proto PParams -> Const Natural (Proto PParams)
#minCommitteeSize ((Word32 -> Const Natural Word32)
 -> Proto PParams -> Const Natural (Proto PParams))
-> ((Natural -> Const Natural Natural)
    -> Word32 -> Const Natural Word32)
-> Getting Natural (Proto PParams) Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Natural) -> SimpleGetter Word32 Natural
forall s a. (s -> a) -> SimpleGetter s a
to Word32 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
      , PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          (PParams (ShelleyLedgerEra era)
 -> Either String (PParams (ShelleyLedgerEra era)))
-> (PParams (ShelleyLedgerEra era)
    -> PParams (ShelleyLedgerEra era))
-> PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((EpochInterval -> Identity EpochInterval)
-> PParams (ShelleyLedgerEra era)
-> Identity (PParams (ShelleyLedgerEra era))
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams (ShelleyLedgerEra era)) EpochInterval
L.ppCommitteeMaxTermLengthL ((EpochInterval -> Identity EpochInterval)
 -> PParams (ShelleyLedgerEra era)
 -> Identity (PParams (ShelleyLedgerEra era)))
-> EpochInterval
-> PParams (ShelleyLedgerEra era)
-> PParams (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proto PParams
pp Proto PParams
-> Getting EpochInterval (Proto PParams) EpochInterval
-> EpochInterval
forall s a. s -> Getting a s a -> a
^. (Word64 -> Const EpochInterval Word64)
-> Proto PParams -> Const EpochInterval (Proto PParams)
#committeeTermLimit ((Word64 -> Const EpochInterval Word64)
 -> Proto PParams -> Const EpochInterval (Proto PParams))
-> ((EpochInterval -> Const EpochInterval EpochInterval)
    -> Word64 -> Const EpochInterval Word64)
-> Getting EpochInterval (Proto PParams) EpochInterval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Word32) -> SimpleGetter Word64 Word32
forall s a. (s -> a) -> SimpleGetter s a
to Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Getting EpochInterval Word64 Word32
-> ((EpochInterval -> Const EpochInterval EpochInterval)
    -> Word32 -> Const EpochInterval Word32)
-> (EpochInterval -> Const EpochInterval EpochInterval)
-> Word64
-> Const EpochInterval Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> EpochInterval) -> SimpleGetter Word32 EpochInterval
forall s a. (s -> a) -> SimpleGetter s a
to Word32 -> EpochInterval
L.EpochInterval)
      , PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          (PParams (ShelleyLedgerEra era)
 -> Either String (PParams (ShelleyLedgerEra era)))
-> (PParams (ShelleyLedgerEra era)
    -> PParams (ShelleyLedgerEra era))
-> PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( (EpochInterval -> Identity EpochInterval)
-> PParams (ShelleyLedgerEra era)
-> Identity (PParams (ShelleyLedgerEra era))
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams (ShelleyLedgerEra era)) EpochInterval
L.ppGovActionLifetimeL
                ((EpochInterval -> Identity EpochInterval)
 -> PParams (ShelleyLedgerEra era)
 -> Identity (PParams (ShelleyLedgerEra era)))
-> EpochInterval
-> PParams (ShelleyLedgerEra era)
-> PParams (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proto PParams
pp Proto PParams
-> Getting EpochInterval (Proto PParams) EpochInterval
-> EpochInterval
forall s a. s -> Getting a s a -> a
^. (Word64 -> Const EpochInterval Word64)
-> Proto PParams -> Const EpochInterval (Proto PParams)
#governanceActionValidityPeriod ((Word64 -> Const EpochInterval Word64)
 -> Proto PParams -> Const EpochInterval (Proto PParams))
-> ((EpochInterval -> Const EpochInterval EpochInterval)
    -> Word64 -> Const EpochInterval Word64)
-> Getting EpochInterval (Proto PParams) EpochInterval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Word32) -> SimpleGetter Word64 Word32
forall s a. (s -> a) -> SimpleGetter s a
to Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Getting EpochInterval Word64 Word32
-> ((EpochInterval -> Const EpochInterval EpochInterval)
    -> Word32 -> Const EpochInterval Word32)
-> (EpochInterval -> Const EpochInterval EpochInterval)
-> Word64
-> Const EpochInterval Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> EpochInterval) -> SimpleGetter Word32 EpochInterval
forall s a. (s -> a) -> SimpleGetter s a
to Word32 -> EpochInterval
L.EpochInterval
            )
      , PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PParams (ShelleyLedgerEra era)
 -> Either String (PParams (ShelleyLedgerEra era)))
-> (PParams (ShelleyLedgerEra era)
    -> PParams (ShelleyLedgerEra era))
-> PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Coin -> Identity Coin)
-> PParams (ShelleyLedgerEra era)
-> Identity (PParams (ShelleyLedgerEra era))
forall era. ConwayEraPParams era => Lens' (PParams era) Coin
Lens' (PParams (ShelleyLedgerEra era)) Coin
L.ppGovActionDepositL ((Coin -> Identity Coin)
 -> PParams (ShelleyLedgerEra era)
 -> Identity (PParams (ShelleyLedgerEra era)))
-> Coin
-> PParams (ShelleyLedgerEra era)
-> PParams (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proto PParams
pp Proto PParams -> Getting Coin (Proto PParams) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. (Word64 -> Const Coin Word64)
-> Proto PParams -> Const Coin (Proto PParams)
#governanceActionDeposit ((Word64 -> Const Coin Word64)
 -> Proto PParams -> Const Coin (Proto PParams))
-> ((Coin -> Const Coin Coin) -> Word64 -> Const Coin Word64)
-> Getting Coin (Proto PParams) Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Coin) -> SimpleGetter Word64 Coin
forall s a. (s -> a) -> SimpleGetter s a
to Word64 -> Coin
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
      , PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PParams (ShelleyLedgerEra era)
 -> Either String (PParams (ShelleyLedgerEra era)))
-> (PParams (ShelleyLedgerEra era)
    -> PParams (ShelleyLedgerEra era))
-> PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Coin -> Identity Coin)
-> PParams (ShelleyLedgerEra era)
-> Identity (PParams (ShelleyLedgerEra era))
forall era. ConwayEraPParams era => Lens' (PParams era) Coin
Lens' (PParams (ShelleyLedgerEra era)) Coin
L.ppDRepDepositL ((Coin -> Identity Coin)
 -> PParams (ShelleyLedgerEra era)
 -> Identity (PParams (ShelleyLedgerEra era)))
-> Coin
-> PParams (ShelleyLedgerEra era)
-> PParams (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proto PParams
pp Proto PParams -> Getting Coin (Proto PParams) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. (Word64 -> Const Coin Word64)
-> Proto PParams -> Const Coin (Proto PParams)
#drepDeposit ((Word64 -> Const Coin Word64)
 -> Proto PParams -> Const Coin (Proto PParams))
-> ((Coin -> Const Coin Coin) -> Word64 -> Const Coin Word64)
-> Getting Coin (Proto PParams) Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Coin) -> SimpleGetter Word64 Coin
forall s a. (s -> a) -> SimpleGetter s a
to Word64 -> Coin
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
      , PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PParams (ShelleyLedgerEra era)
 -> Either String (PParams (ShelleyLedgerEra era)))
-> (PParams (ShelleyLedgerEra era)
    -> PParams (ShelleyLedgerEra era))
-> PParams (ShelleyLedgerEra era)
-> Either String (PParams (ShelleyLedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((EpochInterval -> Identity EpochInterval)
-> PParams (ShelleyLedgerEra era)
-> Identity (PParams (ShelleyLedgerEra era))
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams (ShelleyLedgerEra era)) EpochInterval
L.ppDRepActivityL ((EpochInterval -> Identity EpochInterval)
 -> PParams (ShelleyLedgerEra era)
 -> Identity (PParams (ShelleyLedgerEra era)))
-> EpochInterval
-> PParams (ShelleyLedgerEra era)
-> PParams (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proto PParams
pp Proto PParams
-> Getting EpochInterval (Proto PParams) EpochInterval
-> EpochInterval
forall s a. s -> Getting a s a -> a
^. (Word64 -> Const EpochInterval Word64)
-> Proto PParams -> Const EpochInterval (Proto PParams)
#drepInactivityPeriod ((Word64 -> Const EpochInterval Word64)
 -> Proto PParams -> Const EpochInterval (Proto PParams))
-> ((EpochInterval -> Const EpochInterval EpochInterval)
    -> Word64 -> Const EpochInterval Word64)
-> Getting EpochInterval (Proto PParams) EpochInterval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Word32) -> SimpleGetter Word64 Word32
forall s a. (s -> a) -> SimpleGetter s a
to Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Getting EpochInterval Word64 Word32
-> ((EpochInterval -> Const EpochInterval EpochInterval)
    -> Word32 -> Const EpochInterval Word32)
-> (EpochInterval -> Const EpochInterval EpochInterval)
-> Word64
-> Const EpochInterval Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> EpochInterval) -> SimpleGetter Word32 EpochInterval
forall s a. (s -> a) -> SimpleGetter s a
to Word32 -> EpochInterval
L.EpochInterval)
      ]
 where
  -- Run a list of functions feeding the output of one to the next
  appFuns :: Monad m => [a -> m a] -> a -> m a
  appFuns :: forall (m :: * -> *) a. Monad m => [a -> m a] -> a -> m a
appFuns [a -> m a]
fs a
a0 = ((a -> m a) -> m a -> m a) -> m a -> [a -> m a] -> m a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (a -> m a) -> m a -> m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
(=<<) (a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a0) [a -> m a]
fs

  pvMajorL :: Lens' L.ProtVer L.Version
  pvMajorL :: Lens' ProtVer Version
pvMajorL = (ProtVer -> Version)
-> (ProtVer -> Version -> ProtVer) -> Lens' ProtVer Version
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ProtVer -> Version
L.pvMajor ((ProtVer -> Version -> ProtVer) -> Lens' ProtVer Version)
-> (ProtVer -> Version -> ProtVer) -> Lens' ProtVer Version
forall a b. (a -> b) -> a -> b
$ \ProtVer
p Version
v -> ProtVer
p{L.pvMajor = v}

  pvMinorL :: Lens' L.ProtVer Natural
  pvMinorL :: Lens' ProtVer Natural
pvMinorL = (ProtVer -> Natural)
-> (ProtVer -> Natural -> ProtVer) -> Lens' ProtVer Natural
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ProtVer -> Natural
L.pvMinor ((ProtVer -> Natural -> ProtVer) -> Lens' ProtVer Natural)
-> (ProtVer -> Natural -> ProtVer) -> Lens' ProtVer Natural
forall a b. (a -> b) -> a -> b
$ \ProtVer
p Natural
v -> ProtVer
p{L.pvMinor = v}

  prStepsL :: Lens' L.Prices L.NonNegativeInterval
  prStepsL :: Lens' Prices NonNegativeInterval
prStepsL = (Prices -> NonNegativeInterval)
-> (Prices -> NonNegativeInterval -> Prices)
-> Lens' Prices NonNegativeInterval
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Prices -> NonNegativeInterval
L.prSteps ((Prices -> NonNegativeInterval -> Prices)
 -> Lens' Prices NonNegativeInterval)
-> (Prices -> NonNegativeInterval -> Prices)
-> Lens' Prices NonNegativeInterval
forall a b. (a -> b) -> a -> b
$ \Prices
p NonNegativeInterval
v -> Prices
p{L.prSteps = v}

  prMemL :: Lens' L.Prices L.NonNegativeInterval
  prMemL :: Lens' Prices NonNegativeInterval
prMemL = (Prices -> NonNegativeInterval)
-> (Prices -> NonNegativeInterval -> Prices)
-> Lens' Prices NonNegativeInterval
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Prices -> NonNegativeInterval
L.prMem ((Prices -> NonNegativeInterval -> Prices)
 -> Lens' Prices NonNegativeInterval)
-> (Prices -> NonNegativeInterval -> Prices)
-> Lens' Prices NonNegativeInterval
forall a b. (a -> b) -> a -> b
$ \Prices
p NonNegativeInterval
v -> Prices
p{L.prMem = v}

mkChainPointMsg
  :: ChainPoint
  -> WithOrigin BlockNo
  -> Proto UtxoRpc.ChainPoint
mkChainPointMsg :: ChainPoint -> WithOrigin BlockNo -> Proto ChainPoint
mkChainPointMsg ChainPoint
chainPoint WithOrigin BlockNo
blockNo = do
  let (Word64
slotNo, ByteString
blockHash) = case ChainPoint
chainPoint of
        ChainPoint
ChainPointAtGenesis -> (Word64
0, ByteString
forall a. Monoid a => a
mempty)
        ChainPoint (SlotNo Word64
slot) (HeaderHash ShortByteString
hash) -> (Word64
slot, ShortByteString -> ByteString
SBS.fromShort ShortByteString
hash)
      blockHeight :: Word64
blockHeight = case WithOrigin BlockNo
blockNo of
        WithOrigin BlockNo
Origin -> Word64
0
        At (BlockNo Word64
h) -> Word64
h
  Proto ChainPoint
forall msg. Message msg => msg
defMessage
    Proto ChainPoint
-> (Proto ChainPoint -> Proto ChainPoint) -> Proto ChainPoint
forall a b. a -> (a -> b) -> b
& ASetter (Proto ChainPoint) (Proto ChainPoint) Word64 Word64
#slot ASetter (Proto ChainPoint) (Proto ChainPoint) Word64 Word64
-> Word64 -> Proto ChainPoint -> Proto ChainPoint
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word64
slotNo
    Proto ChainPoint
-> (Proto ChainPoint -> Proto ChainPoint) -> Proto ChainPoint
forall a b. a -> (a -> b) -> b
& ASetter (Proto ChainPoint) (Proto ChainPoint) ByteString ByteString
#hash ASetter (Proto ChainPoint) (Proto ChainPoint) ByteString ByteString
-> ByteString -> Proto ChainPoint -> Proto ChainPoint
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ByteString
blockHash
    Proto ChainPoint
-> (Proto ChainPoint -> Proto ChainPoint) -> Proto ChainPoint
forall a b. a -> (a -> b) -> b
& ASetter (Proto ChainPoint) (Proto ChainPoint) Word64 Word64
#height ASetter (Proto ChainPoint) (Proto ChainPoint) Word64 Word64
-> Word64 -> Proto ChainPoint -> Proto ChainPoint
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word64
blockHeight

simpleScriptToUtxoRpcNativeScript :: SimpleScript -> Proto UtxoRpc.NativeScript
simpleScriptToUtxoRpcNativeScript :: SimpleScript -> Proto NativeScript
simpleScriptToUtxoRpcNativeScript = \case
  RequireSignature Hash PaymentKey
paymentKeyHash ->
    Proto NativeScript
forall msg. Message msg => msg
defMessage Proto NativeScript
-> (Proto NativeScript -> Proto NativeScript) -> Proto NativeScript
forall a b. a -> (a -> b) -> b
& ASetter
  (Proto NativeScript) (Proto NativeScript) ByteString ByteString
#scriptPubkey ASetter
  (Proto NativeScript) (Proto NativeScript) ByteString ByteString
-> ByteString -> Proto NativeScript -> Proto NativeScript
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Hash PaymentKey -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes Hash PaymentKey
paymentKeyHash
  RequireTimeBefore (SlotNo Word64
slotNo) ->
    Proto NativeScript
forall msg. Message msg => msg
defMessage Proto NativeScript
-> (Proto NativeScript -> Proto NativeScript) -> Proto NativeScript
forall a b. a -> (a -> b) -> b
& ASetter (Proto NativeScript) (Proto NativeScript) Word64 Word64
#invalidHereafter ASetter (Proto NativeScript) (Proto NativeScript) Word64 Word64
-> Word64 -> Proto NativeScript -> Proto NativeScript
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word64
slotNo
  RequireTimeAfter (SlotNo Word64
slotNo) ->
    Proto NativeScript
forall msg. Message msg => msg
defMessage Proto NativeScript
-> (Proto NativeScript -> Proto NativeScript) -> Proto NativeScript
forall a b. a -> (a -> b) -> b
& ASetter (Proto NativeScript) (Proto NativeScript) Word64 Word64
#invalidBefore ASetter (Proto NativeScript) (Proto NativeScript) Word64 Word64
-> Word64 -> Proto NativeScript -> Proto NativeScript
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word64
slotNo
  RequireAllOf [SimpleScript]
scripts ->
    Proto NativeScript
forall msg. Message msg => msg
defMessage Proto NativeScript
-> (Proto NativeScript -> Proto NativeScript) -> Proto NativeScript
forall a b. a -> (a -> b) -> b
& (Proto NativeScriptList -> Identity (Proto NativeScriptList))
-> Proto NativeScript -> Identity (Proto NativeScript)
#scriptAll ((Proto NativeScriptList -> Identity (Proto NativeScriptList))
 -> Proto NativeScript -> Identity (Proto NativeScript))
-> (([Proto NativeScript] -> Identity [Proto NativeScript])
    -> Proto NativeScriptList -> Identity (Proto NativeScriptList))
-> ([Proto NativeScript] -> Identity [Proto NativeScript])
-> Proto NativeScript
-> Identity (Proto NativeScript)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Proto NativeScript] -> Identity [Proto NativeScript])
-> Proto NativeScriptList -> Identity (Proto NativeScriptList)
#items (([Proto NativeScript] -> Identity [Proto NativeScript])
 -> Proto NativeScript -> Identity (Proto NativeScript))
-> [Proto NativeScript] -> Proto NativeScript -> Proto NativeScript
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (SimpleScript -> Proto NativeScript)
-> [SimpleScript] -> [Proto NativeScript]
forall a b. (a -> b) -> [a] -> [b]
map SimpleScript -> Proto NativeScript
simpleScriptToUtxoRpcNativeScript [SimpleScript]
scripts
  RequireAnyOf [SimpleScript]
scripts ->
    Proto NativeScript
forall msg. Message msg => msg
defMessage Proto NativeScript
-> (Proto NativeScript -> Proto NativeScript) -> Proto NativeScript
forall a b. a -> (a -> b) -> b
& (Proto NativeScriptList -> Identity (Proto NativeScriptList))
-> Proto NativeScript -> Identity (Proto NativeScript)
#scriptAny ((Proto NativeScriptList -> Identity (Proto NativeScriptList))
 -> Proto NativeScript -> Identity (Proto NativeScript))
-> (([Proto NativeScript] -> Identity [Proto NativeScript])
    -> Proto NativeScriptList -> Identity (Proto NativeScriptList))
-> ([Proto NativeScript] -> Identity [Proto NativeScript])
-> Proto NativeScript
-> Identity (Proto NativeScript)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Proto NativeScript] -> Identity [Proto NativeScript])
-> Proto NativeScriptList -> Identity (Proto NativeScriptList)
#items (([Proto NativeScript] -> Identity [Proto NativeScript])
 -> Proto NativeScript -> Identity (Proto NativeScript))
-> [Proto NativeScript] -> Proto NativeScript -> Proto NativeScript
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (SimpleScript -> Proto NativeScript)
-> [SimpleScript] -> [Proto NativeScript]
forall a b. (a -> b) -> [a] -> [b]
map SimpleScript -> Proto NativeScript
simpleScriptToUtxoRpcNativeScript [SimpleScript]
scripts
  RequireMOf Int
k [SimpleScript]
scripts -> do
    let nScriptsOf :: Proto ScriptNOfK
nScriptsOf =
          Proto ScriptNOfK
forall msg. Message msg => msg
defMessage
            Proto ScriptNOfK
-> (Proto ScriptNOfK -> Proto ScriptNOfK) -> Proto ScriptNOfK
forall a b. a -> (a -> b) -> b
& ASetter (Proto ScriptNOfK) (Proto ScriptNOfK) Word32 Word32
#k ASetter (Proto ScriptNOfK) (Proto ScriptNOfK) Word32 Word32
-> Word32 -> Proto ScriptNOfK -> Proto ScriptNOfK
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k
            Proto ScriptNOfK
-> (Proto ScriptNOfK -> Proto ScriptNOfK) -> Proto ScriptNOfK
forall a b. a -> (a -> b) -> b
& ASetter
  (Proto ScriptNOfK)
  (Proto ScriptNOfK)
  [Proto NativeScript]
  [Proto NativeScript]
#scripts ASetter
  (Proto ScriptNOfK)
  (Proto ScriptNOfK)
  [Proto NativeScript]
  [Proto NativeScript]
-> [Proto NativeScript] -> Proto ScriptNOfK -> Proto ScriptNOfK
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (SimpleScript -> Proto NativeScript)
-> [SimpleScript] -> [Proto NativeScript]
forall a b. (a -> b) -> [a] -> [b]
map SimpleScript -> Proto NativeScript
simpleScriptToUtxoRpcNativeScript [SimpleScript]
scripts
    Proto NativeScript
forall msg. Message msg => msg
defMessage Proto NativeScript
-> (Proto NativeScript -> Proto NativeScript) -> Proto NativeScript
forall a b. a -> (a -> b) -> b
& ASetter
  (Proto NativeScript)
  (Proto NativeScript)
  (Proto ScriptNOfK)
  (Proto ScriptNOfK)
#scriptNOfK ASetter
  (Proto NativeScript)
  (Proto NativeScript)
  (Proto ScriptNOfK)
  (Proto ScriptNOfK)
-> Proto ScriptNOfK -> Proto NativeScript -> Proto NativeScript
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proto ScriptNOfK
nScriptsOf

utxoRpcNativeScriptToSimpleScript
  :: HasCallStack
  => MonadThrow m
  => Proto UtxoRpc.NativeScript
  -> m SimpleScript
utxoRpcNativeScriptToSimpleScript :: forall (m :: * -> *).
(HasCallStack, MonadThrow m) =>
Proto NativeScript -> m SimpleScript
utxoRpcNativeScriptToSimpleScript Proto NativeScript
scriptRpc
  | Just ByteString
paymentKeyHash <- Proto NativeScript
scriptRpc Proto NativeScript
-> Getting
     (Maybe ByteString) (Proto NativeScript) (Maybe ByteString)
-> Maybe ByteString
forall s a. s -> Getting a s a -> a
^. Getting (Maybe ByteString) (Proto NativeScript) (Maybe ByteString)
#maybe'scriptPubkey =
      Hash PaymentKey -> SimpleScript
RequireSignature (Hash PaymentKey -> SimpleScript)
-> m (Hash PaymentKey) -> m SimpleScript
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either SerialiseAsRawBytesError (Hash PaymentKey)
-> m (Hash PaymentKey)
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Typeable e, Error e) =>
Either e a -> m a
liftEitherError (AsType (Hash PaymentKey)
-> ByteString -> Either SerialiseAsRawBytesError (Hash PaymentKey)
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either SerialiseAsRawBytesError a
deserialiseFromRawBytes AsType (Hash PaymentKey)
forall t. HasTypeProxy t => AsType t
asType ByteString
paymentKeyHash)
  | Just Word64
slotNo <- Proto NativeScript
scriptRpc Proto NativeScript
-> Getting (Maybe Word64) (Proto NativeScript) (Maybe Word64)
-> Maybe Word64
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Word64) (Proto NativeScript) (Maybe Word64)
#maybe'invalidHereafter =
      SimpleScript -> m SimpleScript
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SimpleScript -> m SimpleScript)
-> (SlotNo -> SimpleScript) -> SlotNo -> m SimpleScript
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotNo -> SimpleScript
RequireTimeBefore (SlotNo -> m SimpleScript) -> SlotNo -> m SimpleScript
forall a b. (a -> b) -> a -> b
$ Word64 -> SlotNo
SlotNo Word64
slotNo
  | Just Word64
slotNo <- Proto NativeScript
scriptRpc Proto NativeScript
-> Getting (Maybe Word64) (Proto NativeScript) (Maybe Word64)
-> Maybe Word64
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Word64) (Proto NativeScript) (Maybe Word64)
#maybe'invalidBefore =
      SimpleScript -> m SimpleScript
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SimpleScript -> m SimpleScript)
-> (SlotNo -> SimpleScript) -> SlotNo -> m SimpleScript
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotNo -> SimpleScript
RequireTimeAfter (SlotNo -> m SimpleScript) -> SlotNo -> m SimpleScript
forall a b. (a -> b) -> a -> b
$ Word64 -> SlotNo
SlotNo Word64
slotNo
  | Just Proto NativeScriptList
scriptsRpc <- Proto NativeScript
scriptRpc Proto NativeScript
-> Getting
     (Maybe (Proto NativeScriptList))
     (Proto NativeScript)
     (Maybe (Proto NativeScriptList))
-> Maybe (Proto NativeScriptList)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Proto NativeScriptList))
  (Proto NativeScript)
  (Maybe (Proto NativeScriptList))
#maybe'scriptAll = do
      ([SimpleScript] -> SimpleScript)
-> m [SimpleScript] -> m SimpleScript
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [SimpleScript] -> SimpleScript
RequireAllOf (m [SimpleScript] -> m SimpleScript)
-> m [SimpleScript] -> m SimpleScript
forall a b. (a -> b) -> a -> b
$
        (Proto NativeScript -> m SimpleScript)
-> [Proto NativeScript] -> m [SimpleScript]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Proto NativeScript -> m SimpleScript
forall (m :: * -> *).
(HasCallStack, MonadThrow m) =>
Proto NativeScript -> m SimpleScript
utxoRpcNativeScriptToSimpleScript ([Proto NativeScript] -> m [SimpleScript])
-> [Proto NativeScript] -> m [SimpleScript]
forall a b. (a -> b) -> a -> b
$
          Proto NativeScriptList
scriptsRpc Proto NativeScriptList
-> Getting
     [Proto NativeScript] (Proto NativeScriptList) [Proto NativeScript]
-> [Proto NativeScript]
forall s a. s -> Getting a s a -> a
^. Getting
  [Proto NativeScript] (Proto NativeScriptList) [Proto NativeScript]
#items
  | Just Proto NativeScriptList
scriptsRpc <- Proto NativeScript
scriptRpc Proto NativeScript
-> Getting
     (Maybe (Proto NativeScriptList))
     (Proto NativeScript)
     (Maybe (Proto NativeScriptList))
-> Maybe (Proto NativeScriptList)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Proto NativeScriptList))
  (Proto NativeScript)
  (Maybe (Proto NativeScriptList))
#maybe'scriptAny = do
      ([SimpleScript] -> SimpleScript)
-> m [SimpleScript] -> m SimpleScript
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [SimpleScript] -> SimpleScript
RequireAnyOf (m [SimpleScript] -> m SimpleScript)
-> m [SimpleScript] -> m SimpleScript
forall a b. (a -> b) -> a -> b
$
        (Proto NativeScript -> m SimpleScript)
-> [Proto NativeScript] -> m [SimpleScript]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Proto NativeScript -> m SimpleScript
forall (m :: * -> *).
(HasCallStack, MonadThrow m) =>
Proto NativeScript -> m SimpleScript
utxoRpcNativeScriptToSimpleScript ([Proto NativeScript] -> m [SimpleScript])
-> [Proto NativeScript] -> m [SimpleScript]
forall a b. (a -> b) -> a -> b
$
          Proto NativeScriptList
scriptsRpc Proto NativeScriptList
-> Getting
     [Proto NativeScript] (Proto NativeScriptList) [Proto NativeScript]
-> [Proto NativeScript]
forall s a. s -> Getting a s a -> a
^. Getting
  [Proto NativeScript] (Proto NativeScriptList) [Proto NativeScript]
#items
  | Just Proto ScriptNOfK
scriptsRpc <- Proto NativeScript
scriptRpc Proto NativeScript
-> Getting
     (Maybe (Proto ScriptNOfK))
     (Proto NativeScript)
     (Maybe (Proto ScriptNOfK))
-> Maybe (Proto ScriptNOfK)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Proto ScriptNOfK))
  (Proto NativeScript)
  (Maybe (Proto ScriptNOfK))
#maybe'scriptNOfK = do
      ([SimpleScript] -> SimpleScript)
-> m [SimpleScript] -> m SimpleScript
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> [SimpleScript] -> SimpleScript
RequireMOf (Int -> [SimpleScript] -> SimpleScript)
-> (Word32 -> Int) -> Word32 -> [SimpleScript] -> SimpleScript
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> [SimpleScript] -> SimpleScript)
-> Word32 -> [SimpleScript] -> SimpleScript
forall a b. (a -> b) -> a -> b
$ Proto ScriptNOfK
scriptsRpc Proto ScriptNOfK
-> Getting Word32 (Proto ScriptNOfK) Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. Getting Word32 (Proto ScriptNOfK) Word32
#k) (m [SimpleScript] -> m SimpleScript)
-> m [SimpleScript] -> m SimpleScript
forall a b. (a -> b) -> a -> b
$
        (Proto NativeScript -> m SimpleScript)
-> [Proto NativeScript] -> m [SimpleScript]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Proto NativeScript -> m SimpleScript
forall (m :: * -> *).
(HasCallStack, MonadThrow m) =>
Proto NativeScript -> m SimpleScript
utxoRpcNativeScriptToSimpleScript ([Proto NativeScript] -> m [SimpleScript])
-> [Proto NativeScript] -> m [SimpleScript]
forall a b. (a -> b) -> a -> b
$
          Proto ScriptNOfK
scriptsRpc Proto ScriptNOfK
-> Getting
     [Proto NativeScript] (Proto ScriptNOfK) [Proto NativeScript]
-> [Proto NativeScript]
forall s a. s -> Getting a s a -> a
^. Getting
  [Proto NativeScript] (Proto ScriptNOfK) [Proto NativeScript]
#scripts
  | Bool
otherwise = StringException -> m SimpleScript
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (StringException -> m SimpleScript)
-> (String -> StringException) -> String -> m SimpleScript
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => String -> StringException
String -> StringException
stringException (String -> m SimpleScript) -> String -> m SimpleScript
forall a b. (a -> b) -> a -> b
$ String
"Cannot decode UTxORPC NativeScript"

referenceScriptToUtxoRpcScript :: ReferenceScript era -> Proto UtxoRpc.Script
referenceScriptToUtxoRpcScript :: forall era. ReferenceScript era -> Proto Script
referenceScriptToUtxoRpcScript ReferenceScript era
ReferenceScriptNone = Proto Script
forall msg. Message msg => msg
defMessage
referenceScriptToUtxoRpcScript (ReferenceScript BabbageEraOnwards era
_ (ScriptInAnyLang ScriptLanguage lang
_ Script lang
script)) =
  case Script lang
script of
    SimpleScript SimpleScript
ss ->
      Proto Script
forall msg. Message msg => msg
defMessage Proto Script -> (Proto Script -> Proto Script) -> Proto Script
forall a b. a -> (a -> b) -> b
& ASetter
  (Proto Script)
  (Proto Script)
  (Proto NativeScript)
  (Proto NativeScript)
#native ASetter
  (Proto Script)
  (Proto Script)
  (Proto NativeScript)
  (Proto NativeScript)
-> Proto NativeScript -> Proto Script -> Proto Script
forall s t a b. ASetter s t a b -> b -> s -> t
.~ SimpleScript -> Proto NativeScript
simpleScriptToUtxoRpcNativeScript SimpleScript
ss
    PlutusScript PlutusScriptVersion lang
PlutusScriptV1 PlutusScript lang
ps ->
      Proto Script
forall msg. Message msg => msg
defMessage Proto Script -> (Proto Script -> Proto Script) -> Proto Script
forall a b. a -> (a -> b) -> b
& ASetter (Proto Script) (Proto Script) ByteString ByteString
#plutusV1 ASetter (Proto Script) (Proto Script) ByteString ByteString
-> ByteString -> Proto Script -> Proto Script
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PlutusScript lang -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes PlutusScript lang
ps
    PlutusScript PlutusScriptVersion lang
PlutusScriptV2 PlutusScript lang
ps ->
      Proto Script
forall msg. Message msg => msg
defMessage Proto Script -> (Proto Script -> Proto Script) -> Proto Script
forall a b. a -> (a -> b) -> b
& ASetter (Proto Script) (Proto Script) ByteString ByteString
#plutusV2 ASetter (Proto Script) (Proto Script) ByteString ByteString
-> ByteString -> Proto Script -> Proto Script
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PlutusScript lang -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes PlutusScript lang
ps
    PlutusScript PlutusScriptVersion lang
PlutusScriptV3 PlutusScript lang
ps ->
      Proto Script
forall msg. Message msg => msg
defMessage Proto Script -> (Proto Script -> Proto Script) -> Proto Script
forall a b. a -> (a -> b) -> b
& ASetter (Proto Script) (Proto Script) ByteString ByteString
#plutusV3 ASetter (Proto Script) (Proto Script) ByteString ByteString
-> ByteString -> Proto Script -> Proto Script
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PlutusScript lang -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes PlutusScript lang
ps
    PlutusScript PlutusScriptVersion lang
PlutusScriptV4 PlutusScript lang
ps ->
      Proto Script
forall msg. Message msg => msg
defMessage Proto Script -> (Proto Script -> Proto Script) -> Proto Script
forall a b. a -> (a -> b) -> b
& ASetter (Proto Script) (Proto Script) ByteString ByteString
#plutusV4 ASetter (Proto Script) (Proto Script) ByteString ByteString
-> ByteString -> Proto Script -> Proto Script
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PlutusScript lang -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes PlutusScript lang
ps

utxoRpcScriptToReferenceScript
  :: forall era m
   . HasCallStack
  => MonadThrow m
  => IsEra era
  => Proto UtxoRpc.Script
  -> m (ReferenceScript era)
utxoRpcScriptToReferenceScript :: forall era (m :: * -> *).
(HasCallStack, MonadThrow m, IsEra era) =>
Proto Script -> m (ReferenceScript era)
utxoRpcScriptToReferenceScript Proto Script
protoScript
  | Just Proto NativeScript
script <- Proto Script
protoScript Proto Script
-> Getting
     (Maybe (Proto NativeScript))
     (Proto Script)
     (Maybe (Proto NativeScript))
-> Maybe (Proto NativeScript)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Proto NativeScript))
  (Proto Script)
  (Maybe (Proto NativeScript))
#maybe'native =
      BabbageEraOnwards era -> ScriptInAnyLang -> ReferenceScript era
forall era.
BabbageEraOnwards era -> ScriptInAnyLang -> ReferenceScript era
ReferenceScript (Era era -> BabbageEraOnwards era
forall era. Era era -> BabbageEraOnwards era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert (Era era -> BabbageEraOnwards era)
-> Era era -> BabbageEraOnwards era
forall a b. (a -> b) -> a -> b
$ forall era. IsEra era => Era era
useEra @era) (ScriptInAnyLang -> ReferenceScript era)
-> (SimpleScript -> ScriptInAnyLang)
-> SimpleScript
-> ReferenceScript era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptLanguage SimpleScript'
-> Script SimpleScript' -> ScriptInAnyLang
forall lang. ScriptLanguage lang -> Script lang -> ScriptInAnyLang
ScriptInAnyLang ScriptLanguage SimpleScript'
SimpleScriptLanguage (Script SimpleScript' -> ScriptInAnyLang)
-> (SimpleScript -> Script SimpleScript')
-> SimpleScript
-> ScriptInAnyLang
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleScript -> Script SimpleScript'
SimpleScript
        (SimpleScript -> ReferenceScript era)
-> m SimpleScript -> m (ReferenceScript era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proto NativeScript -> m SimpleScript
forall (m :: * -> *).
(HasCallStack, MonadThrow m) =>
Proto NativeScript -> m SimpleScript
utxoRpcNativeScriptToSimpleScript Proto NativeScript
script
  | Just ByteString
script <- Proto Script
protoScript Proto Script
-> Getting (Maybe ByteString) (Proto Script) (Maybe ByteString)
-> Maybe ByteString
forall s a. s -> Getting a s a -> a
^. Getting (Maybe ByteString) (Proto Script) (Maybe ByteString)
#maybe'plutusV1 =
      BabbageEraOnwards era -> ScriptInAnyLang -> ReferenceScript era
forall era.
BabbageEraOnwards era -> ScriptInAnyLang -> ReferenceScript era
ReferenceScript (Era era -> BabbageEraOnwards era
forall era. Era era -> BabbageEraOnwards era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert (Era era -> BabbageEraOnwards era)
-> Era era -> BabbageEraOnwards era
forall a b. (a -> b) -> a -> b
$ forall era. IsEra era => Era era
useEra @era) (ScriptInAnyLang -> ReferenceScript era)
-> (Script PlutusScriptV1 -> ScriptInAnyLang)
-> Script PlutusScriptV1
-> ReferenceScript era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptLanguage PlutusScriptV1
-> Script PlutusScriptV1 -> ScriptInAnyLang
forall lang. ScriptLanguage lang -> Script lang -> ScriptInAnyLang
ScriptInAnyLang (PlutusScriptVersion PlutusScriptV1 -> ScriptLanguage PlutusScriptV1
forall lang.
IsPlutusScriptLanguage lang =>
PlutusScriptVersion lang -> ScriptLanguage lang
PlutusScriptLanguage PlutusScriptVersion PlutusScriptV1
PlutusScriptV1)
        (Script PlutusScriptV1 -> ReferenceScript era)
-> m (Script PlutusScriptV1) -> m (ReferenceScript era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either DecoderError (Script PlutusScriptV1)
-> m (Script PlutusScriptV1)
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Typeable e, Error e) =>
Either e a -> m a
liftEitherError (AsType (Script PlutusScriptV1)
-> ByteString -> Either DecoderError (Script PlutusScriptV1)
forall a.
SerialiseAsCBOR a =>
AsType a -> ByteString -> Either DecoderError a
deserialiseFromCBOR AsType (Script PlutusScriptV1)
forall t. HasTypeProxy t => AsType t
asType ByteString
script)
  | Just ByteString
script <- Proto Script
protoScript Proto Script
-> Getting (Maybe ByteString) (Proto Script) (Maybe ByteString)
-> Maybe ByteString
forall s a. s -> Getting a s a -> a
^. Getting (Maybe ByteString) (Proto Script) (Maybe ByteString)
#maybe'plutusV2 =
      BabbageEraOnwards era -> ScriptInAnyLang -> ReferenceScript era
forall era.
BabbageEraOnwards era -> ScriptInAnyLang -> ReferenceScript era
ReferenceScript (Era era -> BabbageEraOnwards era
forall era. Era era -> BabbageEraOnwards era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert (Era era -> BabbageEraOnwards era)
-> Era era -> BabbageEraOnwards era
forall a b. (a -> b) -> a -> b
$ forall era. IsEra era => Era era
useEra @era) (ScriptInAnyLang -> ReferenceScript era)
-> (Script PlutusScriptV2 -> ScriptInAnyLang)
-> Script PlutusScriptV2
-> ReferenceScript era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptLanguage PlutusScriptV2
-> Script PlutusScriptV2 -> ScriptInAnyLang
forall lang. ScriptLanguage lang -> Script lang -> ScriptInAnyLang
ScriptInAnyLang (PlutusScriptVersion PlutusScriptV2 -> ScriptLanguage PlutusScriptV2
forall lang.
IsPlutusScriptLanguage lang =>
PlutusScriptVersion lang -> ScriptLanguage lang
PlutusScriptLanguage PlutusScriptVersion PlutusScriptV2
PlutusScriptV2)
        (Script PlutusScriptV2 -> ReferenceScript era)
-> m (Script PlutusScriptV2) -> m (ReferenceScript era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either DecoderError (Script PlutusScriptV2)
-> m (Script PlutusScriptV2)
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Typeable e, Error e) =>
Either e a -> m a
liftEitherError (AsType (Script PlutusScriptV2)
-> ByteString -> Either DecoderError (Script PlutusScriptV2)
forall a.
SerialiseAsCBOR a =>
AsType a -> ByteString -> Either DecoderError a
deserialiseFromCBOR AsType (Script PlutusScriptV2)
forall t. HasTypeProxy t => AsType t
asType ByteString
script)
  | Just ByteString
script <- Proto Script
protoScript Proto Script
-> Getting (Maybe ByteString) (Proto Script) (Maybe ByteString)
-> Maybe ByteString
forall s a. s -> Getting a s a -> a
^. Getting (Maybe ByteString) (Proto Script) (Maybe ByteString)
#maybe'plutusV3 =
      BabbageEraOnwards era -> ScriptInAnyLang -> ReferenceScript era
forall era.
BabbageEraOnwards era -> ScriptInAnyLang -> ReferenceScript era
ReferenceScript (Era era -> BabbageEraOnwards era
forall era. Era era -> BabbageEraOnwards era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert (Era era -> BabbageEraOnwards era)
-> Era era -> BabbageEraOnwards era
forall a b. (a -> b) -> a -> b
$ forall era. IsEra era => Era era
useEra @era) (ScriptInAnyLang -> ReferenceScript era)
-> (Script PlutusScriptV3 -> ScriptInAnyLang)
-> Script PlutusScriptV3
-> ReferenceScript era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptLanguage PlutusScriptV3
-> Script PlutusScriptV3 -> ScriptInAnyLang
forall lang. ScriptLanguage lang -> Script lang -> ScriptInAnyLang
ScriptInAnyLang (PlutusScriptVersion PlutusScriptV3 -> ScriptLanguage PlutusScriptV3
forall lang.
IsPlutusScriptLanguage lang =>
PlutusScriptVersion lang -> ScriptLanguage lang
PlutusScriptLanguage PlutusScriptVersion PlutusScriptV3
PlutusScriptV3)
        (Script PlutusScriptV3 -> ReferenceScript era)
-> m (Script PlutusScriptV3) -> m (ReferenceScript era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either DecoderError (Script PlutusScriptV3)
-> m (Script PlutusScriptV3)
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Typeable e, Error e) =>
Either e a -> m a
liftEitherError (AsType (Script PlutusScriptV3)
-> ByteString -> Either DecoderError (Script PlutusScriptV3)
forall a.
SerialiseAsCBOR a =>
AsType a -> ByteString -> Either DecoderError a
deserialiseFromCBOR AsType (Script PlutusScriptV3)
forall t. HasTypeProxy t => AsType t
asType ByteString
script)
  | Just ByteString
script <- Proto Script
protoScript Proto Script
-> Getting (Maybe ByteString) (Proto Script) (Maybe ByteString)
-> Maybe ByteString
forall s a. s -> Getting a s a -> a
^. Getting (Maybe ByteString) (Proto Script) (Maybe ByteString)
#maybe'plutusV4 =
      BabbageEraOnwards era -> ScriptInAnyLang -> ReferenceScript era
forall era.
BabbageEraOnwards era -> ScriptInAnyLang -> ReferenceScript era
ReferenceScript (Era era -> BabbageEraOnwards era
forall era. Era era -> BabbageEraOnwards era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert (Era era -> BabbageEraOnwards era)
-> Era era -> BabbageEraOnwards era
forall a b. (a -> b) -> a -> b
$ forall era. IsEra era => Era era
useEra @era) (ScriptInAnyLang -> ReferenceScript era)
-> (Script PlutusScriptV4 -> ScriptInAnyLang)
-> Script PlutusScriptV4
-> ReferenceScript era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptLanguage PlutusScriptV4
-> Script PlutusScriptV4 -> ScriptInAnyLang
forall lang. ScriptLanguage lang -> Script lang -> ScriptInAnyLang
ScriptInAnyLang (PlutusScriptVersion PlutusScriptV4 -> ScriptLanguage PlutusScriptV4
forall lang.
IsPlutusScriptLanguage lang =>
PlutusScriptVersion lang -> ScriptLanguage lang
PlutusScriptLanguage PlutusScriptVersion PlutusScriptV4
PlutusScriptV4)
        (Script PlutusScriptV4 -> ReferenceScript era)
-> m (Script PlutusScriptV4) -> m (ReferenceScript era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either DecoderError (Script PlutusScriptV4)
-> m (Script PlutusScriptV4)
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Typeable e, Error e) =>
Either e a -> m a
liftEitherError (AsType (Script PlutusScriptV4)
-> ByteString -> Either DecoderError (Script PlutusScriptV4)
forall a.
SerialiseAsCBOR a =>
AsType a -> ByteString -> Either DecoderError a
deserialiseFromCBOR AsType (Script PlutusScriptV4)
forall t. HasTypeProxy t => AsType t
asType ByteString
script)
  | Bool
otherwise = ReferenceScript era -> m (ReferenceScript era)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReferenceScript era
forall era. ReferenceScript era
ReferenceScriptNone

scriptDataToUtxoRpcPlutusData :: ScriptData -> Proto UtxoRpc.PlutusData
scriptDataToUtxoRpcPlutusData :: ScriptData -> Proto PlutusData
scriptDataToUtxoRpcPlutusData = \case
  ScriptDataBytes ByteString
bs ->
    Proto PlutusData
forall msg. Message msg => msg
defMessage Proto PlutusData
-> (Proto PlutusData -> Proto PlutusData) -> Proto PlutusData
forall a b. a -> (a -> b) -> b
& ASetter (Proto PlutusData) (Proto PlutusData) ByteString ByteString
#boundedBytes ASetter (Proto PlutusData) (Proto PlutusData) ByteString ByteString
-> ByteString -> Proto PlutusData -> Proto PlutusData
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ByteString
bs
  ScriptDataNumber Integer
int
    | Integer
int Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound @Int64)
        Bool -> Bool -> Bool
&& Integer
int Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
minBound @Int64) ->
        Proto PlutusData
forall msg. Message msg => msg
defMessage Proto PlutusData
-> (Proto PlutusData -> Proto PlutusData) -> Proto PlutusData
forall a b. a -> (a -> b) -> b
& (Proto BigInt -> Identity (Proto BigInt))
-> Proto PlutusData -> Identity (Proto PlutusData)
#bigInt ((Proto BigInt -> Identity (Proto BigInt))
 -> Proto PlutusData -> Identity (Proto PlutusData))
-> ((Int64 -> Identity Int64)
    -> Proto BigInt -> Identity (Proto BigInt))
-> (Int64 -> Identity Int64)
-> Proto PlutusData
-> Identity (Proto PlutusData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int64 -> Identity Int64)
-> Proto BigInt -> Identity (Proto BigInt)
#int ((Int64 -> Identity Int64)
 -> Proto PlutusData -> Identity (Proto PlutusData))
-> Int64 -> Proto PlutusData -> Proto PlutusData
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
int
    | Integer
int Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 ->
        -- https://www.rfc-editor.org/rfc/rfc8949.html#name-bignums see 3.4.3 for negative integers
        Proto PlutusData
forall msg. Message msg => msg
defMessage Proto PlutusData
-> (Proto PlutusData -> Proto PlutusData) -> Proto PlutusData
forall a b. a -> (a -> b) -> b
& (Proto BigInt -> Identity (Proto BigInt))
-> Proto PlutusData -> Identity (Proto PlutusData)
#bigInt ((Proto BigInt -> Identity (Proto BigInt))
 -> Proto PlutusData -> Identity (Proto PlutusData))
-> ((ByteString -> Identity ByteString)
    -> Proto BigInt -> Identity (Proto BigInt))
-> ASetter
     (Proto PlutusData) (Proto PlutusData) ByteString ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Identity ByteString)
-> Proto BigInt -> Identity (Proto BigInt)
#bigNInt ASetter (Proto PlutusData) (Proto PlutusData) ByteString ByteString
-> ByteString -> Proto PlutusData -> Proto PlutusData
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes (forall a b. (Integral a, Num b) => a -> b
fromIntegral @_ @Natural (-Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
int))
    | Bool
otherwise ->
        Proto PlutusData
forall msg. Message msg => msg
defMessage Proto PlutusData
-> (Proto PlutusData -> Proto PlutusData) -> Proto PlutusData
forall a b. a -> (a -> b) -> b
& (Proto BigInt -> Identity (Proto BigInt))
-> Proto PlutusData -> Identity (Proto PlutusData)
#bigInt ((Proto BigInt -> Identity (Proto BigInt))
 -> Proto PlutusData -> Identity (Proto PlutusData))
-> ((ByteString -> Identity ByteString)
    -> Proto BigInt -> Identity (Proto BigInt))
-> ASetter
     (Proto PlutusData) (Proto PlutusData) ByteString ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Identity ByteString)
-> Proto BigInt -> Identity (Proto BigInt)
#bigUInt ASetter (Proto PlutusData) (Proto PlutusData) ByteString ByteString
-> ByteString -> Proto PlutusData -> Proto PlutusData
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes (forall a b. (Integral a, Num b) => a -> b
fromIntegral @_ @Natural Integer
int)
  ScriptDataList [ScriptData]
sds ->
    Proto PlutusData
forall msg. Message msg => msg
defMessage Proto PlutusData
-> (Proto PlutusData -> Proto PlutusData) -> Proto PlutusData
forall a b. a -> (a -> b) -> b
& (Proto PlutusDataArray -> Identity (Proto PlutusDataArray))
-> Proto PlutusData -> Identity (Proto PlutusData)
#array ((Proto PlutusDataArray -> Identity (Proto PlutusDataArray))
 -> Proto PlutusData -> Identity (Proto PlutusData))
-> (([Proto PlutusData] -> Identity [Proto PlutusData])
    -> Proto PlutusDataArray -> Identity (Proto PlutusDataArray))
-> ([Proto PlutusData] -> Identity [Proto PlutusData])
-> Proto PlutusData
-> Identity (Proto PlutusData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Proto PlutusData] -> Identity [Proto PlutusData])
-> Proto PlutusDataArray -> Identity (Proto PlutusDataArray)
#items (([Proto PlutusData] -> Identity [Proto PlutusData])
 -> Proto PlutusData -> Identity (Proto PlutusData))
-> [Proto PlutusData] -> Proto PlutusData -> Proto PlutusData
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (ScriptData -> Proto PlutusData)
-> [ScriptData] -> [Proto PlutusData]
forall a b. (a -> b) -> [a] -> [b]
map ScriptData -> Proto PlutusData
scriptDataToUtxoRpcPlutusData [ScriptData]
sds
  ScriptDataMap [(ScriptData, ScriptData)]
elements -> do
    let pairs :: [Proto PlutusDataPair]
pairs =
          [(ScriptData, ScriptData)]
elements [(ScriptData, ScriptData)]
-> ((ScriptData, ScriptData) -> Proto PlutusDataPair)
-> [Proto PlutusDataPair]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(ScriptData
k, ScriptData
v) ->
            Proto PlutusDataPair
forall msg. Message msg => msg
defMessage
              Proto PlutusDataPair
-> (Proto PlutusDataPair -> Proto PlutusDataPair)
-> Proto PlutusDataPair
forall a b. a -> (a -> b) -> b
& ASetter
  (Proto PlutusDataPair)
  (Proto PlutusDataPair)
  (Proto PlutusData)
  (Proto PlutusData)
#key ASetter
  (Proto PlutusDataPair)
  (Proto PlutusDataPair)
  (Proto PlutusData)
  (Proto PlutusData)
-> Proto PlutusData -> Proto PlutusDataPair -> Proto PlutusDataPair
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ScriptData -> Proto PlutusData
scriptDataToUtxoRpcPlutusData ScriptData
k
              Proto PlutusDataPair
-> (Proto PlutusDataPair -> Proto PlutusDataPair)
-> Proto PlutusDataPair
forall a b. a -> (a -> b) -> b
& ASetter
  (Proto PlutusDataPair)
  (Proto PlutusDataPair)
  (Proto PlutusData)
  (Proto PlutusData)
#value ASetter
  (Proto PlutusDataPair)
  (Proto PlutusDataPair)
  (Proto PlutusData)
  (Proto PlutusData)
-> Proto PlutusData -> Proto PlutusDataPair -> Proto PlutusDataPair
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ScriptData -> Proto PlutusData
scriptDataToUtxoRpcPlutusData ScriptData
v
    Proto PlutusData
forall msg. Message msg => msg
defMessage Proto PlutusData
-> (Proto PlutusData -> Proto PlutusData) -> Proto PlutusData
forall a b. a -> (a -> b) -> b
& (Proto PlutusDataMap -> Identity (Proto PlutusDataMap))
-> Proto PlutusData -> Identity (Proto PlutusData)
#map ((Proto PlutusDataMap -> Identity (Proto PlutusDataMap))
 -> Proto PlutusData -> Identity (Proto PlutusData))
-> (([Proto PlutusDataPair] -> Identity [Proto PlutusDataPair])
    -> Proto PlutusDataMap -> Identity (Proto PlutusDataMap))
-> ([Proto PlutusDataPair] -> Identity [Proto PlutusDataPair])
-> Proto PlutusData
-> Identity (Proto PlutusData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Proto PlutusDataPair] -> Identity [Proto PlutusDataPair])
-> Proto PlutusDataMap -> Identity (Proto PlutusDataMap)
#pairs (([Proto PlutusDataPair] -> Identity [Proto PlutusDataPair])
 -> Proto PlutusData -> Identity (Proto PlutusData))
-> [Proto PlutusDataPair] -> Proto PlutusData -> Proto PlutusData
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Proto PlutusDataPair]
pairs
  ScriptDataConstructor Integer
tag [ScriptData]
args -> do
    -- Details of plutus tag serialisation:
    -- https://github.com/IntersectMBO/plutus/blob/fc78c36b545ee287ae8796a0c1a7d04cf31f4cee/plutus-core/plutus-core/src/PlutusCore/Data.hs#L72
    let constr :: Proto Constr
constr =
          Proto Constr
forall msg. Message msg => msg
defMessage
            Proto Constr -> (Proto Constr -> Proto Constr) -> Proto Constr
forall a b. a -> (a -> b) -> b
& ( if Integer
tag Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound @Word32)
                  then ASetter (Proto Constr) (Proto Constr) Word32 Word32
#tag ASetter (Proto Constr) (Proto Constr) Word32 Word32
-> Word32 -> Proto Constr -> Proto Constr
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 Integer
tag
                  else (ASetter (Proto Constr) (Proto Constr) Word32 Word32
#tag ASetter (Proto Constr) (Proto Constr) Word32 Word32
-> Word32 -> Proto Constr -> Proto Constr
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32
102) (Proto Constr -> Proto Constr)
-> (Proto Constr -> Proto Constr) -> Proto Constr -> Proto Constr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ASetter (Proto Constr) (Proto Constr) Word64 Word64
#anyConstructor ASetter (Proto Constr) (Proto Constr) Word64 Word64
-> Word64 -> Proto Constr -> Proto Constr
forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a b. (Integral a, Num b) => a -> b
fromIntegral @_ @Word64 Integer
tag)
              )
            Proto Constr -> (Proto Constr -> Proto Constr) -> Proto Constr
forall a b. a -> (a -> b) -> b
& ASetter
  (Proto Constr) (Proto Constr) [Proto PlutusData] [Proto PlutusData]
#fields ASetter
  (Proto Constr) (Proto Constr) [Proto PlutusData] [Proto PlutusData]
-> [Proto PlutusData] -> Proto Constr -> Proto Constr
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (ScriptData -> Proto PlutusData)
-> [ScriptData] -> [Proto PlutusData]
forall a b. (a -> b) -> [a] -> [b]
map ScriptData -> Proto PlutusData
scriptDataToUtxoRpcPlutusData [ScriptData]
args
    Proto PlutusData
forall msg. Message msg => msg
defMessage Proto PlutusData
-> (Proto PlutusData -> Proto PlutusData) -> Proto PlutusData
forall a b. a -> (a -> b) -> b
& ASetter
  (Proto PlutusData) (Proto PlutusData) (Proto Constr) (Proto Constr)
#constr ASetter
  (Proto PlutusData) (Proto PlutusData) (Proto Constr) (Proto Constr)
-> Proto Constr -> Proto PlutusData -> Proto PlutusData
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proto Constr
constr

utxoToUtxoRpcAnyUtxoData :: forall era. IsEra era => UTxO era -> [Proto UtxoRpc.AnyUtxoData]
utxoToUtxoRpcAnyUtxoData :: forall era. IsEra era => UTxO era -> [Proto AnyUtxoData]
utxoToUtxoRpcAnyUtxoData UTxO era
utxo =
  UTxO era -> [Item (UTxO era)]
forall l. IsList l => l -> [Item l]
toList UTxO era
utxo [(TxIn, TxOut CtxUTxO era)]
-> ((TxIn, TxOut CtxUTxO era) -> Proto AnyUtxoData)
-> [Proto AnyUtxoData]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(TxIn
txIn, TxOut CtxUTxO era
txOut) -> do
    let era :: Era era
era = forall era. IsEra era => Era era
useEra @era
        txOutCbor :: ByteString
txOutCbor =
          Era era -> (EraCommonConstraints era => ByteString) -> ByteString
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
era ((EraCommonConstraints era => ByteString) -> ByteString)
-> (EraCommonConstraints era => ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$
            TxOut (LedgerEra era) -> ByteString
forall a. ToCBOR a => a -> ByteString
CBOR.serialize' (TxOut (LedgerEra era) -> ByteString)
-> TxOut (LedgerEra era) -> ByteString
forall a b. (a -> b) -> a -> b
$
              ShelleyBasedEra era -> TxOut CtxUTxO era -> TxOut (LedgerEra era)
forall era ledgerera.
(HasCallStack, ShelleyLedgerEra era ~ ledgerera) =>
ShelleyBasedEra era -> TxOut CtxUTxO era -> TxOut ledgerera
toShelleyTxOut (Era era -> ShelleyBasedEra era
forall era. Era era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
era) TxOut CtxUTxO era
txOut
    Proto AnyUtxoData
forall msg. Message msg => msg
defMessage
      Proto AnyUtxoData
-> (Proto AnyUtxoData -> Proto AnyUtxoData) -> Proto AnyUtxoData
forall a b. a -> (a -> b) -> b
& ASetter
  (Proto AnyUtxoData) (Proto AnyUtxoData) ByteString ByteString
#nativeBytes ASetter
  (Proto AnyUtxoData) (Proto AnyUtxoData) ByteString ByteString
-> ByteString -> Proto AnyUtxoData -> Proto AnyUtxoData
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ByteString
txOutCbor
      Proto AnyUtxoData
-> (Proto AnyUtxoData -> Proto AnyUtxoData) -> Proto AnyUtxoData
forall a b. a -> (a -> b) -> b
& ASetter
  (Proto AnyUtxoData)
  (Proto AnyUtxoData)
  (Proto TxoRef)
  (Proto TxoRef)
#txoRef ASetter
  (Proto AnyUtxoData)
  (Proto AnyUtxoData)
  (Proto TxoRef)
  (Proto TxoRef)
-> Proto TxoRef -> Proto AnyUtxoData -> Proto AnyUtxoData
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxIn -> Proto TxoRef
forall t s. Inject t s => t -> s
inject TxIn
txIn
      Proto AnyUtxoData
-> (Proto AnyUtxoData -> Proto AnyUtxoData) -> Proto AnyUtxoData
forall a b. a -> (a -> b) -> b
& ASetter
  (Proto AnyUtxoData)
  (Proto AnyUtxoData)
  (Proto TxOutput)
  (Proto TxOutput)
#cardano ASetter
  (Proto AnyUtxoData)
  (Proto AnyUtxoData)
  (Proto TxOutput)
  (Proto TxOutput)
-> Proto TxOutput -> Proto AnyUtxoData -> Proto AnyUtxoData
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxOut CtxUTxO era -> Proto TxOutput
forall era. IsEra era => TxOut CtxUTxO era -> Proto TxOutput
txOutToUtxoRpcTxOutput TxOut CtxUTxO era
txOut

anyUtxoDataUtxoRpcToUtxo
  :: forall era m
   . HasCallStack
  => MonadThrow m
  => Era era
  -> [Proto UtxoRpc.AnyUtxoData]
  -> m (UTxO era)
anyUtxoDataUtxoRpcToUtxo :: forall era (m :: * -> *).
(HasCallStack, MonadThrow m) =>
Era era -> [Proto AnyUtxoData] -> m (UTxO era)
anyUtxoDataUtxoRpcToUtxo Era era
era = ([(TxIn, TxOut CtxUTxO era)] -> UTxO era)
-> m [(TxIn, TxOut CtxUTxO era)] -> m (UTxO era)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(TxIn, TxOut CtxUTxO era)] -> UTxO era
[Item (UTxO era)] -> UTxO era
forall l. IsList l => [Item l] -> l
fromList (m [(TxIn, TxOut CtxUTxO era)] -> m (UTxO era))
-> ([Proto AnyUtxoData] -> m [(TxIn, TxOut CtxUTxO era)])
-> [Proto AnyUtxoData]
-> m (UTxO era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(TxIn, TxOut CtxUTxO era)]
 -> Proto AnyUtxoData -> m [(TxIn, TxOut CtxUTxO era)])
-> [(TxIn, TxOut CtxUTxO era)]
-> [Proto AnyUtxoData]
-> m [(TxIn, TxOut CtxUTxO era)]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM [(TxIn, TxOut CtxUTxO era)]
-> Proto AnyUtxoData -> m [(TxIn, TxOut CtxUTxO era)]
f [(TxIn, TxOut CtxUTxO era)]
forall a. Monoid a => a
mempty
 where
  f
    :: [(TxIn, TxOut CtxUTxO era)]
    -> Proto UtxoRpc.AnyUtxoData
    -> m [(TxIn, TxOut CtxUTxO era)]
  f :: [(TxIn, TxOut CtxUTxO era)]
-> Proto AnyUtxoData -> m [(TxIn, TxOut CtxUTxO era)]
f [(TxIn, TxOut CtxUTxO era)]
acc Proto AnyUtxoData
e = do
    txOut <- Era era
-> (EraCommonConstraints era => m (TxOut CtxUTxO era))
-> m (TxOut CtxUTxO era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
era ((EraCommonConstraints era => m (TxOut CtxUTxO era))
 -> m (TxOut CtxUTxO era))
-> (EraCommonConstraints era => m (TxOut CtxUTxO era))
-> m (TxOut CtxUTxO era)
forall a b. (a -> b) -> a -> b
$ Proto TxOutput -> m (TxOut CtxUTxO era)
forall era (m :: * -> *).
(HasCallStack, MonadThrow m, IsEra era) =>
Proto TxOutput -> m (TxOut CtxUTxO era)
utxoRpcTxOutputToTxOut (Proto TxOutput -> m (TxOut CtxUTxO era))
-> Proto TxOutput -> m (TxOut CtxUTxO era)
forall a b. (a -> b) -> a -> b
$ Proto AnyUtxoData
e Proto AnyUtxoData
-> Getting (Proto TxOutput) (Proto AnyUtxoData) (Proto TxOutput)
-> Proto TxOutput
forall s a. s -> Getting a s a -> a
^. Getting (Proto TxOutput) (Proto AnyUtxoData) (Proto TxOutput)
#cardano
    txIn <- txoRefUtxoRpcToTxIn $ e ^. #txoRef
    pure $ (txIn, txOut) : acc

txoRefUtxoRpcToTxIn
  :: forall m
   . HasCallStack
  => MonadThrow m
  => Proto UtxoRpc.TxoRef
  -> m TxIn
txoRefUtxoRpcToTxIn :: forall (m :: * -> *).
(HasCallStack, MonadThrow m) =>
Proto TxoRef -> m TxIn
txoRefUtxoRpcToTxIn Proto TxoRef
txoRef = do
  txId' <-
    Either SerialiseAsRawBytesError TxId -> m TxId
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Typeable e, Error e) =>
Either e a -> m a
liftEitherError (Either SerialiseAsRawBytesError TxId -> m TxId)
-> Either SerialiseAsRawBytesError TxId -> m TxId
forall a b. (a -> b) -> a -> b
$
      AsType TxId -> ByteString -> Either SerialiseAsRawBytesError TxId
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either SerialiseAsRawBytesError a
deserialiseFromRawBytes AsType TxId
forall t. HasTypeProxy t => AsType t
asType (ByteString -> Either SerialiseAsRawBytesError TxId)
-> ByteString -> Either SerialiseAsRawBytesError TxId
forall a b. (a -> b) -> a -> b
$
        Proto TxoRef
txoRef Proto TxoRef
-> Getting ByteString (Proto TxoRef) ByteString -> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Proto TxoRef) ByteString
#hash
  pure $ TxIn txId' (TxIx . fromIntegral $ txoRef ^. #index)

txOutToUtxoRpcTxOutput
  :: forall era
   . IsEra era
  => TxOut CtxUTxO era
  -> Proto UtxoRpc.TxOutput
txOutToUtxoRpcTxOutput :: forall era. IsEra era => TxOut CtxUTxO era -> Proto TxOutput
txOutToUtxoRpcTxOutput (TxOut AddressInEra era
addressInEra TxOutValue era
txOutValue TxOutDatum CtxUTxO era
datum ReferenceScript era
script) = do
  let multiAsset :: [Proto MultiAsset]
multiAsset =
        [Item [Proto MultiAsset]] -> [Proto MultiAsset]
forall l. IsList l => [Item l] -> l
fromList ([Item [Proto MultiAsset]] -> [Proto MultiAsset])
-> [Item [Proto MultiAsset]] -> [Proto MultiAsset]
forall a b. (a -> b) -> a -> b
$
          Map PolicyId PolicyAssets -> [Item (Map PolicyId PolicyAssets)]
forall l. IsList l => l -> [Item l]
toList (Value -> Map PolicyId PolicyAssets
valueToPolicyAssets (Value -> Map PolicyId PolicyAssets)
-> Value -> Map PolicyId PolicyAssets
forall a b. (a -> b) -> a -> b
$ TxOutValue era -> Value
forall era. TxOutValue era -> Value
txOutValueToValue TxOutValue era
txOutValue) [(PolicyId, PolicyAssets)]
-> ((PolicyId, PolicyAssets) -> Item [Proto MultiAsset])
-> [Item [Proto MultiAsset]]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(PolicyId
pId, PolicyAssets
policyAssets) -> do
            let assets :: [Proto Asset]
assets =
                  PolicyAssets -> [Item PolicyAssets]
forall l. IsList l => l -> [Item l]
toList PolicyAssets
policyAssets [(AssetName, Quantity)]
-> ((AssetName, Quantity) -> Proto Asset) -> [Proto Asset]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(AssetName
assetName, Quantity Integer
qty) -> do
                    Proto Asset
forall msg. Message msg => msg
defMessage
                      Proto Asset -> (Proto Asset -> Proto Asset) -> Proto Asset
forall a b. a -> (a -> b) -> b
& ASetter (Proto Asset) (Proto Asset) ByteString ByteString
#name ASetter (Proto Asset) (Proto Asset) ByteString ByteString
-> ByteString -> Proto Asset -> Proto Asset
forall s t a b. ASetter s t a b -> b -> s -> t
.~ AssetName -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes AssetName
assetName
                      -- we don't have access to info if the coin was minted in the transaction,
                      -- maybe we should add it later
                      -- & #maybe'mintCoin .~ Nothing
                      Proto Asset -> (Proto Asset -> Proto Asset) -> Proto Asset
forall a b. a -> (a -> b) -> b
& ASetter (Proto Asset) (Proto Asset) Word64 Word64
#outputCoin ASetter (Proto Asset) (Proto Asset) Word64 Word64
-> Word64 -> Proto Asset -> Proto Asset
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
qty
            Item [Proto MultiAsset]
forall msg. Message msg => msg
defMessage
              Item [Proto MultiAsset]
-> (Item [Proto MultiAsset] -> Item [Proto MultiAsset])
-> Item [Proto MultiAsset]
forall a b. a -> (a -> b) -> b
& ASetter
  (Item [Proto MultiAsset])
  (Item [Proto MultiAsset])
  ByteString
  ByteString
#policyId ASetter
  (Item [Proto MultiAsset])
  (Item [Proto MultiAsset])
  ByteString
  ByteString
-> ByteString -> Item [Proto MultiAsset] -> Item [Proto MultiAsset]
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PolicyId -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes PolicyId
pId
              Item [Proto MultiAsset]
-> (Item [Proto MultiAsset] -> Item [Proto MultiAsset])
-> Item [Proto MultiAsset]
forall a b. a -> (a -> b) -> b
& ASetter
  (Item [Proto MultiAsset])
  (Item [Proto MultiAsset])
  [Proto Asset]
  [Proto Asset]
#assets ASetter
  (Item [Proto MultiAsset])
  (Item [Proto MultiAsset])
  [Proto Asset]
  [Proto Asset]
-> [Proto Asset]
-> Item [Proto MultiAsset]
-> Item [Proto MultiAsset]
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Proto Asset]
assets
      datumRpc :: Maybe (Proto Datum)
datumRpc = case TxOutDatum CtxUTxO era
datum of
        TxOutDatum CtxUTxO era
TxOutDatumNone ->
          Maybe (Proto Datum)
forall a. Maybe a
Nothing
        TxOutDatumHash AlonzoEraOnwards era
_ Hash ScriptData
scriptDataHash ->
          Proto Datum -> Maybe (Proto Datum)
forall a. a -> Maybe a
Just (Proto Datum -> Maybe (Proto Datum))
-> Proto Datum -> Maybe (Proto Datum)
forall a b. (a -> b) -> a -> b
$
            Proto Datum
forall msg. Message msg => msg
defMessage
              Proto Datum -> (Proto Datum -> Proto Datum) -> Proto Datum
forall a b. a -> (a -> b) -> b
& ASetter (Proto Datum) (Proto Datum) ByteString ByteString
#hash ASetter (Proto Datum) (Proto Datum) ByteString ByteString
-> ByteString -> Proto Datum -> Proto Datum
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Hash ScriptData -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes Hash ScriptData
scriptDataHash
              Proto Datum -> (Proto Datum -> Proto Datum) -> Proto Datum
forall a b. a -> (a -> b) -> b
& ASetter
  (Proto Datum)
  (Proto Datum)
  (Maybe (Proto PlutusData))
  (Maybe (Proto PlutusData))
#maybe'payload ASetter
  (Proto Datum)
  (Proto Datum)
  (Maybe (Proto PlutusData))
  (Maybe (Proto PlutusData))
-> Maybe (Proto PlutusData) -> Proto Datum -> Proto Datum
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe (Proto PlutusData)
forall a. Maybe a
Nothing -- we don't have it
              Proto Datum -> (Proto Datum -> Proto Datum) -> Proto Datum
forall a b. a -> (a -> b) -> b
& ASetter
  (Proto Datum) (Proto Datum) (Maybe ByteString) (Maybe ByteString)
#maybe'originalCbor ASetter
  (Proto Datum) (Proto Datum) (Maybe ByteString) (Maybe ByteString)
-> Maybe ByteString -> Proto Datum -> Proto Datum
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe ByteString
forall a. Maybe a
Nothing
        TxOutDatumInline BabbageEraOnwards era
_ HashableScriptData
hashableScriptData ->
          Proto Datum -> Maybe (Proto Datum)
forall a. a -> Maybe a
Just (Proto Datum -> Maybe (Proto Datum))
-> Proto Datum -> Maybe (Proto Datum)
forall a b. (a -> b) -> a -> b
$
            Proto Datum
forall msg. Message msg => msg
defMessage
              Proto Datum -> (Proto Datum -> Proto Datum) -> Proto Datum
forall a b. a -> (a -> b) -> b
& ASetter (Proto Datum) (Proto Datum) ByteString ByteString
#hash ASetter (Proto Datum) (Proto Datum) ByteString ByteString
-> ByteString -> Proto Datum -> Proto Datum
forall s t a b. ASetter s t a b -> b -> s -> t
.~ HashableScriptData -> ByteString
forall a. SerialiseAsCBOR a => a -> ByteString
serialiseToCBOR HashableScriptData
hashableScriptData
              Proto Datum -> (Proto Datum -> Proto Datum) -> Proto Datum
forall a b. a -> (a -> b) -> b
& ASetter
  (Proto Datum) (Proto Datum) (Proto PlutusData) (Proto PlutusData)
#payload ASetter
  (Proto Datum) (Proto Datum) (Proto PlutusData) (Proto PlutusData)
-> Proto PlutusData -> Proto Datum -> Proto Datum
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ScriptData -> Proto PlutusData
scriptDataToUtxoRpcPlutusData (HashableScriptData -> ScriptData
getScriptData HashableScriptData
hashableScriptData)
              Proto Datum -> (Proto Datum -> Proto Datum) -> Proto Datum
forall a b. a -> (a -> b) -> b
& ASetter (Proto Datum) (Proto Datum) ByteString ByteString
#originalCbor ASetter (Proto Datum) (Proto Datum) ByteString ByteString
-> ByteString -> Proto Datum -> Proto Datum
forall s t a b. ASetter s t a b -> b -> s -> t
.~ HashableScriptData -> ByteString
getOriginalScriptDataBytes HashableScriptData
hashableScriptData

  Proto TxOutput
forall msg. Message msg => msg
defMessage
    Proto TxOutput
-> (Proto TxOutput -> Proto TxOutput) -> Proto TxOutput
forall a b. a -> (a -> b) -> b
& ASetter (Proto TxOutput) (Proto TxOutput) ByteString ByteString
#address ASetter (Proto TxOutput) (Proto TxOutput) ByteString ByteString
-> ByteString -> Proto TxOutput -> Proto TxOutput
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text -> ByteString
T.encodeUtf8 (Era era -> (EraCommonConstraints era => Text) -> Text
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
useEra @era) ((EraCommonConstraints era => Text) -> Text)
-> (EraCommonConstraints era => Text) -> Text
forall a b. (a -> b) -> a -> b
$ AddressInEra era -> Text
forall addr. SerialiseAddress addr => addr -> Text
serialiseAddress AddressInEra era
addressInEra)
    Proto TxOutput
-> (Proto TxOutput -> Proto TxOutput) -> Proto TxOutput
forall a b. a -> (a -> b) -> b
& ASetter (Proto TxOutput) (Proto TxOutput) Word64 Word64
#coin ASetter (Proto TxOutput) (Proto TxOutput) Word64 Word64
-> Word64 -> Proto TxOutput -> Proto TxOutput
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Coin -> Integer
L.unCoin (TxOutValue era -> Coin
forall era. TxOutValue era -> Coin
txOutValueToLovelace TxOutValue era
txOutValue))
    Proto TxOutput
-> (Proto TxOutput -> Proto TxOutput) -> Proto TxOutput
forall a b. a -> (a -> b) -> b
& ASetter
  (Proto TxOutput)
  (Proto TxOutput)
  [Proto MultiAsset]
  [Proto MultiAsset]
#assets ASetter
  (Proto TxOutput)
  (Proto TxOutput)
  [Proto MultiAsset]
  [Proto MultiAsset]
-> [Proto MultiAsset] -> Proto TxOutput -> Proto TxOutput
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Proto MultiAsset]
multiAsset
    Proto TxOutput
-> (Proto TxOutput -> Proto TxOutput) -> Proto TxOutput
forall a b. a -> (a -> b) -> b
& ASetter
  (Proto TxOutput)
  (Proto TxOutput)
  (Maybe (Proto Datum))
  (Maybe (Proto Datum))
#maybe'datum ASetter
  (Proto TxOutput)
  (Proto TxOutput)
  (Maybe (Proto Datum))
  (Maybe (Proto Datum))
-> Maybe (Proto Datum) -> Proto TxOutput -> Proto TxOutput
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe (Proto Datum)
datumRpc
    Proto TxOutput
-> (Proto TxOutput -> Proto TxOutput) -> Proto TxOutput
forall a b. a -> (a -> b) -> b
& ASetter
  (Proto TxOutput) (Proto TxOutput) (Proto Script) (Proto Script)
#script ASetter
  (Proto TxOutput) (Proto TxOutput) (Proto Script) (Proto Script)
-> Proto Script -> Proto TxOutput -> Proto TxOutput
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ReferenceScript era -> Proto Script
forall era. ReferenceScript era -> Proto Script
referenceScriptToUtxoRpcScript ReferenceScript era
script

utxoRpcTxOutputToTxOut
  :: forall era m
   . HasCallStack
  => MonadThrow m
  => IsEra era
  => Proto UtxoRpc.TxOutput
  -> m (TxOut CtxUTxO era)
utxoRpcTxOutputToTxOut :: forall era (m :: * -> *).
(HasCallStack, MonadThrow m, IsEra era) =>
Proto TxOutput -> m (TxOut CtxUTxO era)
utxoRpcTxOutputToTxOut Proto TxOutput
txOutput = do
  let era :: Era era
era = forall era. IsEra era => Era era
useEra @era
  addrUtf8 <- Either UnicodeException Text -> m Text
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Typeable e, Error e) =>
Either e a -> m a
liftEitherError (Either UnicodeException Text -> m Text)
-> Either UnicodeException Text -> m Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Either UnicodeException Text
T.decodeUtf8' (Proto TxOutput
txOutput Proto TxOutput
-> Getting ByteString (Proto TxOutput) ByteString -> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Proto TxOutput) ByteString
#address)
  address <-
    maybe (throwM . stringException $ "Cannot decode address: " <> T.unpack addrUtf8) pure $
      obtainCommonConstraints era $
        deserialiseAddress asType addrUtf8
  datum <-
    case txOutput ^. #maybe'datum of
      Just Proto Datum
datumRpc ->
        case Proto Datum
datumRpc Proto Datum
-> Getting (Maybe ByteString) (Proto Datum) (Maybe ByteString)
-> Maybe ByteString
forall s a. s -> Getting a s a -> a
^. Getting (Maybe ByteString) (Proto Datum) (Maybe ByteString)
#maybe'originalCbor of
          Just ByteString
cbor ->
            Either DecoderError (TxOutDatum CtxUTxO era)
-> m (TxOutDatum CtxUTxO era)
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Typeable e, Error e) =>
Either e a -> m a
liftEitherError (Either DecoderError (TxOutDatum CtxUTxO era)
 -> m (TxOutDatum CtxUTxO era))
-> Either DecoderError (TxOutDatum CtxUTxO era)
-> m (TxOutDatum CtxUTxO era)
forall a b. (a -> b) -> a -> b
$
              BabbageEraOnwards era
-> HashableScriptData -> TxOutDatum CtxUTxO era
forall era ctx.
BabbageEraOnwards era -> HashableScriptData -> TxOutDatum ctx era
TxOutDatumInline (Era era -> BabbageEraOnwards era
forall era. Era era -> BabbageEraOnwards era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
era)
                (HashableScriptData -> TxOutDatum CtxUTxO era)
-> Either DecoderError HashableScriptData
-> Either DecoderError (TxOutDatum CtxUTxO era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AsType HashableScriptData
-> ByteString -> Either DecoderError HashableScriptData
forall a.
SerialiseAsCBOR a =>
AsType a -> ByteString -> Either DecoderError a
deserialiseFromCBOR AsType HashableScriptData
forall t. HasTypeProxy t => AsType t
asType ByteString
cbor
          Maybe ByteString
Nothing ->
            Either SerialiseAsRawBytesError (TxOutDatum CtxUTxO era)
-> m (TxOutDatum CtxUTxO era)
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Typeable e, Error e) =>
Either e a -> m a
liftEitherError (Either SerialiseAsRawBytesError (TxOutDatum CtxUTxO era)
 -> m (TxOutDatum CtxUTxO era))
-> Either SerialiseAsRawBytesError (TxOutDatum CtxUTxO era)
-> m (TxOutDatum CtxUTxO era)
forall a b. (a -> b) -> a -> b
$
              AlonzoEraOnwards era -> Hash ScriptData -> TxOutDatum CtxUTxO era
forall era ctx.
AlonzoEraOnwards era -> Hash ScriptData -> TxOutDatum ctx era
TxOutDatumHash (Era era -> AlonzoEraOnwards era
forall era. Era era -> AlonzoEraOnwards era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
era)
                (Hash ScriptData -> TxOutDatum CtxUTxO era)
-> Either SerialiseAsRawBytesError (Hash ScriptData)
-> Either SerialiseAsRawBytesError (TxOutDatum CtxUTxO era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AsType (Hash ScriptData)
-> ByteString -> Either SerialiseAsRawBytesError (Hash ScriptData)
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either SerialiseAsRawBytesError a
deserialiseFromRawBytes AsType (Hash ScriptData)
forall t. HasTypeProxy t => AsType t
asType (Proto Datum
datumRpc Proto Datum
-> Getting ByteString (Proto Datum) ByteString -> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Proto Datum) ByteString
#hash)
      Maybe (Proto Datum)
Nothing -> TxOutDatum CtxUTxO era -> m (TxOutDatum CtxUTxO era)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TxOutDatum CtxUTxO era
forall ctx era. TxOutDatum ctx era
TxOutDatumNone
  referenceScript <- utxoRpcScriptToReferenceScript (txOutput ^. #script)
  let coinValue = Proto TxOutput
txOutput Proto TxOutput -> Getting Value (Proto TxOutput) Value -> Value
forall s a. s -> Getting a s a -> a
^. (Word64 -> Const Value Word64)
-> Proto TxOutput -> Const Value (Proto TxOutput)
#coin ((Word64 -> Const Value Word64)
 -> Proto TxOutput -> Const Value (Proto TxOutput))
-> ((Value -> Const Value Value) -> Word64 -> Const Value Word64)
-> Getting Value (Proto TxOutput) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Integer) -> SimpleGetter Word64 Integer
forall s a. (s -> a) -> SimpleGetter s a
to Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Getting Value Word64 Integer
-> ((Value -> Const Value Value) -> Integer -> Const Value Integer)
-> (Value -> Const Value Value)
-> Word64
-> Const Value Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Coin) -> SimpleGetter Integer Coin
forall s a. (s -> a) -> SimpleGetter s a
to Integer -> Coin
L.Coin Getting Value Integer Coin
-> ((Value -> Const Value Value) -> Coin -> Const Value Coin)
-> (Value -> Const Value Value)
-> Integer
-> Const Value Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Value) -> SimpleGetter Coin Value
forall s a. (s -> a) -> SimpleGetter s a
to Coin -> Value
lovelaceToValue
  multiAssetValue <- fmap (fromList @Value . join) . forM (txOutput ^. #assets) $ \Proto MultiAsset
policyAssets -> do
    pId <-
      Either SerialiseAsRawBytesError PolicyId -> m PolicyId
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Typeable e, Error e) =>
Either e a -> m a
liftEitherError (Either SerialiseAsRawBytesError PolicyId -> m PolicyId)
-> Either SerialiseAsRawBytesError PolicyId -> m PolicyId
forall a b. (a -> b) -> a -> b
$ AsType PolicyId
-> ByteString -> Either SerialiseAsRawBytesError PolicyId
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either SerialiseAsRawBytesError a
deserialiseFromRawBytes AsType PolicyId
AsPolicyId (Proto MultiAsset
policyAssets Proto MultiAsset
-> Getting ByteString (Proto MultiAsset) ByteString -> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Proto MultiAsset) ByteString
#policyId)
    forM (policyAssets ^. #assets) $ \Proto Asset
asset -> do
      assetName <-
        Either SerialiseAsRawBytesError AssetName -> m AssetName
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Typeable e, Error e) =>
Either e a -> m a
liftEitherError (Either SerialiseAsRawBytesError AssetName -> m AssetName)
-> Either SerialiseAsRawBytesError AssetName -> m AssetName
forall a b. (a -> b) -> a -> b
$
          AsType AssetName
-> ByteString -> Either SerialiseAsRawBytesError AssetName
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either SerialiseAsRawBytesError a
deserialiseFromRawBytes AsType AssetName
AsAssetName (Proto Asset
asset Proto Asset
-> Getting ByteString (Proto Asset) ByteString -> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Proto Asset) ByteString
#name)
      let outCoin = Integer -> Quantity
Quantity (Integer -> Quantity) -> (Word64 -> Integer) -> Word64 -> Quantity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Quantity) -> Word64 -> Quantity
forall a b. (a -> b) -> a -> b
$ Proto Asset
asset Proto Asset -> Getting Word64 (Proto Asset) Word64 -> Word64
forall s a. s -> Getting a s a -> a
^. Getting Word64 (Proto Asset) Word64
#outputCoin
          mintCoin = Integer -> Quantity
Quantity (Integer -> Quantity) -> (Int64 -> Integer) -> Int64 -> Quantity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Quantity) -> Int64 -> Quantity
forall a b. (a -> b) -> a -> b
$ Proto Asset
asset Proto Asset -> Getting Int64 (Proto Asset) Int64 -> Int64
forall s a. s -> Getting a s a -> a
^. Getting Int64 (Proto Asset) Int64
#mintCoin
      pure (AssetId pId assetName, outCoin <> mintCoin)
  pure $
    TxOut
      address
      ( obtainCommonConstraints era $
          TxOutValueShelleyBased (convert era) (toMaryValue $ coinValue <> multiAssetValue)
      )
      datum
      referenceScript