Write a policy script with a custom redeemer type, but do NOT use `Plutus.liftCode`

Question

I'd like to write a policy script that receives a custom data type for the Redeemer argument, but does not use Plutus.liftCode to "bake the argument value" into the compiled Plutus script. Instead, I want to be able to compile the policy script with no redeemer value upfront and just declare the type of the argument (e.g. my custom data type) that will be received when the transaction is executed. This will mean that the custom redeemer data will be submitted with the transaction instead.

There are examples of this for Validator, e.g. TypedValidator example from PPP, but I cannot figure out how to do the equivalent thing for a PolicyScript. All the policy script examples I've seen use Plutus.liftCode.

Here's the starting point of the code I'm trying to write. I put brackets around the places in the code that I need an equivalent idea for PolicyScript.

data CustomRedeemer = CustomRedeemer
    { txOut :: TxOutRef
    , nftName :: String
    } deriving Show

PlutusTx.unstableMakeIsData ''CustomRedeemer

{-# INLINABLE mkNftPolicy #-}
mkNftPolicy :: CustomRedeemer -> ScriptContext -> Bool
mkNftPolicy custom ctx = traceIfFalse "UTxO not consumed"   hasUTxO           &&
                         traceIfFalse "wrong amount minted" checkMintedAmount
  where (...)

data MyTypedInstance
instance <equivalent-of: Scripts.ValidatorTypes> MyTypedInstance where
    type instance RedeemerType MyTypedInstance = CustomRedeemer

typedPolicy :: <equivalent-of: Scripts.TypedValidator> MyTypedInstance
typedPolicy =  <equivalent-of: Scripts.mkTypedValidator> @MyTypedInstance
    $$(PlutusTx.compile [|| mkNftPolicy ||])
    $$(PlutusTx.compile [|| wrap ||])
  where
    wrap = <equivalent-of: Scripts.wrapValidator> @CustomRedeemer

Thanks!

Answer 1

It's pretty simple:

1. Define the redeemer with the proper types (they must be part of UnsafeFromData typeclass in order to use PlutusTx.unstableMakeIsData (2))

2. Do PlutusTx.unstableMakeIsData ''CustomRedeemer.

3. Define the policy with mkMintingPolicyScript $$(PlutusTx.compile [|| Scripts.wrapMintingPolicy mkPolicy ||]) where mkPolicy doesn't have any lifted parameters.

4. Have fun.

Important: If you define the custom redeemer along with PlutusTx.unstableMakeIsData in the same module as your minting policy script, the compiler complains in Scripts.wrapMintingPolicy saying that PlutusTx.UnsafeFromData CustomRedeemer must be imported, not defined locally. SOLUTION: Define it in a separate module. This must be Template Haskell stuff...

Additionally, I share a simple example of all of this:

[custom redeemer types module]

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

module Week05.WithCustomRedeemerTypes where

import           PlutusTx.Prelude
import           Prelude          (Show (..))
import qualified PlutusTx
import           Ledger           (TokenName)

data CustomRedeemer = CustomRedeemer
    { nftName     :: TokenName 
    , description :: BuiltinByteString
    } deriving Show

PlutusTx.unstableMakeIsData ''CustomRedeemer 

[minting policy module]

{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE DeriveAnyClass      #-}
{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE NoImplicitPrelude   #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell     #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE TypeFamilies        #-}
{-# LANGUAGE TypeOperators       #-}

module Week05.WithCustomRedeemer where

import           Control.Monad          hiding (fmap)
import           Data.Aeson             (ToJSON, FromJSON)
import           Data.Text              (Text)
import           GHC.Generics           (Generic)
import           Plutus.Contract        as Contract
import           Plutus.Trace.Emulator  as Emulator
import qualified PlutusTx
import           PlutusTx.Prelude       hiding (Semigroup(..), unless)
import           Ledger                 hiding (mint, singleton)
import           Ledger.Constraints     as Constraints
import qualified Ledger.Typed.Scripts   as Scripts
import           Ledger.Value           as Value
import           Prelude                (IO, Show (..), String)
import           Text.Printf            (printf)
import           Wallet.Emulator.Wallet

import           Week05.WithCustomRedeemerTypes
 
{-# INLINABLE mkNftPolicy #-}
mkNftPolicy :: CustomRedeemer -> ScriptContext -> Bool
mkNftPolicy CustomRedeemer{nftName} _ = 
    let expected = TokenName "kurt"
    in traceIfFalse "Kurt is sad because the nft is not called kurt :(" $ nftName == expected 

policy :: Scripts.MintingPolicy
policy = mkMintingPolicyScript $$(PlutusTx.compile [|| Scripts.wrapMintingPolicy mkNftPolicy ||])

curSymbol :: CurrencySymbol
curSymbol = scriptCurrencySymbol policy


data MintParams = MintParams
    { mpTokenName :: !TokenName
    , mpAmount    :: !Integer
    } deriving (Generic, ToJSON, FromJSON)

type FreeSchema = Endpoint "mint" MintParams

mint :: MintParams -> Contract w FreeSchema Text ()
mint mp = do
    let tn = mpTokenName mp
        redeemer = Redeemer $ PlutusTx.toBuiltinData $ CustomRedeemer tn "a description"
        val      = Value.singleton curSymbol (mpTokenName mp) (mpAmount mp)
        lookups  = Constraints.mintingPolicy policy
        tx       = Constraints.mustMintValueWithRedeemer redeemer val
    ledgerTx <- submitTxConstraintsWith @Scripts.Any lookups tx
    void $ awaitTxConfirmed $ getCardanoTxId ledgerTx
    Contract.logInfo @String $ printf "forged %s" (show val)

endpoints :: Contract () FreeSchema Text ()
endpoints = mint' >> endpoints
  where
    mint' = awaitPromise $ endpoint @"mint" mint

happyKurt :: IO ()
happyKurt = runEmulatorTraceIO $ do
    let tn = "kurt"
    h1 <- activateContractWallet (knownWallet 1) endpoints
    callEndpoint @"mint" h1 $ MintParams
        { mpTokenName = tn
        , mpAmount    = 555
        }
    void $ Emulator.waitNSlots 1

sadKurt :: IO ()
sadKurt = runEmulatorTraceIO $ do
    let tn = "bob"
    h1 <- activateContractWallet (knownWallet 1) endpoints
    callEndpoint @"mint" h1 $ MintParams
        { mpTokenName = tn
        , mpAmount    = 555
        }
    void $ Emulator.waitNSlots 1   

You can find the previous code integrated with week05 in my plutus-pioneer-program repo:

https://github.com/kindofdev/plutus-pioneer-program-iter3/blob/main/code/week05/src/Week05/WithCustomRedeemer.hs