RawUPLC + Validators

src/Cooked/RawUPLC.hs

@@ -1,17 +1,19 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TemplateHaskell #-}
 
 -- | Provides functions to create instances of 'TypedValidator' from a
 --  UPLC program (either as a ShortByteString -- or its alias
---  SerialisedScript, or a CompiledCode). The "unsafe" refers to the
+--  SerialisedScript, or a Code). The "unsafe" refers to the
 --  use of 'unsafeCoerce' to cast a @TypedValidator Any@ into a
 --  suitable type using a @-XTypeApplications@. The programmer is
 --  responsible for ensuring that the type variable @a@ gets
 --  instantiated to the correct type.
 module Cooked.RawUPLC
   ( typedValidatorFromBS,
-    typedValidatorFromCompiledCode,
+    typedValidatorFromCode,
     unsafeTypedValidatorFromBS,
-    unsafeTypedValidatorFromCompiledCode,
+    unsafeTypedValidatorFromCode,
   )
 where
 
@@ -24,11 +26,11 @@ import Unsafe.Coerce
 unsafeTypedValidatorFromBS :: forall a. Pl.SerialisedScript -> Pl.TypedValidator a
 unsafeTypedValidatorFromBS = unsafeCoerce . typedValidatorFromBS
 
-unsafeTypedValidatorFromCompiledCode :: forall a. Pl.CompiledCode (Pl.BuiltinData -> Pl.BuiltinData -> Pl.BuiltinData -> ()) -> Pl.TypedValidator a
-unsafeTypedValidatorFromCompiledCode = unsafeCoerce . typedValidatorFromCompiledCode
+unsafeTypedValidatorFromCode :: forall a. (Pl.BuiltinData -> Pl.BuiltinData -> Pl.BuiltinData -> ()) -> Pl.TypedValidator a
+unsafeTypedValidatorFromCode = unsafeCoerce . typedValidatorFromCode
 
 typedValidatorFromBS :: Pl.SerialisedScript -> Pl.TypedValidator Pl.Any
 typedValidatorFromBS = Pl.unsafeMkTypedValidator . flip Pl.Versioned Pl.PlutusV3 . Pl.Validator . Pl.Script
 
-typedValidatorFromCompiledCode :: Pl.CompiledCode (Pl.BuiltinData -> Pl.BuiltinData -> Pl.BuiltinData -> ()) -> Pl.TypedValidator Pl.Any
-typedValidatorFromCompiledCode = typedValidatorFromBS . Pl.serialiseCompiledCode
+typedValidatorFromCode :: (Pl.BuiltinData -> Pl.BuiltinData -> Pl.BuiltinData -> ()) -> Pl.TypedValidator Pl.Any
+typedValidatorFromCode validator = typedValidatorFromBS $ Pl.serialiseCompiledCode $$(Pl.compile [||validator||])

src/Cooked/Validators.hs

@@ -1,7 +1,4 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE NoImplicitPrelude #-}
 
 -- | This module introduces standard dummy validators to be used in
 -- attacks, traces or tests. More precisely, it introduces the always
@@ -16,24 +13,17 @@ where
 
 import Cooked.RawUPLC
 import qualified Plutus.Script.Utils.V2.Typed.Scripts.Validators as Pl
-import qualified PlutusTx as Pl
-import PlutusTx.Prelude
+import qualified PlutusTx.Prelude as Pl
 
 -- | The trivial validator that always succeds; this is in particular
 -- a sufficient target for the datum hijacking attack since we only
 -- want to show feasibility of the attack.
 alwaysTrueValidator :: Pl.TypedValidator a
-alwaysTrueValidator = unsafeTypedValidatorFromUPLC $ Pl.getPlc $$(Pl.compile [||tgt||])
-  where
-    tgt :: Pl.BuiltinData -> Pl.BuiltinData -> Pl.BuiltinData -> ()
-    tgt _ _ _ = ()
+alwaysTrueValidator = unsafeTypedValidatorFromCode (\_ _ _ -> ())
 
 -- | The trivial validator that always fails
 alwaysFalseValidator :: Pl.TypedValidator a
-alwaysFalseValidator = unsafeTypedValidatorFromUPLC $ Pl.getPlc $$(Pl.compile [||tgt||])
-  where
-    tgt :: Pl.BuiltinData -> Pl.BuiltinData -> Pl.BuiltinData -> ()
-    tgt _ _ _ = error ()
+alwaysFalseValidator = unsafeTypedValidatorFromCode (\_ _ _ -> Pl.error ())
 
 -- | A Mock contract type to instantiate validators with
 data MockContract