{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

-- | The various Cardano protocol parameters, including:
--
-- * updates to protocol parameters: 'ProtocolParametersUpdate'
-- * update proposals that can be embedded in transactions: 'UpdateProposal'
-- * parameters fixed in the genesis file: 'GenesisParameters'
module Cardano.Api.ProtocolParameters
  ( -- * The updatable protocol parameters
    EpochNo

    -- * The updatable protocol parameters
  , LedgerProtocolParameters (..)
  , EraBasedProtocolParametersUpdate (..)
  , AlonzoOnwardsPParams (..)
  , CommonProtocolParametersUpdate (..)
  , DeprecatedAfterBabbagePParams (..)
  , DeprecatedAfterMaryPParams (..)
  , ShelleyToAlonzoPParams (..)
  , IntroducedInBabbagePParams (..)
  , IntroducedInConwayPParams (..)
  , IntroducedInDijkstraPParams (..)
  , createEraBasedProtocolParamUpdate
  , createPParams

    -- * Errors
  , ProtocolParametersError (..)
  , ProtocolParametersConversionError (..)

    -- * PraosNonce
  , PraosNonce
  , makePraosNonce

    -- * Execution units, prices and cost models,
  , ExecutionUnits (..)
  , ExecutionUnitPrices (..)
  , CostModels (..)
  , CostModel (..)
  , fromAlonzoCostModels

    -- * Update proposals to change the protocol parameters
  , UpdateProposal (..)
  , makeShelleyUpdateProposal

    -- * Internal conversion functions
  , toLedgerNonce
  , toLedgerUpdate
  , fromLedgerUpdate
  , toLedgerProposedPPUpdates
  , fromLedgerProposedPPUpdates
  , fromLedgerPParamsUpdate
  , toAlonzoPrices
  , fromAlonzoPrices
  , toAlonzoScriptLanguage
  , fromAlonzoScriptLanguage
  , toAlonzoCostModel
  , fromAlonzoCostModel
  , toAlonzoCostModels

    -- * Data family instances
  , AsType (..)

    -- ** Era-dependent protocol features
  )
where

import Cardano.Api.Address
import Cardano.Api.Byron.Internal.Key
import Cardano.Api.Certificate.Internal.StakePoolMetadata
import Cardano.Api.Compatible.ProtocolParametersUpdate
import Cardano.Api.Era
import Cardano.Api.Error
import Cardano.Api.HasTypeProxy
import Cardano.Api.Internal.Orphans ()
import Cardano.Api.Plutus.Internal.Script
import Cardano.Api.Pretty
import Cardano.Api.Serialise.Cbor
import Cardano.Api.Serialise.Json (toRationalJSON)
import Cardano.Api.Serialise.Raw
import Cardano.Api.Serialise.SerialiseUsing
import Cardano.Api.Tx.Internal.TxMetadata
import Cardano.Api.Value.Internal

import Cardano.Binary qualified as CBOR
import Cardano.Crypto.Hash qualified as Hash
import Cardano.Crypto.Hash.Class qualified as Crypto
import Cardano.Ledger.Alonzo.Scripts qualified as Alonzo
import Cardano.Ledger.Babbage.Core qualified as Ledger
import Cardano.Ledger.BaseTypes qualified as Ledger
import Cardano.Ledger.Hashes (HASH)
import Cardano.Ledger.Plutus.CostModels qualified as Plutus
import Cardano.Ledger.Plutus.Language qualified as Plutus
import Cardano.Slotting.Slot (EpochNo (..))
import PlutusLedgerApi.Common (CostModelApplyError)

import Data.Aeson
  ( FromJSON (..)
  , ToJSON (..)
  , object
  , withObject
  , (.:)
  , (.=)
  )
import Data.Bifunctor (bimap, first)
import Data.ByteString (ByteString)
import Data.Data (Data)
import Data.Either.Combinators (maybeToRight)
import Data.Int (Int64)
import Data.Map.Strict (Map)
import GHC.Exts (IsList (..))
import GHC.Generics
import Numeric.Natural
import Text.PrettyBy.Default (display)

-- -----------------------------------------------------------------------------
-- Era based ledger protocol parameters
--
newtype LedgerProtocolParameters era = LedgerProtocolParameters
  { forall era.
LedgerProtocolParameters era -> PParams (ShelleyLedgerEra era)
unLedgerProtocolParameters :: Ledger.PParams (ShelleyLedgerEra era)
  }

instance IsShelleyBasedEra era => Show (LedgerProtocolParameters era) where
  show :: LedgerProtocolParameters era -> String
show (LedgerProtocolParameters PParams (ShelleyLedgerEra era)
pp) =
    ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => String) -> String
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints (forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra @era) ((ShelleyBasedEraConstraints era => String) -> String)
-> (ShelleyBasedEraConstraints era => String) -> String
forall a b. (a -> b) -> a -> b
$
      PParams (ShelleyLedgerEra era) -> String
forall a. Show a => a -> String
show PParams (ShelleyLedgerEra era)
pp

instance IsShelleyBasedEra era => Eq (LedgerProtocolParameters era) where
  LedgerProtocolParameters PParams (ShelleyLedgerEra era)
a == :: LedgerProtocolParameters era
-> LedgerProtocolParameters era -> Bool
== LedgerProtocolParameters PParams (ShelleyLedgerEra era)
b =
    ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => Bool) -> Bool
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints (forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra @era) ((ShelleyBasedEraConstraints era => Bool) -> Bool)
-> (ShelleyBasedEraConstraints era => Bool) -> Bool
forall a b. (a -> b) -> a -> b
$
      PParams (ShelleyLedgerEra era)
a PParams (ShelleyLedgerEra era)
-> PParams (ShelleyLedgerEra era) -> Bool
forall a. Eq a => a -> a -> Bool
== PParams (ShelleyLedgerEra era)
b

-- ----------------------------------------------------------------------------
-- Praos nonce
--

newtype PraosNonce = PraosNonce {PraosNonce -> Hash HASH ByteString
unPraosNonce :: Hash.Hash HASH ByteString}
  deriving stock (PraosNonce -> PraosNonce -> Bool
(PraosNonce -> PraosNonce -> Bool)
-> (PraosNonce -> PraosNonce -> Bool) -> Eq PraosNonce
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PraosNonce -> PraosNonce -> Bool
== :: PraosNonce -> PraosNonce -> Bool
$c/= :: PraosNonce -> PraosNonce -> Bool
/= :: PraosNonce -> PraosNonce -> Bool
Eq, Eq PraosNonce
Eq PraosNonce =>
(PraosNonce -> PraosNonce -> Ordering)
-> (PraosNonce -> PraosNonce -> Bool)
-> (PraosNonce -> PraosNonce -> Bool)
-> (PraosNonce -> PraosNonce -> Bool)
-> (PraosNonce -> PraosNonce -> Bool)
-> (PraosNonce -> PraosNonce -> PraosNonce)
-> (PraosNonce -> PraosNonce -> PraosNonce)
-> Ord PraosNonce
PraosNonce -> PraosNonce -> Bool
PraosNonce -> PraosNonce -> Ordering
PraosNonce -> PraosNonce -> PraosNonce
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PraosNonce -> PraosNonce -> Ordering
compare :: PraosNonce -> PraosNonce -> Ordering
$c< :: PraosNonce -> PraosNonce -> Bool
< :: PraosNonce -> PraosNonce -> Bool
$c<= :: PraosNonce -> PraosNonce -> Bool
<= :: PraosNonce -> PraosNonce -> Bool
$c> :: PraosNonce -> PraosNonce -> Bool
> :: PraosNonce -> PraosNonce -> Bool
$c>= :: PraosNonce -> PraosNonce -> Bool
>= :: PraosNonce -> PraosNonce -> Bool
$cmax :: PraosNonce -> PraosNonce -> PraosNonce
max :: PraosNonce -> PraosNonce -> PraosNonce
$cmin :: PraosNonce -> PraosNonce -> PraosNonce
min :: PraosNonce -> PraosNonce -> PraosNonce
Ord, (forall x. PraosNonce -> Rep PraosNonce x)
-> (forall x. Rep PraosNonce x -> PraosNonce) -> Generic PraosNonce
forall x. Rep PraosNonce x -> PraosNonce
forall x. PraosNonce -> Rep PraosNonce x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PraosNonce -> Rep PraosNonce x
from :: forall x. PraosNonce -> Rep PraosNonce x
$cto :: forall x. Rep PraosNonce x -> PraosNonce
to :: forall x. Rep PraosNonce x -> PraosNonce
Generic)
  deriving (Int -> PraosNonce -> ShowS
[PraosNonce] -> ShowS
PraosNonce -> String
(Int -> PraosNonce -> ShowS)
-> (PraosNonce -> String)
-> ([PraosNonce] -> ShowS)
-> Show PraosNonce
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PraosNonce -> ShowS
showsPrec :: Int -> PraosNonce -> ShowS
$cshow :: PraosNonce -> String
show :: PraosNonce -> String
$cshowList :: [PraosNonce] -> ShowS
showList :: [PraosNonce] -> ShowS
Show, (forall ann. PraosNonce -> Doc ann)
-> (forall ann. [PraosNonce] -> Doc ann) -> Pretty PraosNonce
forall ann. [PraosNonce] -> Doc ann
forall ann. PraosNonce -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
$cpretty :: forall ann. PraosNonce -> Doc ann
pretty :: forall ann. PraosNonce -> Doc ann
$cprettyList :: forall ann. [PraosNonce] -> Doc ann
prettyList :: forall ann. [PraosNonce] -> Doc ann
Pretty) via UsingRawBytesHex PraosNonce
  deriving ([PraosNonce] -> Value
[PraosNonce] -> Encoding
PraosNonce -> Bool
PraosNonce -> Value
PraosNonce -> Encoding
(PraosNonce -> Value)
-> (PraosNonce -> Encoding)
-> ([PraosNonce] -> Value)
-> ([PraosNonce] -> Encoding)
-> (PraosNonce -> Bool)
-> ToJSON PraosNonce
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: PraosNonce -> Value
toJSON :: PraosNonce -> Value
$ctoEncoding :: PraosNonce -> Encoding
toEncoding :: PraosNonce -> Encoding
$ctoJSONList :: [PraosNonce] -> Value
toJSONList :: [PraosNonce] -> Value
$ctoEncodingList :: [PraosNonce] -> Encoding
toEncodingList :: [PraosNonce] -> Encoding
$comitField :: PraosNonce -> Bool
omitField :: PraosNonce -> Bool
ToJSON, Maybe PraosNonce
Value -> Parser [PraosNonce]
Value -> Parser PraosNonce
(Value -> Parser PraosNonce)
-> (Value -> Parser [PraosNonce])
-> Maybe PraosNonce
-> FromJSON PraosNonce
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser PraosNonce
parseJSON :: Value -> Parser PraosNonce
$cparseJSONList :: Value -> Parser [PraosNonce]
parseJSONList :: Value -> Parser [PraosNonce]
$comittedField :: Maybe PraosNonce
omittedField :: Maybe PraosNonce
FromJSON) via UsingRawBytesHex PraosNonce
  deriving (Typeable PraosNonce
Typeable PraosNonce =>
(PraosNonce -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy PraosNonce -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [PraosNonce] -> Size)
-> ToCBOR PraosNonce
PraosNonce -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PraosNonce] -> Size
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy PraosNonce -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
$ctoCBOR :: PraosNonce -> Encoding
toCBOR :: PraosNonce -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy PraosNonce -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy PraosNonce -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PraosNonce] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PraosNonce] -> Size
ToCBOR, Typeable PraosNonce
Typeable PraosNonce =>
(forall s. Decoder s PraosNonce)
-> (Proxy PraosNonce -> Text) -> FromCBOR PraosNonce
Proxy PraosNonce -> Text
forall s. Decoder s PraosNonce
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s PraosNonce
fromCBOR :: forall s. Decoder s PraosNonce
$clabel :: Proxy PraosNonce -> Text
label :: Proxy PraosNonce -> Text
FromCBOR) via UsingRawBytes PraosNonce

instance HasTypeProxy PraosNonce where
  data AsType PraosNonce = AsPraosNonce
  proxyToAsType :: Proxy PraosNonce -> AsType PraosNonce
proxyToAsType Proxy PraosNonce
_ = AsType PraosNonce
AsPraosNonce

instance SerialiseAsRawBytes PraosNonce where
  serialiseToRawBytes :: PraosNonce -> ByteString
serialiseToRawBytes (PraosNonce Hash HASH ByteString
h) =
    Hash HASH ByteString -> ByteString
forall h a. Hash h a -> ByteString
Crypto.hashToBytes Hash HASH ByteString
h

  deserialiseFromRawBytes :: AsType PraosNonce
-> ByteString -> Either SerialiseAsRawBytesError PraosNonce
deserialiseFromRawBytes AsType PraosNonce
R:AsTypePraosNonce
AsPraosNonce ByteString
bs =
    SerialiseAsRawBytesError
-> Maybe PraosNonce -> Either SerialiseAsRawBytesError PraosNonce
forall b a. b -> Maybe a -> Either b a
maybeToRight (String -> SerialiseAsRawBytesError
SerialiseAsRawBytesError String
"Unable to deserialise PraosNonce") (Maybe PraosNonce -> Either SerialiseAsRawBytesError PraosNonce)
-> Maybe PraosNonce -> Either SerialiseAsRawBytesError PraosNonce
forall a b. (a -> b) -> a -> b
$
      Hash HASH ByteString -> PraosNonce
PraosNonce (Hash HASH ByteString -> PraosNonce)
-> Maybe (Hash HASH ByteString) -> Maybe PraosNonce
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (Hash HASH ByteString)
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
Crypto.hashFromBytes ByteString
bs

makePraosNonce :: ByteString -> PraosNonce
makePraosNonce :: ByteString -> PraosNonce
makePraosNonce = Hash HASH ByteString -> PraosNonce
PraosNonce (Hash HASH ByteString -> PraosNonce)
-> (ByteString -> Hash HASH ByteString) -> ByteString -> PraosNonce
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString) -> ByteString -> Hash HASH ByteString
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
Crypto.hashWith ByteString -> ByteString
forall a. a -> a
id

toLedgerNonce :: Maybe PraosNonce -> Ledger.Nonce
toLedgerNonce :: Maybe PraosNonce -> Nonce
toLedgerNonce Maybe PraosNonce
Nothing = Nonce
Ledger.NeutralNonce
toLedgerNonce (Just (PraosNonce Hash HASH ByteString
h)) = Hash HASH Nonce -> Nonce
Ledger.Nonce (Hash HASH ByteString -> Hash HASH Nonce
forall h a b. Hash h a -> Hash h b
Crypto.castHash Hash HASH ByteString
h)

-- ----------------------------------------------------------------------------
-- Script execution unit prices and cost models
--

-- | The prices for 'ExecutionUnits' as a fraction of a 'L.Coin'.
--
-- These are used to determine the fee for the use of a script within a
-- transaction, based on the 'ExecutionUnits' needed by the use of the script.
data ExecutionUnitPrices
  = ExecutionUnitPrices
  { ExecutionUnitPrices -> Rational
priceExecutionSteps :: Rational
  , ExecutionUnitPrices -> Rational
priceExecutionMemory :: Rational
  }
  deriving (ExecutionUnitPrices -> ExecutionUnitPrices -> Bool
(ExecutionUnitPrices -> ExecutionUnitPrices -> Bool)
-> (ExecutionUnitPrices -> ExecutionUnitPrices -> Bool)
-> Eq ExecutionUnitPrices
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExecutionUnitPrices -> ExecutionUnitPrices -> Bool
== :: ExecutionUnitPrices -> ExecutionUnitPrices -> Bool
$c/= :: ExecutionUnitPrices -> ExecutionUnitPrices -> Bool
/= :: ExecutionUnitPrices -> ExecutionUnitPrices -> Bool
Eq, Int -> ExecutionUnitPrices -> ShowS
[ExecutionUnitPrices] -> ShowS
ExecutionUnitPrices -> String
(Int -> ExecutionUnitPrices -> ShowS)
-> (ExecutionUnitPrices -> String)
-> ([ExecutionUnitPrices] -> ShowS)
-> Show ExecutionUnitPrices
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExecutionUnitPrices -> ShowS
showsPrec :: Int -> ExecutionUnitPrices -> ShowS
$cshow :: ExecutionUnitPrices -> String
show :: ExecutionUnitPrices -> String
$cshowList :: [ExecutionUnitPrices] -> ShowS
showList :: [ExecutionUnitPrices] -> ShowS
Show)

instance ToCBOR ExecutionUnitPrices where
  toCBOR :: ExecutionUnitPrices -> Encoding
toCBOR ExecutionUnitPrices{Rational
priceExecutionSteps :: ExecutionUnitPrices -> Rational
priceExecutionSteps :: Rational
priceExecutionSteps, Rational
priceExecutionMemory :: ExecutionUnitPrices -> Rational
priceExecutionMemory :: Rational
priceExecutionMemory} =
    Word -> Encoding
CBOR.encodeListLen Word
2
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Rational -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Rational
priceExecutionSteps
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Rational -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Rational
priceExecutionMemory

instance FromCBOR ExecutionUnitPrices where
  fromCBOR :: forall s. Decoder s ExecutionUnitPrices
fromCBOR = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
CBOR.enforceSize Text
"ExecutionUnitPrices" Int
2
    Rational -> Rational -> ExecutionUnitPrices
ExecutionUnitPrices
      (Rational -> Rational -> ExecutionUnitPrices)
-> Decoder s Rational
-> Decoder s (Rational -> ExecutionUnitPrices)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Rational
forall s. Decoder s Rational
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder s (Rational -> ExecutionUnitPrices)
-> Decoder s Rational -> Decoder s ExecutionUnitPrices
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Rational
forall s. Decoder s Rational
forall a s. FromCBOR a => Decoder s a
fromCBOR

instance ToJSON ExecutionUnitPrices where
  toJSON :: ExecutionUnitPrices -> Value
toJSON ExecutionUnitPrices{Rational
priceExecutionSteps :: ExecutionUnitPrices -> Rational
priceExecutionSteps :: Rational
priceExecutionSteps, Rational
priceExecutionMemory :: ExecutionUnitPrices -> Rational
priceExecutionMemory :: Rational
priceExecutionMemory} =
    [(Key, Value)] -> Value
object
      [ Key
"priceSteps" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Rational -> Value
toRationalJSON Rational
priceExecutionSteps
      , Key
"priceMemory" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Rational -> Value
toRationalJSON Rational
priceExecutionMemory
      ]

instance FromJSON ExecutionUnitPrices where
  parseJSON :: Value -> Parser ExecutionUnitPrices
parseJSON =
    String
-> (Object -> Parser ExecutionUnitPrices)
-> Value
-> Parser ExecutionUnitPrices
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ExecutionUnitPrices" ((Object -> Parser ExecutionUnitPrices)
 -> Value -> Parser ExecutionUnitPrices)
-> (Object -> Parser ExecutionUnitPrices)
-> Value
-> Parser ExecutionUnitPrices
forall a b. (a -> b) -> a -> b
$ \Object
o ->
      Rational -> Rational -> ExecutionUnitPrices
ExecutionUnitPrices
        (Rational -> Rational -> ExecutionUnitPrices)
-> Parser Rational -> Parser (Rational -> ExecutionUnitPrices)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Rational
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"priceSteps"
        Parser (Rational -> ExecutionUnitPrices)
-> Parser Rational -> Parser ExecutionUnitPrices
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Rational
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"priceMemory"

toAlonzoPrices :: ExecutionUnitPrices -> Either ProtocolParametersConversionError Alonzo.Prices
toAlonzoPrices :: ExecutionUnitPrices
-> Either ProtocolParametersConversionError Prices
toAlonzoPrices
  ExecutionUnitPrices
    { Rational
priceExecutionSteps :: ExecutionUnitPrices -> Rational
priceExecutionSteps :: Rational
priceExecutionSteps
    , Rational
priceExecutionMemory :: ExecutionUnitPrices -> Rational
priceExecutionMemory :: Rational
priceExecutionMemory
    } = do
    prSteps <- String
-> Rational
-> Either ProtocolParametersConversionError NonNegativeInterval
forall b.
BoundedRational b =>
String -> Rational -> Either ProtocolParametersConversionError b
boundRationalEither String
"Steps" Rational
priceExecutionSteps
    prMem <- boundRationalEither "Mem" priceExecutionMemory
    return
      Alonzo.Prices
        { Alonzo.prSteps
        , Alonzo.prMem
        }

fromAlonzoPrices :: Alonzo.Prices -> ExecutionUnitPrices
fromAlonzoPrices :: Prices -> ExecutionUnitPrices
fromAlonzoPrices Alonzo.Prices{NonNegativeInterval
prSteps :: Prices -> NonNegativeInterval
prSteps :: NonNegativeInterval
Alonzo.prSteps, NonNegativeInterval
prMem :: Prices -> NonNegativeInterval
prMem :: NonNegativeInterval
Alonzo.prMem} =
  ExecutionUnitPrices
    { priceExecutionSteps :: Rational
priceExecutionSteps = NonNegativeInterval -> Rational
forall r. BoundedRational r => r -> Rational
Ledger.unboundRational NonNegativeInterval
prSteps
    , priceExecutionMemory :: Rational
priceExecutionMemory = NonNegativeInterval -> Rational
forall r. BoundedRational r => r -> Rational
Ledger.unboundRational NonNegativeInterval
prMem
    }

-- ----------------------------------------------------------------------------
-- Script cost models
--

newtype CostModel = CostModel [Int64]
  deriving (CostModel -> CostModel -> Bool
(CostModel -> CostModel -> Bool)
-> (CostModel -> CostModel -> Bool) -> Eq CostModel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CostModel -> CostModel -> Bool
== :: CostModel -> CostModel -> Bool
$c/= :: CostModel -> CostModel -> Bool
/= :: CostModel -> CostModel -> Bool
Eq, Int -> CostModel -> ShowS
[CostModel] -> ShowS
CostModel -> String
(Int -> CostModel -> ShowS)
-> (CostModel -> String)
-> ([CostModel] -> ShowS)
-> Show CostModel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CostModel -> ShowS
showsPrec :: Int -> CostModel -> ShowS
$cshow :: CostModel -> String
show :: CostModel -> String
$cshowList :: [CostModel] -> ShowS
showList :: [CostModel] -> ShowS
Show, Typeable CostModel
Typeable CostModel =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> CostModel -> c CostModel)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CostModel)
-> (CostModel -> Constr)
-> (CostModel -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CostModel))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CostModel))
-> ((forall b. Data b => b -> b) -> CostModel -> CostModel)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CostModel -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CostModel -> r)
-> (forall u. (forall d. Data d => d -> u) -> CostModel -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CostModel -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> CostModel -> m CostModel)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CostModel -> m CostModel)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CostModel -> m CostModel)
-> Data CostModel
CostModel -> Constr
CostModel -> DataType
(forall b. Data b => b -> b) -> CostModel -> CostModel
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> CostModel -> u
forall u. (forall d. Data d => d -> u) -> CostModel -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CostModel -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CostModel -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CostModel -> m CostModel
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CostModel -> m CostModel
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CostModel
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CostModel -> c CostModel
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CostModel)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CostModel)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CostModel -> c CostModel
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CostModel -> c CostModel
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CostModel
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CostModel
$ctoConstr :: CostModel -> Constr
toConstr :: CostModel -> Constr
$cdataTypeOf :: CostModel -> DataType
dataTypeOf :: CostModel -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CostModel)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CostModel)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CostModel)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CostModel)
$cgmapT :: (forall b. Data b => b -> b) -> CostModel -> CostModel
gmapT :: (forall b. Data b => b -> b) -> CostModel -> CostModel
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CostModel -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CostModel -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CostModel -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CostModel -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CostModel -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> CostModel -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CostModel -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CostModel -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CostModel -> m CostModel
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CostModel -> m CostModel
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CostModel -> m CostModel
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CostModel -> m CostModel
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CostModel -> m CostModel
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CostModel -> m CostModel
Data)
  deriving newtype (Typeable CostModel
Typeable CostModel =>
(CostModel -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy CostModel -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [CostModel] -> Size)
-> ToCBOR CostModel
CostModel -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [CostModel] -> Size
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy CostModel -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
$ctoCBOR :: CostModel -> Encoding
toCBOR :: CostModel -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy CostModel -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy CostModel -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [CostModel] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [CostModel] -> Size
ToCBOR, Typeable CostModel
Typeable CostModel =>
(forall s. Decoder s CostModel)
-> (Proxy CostModel -> Text) -> FromCBOR CostModel
Proxy CostModel -> Text
forall s. Decoder s CostModel
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s CostModel
fromCBOR :: forall s. Decoder s CostModel
$clabel :: Proxy CostModel -> Text
label :: Proxy CostModel -> Text
FromCBOR)

newtype CostModels = CostModels {CostModels -> Map AnyPlutusScriptVersion CostModel
unCostModels :: Map AnyPlutusScriptVersion CostModel}
  deriving (CostModels -> CostModels -> Bool
(CostModels -> CostModels -> Bool)
-> (CostModels -> CostModels -> Bool) -> Eq CostModels
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CostModels -> CostModels -> Bool
== :: CostModels -> CostModels -> Bool
$c/= :: CostModels -> CostModels -> Bool
/= :: CostModels -> CostModels -> Bool
Eq, Int -> CostModels -> ShowS
[CostModels] -> ShowS
CostModels -> String
(Int -> CostModels -> ShowS)
-> (CostModels -> String)
-> ([CostModels] -> ShowS)
-> Show CostModels
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CostModels -> ShowS
showsPrec :: Int -> CostModels -> ShowS
$cshow :: CostModels -> String
show :: CostModels -> String
$cshowList :: [CostModels] -> ShowS
showList :: [CostModels] -> ShowS
Show)

instance FromJSON CostModels where
  parseJSON :: Value -> Parser CostModels
parseJSON Value
v = Map AnyPlutusScriptVersion CostModel -> CostModels
CostModels (Map AnyPlutusScriptVersion CostModel -> CostModels)
-> (CostModels -> Map AnyPlutusScriptVersion CostModel)
-> CostModels
-> CostModels
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CostModels -> Map AnyPlutusScriptVersion CostModel
fromAlonzoCostModels (CostModels -> CostModels)
-> Parser CostModels -> Parser CostModels
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser CostModels
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

instance ToJSON CostModels where
  toJSON :: CostModels -> Value
toJSON (CostModels Map AnyPlutusScriptVersion CostModel
costModels) =
    case Map AnyPlutusScriptVersion CostModel
-> Either ProtocolParametersConversionError CostModels
toAlonzoCostModels Map AnyPlutusScriptVersion CostModel
costModels of
      Left ProtocolParametersConversionError
err -> String -> Value
forall a. HasCallStack => String -> a
error (String -> Value) -> String -> Value
forall a b. (a -> b) -> a -> b
$ ProtocolParametersConversionError -> String
forall a. Error a => a -> String
displayError ProtocolParametersConversionError
err
      Right CostModels
ledgerCostModels -> CostModels -> Value
forall a. ToJSON a => a -> Value
toJSON CostModels
ledgerCostModels

toAlonzoCostModels
  :: Map AnyPlutusScriptVersion CostModel
  -> Either ProtocolParametersConversionError Alonzo.CostModels
toAlonzoCostModels :: Map AnyPlutusScriptVersion CostModel
-> Either ProtocolParametersConversionError CostModels
toAlonzoCostModels Map AnyPlutusScriptVersion CostModel
m = do
  f <- ((AnyPlutusScriptVersion, CostModel)
 -> Either ProtocolParametersConversionError (Language, CostModel))
-> [(AnyPlutusScriptVersion, CostModel)]
-> Either ProtocolParametersConversionError [(Language, CostModel)]
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 (AnyPlutusScriptVersion, CostModel)
-> Either ProtocolParametersConversionError (Language, CostModel)
conv ([(AnyPlutusScriptVersion, CostModel)]
 -> Either
      ProtocolParametersConversionError [(Language, CostModel)])
-> [(AnyPlutusScriptVersion, CostModel)]
-> Either ProtocolParametersConversionError [(Language, CostModel)]
forall a b. (a -> b) -> a -> b
$ Map AnyPlutusScriptVersion CostModel
-> [Item (Map AnyPlutusScriptVersion CostModel)]
forall l. IsList l => l -> [Item l]
toList Map AnyPlutusScriptVersion CostModel
m
  Right $ Plutus.mkCostModels $ fromList f
 where
  conv
    :: (AnyPlutusScriptVersion, CostModel)
    -> Either ProtocolParametersConversionError (Plutus.Language, Alonzo.CostModel)
  conv :: (AnyPlutusScriptVersion, CostModel)
-> Either ProtocolParametersConversionError (Language, CostModel)
conv (AnyPlutusScriptVersion
anySVer, CostModel
cModel) = do
    alonzoCostModel <- CostModel
-> Language -> Either ProtocolParametersConversionError CostModel
toAlonzoCostModel CostModel
cModel (AnyPlutusScriptVersion -> Language
toAlonzoScriptLanguage AnyPlutusScriptVersion
anySVer)
    Right (toAlonzoScriptLanguage anySVer, alonzoCostModel)

fromAlonzoCostModels
  :: Plutus.CostModels
  -> Map AnyPlutusScriptVersion CostModel
fromAlonzoCostModels :: CostModels -> Map AnyPlutusScriptVersion CostModel
fromAlonzoCostModels CostModels
cModels =
  [(AnyPlutusScriptVersion, CostModel)]
-> Map AnyPlutusScriptVersion CostModel
[Item (Map AnyPlutusScriptVersion CostModel)]
-> Map AnyPlutusScriptVersion CostModel
forall l. IsList l => [Item l] -> l
fromList
    ([(AnyPlutusScriptVersion, CostModel)]
 -> Map AnyPlutusScriptVersion CostModel)
-> ([Item (Map Language CostModel)]
    -> [(AnyPlutusScriptVersion, CostModel)])
-> [Item (Map Language CostModel)]
-> Map AnyPlutusScriptVersion CostModel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Language, CostModel) -> (AnyPlutusScriptVersion, CostModel))
-> [(Language, CostModel)] -> [(AnyPlutusScriptVersion, CostModel)]
forall a b. (a -> b) -> [a] -> [b]
map ((Language -> AnyPlutusScriptVersion)
-> (CostModel -> CostModel)
-> (Language, CostModel)
-> (AnyPlutusScriptVersion, CostModel)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Language -> AnyPlutusScriptVersion
fromAlonzoScriptLanguage CostModel -> CostModel
fromAlonzoCostModel)
    ([Item (Map Language CostModel)]
 -> Map AnyPlutusScriptVersion CostModel)
-> [Item (Map Language CostModel)]
-> Map AnyPlutusScriptVersion CostModel
forall a b. (a -> b) -> a -> b
$ Map Language CostModel -> [Item (Map Language CostModel)]
forall l. IsList l => l -> [Item l]
toList
    (Map Language CostModel -> [Item (Map Language CostModel)])
-> Map Language CostModel -> [Item (Map Language CostModel)]
forall a b. (a -> b) -> a -> b
$ CostModels -> Map Language CostModel
Plutus.costModelsValid CostModels
cModels

toAlonzoScriptLanguage :: AnyPlutusScriptVersion -> Plutus.Language
toAlonzoScriptLanguage :: AnyPlutusScriptVersion -> Language
toAlonzoScriptLanguage (AnyPlutusScriptVersion PlutusScriptVersion lang
PlutusScriptV1) = Language
Plutus.PlutusV1
toAlonzoScriptLanguage (AnyPlutusScriptVersion PlutusScriptVersion lang
PlutusScriptV2) = Language
Plutus.PlutusV2
toAlonzoScriptLanguage (AnyPlutusScriptVersion PlutusScriptVersion lang
PlutusScriptV3) = Language
Plutus.PlutusV3
toAlonzoScriptLanguage (AnyPlutusScriptVersion PlutusScriptVersion lang
PlutusScriptV4) = Language
Plutus.PlutusV4

fromAlonzoScriptLanguage :: Plutus.Language -> AnyPlutusScriptVersion
fromAlonzoScriptLanguage :: Language -> AnyPlutusScriptVersion
fromAlonzoScriptLanguage Language
Plutus.PlutusV1 = PlutusScriptVersion PlutusScriptV1 -> AnyPlutusScriptVersion
forall lang.
IsPlutusScriptLanguage lang =>
PlutusScriptVersion lang -> AnyPlutusScriptVersion
AnyPlutusScriptVersion PlutusScriptVersion PlutusScriptV1
PlutusScriptV1
fromAlonzoScriptLanguage Language
Plutus.PlutusV2 = PlutusScriptVersion PlutusScriptV2 -> AnyPlutusScriptVersion
forall lang.
IsPlutusScriptLanguage lang =>
PlutusScriptVersion lang -> AnyPlutusScriptVersion
AnyPlutusScriptVersion PlutusScriptVersion PlutusScriptV2
PlutusScriptV2
fromAlonzoScriptLanguage Language
Plutus.PlutusV3 = PlutusScriptVersion PlutusScriptV3 -> AnyPlutusScriptVersion
forall lang.
IsPlutusScriptLanguage lang =>
PlutusScriptVersion lang -> AnyPlutusScriptVersion
AnyPlutusScriptVersion PlutusScriptVersion PlutusScriptV3
PlutusScriptV3
fromAlonzoScriptLanguage Language
Plutus.PlutusV4 = PlutusScriptVersion PlutusScriptV4 -> AnyPlutusScriptVersion
forall lang.
IsPlutusScriptLanguage lang =>
PlutusScriptVersion lang -> AnyPlutusScriptVersion
AnyPlutusScriptVersion PlutusScriptVersion PlutusScriptV4
PlutusScriptV4

toAlonzoCostModel
  :: CostModel -> Plutus.Language -> Either ProtocolParametersConversionError Alonzo.CostModel
toAlonzoCostModel :: CostModel
-> Language -> Either ProtocolParametersConversionError CostModel
toAlonzoCostModel (CostModel [Int64]
m) Language
l = (CostModelApplyError -> ProtocolParametersConversionError)
-> Either CostModelApplyError CostModel
-> Either ProtocolParametersConversionError CostModel
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 (CostModel
-> CostModelApplyError -> ProtocolParametersConversionError
PpceInvalidCostModel ([Int64] -> CostModel
CostModel [Int64]
m)) (Either CostModelApplyError CostModel
 -> Either ProtocolParametersConversionError CostModel)
-> Either CostModelApplyError CostModel
-> Either ProtocolParametersConversionError CostModel
forall a b. (a -> b) -> a -> b
$ Language -> [Int64] -> Either CostModelApplyError CostModel
Alonzo.mkCostModel Language
l [Int64]
m

fromAlonzoCostModel :: Alonzo.CostModel -> CostModel
fromAlonzoCostModel :: CostModel -> CostModel
fromAlonzoCostModel CostModel
m = [Int64] -> CostModel
CostModel ([Int64] -> CostModel) -> [Int64] -> CostModel
forall a b. (a -> b) -> a -> b
$ CostModel -> [Int64]
Alonzo.getCostModelParams CostModel
m

boundRationalEither
  :: Ledger.BoundedRational b
  => String
  -> Rational
  -> Either ProtocolParametersConversionError b
boundRationalEither :: forall b.
BoundedRational b =>
String -> Rational -> Either ProtocolParametersConversionError b
boundRationalEither String
name Rational
r = ProtocolParametersConversionError
-> Maybe b -> Either ProtocolParametersConversionError b
forall b a. b -> Maybe a -> Either b a
maybeToRight (String -> Rational -> ProtocolParametersConversionError
PpceOutOfBounds String
name Rational
r) (Maybe b -> Either ProtocolParametersConversionError b)
-> Maybe b -> Either ProtocolParametersConversionError b
forall a b. (a -> b) -> a -> b
$ Rational -> Maybe b
forall r. BoundedRational r => Rational -> Maybe r
Ledger.boundRational Rational
r

data ProtocolParametersError
  = PParamsErrorMissingMinUTxoValue !AnyCardanoEra
  | PParamsErrorMissingAlonzoProtocolParameter
  deriving Int -> ProtocolParametersError -> ShowS
[ProtocolParametersError] -> ShowS
ProtocolParametersError -> String
(Int -> ProtocolParametersError -> ShowS)
-> (ProtocolParametersError -> String)
-> ([ProtocolParametersError] -> ShowS)
-> Show ProtocolParametersError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProtocolParametersError -> ShowS
showsPrec :: Int -> ProtocolParametersError -> ShowS
$cshow :: ProtocolParametersError -> String
show :: ProtocolParametersError -> String
$cshowList :: [ProtocolParametersError] -> ShowS
showList :: [ProtocolParametersError] -> ShowS
Show

instance Error ProtocolParametersError where
  prettyError :: forall ann. ProtocolParametersError -> Doc ann
prettyError = \case
    PParamsErrorMissingMinUTxoValue (AnyCardanoEra CardanoEra era
era) ->
      [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat
        [ Doc ann
"The " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> CardanoEra era -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. CardanoEra era -> Doc ann
pretty CardanoEra era
era Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" protocol parameters value is missing the following "
        , Doc ann
"field: MinUTxoValue. Did you intend to use a " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> CardanoEra era -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. CardanoEra era -> Doc ann
pretty CardanoEra era
era Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" protocol "
        , Doc ann
"parameters value?"
        ]
    ProtocolParametersError
PParamsErrorMissingAlonzoProtocolParameter ->
      [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat
        [ Doc ann
"The Alonzo era protocol parameters in use is missing one or more of the "
        , Doc ann
"following fields: UTxOCostPerWord, CostModels, Prices, MaxTxExUnits, "
        , Doc ann
"MaxBlockExUnits, MaxValueSize, CollateralPercent, MaxCollateralInputs. Did "
        , Doc ann
"you intend to use an Alonzo era protocol parameters value?"
        ]

data ProtocolParametersConversionError
  = PpceOutOfBounds !ProtocolParameterName !Rational
  | PpceVersionInvalid !ProtocolParameterVersion
  | PpceInvalidCostModel !CostModel !CostModelApplyError
  | PpceMissingParameter !ProtocolParameterName
  deriving (ProtocolParametersConversionError
-> ProtocolParametersConversionError -> Bool
(ProtocolParametersConversionError
 -> ProtocolParametersConversionError -> Bool)
-> (ProtocolParametersConversionError
    -> ProtocolParametersConversionError -> Bool)
-> Eq ProtocolParametersConversionError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProtocolParametersConversionError
-> ProtocolParametersConversionError -> Bool
== :: ProtocolParametersConversionError
-> ProtocolParametersConversionError -> Bool
$c/= :: ProtocolParametersConversionError
-> ProtocolParametersConversionError -> Bool
/= :: ProtocolParametersConversionError
-> ProtocolParametersConversionError -> Bool
Eq, Int -> ProtocolParametersConversionError -> ShowS
[ProtocolParametersConversionError] -> ShowS
ProtocolParametersConversionError -> String
(Int -> ProtocolParametersConversionError -> ShowS)
-> (ProtocolParametersConversionError -> String)
-> ([ProtocolParametersConversionError] -> ShowS)
-> Show ProtocolParametersConversionError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProtocolParametersConversionError -> ShowS
showsPrec :: Int -> ProtocolParametersConversionError -> ShowS
$cshow :: ProtocolParametersConversionError -> String
show :: ProtocolParametersConversionError -> String
$cshowList :: [ProtocolParametersConversionError] -> ShowS
showList :: [ProtocolParametersConversionError] -> ShowS
Show, Typeable ProtocolParametersConversionError
Typeable ProtocolParametersConversionError =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ProtocolParametersConversionError
 -> c ProtocolParametersConversionError)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c ProtocolParametersConversionError)
-> (ProtocolParametersConversionError -> Constr)
-> (ProtocolParametersConversionError -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c ProtocolParametersConversionError))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ProtocolParametersConversionError))
-> ((forall b. Data b => b -> b)
    -> ProtocolParametersConversionError
    -> ProtocolParametersConversionError)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ProtocolParametersConversionError
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ProtocolParametersConversionError
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> ProtocolParametersConversionError -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> ProtocolParametersConversionError
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ProtocolParametersConversionError
    -> m ProtocolParametersConversionError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ProtocolParametersConversionError
    -> m ProtocolParametersConversionError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ProtocolParametersConversionError
    -> m ProtocolParametersConversionError)
-> Data ProtocolParametersConversionError
ProtocolParametersConversionError -> Constr
ProtocolParametersConversionError -> DataType
(forall b. Data b => b -> b)
-> ProtocolParametersConversionError
-> ProtocolParametersConversionError
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> ProtocolParametersConversionError
-> u
forall u.
(forall d. Data d => d -> u)
-> ProtocolParametersConversionError -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ProtocolParametersConversionError
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ProtocolParametersConversionError
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ProtocolParametersConversionError
-> m ProtocolParametersConversionError
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ProtocolParametersConversionError
-> m ProtocolParametersConversionError
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ProtocolParametersConversionError
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ProtocolParametersConversionError
-> c ProtocolParametersConversionError
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ProtocolParametersConversionError)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ProtocolParametersConversionError)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ProtocolParametersConversionError
-> c ProtocolParametersConversionError
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ProtocolParametersConversionError
-> c ProtocolParametersConversionError
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ProtocolParametersConversionError
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ProtocolParametersConversionError
$ctoConstr :: ProtocolParametersConversionError -> Constr
toConstr :: ProtocolParametersConversionError -> Constr
$cdataTypeOf :: ProtocolParametersConversionError -> DataType
dataTypeOf :: ProtocolParametersConversionError -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ProtocolParametersConversionError)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ProtocolParametersConversionError)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ProtocolParametersConversionError)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ProtocolParametersConversionError)
$cgmapT :: (forall b. Data b => b -> b)
-> ProtocolParametersConversionError
-> ProtocolParametersConversionError
gmapT :: (forall b. Data b => b -> b)
-> ProtocolParametersConversionError
-> ProtocolParametersConversionError
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ProtocolParametersConversionError
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ProtocolParametersConversionError
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ProtocolParametersConversionError
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ProtocolParametersConversionError
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> ProtocolParametersConversionError -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> ProtocolParametersConversionError -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ProtocolParametersConversionError
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ProtocolParametersConversionError
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ProtocolParametersConversionError
-> m ProtocolParametersConversionError
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ProtocolParametersConversionError
-> m ProtocolParametersConversionError
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ProtocolParametersConversionError
-> m ProtocolParametersConversionError
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ProtocolParametersConversionError
-> m ProtocolParametersConversionError
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ProtocolParametersConversionError
-> m ProtocolParametersConversionError
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ProtocolParametersConversionError
-> m ProtocolParametersConversionError
Data)

type ProtocolParameterName = String

type ProtocolParameterVersion = Natural

instance Error ProtocolParametersConversionError where
  prettyError :: forall ann. ProtocolParametersConversionError -> Doc ann
prettyError = \case
    PpceOutOfBounds String
name Rational
r ->
      Doc ann
"Value for '" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
name Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"' is outside of bounds: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Double -> Doc ann
forall ann. Double -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
r :: Double)
    PpceVersionInvalid Natural
majorProtVer ->
      Doc ann
"Major protocol version is invalid: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Natural -> Doc ann
forall ann. Natural -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Natural
majorProtVer
    PpceInvalidCostModel CostModel
cm CostModelApplyError
err ->
      Doc ann
"Invalid cost model: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty @Text (CostModelApplyError -> Text
forall str a. (Pretty a, Render str) => a -> str
display CostModelApplyError
err) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" Cost model: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> CostModel -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow CostModel
cm
    PpceMissingParameter String
name ->
      Doc ann
"Missing parameter: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
name