How do I test the on-chain validator in Vesting.hs?

Question

In Plutus Pioneer Program, Iteration #3, Lecture #3, Part #4 at 27:48, Lars mentions that he wrote the contract code in a way that invalid transactions will always be caught by the off-chain code. So the on-chain validator never really gets exercised. He says that, as optional homework, you can modify the off-chain code so it always passes. I attempted to do that but I wasn't successful.

Here is the original Vesting.hs.

I modified the off-chain code to always pass by replacing the grab endpoint with a copy of the grab endpoint from week 2's Gift.hs. Here's the full script I'm pasting into the Plutus Playground.

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

{-# OPTIONS_GHC -fno-warn-unused-imports #-}

module Week03.Vesting where

import           Control.Monad        hiding (fmap)
import           Data.Aeson           (ToJSON, FromJSON)
import           Data.Map             as Map
import           Data.Text            (Text)
import           Data.Void            (Void)
import           GHC.Generics         (Generic)
import           Plutus.Contract
import           PlutusTx             (Data (..))
import qualified PlutusTx

import qualified PlutusTx.Builtins   as Builtins
import           PlutusTx.Prelude     hiding (Semigroup(..), unless)
import           Ledger               hiding (singleton)
import           Ledger.Constraints   (TxConstraints)
import qualified Ledger.Constraints   as Constraints
import qualified Ledger.Typed.Scripts as Scripts
import           Ledger.Ada           as Ada
import           Playground.Contract  (printJson, printSchemas, ensureKnownCurrencies, stage, ToSchema)
import           Playground.TH        (mkKnownCurrencies, mkSchemaDefinitions)
import           Playground.Types     (KnownCurrency (..))
import           Prelude              (IO, Semigroup (..), Show (..), String)
import           Text.Printf          (printf)

data VestingDatum = VestingDatum
    { beneficiary :: PaymentPubKeyHash
    , deadline    :: POSIXTime
    } deriving Show

PlutusTx.unstableMakeIsData ''VestingDatum

{-# INLINABLE mkValidator #-}
mkValidator :: VestingDatum -> () -> ScriptContext -> Bool
mkValidator dat () ctx = traceIfFalse "beneficiary's signature missing" signedByBeneficiary &&
                         traceIfFalse "deadline not reached" deadlineReached
  where
    info :: TxInfo
    info = scriptContextTxInfo ctx

    signedByBeneficiary :: Bool
    signedByBeneficiary = txSignedBy info $ unPaymentPubKeyHash $ beneficiary dat

    deadlineReached :: Bool
    deadlineReached = contains (from $ deadline dat) $ txInfoValidRange info

data Vesting
instance Scripts.ValidatorTypes Vesting where
    type instance DatumType Vesting = VestingDatum
    type instance RedeemerType Vesting = ()

typedValidator :: Scripts.TypedValidator Vesting
typedValidator = Scripts.mkTypedValidator @Vesting
    $$(PlutusTx.compile [|| mkValidator ||])
    $$(PlutusTx.compile [|| wrap ||])
  where
    wrap = Scripts.wrapValidator @VestingDatum @()

validator :: Validator
validator = Scripts.validatorScript typedValidator

valHash :: Ledger.ValidatorHash
valHash = Scripts.validatorHash typedValidator

scrAddress :: Ledger.Address
scrAddress = scriptAddress validator

data GiveParams = GiveParams
    { gpBeneficiary :: !PaymentPubKeyHash
    , gpDeadline    :: !POSIXTime
    , gpAmount      :: !Integer
    } deriving (Generic, ToJSON, FromJSON, ToSchema)

type VestingSchema =
            Endpoint "give" GiveParams
        .\/ Endpoint "grab" ()

give :: AsContractError e => GiveParams -> Contract w s e ()
give gp = do
    let dat = VestingDatum
                { beneficiary = gpBeneficiary gp
                , deadline    = gpDeadline gp
                }
        tx  = Constraints.mustPayToTheScript dat $ Ada.lovelaceValueOf $ gpAmount gp
    ledgerTx <- submitTxConstraints typedValidator tx
    void $ awaitTxConfirmed $ getCardanoTxId ledgerTx
    logInfo @String $ printf "made a gift of %d lovelace to %s with deadline %s"
        (gpAmount gp)
        (show $ gpBeneficiary gp)
        (show $ gpDeadline gp)

grab :: forall w s e. AsContractError e => Contract w s e ()
grab = do
    utxos <- utxosAt scrAddress
    let orefs   = fst <$> Map.toList utxos
        lookups = Constraints.unspentOutputs utxos      <>
                  Constraints.otherScript validator
        tx :: TxConstraints Void Void
        tx      = mconcat [Constraints.mustSpendScriptOutput oref $ Redeemer $ Builtins.mkI 17 | oref <- orefs]
    ledgerTx <- submitTxConstraintsWith @Void lookups tx
    void $ awaitTxConfirmed $ getCardanoTxId ledgerTx
    logInfo @String $ "collected gifts"

endpoints :: Contract () VestingSchema Text ()
endpoints = awaitPromise (give' `select` grab') >> endpoints
  where
    give' = endpoint @"give" give
    grab' = endpoint @"grab" $ const grab

mkSchemaDefinitions ''VestingSchema

mkKnownCurrencies []

I set up the simulation exactly as Lars has it in the video:

3 wallets with 100000000 Lovelace opening balances.

1. Wallet 1 gives 30 ADA to wallet 2 with a deadline of slot 10
2. Wait for 1 slot
3. Wallet 1 gives 30 ADA to wallet 2 with a deadline of slot 20
4. Wait for 1 slot
5. Wallet 1 gives 30 ADA to wallet 3 with a deadline of slot 10
6. Wait until slot 11
7. Wallet 2 grabs
8. Wallet 3 grabs
9. Wait for 5 slots

After evaluating the simulation, I expected the exact same transactions as Lars at 24:59 in the video:

• Slot 0: set the opening balances for the 3 wallets
• Slot 1: wallet 1 locks 30 ADA at script address
• Slot 2: wallet 1 locks another 30 ADA at script address
• Slot 3: wallet 1 locks another 30 ADA at script address
• Slot 12, tx 0: wallet 3 grabs 30 ADA from the script
• Slot 12, tx 1: wallet 2 grabs 30 ADA from the script (the other 30 ADA for wallet 2 doesn't get unlocked because the deadline is not reached)

However, there is no slot 12 in my simulation. Meaning that neither of the expected grab transactions went through.

I would post the full log and trace but they exceed StackExhange's character limit. Instead, here's the most interesting piece I've found in the trace:

Slot 11: 00000000-0000-4000-8000-000000000002 {Wallet Wc30e}:
             Contract instance stopped with error: "WalletError (ValidationError (ScriptFailure (EvaluationError [] \"BuiltinEvaluationFailure of UnConstrData\")))" ]

I know I'm doing something wrong. How do I set up Vesting.hs to test the on-chain validator?

Answer 1

The error that you are getting is due to you are using an invalid redeemer: Redeemer $ Builtins.mkI 17. The validation script needs () as redeemer. You should use unitRedeemer. In this case the error occurs when the offchain part tries to build the transaction. Having said that you cannot debug onchain because it never reaches the validator.

tx      = mconcat [Constraints.mustSpendScriptOutput oref $ Redeemer $ Builtins.mkI 17 | oref <- orefs]        

On other hand, if you fix this, it will fail again because you don't set the time validation constraint in offchain code Constraints.mustValidateIn (from now). If you don't set it, the default validity interval is "all the time", and the validator will fail with "deadline not reached".

Additionally, if you fix these two things (valid redeemer and time constraint), it will fail in grab because it will try to spend all UTXOs (the good ones and the others) sitting at the script address, and the validator will reject the transaction.