{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Cardano.Ledger.Plutus.ExUnits (
txscriptfee,
pointWiseExUnits,
zipSemiExUnits,
ExUnits (ExUnits, exUnitsMem, exUnitsSteps, ..),
ExUnits' (..),
Prices (..),
) where
import Cardano.Ledger.BaseTypes (
BoundedRational (unboundRational),
NonNegativeInterval,
)
import Cardano.Ledger.Binary (
DecCBOR (decCBOR),
Decoder,
DecoderError (..),
EncCBOR (encCBOR),
cborError,
)
import Cardano.Ledger.Binary.Coders (
Decode (D, From, RecD),
Encode (Rec, To),
decode,
encode,
(!>),
(<!),
)
import Cardano.Ledger.Coin (Coin (..))
import Control.Applicative ((<|>))
import Control.DeepSeq (NFData (..))
import Control.Monad (when)
import Data.Aeson (
FromJSON (..),
ToJSON (..),
object,
withObject,
(.:),
(.=),
)
import Data.DerivingVia (InstantiatedAt (..))
import Data.Int (Int64)
import Data.Measure (BoundedMeasure, Measure)
import Data.Semigroup (All (..))
import Data.Word (Word64)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks (..))
import Numeric.Natural (Natural)
data ExUnits' a = ExUnits'
{ forall a. ExUnits' a -> a
exUnitsMem' :: !a
, forall a. ExUnits' a -> a
exUnitsSteps' :: !a
}
deriving (ExUnits' a -> ExUnits' a -> Bool
(ExUnits' a -> ExUnits' a -> Bool)
-> (ExUnits' a -> ExUnits' a -> Bool) -> Eq (ExUnits' a)
forall a. Eq a => ExUnits' a -> ExUnits' a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => ExUnits' a -> ExUnits' a -> Bool
== :: ExUnits' a -> ExUnits' a -> Bool
$c/= :: forall a. Eq a => ExUnits' a -> ExUnits' a -> Bool
/= :: ExUnits' a -> ExUnits' a -> Bool
Eq, (forall x. ExUnits' a -> Rep (ExUnits' a) x)
-> (forall x. Rep (ExUnits' a) x -> ExUnits' a)
-> Generic (ExUnits' a)
forall x. Rep (ExUnits' a) x -> ExUnits' a
forall x. ExUnits' a -> Rep (ExUnits' a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ExUnits' a) x -> ExUnits' a
forall a x. ExUnits' a -> Rep (ExUnits' a) x
$cfrom :: forall a x. ExUnits' a -> Rep (ExUnits' a) x
from :: forall x. ExUnits' a -> Rep (ExUnits' a) x
$cto :: forall a x. Rep (ExUnits' a) x -> ExUnits' a
to :: forall x. Rep (ExUnits' a) x -> ExUnits' a
Generic, Int -> ExUnits' a -> ShowS
[ExUnits' a] -> ShowS
ExUnits' a -> String
(Int -> ExUnits' a -> ShowS)
-> (ExUnits' a -> String)
-> ([ExUnits' a] -> ShowS)
-> Show (ExUnits' a)
forall a. Show a => Int -> ExUnits' a -> ShowS
forall a. Show a => [ExUnits' a] -> ShowS
forall a. Show a => ExUnits' a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> ExUnits' a -> ShowS
showsPrec :: Int -> ExUnits' a -> ShowS
$cshow :: forall a. Show a => ExUnits' a -> String
show :: ExUnits' a -> String
$cshowList :: forall a. Show a => [ExUnits' a] -> ShowS
showList :: [ExUnits' a] -> ShowS
Show, (forall a b. (a -> b) -> ExUnits' a -> ExUnits' b)
-> (forall a b. a -> ExUnits' b -> ExUnits' a) -> Functor ExUnits'
forall a b. a -> ExUnits' b -> ExUnits' a
forall a b. (a -> b) -> ExUnits' a -> ExUnits' b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ExUnits' a -> ExUnits' b
fmap :: forall a b. (a -> b) -> ExUnits' a -> ExUnits' b
$c<$ :: forall a b. a -> ExUnits' b -> ExUnits' a
<$ :: forall a b. a -> ExUnits' b -> ExUnits' a
Functor)
deriving
(Eq (ExUnits' a)
ExUnits' a
Eq (ExUnits' a) =>
ExUnits' a
-> (ExUnits' a -> ExUnits' a -> ExUnits' a)
-> (ExUnits' a -> ExUnits' a -> ExUnits' a)
-> (ExUnits' a -> ExUnits' a -> ExUnits' a)
-> Measure (ExUnits' a)
ExUnits' a -> ExUnits' a -> ExUnits' a
forall a.
Eq a =>
a -> (a -> a -> a) -> (a -> a -> a) -> (a -> a -> a) -> Measure a
forall a. Measure a => Eq (ExUnits' a)
forall a. Measure a => ExUnits' a
forall a. Measure a => ExUnits' a -> ExUnits' a -> ExUnits' a
$czero :: forall a. Measure a => ExUnits' a
zero :: ExUnits' a
$cplus :: forall a. Measure a => ExUnits' a -> ExUnits' a -> ExUnits' a
plus :: ExUnits' a -> ExUnits' a -> ExUnits' a
$cmin :: forall a. Measure a => ExUnits' a -> ExUnits' a -> ExUnits' a
min :: ExUnits' a -> ExUnits' a -> ExUnits' a
$cmax :: forall a. Measure a => ExUnits' a -> ExUnits' a -> ExUnits' a
max :: ExUnits' a -> ExUnits' a -> ExUnits' a
Measure, Measure (ExUnits' a)
ExUnits' a
Measure (ExUnits' a) => ExUnits' a -> BoundedMeasure (ExUnits' a)
forall a. BoundedMeasure a => Measure (ExUnits' a)
forall a. BoundedMeasure a => ExUnits' a
forall a. Measure a => a -> BoundedMeasure a
$cmaxBound :: forall a. BoundedMeasure a => ExUnits' a
maxBound :: ExUnits' a
BoundedMeasure)
via (InstantiatedAt Generic (ExUnits' a))
deriving
(Semigroup (ExUnits' a)
ExUnits' a
Semigroup (ExUnits' a) =>
ExUnits' a
-> (ExUnits' a -> ExUnits' a -> ExUnits' a)
-> ([ExUnits' a] -> ExUnits' a)
-> Monoid (ExUnits' a)
[ExUnits' a] -> ExUnits' a
ExUnits' a -> ExUnits' a -> ExUnits' a
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. Measure a => Semigroup (ExUnits' a)
forall a. Measure a => ExUnits' a
forall a. Measure a => [ExUnits' a] -> ExUnits' a
forall a. Measure a => ExUnits' a -> ExUnits' a -> ExUnits' a
$cmempty :: forall a. Measure a => ExUnits' a
mempty :: ExUnits' a
$cmappend :: forall a. Measure a => ExUnits' a -> ExUnits' a -> ExUnits' a
mappend :: ExUnits' a -> ExUnits' a -> ExUnits' a
$cmconcat :: forall a. Measure a => [ExUnits' a] -> ExUnits' a
mconcat :: [ExUnits' a] -> ExUnits' a
Monoid, NonEmpty (ExUnits' a) -> ExUnits' a
ExUnits' a -> ExUnits' a -> ExUnits' a
(ExUnits' a -> ExUnits' a -> ExUnits' a)
-> (NonEmpty (ExUnits' a) -> ExUnits' a)
-> (forall b. Integral b => b -> ExUnits' a -> ExUnits' a)
-> Semigroup (ExUnits' a)
forall b. Integral b => b -> ExUnits' a -> ExUnits' a
forall a. Measure a => NonEmpty (ExUnits' a) -> ExUnits' a
forall a. Measure a => ExUnits' a -> ExUnits' a -> ExUnits' a
forall a b.
(Measure a, Integral b) =>
b -> ExUnits' a -> ExUnits' a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: forall a. Measure a => ExUnits' a -> ExUnits' a -> ExUnits' a
<> :: ExUnits' a -> ExUnits' a -> ExUnits' a
$csconcat :: forall a. Measure a => NonEmpty (ExUnits' a) -> ExUnits' a
sconcat :: NonEmpty (ExUnits' a) -> ExUnits' a
$cstimes :: forall a b.
(Measure a, Integral b) =>
b -> ExUnits' a -> ExUnits' a
stimes :: forall b. Integral b => b -> ExUnits' a -> ExUnits' a
Semigroup)
via (InstantiatedAt Measure (ExUnits' a))
instance NoThunks a => NoThunks (ExUnits' a)
instance NFData a => NFData (ExUnits' a)
deriving instance ToJSON a => ToJSON (ExUnits' a)
deriving instance FromJSON a => FromJSON (ExUnits' a)
newtype ExUnits = WrapExUnits {ExUnits -> ExUnits' Natural
unWrapExUnits :: ExUnits' Natural}
deriving (ExUnits -> ExUnits -> Bool
(ExUnits -> ExUnits -> Bool)
-> (ExUnits -> ExUnits -> Bool) -> Eq ExUnits
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExUnits -> ExUnits -> Bool
== :: ExUnits -> ExUnits -> Bool
$c/= :: ExUnits -> ExUnits -> Bool
/= :: ExUnits -> ExUnits -> Bool
Eq, (forall x. ExUnits -> Rep ExUnits x)
-> (forall x. Rep ExUnits x -> ExUnits) -> Generic ExUnits
forall x. Rep ExUnits x -> ExUnits
forall x. ExUnits -> Rep ExUnits x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ExUnits -> Rep ExUnits x
from :: forall x. ExUnits -> Rep ExUnits x
$cto :: forall x. Rep ExUnits x -> ExUnits
to :: forall x. Rep ExUnits x -> ExUnits
Generic, Int -> ExUnits -> ShowS
[ExUnits] -> ShowS
ExUnits -> String
(Int -> ExUnits -> ShowS)
-> (ExUnits -> String) -> ([ExUnits] -> ShowS) -> Show ExUnits
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExUnits -> ShowS
showsPrec :: Int -> ExUnits -> ShowS
$cshow :: ExUnits -> String
show :: ExUnits -> String
$cshowList :: [ExUnits] -> ShowS
showList :: [ExUnits] -> ShowS
Show)
deriving newtype (Semigroup ExUnits
ExUnits
Semigroup ExUnits =>
ExUnits
-> (ExUnits -> ExUnits -> ExUnits)
-> ([ExUnits] -> ExUnits)
-> Monoid ExUnits
[ExUnits] -> ExUnits
ExUnits -> ExUnits -> ExUnits
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: ExUnits
mempty :: ExUnits
$cmappend :: ExUnits -> ExUnits -> ExUnits
mappend :: ExUnits -> ExUnits -> ExUnits
$cmconcat :: [ExUnits] -> ExUnits
mconcat :: [ExUnits] -> ExUnits
Monoid, NonEmpty ExUnits -> ExUnits
ExUnits -> ExUnits -> ExUnits
(ExUnits -> ExUnits -> ExUnits)
-> (NonEmpty ExUnits -> ExUnits)
-> (forall b. Integral b => b -> ExUnits -> ExUnits)
-> Semigroup ExUnits
forall b. Integral b => b -> ExUnits -> ExUnits
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: ExUnits -> ExUnits -> ExUnits
<> :: ExUnits -> ExUnits -> ExUnits
$csconcat :: NonEmpty ExUnits -> ExUnits
sconcat :: NonEmpty ExUnits -> ExUnits
$cstimes :: forall b. Integral b => b -> ExUnits -> ExUnits
stimes :: forall b. Integral b => b -> ExUnits -> ExUnits
Semigroup)
instance NoThunks ExUnits
instance NFData ExUnits
instance ToJSON ExUnits where
toJSON :: ExUnits -> Value
toJSON exUnits :: ExUnits
exUnits@(ExUnits Natural
_ Natural
_) =
let ExUnits {Natural
exUnitsMem :: ExUnits -> Natural
exUnitsMem :: Natural
exUnitsMem, Natural
exUnitsSteps :: ExUnits -> Natural
exUnitsSteps :: Natural
exUnitsSteps} = ExUnits
exUnits
in [Pair] -> Value
object
[ Key
"memory" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Natural -> Value
forall a. ToJSON a => a -> Value
toJSON Natural
exUnitsMem
, Key
"steps" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Natural -> Value
forall a. ToJSON a => a -> Value
toJSON Natural
exUnitsSteps
]
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
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
exUnitsMem <- Natural -> Parser Natural
forall {a} {f :: * -> *}.
(Ord a, Num a, MonadFail f, Show a) =>
a -> f a
checkWord64Bounds (Natural -> Parser Natural) -> Parser Natural -> Parser Natural
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Object
o Object -> Key -> Parser Natural
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"memory" Parser Natural -> Parser Natural -> Parser Natural
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object
o Object -> Key -> Parser Natural
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"exUnitsMem")
Natural
exUnitsSteps <- Natural -> Parser Natural
forall {a} {f :: * -> *}.
(Ord a, Num a, MonadFail f, Show a) =>
a -> f a
checkWord64Bounds (Natural -> Parser Natural) -> Parser Natural -> Parser Natural
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Object
o Object -> Key -> Parser Natural
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"steps" Parser Natural -> Parser Natural -> Parser Natural
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object
o Object -> Key -> Parser Natural
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"exUnitsSteps")
ExUnits -> Parser ExUnits
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExUnits -> Parser ExUnits) -> ExUnits -> Parser ExUnits
forall a b. (a -> b) -> a -> b
$ ExUnits {Natural
exUnitsMem :: Natural
exUnitsMem :: Natural
exUnitsMem, Natural
exUnitsSteps :: Natural
exUnitsSteps :: Natural
exUnitsSteps}
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 (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 (forall a. Bounded a => a
maxBound @Word64)
then a -> f a
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
n
else String -> f a
forall a. String -> f a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unit out of bounds for Word64: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
n)
pattern ExUnits :: Natural -> Natural -> ExUnits
pattern $mExUnits :: forall {r}.
ExUnits -> (Natural -> Natural -> r) -> ((# #) -> r) -> r
$bExUnits :: Natural -> Natural -> ExUnits
ExUnits {ExUnits -> Natural
exUnitsMem, ExUnits -> Natural
exUnitsSteps} <-
WrapExUnits (ExUnits' exUnitsMem exUnitsSteps)
where
ExUnits Natural
m Natural
s = ExUnits' Natural -> ExUnits
WrapExUnits (Natural -> Natural -> ExUnits' Natural
forall a. a -> a -> ExUnits' a
ExUnits' Natural
m Natural
s)
{-# COMPLETE ExUnits #-}
pointWiseExUnits :: (Natural -> Natural -> Bool) -> ExUnits -> ExUnits -> Bool
pointWiseExUnits :: (Natural -> Natural -> Bool) -> ExUnits -> ExUnits -> Bool
pointWiseExUnits Natural -> Natural -> Bool
f ExUnits
ex1 ExUnits
ex2 = All -> Bool
getAll ((Natural -> Natural -> All) -> ExUnits -> ExUnits -> All
forall a.
Semigroup a =>
(Natural -> Natural -> a) -> ExUnits -> ExUnits -> a
zipSemiExUnits (\Natural
x Natural
y -> Bool -> All
All (Natural -> Natural -> Bool
f Natural
x Natural
y)) ExUnits
ex1 ExUnits
ex2)
zipSemiExUnits :: Semigroup a => (Natural -> Natural -> a) -> ExUnits -> ExUnits -> a
zipSemiExUnits :: forall a.
Semigroup a =>
(Natural -> Natural -> a) -> ExUnits -> ExUnits -> a
zipSemiExUnits Natural -> Natural -> a
f (ExUnits Natural
m1 Natural
s1) (ExUnits Natural
m2 Natural
s2) = (Natural
m1 Natural -> Natural -> a
`f` Natural
m2) a -> a -> a
forall a. Semigroup a => a -> a -> a
<> (Natural
s1 Natural -> Natural -> a
`f` Natural
s2)
data Prices = Prices
{ Prices -> NonNegativeInterval
prMem :: !NonNegativeInterval
, Prices -> NonNegativeInterval
prSteps :: !NonNegativeInterval
}
deriving (Prices -> Prices -> Bool
(Prices -> Prices -> Bool)
-> (Prices -> Prices -> Bool) -> Eq Prices
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Prices -> Prices -> Bool
== :: Prices -> Prices -> Bool
$c/= :: Prices -> Prices -> Bool
/= :: Prices -> Prices -> Bool
Eq, (forall x. Prices -> Rep Prices x)
-> (forall x. Rep Prices x -> Prices) -> Generic Prices
forall x. Rep Prices x -> Prices
forall x. Prices -> Rep Prices x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Prices -> Rep Prices x
from :: forall x. Prices -> Rep Prices x
$cto :: forall x. Rep Prices x -> Prices
to :: forall x. Rep Prices x -> Prices
Generic, Int -> Prices -> ShowS
[Prices] -> ShowS
Prices -> String
(Int -> Prices -> ShowS)
-> (Prices -> String) -> ([Prices] -> ShowS) -> Show Prices
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Prices -> ShowS
showsPrec :: Int -> Prices -> ShowS
$cshow :: Prices -> String
show :: Prices -> String
$cshowList :: [Prices] -> ShowS
showList :: [Prices] -> ShowS
Show, Eq Prices
Eq Prices =>
(Prices -> Prices -> Ordering)
-> (Prices -> Prices -> Bool)
-> (Prices -> Prices -> Bool)
-> (Prices -> Prices -> Bool)
-> (Prices -> Prices -> Bool)
-> (Prices -> Prices -> Prices)
-> (Prices -> Prices -> Prices)
-> Ord Prices
Prices -> Prices -> Bool
Prices -> Prices -> Ordering
Prices -> Prices -> Prices
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 :: Prices -> Prices -> Ordering
compare :: Prices -> Prices -> Ordering
$c< :: Prices -> Prices -> Bool
< :: Prices -> Prices -> Bool
$c<= :: Prices -> Prices -> Bool
<= :: Prices -> Prices -> Bool
$c> :: Prices -> Prices -> Bool
> :: Prices -> Prices -> Bool
$c>= :: Prices -> Prices -> Bool
>= :: Prices -> Prices -> Bool
$cmax :: Prices -> Prices -> Prices
max :: Prices -> Prices -> Prices
$cmin :: Prices -> Prices -> Prices
min :: Prices -> Prices -> Prices
Ord)
instance NoThunks Prices
instance NFData Prices
instance ToJSON Prices where
toJSON :: Prices -> Value
toJSON Prices {NonNegativeInterval
prSteps :: Prices -> NonNegativeInterval
prSteps :: NonNegativeInterval
prSteps, NonNegativeInterval
prMem :: Prices -> NonNegativeInterval
prMem :: NonNegativeInterval
prMem} =
[Pair] -> Value
object
[ Key
"priceSteps" Key -> NonNegativeInterval -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NonNegativeInterval
prSteps
, Key
"priceMemory" Key -> NonNegativeInterval -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= 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
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
NonNegativeInterval
prSteps <- Object
o Object -> Key -> Parser NonNegativeInterval
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"priceSteps" Parser NonNegativeInterval
-> Parser NonNegativeInterval -> Parser NonNegativeInterval
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object
o Object -> Key -> Parser NonNegativeInterval
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"prSteps"
NonNegativeInterval
prMem <- Object
o Object -> Key -> Parser NonNegativeInterval
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"priceMemory" Parser NonNegativeInterval
-> Parser NonNegativeInterval -> Parser NonNegativeInterval
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object
o Object -> Key -> Parser NonNegativeInterval
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"prMem"
Prices -> Parser Prices
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Prices {NonNegativeInterval
prSteps :: NonNegativeInterval
prSteps :: NonNegativeInterval
prSteps, NonNegativeInterval
prMem :: NonNegativeInterval
prMem :: NonNegativeInterval
prMem}
txscriptfee :: Prices -> ExUnits -> Coin
txscriptfee :: Prices -> ExUnits -> Coin
txscriptfee Prices {NonNegativeInterval
prMem :: Prices -> NonNegativeInterval
prMem :: NonNegativeInterval
prMem, NonNegativeInterval
prSteps :: Prices -> NonNegativeInterval
prSteps :: NonNegativeInterval
prSteps} ExUnits {exUnitsMem :: ExUnits -> Natural
exUnitsMem = Natural
m, exUnitsSteps :: ExUnits -> Natural
exUnitsSteps = Natural
s} =
Integer -> Coin
Coin (Integer -> Coin) -> Integer -> Coin
forall a b. (a -> b) -> a -> b
$
Rational -> Integer
forall b. Integral b => Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Rational -> Integer) -> Rational -> Integer
forall a b. (a -> b) -> a -> b
$
(Natural -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
m Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* NonNegativeInterval -> Rational
forall r. BoundedRational r => r -> Rational
unboundRational NonNegativeInterval
prMem)
Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ (Natural -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
s Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* NonNegativeInterval -> Rational
forall r. BoundedRational r => r -> Rational
unboundRational NonNegativeInterval
prSteps)
instance EncCBOR ExUnits where
encCBOR :: ExUnits -> Encoding
encCBOR (ExUnits Natural
m Natural
s) = Encode ('Closed 'Dense) ExUnits -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode ('Closed 'Dense) ExUnits -> Encoding)
-> Encode ('Closed 'Dense) ExUnits -> Encoding
forall a b. (a -> b) -> a -> b
$ (Natural -> Natural -> ExUnits)
-> Encode ('Closed 'Dense) (Natural -> Natural -> ExUnits)
forall t. t -> Encode ('Closed 'Dense) t
Rec Natural -> Natural -> ExUnits
ExUnits Encode ('Closed 'Dense) (Natural -> Natural -> ExUnits)
-> Encode ('Closed 'Dense) Natural
-> Encode ('Closed 'Dense) (Natural -> ExUnits)
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. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Natural
m Encode ('Closed 'Dense) (Natural -> ExUnits)
-> Encode ('Closed 'Dense) Natural
-> Encode ('Closed 'Dense) ExUnits
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. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Natural
s
instance DecCBOR ExUnits where
decCBOR :: forall s. Decoder s ExUnits
decCBOR = Decode ('Closed 'Dense) ExUnits -> Decoder s ExUnits
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) ExUnits -> Decoder s ExUnits)
-> Decode ('Closed 'Dense) ExUnits -> Decoder s ExUnits
forall a b. (a -> b) -> a -> b
$ (Natural -> Natural -> ExUnits)
-> Decode ('Closed 'Dense) (Natural -> Natural -> ExUnits)
forall t. t -> Decode ('Closed 'Dense) t
RecD Natural -> Natural -> ExUnits
ExUnits Decode ('Closed 'Dense) (Natural -> Natural -> ExUnits)
-> Decode ('Closed 'Dense) Natural
-> Decode ('Closed 'Dense) (Natural -> ExUnits)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! (forall s. Decoder s Natural) -> Decode ('Closed 'Dense) Natural
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D Decoder s Natural
forall s. Decoder s Natural
decNat Decode ('Closed 'Dense) (Natural -> ExUnits)
-> Decode ('Closed 'Dense) Natural
-> Decode ('Closed 'Dense) ExUnits
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! (forall s. Decoder s Natural) -> Decode ('Closed 'Dense) Natural
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D Decoder s Natural
forall s. Decoder s Natural
decNat
where
decNat :: Decoder s Natural
decNat :: forall s. Decoder s Natural
decNat = do
Word64
x <- Decoder s Word64
forall s. Decoder s Word64
forall a s. DecCBOR a => Decoder s a
decCBOR
Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
(Word64
x Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64
forall a. Bounded a => a
Prelude.maxBound :: Int64))
( DecoderError -> Decoder s ()
forall (m :: * -> *) e a. (MonadFail m, Buildable e) => e -> m a
cborError (DecoderError -> Decoder s ()) -> DecoderError -> Decoder s ()
forall a b. (a -> b) -> a -> b
$
Text -> Text -> DecoderError
DecoderErrorCustom Text
"ExUnits field" Text
"values must not exceed maxBound :: Int64"
)
Natural -> Decoder s Natural
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Natural -> Decoder s Natural) -> Natural -> Decoder s Natural
forall a b. (a -> b) -> a -> b
$ Word64 -> Natural
wordToNatural Word64
x
{-# INLINE decNat #-}
wordToNatural :: Word64 -> Natural
wordToNatural :: Word64 -> Natural
wordToNatural = Word64 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE wordToNatural #-}
{-# INLINE decCBOR #-}
instance EncCBOR Prices where
encCBOR :: Prices -> Encoding
encCBOR (Prices NonNegativeInterval
m NonNegativeInterval
s) = Encode ('Closed 'Dense) Prices -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode ('Closed 'Dense) Prices -> Encoding)
-> Encode ('Closed 'Dense) Prices -> Encoding
forall a b. (a -> b) -> a -> b
$ (NonNegativeInterval -> NonNegativeInterval -> Prices)
-> Encode
('Closed 'Dense)
(NonNegativeInterval -> NonNegativeInterval -> Prices)
forall t. t -> Encode ('Closed 'Dense) t
Rec NonNegativeInterval -> NonNegativeInterval -> Prices
Prices Encode
('Closed 'Dense)
(NonNegativeInterval -> NonNegativeInterval -> Prices)
-> Encode ('Closed 'Dense) NonNegativeInterval
-> Encode ('Closed 'Dense) (NonNegativeInterval -> Prices)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> NonNegativeInterval -> Encode ('Closed 'Dense) NonNegativeInterval
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To NonNegativeInterval
m Encode ('Closed 'Dense) (NonNegativeInterval -> Prices)
-> Encode ('Closed 'Dense) NonNegativeInterval
-> Encode ('Closed 'Dense) Prices
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> NonNegativeInterval -> Encode ('Closed 'Dense) NonNegativeInterval
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To NonNegativeInterval
s
instance DecCBOR Prices where
decCBOR :: forall s. Decoder s Prices
decCBOR = Decode ('Closed 'Dense) Prices -> Decoder s Prices
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) Prices -> Decoder s Prices)
-> Decode ('Closed 'Dense) Prices -> Decoder s Prices
forall a b. (a -> b) -> a -> b
$ (NonNegativeInterval -> NonNegativeInterval -> Prices)
-> Decode
('Closed 'Dense)
(NonNegativeInterval -> NonNegativeInterval -> Prices)
forall t. t -> Decode ('Closed 'Dense) t
RecD NonNegativeInterval -> NonNegativeInterval -> Prices
Prices Decode
('Closed 'Dense)
(NonNegativeInterval -> NonNegativeInterval -> Prices)
-> Decode ('Closed Any) NonNegativeInterval
-> Decode ('Closed 'Dense) (NonNegativeInterval -> Prices)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) NonNegativeInterval
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode ('Closed 'Dense) (NonNegativeInterval -> Prices)
-> Decode ('Closed Any) NonNegativeInterval
-> Decode ('Closed 'Dense) Prices
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) NonNegativeInterval
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
{-# INLINE decCBOR #-}