{-# LANGUAGE TypeApplications #-}
{-|
This module contains example values to be used for testing. These should NOT be used in non-test code!
-}
module Plutus.V1.Ledger.Examples (alwaysSucceedingNAryFunction, alwaysFailingNAryFunction, summingFunction, saltFunction) where

import Codec.Serialise
import Data.ByteString.Lazy (fromStrict, toStrict)
import Data.ByteString.Short
import Numeric.Natural
import Plutus.V1.Ledger.Api
import Plutus.V1.Ledger.Scripts qualified as Scripts
import PlutusCore qualified as PLC
import PlutusCore.MkPlc qualified as PLC
import Universe (Some (Some))
import UntypedPlutusCore qualified as UPLC

{- 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 -> SerializedScript
alwaysSucceedingNAryFunction :: Natural -> SerializedScript
alwaysSucceedingNAryFunction Natural
n = ByteString -> SerializedScript
toShort (ByteString -> SerializedScript) -> ByteString -> SerializedScript
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Script -> ByteString
forall a. Serialise a => a -> ByteString
serialise (Script -> ByteString) -> Script -> ByteString
forall a b. (a -> b) -> a -> b
$ Program DeBruijn DefaultUni DefaultFun () -> Script
Scripts.Script (Program DeBruijn DefaultUni DefaultFun () -> Script)
-> Program DeBruijn DefaultUni DefaultFun () -> Script
forall a b. (a -> b) -> a -> b
$ ()
-> Version ()
-> Term DeBruijn DefaultUni DefaultFun ()
-> Program DeBruijn DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun ann.
ann
-> Version ann -> Term name uni fun ann -> Program name uni fun ann
UPLC.Program () (() -> Version ()
forall ann. ann -> Version ann
PLC.defaultVersion ()) (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 -> SerializedScript
alwaysFailingNAryFunction :: Natural -> SerializedScript
alwaysFailingNAryFunction Natural
n = ByteString -> SerializedScript
toShort (ByteString -> SerializedScript) -> ByteString -> SerializedScript
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Script -> ByteString
forall a. Serialise a => a -> ByteString
serialise (Script -> ByteString) -> Script -> ByteString
forall a b. (a -> b) -> a -> b
$ Program DeBruijn DefaultUni DefaultFun () -> Script
Scripts.Script (Program DeBruijn DefaultUni DefaultFun () -> Script)
-> Program DeBruijn DefaultUni DefaultFun () -> Script
forall a b. (a -> b) -> a -> b
$ ()
-> Version ()
-> Term DeBruijn DefaultUni DefaultFun ()
-> Program DeBruijn DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun ann.
ann
-> Version ann -> Term name uni fun ann -> Program name uni fun ann
UPLC.Program () (() -> Version ()
forall ann. ann -> Version ann
PLC.defaultVersion ()) (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 :: SerializedScript
summingFunction :: SerializedScript
summingFunction = ByteString -> SerializedScript
toShort (ByteString -> SerializedScript) -> ByteString -> SerializedScript
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Script -> ByteString
forall a. Serialise a => a -> ByteString
serialise (Script -> ByteString) -> Script -> ByteString
forall a b. (a -> b) -> a -> b
$ Program DeBruijn DefaultUni DefaultFun () -> Script
Scripts.Script (Program DeBruijn DefaultUni DefaultFun () -> Script)
-> Program DeBruijn DefaultUni DefaultFun () -> Script
forall a b. (a -> b) -> a -> b
$ ()
-> Version ()
-> Term DeBruijn DefaultUni DefaultFun ()
-> Program DeBruijn DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun ann.
ann
-> Version ann -> Term name uni fun ann -> Program name uni fun ann
UPLC.Program () (() -> Version ()
forall ann. ann -> Version ann
PLC.defaultVersion ()) 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) (() -> Integer -> Term name DefaultUni DefaultFun ()
forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, Includes uni a) =>
ann -> a -> term ann
PLC.mkConstant @Integer () Integer
1)) (() -> Integer -> Term name DefaultUni DefaultFun ()
forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, Includes 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 -> SerializedScript -> SerializedScript
saltFunction :: Integer -> SerializedScript -> SerializedScript
saltFunction Integer
salt SerializedScript
b0 = ByteString -> SerializedScript
toShort (ByteString -> SerializedScript) -> ByteString -> SerializedScript
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Script -> ByteString
forall a. Serialise a => a -> ByteString
serialise (Script -> ByteString) -> Script -> ByteString
forall a b. (a -> b) -> a -> b
$ Program DeBruijn DefaultUni DefaultFun () -> Script
Scripts.Script (Program DeBruijn DefaultUni DefaultFun () -> Script)
-> Program DeBruijn DefaultUni DefaultFun () -> Script
forall a b. (a -> b) -> a -> b
$ ()
-> Version ()
-> Term DeBruijn DefaultUni DefaultFun ()
-> Program DeBruijn DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun ann.
ann
-> Version ann -> Term name uni fun ann -> Program name uni fun ann
UPLC.Program () Version ()
version Term DeBruijn DefaultUni DefaultFun ()
body
    where
        Scripts.Script (UPLC.Program () Version ()
version Term DeBruijn DefaultUni DefaultFun ()
b1) = ByteString -> Script
forall a. Serialise a => ByteString -> a
deserialise (ByteString -> Script) -> ByteString -> Script
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ SerializedScript -> ByteString
fromShort SerializedScript
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)