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

module Plutarch.Internal.Evaluate (uplcVersion, evalScript, evalScriptHuge, evalScriptUnlimited, evalScript', EvalError) 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

type EvalError = (Cek.CekEvaluationException PLC.NamedDeBruijn PLC.DefaultUni PLC.DefaultFun)

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

-- | Evaluate a script with a big budget, returning the trace log and term result.
evalScript :: Script -> (Either EvalError Script, ExBudget, [Text])
evalScript :: Script -> (Either EvalError Script, ExBudget, [Text])
evalScript = ExBudget -> Script -> (Either EvalError 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 EvalError Script, ExBudget, [Text])
evalScriptHuge :: Script -> (Either EvalError Script, ExBudget, [Text])
evalScriptHuge = ExBudget -> Script -> (Either EvalError 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 EvalError Script, ExBudget, [Text])
evalScript' ExBudget
budget (Script (Program ()
_ Version
_ Term DeBruijn DefaultUni DefaultFun ()
t)) = case ExBudget
-> Term NamedDeBruijn DefaultUni DefaultFun ()
-> (Either EvalError (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 EvalError (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 EvalError (Term NamedDeBruijn DefaultUni DefaultFun ())
-> Either EvalError Script
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Either EvalError (Term NamedDeBruijn DefaultUni DefaultFun ())
res, ExBudget
remaining, [Text]
logs)

{- | Evaluate a script without budget limit

@since WIP
-}
evalScriptUnlimited :: Script -> (Either (Cek.CekEvaluationException PLC.NamedDeBruijn PLC.DefaultUni PLC.DefaultFun) Script, ExBudget, [Text])
evalScriptUnlimited :: Script -> (Either EvalError 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 ()
-> (Either EvalError (Term NamedDeBruijn DefaultUni DefaultFun ()),
    CountingSt, [Text])
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
-> (Either
      (CekEvaluationException NamedDeBruijn uni fun) (NTerm uni fun ()),
    cost, [Text])
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
    (Either EvalError (Term NamedDeBruijn DefaultUni DefaultFun ())
errOrRes, Cek.CountingSt ExBudget
final, [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 EvalError (Term NamedDeBruijn DefaultUni DefaultFun ())
-> Either EvalError Script
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Either EvalError (Term NamedDeBruijn DefaultUni DefaultFun ())
errOrRes, ExBudget
final, [Text]
logs)

evalTerm ::
  ExBudget ->
  Term PLC.NamedDeBruijn PLC.DefaultUni PLC.DefaultFun () ->
  ( Either
      EvalError
      (Term PLC.NamedDeBruijn PLC.DefaultUni PLC.DefaultFun ())
  , ExBudget
  , [Text]
  )
evalTerm :: ExBudget
-> Term NamedDeBruijn DefaultUni DefaultFun ()
-> (Either EvalError (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 ()
-> (Either EvalError (Term NamedDeBruijn DefaultUni DefaultFun ()),
    RestrictingSt, [Text])
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
-> (Either
      (CekEvaluationException NamedDeBruijn uni fun) (NTerm uni fun ()),
    cost, [Text])
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
    (Either EvalError (Term NamedDeBruijn DefaultUni DefaultFun ())
errOrRes, Cek.RestrictingSt (ExRestrictingBudget ExBudget
final), [Text]
logs) -> (Either EvalError (Term NamedDeBruijn DefaultUni DefaultFun ())
errOrRes, ExBudget
budget ExBudget -> ExBudget -> ExBudget
`minusExBudget` ExBudget
final, [Text]
logs)