{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# HLINT ignore "Use <$>" #-}
module Hydra.Ledger.Cardano.Evaluate where
import Hydra.Prelude hiding (label)
import Cardano.Api.UTxO qualified as UTxO
import Cardano.Ledger.Alonzo.Plutus.Evaluate (collectPlutusScriptsWithContext)
import Cardano.Ledger.Alonzo.Scripts (CostModel, Prices (..), mkCostModel, mkCostModels, txscriptfee)
import Cardano.Ledger.Api (CoinPerByte (..), ppCoinsPerUTxOByteL, ppCostModelsL, ppMaxBlockExUnitsL, ppMaxTxExUnitsL, ppMaxValSizeL, ppMinFeeAL, ppMinFeeBL, ppPricesL, ppProtocolVersionL)
import Cardano.Ledger.BaseTypes (BoundedRational (boundRational), ProtVer (..), getVersion, natVersion)
import Cardano.Ledger.Coin (Coin (Coin))
import Cardano.Ledger.Core (PParams, ppMaxTxSizeL)
import Cardano.Ledger.Plutus (
Language (..),
LegacyPlutusArgs (..),
PlutusArgs (..),
PlutusLanguage (decodePlutusRunnable),
PlutusRunnable (..),
PlutusWithContext (..),
SLanguage (..),
isLanguage,
unPlutusV2Args,
)
import Cardano.Ledger.Val (Val ((<+>)), (<×>))
import Cardano.Slotting.EpochInfo (EpochInfo, fixedEpochInfo)
import Cardano.Slotting.Slot (EpochNo (EpochNo), EpochSize (EpochSize), SlotNo (SlotNo))
import Cardano.Slotting.Time (RelativeTime (RelativeTime), SlotLength, SystemStart (SystemStart), mkSlotLength)
import Control.Arrow (left)
import Control.Lens ((.~))
import Control.Lens.Getter
import Data.ByteString qualified as BS
import Data.Default (def)
import Data.Map qualified as Map
import Data.Maybe (fromJust)
import Data.Ratio ((%))
import Data.SOP.NonEmpty (NonEmpty (NonEmptyOne))
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Flat (flat)
import Hydra.Cardano.Api (
Era,
EraHistory (EraHistory),
ExecutionUnits (..),
IsCardanoEra (cardanoEra),
LedgerEpochInfo (..),
LedgerEra,
LedgerProtocolParameters (..),
ProtocolParametersConversionError,
ScriptExecutionError (ScriptErrorMissingScript),
ScriptWitnessIndex,
SerialiseAsCBOR (serialiseToCBOR),
StandardCrypto,
TransactionValidityError,
Tx,
UTxO,
evaluateTransactionExecutionUnits,
getTxBody,
toLedgerExUnits,
toLedgerTx,
toLedgerUTxO,
)
import Hydra.Cardano.Api.Pretty (renderTxWithUTxO)
import Hydra.Ledger.Cardano.Time (slotNoFromUTCTime, slotNoToUTCTime)
import Hydra.Tx.ContestationPeriod (ContestationPeriod (UnsafeContestationPeriod))
import Ouroboros.Consensus.Block (GenesisWindow (..))
import Ouroboros.Consensus.Cardano.Block (CardanoEras)
import Ouroboros.Consensus.HardFork.History (
Bound (Bound, boundEpoch, boundSlot, boundTime),
EraEnd (..),
EraParams (..),
EraSummary (..),
SafeZone (..),
Summary (Summary),
initBound,
mkInterpreter,
)
import PlutusCore qualified as PLC
import PlutusLedgerApi.Common (mkTermToEvaluate, toData)
import PlutusLedgerApi.Common qualified as Plutus
import Test.QuickCheck (Property, choose, counterexample, property)
import Test.QuickCheck.Gen (chooseWord64)
import UntypedPlutusCore (UnrestrictedProgram (..))
import UntypedPlutusCore qualified as UPLC
evaluateTx ::
Tx ->
UTxO ->
Either EvaluationError EvaluationReport
evaluateTx :: Tx -> UTxO -> Either EvaluationError EvaluationReport
evaluateTx = ExecutionUnits
-> Tx -> UTxO -> Either EvaluationError EvaluationReport
evaluateTx' ExecutionUnits
maxTxExecutionUnits
evaluateTx' ::
ExecutionUnits ->
Tx ->
UTxO ->
Either EvaluationError EvaluationReport
evaluateTx' :: ExecutionUnits
-> Tx -> UTxO -> Either EvaluationError EvaluationReport
evaluateTx' ExecutionUnits
maxUnits Tx
tx UTxO
utxo = do
let pparams' :: PParams StandardConway
pparams' = PParams LedgerEra
PParams StandardConway
pparams PParams StandardConway
-> (PParams StandardConway -> PParams StandardConway)
-> PParams StandardConway
forall a b. a -> (a -> b) -> b
& (ExUnits -> Identity ExUnits)
-> PParams StandardConway -> Identity (PParams StandardConway)
forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
Lens' (PParams StandardConway) ExUnits
ppMaxTxExUnitsL ((ExUnits -> Identity ExUnits)
-> PParams StandardConway -> Identity (PParams StandardConway))
-> ExUnits -> PParams StandardConway -> PParams StandardConway
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ExecutionUnits -> ExUnits
toLedgerExUnits ExecutionUnits
maxUnits
case LedgerProtocolParameters Era
-> Either (TransactionValidityError Era) EvaluationReport
result (PParams LedgerEra -> LedgerProtocolParameters Era
forall era.
PParams (ShelleyLedgerEra era) -> LedgerProtocolParameters era
LedgerProtocolParameters PParams LedgerEra
PParams StandardConway
pparams') of
Left TransactionValidityError Era
txValidityError -> EvaluationError -> Either EvaluationError EvaluationReport
forall a b. a -> Either a b
Left (EvaluationError -> Either EvaluationError EvaluationReport)
-> EvaluationError -> Either EvaluationError EvaluationReport
forall a b. (a -> b) -> a -> b
$ TransactionValidityError Era -> EvaluationError
TransactionInvalid TransactionValidityError Era
txValidityError
Right EvaluationReport
report
| (Either ScriptExecutionError ExecutionUnits -> Bool)
-> EvaluationReport -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Either ScriptExecutionError ExecutionUnits -> Bool
forall a b. Either a b -> Bool
isRight EvaluationReport
report -> ExecutionUnits
-> EvaluationReport -> Either EvaluationError EvaluationReport
checkBudget ExecutionUnits
maxUnits EvaluationReport
report
| Bool
otherwise -> EvaluationReport -> Either EvaluationError EvaluationReport
forall a b. b -> Either a b
Right EvaluationReport
report
where
result ::
LedgerProtocolParameters UTxO.Era ->
Either
(TransactionValidityError UTxO.Era)
( Map
ScriptWitnessIndex
( Either
ScriptExecutionError
ExecutionUnits
)
)
result :: LedgerProtocolParameters Era
-> Either (TransactionValidityError Era) EvaluationReport
result LedgerProtocolParameters Era
pparams' =
((Map
ScriptWitnessIndex
(Either
ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits))
-> EvaluationReport)
-> Either
(TransactionValidityError Era)
(Map
ScriptWitnessIndex
(Either
ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits)))
-> Either (TransactionValidityError Era) EvaluationReport
forall a b.
(a -> b)
-> Either (TransactionValidityError Era) a
-> Either (TransactionValidityError Era) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Map
ScriptWitnessIndex
(Either
ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits))
-> EvaluationReport)
-> Either
(TransactionValidityError Era)
(Map
ScriptWitnessIndex
(Either
ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits)))
-> Either (TransactionValidityError Era) EvaluationReport)
-> (((EvalTxExecutionUnitsLog, ExecutionUnits) -> ExecutionUnits)
-> Map
ScriptWitnessIndex
(Either
ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits))
-> EvaluationReport)
-> ((EvalTxExecutionUnitsLog, ExecutionUnits) -> ExecutionUnits)
-> Either
(TransactionValidityError Era)
(Map
ScriptWitnessIndex
(Either
ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits)))
-> Either (TransactionValidityError Era) EvaluationReport
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either
ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits)
-> Either ScriptExecutionError ExecutionUnits)
-> Map
ScriptWitnessIndex
(Either
ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits))
-> EvaluationReport
forall a b.
(a -> b) -> Map ScriptWitnessIndex a -> Map ScriptWitnessIndex b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Either
ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits)
-> Either ScriptExecutionError ExecutionUnits)
-> Map
ScriptWitnessIndex
(Either
ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits))
-> EvaluationReport)
-> (((EvalTxExecutionUnitsLog, ExecutionUnits) -> ExecutionUnits)
-> Either
ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits)
-> Either ScriptExecutionError ExecutionUnits)
-> ((EvalTxExecutionUnitsLog, ExecutionUnits) -> ExecutionUnits)
-> Map
ScriptWitnessIndex
(Either
ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits))
-> EvaluationReport
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((EvalTxExecutionUnitsLog, ExecutionUnits) -> ExecutionUnits)
-> Either
ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits)
-> Either ScriptExecutionError ExecutionUnits
forall a b.
(a -> b)
-> Either ScriptExecutionError a -> Either ScriptExecutionError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (EvalTxExecutionUnitsLog, ExecutionUnits) -> ExecutionUnits
forall a b. (a, b) -> b
snd (Either
(TransactionValidityError Era)
(Map
ScriptWitnessIndex
(Either
ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits)))
-> Either (TransactionValidityError Era) EvaluationReport)
-> Either
(TransactionValidityError Era)
(Map
ScriptWitnessIndex
(Either
ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits)))
-> Either (TransactionValidityError Era) EvaluationReport
forall a b. (a -> b) -> a -> b
$
CardanoEra Era
-> SystemStart
-> LedgerEpochInfo
-> LedgerProtocolParameters Era
-> UTxO Era
-> TxBody Era
-> Either
(TransactionValidityError Era)
(Map
ScriptWitnessIndex
(Either
ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits)))
forall era.
CardanoEra era
-> SystemStart
-> LedgerEpochInfo
-> LedgerProtocolParameters era
-> UTxO era
-> TxBody era
-> Either
(TransactionValidityError era)
(Map
ScriptWitnessIndex
(Either
ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits)))
evaluateTransactionExecutionUnits
CardanoEra Era
forall era. IsCardanoEra era => CardanoEra era
cardanoEra
SystemStart
systemStart
(EpochInfo (Either Text) -> LedgerEpochInfo
LedgerEpochInfo EpochInfo (Either Text)
forall (m :: * -> *). Monad m => EpochInfo m
epochInfo)
LedgerProtocolParameters Era
pparams'
(UTxO -> UTxO Era
UTxO.toApi UTxO
utxo)
(Tx -> TxBody Era
forall era. Tx era -> TxBody era
getTxBody Tx
tx)
checkBudget :: ExecutionUnits -> EvaluationReport -> Either EvaluationError EvaluationReport
checkBudget :: ExecutionUnits
-> EvaluationReport -> Either EvaluationError EvaluationReport
checkBudget ExecutionUnits
maxUnits EvaluationReport
report
| Natural
usedMemory Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
<= ExecutionUnits -> Natural
executionMemory ExecutionUnits
maxUnits Bool -> Bool -> Bool
&& Natural
usedCpu Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
<= ExecutionUnits -> Natural
executionSteps ExecutionUnits
maxUnits =
EvaluationReport -> Either EvaluationError EvaluationReport
forall a b. b -> Either a b
Right EvaluationReport
report
| Bool
otherwise =
EvaluationError -> Either EvaluationError EvaluationReport
forall a b. a -> Either a b
Left
TransactionBudgetOverspent
{ ExecutionUnits
used :: ExecutionUnits
$sel:used:TransactionBudgetOverspent :: ExecutionUnits
used
, $sel:available:TransactionBudgetOverspent :: ExecutionUnits
available = ExecutionUnits
maxUnits
}
where
used :: ExecutionUnits
used@ExecutionUnits
{ executionMemory :: ExecutionUnits -> Natural
executionMemory = Natural
usedMemory
, executionSteps :: ExecutionUnits -> Natural
executionSteps = Natural
usedCpu
} = EvaluationReport -> ExecutionUnits
usedExecutionUnits EvaluationReport
report
data EvaluationError
= TransactionBudgetOverspent {EvaluationError -> ExecutionUnits
used :: ExecutionUnits, EvaluationError -> ExecutionUnits
available :: ExecutionUnits}
| TransactionInvalid (TransactionValidityError Era)
| PParamsConversion ProtocolParametersConversionError
deriving stock (Int -> EvaluationError -> ShowS
[EvaluationError] -> ShowS
EvaluationError -> String
(Int -> EvaluationError -> ShowS)
-> (EvaluationError -> String)
-> ([EvaluationError] -> ShowS)
-> Show EvaluationError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EvaluationError -> ShowS
showsPrec :: Int -> EvaluationError -> ShowS
$cshow :: EvaluationError -> String
show :: EvaluationError -> String
$cshowList :: [EvaluationError] -> ShowS
showList :: [EvaluationError] -> ShowS
Show)
type EvaluationReport =
(Map ScriptWitnessIndex (Either ScriptExecutionError ExecutionUnits))
renderEvaluationReportFailures :: EvaluationReport -> Text
renderEvaluationReportFailures :: EvaluationReport -> Text
renderEvaluationReportFailures EvaluationReport
reportMap =
EvalTxExecutionUnitsLog -> Text
forall t. IsText t "unlines" => [t] -> t
unlines (EvalTxExecutionUnitsLog -> Text)
-> EvalTxExecutionUnitsLog -> Text
forall a b. (a -> b) -> a -> b
$ ScriptExecutionError -> Text
renderScriptExecutionError (ScriptExecutionError -> Text)
-> [ScriptExecutionError] -> EvalTxExecutionUnitsLog
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ScriptExecutionError]
failures
where
failures :: [ScriptExecutionError]
failures = [Either ScriptExecutionError ExecutionUnits]
-> [ScriptExecutionError]
forall a b. [Either a b] -> [a]
lefts ([Either ScriptExecutionError ExecutionUnits]
-> [ScriptExecutionError])
-> [Either ScriptExecutionError ExecutionUnits]
-> [ScriptExecutionError]
forall a b. (a -> b) -> a -> b
$ (Either ScriptExecutionError ExecutionUnits
-> [Either ScriptExecutionError ExecutionUnits])
-> EvaluationReport -> [Either ScriptExecutionError ExecutionUnits]
forall m a. Monoid m => (a -> m) -> Map ScriptWitnessIndex a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Either ScriptExecutionError ExecutionUnits
-> [Either ScriptExecutionError ExecutionUnits]
-> [Either ScriptExecutionError ExecutionUnits]
forall a. a -> [a] -> [a]
: []) EvaluationReport
reportMap
renderScriptExecutionError :: ScriptExecutionError -> Text
renderScriptExecutionError = \case
ScriptErrorMissingScript ScriptWitnessIndex
missingRdmrPtr ResolvablePointers
_ ->
Text
"Missing script of redeemer pointer " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ScriptWitnessIndex -> Text
forall b a. (Show a, IsString b) => a -> b
show ScriptWitnessIndex
missingRdmrPtr
ScriptExecutionError
f ->
ScriptExecutionError -> Text
forall b a. (Show a, IsString b) => a -> b
show ScriptExecutionError
f
usedExecutionUnits :: EvaluationReport -> ExecutionUnits
usedExecutionUnits :: EvaluationReport -> ExecutionUnits
usedExecutionUnits EvaluationReport
report =
ExecutionUnits
{ executionMemory :: Natural
executionMemory = Natural
usedMemory
, executionSteps :: Natural
executionSteps = Natural
usedCpu
}
where
usedMemory :: Natural
usedMemory = [Natural] -> Natural
forall a (f :: * -> *). (Foldable f, Num a) => f a -> a
sum ([Natural] -> Natural) -> [Natural] -> Natural
forall a b. (a -> b) -> a -> b
$ ExecutionUnits -> Natural
executionMemory (ExecutionUnits -> Natural) -> [ExecutionUnits] -> [Natural]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ExecutionUnits]
budgets
usedCpu :: Natural
usedCpu = [Natural] -> Natural
forall a (f :: * -> *). (Foldable f, Num a) => f a -> a
sum ([Natural] -> Natural) -> [Natural] -> Natural
forall a b. (a -> b) -> a -> b
$ ExecutionUnits -> Natural
executionSteps (ExecutionUnits -> Natural) -> [ExecutionUnits] -> [Natural]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ExecutionUnits]
budgets
budgets :: [ExecutionUnits]
budgets = [Either ScriptExecutionError ExecutionUnits] -> [ExecutionUnits]
forall a b. [Either a b] -> [b]
rights ([Either ScriptExecutionError ExecutionUnits] -> [ExecutionUnits])
-> [Either ScriptExecutionError ExecutionUnits] -> [ExecutionUnits]
forall a b. (a -> b) -> a -> b
$ EvaluationReport -> [Either ScriptExecutionError ExecutionUnits]
forall a. Map ScriptWitnessIndex a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList EvaluationReport
report
estimateMinFee ::
Tx ->
EvaluationReport ->
Coin
estimateMinFee :: Tx -> EvaluationReport -> Coin
estimateMinFee Tx
tx EvaluationReport
evaluationReport =
(Int
txSize Int -> Coin -> Coin
forall i. Integral i => i -> Coin -> Coin
forall t i. (Val t, Integral i) => i -> t -> t
<×> Coin
a Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Coin
b)
Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Prices -> ExUnits -> Coin
txscriptfee Prices
prices ExUnits
allExunits
where
txSize :: Int
txSize = ByteString -> Int
BS.length (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ Tx -> ByteString
forall a. SerialiseAsCBOR a => a -> ByteString
serialiseToCBOR Tx
tx
a :: Coin
a = PParams LedgerEra
PParams StandardConway
pparams PParams StandardConway
-> Getting Coin (PParams StandardConway) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (PParams StandardConway) Coin
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams StandardConway) Coin
ppMinFeeAL
b :: Coin
b = PParams LedgerEra
PParams StandardConway
pparams PParams StandardConway
-> Getting Coin (PParams StandardConway) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (PParams StandardConway) Coin
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams StandardConway) Coin
ppMinFeeBL
prices :: Prices
prices = PParams LedgerEra
PParams StandardConway
pparams PParams StandardConway
-> Getting Prices (PParams StandardConway) Prices -> Prices
forall s a. s -> Getting a s a -> a
^. Getting Prices (PParams StandardConway) Prices
forall era. AlonzoEraPParams era => Lens' (PParams era) Prices
Lens' (PParams StandardConway) Prices
ppPricesL
allExunits :: ExUnits
allExunits = (ExecutionUnits -> ExUnits) -> [ExecutionUnits] -> ExUnits
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ExecutionUnits -> ExUnits
toLedgerExUnits ([ExecutionUnits] -> ExUnits)
-> ([Either ScriptExecutionError ExecutionUnits]
-> [ExecutionUnits])
-> [Either ScriptExecutionError ExecutionUnits]
-> ExUnits
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either ScriptExecutionError ExecutionUnits] -> [ExecutionUnits]
forall a b. [Either a b] -> [b]
rights ([Either ScriptExecutionError ExecutionUnits] -> ExUnits)
-> [Either ScriptExecutionError ExecutionUnits] -> ExUnits
forall a b. (a -> b) -> a -> b
$ EvaluationReport -> [Either ScriptExecutionError ExecutionUnits]
forall a. Map ScriptWitnessIndex a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList EvaluationReport
evaluationReport
prepareTxScripts ::
Tx ->
UTxO ->
Either String [ByteString]
prepareTxScripts :: Tx -> UTxO -> Either String [ByteString]
prepareTxScripts Tx
tx UTxO
utxo = do
[PlutusWithContext StandardCrypto]
results <-
case EpochInfo (Either Text)
-> SystemStart
-> PParams StandardConway
-> Tx StandardConway
-> UTxO StandardConway
-> Either
[CollectError StandardConway]
[PlutusWithContext (EraCrypto StandardConway)]
forall era.
(AlonzoEraTxBody era, AlonzoEraTxWits era, AlonzoEraUTxO era,
ScriptsNeeded era ~ AlonzoScriptsNeeded era,
EraPlutusContext era) =>
EpochInfo (Either Text)
-> SystemStart
-> PParams era
-> Tx era
-> UTxO era
-> Either [CollectError era] [PlutusWithContext (EraCrypto era)]
collectPlutusScriptsWithContext EpochInfo (Either Text)
forall (m :: * -> *). Monad m => EpochInfo m
epochInfo SystemStart
systemStart PParams LedgerEra
PParams StandardConway
pparams Tx LedgerEra
Tx StandardConway
ltx UTxO LedgerEra
UTxO StandardConway
lutxo of
Left [CollectError StandardConway]
e -> String -> Either String [PlutusWithContext StandardCrypto]
forall a b. a -> Either a b
Left (String -> Either String [PlutusWithContext StandardCrypto])
-> String -> Either String [PlutusWithContext StandardCrypto]
forall a b. (a -> b) -> a -> b
$ [CollectError StandardConway] -> String
forall b a. (Show a, IsString b) => a -> b
show [CollectError StandardConway]
e
Right [PlutusWithContext (EraCrypto StandardConway)]
x -> [PlutusWithContext StandardCrypto]
-> Either String [PlutusWithContext StandardCrypto]
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [PlutusWithContext StandardCrypto]
[PlutusWithContext (EraCrypto StandardConway)]
x
[Program NamedDeBruijn DefaultUni DefaultFun ()]
programs <- [PlutusWithContext StandardCrypto]
-> (PlutusWithContext StandardCrypto
-> Either String (Program NamedDeBruijn DefaultUni DefaultFun ()))
-> Either String [Program NamedDeBruijn DefaultUni DefaultFun ()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [PlutusWithContext StandardCrypto]
results ((PlutusWithContext StandardCrypto
-> Either String (Program NamedDeBruijn DefaultUni DefaultFun ()))
-> Either String [Program NamedDeBruijn DefaultUni DefaultFun ()])
-> (PlutusWithContext StandardCrypto
-> Either String (Program NamedDeBruijn DefaultUni DefaultFun ()))
-> Either String [Program NamedDeBruijn DefaultUni DefaultFun ()]
forall a b. (a -> b) -> a -> b
$ \(PlutusWithContext Version
protocolVersion Either (Plutus l) (PlutusRunnable l)
script ScriptHash StandardCrypto
_ (PlutusArgs l
arguments :: PlutusArgs l) ExUnits
_exUnits CostModel
_costModel) -> do
(PlutusRunnable ScriptForEvaluation
rs) <-
case Either (Plutus l) (PlutusRunnable l)
script of
Right PlutusRunnable l
runnable -> PlutusRunnable l -> Either String (PlutusRunnable l)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PlutusRunnable l
runnable
Left Plutus l
serialised -> (ScriptDecodeError -> String)
-> Either ScriptDecodeError (PlutusRunnable l)
-> Either String (PlutusRunnable l)
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left ScriptDecodeError -> String
forall b a. (Show a, IsString b) => a -> b
show (Either ScriptDecodeError (PlutusRunnable l)
-> Either String (PlutusRunnable l))
-> Either ScriptDecodeError (PlutusRunnable l)
-> Either String (PlutusRunnable l)
forall a b. (a -> b) -> a -> b
$ Version -> Plutus l -> Either ScriptDecodeError (PlutusRunnable l)
forall (l :: Language).
PlutusLanguage l =>
Version -> Plutus l -> Either ScriptDecodeError (PlutusRunnable l)
decodePlutusRunnable Version
protocolVersion Plutus l
serialised
let majorProtocolVersion :: MajorProtocolVersion
majorProtocolVersion = Int -> MajorProtocolVersion
Plutus.MajorProtocolVersion (Int -> MajorProtocolVersion) -> Int -> MajorProtocolVersion
forall a b. (a -> b) -> a -> b
$ Version -> Int
forall i. Integral i => Version -> i
getVersion Version
protocolVersion
args :: [Data]
args =
case forall (l :: Language). PlutusLanguage l => SLanguage l
isLanguage @l of
SLanguage l
SPlutusV2 -> case PlutusArgs 'PlutusV2 -> LegacyPlutusArgs 'PlutusV2
unPlutusV2Args PlutusArgs l
PlutusArgs 'PlutusV2
arguments of
LegacyPlutusArgs2 Data
redeemer PlutusScriptContext 'PlutusV2
scriptContext -> [Data
redeemer, ScriptContext -> Data
forall a. ToData a => a -> Data
toData PlutusScriptContext 'PlutusV2
ScriptContext
scriptContext]
LegacyPlutusArgs 'PlutusV2
_ -> Text -> [Data]
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"unexpeted args"
SLanguage l
_ -> Text -> [Data]
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"unsupported language"
Term NamedDeBruijn DefaultUni DefaultFun ()
appliedTerm <- (EvaluationError -> String)
-> Either
EvaluationError (Term NamedDeBruijn DefaultUni DefaultFun ())
-> Either String (Term NamedDeBruijn DefaultUni DefaultFun ())
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left EvaluationError -> String
forall b a. (Show a, IsString b) => a -> b
show (Either
EvaluationError (Term NamedDeBruijn DefaultUni DefaultFun ())
-> Either String (Term NamedDeBruijn DefaultUni DefaultFun ()))
-> Either
EvaluationError (Term NamedDeBruijn DefaultUni DefaultFun ())
-> Either String (Term NamedDeBruijn DefaultUni DefaultFun ())
forall a b. (a -> b) -> a -> b
$ PlutusLedgerLanguage
-> MajorProtocolVersion
-> ScriptForEvaluation
-> [Data]
-> Either
EvaluationError (Term NamedDeBruijn DefaultUni DefaultFun ())
forall (m :: * -> *).
MonadError EvaluationError m =>
PlutusLedgerLanguage
-> MajorProtocolVersion
-> ScriptForEvaluation
-> [Data]
-> m (Term NamedDeBruijn DefaultUni DefaultFun ())
mkTermToEvaluate PlutusLedgerLanguage
Plutus.PlutusV2 MajorProtocolVersion
majorProtocolVersion ScriptForEvaluation
rs [Data]
args
Program NamedDeBruijn DefaultUni DefaultFun ()
-> Either String (Program NamedDeBruijn DefaultUni DefaultFun ())
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Program NamedDeBruijn DefaultUni DefaultFun ()
-> Either String (Program NamedDeBruijn DefaultUni DefaultFun ()))
-> Program NamedDeBruijn DefaultUni DefaultFun ()
-> Either String (Program NamedDeBruijn DefaultUni DefaultFun ())
forall a b. (a -> b) -> a -> b
$ ()
-> Version
-> Term NamedDeBruijn DefaultUni DefaultFun ()
-> Program NamedDeBruijn DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun ann.
ann -> Version -> Term name uni fun ann -> Program name uni fun ann
UPLC.Program () Version
PLC.latestVersion Term NamedDeBruijn DefaultUni DefaultFun ()
appliedTerm
[ByteString] -> Either String [ByteString]
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ByteString] -> Either String [ByteString])
-> [ByteString] -> Either String [ByteString]
forall a b. (a -> b) -> a -> b
$ UnrestrictedProgram NamedDeBruijn DefaultUni DefaultFun ()
-> ByteString
forall a. Flat a => a -> ByteString
flat (UnrestrictedProgram NamedDeBruijn DefaultUni DefaultFun ()
-> ByteString)
-> (Program NamedDeBruijn DefaultUni DefaultFun ()
-> UnrestrictedProgram NamedDeBruijn DefaultUni DefaultFun ())
-> Program NamedDeBruijn DefaultUni DefaultFun ()
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program NamedDeBruijn DefaultUni DefaultFun ()
-> UnrestrictedProgram NamedDeBruijn DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun ann.
Program name uni fun ann -> UnrestrictedProgram name uni fun ann
UnrestrictedProgram (Program NamedDeBruijn DefaultUni DefaultFun () -> ByteString)
-> [Program NamedDeBruijn DefaultUni DefaultFun ()] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Program NamedDeBruijn DefaultUni DefaultFun ()]
programs
where
ltx :: Tx LedgerEra
ltx = Tx -> Tx LedgerEra
forall era. Tx era -> Tx (ShelleyLedgerEra era)
toLedgerTx Tx
tx
lutxo :: UTxO LedgerEra
lutxo = UTxO -> UTxO LedgerEra
toLedgerUTxO UTxO
utxo
pparams :: PParams LedgerEra
pparams :: PParams LedgerEra
pparams =
PParams StandardConway
forall a. Default a => a
def
PParams StandardConway
-> (PParams StandardConway -> PParams StandardConway)
-> PParams StandardConway
forall a b. a -> (a -> b) -> b
& (Word32 -> Identity Word32)
-> PParams StandardConway -> Identity (PParams StandardConway)
forall era. EraPParams era => Lens' (PParams era) Word32
Lens' (PParams StandardConway) Word32
ppMaxTxSizeL ((Word32 -> Identity Word32)
-> PParams StandardConway -> Identity (PParams StandardConway))
-> Word32 -> PParams StandardConway -> PParams StandardConway
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
maxTxSize
PParams StandardConway
-> (PParams StandardConway -> PParams StandardConway)
-> PParams StandardConway
forall a b. a -> (a -> b) -> b
& (Natural -> Identity Natural)
-> PParams StandardConway -> Identity (PParams StandardConway)
forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
Lens' (PParams StandardConway) Natural
ppMaxValSizeL ((Natural -> Identity Natural)
-> PParams StandardConway -> Identity (PParams StandardConway))
-> Natural -> PParams StandardConway -> PParams StandardConway
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural
1000000000
PParams StandardConway
-> (PParams StandardConway -> PParams StandardConway)
-> PParams StandardConway
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> PParams StandardConway -> Identity (PParams StandardConway)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams StandardConway) Coin
ppMinFeeAL ((Coin -> Identity Coin)
-> PParams StandardConway -> Identity (PParams StandardConway))
-> Coin -> PParams StandardConway -> PParams StandardConway
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
44
PParams StandardConway
-> (PParams StandardConway -> PParams StandardConway)
-> PParams StandardConway
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> PParams StandardConway -> Identity (PParams StandardConway)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams StandardConway) Coin
ppMinFeeBL ((Coin -> Identity Coin)
-> PParams StandardConway -> Identity (PParams StandardConway))
-> Coin -> PParams StandardConway -> PParams StandardConway
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
155381
PParams StandardConway
-> (PParams StandardConway -> PParams StandardConway)
-> PParams StandardConway
forall a b. a -> (a -> b) -> b
& (CoinPerByte -> Identity CoinPerByte)
-> PParams StandardConway -> Identity (PParams StandardConway)
forall era.
BabbageEraPParams era =>
Lens' (PParams era) CoinPerByte
Lens' (PParams StandardConway) CoinPerByte
ppCoinsPerUTxOByteL ((CoinPerByte -> Identity CoinPerByte)
-> PParams StandardConway -> Identity (PParams StandardConway))
-> CoinPerByte -> PParams StandardConway -> PParams StandardConway
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin -> CoinPerByte
CoinPerByte (Integer -> Coin
Coin Integer
4310)
PParams StandardConway
-> (PParams StandardConway -> PParams StandardConway)
-> PParams StandardConway
forall a b. a -> (a -> b) -> b
& (ExUnits -> Identity ExUnits)
-> PParams StandardConway -> Identity (PParams StandardConway)
forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
Lens' (PParams StandardConway) ExUnits
ppMaxTxExUnitsL ((ExUnits -> Identity ExUnits)
-> PParams StandardConway -> Identity (PParams StandardConway))
-> ExUnits -> PParams StandardConway -> PParams StandardConway
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ExecutionUnits -> ExUnits
toLedgerExUnits ExecutionUnits
maxTxExecutionUnits
PParams StandardConway
-> (PParams StandardConway -> PParams StandardConway)
-> PParams StandardConway
forall a b. a -> (a -> b) -> b
& (ExUnits -> Identity ExUnits)
-> PParams StandardConway -> Identity (PParams StandardConway)
forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
Lens' (PParams StandardConway) ExUnits
ppMaxBlockExUnitsL
((ExUnits -> Identity ExUnits)
-> PParams StandardConway -> Identity (PParams StandardConway))
-> ExUnits -> PParams StandardConway -> PParams StandardConway
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ExecutionUnits -> ExUnits
toLedgerExUnits
ExecutionUnits
{ executionMemory :: Natural
executionMemory = Natural
62_000_000
, executionSteps :: Natural
executionSteps = Natural
40_000_000_000
}
PParams StandardConway
-> (PParams StandardConway -> PParams StandardConway)
-> PParams StandardConway
forall a b. a -> (a -> b) -> b
& (Prices -> Identity Prices)
-> PParams StandardConway -> Identity (PParams StandardConway)
forall era. AlonzoEraPParams era => Lens' (PParams era) Prices
Lens' (PParams StandardConway) Prices
ppPricesL
((Prices -> Identity Prices)
-> PParams StandardConway -> Identity (PParams StandardConway))
-> Prices -> PParams StandardConway -> PParams StandardConway
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Prices
{ prSteps :: NonNegativeInterval
prSteps = Maybe NonNegativeInterval -> NonNegativeInterval
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe NonNegativeInterval -> NonNegativeInterval)
-> Maybe NonNegativeInterval -> NonNegativeInterval
forall a b. (a -> b) -> a -> b
$ Rational -> Maybe NonNegativeInterval
forall r. BoundedRational r => Rational -> Maybe r
boundRational (Rational -> Maybe NonNegativeInterval)
-> Rational -> Maybe NonNegativeInterval
forall a b. (a -> b) -> a -> b
$ Integer
721 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
10000000
, prMem :: NonNegativeInterval
prMem = Maybe NonNegativeInterval -> NonNegativeInterval
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe NonNegativeInterval -> NonNegativeInterval)
-> Maybe NonNegativeInterval -> NonNegativeInterval
forall a b. (a -> b) -> a -> b
$ Rational -> Maybe NonNegativeInterval
forall r. BoundedRational r => Rational -> Maybe r
boundRational (Rational -> Maybe NonNegativeInterval)
-> Rational -> Maybe NonNegativeInterval
forall a b. (a -> b) -> a -> b
$ Integer
577 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
10000
}
PParams StandardConway
-> (PParams StandardConway -> PParams StandardConway)
-> PParams StandardConway
forall a b. a -> (a -> b) -> b
& (ProtVer -> Identity ProtVer)
-> PParams StandardConway -> Identity (PParams StandardConway)
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams StandardConway) ProtVer
ppProtocolVersionL ((ProtVer -> Identity ProtVer)
-> PParams StandardConway -> Identity (PParams StandardConway))
-> ProtVer -> PParams StandardConway -> PParams StandardConway
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ProtVer{pvMajor :: Version
pvMajor = forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @9, pvMinor :: Natural
pvMinor = Natural
0}
PParams StandardConway
-> (PParams StandardConway -> PParams StandardConway)
-> PParams StandardConway
forall a b. a -> (a -> b) -> b
& (CostModels -> Identity CostModels)
-> PParams StandardConway -> Identity (PParams StandardConway)
forall era. AlonzoEraPParams era => Lens' (PParams era) CostModels
Lens' (PParams StandardConway) CostModels
ppCostModelsL
((CostModels -> Identity CostModels)
-> PParams StandardConway -> Identity (PParams StandardConway))
-> CostModels -> PParams StandardConway -> PParams StandardConway
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map Language CostModel -> CostModels
mkCostModels
( [(Language, CostModel)] -> Map Language CostModel
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
[ (Language
PlutusV2, CostModel
plutusV2CostModel)
, (Language
PlutusV3, CostModel
plutusV3CostModel)
]
)
maxTxSize :: Natural
maxTxSize :: Natural
maxTxSize = Natural
16384
maxTxExecutionUnits :: ExecutionUnits
maxTxExecutionUnits :: ExecutionUnits
maxTxExecutionUnits =
ExecutionUnits
{ executionMemory :: Natural
executionMemory = Natural
14_000_000
, executionSteps :: Natural
executionSteps = Natural
10_000_000_000
}
maxMem, maxCpu :: Natural
maxCpu :: Natural
maxCpu = ExecutionUnits -> Natural
executionSteps ExecutionUnits
maxTxExecutionUnits
maxMem :: Natural
maxMem = ExecutionUnits -> Natural
executionMemory ExecutionUnits
maxTxExecutionUnits
epochInfo :: Monad m => EpochInfo m
epochInfo :: forall (m :: * -> *). Monad m => EpochInfo m
epochInfo = EpochSize -> SlotLength -> EpochInfo m
forall (m :: * -> *).
Monad m =>
EpochSize -> SlotLength -> EpochInfo m
fixedEpochInfo EpochSize
epochSize SlotLength
slotLength
eraHistoryWithHorizonAt :: SlotNo -> EraHistory
eraHistoryWithHorizonAt :: SlotNo -> EraHistory
eraHistoryWithHorizonAt slotNo :: SlotNo
slotNo@(SlotNo Word64
n) =
Interpreter (CardanoEras StandardCrypto) -> EraHistory
forall (xs :: [*]).
(CardanoBlock StandardCrypto ~ HardForkBlock xs) =>
Interpreter xs -> EraHistory
EraHistory (Summary (CardanoEras StandardCrypto)
-> Interpreter (CardanoEras StandardCrypto)
forall (xs :: [*]). Summary xs -> Interpreter xs
mkInterpreter Summary (CardanoEras StandardCrypto)
summary)
where
summary :: Summary (CardanoEras StandardCrypto)
summary :: Summary (CardanoEras StandardCrypto)
summary =
NonEmpty (CardanoEras StandardCrypto) EraSummary
-> Summary (CardanoEras StandardCrypto)
forall (xs :: [*]). NonEmpty xs EraSummary -> Summary xs
Summary (NonEmpty (CardanoEras StandardCrypto) EraSummary
-> Summary (CardanoEras StandardCrypto))
-> (EraSummary -> NonEmpty (CardanoEras StandardCrypto) EraSummary)
-> EraSummary
-> Summary (CardanoEras StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EraSummary -> NonEmpty (CardanoEras StandardCrypto) EraSummary
forall a x (xs1 :: [*]). a -> NonEmpty (x : xs1) a
NonEmptyOne (EraSummary -> Summary (CardanoEras StandardCrypto))
-> EraSummary -> Summary (CardanoEras StandardCrypto)
forall a b. (a -> b) -> a -> b
$
EraSummary
{ eraStart :: Bound
eraStart = Bound
initBound
, eraEnd :: EraEnd
eraEnd =
Bound -> EraEnd
EraEnd (Bound -> EraEnd) -> Bound -> EraEnd
forall a b. (a -> b) -> a -> b
$
Bound
{ boundTime :: RelativeTime
boundTime = POSIXTime -> RelativeTime
RelativeTime (POSIXTime -> RelativeTime) -> POSIXTime -> RelativeTime
forall a b. (a -> b) -> a -> b
$ Word64 -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n
, boundSlot :: SlotNo
boundSlot = SlotNo
slotNo
, boundEpoch :: EpochNo
boundEpoch = Word64 -> EpochNo
EpochNo Word64
n
}
, EraParams
eraParams :: EraParams
eraParams :: EraParams
eraParams
}
eraParams :: EraParams
eraParams =
EraParams
{ eraEpochSize :: EpochSize
eraEpochSize = Word64 -> EpochSize
EpochSize Word64
1
, eraSlotLength :: SlotLength
eraSlotLength = POSIXTime -> SlotLength
mkSlotLength POSIXTime
1
,
eraSafeZone :: SafeZone
eraSafeZone = SafeZone
UnsafeIndefiniteSafeZone
, eraGenesisWin :: GenesisWindow
eraGenesisWin = Word64 -> GenesisWindow
GenesisWindow Word64
1
}
eraHistoryWithoutHorizon :: EraHistory
eraHistoryWithoutHorizon :: EraHistory
eraHistoryWithoutHorizon =
Interpreter (CardanoEras StandardCrypto) -> EraHistory
forall (xs :: [*]).
(CardanoBlock StandardCrypto ~ HardForkBlock xs) =>
Interpreter xs -> EraHistory
EraHistory (Summary (CardanoEras StandardCrypto)
-> Interpreter (CardanoEras StandardCrypto)
forall (xs :: [*]). Summary xs -> Interpreter xs
mkInterpreter Summary (CardanoEras StandardCrypto)
summary)
where
summary :: Summary (CardanoEras StandardCrypto)
summary :: Summary (CardanoEras StandardCrypto)
summary =
NonEmpty (CardanoEras StandardCrypto) EraSummary
-> Summary (CardanoEras StandardCrypto)
forall (xs :: [*]). NonEmpty xs EraSummary -> Summary xs
Summary (NonEmpty (CardanoEras StandardCrypto) EraSummary
-> Summary (CardanoEras StandardCrypto))
-> (EraSummary -> NonEmpty (CardanoEras StandardCrypto) EraSummary)
-> EraSummary
-> Summary (CardanoEras StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EraSummary -> NonEmpty (CardanoEras StandardCrypto) EraSummary
forall a x (xs1 :: [*]). a -> NonEmpty (x : xs1) a
NonEmptyOne (EraSummary -> Summary (CardanoEras StandardCrypto))
-> EraSummary -> Summary (CardanoEras StandardCrypto)
forall a b. (a -> b) -> a -> b
$
EraSummary
{ eraStart :: Bound
eraStart = Bound
initBound
, eraEnd :: EraEnd
eraEnd = EraEnd
EraUnbounded
, EraParams
eraParams :: EraParams
eraParams :: EraParams
eraParams
}
eraParams :: EraParams
eraParams =
EraParams
{ eraEpochSize :: EpochSize
eraEpochSize = Word64 -> EpochSize
EpochSize Word64
1
, eraSlotLength :: SlotLength
eraSlotLength = POSIXTime -> SlotLength
mkSlotLength POSIXTime
1
,
eraSafeZone :: SafeZone
eraSafeZone = SafeZone
UnsafeIndefiniteSafeZone
, eraGenesisWin :: GenesisWindow
eraGenesisWin = Word64 -> GenesisWindow
GenesisWindow Word64
1
}
epochSize :: EpochSize
epochSize :: EpochSize
epochSize = Word64 -> EpochSize
EpochSize Word64
100
slotLength :: SlotLength
slotLength :: SlotLength
slotLength = POSIXTime -> SlotLength
mkSlotLength POSIXTime
1
systemStart :: SystemStart
systemStart :: SystemStart
systemStart = UTCTime -> SystemStart
SystemStart (UTCTime -> SystemStart) -> UTCTime -> SystemStart
forall a b. (a -> b) -> a -> b
$ POSIXTime -> UTCTime
posixSecondsToUTCTime POSIXTime
0
propTransactionEvaluates :: (Tx, UTxO) -> Property
propTransactionEvaluates :: (Tx, UTxO) -> Property
propTransactionEvaluates (Tx
tx, UTxO
lookupUTxO) =
case Tx -> UTxO -> Either EvaluationError EvaluationReport
evaluateTx Tx
tx UTxO
lookupUTxO of
Left EvaluationError
err ->
Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
False
Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"Transaction: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UTxO -> Tx -> String
renderTxWithUTxO UTxO
lookupUTxO Tx
tx)
Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"Phase-1 validation failed: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> EvaluationError -> String
forall b a. (Show a, IsString b) => a -> b
show EvaluationError
err)
Right EvaluationReport
redeemerReport ->
(Either ScriptExecutionError ExecutionUnits -> Bool)
-> [Either ScriptExecutionError ExecutionUnits] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Either ScriptExecutionError ExecutionUnits -> Bool
forall a b. Either a b -> Bool
isRight (EvaluationReport -> [Either ScriptExecutionError ExecutionUnits]
forall k a. Map k a -> [a]
Map.elems EvaluationReport
redeemerReport)
Bool -> (Bool -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"Transaction: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UTxO -> Tx -> String
renderTxWithUTxO UTxO
lookupUTxO Tx
tx)
Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"Redeemer report: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> EvaluationReport -> String
forall b a. (Show a, IsString b) => a -> b
show EvaluationReport
redeemerReport)
Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample String
"Phase-2 validation failed"
propTransactionFailsEvaluation :: (Tx, UTxO) -> Property
propTransactionFailsEvaluation :: (Tx, UTxO) -> Property
propTransactionFailsEvaluation (Tx
tx, UTxO
lookupUTxO) =
case Tx -> UTxO -> Either EvaluationError EvaluationReport
evaluateTx Tx
tx UTxO
lookupUTxO of
Left EvaluationError
_ -> Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True
Right EvaluationReport
redeemerReport ->
(Either ScriptExecutionError ExecutionUnits -> Bool)
-> EvaluationReport -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Either ScriptExecutionError ExecutionUnits -> Bool
forall a b. Either a b -> Bool
isLeft EvaluationReport
redeemerReport
Bool -> (Bool -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"Transaction: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UTxO -> Tx -> String
renderTxWithUTxO UTxO
lookupUTxO Tx
tx)
Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"Redeemer report: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> EvaluationReport -> String
forall b a. (Show a, IsString b) => a -> b
show EvaluationReport
redeemerReport)
Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample String
"Phase-2 validation should have failed"
genPointInTime :: Gen (SlotNo, UTCTime)
genPointInTime :: Gen (SlotNo, UTCTime)
genPointInTime = do
SlotNo
slot <- Word64 -> SlotNo
SlotNo (Word64 -> SlotNo) -> Gen Word64 -> Gen SlotNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word64
forall a. Arbitrary a => Gen a
arbitrary
let time :: UTCTime
time = SystemStart -> SlotLength -> SlotNo -> UTCTime
slotNoToUTCTime SystemStart
systemStart SlotLength
slotLength SlotNo
slot
(SlotNo, UTCTime) -> Gen (SlotNo, UTCTime)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SlotNo
slot, UTCTime
time)
genValidityBoundsFromContestationPeriod :: ContestationPeriod -> Gen (SlotNo, (SlotNo, UTCTime))
genValidityBoundsFromContestationPeriod :: ContestationPeriod -> Gen (SlotNo, (SlotNo, UTCTime))
genValidityBoundsFromContestationPeriod (UnsafeContestationPeriod Natural
cpSeconds) = do
startSlot :: SlotNo
startSlot@(SlotNo Word64
start) <- Word64 -> SlotNo
SlotNo (Word64 -> SlotNo) -> Gen Word64 -> Gen SlotNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word64
forall a. Arbitrary a => Gen a
arbitrary
let end :: Word64
end = Word64
start Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Natural -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
cpSeconds
SlotNo
endSlot <- Word64 -> SlotNo
SlotNo (Word64 -> SlotNo) -> Gen Word64 -> Gen SlotNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64, Word64) -> Gen Word64
chooseWord64 (Word64
start, Word64
end)
let time :: UTCTime
time = SystemStart -> SlotLength -> SlotNo -> UTCTime
slotNoToUTCTime SystemStart
systemStart SlotLength
slotLength SlotNo
endSlot
(SlotNo, (SlotNo, UTCTime)) -> Gen (SlotNo, (SlotNo, UTCTime))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SlotNo
startSlot, (SlotNo
endSlot, UTCTime
time))
genPointInTimeBefore :: UTCTime -> Gen (SlotNo, UTCTime)
genPointInTimeBefore :: UTCTime -> Gen (SlotNo, UTCTime)
genPointInTimeBefore UTCTime
deadline = do
let SlotNo Word64
slotDeadline = SystemStart -> SlotLength -> UTCTime -> SlotNo
slotNoFromUTCTime SystemStart
systemStart SlotLength
slotLength UTCTime
deadline
SlotNo
slot <- Word64 -> SlotNo
SlotNo (Word64 -> SlotNo) -> Gen Word64 -> Gen SlotNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
0, Word64
slotDeadline)
(SlotNo, UTCTime) -> Gen (SlotNo, UTCTime)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SlotNo
slot, SystemStart -> SlotLength -> SlotNo -> UTCTime
slotNoToUTCTime SystemStart
systemStart SlotLength
slotLength SlotNo
slot)
genPointInTimeAfter :: UTCTime -> Gen (SlotNo, UTCTime)
genPointInTimeAfter :: UTCTime -> Gen (SlotNo, UTCTime)
genPointInTimeAfter UTCTime
deadline = do
let SlotNo Word64
slotDeadline = SystemStart -> SlotLength -> UTCTime -> SlotNo
slotNoFromUTCTime SystemStart
systemStart SlotLength
slotLength UTCTime
deadline
SlotNo
slot <- Word64 -> SlotNo
SlotNo (Word64 -> SlotNo) -> Gen Word64 -> Gen SlotNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
slotDeadline, Word64
forall a. Bounded a => a
maxBound)
(SlotNo, UTCTime) -> Gen (SlotNo, UTCTime)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SlotNo
slot, SystemStart -> SlotLength -> SlotNo -> UTCTime
slotNoToUTCTime SystemStart
systemStart SlotLength
slotLength SlotNo
slot)
plutusV3CostModel :: CostModel
plutusV3CostModel :: CostModel
plutusV3CostModel =
(CostModelApplyError -> CostModel)
-> (CostModel -> CostModel)
-> Either CostModelApplyError CostModel
-> CostModel
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> CostModel
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> CostModel)
-> (CostModelApplyError -> Text)
-> CostModelApplyError
-> CostModel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CostModelApplyError -> Text
forall b a. (Show a, IsString b) => a -> b
show) CostModel -> CostModel
forall a. a -> a
id (Either CostModelApplyError CostModel -> CostModel)
-> Either CostModelApplyError CostModel -> CostModel
forall a b. (a -> b) -> a -> b
$
Language -> [Int64] -> Either CostModelApplyError CostModel
mkCostModel
Language
PlutusV3
[ Int64
100788
, Int64
420
, Int64
1
, Int64
1
, Int64
1000
, Int64
173
, Int64
0
, Int64
1
, Int64
1000
, Int64
59957
, Int64
4
, Int64
1
, Int64
11183
, Int64
32
, Int64
201305
, Int64
8356
, Int64
4
, Int64
16000
, Int64
100
, Int64
16000
, Int64
100
, Int64
16000
, Int64
100
, Int64
16000
, Int64
100
, Int64
16000
, Int64
100
, Int64
16000
, Int64
100
, Int64
100
, Int64
100
, Int64
16000
, Int64
100
, Int64
94375
, Int64
32
, Int64
132994
, Int64
32
, Int64
61462
, Int64
4
, Int64
72010
, Int64
178
, Int64
0
, Int64
1
, Int64
22151
, Int64
32
, Int64
91189
, Int64
769
, Int64
4
, Int64
2
, Int64
85848
, Int64
123203
, Int64
7305
, -Int64
900
, Int64
1716
, Int64
549
, Int64
57
, Int64
85848
, Int64
0
, Int64
1
, Int64
1
, Int64
1000
, Int64
42921
, Int64
4
, Int64
2
, Int64
24548
, Int64
29498
, Int64
38
, Int64
1
, Int64
898148
, Int64
27279
, Int64
1
, Int64
51775
, Int64
558
, Int64
1
, Int64
39184
, Int64
1000
, Int64
60594
, Int64
1
, Int64
141895
, Int64
32
, Int64
83150
, Int64
32
, Int64
15299
, Int64
32
, Int64
76049
, Int64
1
, Int64
13169
, Int64
4
, Int64
22100
, Int64
10
, Int64
28999
, Int64
74
, Int64
1
, Int64
28999
, Int64
74
, Int64
1
, Int64
43285
, Int64
552
, Int64
1
, Int64
44749
, Int64
541
, Int64
1
, Int64
33852
, Int64
32
, Int64
68246
, Int64
32
, Int64
72362
, Int64
32
, Int64
7243
, Int64
32
, Int64
7391
, Int64
32
, Int64
11546
, Int64
32
, Int64
85848
, Int64
123203
, Int64
7305
, -Int64
900
, Int64
1716
, Int64
549
, Int64
57
, Int64
85848
, Int64
0
, Int64
1
, Int64
90434
, Int64
519
, Int64
0
, Int64
1
, Int64
74433
, Int64
32
, Int64
85848
, Int64
123203
, Int64
7305
, -Int64
900
, Int64
1716
, Int64
549
, Int64
57
, Int64
85848
, Int64
0
, Int64
1
, Int64
1
, Int64
85848
, Int64
123203
, Int64
7305
, -Int64
900
, Int64
1716
, Int64
549
, Int64
57
, Int64
85848
, Int64
0
, Int64
1
, Int64
955506
, Int64
213312
, Int64
0
, Int64
2
, Int64
270652
, Int64
22588
, Int64
4
, Int64
1457325
, Int64
64566
, Int64
4
, Int64
20467
, Int64
1
, Int64
4
, Int64
0
, Int64
141992
, Int64
32
, Int64
100788
, Int64
420
, Int64
1
, Int64
1
, Int64
81663
, Int64
32
, Int64
59498
, Int64
32
, Int64
20142
, Int64
32
, Int64
24588
, Int64
32
, Int64
20744
, Int64
32
, Int64
25933
, Int64
32
, Int64
24623
, Int64
32
, Int64
43053543
, Int64
10
, Int64
53384111
, Int64
14333
, Int64
10
, Int64
43574283
, Int64
26308
, Int64
10
, Int64
16000
, Int64
100
, Int64
16000
, Int64
100
, Int64
962335
, Int64
18
, Int64
2780678
, Int64
6
, Int64
442008
, Int64
1
, Int64
52538055
, Int64
3756
, Int64
18
, Int64
267929
, Int64
18
, Int64
76433006
, Int64
8868
, Int64
18
, Int64
52948122
, Int64
18
, Int64
1995836
, Int64
36
, Int64
3227919
, Int64
12
, Int64
901022
, Int64
1
, Int64
166917843
, Int64
4307
, Int64
36
, Int64
284546
, Int64
36
, Int64
158221314
, Int64
26549
, Int64
36
, Int64
74698472
, Int64
36
, Int64
333849714
, Int64
1
, Int64
254006273
, Int64
72
, Int64
2174038
, Int64
72
, Int64
2261318
, Int64
64571
, Int64
4
, Int64
207616
, Int64
8310
, Int64
4
, Int64
1293828
, Int64
28716
, Int64
63
, Int64
0
, Int64
1
, Int64
1006041
, Int64
43623
, Int64
251
, Int64
0
, Int64
1
]
plutusV2CostModel :: CostModel
plutusV2CostModel :: CostModel
plutusV2CostModel =
(CostModelApplyError -> CostModel)
-> (CostModel -> CostModel)
-> Either CostModelApplyError CostModel
-> CostModel
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> CostModel
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> CostModel)
-> (CostModelApplyError -> Text)
-> CostModelApplyError
-> CostModel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CostModelApplyError -> Text
forall b a. (Show a, IsString b) => a -> b
show) CostModel -> CostModel
forall a. a -> a
id (Either CostModelApplyError CostModel -> CostModel)
-> Either CostModelApplyError CostModel -> CostModel
forall a b. (a -> b) -> a -> b
$
Language -> [Int64] -> Either CostModelApplyError CostModel
mkCostModel
Language
PlutusV2
[ Int64
205665
, Int64
812
, Int64
1
, Int64
1
, Int64
1000
, Int64
571
, Int64
0
, Int64
1
, Int64
1000
, Int64
24177
, Int64
4
, Int64
1
, Int64
1000
, Int64
32
, Int64
117366
, Int64
10475
, Int64
4
, Int64
23000
, Int64
100
, Int64
23000
, Int64
100
, Int64
23000
, Int64
100
, Int64
23000
, Int64
100
, Int64
23000
, Int64
100
, Int64
23000
, Int64
100
, Int64
100
, Int64
100
, Int64
23000
, Int64
100
, Int64
19537
, Int64
32
, Int64
175354
, Int64
32
, Int64
46417
, Int64
4
, Int64
221973
, Int64
511
, Int64
0
, Int64
1
, Int64
89141
, Int64
32
, Int64
497525
, Int64
14068
, Int64
4
, Int64
2
, Int64
196500
, Int64
453240
, Int64
220
, Int64
0
, Int64
1
, Int64
1
, Int64
1000
, Int64
28662
, Int64
4
, Int64
2
, Int64
245000
, Int64
216773
, Int64
62
, Int64
1
, Int64
1060367
, Int64
12586
, Int64
1
, Int64
208512
, Int64
421
, Int64
1
, Int64
187000
, Int64
1000
, Int64
52998
, Int64
1
, Int64
80436
, Int64
32
, Int64
43249
, Int64
32
, Int64
1000
, Int64
32
, Int64
80556
, Int64
1
, Int64
57667
, Int64
4
, Int64
1000
, Int64
10
, Int64
197145
, Int64
156
, Int64
1
, Int64
197145
, Int64
156
, Int64
1
, Int64
204924
, Int64
473
, Int64
1
, Int64
208896
, Int64
511
, Int64
1
, Int64
52467
, Int64
32
, Int64
64832
, Int64
32
, Int64
65493
, Int64
32
, Int64
22558
, Int64
32
, Int64
16563
, Int64
32
, Int64
76511
, Int64
32
, Int64
196500
, Int64
453240
, Int64
220
, Int64
0
, Int64
1
, Int64
1
, Int64
69522
, Int64
11687
, Int64
0
, Int64
1
, Int64
60091
, Int64
32
, Int64
196500
, Int64
453240
, Int64
220
, Int64
0
, Int64
1
, Int64
1
, Int64
196500
, Int64
453240
, Int64
220
, Int64
0
, Int64
1
, Int64
1
, Int64
1159724
, Int64
392670
, Int64
0
, Int64
2
, Int64
806990
, Int64
30482
, Int64
4
, Int64
1927926
, Int64
82523
, Int64
4
, Int64
265318
, Int64
0
, Int64
4
, Int64
0
, Int64
85931
, Int64
32
, Int64
205665
, Int64
812
, Int64
1
, Int64
1
, Int64
41182
, Int64
32
, Int64
212342
, Int64
32
, Int64
31220
, Int64
32
, Int64
32696
, Int64
32
, Int64
43357
, Int64
32
, Int64
32247
, Int64
32
, Int64
38314
, Int64
32
, Int64
35892428
, Int64
10
, Int64
57996947
, Int64
18975
, Int64
10
, Int64
38887044
, Int64
32947
, Int64
10
]