Using Do notation to process Maybe’s

The grab function has a function isSuitable to filter the utxo’s at the script address on line 5 of the following code snippet.

 1 grab :: Contract w s Text ()
 2 grab = do
 3     now   <- currentTime
 4     pkh   <- pubKeyHash <$> ownPubKey
 5     utxos <- Map.filter (isSuitable pkh now) <$> utxoAt scrAddress
 6     if Map.null utxos
 7         then logInfo @String $ "no gifts available"
 8         else do
 9             let orefs   = fst <$> Map.toList utxos
10                 lookups = Constraints.unspentOutputs utxos  <>
11                         Constraints.otherScript validator
12                 tx :: TxConstraints Void Void
13                 tx      = mconcat [mustSpendScriptOutput oref $ Redeemer $ PlutusTx.toData () | oref <- orefs] <>
14                         mustValidateIn (from now)
15             ledgerTx <- submitTxConstraintsWith @Void lookups tx
16             void $ awaitTxConfirmed $ txId ledgerTx
17             logInfo @String $ "collected gifts"
18     where
19         isSuitable :: PubKeyHash -> POSIXTime -> TxOutTx -> Bool
20         isSuitable pkh now o = case txOutDatumHash $ txOutTxOut o of
21             Nothing -> False
22             Just h  -> case Map.lookup h $ txData $ txOutTxTx o of
23                 Nothing        -> False
24                 Just (Datum e) -> case PlutusTx.fromData e of
25                     Nothing -> False
26                     Just d  -> beneficiary d == pkh && deadline d <= now

The filtering happens in the Contract monad via <$> which is a function of the Functor type class.

We note the (<$>) is an infix synonym for fmap .

utxos <- Map.filter (isSuitable pkh now) <$> utxoAt scrAddress

Lets start the REPL via cabal repl, import some modules and enable some extensions.

Prelude Week03.Vesting> :m + Plutus.Contract.Request Plutus.Contract.Types Data.Text.Internal Plutus.V1.Ledger.Tx
Prelude Week03.Vesting Plutus.Contract.Request Plutus.Contract.Types Data.Text.Internal Plutus.V1.Ledger.Tx>:set -XTypeApplications
Prelude Week03.Vesting Plutus.Contract.Request Plutus.Contract.Types Data.Text.Internal Plutus.V1.Ledger.Tx>:set -fprint-explicit-foralls

Lets verify that Contract has an instance of Functor

Prelude Week03.Vesting Plutus.Contract.Request Plutus.Contract.Types Data.Text.Internal Plutus.V1.Ledger.Tx> :i Functor
type Functor :: (* -> *) -> Constraint
class Functor f where
fmap :: (a -> b) -> f a -> f b
(<$) :: a -> f b -> f a
{-# MINIMAL fmap #-}
        -- Defined in ‘GHC.Base’
instance Functor (Either a) -- Defined in ‘Data.Either’
instance Functor (Contract w s e)
-- Defined in ‘Plutus.Contract.Types’
instance Functor [] -- Defined in ‘GHC.Base’
instance Functor Maybe -- Defined in ‘GHC.Base’
instance Functor IO -- Defined in ‘GHC.Base’
instance Functor ((->) r) -- Defined in ‘GHC.Base’
instance Functor ((,,,) a b c) -- Defined in ‘GHC.Base’
instance Functor ((,,) a b) -- Defined in ‘GHC.Base’
instance Functor ((,) a) -- Defined in ‘GHC.Base’
Prelude Week03.Vesting Plutus.Contract.Request Plutus.Contract.Types Data.Text.Internal Plutus.V1.Ledger.Tx> :i Contract
type role Contract phantom phantom phantom nominal
type Contract :: * -> Data.Row.Internal.Row * -> * -> * -> *
newtype Contract w s e a
    = Contract {unContract :: freer-simple-1.2.1.1:Control.Monad.Freer.Internal.Eff
                                (Plutus.Contract.Types.ContractEffs w e) a}
            -- Defined in ‘Plutus.Contract.Types’
instance Applicative (Contract w s e)
-- Defined in ‘Plutus.Contract.Types’
instance Functor (Contract w s e)
-- Defined in ‘Plutus.Contract.Types’
instance Monad (Contract w s e)
-- Defined in ‘Plutus.Contract.Types’

Lets use TypeApplications to specialise the function with the types of the Contract

 1 Prelude Week03.Vesting Plutus.Contract.Request Plutus.Contract.Types Data.Text.Internal Plutus.V1.Ledger.Tx> :t (<$>) @(Contract () VestingSchema Text)
 2 (<$>) @(Contract () VestingSchema Text)
 3   :: forall {a} {b}.
 4      (a -> b)
 5      -> Contract
 6           ()
 7           ('Data.Row.Internal.R
 8              '[ "give"
 9                 'Data.Row.Internal.:-> (Wallet.Types.EndpointValue GiveParams,
10                                         Plutus.Contract.Effects.ActiveEndpoint),
11                 "grab"
12                 'Data.Row.Internal.:-> (Wallet.Types.EndpointValue (),
13                                         Plutus.Contract.Effects.ActiveEndpoint)])
14           Text
15           a
16      -> Contract
17           ()
18           ('Data.Row.Internal.R
19              '[ "give"
20                 'Data.Row.Internal.:-> (Wallet.Types.EndpointValue GiveParams,
21                                         Plutus.Contract.Effects.ActiveEndpoint),
22                 "grab"
23                 'Data.Row.Internal.:-> (Wallet.Types.EndpointValue (),
24                                         Plutus.Contract.Effects.ActiveEndpoint)])
25           Text
26           b

So we can just plug in the function (a -> b) on line 4 which is UtxoMap -> Map TxOutRef TxOutTx, since UtxoMap is a type alias of Map TxOutRef TxOutTx

type UtxoMap = Map TxOutRef TxOutTx

Lets examine the fully specified types in the use of <$>

Prelude Week03.Vesting Plutus.Contract.Request Plutus.Contract.Types Data.Text.Internal Plutus.V1.Ledger.Tx Map Plutus.Contract> :t (<$>) @(Contract () VestingSchema Text) @UtxoMap @(Map TxOutRef TxOutTx)
(<$>) @(Contract () VestingSchema Text) @UtxoMap @(Map TxOutRef TxOutTx)
:: (UtxoMap -> Map TxOutRef TxOutTx)
    -> Contract
        ()
        ('Data.Row.Internal.R
            '[ "give"
                'Data.Row.Internal.:-> (Wallet.Types.EndpointValue GiveParams,
                                        Plutus.Contract.Effects.ActiveEndpoint),
                "grab"
                'Data.Row.Internal.:-> (Wallet.Types.EndpointValue (),
                                        Plutus.Contract.Effects.ActiveEndpoint)])
        Text
        UtxoMap
    -> Contract
        ()
        ('Data.Row.Internal.R
            '[ "give"
                'Data.Row.Internal.:-> (Wallet.Types.EndpointValue GiveParams,
                                        Plutus.Contract.Effects.ActiveEndpoint),
                "grab"
                'Data.Row.Internal.:-> (Wallet.Types.EndpointValue (),
                                        Plutus.Contract.Effects.ActiveEndpoint)])
        Text
        (Map TxOutRef TxOutTx)

We have extracted the minimum subset of code needed to specify a function to filter the utxo’s, in a function called filterUtxosFromScriptAddress [1]

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

module Week03.VestingOnly where

import Data.Map as Map ( filter, lookup, Map )
import Plutus.Contract ( UtxoMap )
import qualified PlutusTx

import PlutusTx.Prelude
    ( Bool(False),
      Maybe(Just, Nothing),
      (&&),
      ($),
      Eq((==)),
      Ord((<=)) )

import Ledger
    ( PubKeyHash,
      Datum(Datum),
      POSIXTime,
      Tx(txData),
      TxOut(txOutDatumHash),
      TxOutRef,
      TxOutTx(txOutTxOut, txOutTxTx) )

import Prelude (Show (..))

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

PlutusTx.unstableMakeIsData ''VestingDatum

filterUtxosFromScriptAddress :: PubKeyHash -> POSIXTime -> UtxoMap -> Map TxOutRef TxOutTx
filterUtxosFromScriptAddress pkh now utxosFromScriptAddress = Map.filter (isSuitable pkh now) utxosFromScriptAddress
  where
    isSuitable :: PubKeyHash -> POSIXTime -> TxOutTx -> Bool
    isSuitable pkh now o = case txOutDatumHash $ txOutTxOut o of
        Nothing -> False
        Just h  -> case Map.lookup h $ txData $ txOutTxTx o of
            Nothing        -> False
            Just (Datum e) -> case PlutusTx.fromData e of
                Nothing -> False
                Just d  -> beneficiary d == pkh && deadline d <= now

isSuitable is written using case expressions to process the results of Maybe a

isSuitable can be rewritten exploiting the do [2] syntax and the fromMaybe function to make the code more succinct. (Plutus has a slightly different version of fromMaybe to make it compatible with plutus in module PlutusTx.Maybe)

isSuitable :: PubKeyHash -> POSIXTime -> TxOutTx -> Bool
isSuitable pkh now o = case txOutDatumHash $ txOutTxOut o of
                        Nothing -> False
                        Just h  -> case Map.lookup h $ txData $ txOutTxTx o of
                                    Nothing        -> False
                                    Just (Datum e) -> case PlutusTx.fromData e of
                                        Nothing -> False
                                        Just d  -> beneficiary d == pkh && deadline d <= now

The fromMaybe function takes a default value and a Maybe value. If the Maybe is Nothing, it returns the default value; otherwise, it returns the value contained in the Maybe.

fromMaybe :: a -> Maybe a -> a  -- Defined in ‘PlutusTx.Maybe’

Here we see the do syntax used, we process the happy path whenever the result of each step is a Just a otherwise the function essentially exits early and returns a Nothing.

If any part of the processing results in a Nothing, the fromMaybe is used to return a default value which in this case is False

isSuitable :: PubKeyHash -> POSIXTime -> TxOutTx -> Bool
isSuitable pkh now o = fromMaybe False $ do
    h <- txOutDatumHash $ txOutTxOut o
    (Datum e) <- Map.lookup h $ txData $ txOutTxTx o
    d <- PlutusTx.fromData e
    return $ beneficiary d == pkh && deadline d <= now

The suitability predicate of the VestingDatum can be extracted into a seperate function

suitabilityPredicate :: VestingDatum -> PubKeyHash ->POSIXTime -> Bool
suitabilityPredicate d now = beneficiary d == pkh && deadline d <= now

We can paramertise isSuitable by providing suitabilityPredicate as a parameter.

The PubKeyHash and POSIXTime can be capatured via a closure so the suitabilityPredicate can have a type signature (VestingDatum -> Bool)

isSuitable :: (VestingDatum -> Bool) -> TxOutTx -> Bool
isSuitable p o = fromMaybe False $ do
        h <- txOutDatumHash $ txOutTxOut o
        (Datum e) <- Map.lookup h $ txData $ txOutTxTx o
        d <- PlutusTx.fromData e
        return $ p d

It can then be used as follows

Map.filter (\txOutTx ->
                        isSuitable (\d -> beneficiary d == pkh
                                             && deadline d <= now ) txOutTx) utxosFromScriptAddress

or more simply

Map.filter (isSuitable $ \d -> beneficiary d == pkh && deadline d <= now) utxosFromScriptAddress

Here’s the new code in the orginal code of the Vesting contract.

grab :: Contract w s Text ()
grab = do
    now   <- currentTime
    pkh   <- pubKeyHash <$> ownPubKey
    utxos <- Map.filter (isSuitable $ \d -> beneficiary d == pkh && deadline d <= now) <$> utxoAt scrAddress
    if Map.null utxos
        then logInfo @String $ "no gifts available"
        else do
            let orefs   = fst <$> Map.toList utxos
                lookups = Constraints.unspentOutputs utxos  <>
                        Constraints.otherScript validator
                tx :: TxConstraints Void Void
                tx      = mconcat [mustSpendScriptOutput oref $ Redeemer $ PlutusTx.toData () | oref <- orefs] <>
                        mustValidateIn (from now)
            ledgerTx <- submitTxConstraintsWith @Void lookups tx
            void $ awaitTxConfirmed $ txId ledgerTx
            logInfo @String $ "collected gifts"
where
    isSuitable :: (VestingDatum -> Bool) -> TxOutTx -> Bool
    isSuitable p o = fromMaybe False $ do
            h <- txOutDatumHash $ txOutTxOut o
            (Datum e) <- Map.lookup h $ txData $ txOutTxTx o
            d <- PlutusTx.fromData e
            return $ p d

We also note that we can create some addtional general functions here, with the aid of any since Maybe has an instance of Foldable and introducing type constraints.

Prelude Plutus.Contract.Request Plutus.Contract.Types Data.Text.Internal Plutus.V1.Ledger.Tx> :t any
any
  :: forall {t :: * -> *} {a}.
     Foldable t =>
     (a -> Bool) -> t a -> Bool
getDatumFromTxOutTx ::(PlutusTx.IsData a) => TxOutTx -> Maybe a
getDatumFromTxOutTx o = do
        h <- txOutDatumHash $ txOutTxOut o
        (Datum e) <- Map.lookup h $ txData $ txOutTxTx o
        PlutusTx.fromData e

getDatumFromTxOutTx can then be composed with the (.) and any to provide a generic isSuitable function.

isTxOutTxSuitable :: (PlutusTx.IsData a) => (a -> Bool) -> TxOutTx -> Bool
isTxOutTxSuitable p = any p . getDatumFromTxOutTx

Footnotes

[1]full sample from Plutus Pioneers Lectures https://github.com/input-output-hk/plutus-pioneer-program/blob/main/code/week03/src/Week03/Vesting.hs
[2]do notation is covered in the lectures in Week04