-- | Simplified interface to phase-2 validation of transactions, eg. evaluation
-- of Plutus scripts.
--
-- The `evaluateTx` function simplifies the call to ledger and plutus providing
-- an 'EvaluationReport' using pre-canned `ProtocolParameters`. This should only
-- be used for /testing/ or /benchmarking/ purpose as the real evaluation
-- parameters are set when the Hydra node starts.
--
-- __NOTE__: The reason this module is here instead of part of `test/` directory
-- is to be used in @tx-cost@ executable.
module Hydra.Ledger.Cardano.Evaluate where

import Hydra.Prelude hiding (label)

import Cardano.Api.UTxO qualified as UTxO
import Cardano.Ledger.Alonzo.Language (BinaryPlutus (..), Language (PlutusV2), Plutus (..))
import Cardano.Ledger.Alonzo.PlutusScriptApi qualified as Ledger
import Cardano.Ledger.Alonzo.Scripts (CostModel, Prices (..), costModelsValid, emptyCostModels, mkCostModel, txscriptfee)
import Cardano.Ledger.Alonzo.Scripts.Data qualified as Ledger
import Cardano.Ledger.Alonzo.TxInfo (PlutusWithContext (PlutusWithContext))
import Cardano.Ledger.Api (CoinPerByte (..), ppCoinsPerUTxOByteL, ppCostModelsL, ppMaxBlockExUnitsL, ppMaxTxExUnitsL, ppMaxValSizeL, ppMinFeeAL, ppMinFeeBL, ppPricesL, ppProtocolVersionL)
import Cardano.Ledger.BaseTypes (BoundedRational (boundRational), ProtVer (..), natVersion)
import Cardano.Ledger.Binary (getVersion)
import Cardano.Ledger.Coin (Coin (Coin))
import Cardano.Ledger.Core (PParams, ppMaxTxSizeL)
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 (
  CardanoMode,
  ConsensusMode (CardanoMode),
  EraHistory (EraHistory),
  ExecutionUnits (..),
  LedgerEpochInfo (..),
  LedgerEra,
  LedgerProtocolParameters (..),
  Lovelace,
  ProtocolParametersConversionError,
  ScriptExecutionError (ScriptErrorMissingScript),
  ScriptWitnessIndex,
  SerialiseAsCBOR (serialiseToCBOR),
  StandardCrypto,
  TransactionValidityError,
  Tx,
  UTxO,
  evaluateTransactionExecutionUnits,
  fromLedgerCoin,
  getTxBody,
  toLedgerExUnits,
  toLedgerTx,
  toLedgerUTxO,
 )
import Hydra.ContestationPeriod (ContestationPeriod (UnsafeContestationPeriod))
import Hydra.Ledger.Cardano.Time (slotNoFromUTCTime, slotNoToUTCTime)
import Ouroboros.Consensus.Cardano.Block (CardanoEras)
import Ouroboros.Consensus.HardFork.History (
  Bound (Bound, boundEpoch, boundSlot, boundTime),
  EraEnd (EraEnd),
  EraParams (..),
  EraSummary (..),
  SafeZone (..),
  Summary (Summary),
  initBound,
  mkInterpreter,
 )
import PlutusCore qualified as PLC
import PlutusLedgerApi.Common (mkTermToEvaluate)
import PlutusLedgerApi.Common qualified as Plutus
import Test.QuickCheck (choose)
import Test.QuickCheck.Gen (chooseWord64)
import UntypedPlutusCore (UnrestrictedProgram (..))
import UntypedPlutusCore qualified as UPLC

-- * Evaluate transactions

-- | Thin wrapper around 'evaluateTransactionExecutionUnits', using fixtures
-- from this module for 'systemStart', 'eraHistory' and 'pparams'.
--
-- Additionally, this function checks the overall execution units are not
-- exceeding 'maxTxExecutionUnits'.
evaluateTx ::
  Tx ->
  UTxO ->
  Either EvaluationError EvaluationReport
evaluateTx :: Tx -> UTxO -> Either EvaluationError EvaluationReport
evaluateTx = ExecutionUnits
-> Tx -> UTxO -> Either EvaluationError EvaluationReport
evaluateTx' ExecutionUnits
maxTxExecutionUnits

-- | Like 'evaluateTx', but with a configurable maximum transaction
-- 'ExecutionUnits'.
evaluateTx' ::
  -- | Max tx execution units.
  ExecutionUnits ->
  Tx ->
  UTxO ->
  Either EvaluationError EvaluationReport
evaluateTx' :: ExecutionUnits
-> Tx -> UTxO -> Either EvaluationError EvaluationReport
evaluateTx' ExecutionUnits
maxUnits Tx
tx UTxO
utxo = do
  let pparams' :: PParams LedgerEra
pparams' = PParams LedgerEra
pparams PParams LedgerEra
-> (PParams LedgerEra -> PParams LedgerEra) -> PParams LedgerEra
forall a b. a -> (a -> b) -> b
& (ExUnits -> Identity ExUnits)
-> PParams LedgerEra -> Identity (PParams LedgerEra)
forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
Lens' (PParams LedgerEra) ExUnits
ppMaxTxExUnitsL ((ExUnits -> Identity ExUnits)
 -> PParams LedgerEra -> Identity (PParams LedgerEra))
-> ExUnits -> PParams LedgerEra -> PParams LedgerEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ExecutionUnits -> ExUnits
toLedgerExUnits ExecutionUnits
maxUnits
  case LedgerProtocolParameters BabbageEra
-> Either TransactionValidityError EvaluationReport
result (PParams (ShelleyLedgerEra BabbageEra)
-> LedgerProtocolParameters BabbageEra
forall era.
PParams (ShelleyLedgerEra era) -> LedgerProtocolParameters era
LedgerProtocolParameters PParams (ShelleyLedgerEra BabbageEra)
PParams LedgerEra
pparams') of
    Left TransactionValidityError
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 -> EvaluationError
TransactionInvalid TransactionValidityError
txValidityError
    Right EvaluationReport
report
      -- Check overall budget when all individual scripts evaluated
      | (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 BabbageEra
-> Either TransactionValidityError EvaluationReport
result LedgerProtocolParameters BabbageEra
pparams' =
    SystemStart
-> LedgerEpochInfo
-> LedgerProtocolParameters BabbageEra
-> UTxO BabbageEra
-> TxBody BabbageEra
-> Either TransactionValidityError EvaluationReport
forall era.
SystemStart
-> LedgerEpochInfo
-> LedgerProtocolParameters era
-> UTxO era
-> TxBody era
-> Either TransactionValidityError EvaluationReport
evaluateTransactionExecutionUnits
      SystemStart
systemStart
      (EpochInfo (Either Text) -> LedgerEpochInfo
LedgerEpochInfo EpochInfo (Either Text)
forall (m :: * -> *). Monad m => EpochInfo m
epochInfo)
      LedgerProtocolParameters BabbageEra
pparams'
      (UTxO -> UTxO BabbageEra
UTxO.toApi UTxO
utxo)
      (Tx -> TxBody BabbageEra
forall era. Tx era -> TxBody era
getTxBody Tx
tx)

-- | Check the budget used by provided 'EvaluationReport' does not exceed given
-- maximum 'ExecutionUnits'.
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

-- | Errors returned by 'evaluateTx' extending the upstream
-- 'TransactionValidityError' with additional cases.
data EvaluationError
  = TransactionBudgetOverspent {EvaluationError -> ExecutionUnits
used :: ExecutionUnits, EvaluationError -> ExecutionUnits
available :: ExecutionUnits}
  | TransactionInvalid TransactionValidityError
  | 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)

-- | Evaluation result for each of the included scripts. Either they failed
-- evaluation or used a number of 'ExecutionUnits'.
type EvaluationReport =
  (Map ScriptWitnessIndex (Either ScriptExecutionError ExecutionUnits))

renderEvaluationReportFailures :: EvaluationReport -> Text
renderEvaluationReportFailures :: EvaluationReport -> Text
renderEvaluationReportFailures EvaluationReport
reportMap =
  [Text] -> Text
forall t. IsText t "unlines" => [t] -> t
unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ScriptExecutionError -> Text
renderScriptExecutionError (ScriptExecutionError -> Text) -> [ScriptExecutionError] -> [Text]
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 RdmrPtr
missingRdmrPtr ResolvablePointers
_ ->
      Text
"Missing script of redeemer pointer " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RdmrPtr -> Text
forall b a. (Show a, IsString b) => a -> b
show RdmrPtr
missingRdmrPtr
    ScriptExecutionError
f ->
      ScriptExecutionError -> Text
forall b a. (Show a, IsString b) => a -> b
show ScriptExecutionError
f

-- | Get the total used 'ExecutionUnits' from an 'EvaluationReport'. Useful to
-- further process the result of 'evaluateTx'.
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

-- | Estimate minimum fee for given transaction and evaluated redeemers. Instead
-- of using the budgets from the transaction (which are usually set to 0 until
-- balancing), this directly computes the fee from transaction size and the
-- units of the 'EvaluationReport'. Note that this function only provides a
-- rough estimate using this modules' 'pparams' and likely under-estimates cost
-- as we have no witnesses on this 'Tx'.
estimateMinFee ::
  Tx ->
  EvaluationReport ->
  Lovelace
estimateMinFee :: Tx -> EvaluationReport -> Lovelace
estimateMinFee Tx
tx EvaluationReport
evaluationReport =
  Coin -> Lovelace
fromLedgerCoin (Coin -> Lovelace) -> Coin -> Lovelace
forall a b. (a -> b) -> a -> b
$
    (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 PParams LedgerEra -> Getting Coin (PParams LedgerEra) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (PParams LedgerEra) Coin
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams LedgerEra) Coin
ppMinFeeAL
  b :: Coin
b = PParams LedgerEra
pparams PParams LedgerEra -> Getting Coin (PParams LedgerEra) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (PParams LedgerEra) Coin
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams LedgerEra) Coin
ppMinFeeBL
  prices :: Prices
prices = PParams LedgerEra
pparams PParams LedgerEra
-> Getting Prices (PParams LedgerEra) Prices -> Prices
forall s a. s -> Getting a s a -> a
^. Getting Prices (PParams LedgerEra) Prices
forall era. AlonzoEraPParams era => Lens' (PParams era) Prices
Lens' (PParams LedgerEra) 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

-- * Profile transactions

-- | Like 'evaluateTx', but instead of actual evaluation, return the
-- flat-encoded, fully applied scripts for each redeemer to be evaluated
-- externally by 'uplc'. Use input format "flat-namedDeBruijn". This can be used
-- to gather profiling information.
--
-- NOTE: This assumes we use 'Babbage' and only 'PlutusV2' scripts are used.
prepareTxScripts ::
  Tx ->
  UTxO ->
  Either String [ByteString]
prepareTxScripts :: Tx -> UTxO -> Either String [ByteString]
prepareTxScripts Tx
tx UTxO
utxo = do
  -- Tuples with scripts and their arguments collected from the tx
  [PlutusWithContext LedgerEra]
results <-
    case EpochInfo (Either Text)
-> SystemStart
-> PParams LedgerEra
-> Tx LedgerEra
-> UTxO LedgerEra
-> Either [CollectError LedgerEra] [PlutusWithContext LedgerEra]
forall era.
(MaryEraTxBody era, AlonzoEraTxWits era, AlonzoEraUTxO era,
 ScriptsNeeded era ~ AlonzoScriptsNeeded era, ExtendedUTxO era,
 Script era ~ AlonzoScript era, AlonzoEraPParams era,
 EraPlutusContext 'PlutusV1 era) =>
EpochInfo (Either Text)
-> SystemStart
-> PParams era
-> Tx era
-> UTxO era
-> Either [CollectError era] [PlutusWithContext era]
Ledger.collectPlutusScriptsWithContext EpochInfo (Either Text)
forall (m :: * -> *). Monad m => EpochInfo m
epochInfo SystemStart
systemStart PParams LedgerEra
pparams Tx (ShelleyLedgerEra BabbageEra)
Tx LedgerEra
ltx UTxO LedgerEra
lutxo of
      Left [CollectError LedgerEra]
e -> String -> Either String [PlutusWithContext LedgerEra]
forall a b. a -> Either a b
Left (String -> Either String [PlutusWithContext LedgerEra])
-> String -> Either String [PlutusWithContext LedgerEra]
forall a b. (a -> b) -> a -> b
$ [CollectError LedgerEra] -> String
forall b a. (Show a, IsString b) => a -> b
show [CollectError LedgerEra]
e
      Right [PlutusWithContext LedgerEra]
x -> [PlutusWithContext LedgerEra]
-> Either String [PlutusWithContext LedgerEra]
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [PlutusWithContext LedgerEra]
x

  -- Fully applied UPLC programs which we could run using the cekMachine
  [Program NamedDeBruijn DefaultUni DefaultFun ()]
programs <- [PlutusWithContext LedgerEra]
-> (PlutusWithContext LedgerEra
    -> 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 LedgerEra]
results ((PlutusWithContext LedgerEra
  -> Either String (Program NamedDeBruijn DefaultUni DefaultFun ()))
 -> Either String [Program NamedDeBruijn DefaultUni DefaultFun ()])
-> (PlutusWithContext LedgerEra
    -> Either String (Program NamedDeBruijn DefaultUni DefaultFun ()))
-> Either String [Program NamedDeBruijn DefaultUni DefaultFun ()]
forall a b. (a -> b) -> a -> b
$ \(PlutusWithContext (Plutus Language
_ (BinaryPlutus ShortByteString
script)) [Data LedgerEra]
arguments ExUnits
_exUnits CostModel
_costModel) -> do
    let pArgs :: [Data]
pArgs = Data LedgerEra -> Data
forall era. Data era -> Data
Ledger.getPlutusData (Data LedgerEra -> Data) -> [Data LedgerEra] -> [Data]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Data LedgerEra]
arguments
    ScriptForEvaluation
x <- (ScriptDecodeError -> String)
-> Either ScriptDecodeError ScriptForEvaluation
-> Either String ScriptForEvaluation
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 ScriptForEvaluation
 -> Either String ScriptForEvaluation)
-> Either ScriptDecodeError ScriptForEvaluation
-> Either String ScriptForEvaluation
forall a b. (a -> b) -> a -> b
$ PlutusLedgerLanguage
-> MajorProtocolVersion
-> ShortByteString
-> Either ScriptDecodeError ScriptForEvaluation
forall (m :: * -> *).
MonadError ScriptDecodeError m =>
PlutusLedgerLanguage
-> MajorProtocolVersion -> ShortByteString -> m ScriptForEvaluation
Plutus.deserialiseScript PlutusLedgerLanguage
Plutus.PlutusV2 MajorProtocolVersion
protocolVersion ShortByteString
script
    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
protocolVersion ScriptForEvaluation
x [Data]
pArgs
    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 (ShelleyLedgerEra BabbageEra)
ltx = Tx -> Tx (ShelleyLedgerEra BabbageEra)
toLedgerTx Tx
tx

  lutxo :: UTxO LedgerEra
lutxo = UTxO -> UTxO LedgerEra
toLedgerUTxO UTxO
utxo

  protocolVersion :: MajorProtocolVersion
protocolVersion =
    let ProtVer{Version
pvMajor :: Version
pvMajor :: ProtVer -> Version
pvMajor} = PParams LedgerEra
pparams PParams LedgerEra
-> Getting ProtVer (PParams LedgerEra) ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. Getting ProtVer (PParams LedgerEra) ProtVer
forall era.
(EraPParams era, EraPParams era) =>
Lens' (PParams era) ProtVer
Lens' (PParams LedgerEra) ProtVer
ppProtocolVersionL
     in 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
pvMajor

-- * Fixtures

-- | Current (2023-04-12) mainchain protocol parameters.
-- XXX: Avoid specifiying not required parameters here (e.g. max block units
-- should not matter).
-- XXX: Load and use mainnet parameters from a file which we can easily review
-- to be in sync with mainnet.
pparams :: PParams LedgerEra
pparams :: PParams LedgerEra
pparams =
  PParams LedgerEra
forall a. Default a => a
def
    PParams LedgerEra
-> (PParams LedgerEra -> PParams LedgerEra) -> PParams LedgerEra
forall a b. a -> (a -> b) -> b
& (Natural -> Identity Natural)
-> PParams LedgerEra -> Identity (PParams LedgerEra)
forall era. EraPParams era => Lens' (PParams era) Natural
Lens' (PParams LedgerEra) Natural
ppMaxTxSizeL ((Natural -> Identity Natural)
 -> PParams LedgerEra -> Identity (PParams LedgerEra))
-> Natural -> PParams LedgerEra -> PParams LedgerEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural
maxTxSize
    PParams LedgerEra
-> (PParams LedgerEra -> PParams LedgerEra) -> PParams LedgerEra
forall a b. a -> (a -> b) -> b
& (Natural -> Identity Natural)
-> PParams LedgerEra -> Identity (PParams LedgerEra)
forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
Lens' (PParams LedgerEra) Natural
ppMaxValSizeL ((Natural -> Identity Natural)
 -> PParams LedgerEra -> Identity (PParams LedgerEra))
-> Natural -> PParams LedgerEra -> PParams LedgerEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural
1000000000
    PParams LedgerEra
-> (PParams LedgerEra -> PParams LedgerEra) -> PParams LedgerEra
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> PParams LedgerEra -> Identity (PParams LedgerEra)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams LedgerEra) Coin
ppMinFeeAL ((Coin -> Identity Coin)
 -> PParams LedgerEra -> Identity (PParams LedgerEra))
-> Coin -> PParams LedgerEra -> PParams LedgerEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
44
    PParams LedgerEra
-> (PParams LedgerEra -> PParams LedgerEra) -> PParams LedgerEra
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> PParams LedgerEra -> Identity (PParams LedgerEra)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams LedgerEra) Coin
ppMinFeeBL ((Coin -> Identity Coin)
 -> PParams LedgerEra -> Identity (PParams LedgerEra))
-> Coin -> PParams LedgerEra -> PParams LedgerEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
155381
    PParams LedgerEra
-> (PParams LedgerEra -> PParams LedgerEra) -> PParams LedgerEra
forall a b. a -> (a -> b) -> b
& (CoinPerByte -> Identity CoinPerByte)
-> PParams LedgerEra -> Identity (PParams LedgerEra)
forall era.
BabbageEraPParams era =>
Lens' (PParams era) CoinPerByte
Lens' (PParams LedgerEra) CoinPerByte
ppCoinsPerUTxOByteL ((CoinPerByte -> Identity CoinPerByte)
 -> PParams LedgerEra -> Identity (PParams LedgerEra))
-> CoinPerByte -> PParams LedgerEra -> PParams LedgerEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin -> CoinPerByte
CoinPerByte (Integer -> Coin
Coin Integer
4310)
    PParams LedgerEra
-> (PParams LedgerEra -> PParams LedgerEra) -> PParams LedgerEra
forall a b. a -> (a -> b) -> b
& (ExUnits -> Identity ExUnits)
-> PParams LedgerEra -> Identity (PParams LedgerEra)
forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
Lens' (PParams LedgerEra) ExUnits
ppMaxTxExUnitsL ((ExUnits -> Identity ExUnits)
 -> PParams LedgerEra -> Identity (PParams LedgerEra))
-> ExUnits -> PParams LedgerEra -> PParams LedgerEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ExecutionUnits -> ExUnits
toLedgerExUnits ExecutionUnits
maxTxExecutionUnits
    PParams LedgerEra
-> (PParams LedgerEra -> PParams LedgerEra) -> PParams LedgerEra
forall a b. a -> (a -> b) -> b
& (ExUnits -> Identity ExUnits)
-> PParams LedgerEra -> Identity (PParams LedgerEra)
forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
Lens' (PParams LedgerEra) ExUnits
ppMaxBlockExUnitsL
      ((ExUnits -> Identity ExUnits)
 -> PParams LedgerEra -> Identity (PParams LedgerEra))
-> ExUnits -> PParams LedgerEra -> PParams LedgerEra
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 LedgerEra
-> (PParams LedgerEra -> PParams LedgerEra) -> PParams LedgerEra
forall a b. a -> (a -> b) -> b
& (Prices -> Identity Prices)
-> PParams LedgerEra -> Identity (PParams LedgerEra)
forall era. AlonzoEraPParams era => Lens' (PParams era) Prices
Lens' (PParams LedgerEra) Prices
ppPricesL
      ((Prices -> Identity Prices)
 -> PParams LedgerEra -> Identity (PParams LedgerEra))
-> Prices -> PParams LedgerEra -> PParams LedgerEra
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 LedgerEra
-> (PParams LedgerEra -> PParams LedgerEra) -> PParams LedgerEra
forall a b. a -> (a -> b) -> b
& (ProtVer -> Identity ProtVer)
-> PParams LedgerEra -> Identity (PParams LedgerEra)
forall era.
(EraPParams era, EraPParams era) =>
Lens' (PParams era) ProtVer
Lens' (PParams LedgerEra) ProtVer
ppProtocolVersionL ((ProtVer -> Identity ProtVer)
 -> PParams LedgerEra -> Identity (PParams LedgerEra))
-> ProtVer -> PParams LedgerEra -> PParams LedgerEra
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 @8, pvMinor :: Natural
pvMinor = Natural
0}
    PParams LedgerEra
-> (PParams LedgerEra -> PParams LedgerEra) -> PParams LedgerEra
forall a b. a -> (a -> b) -> b
& (CostModels -> Identity CostModels)
-> PParams LedgerEra -> Identity (PParams LedgerEra)
forall era. AlonzoEraPParams era => Lens' (PParams era) CostModels
Lens' (PParams LedgerEra) CostModels
ppCostModelsL ((CostModels -> Identity CostModels)
 -> PParams LedgerEra -> Identity (PParams LedgerEra))
-> CostModels -> PParams LedgerEra -> PParams LedgerEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ CostModels
emptyCostModels{costModelsValid = Map.fromList [(PlutusV2, plutusV2CostModel)]}

maxTxSize :: Natural
maxTxSize :: Natural
maxTxSize = Natural
16384

-- | Max transaction execution unit budget of the current 'pparams'.
maxTxExecutionUnits :: ExecutionUnits
maxTxExecutionUnits :: ExecutionUnits
maxTxExecutionUnits =
  ExecutionUnits
    { executionMemory :: Natural
executionMemory = Natural
14_000_000
    , executionSteps :: Natural
executionSteps = Natural
10_000_000_000
    }

-- | Max memory and cpu units of the current 'pparams'.
maxMem, maxCpu :: Natural
maxCpu :: Natural
maxCpu = ExecutionUnits -> Natural
executionSteps ExecutionUnits
maxTxExecutionUnits
maxMem :: Natural
maxMem = ExecutionUnits -> Natural
executionMemory ExecutionUnits
maxTxExecutionUnits

-- | An artifical 'EpochInfo' comprised by a single never ending (forking) era,
-- with fixed 'epochSize' and 'slotLength'.
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

-- | An era history with a single era which will end at some point.
--
-- A "real" 'EraHistory' received from the cardano-node will have the 'eraEnd'
-- at a known or earliest possible end of the current era + a safe zone.
--
-- See 'Ouroboros.Consensus.HardFork.History.EraParams' for details.
--
-- NOTE: This era is using not so realistic epoch sizes of 1 and sets a slot
-- length of 1
eraHistoryWithHorizonAt :: SlotNo -> EraHistory CardanoMode
eraHistoryWithHorizonAt :: SlotNo -> EraHistory CardanoMode
eraHistoryWithHorizonAt slotNo :: SlotNo
slotNo@(SlotNo Word64
n) =
  ConsensusMode CardanoMode
-> Interpreter (CardanoEras StandardCrypto)
-> EraHistory CardanoMode
forall mode (xs :: [*]).
(ConsensusBlockForMode mode ~ HardForkBlock xs) =>
ConsensusMode mode -> Interpreter xs -> EraHistory mode
EraHistory ConsensusMode CardanoMode
CardanoMode (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
      , -- NOTE: unused if the 'eraEnd' is already defined, but would be used to
        -- extend the last era accordingly in the real cardano-node
        eraSafeZone :: SafeZone
eraSafeZone = SafeZone
UnsafeIndefiniteSafeZone
      }

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

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)

-- | Parameter here is the contestation period (cp) so we need to generate
-- start (tMin) and end (tMax) tx validity bound such that their difference
-- is not higher than the cp.
-- Returned slots are tx validity bounds
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)

-- ** Plutus cost model fixtures

-- | Current (2023-08-04) mainnet PlutusV2 cost model.
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 -> [Integer] -> Either CostModelApplyError CostModel
mkCostModel
      Language
PlutusV2
      [ Integer
205665
      , Integer
812
      , Integer
1
      , Integer
1
      , Integer
1000
      , Integer
571
      , Integer
0
      , Integer
1
      , Integer
1000
      , Integer
24177
      , Integer
4
      , Integer
1
      , Integer
1000
      , Integer
32
      , Integer
117366
      , Integer
10475
      , Integer
4
      , Integer
23000
      , Integer
100
      , Integer
23000
      , Integer
100
      , Integer
23000
      , Integer
100
      , Integer
23000
      , Integer
100
      , Integer
23000
      , Integer
100
      , Integer
23000
      , Integer
100
      , Integer
100
      , Integer
100
      , Integer
23000
      , Integer
100
      , Integer
19537
      , Integer
32
      , Integer
175354
      , Integer
32
      , Integer
46417
      , Integer
4
      , Integer
221973
      , Integer
511
      , Integer
0
      , Integer
1
      , Integer
89141
      , Integer
32
      , Integer
497525
      , Integer
14068
      , Integer
4
      , Integer
2
      , Integer
196500
      , Integer
453240
      , Integer
220
      , Integer
0
      , Integer
1
      , Integer
1
      , Integer
1000
      , Integer
28662
      , Integer
4
      , Integer
2
      , Integer
245000
      , Integer
216773
      , Integer
62
      , Integer
1
      , Integer
1060367
      , Integer
12586
      , Integer
1
      , Integer
208512
      , Integer
421
      , Integer
1
      , Integer
187000
      , Integer
1000
      , Integer
52998
      , Integer
1
      , Integer
80436
      , Integer
32
      , Integer
43249
      , Integer
32
      , Integer
1000
      , Integer
32
      , Integer
80556
      , Integer
1
      , Integer
57667
      , Integer
4
      , Integer
1000
      , Integer
10
      , Integer
197145
      , Integer
156
      , Integer
1
      , Integer
197145
      , Integer
156
      , Integer
1
      , Integer
204924
      , Integer
473
      , Integer
1
      , Integer
208896
      , Integer
511
      , Integer
1
      , Integer
52467
      , Integer
32
      , Integer
64832
      , Integer
32
      , Integer
65493
      , Integer
32
      , Integer
22558
      , Integer
32
      , Integer
16563
      , Integer
32
      , Integer
76511
      , Integer
32
      , Integer
196500
      , Integer
453240
      , Integer
220
      , Integer
0
      , Integer
1
      , Integer
1
      , Integer
69522
      , Integer
11687
      , Integer
0
      , Integer
1
      , Integer
60091
      , Integer
32
      , Integer
196500
      , Integer
453240
      , Integer
220
      , Integer
0
      , Integer
1
      , Integer
1
      , Integer
196500
      , Integer
453240
      , Integer
220
      , Integer
0
      , Integer
1
      , Integer
1
      , Integer
1159724
      , Integer
392670
      , Integer
0
      , Integer
2
      , Integer
806990
      , Integer
30482
      , Integer
4
      , Integer
1927926
      , Integer
82523
      , Integer
4
      , Integer
265318
      , Integer
0
      , Integer
4
      , Integer
0
      , Integer
85931
      , Integer
32
      , Integer
205665
      , Integer
812
      , Integer
1
      , Integer
1
      , Integer
41182
      , Integer
32
      , Integer
212342
      , Integer
32
      , Integer
31220
      , Integer
32
      , Integer
32696
      , Integer
32
      , Integer
43357
      , Integer
32
      , Integer
32247
      , Integer
32
      , Integer
38314
      , Integer
32
      , Integer
35892428
      , Integer
10
      , Integer
57996947
      , Integer
18975
      , Integer
10
      , Integer
38887044
      , Integer
32947
      , Integer
10
      ]