-- editorconfig-checker-disable-file
{-# LANGUAGE TypeApplications #-}
-- | This module contains example values to be used for testing. These should NOT be used in non-test code!
module PlutusLedgerApi.Test.Examples where

import PlutusCore qualified as PLC
import PlutusCore.MkPlc qualified as PLC
import PlutusCore.Version qualified as PLC
import PlutusLedgerApi.V1
import UntypedPlutusCore qualified as UPLC

import Numeric.Natural
import Universe (Some (Some))

{- Note [Manually constructing scripts]
The scripts we provide here are *manually* constructed Plutus Core. Why not use our great machinery for easily creating
scripts with Plutus Tx? Because Plutus Tx relies on a compiler plugin, and so is always going to be a bit finicky to user.
It seems better therefore to avoid depending on Plutus Tx in any "core" projects like the ledger.
-}

-- | Creates a script which has N arguments, and always succeeds.
alwaysSucceedingNAryFunction :: Natural -> SerialisedScript
alwaysSucceedingNAryFunction :: Natural -> SerialisedScript
alwaysSucceedingNAryFunction Natural
n = Program DeBruijn DefaultUni DefaultFun () -> SerialisedScript
serialiseUPLC (Program DeBruijn DefaultUni DefaultFun () -> SerialisedScript)
-> Program DeBruijn DefaultUni DefaultFun () -> SerialisedScript
forall a b. (a -> b) -> a -> b
$ ()
-> Version
-> Term DeBruijn DefaultUni DefaultFun ()
-> Program DeBruijn DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun ann.
ann -> Version -> Term name uni fun ann -> Program name uni fun ann
UPLC.Program () Version
PLC.plcVersion100 (Natural -> Term DeBruijn DefaultUni DefaultFun ()
forall {t} {uni :: * -> *} {fun}.
(Eq t, Num t) =>
t -> Term DeBruijn uni fun ()
body Natural
n)
    where
        -- No more arguments! The body can be anything that doesn't fail, so we return `\x . x`
        body :: t -> Term DeBruijn uni fun ()
body t
i | t
i t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 = ()
-> DeBruijn -> Term DeBruijn uni fun () -> Term DeBruijn uni fun ()
forall name (uni :: * -> *) fun ann.
ann -> name -> Term name uni fun ann -> Term name uni fun ann
UPLC.LamAbs() (Index -> DeBruijn
UPLC.DeBruijn Index
0) (Term DeBruijn uni fun () -> Term DeBruijn uni fun ())
-> Term DeBruijn uni fun () -> Term DeBruijn uni fun ()
forall a b. (a -> b) -> a -> b
$ () -> DeBruijn -> Term DeBruijn uni fun ()
forall name (uni :: * -> *) fun ann.
ann -> name -> Term name uni fun ann
UPLC.Var () (Index -> DeBruijn
UPLC.DeBruijn Index
1)
        -- We're using de Bruijn indices, so we can use the same binder each time!
        body t
i = ()
-> DeBruijn -> Term DeBruijn uni fun () -> Term DeBruijn uni fun ()
forall name (uni :: * -> *) fun ann.
ann -> name -> Term name uni fun ann -> Term name uni fun ann
UPLC.LamAbs () (Index -> DeBruijn
UPLC.DeBruijn Index
0) (Term DeBruijn uni fun () -> Term DeBruijn uni fun ())
-> Term DeBruijn uni fun () -> Term DeBruijn uni fun ()
forall a b. (a -> b) -> a -> b
$ t -> Term DeBruijn uni fun ()
body (t
it -> t -> t
forall a. Num a => a -> a -> a
-t
1)

-- | Creates a script which has N arguments, and always fails.
alwaysFailingNAryFunction :: Natural -> SerialisedScript
alwaysFailingNAryFunction :: Natural -> SerialisedScript
alwaysFailingNAryFunction Natural
n = Program DeBruijn DefaultUni DefaultFun () -> SerialisedScript
serialiseUPLC (Program DeBruijn DefaultUni DefaultFun () -> SerialisedScript)
-> Program DeBruijn DefaultUni DefaultFun () -> SerialisedScript
forall a b. (a -> b) -> a -> b
$ ()
-> Version
-> Term DeBruijn DefaultUni DefaultFun ()
-> Program DeBruijn DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun ann.
ann -> Version -> Term name uni fun ann -> Program name uni fun ann
UPLC.Program () Version
PLC.plcVersion100 (Natural -> Term DeBruijn DefaultUni DefaultFun ()
forall {t} {uni :: * -> *} {fun}.
(Eq t, Num t) =>
t -> Term DeBruijn uni fun ()
body Natural
n)
    where
        -- No more arguments! The body should be error.
        body :: t -> Term DeBruijn uni fun ()
body t
i | t
i t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 = () -> Term DeBruijn uni fun ()
forall name (uni :: * -> *) fun ann. ann -> Term name uni fun ann
UPLC.Error ()
        -- We're using de Bruijn indices, so we can use the same binder each time!
        body t
i = ()
-> DeBruijn -> Term DeBruijn uni fun () -> Term DeBruijn uni fun ()
forall name (uni :: * -> *) fun ann.
ann -> name -> Term name uni fun ann -> Term name uni fun ann
UPLC.LamAbs () (Index -> DeBruijn
UPLC.DeBruijn Index
0) (Term DeBruijn uni fun () -> Term DeBruijn uni fun ())
-> Term DeBruijn uni fun () -> Term DeBruijn uni fun ()
forall a b. (a -> b) -> a -> b
$ t -> Term DeBruijn uni fun ()
body (t
it -> t -> t
forall a. Num a => a -> a -> a
-t
1)

summingFunction :: SerialisedScript
summingFunction :: SerialisedScript
summingFunction = Program DeBruijn DefaultUni DefaultFun () -> SerialisedScript
serialiseUPLC (Program DeBruijn DefaultUni DefaultFun () -> SerialisedScript)
-> Program DeBruijn DefaultUni DefaultFun () -> SerialisedScript
forall a b. (a -> b) -> a -> b
$ ()
-> Version
-> Term DeBruijn DefaultUni DefaultFun ()
-> Program DeBruijn DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun ann.
ann -> Version -> Term name uni fun ann -> Program name uni fun ann
UPLC.Program () Version
PLC.plcVersion100 Term DeBruijn DefaultUni DefaultFun ()
forall {name}. Term name DefaultUni DefaultFun ()
body
    where
        body :: Term name DefaultUni DefaultFun ()
body = ()
-> Term name DefaultUni DefaultFun ()
-> Term name DefaultUni DefaultFun ()
-> Term name DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun ann.
ann
-> Term name uni fun ann
-> Term name uni fun ann
-> Term name uni fun ann
UPLC.Apply () (()
-> Term name DefaultUni DefaultFun ()
-> Term name DefaultUni DefaultFun ()
-> Term name DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun ann.
ann
-> Term name uni fun ann
-> Term name uni fun ann
-> Term name uni fun ann
UPLC.Apply () (() -> DefaultFun -> Term name DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun ann.
ann -> fun -> Term name uni fun ann
UPLC.Builtin () DefaultFun
PLC.AddInteger) (forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
PLC.mkConstant @Integer () Integer
1)) (forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
PLC.mkConstant @Integer () Integer
2)

-- | Wrap a script with lambda/app so that, for instance, it has a different hash but the same behavior.
saltFunction :: Integer -> SerialisedScript -> SerialisedScript
saltFunction :: Integer -> SerialisedScript -> SerialisedScript
saltFunction Integer
salt SerialisedScript
b0 = Program DeBruijn DefaultUni DefaultFun () -> SerialisedScript
serialiseUPLC (Program DeBruijn DefaultUni DefaultFun () -> SerialisedScript)
-> Program DeBruijn DefaultUni DefaultFun () -> SerialisedScript
forall a b. (a -> b) -> a -> b
$ ()
-> Version
-> Term DeBruijn DefaultUni DefaultFun ()
-> Program DeBruijn DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun ann.
ann -> Version -> Term name uni fun ann -> Program name uni fun ann
UPLC.Program () Version
version Term DeBruijn DefaultUni DefaultFun ()
body
    where
        UPLC.Program () Version
version Term DeBruijn DefaultUni DefaultFun ()
b1 = SerialisedScript -> Program DeBruijn DefaultUni DefaultFun ()
uncheckedDeserialiseUPLC SerialisedScript
b0

        body :: Term DeBruijn DefaultUni DefaultFun ()
body = ()
-> Term DeBruijn DefaultUni DefaultFun ()
-> Term DeBruijn DefaultUni DefaultFun ()
-> Term DeBruijn DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun ann.
ann
-> Term name uni fun ann
-> Term name uni fun ann
-> Term name uni fun ann
UPLC.Apply ()
            (()
-> DeBruijn
-> Term DeBruijn DefaultUni DefaultFun ()
-> Term DeBruijn DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun ann.
ann -> name -> Term name uni fun ann -> Term name uni fun ann
UPLC.LamAbs () (Index -> DeBruijn
UPLC.DeBruijn Index
0) Term DeBruijn DefaultUni DefaultFun ()
b1)
            (()
-> Some (ValueOf DefaultUni)
-> Term DeBruijn DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun ann.
ann -> Some (ValueOf uni) -> Term name uni fun ann
UPLC.Constant () (Some (ValueOf DefaultUni)
 -> Term DeBruijn DefaultUni DefaultFun ())
-> Some (ValueOf DefaultUni)
-> Term DeBruijn DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ ValueOf DefaultUni Integer -> Some (ValueOf DefaultUni)
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some (ValueOf DefaultUni Integer -> Some (ValueOf DefaultUni))
-> ValueOf DefaultUni Integer -> Some (ValueOf DefaultUni)
forall a b. (a -> b) -> a -> b
$ DefaultUni (Esc Integer) -> Integer -> ValueOf DefaultUni Integer
forall (uni :: * -> *) a. uni (Esc a) -> a -> ValueOf uni a
PLC.ValueOf DefaultUni (Esc Integer)
PLC.DefaultUniInteger Integer
salt)

integerToByteStringFunction :: SerialisedScript
integerToByteStringFunction :: SerialisedScript
integerToByteStringFunction = Program DeBruijn DefaultUni DefaultFun () -> SerialisedScript
serialiseUPLC (Program DeBruijn DefaultUni DefaultFun () -> SerialisedScript)
-> Program DeBruijn DefaultUni DefaultFun () -> SerialisedScript
forall a b. (a -> b) -> a -> b
$ ()
-> Version
-> Term DeBruijn DefaultUni DefaultFun ()
-> Program DeBruijn DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun ann.
ann -> Version -> Term name uni fun ann -> Program name uni fun ann
UPLC.Program () Version
PLC.plcVersion110 Term DeBruijn DefaultUni DefaultFun ()
body
  where
    body :: Term DeBruijn DefaultUni DefaultFun ()
body =
      -- This is run as a Plutus V3 script, so it must return BuiltinUnit
      ()
-> DeBruijn
-> Term DeBruijn DefaultUni DefaultFun ()
-> Term DeBruijn DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun ann.
ann -> name -> Term name uni fun ann -> Term name uni fun ann
UPLC.LamAbs () (Index -> DeBruijn
UPLC.DeBruijn Index
0) (Term DeBruijn DefaultUni DefaultFun ()
 -> Term DeBruijn DefaultUni DefaultFun ())
-> Term DeBruijn DefaultUni DefaultFun ()
-> Term DeBruijn DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$
        ()
-> Term DeBruijn DefaultUni DefaultFun ()
-> Term DeBruijn DefaultUni DefaultFun ()
-> Term DeBruijn DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun ann.
ann
-> Term name uni fun ann
-> Term name uni fun ann
-> Term name uni fun ann
UPLC.Apply
          ()
          (()
-> DeBruijn
-> Term DeBruijn DefaultUni DefaultFun ()
-> Term DeBruijn DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun ann.
ann -> name -> Term name uni fun ann -> Term name uni fun ann
UPLC.LamAbs () (Index -> DeBruijn
UPLC.DeBruijn Index
0) (() -> () -> Term DeBruijn DefaultUni DefaultFun ()
forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
PLC.mkConstant () ()))
          ( Term DeBruijn DefaultUni DefaultFun ()
-> [Term DeBruijn DefaultUni DefaultFun ()]
-> Term DeBruijn DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
TermLike term tyname name uni fun =>
term () -> [term ()] -> term ()
PLC.mkIterAppNoAnn
              (() -> DefaultFun -> Term DeBruijn DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun ann.
ann -> fun -> Term name uni fun ann
UPLC.Builtin () DefaultFun
PLC.IntegerToByteString)
              [ forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
PLC.mkConstant @Bool () Bool
False
              , forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
PLC.mkConstant @Integer () Integer
5
              , forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
PLC.mkConstant @Integer () Integer
1
              ]
          )