{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TemplateHaskell   #-}

module PlutusExample.PlutusVersion2.RequireRedeemer
  ( requireRedeemerScript
  , requireRedeemerScriptShortBs
  ) where

import Cardano.Api.Shelley (PlutusScript (..), PlutusScriptV2)
import Prelude hiding (($), (&&))

import Codec.Serialise
import Data.ByteString.Lazy qualified as LBS
import Data.ByteString.Short qualified as SBS

import Plutus.Script.Utils.Typed as Scripts
import Plutus.V2.Ledger.Api qualified as Plutus
import Plutus.V2.Ledger.Contexts as V2
import PlutusTx qualified
import PlutusTx.Builtins
import PlutusTx.Eq as PlutusTx
import PlutusTx.Prelude hiding (Semigroup (..), unless, (.))
import PlutusTx.Prelude qualified as PlutusPrelude

-- serialiseData is a PlutusV2 builtin

{-# INLINABLE mkValidator #-}
mkValidator :: BuiltinData -> BuiltinData -> V2.ScriptContext -> Bool
mkValidator :: BuiltinData -> BuiltinData -> ScriptContext -> Bool
mkValidator BuiltinData
_ BuiltinData
redeemer ScriptContext
sc =
  BuiltinData -> BuiltinByteString
serialiseData BuiltinData
redeemer BuiltinByteString -> BuiltinByteString -> Bool
forall a. Eq a => a -> a -> Bool
PlutusTx./= BuiltinByteString
emptyByteString Bool -> Bool -> Bool
&&
  Maybe OutputDatum -> Bool
forall a. Maybe a -> Bool
PlutusPrelude.isJust ((OutputDatum -> Bool) -> [OutputDatum] -> Maybe OutputDatum
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
PlutusPrelude.find
    (OutputDatum -> OutputDatum -> Bool
forall a. Eq a => a -> a -> Bool
PlutusTx.== Datum -> OutputDatum
Plutus.OutputDatum (BuiltinData -> Datum
Plutus.Datum (BuiltinData -> Datum) -> BuiltinData -> Datum
forall a b. (a -> b) -> a -> b
$ Integer -> BuiltinData
forall a. ToData a => a -> BuiltinData
PlutusTx.toBuiltinData (Integer
42 :: Integer)))
    [OutputDatum]
txinsDatums) Bool -> Bool -> Bool
&&
  Maybe OutputDatum -> Bool
forall a. Maybe a -> Bool
PlutusPrelude.isJust ((OutputDatum -> Bool) -> [OutputDatum] -> Maybe OutputDatum
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
PlutusPrelude.find
    (OutputDatum -> OutputDatum -> Bool
forall a. Eq a => a -> a -> Bool
PlutusTx.== Datum -> OutputDatum
Plutus.OutputDatum (BuiltinData -> Datum
Plutus.Datum (BuiltinData -> Datum) -> BuiltinData -> Datum
forall a b. (a -> b) -> a -> b
$ Integer -> BuiltinData
forall a. ToData a => a -> BuiltinData
PlutusTx.toBuiltinData (Integer
42 :: Integer)))
    [OutputDatum]
referenceInputDatums)
 where
  txInfo :: TxInfo
txInfo = ScriptContext -> TxInfo
V2.scriptContextTxInfo ScriptContext
sc
  txinsDatums :: [OutputDatum]
txinsDatums = (TxInInfo -> OutputDatum) -> [TxInInfo] -> [OutputDatum]
forall a b. (a -> b) -> [a] -> [b]
PlutusPrelude.map (TxOut -> OutputDatum
txOutDatum (TxOut -> OutputDatum)
-> (TxInInfo -> TxOut) -> TxInInfo -> OutputDatum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxInInfo -> TxOut
txInInfoResolved)
                  ([TxInInfo] -> [OutputDatum]) -> [TxInInfo] -> [OutputDatum]
forall a b. (a -> b) -> a -> b
$ TxInfo -> [TxInInfo]
V2.txInfoInputs TxInfo
txInfo
  referenceInputDatums :: [OutputDatum]
referenceInputDatums =
    (TxInInfo -> OutputDatum) -> [TxInInfo] -> [OutputDatum]
forall a b. (a -> b) -> [a] -> [b]
PlutusPrelude.map (TxOut -> OutputDatum
txOutDatum (TxOut -> OutputDatum)
-> (TxInInfo -> TxOut) -> TxInInfo -> OutputDatum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxInInfo -> TxOut
txInInfoResolved)
      ([TxInInfo] -> [OutputDatum]) -> [TxInInfo] -> [OutputDatum]
forall a b. (a -> b) -> a -> b
$ TxInfo -> [TxInInfo]
V2.txInfoReferenceInputs TxInfo
txInfo

validator :: Plutus.Validator
validator :: Validator
validator = CompiledCode (BuiltinData -> BuiltinData -> BuiltinData -> ())
-> Validator
Plutus.mkValidatorScript
   $$(PlutusTx.compile [|| wrap ||])
 where
   wrap :: BuiltinData -> BuiltinData -> BuiltinData -> ()
wrap = (BuiltinData -> BuiltinData -> ScriptContext -> Bool)
-> BuiltinData -> BuiltinData -> BuiltinData -> ()
forall sc d r.
(IsScriptContext sc, UnsafeFromData d, UnsafeFromData r) =>
(d -> r -> sc -> Bool)
-> BuiltinData -> BuiltinData -> BuiltinData -> ()
Scripts.mkUntypedValidator BuiltinData -> BuiltinData -> ScriptContext -> Bool
mkValidator

script :: Plutus.Script
script :: Script
script = Validator -> Script
Plutus.unValidatorScript Validator
validator

requireRedeemerScriptShortBs :: SBS.ShortByteString
requireRedeemerScriptShortBs :: ShortByteString
requireRedeemerScriptShortBs = ByteString -> ShortByteString
SBS.toShort (ByteString -> ShortByteString)
-> (ByteString -> ByteString) -> ByteString -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.toStrict (ByteString -> ShortByteString) -> ByteString -> ShortByteString
forall a b. (a -> b) -> a -> b
$ Script -> ByteString
forall a. Serialise a => a -> ByteString
serialise Script
script

requireRedeemerScript :: PlutusScript PlutusScriptV2
requireRedeemerScript :: PlutusScript PlutusScriptV2
requireRedeemerScript = ShortByteString -> PlutusScript PlutusScriptV2
forall lang. ShortByteString -> PlutusScript lang
PlutusScriptSerialised ShortByteString
requireRedeemerScriptShortBs