Documentation for filtering through the inputs of a Plutus Script

Question

I Have 1000 utxo's sitting at a script address with unique datums is there documentation for a validator so that when collectFromScript is called it only pulls 1 utxo based on the user input matching with the datum of one of the utxo's sitting at the script?

Answer 1

In order to collect and filter by datum in offchain code you can use collectFromScriptFilter from Plutus.Contract. I've implemented a simple example showing the use case.

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

module Week05.OffchainFilterByDatumAndCollect where

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

type Field1 = Integer
type Field2 = Integer

data MyParams = MyParams 
    { mpField1 :: Field1
    , mpField2 :: Field2
    } deriving stock (Haskell.Eq, Haskell.Show, Generic)
      deriving anyclass (ToJSON, FromJSON)

data MyDatum = MyDatum 
    { mdField1 :: Field1
    , myField2 :: Field2
    } deriving Show

PlutusTx.unstableMakeIsData ''MyDatum 

{-# INLINABLE mkValidator #-}
mkValidator :: MyDatum -> () -> ScriptContext -> Bool
mkValidator _ _ _ = True

data Typed
instance Scripts.ValidatorTypes Typed where
    type instance DatumType Typed = MyDatum
    type instance RedeemerType Typed = ()

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

validator :: Validator
validator = Scripts.validatorScript typedValidator

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

scrAddress :: Ledger.Address
scrAddress = scriptAddress validator

type GiftSchema =
            Endpoint "give" (Integer, MyParams)
        .\/ Endpoint "grab" MyParams

give :: AsContractError e => (Integer, MyParams) -> Contract w s e ()
give (amount, MyParams{..}) = do
    let dat = MyDatum mpField1 mpField2
        lookups = Constraints.typedValidatorLookups typedValidator
        tx      = mustPayToTheScript dat $ Ada.lovelaceValueOf amount
    utx  <- mkTxConstraints lookups tx
    txid <- getCardanoTxId <$> submitUnbalancedTx (Constraints.adjustUnbalancedTx utx) 
    void $ awaitTxConfirmed txid
    logInfo @String $ printf "made a gift of %d lovelace" amount
    
grab :: forall w s e. AsContractError e => MyParams -> Contract w s e ()
grab MyParams{..} = do
    utxos <- utxosAt scrAddress
    let dat     = MyDatum mpField1 mpField2
        flt _ ciTxOut = either id Ledger.datumHash (Tx._ciTxOutDatum ciTxOut) == Ledger.datumHash (Datum (PlutusTx.toBuiltinData dat))
        lookups = Constraints.unspentOutputs utxos <>
                  Constraints.typedValidatorLookups typedValidator
        tx      = collectFromScriptFilter flt utxos ()
    utx  <- mkTxConstraints lookups tx
    txid <- getCardanoTxId <$> submitUnbalancedTx (Constraints.adjustUnbalancedTx utx) 
    void $ awaitTxConfirmed txid
    logInfo @String $ "collected gifts"

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

-- w1 gives 10 (datum1) + 20 (datum2)
-- w2 grab  10 (datum1)
-- script locks 20 (datum2)
test :: IO ()
test = runEmulatorTraceIO $ do
    let params1 = MyParams 1 1
        params2 = MyParams 2 2
    h1 <- activateContractWallet (knownWallet 1) endpoints
    h2 <- activateContractWallet (knownWallet 2) endpoints
    callEndpoint @"give" h1 (10_000_000, params1)
    void $ Emulator.waitNSlots 1
    callEndpoint @"give" h1 (20_000_000, params2)
    void $ Emulator.waitNSlots 1
    callEndpoint @"grab" h2 params1
    void $ Emulator.waitNSlots 1

In plutus-use-cases repo you can find more interesting examples:

• https://github.com/input-output-hk/plutus-apps/blob/main/plutus-use-cases/src/Plutus/Contracts/Crowdfunding.hs

• https://github.com/input-output-hk/plutus-apps/blob/main/plutus-use-cases/src/Plutus/Contracts/Escrow.hs