{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Alonzo.Genesis
  ( AlonzoGenesis (..),
    extendPPWithGenesis,
  )
where

import Cardano.Binary
import Cardano.Crypto.Hash.Class (hashToTextAsHex)
import Cardano.Ledger.Alonzo.Language (Language (..))
import Cardano.Ledger.Alonzo.PParams
import Cardano.Ledger.Alonzo.Scripts
  ( CostModel,
    CostModels (..),
    ExUnits (..),
    ExUnits',
    Prices (..),
    getCostModelParams,
    mkCostModel,
  )
import Cardano.Ledger.Alonzo.TxBody (TxOut (TxOut))
import qualified Cardano.Ledger.BaseTypes as BT
import Cardano.Ledger.Coin (Coin)
import qualified Cardano.Ledger.Core as Core
import Cardano.Ledger.Era (Era)
import Cardano.Ledger.SafeHash (extractHash)
import qualified Cardano.Ledger.Shelley.PParams as Shelley
import Data.Aeson (FromJSON (..), ToJSON (..), Value, object, (.!=), (.:), (.:?), (.=))
import qualified Data.Aeson as Aeson
import Data.Aeson.Types (FromJSONKey (..), ToJSONKey (..), toJSONKeyText)
import Data.Coders
import Data.Functor.Identity
import Data.Map (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (mapMaybe)
import Data.Scientific (fromRationalRepetendLimited)
import qualified Data.Set as Set
import Data.Text (Text)
import Data.Word (Word64)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks)
import Numeric.Natural (Natural)
import Plutus.V1.Ledger.Api as PV1 (costModelParamNames)
import Prelude

data AlonzoGenesis = AlonzoGenesis
  { AlonzoGenesis -> Coin
coinsPerUTxOWord :: !Coin,
    AlonzoGenesis -> CostModels
costmdls :: !CostModels,
    AlonzoGenesis -> Prices
prices :: !Prices,
    AlonzoGenesis -> ExUnits
maxTxExUnits :: !ExUnits,
    AlonzoGenesis -> ExUnits
maxBlockExUnits :: !ExUnits,
    AlonzoGenesis -> Natural
maxValSize :: !Natural,
    AlonzoGenesis -> Natural
collateralPercentage :: !Natural,
    AlonzoGenesis -> Natural
maxCollateralInputs :: !Natural
  }
  deriving (AlonzoGenesis -> AlonzoGenesis -> Bool
(AlonzoGenesis -> AlonzoGenesis -> Bool)
-> (AlonzoGenesis -> AlonzoGenesis -> Bool) -> Eq AlonzoGenesis
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AlonzoGenesis -> AlonzoGenesis -> Bool
$c/= :: AlonzoGenesis -> AlonzoGenesis -> Bool
== :: AlonzoGenesis -> AlonzoGenesis -> Bool
$c== :: AlonzoGenesis -> AlonzoGenesis -> Bool
Eq, (forall x. AlonzoGenesis -> Rep AlonzoGenesis x)
-> (forall x. Rep AlonzoGenesis x -> AlonzoGenesis)
-> Generic AlonzoGenesis
forall x. Rep AlonzoGenesis x -> AlonzoGenesis
forall x. AlonzoGenesis -> Rep AlonzoGenesis x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AlonzoGenesis x -> AlonzoGenesis
$cfrom :: forall x. AlonzoGenesis -> Rep AlonzoGenesis x
Generic, Context -> AlonzoGenesis -> IO (Maybe ThunkInfo)
Proxy AlonzoGenesis -> String
(Context -> AlonzoGenesis -> IO (Maybe ThunkInfo))
-> (Context -> AlonzoGenesis -> IO (Maybe ThunkInfo))
-> (Proxy AlonzoGenesis -> String)
-> NoThunks AlonzoGenesis
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy AlonzoGenesis -> String
$cshowTypeOf :: Proxy AlonzoGenesis -> String
wNoThunks :: Context -> AlonzoGenesis -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> AlonzoGenesis -> IO (Maybe ThunkInfo)
noThunks :: Context -> AlonzoGenesis -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> AlonzoGenesis -> IO (Maybe ThunkInfo)
NoThunks)

-- | Given the missing pieces turn a Shelley.PParams' into an Params'
extendPPWithGenesis ::
  Shelley.PParams' Identity era1 ->
  AlonzoGenesis ->
  PParams' Identity era2
extendPPWithGenesis :: PParams' Identity era1 -> AlonzoGenesis -> PParams' Identity era2
extendPPWithGenesis
  PParams' Identity era1
pp
  AlonzoGenesis
    { Coin
coinsPerUTxOWord :: Coin
coinsPerUTxOWord :: AlonzoGenesis -> Coin
coinsPerUTxOWord,
      CostModels
costmdls :: CostModels
costmdls :: AlonzoGenesis -> CostModels
costmdls,
      Prices
prices :: Prices
prices :: AlonzoGenesis -> Prices
prices,
      ExUnits
maxTxExUnits :: ExUnits
maxTxExUnits :: AlonzoGenesis -> ExUnits
maxTxExUnits,
      ExUnits
maxBlockExUnits :: ExUnits
maxBlockExUnits :: AlonzoGenesis -> ExUnits
maxBlockExUnits,
      Natural
maxValSize :: Natural
maxValSize :: AlonzoGenesis -> Natural
maxValSize,
      Natural
collateralPercentage :: Natural
collateralPercentage :: AlonzoGenesis -> Natural
collateralPercentage,
      Natural
maxCollateralInputs :: Natural
maxCollateralInputs :: AlonzoGenesis -> Natural
maxCollateralInputs
    } =
    PParams' Identity era1
-> HKD Identity Coin
-> HKD Identity CostModels
-> HKD Identity Prices
-> HKD Identity ExUnits
-> HKD Identity ExUnits
-> HKD Identity Natural
-> HKD Identity Natural
-> HKD Identity Natural
-> PParams' Identity era2
forall (f :: * -> *) era1 era2.
PParams' f era1
-> HKD f Coin
-> HKD f CostModels
-> HKD f Prices
-> HKD f ExUnits
-> HKD f ExUnits
-> HKD f Natural
-> HKD f Natural
-> HKD f Natural
-> PParams' f era2
extendPP
      PParams' Identity era1
pp
      Coin
HKD Identity Coin
coinsPerUTxOWord
      HKD Identity CostModels
CostModels
costmdls
      HKD Identity Prices
Prices
prices
      HKD Identity ExUnits
ExUnits
maxTxExUnits
      HKD Identity ExUnits
ExUnits
maxBlockExUnits
      Natural
HKD Identity Natural
maxValSize
      Natural
HKD Identity Natural
collateralPercentage
      Natural
HKD Identity Natural
maxCollateralInputs

--------------------------------------------------------------------------------
-- Serialisation
--------------------------------------------------------------------------------

instance FromCBOR AlonzoGenesis where
  fromCBOR :: Decoder s AlonzoGenesis
fromCBOR =
    Decode ('Closed 'Dense) AlonzoGenesis -> Decoder s AlonzoGenesis
forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) AlonzoGenesis -> Decoder s AlonzoGenesis)
-> Decode ('Closed 'Dense) AlonzoGenesis -> Decoder s AlonzoGenesis
forall a b. (a -> b) -> a -> b
$
      (Coin
 -> CostModels
 -> Prices
 -> ExUnits
 -> ExUnits
 -> Natural
 -> Natural
 -> Natural
 -> AlonzoGenesis)
-> Decode
     ('Closed 'Dense)
     (Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> AlonzoGenesis)
forall t. t -> Decode ('Closed 'Dense) t
RecD Coin
-> CostModels
-> Prices
-> ExUnits
-> ExUnits
-> Natural
-> Natural
-> Natural
-> AlonzoGenesis
AlonzoGenesis
        Decode
  ('Closed 'Dense)
  (Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> AlonzoGenesis)
-> Decode ('Closed Any) Coin
-> Decode
     ('Closed 'Dense)
     (CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> AlonzoGenesis)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Coin
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> AlonzoGenesis)
-> Decode ('Closed Any) CostModels
-> Decode
     ('Closed 'Dense)
     (Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> AlonzoGenesis)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) CostModels
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> AlonzoGenesis)
-> Decode ('Closed Any) Prices
-> Decode
     ('Closed 'Dense)
     (ExUnits
      -> ExUnits -> Natural -> Natural -> Natural -> AlonzoGenesis)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Prices
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (ExUnits
   -> ExUnits -> Natural -> Natural -> Natural -> AlonzoGenesis)
-> Decode ('Closed Any) ExUnits
-> Decode
     ('Closed 'Dense)
     (ExUnits -> Natural -> Natural -> Natural -> AlonzoGenesis)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) ExUnits
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (ExUnits -> Natural -> Natural -> Natural -> AlonzoGenesis)
-> Decode ('Closed Any) ExUnits
-> Decode
     ('Closed 'Dense) (Natural -> Natural -> Natural -> AlonzoGenesis)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) ExUnits
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense) (Natural -> Natural -> Natural -> AlonzoGenesis)
-> Decode ('Closed Any) Natural
-> Decode ('Closed 'Dense) (Natural -> Natural -> AlonzoGenesis)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Natural
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
        Decode ('Closed 'Dense) (Natural -> Natural -> AlonzoGenesis)
-> Decode ('Closed Any) Natural
-> Decode ('Closed 'Dense) (Natural -> AlonzoGenesis)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Natural
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
        Decode ('Closed 'Dense) (Natural -> AlonzoGenesis)
-> Decode ('Closed Any) Natural
-> Decode ('Closed 'Dense) AlonzoGenesis
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Natural
forall t (w :: Wrapped). FromCBOR t => Decode w t
From

instance ToCBOR AlonzoGenesis where
  toCBOR :: AlonzoGenesis -> Encoding
toCBOR
    AlonzoGenesis
      { Coin
coinsPerUTxOWord :: Coin
coinsPerUTxOWord :: AlonzoGenesis -> Coin
coinsPerUTxOWord,
        CostModels
costmdls :: CostModels
costmdls :: AlonzoGenesis -> CostModels
costmdls,
        Prices
prices :: Prices
prices :: AlonzoGenesis -> Prices
prices,
        ExUnits
maxTxExUnits :: ExUnits
maxTxExUnits :: AlonzoGenesis -> ExUnits
maxTxExUnits,
        ExUnits
maxBlockExUnits :: ExUnits
maxBlockExUnits :: AlonzoGenesis -> ExUnits
maxBlockExUnits,
        Natural
maxValSize :: Natural
maxValSize :: AlonzoGenesis -> Natural
maxValSize,
        Natural
collateralPercentage :: Natural
collateralPercentage :: AlonzoGenesis -> Natural
collateralPercentage,
        Natural
maxCollateralInputs :: Natural
maxCollateralInputs :: AlonzoGenesis -> Natural
maxCollateralInputs
      } =
      Encode ('Closed 'Dense) AlonzoGenesis -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode ('Closed 'Dense) AlonzoGenesis -> Encoding)
-> Encode ('Closed 'Dense) AlonzoGenesis -> Encoding
forall a b. (a -> b) -> a -> b
$
        (Coin
 -> CostModels
 -> Prices
 -> ExUnits
 -> ExUnits
 -> Natural
 -> Natural
 -> Natural
 -> AlonzoGenesis)
-> Encode
     ('Closed 'Dense)
     (Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> AlonzoGenesis)
forall t. t -> Encode ('Closed 'Dense) t
Rec Coin
-> CostModels
-> Prices
-> ExUnits
-> ExUnits
-> Natural
-> Natural
-> Natural
-> AlonzoGenesis
AlonzoGenesis
          Encode
  ('Closed 'Dense)
  (Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> AlonzoGenesis)
-> Encode ('Closed 'Dense) Coin
-> Encode
     ('Closed 'Dense)
     (CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> AlonzoGenesis)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Coin -> Encode ('Closed 'Dense) Coin
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
coinsPerUTxOWord
          Encode
  ('Closed 'Dense)
  (CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> AlonzoGenesis)
-> Encode ('Closed 'Dense) CostModels
-> Encode
     ('Closed 'Dense)
     (Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> AlonzoGenesis)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> CostModels -> Encode ('Closed 'Dense) CostModels
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To CostModels
costmdls
          Encode
  ('Closed 'Dense)
  (Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> AlonzoGenesis)
-> Encode ('Closed 'Dense) Prices
-> Encode
     ('Closed 'Dense)
     (ExUnits
      -> ExUnits -> Natural -> Natural -> Natural -> AlonzoGenesis)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Prices -> Encode ('Closed 'Dense) Prices
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Prices
prices
          Encode
  ('Closed 'Dense)
  (ExUnits
   -> ExUnits -> Natural -> Natural -> Natural -> AlonzoGenesis)
-> Encode ('Closed 'Dense) ExUnits
-> Encode
     ('Closed 'Dense)
     (ExUnits -> Natural -> Natural -> Natural -> AlonzoGenesis)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> ExUnits -> Encode ('Closed 'Dense) ExUnits
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To ExUnits
maxTxExUnits
          Encode
  ('Closed 'Dense)
  (ExUnits -> Natural -> Natural -> Natural -> AlonzoGenesis)
-> Encode ('Closed 'Dense) ExUnits
-> Encode
     ('Closed 'Dense) (Natural -> Natural -> Natural -> AlonzoGenesis)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> ExUnits -> Encode ('Closed 'Dense) ExUnits
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To ExUnits
maxBlockExUnits
          Encode
  ('Closed 'Dense) (Natural -> Natural -> Natural -> AlonzoGenesis)
-> Encode ('Closed 'Dense) Natural
-> Encode ('Closed 'Dense) (Natural -> Natural -> AlonzoGenesis)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Natural -> Encode ('Closed 'Dense) Natural
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Natural
maxValSize
          Encode ('Closed 'Dense) (Natural -> Natural -> AlonzoGenesis)
-> Encode ('Closed 'Dense) Natural
-> Encode ('Closed 'Dense) (Natural -> AlonzoGenesis)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Natural -> Encode ('Closed 'Dense) Natural
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Natural
collateralPercentage
          Encode ('Closed 'Dense) (Natural -> AlonzoGenesis)
-> Encode ('Closed 'Dense) Natural
-> Encode ('Closed 'Dense) AlonzoGenesis
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Natural -> Encode ('Closed 'Dense) Natural
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Natural
maxCollateralInputs

deriving instance ToJSON a => ToJSON (ExUnits' a)

deriving instance FromJSON a => FromJSON (ExUnits' a)

instance ToJSON ExUnits where
  toJSON :: ExUnits -> Value
toJSON ExUnits {exUnitsMem :: ExUnits -> Natural
exUnitsMem = Natural
m, exUnitsSteps :: ExUnits -> Natural
exUnitsSteps = Natural
s} =
    [Pair] -> Value
object
      [ Key
"exUnitsMem" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Natural -> Value
forall a. ToJSON a => a -> Value
toJSON Natural
m,
        Key
"exUnitsSteps" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Natural -> Value
forall a. ToJSON a => a -> Value
toJSON Natural
s
      ]

instance FromJSON ExUnits where
  parseJSON :: Value -> Parser ExUnits
parseJSON = String -> (Object -> Parser ExUnits) -> Value -> Parser ExUnits
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"exUnits" ((Object -> Parser ExUnits) -> Value -> Parser ExUnits)
-> (Object -> Parser ExUnits) -> Value -> Parser ExUnits
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Natural
mem <- Object
o Object -> Key -> Parser Natural
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"exUnitsMem"
    Natural
steps <- Object
o Object -> Key -> Parser Natural
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"exUnitsSteps"
    Natural
bmem <- Natural -> Parser Natural
forall a (f :: * -> *).
(Ord a, Num a, MonadFail f, Show a) =>
a -> f a
checkWord64Bounds Natural
mem
    Natural
bsteps <- Natural -> Parser Natural
forall a (f :: * -> *).
(Ord a, Num a, MonadFail f, Show a) =>
a -> f a
checkWord64Bounds Natural
steps
    ExUnits -> Parser ExUnits
forall (m :: * -> *) a. Monad m => a -> m a
return (ExUnits -> Parser ExUnits) -> ExUnits -> Parser ExUnits
forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> ExUnits
ExUnits Natural
bmem Natural
bsteps
    where
      checkWord64Bounds :: a -> f a
checkWord64Bounds a
n =
        if a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Bounded Word64 => Word64
forall a. Bounded a => a
minBound @Word64)
          Bool -> Bool -> Bool
&& a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Bounded Word64 => Word64
forall a. Bounded a => a
maxBound @Word64)
          then a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
n
          else String -> f a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unit out of bounds for Word64: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
n)

toRationalJSON :: Rational -> Value
toRationalJSON :: Rational -> Value
toRationalJSON Rational
r =
  case Int
-> Rational
-> Either (Scientific, Rational) (Scientific, Maybe Int)
fromRationalRepetendLimited Int
20 Rational
r of
    Right (Scientific
s, Maybe Int
Nothing) -> Scientific -> Value
forall a. ToJSON a => a -> Value
toJSON Scientific
s
    Either (Scientific, Rational) (Scientific, Maybe Int)
_ -> Rational -> Value
forall a. ToJSON a => a -> Value
toJSON Rational
r

instance ToJSON Prices where
  toJSON :: Prices -> Value
toJSON Prices {NonNegativeInterval
prSteps :: Prices -> NonNegativeInterval
prSteps :: NonNegativeInterval
prSteps, NonNegativeInterval
prMem :: Prices -> NonNegativeInterval
prMem :: NonNegativeInterval
prMem} =
    -- We cannot round-trip via NonNegativeInterval, so we go via Rational
    [Pair] -> Value
object
      [ Key
"prSteps" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Rational -> Value
toRationalJSON (NonNegativeInterval -> Rational
forall r. BoundedRational r => r -> Rational
BT.unboundRational NonNegativeInterval
prSteps),
        Key
"prMem" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Rational -> Value
toRationalJSON (NonNegativeInterval -> Rational
forall r. BoundedRational r => r -> Rational
BT.unboundRational NonNegativeInterval
prMem)
      ]

instance FromJSON Prices where
  parseJSON :: Value -> Parser Prices
parseJSON =
    String -> (Object -> Parser Prices) -> Value -> Parser Prices
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"prices" ((Object -> Parser Prices) -> Value -> Parser Prices)
-> (Object -> Parser Prices) -> Value -> Parser Prices
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      Rational
steps <- Object
o Object -> Key -> Parser Rational
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"prSteps"
      Rational
mem <- Object
o Object -> Key -> Parser Rational
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"prMem"
      NonNegativeInterval
prSteps <- Rational -> Parser NonNegativeInterval
forall a (m :: * -> *).
(BoundedRational a, MonadFail m) =>
Rational -> m a
checkBoundedRational Rational
steps
      NonNegativeInterval
prMem <- Rational -> Parser NonNegativeInterval
forall a (m :: * -> *).
(BoundedRational a, MonadFail m) =>
Rational -> m a
checkBoundedRational Rational
mem
      Prices -> Parser Prices
forall (m :: * -> *) a. Monad m => a -> m a
return Prices :: NonNegativeInterval -> NonNegativeInterval -> Prices
Prices {NonNegativeInterval
prSteps :: NonNegativeInterval
prSteps :: NonNegativeInterval
prSteps, NonNegativeInterval
prMem :: NonNegativeInterval
prMem :: NonNegativeInterval
prMem}
    where
      -- We cannot round-trip via NonNegativeInterval, so we go via Rational
      checkBoundedRational :: Rational -> m a
checkBoundedRational Rational
r =
        case Rational -> Maybe a
forall r. BoundedRational r => Rational -> Maybe r
BT.boundRational Rational
r of
          Maybe a
Nothing -> String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"too much precision for bounded rational: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Rational -> String
forall a. Show a => a -> String
show Rational
r)
          Just a
s -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
s

instance ToJSON CostModel where
  toJSON :: CostModel -> Value
toJSON = Map Text Integer -> Value
forall a. ToJSON a => a -> Value
toJSON (Map Text Integer -> Value)
-> (CostModel -> Map Text Integer) -> CostModel -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CostModel -> Map Text Integer
getCostModelParams

instance ToJSON CostModels where
  toJSON :: CostModels -> Value
toJSON = Map Language CostModel -> Value
forall a. ToJSON a => a -> Value
toJSON (Map Language CostModel -> Value)
-> (CostModels -> Map Language CostModel) -> CostModels -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CostModels -> Map Language CostModel
unCostModels

languageToText :: Language -> Text
languageToText :: Language -> Text
languageToText Language
PlutusV1 = Text
"PlutusV1"
languageToText Language
PlutusV2 = Text
"PlutusV2"

languageFromText :: MonadFail m => Text -> m Language
languageFromText :: Text -> m Language
languageFromText Text
"PlutusV1" = Language -> m Language
forall (f :: * -> *) a. Applicative f => a -> f a
pure Language
PlutusV1
languageFromText Text
"PlutusV2" = Language -> m Language
forall (f :: * -> *) a. Applicative f => a -> f a
pure Language
PlutusV2
languageFromText Text
lang = String -> m Language
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m Language) -> String -> m Language
forall a b. (a -> b) -> a -> b
$ String
"Error decoding Language: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
lang

instance FromJSON Language where
  parseJSON :: Value -> Parser Language
parseJSON = String -> (Text -> Parser Language) -> Value -> Parser Language
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"Language" Text -> Parser Language
forall (m :: * -> *). MonadFail m => Text -> m Language
languageFromText

instance ToJSON Language where
  toJSON :: Language -> Value
toJSON = Text -> Value
Aeson.String (Text -> Value) -> (Language -> Text) -> Language -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Language -> Text
languageToText

instance ToJSONKey Language where
  toJSONKey :: ToJSONKeyFunction Language
toJSONKey = (Language -> Text) -> ToJSONKeyFunction Language
forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText Language -> Text
languageToText

instance FromJSONKey Language where
  fromJSONKey :: FromJSONKeyFunction Language
fromJSONKey = (Text -> Parser Language) -> FromJSONKeyFunction Language
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
Aeson.FromJSONKeyTextParser Text -> Parser Language
forall (m :: * -> *). MonadFail m => Text -> m Language
languageFromText

validateCostModel :: MonadFail m => (Language, Map Text Integer) -> m (Language, CostModel)
validateCostModel :: (Language, Map Text Integer) -> m (Language, CostModel)
validateCostModel (Language
lang, Map Text Integer
cmps) = case Language
-> Map Text Integer -> Either CostModelApplyError CostModel
mkCostModel Language
lang Map Text Integer
cmps of
  Left CostModelApplyError
err -> String -> m (Language, CostModel)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m (Language, CostModel))
-> String -> m (Language, CostModel)
forall a b. (a -> b) -> a -> b
$ CostModelApplyError -> String
forall a. Show a => a -> String
show CostModelApplyError
err
  Right CostModel
cm -> (Language, CostModel) -> m (Language, CostModel)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Language
lang, CostModel
cm)

-- | The keys of the Plutus V1 cost models have changed since the Alonzo genesis file was created.
-- The number of keys, and the ordering of the keys, however, has not changed.
-- Therefore we just replace (in order) the new keys for the old ones.
translateLegacyV1paramNames :: Map Text Integer -> Map Text Integer
translateLegacyV1paramNames :: Map Text Integer -> Map Text Integer
translateLegacyV1paramNames Map Text Integer
cmps =
  [(Text, Integer)] -> Map Text Integer
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, Integer)] -> Map Text Integer)
-> [(Text, Integer)] -> Map Text Integer
forall a b. (a -> b) -> a -> b
$
    ((Text, Integer) -> Text -> (Text, Integer))
-> [(Text, Integer)] -> [Text] -> [(Text, Integer)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\(Text
_, Integer
v) Text
k2 -> (Text
k2, Integer
v)) (Map Text Integer -> [(Text, Integer)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Integer
cmps) (Set Text -> [Text]
forall a. Set a -> [a]
Set.toList Set Text
PV1.costModelParamNames)

instance FromJSON CostModels where
  parseJSON :: Value -> Parser CostModels
parseJSON = String
-> (Object -> Parser CostModels) -> Value -> Parser CostModels
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"CostModels" ((Object -> Parser CostModels) -> Value -> Parser CostModels)
-> (Object -> Parser CostModels) -> Value -> Parser CostModels
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Maybe (Map Text Integer)
plutusV1 <- Object
o Object -> Key -> Parser (Maybe (Map Text Integer))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"PlutusV1"
    Maybe (Map Text Integer)
plutusV2 <- Object
o Object -> Key -> Parser (Maybe (Map Text Integer))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"PlutusV2"
    let plutusV1' :: Maybe (Map Text Integer)
plutusV1' = Map Text Integer -> Map Text Integer
translateLegacyV1paramNames (Map Text Integer -> Map Text Integer)
-> Maybe (Map Text Integer) -> Maybe (Map Text Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Map Text Integer)
plutusV1
    [(Language, CostModel)]
cms <- ((Language, Map Text Integer) -> Parser (Language, CostModel))
-> [(Language, Map Text Integer)] -> Parser [(Language, CostModel)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Language, Map Text Integer) -> Parser (Language, CostModel)
forall (m :: * -> *).
MonadFail m =>
(Language, Map Text Integer) -> m (Language, CostModel)
validateCostModel ([(Language, Map Text Integer)] -> Parser [(Language, CostModel)])
-> [(Language, Map Text Integer)] -> Parser [(Language, CostModel)]
forall a b. (a -> b) -> a -> b
$ ((Language, Maybe (Map Text Integer))
 -> Maybe (Language, Map Text Integer))
-> [(Language, Maybe (Map Text Integer))]
-> [(Language, Map Text Integer)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Language, Maybe (Map Text Integer))
-> Maybe (Language, Map Text Integer)
forall a b. (a, Maybe b) -> Maybe (a, b)
f [(Language
PlutusV1, Maybe (Map Text Integer)
plutusV1'), (Language
PlutusV2, Maybe (Map Text Integer)
plutusV2)]
    CostModels -> Parser CostModels
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CostModels -> Parser CostModels)
-> ([(Language, CostModel)] -> CostModels)
-> [(Language, CostModel)]
-> Parser CostModels
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Language CostModel -> CostModels
CostModels (Map Language CostModel -> CostModels)
-> ([(Language, CostModel)] -> Map Language CostModel)
-> [(Language, CostModel)]
-> CostModels
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Language, CostModel)] -> Map Language CostModel
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Language, CostModel)] -> Parser CostModels)
-> [(Language, CostModel)] -> Parser CostModels
forall a b. (a -> b) -> a -> b
$ [(Language, CostModel)]
cms
    where
      f :: (a, Maybe b) -> Maybe (a, b)
f (a
_, Maybe b
Nothing) = Maybe (a, b)
forall a. Maybe a
Nothing
      f (a
a, Just b
b) = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
a, b
b)

instance FromJSON AlonzoGenesis where
  parseJSON :: Value -> Parser AlonzoGenesis
parseJSON = String
-> (Object -> Parser AlonzoGenesis)
-> Value
-> Parser AlonzoGenesis
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"Alonzo Genesis" ((Object -> Parser AlonzoGenesis) -> Value -> Parser AlonzoGenesis)
-> (Object -> Parser AlonzoGenesis)
-> Value
-> Parser AlonzoGenesis
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Coin
coinsPerUTxOWord <- Object
o Object -> Key -> Parser Coin
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"lovelacePerUTxOWord"
    CostModels
costmdls <- Object
o Object -> Key -> Parser CostModels
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"costModels"
    Prices
prices <- Object
o Object -> Key -> Parser Prices
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"executionPrices"
    ExUnits
maxTxExUnits <- Object
o Object -> Key -> Parser ExUnits
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"maxTxExUnits"
    ExUnits
maxBlockExUnits <- Object
o Object -> Key -> Parser ExUnits
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"maxBlockExUnits"
    Natural
maxValSize <- Object
o Object -> Key -> Parser Natural
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"maxValueSize"
    Natural
collateralPercentage <- Object
o Object -> Key -> Parser Natural
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"collateralPercentage"
    Natural
maxCollateralInputs <- Object
o Object -> Key -> Parser Natural
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"maxCollateralInputs"
    AlonzoGenesis -> Parser AlonzoGenesis
forall (m :: * -> *) a. Monad m => a -> m a
return
      AlonzoGenesis :: Coin
-> CostModels
-> Prices
-> ExUnits
-> ExUnits
-> Natural
-> Natural
-> Natural
-> AlonzoGenesis
AlonzoGenesis
        { Coin
coinsPerUTxOWord :: Coin
coinsPerUTxOWord :: Coin
coinsPerUTxOWord,
          CostModels
costmdls :: CostModels
costmdls :: CostModels
costmdls,
          Prices
prices :: Prices
prices :: Prices
prices,
          ExUnits
maxTxExUnits :: ExUnits
maxTxExUnits :: ExUnits
maxTxExUnits,
          ExUnits
maxBlockExUnits :: ExUnits
maxBlockExUnits :: ExUnits
maxBlockExUnits,
          Natural
maxValSize :: Natural
maxValSize :: Natural
maxValSize,
          Natural
collateralPercentage :: Natural
collateralPercentage :: Natural
collateralPercentage,
          Natural
maxCollateralInputs :: Natural
maxCollateralInputs :: Natural
maxCollateralInputs
        }

instance ToJSON AlonzoGenesis where
  toJSON :: AlonzoGenesis -> Value
toJSON AlonzoGenesis
v =
    [Pair] -> Value
object
      [ Key
"lovelacePerUTxOWord" Key -> Coin -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AlonzoGenesis -> Coin
coinsPerUTxOWord AlonzoGenesis
v,
        Key
"costModels" Key -> CostModels -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AlonzoGenesis -> CostModels
costmdls AlonzoGenesis
v,
        Key
"executionPrices" Key -> Prices -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AlonzoGenesis -> Prices
prices AlonzoGenesis
v,
        Key
"maxTxExUnits" Key -> ExUnits -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AlonzoGenesis -> ExUnits
maxTxExUnits AlonzoGenesis
v,
        Key
"maxBlockExUnits" Key -> ExUnits -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AlonzoGenesis -> ExUnits
maxBlockExUnits AlonzoGenesis
v,
        Key
"maxValueSize" Key -> Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AlonzoGenesis -> Natural
maxValSize AlonzoGenesis
v,
        Key
"collateralPercentage" Key -> Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AlonzoGenesis -> Natural
collateralPercentage AlonzoGenesis
v,
        Key
"maxCollateralInputs" Key -> Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AlonzoGenesis -> Natural
maxCollateralInputs AlonzoGenesis
v
      ]

instance ToJSON (PParams era) where
  toJSON :: PParams era -> Value
toJSON PParams era
pp =
    [Pair] -> Value
Aeson.object
      [ Key
"minFeeA" Key -> Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PParams era -> HKD Identity Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_minfeeA PParams era
pp,
        Key
"minFeeB" Key -> Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PParams era -> HKD Identity Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_minfeeB PParams era
pp,
        Key
"maxBlockBodySize" Key -> Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PParams era -> HKD Identity Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_maxBBSize PParams era
pp,
        Key
"maxTxSize" Key -> Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PParams era -> HKD Identity Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_maxTxSize PParams era
pp,
        Key
"maxBlockHeaderSize" Key -> Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PParams era -> HKD Identity Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_maxBHSize PParams era
pp,
        Key
"keyDeposit" Key -> Coin -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PParams era -> HKD Identity Coin
forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_keyDeposit PParams era
pp,
        Key
"poolDeposit" Key -> Coin -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PParams era -> HKD Identity Coin
forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_poolDeposit PParams era
pp,
        Key
"eMax" Key -> EpochNo -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PParams era -> HKD Identity EpochNo
forall (f :: * -> *) era. PParams' f era -> HKD f EpochNo
_eMax PParams era
pp,
        Key
"nOpt" Key -> Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PParams era -> HKD Identity Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_nOpt PParams era
pp,
        Key
"a0" Key -> NonNegativeInterval -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PParams era -> HKD Identity NonNegativeInterval
forall (f :: * -> *) era.
PParams' f era -> HKD f NonNegativeInterval
_a0 PParams era
pp,
        Key
"rho" Key -> UnitInterval -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PParams era -> HKD Identity UnitInterval
forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
_rho PParams era
pp,
        Key
"tau" Key -> UnitInterval -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PParams era -> HKD Identity UnitInterval
forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
_tau PParams era
pp,
        Key
"decentralisationParam" Key -> UnitInterval -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PParams era -> HKD Identity UnitInterval
forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
_d PParams era
pp,
        Key
"extraEntropy" Key -> Nonce -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PParams era -> HKD Identity Nonce
forall (f :: * -> *) era. PParams' f era -> HKD f Nonce
_extraEntropy PParams era
pp,
        Key
"protocolVersion" Key -> ProtVer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PParams era -> HKD Identity ProtVer
forall (f :: * -> *) era. PParams' f era -> HKD f ProtVer
_protocolVersion PParams era
pp,
        Key
"minPoolCost" Key -> Coin -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PParams era -> HKD Identity Coin
forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_minPoolCost PParams era
pp,
        Key
"lovelacePerUTxOWord" Key -> Coin -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PParams era -> HKD Identity Coin
forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_coinsPerUTxOWord PParams era
pp,
        Key
"costmdls" Key -> CostModels -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PParams era -> HKD Identity CostModels
forall (f :: * -> *) era. PParams' f era -> HKD f CostModels
_costmdls PParams era
pp,
        Key
"prices" Key -> Prices -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PParams era -> HKD Identity Prices
forall (f :: * -> *) era. PParams' f era -> HKD f Prices
_prices PParams era
pp,
        Key
"maxTxExUnits" Key -> ExUnits -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PParams era -> HKD Identity ExUnits
forall (f :: * -> *) era. PParams' f era -> HKD f ExUnits
_maxTxExUnits PParams era
pp,
        Key
"maxBlockExUnits" Key -> ExUnits -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PParams era -> HKD Identity ExUnits
forall (f :: * -> *) era. PParams' f era -> HKD f ExUnits
_maxBlockExUnits PParams era
pp,
        Key
"maxValSize" Key -> Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PParams era -> HKD Identity Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_maxValSize PParams era
pp,
        Key
"collateralPercentage" Key -> Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PParams era -> HKD Identity Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_collateralPercentage PParams era
pp,
        Key
"maxCollateralInputs " Key -> Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PParams era -> HKD Identity Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_maxCollateralInputs PParams era
pp
      ]

instance FromJSON (PParams era) where
  parseJSON :: Value -> Parser (PParams era)
parseJSON =
    String
-> (Object -> Parser (PParams era))
-> Value
-> Parser (PParams era)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"PParams" ((Object -> Parser (PParams era)) -> Value -> Parser (PParams era))
-> (Object -> Parser (PParams era))
-> Value
-> Parser (PParams era)
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
      Natural
-> Natural
-> Natural
-> Natural
-> Natural
-> Coin
-> Coin
-> EpochNo
-> Natural
-> NonNegativeInterval
-> UnitInterval
-> UnitInterval
-> UnitInterval
-> Nonce
-> ProtVer
-> Coin
-> Coin
-> CostModels
-> Prices
-> ExUnits
-> ExUnits
-> Natural
-> Natural
-> Natural
-> PParams era
forall (f :: * -> *) era.
HKD f Natural
-> HKD f Natural
-> HKD f Natural
-> HKD f Natural
-> HKD f Natural
-> HKD f Coin
-> HKD f Coin
-> HKD f EpochNo
-> HKD f Natural
-> HKD f NonNegativeInterval
-> HKD f UnitInterval
-> HKD f UnitInterval
-> HKD f UnitInterval
-> HKD f Nonce
-> HKD f ProtVer
-> HKD f Coin
-> HKD f Coin
-> HKD f CostModels
-> HKD f Prices
-> HKD f ExUnits
-> HKD f ExUnits
-> HKD f Natural
-> HKD f Natural
-> HKD f Natural
-> PParams' f era
PParams
        (Natural
 -> Natural
 -> Natural
 -> Natural
 -> Natural
 -> Coin
 -> Coin
 -> EpochNo
 -> Natural
 -> NonNegativeInterval
 -> UnitInterval
 -> UnitInterval
 -> UnitInterval
 -> Nonce
 -> ProtVer
 -> Coin
 -> Coin
 -> CostModels
 -> Prices
 -> ExUnits
 -> ExUnits
 -> Natural
 -> Natural
 -> Natural
 -> PParams era)
-> Parser Natural
-> Parser
     (Natural
      -> Natural
      -> Natural
      -> Natural
      -> Coin
      -> Coin
      -> EpochNo
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser Natural
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"minFeeA"
        Parser
  (Natural
   -> Natural
   -> Natural
   -> Natural
   -> Coin
   -> Coin
   -> EpochNo
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams era)
-> Parser Natural
-> Parser
     (Natural
      -> Natural
      -> Natural
      -> Coin
      -> Coin
      -> EpochNo
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser Natural
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"minFeeB"
        Parser
  (Natural
   -> Natural
   -> Natural
   -> Coin
   -> Coin
   -> EpochNo
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams era)
-> Parser Natural
-> Parser
     (Natural
      -> Natural
      -> Coin
      -> Coin
      -> EpochNo
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser Natural
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"maxBlockBodySize"
        Parser
  (Natural
   -> Natural
   -> Coin
   -> Coin
   -> EpochNo
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams era)
-> Parser Natural
-> Parser
     (Natural
      -> Coin
      -> Coin
      -> EpochNo
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser Natural
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"maxTxSize"
        Parser
  (Natural
   -> Coin
   -> Coin
   -> EpochNo
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams era)
-> Parser Natural
-> Parser
     (Coin
      -> Coin
      -> EpochNo
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser Natural
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"maxBlockHeaderSize"
        Parser
  (Coin
   -> Coin
   -> EpochNo
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams era)
-> Parser Coin
-> Parser
     (Coin
      -> EpochNo
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser Coin
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"keyDeposit"
        Parser
  (Coin
   -> EpochNo
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams era)
-> Parser Coin
-> Parser
     (EpochNo
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser Coin
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"poolDeposit"
        Parser
  (EpochNo
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams era)
-> Parser EpochNo
-> Parser
     (Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser EpochNo
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"eMax"
        Parser
  (Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams era)
-> Parser Natural
-> Parser
     (NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser Natural
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"nOpt"
        Parser
  (NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams era)
-> Parser NonNegativeInterval
-> Parser
     (UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser NonNegativeInterval
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"a0"
        Parser
  (UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams era)
-> Parser UnitInterval
-> Parser
     (UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser UnitInterval
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"rho"
        Parser
  (UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams era)
-> Parser UnitInterval
-> Parser
     (UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser UnitInterval
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tau"
        Parser
  (UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams era)
-> Parser UnitInterval
-> Parser
     (Nonce
      -> ProtVer
      -> Coin
      -> Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser UnitInterval
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"decentralisationParam"
        Parser
  (Nonce
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams era)
-> Parser Nonce
-> Parser
     (ProtVer
      -> Coin
      -> Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser Nonce
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"extraEntropy"
        Parser
  (ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams era)
-> Parser ProtVer
-> Parser
     (Coin
      -> Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser ProtVer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"protocolVersion"
        Parser
  (Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams era)
-> Parser Coin
-> Parser
     (Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (Maybe Coin)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"minPoolCost" Parser (Maybe Coin) -> Coin -> Parser Coin
forall a. Parser (Maybe a) -> a -> Parser a
.!= Coin
forall a. Monoid a => a
mempty
        Parser
  (Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams era)
-> Parser Coin
-> Parser
     (CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser Coin
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"lovelacePerUTxOWord"
        Parser
  (CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams era)
-> Parser CostModels
-> Parser
     (Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser CostModels
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"costmdls"
        Parser
  (Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams era)
-> Parser Prices
-> Parser
     (ExUnits
      -> ExUnits -> Natural -> Natural -> Natural -> PParams era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser Prices
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"prices"
        Parser
  (ExUnits
   -> ExUnits -> Natural -> Natural -> Natural -> PParams era)
-> Parser ExUnits
-> Parser (ExUnits -> Natural -> Natural -> Natural -> PParams era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser ExUnits
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"maxTxExUnits"
        Parser (ExUnits -> Natural -> Natural -> Natural -> PParams era)
-> Parser ExUnits
-> Parser (Natural -> Natural -> Natural -> PParams era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser ExUnits
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"maxBlockExUnits"
        Parser (Natural -> Natural -> Natural -> PParams era)
-> Parser Natural -> Parser (Natural -> Natural -> PParams era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser Natural
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"maxValSize"
        Parser (Natural -> Natural -> PParams era)
-> Parser Natural -> Parser (Natural -> PParams era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser Natural
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"collateralPercentage"
        Parser (Natural -> PParams era)
-> Parser Natural -> Parser (PParams era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser Natural
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"maxCollateralInputs"

deriving instance ToJSON (PParamsUpdate era)

instance
  (Era era, Show (Core.Value era), ToJSON (Core.Value era)) =>
  ToJSON (TxOut era)
  where
  toJSON :: TxOut era -> Value
toJSON (TxOut Addr (Crypto era)
addr Value era
v StrictMaybe (DataHash (Crypto era))
dataHash) =
    [Pair] -> Value
object
      [ Key
"address" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Addr (Crypto era) -> Value
forall a. ToJSON a => a -> Value
toJSON Addr (Crypto era)
addr,
        Key
"value" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value era -> Value
forall a. ToJSON a => a -> Value
toJSON Value era
v,
        Key
"datahash" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= case StrictMaybe (DataHash (Crypto era))
-> Maybe (DataHash (Crypto era))
forall a. StrictMaybe a -> Maybe a
BT.strictMaybeToMaybe StrictMaybe (DataHash (Crypto era))
dataHash of
          Maybe (DataHash (Crypto era))
Nothing -> Value
Aeson.Null
          Just DataHash (Crypto era)
dHash ->
            Text -> Value
Aeson.String (Text -> Value)
-> (Hash (HASH (Crypto era)) EraIndependentData -> Text)
-> Hash (HASH (Crypto era)) EraIndependentData
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash (HASH (Crypto era)) EraIndependentData -> Text
forall h a. Hash h a -> Text
hashToTextAsHex (Hash (HASH (Crypto era)) EraIndependentData -> Value)
-> Hash (HASH (Crypto era)) EraIndependentData -> Value
forall a b. (a -> b) -> a -> b
$
              DataHash (Crypto era)
-> Hash (HASH (Crypto era)) EraIndependentData
forall crypto i. SafeHash crypto i -> Hash (HASH crypto) i
extractHash DataHash (Crypto era)
dHash
      ]

deriving instance Show AlonzoGenesis