{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TupleSections #-} module PlutusTx.Test.Run.Uplc where import Prelude import Control.Exception (SomeException (..)) import Control.Lens ((^.)) import Control.Monad.Except (ExceptT, MonadError (throwError)) import Data.Either.Extras (fromRightM) import Data.Text (Text) import PlutusCore (DefaultFun, DefaultUni) import PlutusCore qualified as PLC import PlutusCore.Evaluation.Machine.ExBudget qualified as PLC import PlutusCore.Evaluation.Machine.ExBudgetingDefaults qualified as PLC import PlutusCore.Test (ToUPlc (..)) import PlutusIR.Test () import PlutusTx.Test.Orphans () import Test.Tasty.Extras () import UntypedPlutusCore qualified as UPLC import UntypedPlutusCore.Evaluation.Machine.Cek qualified as UPLC type Term = UPLC.Term PLC.Name DefaultUni DefaultFun () runPlcCek :: (ToUPlc a PLC.DefaultUni PLC.DefaultFun) => a -> ExceptT SomeException IO (UPLC.Term PLC.Name PLC.DefaultUni PLC.DefaultFun ()) runPlcCek :: forall a. ToUPlc a DefaultUni DefaultFun => a -> ExceptT SomeException IO (Term Name DefaultUni DefaultFun ()) runPlcCek a val = do Program Name DefaultUni DefaultFun () term <- a -> ExceptT SomeException IO (Program Name DefaultUni DefaultFun ()) forall a (uni :: * -> *) fun. ToUPlc a uni fun => a -> ExceptT SomeException IO (Program Name uni fun ()) toUPlc a val (CekEvaluationException Name DefaultUni DefaultFun -> ExceptT SomeException IO (Term Name DefaultUni DefaultFun ())) -> Either (CekEvaluationException Name DefaultUni DefaultFun) (Term Name DefaultUni DefaultFun ()) -> ExceptT SomeException IO (Term Name DefaultUni DefaultFun ()) forall (m :: * -> *) a b. Monad m => (a -> m b) -> Either a b -> m b fromRightM (SomeException -> ExceptT SomeException IO (Term Name DefaultUni DefaultFun ()) forall a. SomeException -> ExceptT SomeException IO a forall e (m :: * -> *) a. MonadError e m => e -> m a throwError (SomeException -> ExceptT SomeException IO (Term Name DefaultUni DefaultFun ())) -> (CekEvaluationException Name DefaultUni DefaultFun -> SomeException) -> CekEvaluationException Name DefaultUni DefaultFun -> ExceptT SomeException IO (Term Name DefaultUni DefaultFun ()) forall b c a. (b -> c) -> (a -> b) -> a -> c . CekEvaluationException Name DefaultUni DefaultFun -> SomeException forall e. Exception e => e -> SomeException SomeException) (Either (CekEvaluationException Name DefaultUni DefaultFun) (Term Name DefaultUni DefaultFun ()) -> ExceptT SomeException IO (Term Name DefaultUni DefaultFun ())) -> Either (CekEvaluationException Name DefaultUni DefaultFun) (Term Name DefaultUni DefaultFun ()) -> ExceptT SomeException IO (Term Name DefaultUni DefaultFun ()) forall a b. (a -> b) -> a -> b $ MachineParameters CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ()) -> Term Name DefaultUni DefaultFun () -> Either (CekEvaluationException Name DefaultUni DefaultFun) (Term Name DefaultUni DefaultFun ()) forall (uni :: * -> *) fun ann. ThrowableBuiltins uni fun => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> Term Name uni fun ann -> Either (CekEvaluationException Name uni fun) (Term Name uni fun ()) UPLC.evaluateCekNoEmit MachineParameters CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ()) forall ann. Typeable ann => MachineParameters CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ann) PLC.defaultCekParametersForTesting (Program Name DefaultUni DefaultFun () term Program Name DefaultUni DefaultFun () -> Getting (Term Name DefaultUni DefaultFun ()) (Program Name DefaultUni DefaultFun ()) (Term Name DefaultUni DefaultFun ()) -> Term Name DefaultUni DefaultFun () forall s a. s -> Getting a s a -> a ^. Getting (Term Name DefaultUni DefaultFun ()) (Program Name DefaultUni DefaultFun ()) (Term Name DefaultUni DefaultFun ()) forall name1 (uni1 :: * -> *) fun1 ann name2 (uni2 :: * -> *) fun2 (f :: * -> *). Functor f => (Term name1 uni1 fun1 ann -> f (Term name2 uni2 fun2 ann)) -> Program name1 uni1 fun1 ann -> f (Program name2 uni2 fun2 ann) UPLC.progTerm) runPlcCekTrace :: (ToUPlc a PLC.DefaultUni PLC.DefaultFun) => a -> ExceptT SomeException IO ( [Text] , UPLC.CekExTally PLC.DefaultFun , UPLC.Term PLC.Name PLC.DefaultUni PLC.DefaultFun () ) runPlcCekTrace :: forall a. ToUPlc a DefaultUni DefaultFun => a -> ExceptT SomeException IO ([Text], CekExTally DefaultFun, Term Name DefaultUni DefaultFun ()) runPlcCekTrace a value = do Program Name DefaultUni DefaultFun () term <- a -> ExceptT SomeException IO (Program Name DefaultUni DefaultFun ()) forall a (uni :: * -> *) fun. ToUPlc a uni fun => a -> ExceptT SomeException IO (Program Name uni fun ()) toUPlc a value let (Either (CekEvaluationException Name DefaultUni DefaultFun) (Term Name DefaultUni DefaultFun ()) result, UPLC.TallyingSt CekExTally DefaultFun tally ExBudget _, [Text] logOut) = MachineParameters CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ()) -> ExBudgetMode (TallyingSt DefaultFun) DefaultUni DefaultFun -> EmitterMode DefaultUni DefaultFun -> Term Name DefaultUni DefaultFun () -> (Either (CekEvaluationException Name DefaultUni DefaultFun) (Term Name DefaultUni DefaultFun ()), TallyingSt DefaultFun, [Text]) forall (uni :: * -> *) fun ann cost. ThrowableBuiltins uni fun => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> ExBudgetMode cost uni fun -> EmitterMode uni fun -> Term Name uni fun ann -> (Either (CekEvaluationException Name uni fun) (Term Name uni fun ()), cost, [Text]) UPLC.runCek MachineParameters CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ()) forall ann. Typeable ann => MachineParameters CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ann) PLC.defaultCekParametersForTesting ExBudgetMode (TallyingSt DefaultFun) DefaultUni DefaultFun forall fun (uni :: * -> *). Hashable fun => ExBudgetMode (TallyingSt fun) uni fun UPLC.tallying EmitterMode DefaultUni DefaultFun forall (uni :: * -> *) fun. EmitterMode uni fun UPLC.logEmitter (Program Name DefaultUni DefaultFun () term Program Name DefaultUni DefaultFun () -> Getting (Term Name DefaultUni DefaultFun ()) (Program Name DefaultUni DefaultFun ()) (Term Name DefaultUni DefaultFun ()) -> Term Name DefaultUni DefaultFun () forall s a. s -> Getting a s a -> a ^. Getting (Term Name DefaultUni DefaultFun ()) (Program Name DefaultUni DefaultFun ()) (Term Name DefaultUni DefaultFun ()) forall name1 (uni1 :: * -> *) fun1 ann name2 (uni2 :: * -> *) fun2 (f :: * -> *). Functor f => (Term name1 uni1 fun1 ann -> f (Term name2 uni2 fun2 ann)) -> Program name1 uni1 fun1 ann -> f (Program name2 uni2 fun2 ann) UPLC.progTerm) Term Name DefaultUni DefaultFun () res <- (CekEvaluationException Name DefaultUni DefaultFun -> ExceptT SomeException IO (Term Name DefaultUni DefaultFun ())) -> Either (CekEvaluationException Name DefaultUni DefaultFun) (Term Name DefaultUni DefaultFun ()) -> ExceptT SomeException IO (Term Name DefaultUni DefaultFun ()) forall (m :: * -> *) a b. Monad m => (a -> m b) -> Either a b -> m b fromRightM (SomeException -> ExceptT SomeException IO (Term Name DefaultUni DefaultFun ()) forall a. SomeException -> ExceptT SomeException IO a forall e (m :: * -> *) a. MonadError e m => e -> m a throwError (SomeException -> ExceptT SomeException IO (Term Name DefaultUni DefaultFun ())) -> (CekEvaluationException Name DefaultUni DefaultFun -> SomeException) -> CekEvaluationException Name DefaultUni DefaultFun -> ExceptT SomeException IO (Term Name DefaultUni DefaultFun ()) forall b c a. (b -> c) -> (a -> b) -> a -> c . CekEvaluationException Name DefaultUni DefaultFun -> SomeException forall e. Exception e => e -> SomeException SomeException) Either (CekEvaluationException Name DefaultUni DefaultFun) (Term Name DefaultUni DefaultFun ()) result ([Text], CekExTally DefaultFun, Term Name DefaultUni DefaultFun ()) -> ExceptT SomeException IO ([Text], CekExTally DefaultFun, Term Name DefaultUni DefaultFun ()) forall a. a -> ExceptT SomeException IO a forall (f :: * -> *) a. Applicative f => a -> f a pure ([Text] logOut, CekExTally DefaultFun tally, Term Name DefaultUni DefaultFun () res) runPlcCekBudget :: (ToUPlc a PLC.DefaultUni PLC.DefaultFun) => a -> ExceptT SomeException IO (UPLC.Term PLC.Name PLC.DefaultUni PLC.DefaultFun (), PLC.ExBudget) runPlcCekBudget :: forall a. ToUPlc a DefaultUni DefaultFun => a -> ExceptT SomeException IO (Term Name DefaultUni DefaultFun (), ExBudget) runPlcCekBudget a val = do Program Name DefaultUni DefaultFun () term <- a -> ExceptT SomeException IO (Program Name DefaultUni DefaultFun ()) forall a (uni :: * -> *) fun. ToUPlc a uni fun => a -> ExceptT SomeException IO (Program Name uni fun ()) toUPlc a val (CekEvaluationException Name DefaultUni DefaultFun -> ExceptT SomeException IO (Term Name DefaultUni DefaultFun (), ExBudget)) -> Either (CekEvaluationException Name DefaultUni DefaultFun) (Term Name DefaultUni DefaultFun (), ExBudget) -> ExceptT SomeException IO (Term Name DefaultUni DefaultFun (), ExBudget) forall (m :: * -> *) a b. Monad m => (a -> m b) -> Either a b -> m b fromRightM (SomeException -> ExceptT SomeException IO (Term Name DefaultUni DefaultFun (), ExBudget) forall a. SomeException -> ExceptT SomeException IO a forall e (m :: * -> *) a. MonadError e m => e -> m a throwError (SomeException -> ExceptT SomeException IO (Term Name DefaultUni DefaultFun (), ExBudget)) -> (CekEvaluationException Name DefaultUni DefaultFun -> SomeException) -> CekEvaluationException Name DefaultUni DefaultFun -> ExceptT SomeException IO (Term Name DefaultUni DefaultFun (), ExBudget) forall b c a. (b -> c) -> (a -> b) -> a -> c . CekEvaluationException Name DefaultUni DefaultFun -> SomeException forall e. Exception e => e -> SomeException SomeException) (Either (CekEvaluationException Name DefaultUni DefaultFun) (Term Name DefaultUni DefaultFun (), ExBudget) -> ExceptT SomeException IO (Term Name DefaultUni DefaultFun (), ExBudget)) -> Either (CekEvaluationException Name DefaultUni DefaultFun) (Term Name DefaultUni DefaultFun (), ExBudget) -> ExceptT SomeException IO (Term Name DefaultUni DefaultFun (), ExBudget) forall a b. (a -> b) -> a -> b $ do let (Either (CekEvaluationException Name DefaultUni DefaultFun) (Term Name DefaultUni DefaultFun ()) evalRes, UPLC.CountingSt ExBudget budget) = MachineParameters CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ()) -> ExBudgetMode CountingSt DefaultUni DefaultFun -> Term Name DefaultUni DefaultFun () -> (Either (CekEvaluationException Name DefaultUni DefaultFun) (Term Name DefaultUni DefaultFun ()), CountingSt) forall (uni :: * -> *) fun ann cost. ThrowableBuiltins uni fun => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> ExBudgetMode cost uni fun -> Term Name uni fun ann -> (Either (CekEvaluationException Name uni fun) (Term Name uni fun ()), cost) UPLC.runCekNoEmit MachineParameters CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ()) forall ann. Typeable ann => MachineParameters CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ann) PLC.defaultCekParametersForTesting ExBudgetMode CountingSt DefaultUni DefaultFun forall (uni :: * -> *) fun. ExBudgetMode CountingSt uni fun UPLC.counting (Program Name DefaultUni DefaultFun () term Program Name DefaultUni DefaultFun () -> Getting (Term Name DefaultUni DefaultFun ()) (Program Name DefaultUni DefaultFun ()) (Term Name DefaultUni DefaultFun ()) -> Term Name DefaultUni DefaultFun () forall s a. s -> Getting a s a -> a ^. Getting (Term Name DefaultUni DefaultFun ()) (Program Name DefaultUni DefaultFun ()) (Term Name DefaultUni DefaultFun ()) forall name1 (uni1 :: * -> *) fun1 ann name2 (uni2 :: * -> *) fun2 (f :: * -> *). Functor f => (Term name1 uni1 fun1 ann -> f (Term name2 uni2 fun2 ann)) -> Program name1 uni1 fun1 ann -> f (Program name2 uni2 fun2 ann) UPLC.progTerm) (,ExBudget budget) (Term Name DefaultUni DefaultFun () -> (Term Name DefaultUni DefaultFun (), ExBudget)) -> Either (CekEvaluationException Name DefaultUni DefaultFun) (Term Name DefaultUni DefaultFun ()) -> Either (CekEvaluationException Name DefaultUni DefaultFun) (Term Name DefaultUni DefaultFun (), ExBudget) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Either (CekEvaluationException Name DefaultUni DefaultFun) (Term Name DefaultUni DefaultFun ()) evalRes