{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE RankNTypes #-}

module Cardano.Rpc.Server.Internal.UtxoRpc.Type
  ( utxoRpcPParamsToProtocolParams
  , protocolParamsToUtxoRpcPParams
  , mkChainPointMsg
  )
where

import Cardano.Api.Block
import Cardano.Api.Era
import Cardano.Api.Experimental.Era
import Cardano.Api.Ledger qualified as L
import Cardano.Api.Monad.Error
import Cardano.Rpc.Proto.Api.UtxoRpc.Query qualified as UtxoRpc
import Cardano.Rpc.Server.Internal.Orphans ()

import Cardano.Ledger.Api qualified as L
import Cardano.Ledger.BaseTypes (WithOrigin (..))
import Cardano.Ledger.Binary.Version 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.ProtoLens (defMessage)
import GHC.IsList
import Network.GRPC.Spec

protocolParamsToUtxoRpcPParams
  :: Era era
  -> L.PParams (ShelleyLedgerEra era)
  -> Proto UtxoRpc.PParams
protocolParamsToUtxoRpcPParams :: forall era.
Era era -> PParams (ShelleyLedgerEra era) -> Proto PParams
protocolParamsToUtxoRpcPParams Era era
era = ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era =>
    PParams (ShelleyLedgerEra era) -> Proto PParams)
-> PParams (ShelleyLedgerEra era)
-> Proto PParams
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 =>
PParams (ShelleyLedgerEra era) -> Proto PParams
PParams (ShelleyLedgerEra era) -> Proto PParams
forall t s. Inject t s => t -> s
inject

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 => 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
          -- 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] ((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