{-# LANGUAGE NoPartialTypeSignatures #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

module Plutarch.Internal.Evaluate (uplcVersion, evalScript, evalScriptHuge, evalScriptUnlimited, evalScript') where

import Data.Text (Text)
import Plutarch.Script (Script (Script))
import PlutusCore qualified as PLC
import PlutusCore.Evaluation.Machine.ExBudget (
  ExBudget (ExBudget),
  ExRestrictingBudget (ExRestrictingBudget),
  minusExBudget,
 )
import PlutusCore.Evaluation.Machine.ExBudgetingDefaults (defaultCekParametersForTesting)
import PlutusCore.Evaluation.Machine.ExMemory (ExCPU (ExCPU), ExMemory (ExMemory))
import UntypedPlutusCore (
  Program (Program),
  Term,
  Version (Version),
 )
import UntypedPlutusCore qualified as UPLC
import UntypedPlutusCore.Evaluation.Machine.Cek qualified as Cek

uplcVersion :: Version
uplcVersion :: Version
uplcVersion = Natural -> Natural -> Natural -> Version
Version Natural
1 Natural
1 Natural
0

-- | Evaluate a script with a big budget, returning the trace log and term result.
evalScript :: Script -> (Either (Cek.CekEvaluationException PLC.NamedDeBruijn PLC.DefaultUni PLC.DefaultFun) Script, ExBudget, [Text])
evalScript :: Script
-> (Either
      (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun)
      Script,
    ExBudget, [Text])
evalScript = ExBudget
-> Script
-> (Either
      (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun)
      Script,
    ExBudget, [Text])
evalScript' ExBudget
budget
  where
    -- from https://github.com/input-output-hk/cardano-node/blob/master/configuration/cardano/mainnet-alonzo-genesis.json#L17
    budget :: ExBudget
budget = ExCPU -> ExMemory -> ExBudget
ExBudget (CostingInteger -> ExCPU
ExCPU CostingInteger
10000000000) (CostingInteger -> ExMemory
ExMemory CostingInteger
10000000)

-- | Evaluate a script with a huge budget, returning the trace log and term result.
evalScriptHuge :: Script -> (Either (Cek.CekEvaluationException PLC.NamedDeBruijn PLC.DefaultUni PLC.DefaultFun) Script, ExBudget, [Text])
evalScriptHuge :: Script
-> (Either
      (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun)
      Script,
    ExBudget, [Text])
evalScriptHuge = ExBudget
-> Script
-> (Either
      (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun)
      Script,
    ExBudget, [Text])
evalScript' ExBudget
budget
  where
    -- from https://github.com/input-output-hk/cardano-node/blob/master/configuration/cardano/mainnet-alonzo-genesis.json#L17
    budget :: ExBudget
budget = ExCPU -> ExMemory -> ExBudget
ExBudget (CostingInteger -> ExCPU
ExCPU CostingInteger
forall a. Bounded a => a
maxBound) (CostingInteger -> ExMemory
ExMemory CostingInteger
forall a. Bounded a => a
maxBound)

-- | Evaluate a script with a specific budget, returning the trace log and term result.
evalScript' :: ExBudget -> Script -> (Either (Cek.CekEvaluationException PLC.NamedDeBruijn PLC.DefaultUni PLC.DefaultFun) Script, ExBudget, [Text])
evalScript' :: ExBudget
-> Script
-> (Either
      (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun)
      Script,
    ExBudget, [Text])
evalScript' ExBudget
budget (Script (Program ()
_ Version
_ Term DeBruijn DefaultUni DefaultFun ()
t)) = case ExBudget
-> Term NamedDeBruijn DefaultUni DefaultFun ()
-> (Either
      (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun)
      (Term NamedDeBruijn DefaultUni DefaultFun ()),
    ExBudget, [Text])
evalTerm ExBudget
budget ((DeBruijn -> NamedDeBruijn)
-> Term DeBruijn DefaultUni DefaultFun ()
-> Term NamedDeBruijn DefaultUni DefaultFun ()
forall name name' (uni :: Type -> Type) fun ann.
(name -> name') -> Term name uni fun ann -> Term name' uni fun ann
UPLC.termMapNames DeBruijn -> NamedDeBruijn
UPLC.fakeNameDeBruijn Term DeBruijn DefaultUni DefaultFun ()
t) of
  (Either
  (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun)
  (Term NamedDeBruijn DefaultUni DefaultFun ())
res, ExBudget
remaining, [Text]
logs) -> (Program DeBruijn DefaultUni DefaultFun () -> Script
Script (Program DeBruijn DefaultUni DefaultFun () -> Script)
-> (Term NamedDeBruijn DefaultUni DefaultFun ()
    -> Program DeBruijn DefaultUni DefaultFun ())
-> Term NamedDeBruijn DefaultUni DefaultFun ()
-> Script
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ()
-> Version
-> Term DeBruijn DefaultUni DefaultFun ()
-> Program DeBruijn DefaultUni DefaultFun ()
forall name (uni :: Type -> Type) fun ann.
ann -> Version -> Term name uni fun ann -> Program name uni fun ann
Program () Version
uplcVersion (Term DeBruijn DefaultUni DefaultFun ()
 -> Program DeBruijn DefaultUni DefaultFun ())
-> (Term NamedDeBruijn DefaultUni DefaultFun ()
    -> Term DeBruijn DefaultUni DefaultFun ())
-> Term NamedDeBruijn DefaultUni DefaultFun ()
-> Program DeBruijn DefaultUni DefaultFun ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NamedDeBruijn -> DeBruijn)
-> Term NamedDeBruijn DefaultUni DefaultFun ()
-> Term DeBruijn DefaultUni DefaultFun ()
forall name name' (uni :: Type -> Type) fun ann.
(name -> name') -> Term name uni fun ann -> Term name' uni fun ann
UPLC.termMapNames NamedDeBruijn -> DeBruijn
UPLC.unNameDeBruijn (Term NamedDeBruijn DefaultUni DefaultFun () -> Script)
-> Either
     (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun)
     (Term NamedDeBruijn DefaultUni DefaultFun ())
-> Either
     (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun) Script
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Either
  (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun)
  (Term NamedDeBruijn DefaultUni DefaultFun ())
res, ExBudget
remaining, [Text]
logs)

{- | Evaluate a script without budget limit

@since 1.10.0
-}
evalScriptUnlimited :: Script -> (Either (Cek.CekEvaluationException PLC.NamedDeBruijn PLC.DefaultUni PLC.DefaultFun) Script, ExBudget, [Text])
evalScriptUnlimited :: Script
-> (Either
      (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun)
      Script,
    ExBudget, [Text])
evalScriptUnlimited (Script (Program ()
_ Version
_ Term DeBruijn DefaultUni DefaultFun ()
t)) =
  case MachineParameters
  CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ())
-> ExBudgetMode CountingSt DefaultUni DefaultFun
-> EmitterMode DefaultUni DefaultFun
-> Term NamedDeBruijn DefaultUni DefaultFun ()
-> CekReport CountingSt NamedDeBruijn DefaultUni DefaultFun
forall (uni :: Type -> Type) fun ann cost.
ThrowableBuiltins uni fun =>
MachineParameters CekMachineCosts fun (CekValue uni fun ann)
-> ExBudgetMode cost uni fun
-> EmitterMode uni fun
-> NTerm uni fun ann
-> CekReport cost NamedDeBruijn uni fun
Cek.runCekDeBruijn MachineParameters
  CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ())
forall ann.
Typeable @Type ann =>
MachineParameters
  CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ann)
defaultCekParametersForTesting ExBudgetMode CountingSt DefaultUni DefaultFun
forall (uni :: Type -> Type) fun. ExBudgetMode CountingSt uni fun
Cek.counting EmitterMode DefaultUni DefaultFun
forall (uni :: Type -> Type) fun. EmitterMode uni fun
Cek.logEmitter ((DeBruijn -> NamedDeBruijn)
-> Term DeBruijn DefaultUni DefaultFun ()
-> Term NamedDeBruijn DefaultUni DefaultFun ()
forall name name' (uni :: Type -> Type) fun ann.
(name -> name') -> Term name uni fun ann -> Term name' uni fun ann
UPLC.termMapNames DeBruijn -> NamedDeBruijn
UPLC.fakeNameDeBruijn Term DeBruijn DefaultUni DefaultFun ()
t) of
    Cek.CekReport CekResult NamedDeBruijn DefaultUni DefaultFun
res (Cek.CountingSt ExBudget
cost) [Text]
logs -> case CekResult NamedDeBruijn DefaultUni DefaultFun
res of
      Cek.CekFailure CekEvaluationException NamedDeBruijn DefaultUni DefaultFun
err -> (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun
-> Either
     (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun) Script
forall a b. a -> Either a b
Left CekEvaluationException NamedDeBruijn DefaultUni DefaultFun
err, ExBudget
cost, [Text]
logs)
      Cek.CekSuccessConstant Some @Type (ValueOf DefaultUni)
c -> (Script
-> Either
     (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun) Script
forall a b. b -> Either a b
Right (Script
 -> Either
      (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun)
      Script)
-> (Some @Type (ValueOf DefaultUni) -> Script)
-> Some @Type (ValueOf DefaultUni)
-> Either
     (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun) Script
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term DeBruijn DefaultUni DefaultFun () -> Script
toScript (Term DeBruijn DefaultUni DefaultFun () -> Script)
-> (Some @Type (ValueOf DefaultUni)
    -> Term DeBruijn DefaultUni DefaultFun ())
-> Some @Type (ValueOf DefaultUni)
-> Script
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ()
-> Some @Type (ValueOf DefaultUni)
-> Term DeBruijn DefaultUni DefaultFun ()
forall name (uni :: Type -> Type) fun ann.
ann -> Some @Type (ValueOf uni) -> Term name uni fun ann
UPLC.Constant () (Some @Type (ValueOf DefaultUni)
 -> Either
      (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun)
      Script)
-> Some @Type (ValueOf DefaultUni)
-> Either
     (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun) Script
forall a b. (a -> b) -> a -> b
$ Some @Type (ValueOf DefaultUni)
c, ExBudget
cost, [Text]
logs)
      Cek.CekSuccessNonConstant Term NamedDeBruijn DefaultUni DefaultFun ()
t -> (Script
-> Either
     (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun) Script
forall a b. b -> Either a b
Right (Script
 -> Either
      (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun)
      Script)
-> (Term NamedDeBruijn DefaultUni DefaultFun () -> Script)
-> Term NamedDeBruijn DefaultUni DefaultFun ()
-> Either
     (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun) Script
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term DeBruijn DefaultUni DefaultFun () -> Script
toScript (Term DeBruijn DefaultUni DefaultFun () -> Script)
-> (Term NamedDeBruijn DefaultUni DefaultFun ()
    -> Term DeBruijn DefaultUni DefaultFun ())
-> Term NamedDeBruijn DefaultUni DefaultFun ()
-> Script
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NamedDeBruijn -> DeBruijn)
-> Term NamedDeBruijn DefaultUni DefaultFun ()
-> Term DeBruijn DefaultUni DefaultFun ()
forall name name' (uni :: Type -> Type) fun ann.
(name -> name') -> Term name uni fun ann -> Term name' uni fun ann
UPLC.termMapNames NamedDeBruijn -> DeBruijn
UPLC.unNameDeBruijn (Term NamedDeBruijn DefaultUni DefaultFun ()
 -> Either
      (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun)
      Script)
-> Term NamedDeBruijn DefaultUni DefaultFun ()
-> Either
     (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun) Script
forall a b. (a -> b) -> a -> b
$ Term NamedDeBruijn DefaultUni DefaultFun ()
t, ExBudget
cost, [Text]
logs)
  where
    toScript :: Term UPLC.DeBruijn UPLC.DefaultUni UPLC.DefaultFun () -> Script
    toScript :: Term DeBruijn DefaultUni DefaultFun () -> Script
toScript = Program DeBruijn DefaultUni DefaultFun () -> Script
Script (Program DeBruijn DefaultUni DefaultFun () -> Script)
-> (Term DeBruijn DefaultUni DefaultFun ()
    -> Program DeBruijn DefaultUni DefaultFun ())
-> Term DeBruijn DefaultUni DefaultFun ()
-> Script
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ()
-> Version
-> Term DeBruijn DefaultUni DefaultFun ()
-> Program DeBruijn DefaultUni DefaultFun ()
forall name (uni :: Type -> Type) fun ann.
ann -> Version -> Term name uni fun ann -> Program name uni fun ann
Program () Version
uplcVersion

evalTerm ::
  ExBudget ->
  Term PLC.NamedDeBruijn PLC.DefaultUni PLC.DefaultFun () ->
  ( Either
      (Cek.CekEvaluationException PLC.NamedDeBruijn PLC.DefaultUni PLC.DefaultFun)
      (Term PLC.NamedDeBruijn PLC.DefaultUni PLC.DefaultFun ())
  , ExBudget
  , [Text]
  )
evalTerm :: ExBudget
-> Term NamedDeBruijn DefaultUni DefaultFun ()
-> (Either
      (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun)
      (Term NamedDeBruijn DefaultUni DefaultFun ()),
    ExBudget, [Text])
evalTerm ExBudget
budget Term NamedDeBruijn DefaultUni DefaultFun ()
t =
  case MachineParameters
  CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ())
-> ExBudgetMode RestrictingSt DefaultUni DefaultFun
-> EmitterMode DefaultUni DefaultFun
-> Term NamedDeBruijn DefaultUni DefaultFun ()
-> CekReport RestrictingSt NamedDeBruijn DefaultUni DefaultFun
forall (uni :: Type -> Type) fun ann cost.
ThrowableBuiltins uni fun =>
MachineParameters CekMachineCosts fun (CekValue uni fun ann)
-> ExBudgetMode cost uni fun
-> EmitterMode uni fun
-> NTerm uni fun ann
-> CekReport cost NamedDeBruijn uni fun
Cek.runCekDeBruijn MachineParameters
  CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ())
forall ann.
Typeable @Type ann =>
MachineParameters
  CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ann)
defaultCekParametersForTesting (ExRestrictingBudget
-> ExBudgetMode RestrictingSt DefaultUni DefaultFun
forall (uni :: Type -> Type) fun.
ThrowableBuiltins uni fun =>
ExRestrictingBudget -> ExBudgetMode RestrictingSt uni fun
Cek.restricting (ExBudget -> ExRestrictingBudget
ExRestrictingBudget ExBudget
budget)) EmitterMode DefaultUni DefaultFun
forall (uni :: Type -> Type) fun. EmitterMode uni fun
Cek.logEmitter Term NamedDeBruijn DefaultUni DefaultFun ()
t of
    Cek.CekReport CekResult NamedDeBruijn DefaultUni DefaultFun
res (Cek.RestrictingSt (ExRestrictingBudget ExBudget
cost)) [Text]
logs -> case CekResult NamedDeBruijn DefaultUni DefaultFun
res of
      Cek.CekFailure CekEvaluationException NamedDeBruijn DefaultUni DefaultFun
err -> (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun
-> Either
     (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun)
     (Term NamedDeBruijn DefaultUni DefaultFun ())
forall a b. a -> Either a b
Left CekEvaluationException NamedDeBruijn DefaultUni DefaultFun
err, ExBudget
budget ExBudget -> ExBudget -> ExBudget
`minusExBudget` ExBudget
cost, [Text]
logs)
      Cek.CekSuccessConstant Some @Type (ValueOf DefaultUni)
c -> (Term NamedDeBruijn DefaultUni DefaultFun ()
-> Either
     (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun)
     (Term NamedDeBruijn DefaultUni DefaultFun ())
forall a b. b -> Either a b
Right (Term NamedDeBruijn DefaultUni DefaultFun ()
 -> Either
      (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun)
      (Term NamedDeBruijn DefaultUni DefaultFun ()))
-> (Some @Type (ValueOf DefaultUni)
    -> Term NamedDeBruijn DefaultUni DefaultFun ())
-> Some @Type (ValueOf DefaultUni)
-> Either
     (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun)
     (Term NamedDeBruijn DefaultUni DefaultFun ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ()
-> Some @Type (ValueOf DefaultUni)
-> Term NamedDeBruijn DefaultUni DefaultFun ()
forall name (uni :: Type -> Type) fun ann.
ann -> Some @Type (ValueOf uni) -> Term name uni fun ann
UPLC.Constant () (Some @Type (ValueOf DefaultUni)
 -> Either
      (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun)
      (Term NamedDeBruijn DefaultUni DefaultFun ()))
-> Some @Type (ValueOf DefaultUni)
-> Either
     (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun)
     (Term NamedDeBruijn DefaultUni DefaultFun ())
forall a b. (a -> b) -> a -> b
$ Some @Type (ValueOf DefaultUni)
c, ExBudget
budget ExBudget -> ExBudget -> ExBudget
`minusExBudget` ExBudget
cost, [Text]
logs)
      Cek.CekSuccessNonConstant Term NamedDeBruijn DefaultUni DefaultFun ()
t -> (Term NamedDeBruijn DefaultUni DefaultFun ()
-> Either
     (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun)
     (Term NamedDeBruijn DefaultUni DefaultFun ())
forall a b. b -> Either a b
Right Term NamedDeBruijn DefaultUni DefaultFun ()
t, ExBudget
budget ExBudget -> ExBudget -> ExBudget
`minusExBudget` ExBudget
cost, [Text]
logs)