1

I would like to be able to update state on the token that is locked in the smart contract address.

My assumption was that using below code

    getLockingDatum :: Maybe LockingDatum
    getLockingDatum = let os = [ o | o <- txInfoOutputs info, valueOf (txOutValue o) cs tn == 1 ] in
        case os of
        [o] -> lockingDatum o (`findDatum` info)
        _   -> Nothing

    checkIfCounterWasUpdated :: Bool
    checkIfCounterWasUpdated = case getLockingDatum of
        Nothing -> False
        Just ld -> owner     ld      == owner    dat &&
                   currency ld       == currency dat &&
                   token    ld       == token    dat
            -- &&   (counter  ld) + 1 == (counter  dat)

I should be able to take old datum and compared with the incoming one. However if I uncomment line -- && (counter ld) + 1 == (counter dat) I'm getting this exception: EvaluationError [\"counter was updated by more than one\",\"PT5\"]

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

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

module Week04.Homework where

import           Control.Monad.Freer.Extras as Extras
import           Control.Monad        hiding (fmap)
import           Data.Aeson           (ToJSON, FromJSON)
import           Data.Map             as Map
import           Data.Text            (Text)
import           Data.Default
import           Data.Void            (Void)
import           GHC.Generics         (Generic)
import           Plutus.Contract            as Contract
import           PlutusTx             (Data (..))
import qualified PlutusTx
import           PlutusTx.Prelude     hiding (Semigroup(..), unless)
import           Ledger               hiding (singleton)
import           Ledger.Constraints   (TxConstraints)
import           Ledger.TimeSlot 
import qualified Ledger.Constraints   as Constraints
import qualified Ledger.Typed.Scripts as Scripts
import           Ledger.Ada           as Ada
import           Ledger.Value         as Value
import           Playground.Contract  (printJson, printSchemas, ensureKnownCurrencies, stage, ToSchema)
import           Playground.Contract
import           Playground.TH        (mkKnownCurrencies, mkSchemaDefinitions)
import           Playground.Types     (KnownCurrency (..))
import           Prelude              (IO, Semigroup (..), Show (..), String)
import           Text.Printf          (printf)
import           Plutus.Trace.Emulator as Emulator
import           Wallet.Emulator.Wallet
import           Wallet.Emulator.Wallet (Wallet(..))
import           Plutus.V1.Ledger.Value 
import           Plutus.Trace.Emulator (EmulatorTrace, EmulatorConfig(..), runEmulatorTraceIO', 
                              activateContractWallet)
-- import           Plutus.ChainIndex.Tx ( ChainIndexTx(_citxData) )
import Plutus.ChainIndex.Tx
data BreedAction = Grab | Update
    deriving (Generic, ToJSON, FromJSON)
PlutusTx.makeIsDataIndexed ''BreedAction [ ('Grab,      0)
                                         , ('Update,    1)
                                        ]
PlutusTx.makeLift ''BreedAction

data LockingDatum = LockingDatum
    { owner       :: PaymentPubKeyHash
    , deadline    :: POSIXTime
    , currency    :: CurrencySymbol
    , token       :: TokenName
    , counter     :: Integer
    } deriving Show

PlutusTx.unstableMakeIsData ''LockingDatum

{-# INLINABLE lockingDatum #-}
lockingDatum :: TxOut -> (DatumHash -> Maybe Datum) -> Maybe LockingDatum
lockingDatum o f = do
    dh <- txOutDatum o
    Datum d <- f dh
    PlutusTx.fromBuiltinData d

{-# INLINABLE mkValidator #-}
mkValidator :: LockingDatum -> BreedAction -> ScriptContext -> Bool
mkValidator dat ba ctx = case ba of
        Grab -> 
            traceIfFalse "owner's signature missing" signedByowner &&
            traceIfFalse "deadline not reached" deadlineReached
        Update -> 
            traceIfFalse "owner's signature missing" signedByowner &&
            traceIfFalse "counter was updated by more than one" checkIfCounterWasUpdated &&
            traceIfFalse "NFT left the script" checkContinuingNFT
  where
    info :: TxInfo
    info = scriptContextTxInfo ctx

    signedByowner :: Bool
    signedByowner = txSignedBy info $ unPaymentPubKeyHash $ owner dat

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

    tn :: TokenName
    tn = token dat

    cs :: CurrencySymbol
    cs = currency dat

    getLockingDatum :: Maybe LockingDatum
    getLockingDatum = let os = [ o | o <- txInfoOutputs info, valueOf (txOutValue o) cs tn == 1 ] in
        case os of
        [o] -> lockingDatum o (`findDatum` info)
        _   -> Nothing

    checkIfCounterWasUpdated :: Bool
    checkIfCounterWasUpdated = case getLockingDatum of
        Nothing -> False
        Just ld -> owner     ld      == owner    dat &&
                   currency ld       == currency dat &&
                   token    ld       == token    dat
            -- &&   (counter  ld) + 1 == (counter  dat)
    
    checkContinuingNFT :: Bool
    checkContinuingNFT = let cos = [ co | co <- getContinuingOutputs ctx, valueOf (txOutValue co) cs tn == 1 ] in
        case cos of
            [_] -> True
            _   -> False

data Locking
instance Scripts.ValidatorTypes Locking where
    type instance DatumType Locking = LockingDatum
    type instance RedeemerType Locking = BreedAction

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

validator :: Validator
validator = Scripts.validatorScript typedValidator

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

scrAddress :: Ledger.Address
scrAddress = scriptAddress validator

data LockParams = LockParams
    { lpOwner :: !PaymentPubKeyHash
    , lpDeadline    :: !POSIXTime
    , lpAmount      :: !Integer
    , lpCurrency    :: !CurrencySymbol
    , lpToken       :: !TokenName
    , lpCounter     :: !Integer
    } deriving (Generic, ToJSON, FromJSON, ToSchema)

type LockingSchema =
            Endpoint "lock" LockParams
            .\/ Endpoint "grab" ()
            .\/ Endpoint "updcntr" LockParams

lock :: AsContractError e => LockParams -> Contract w s e ()
lock lp = do
    Contract.logInfo @String $ printf "starting"
    let dat = LockingDatum
                { owner       = lpOwner lp
                , deadline    = lpDeadline lp
                , currency    = lpCurrency lp
                , token       = lpToken lp
                , counter     = lpCounter lp
                }
        val = Ada.lovelaceValueOf (lpAmount lp) <> Value.singleton (lpCurrency lp) (lpToken lp) 1
        tx  = Constraints.mustPayToTheScript dat val
    ledgerTx <- submitTxConstraints typedValidator tx
    void $ awaitTxConfirmed $ getCardanoTxId ledgerTx
    Contract.logInfo @String $ printf "locked %d lovelace by %s with deadline %s"
        (lpAmount lp)
        (show $ lpOwner lp)
        (show $ lpDeadline lp)

grab :: forall w s e. AsContractError e => Contract w s e ()
grab = do
    now   <- currentTime
    pkh   <- ownPaymentPubKeyHash
    utxos <- Map.filter (isSuitable pkh now) <$> utxosAt scrAddress
    if Map.null utxos
        then Contract.logInfo @String $ "nothing is locked " ++ show scrAddress
        else do
            let orefs   = fst <$> Map.toList utxos
                lookups = Constraints.unspentOutputs utxos  <>
                          Constraints.otherScript validator
                tx :: TxConstraints Void Void
                tx      = mconcat [Constraints.mustSpendScriptOutput oref $ Redeemer $ PlutusTx.toBuiltinData Grab | oref <- orefs] <>
                          Constraints.mustValidateIn (from now)
            ledgerTx <- submitTxConstraintsWith @Void lookups tx
            Contract.logInfo @String $ "[Grab redeemer] collected locked tokens: " ++ show scrAddress
            void $ awaitTxConfirmed $ getCardanoTxId ledgerTx
  where
    isSuitable :: PaymentPubKeyHash -> POSIXTime -> ChainIndexTxOut -> Bool
    isSuitable pkh now o = case _ciTxOutDatum o of
        Left _          -> False
        Right (Datum e) -> case PlutusTx.fromBuiltinData e of
            Nothing -> False
            Just d  -> owner d == pkh && deadline d <= now

updcntr :: forall w s e. AsContractError e => LockParams -> Contract w s e ()
updcntr lp = do
    tkn   <- findLocked (lpCurrency lp, lpToken lp)
    case tkn of
        Nothing -> Contract.logError @String "No token was locked"
        Just (oref, o, lockedDat) -> do
            let r       = Redeemer $ PlutusTx.toBuiltinData Update
                val     = Value.singleton (currency lockedDat) (token lockedDat) 1 <> Ada.lovelaceValueOf (lpAmount lp)
                newCounter  = (counter lockedDat) + 1
                lockedDat'   = lockedDat { counter = newCounter }
                lookups = Constraints.typedValidatorLookups typedValidator <>
                          Constraints.otherScript validator                    <>
                          Constraints.unspentOutputs (Map.singleton oref o)
                tx      = Constraints.mustSpendScriptOutput oref r <>
                          Constraints.mustPayToTheScript lockedDat' val
            Contract.logInfo $ "Updating counter old datum: " ++ show lockedDat ++ " new datum: " ++ show lockedDat'
            ledgerTx <- submitTxConstraintsWith lookups tx
            void $ awaitTxConfirmed $ getCardanoTxId ledgerTx
            Contract.logInfo @String "Counter was updated"


findLocked :: forall w s e. AsContractError e => (CurrencySymbol, TokenName) -> Contract w s e (Maybe (TxOutRef, ChainIndexTxOut, LockingDatum))
findLocked (cs, tn) = do
    utxos <- Map.filter f <$> utxosTxOutTxAt scrAddress
    return $ case Map.toList utxos of
        [(oref, (o, citx))] -> do
            bd <- lockingDatum (toTxOut o) $ \dh -> Map.lookup dh $ _citxData citx
            Just (oref, o, bd)
        _           -> Nothing

  where
    f :: (ChainIndexTxOut, Plutus.ChainIndex.Tx.ChainIndexTx) -> Bool
    f (o, _) = valueOf (txOutValue $ toTxOut o) cs tn == 1


endpoints :: Contract () LockingSchema Text ()
endpoints = awaitPromise (lock' `select` grab' `select` updcntr') >> endpoints
  where
    lock' = endpoint @"lock" lock
    grab' = endpoint @"grab" $ const grab
    updcntr' = endpoint @"updcntr" updcntr

mkSchemaDefinitions ''LockingSchema

myToken :: KnownCurrency
myToken = KnownCurrency (ValidatorHash "f") "Token" (TokenName "T" :| [])

mkKnownCurrencies ['myToken]

testTrace :: Integer -> EmulatorTrace ()
testTrace lov = do
    end <- activateContractWallet (knownWallet 1) endpoints
    let ownWallet = knownWallet 1
        ownPkh       = mockWalletPaymentPubKeyHash ownWallet
        d           = slotToEndPOSIXTime def 10 
        pp  = LockParams { 
                      lpOwner = ownPkh
                    , lpDeadline = d
                    , lpAmount = lov
                    , lpCurrency = CurrencySymbol { unCurrencySymbol = "f"}
                    , lpToken    = TokenName { unTokenName = "T" }
                    , lpCounter  = 0
                    }

        pp1  = LockParams { 
                      lpOwner = ownPkh
                    , lpDeadline = d
                    , lpAmount = lov
                    , lpCurrency = CurrencySymbol { unCurrencySymbol = "f"}
                    , lpToken    = TokenName { unTokenName = "T" }
                    , lpCounter  = 1
                    }


    Extras.logInfo $ "ownerPkh: " ++ show ownPkh ++ " wallet: " ++ show ownWallet ++ " params: "

    callEndpoint @"lock" end pp
    void $ Emulator.waitNSlots 12

    Extras.logInfo @String "calling updcntr for first time"
    callEndpoint @"updcntr" end pp1
    void $ Emulator.waitNSlots 1
    Extras.logInfo @String "called updcntr for first time"

    -- Extras.logInfo @String "calling updcntr for second time"
    -- callEndpoint @"updcntr" end pp2
    -- void $ Emulator.waitNSlots 1
    -- Extras.logInfo @String "calling updcntr for second time"

testLock :: IO ()
testLock = do
    let curr = CurrencySymbol { unCurrencySymbol = "f"}
        tok  = TokenName { unTokenName = "T"}
        dist = Map.fromList [ (knownWallet 1, Ada.lovelaceValueOf 100_000_000 <> Value.singleton curr tok 1)
                             , (knownWallet 2, Ada.lovelaceValueOf 25_000_000)]
        emCfg = EmulatorConfig (Left dist) def def
    runEmulatorTraceIO' def emCfg (testTrace 15_000_000)

any idea what I'm doing wrong?

1 Answer 1

1

From what I see in your code I understand that you want to check that the new datum increases the counter of the old datum in 1. If this statement is correct, the fix is easy.

checkIfCounterWasUpdated :: Bool
checkIfCounterWasUpdated = case getLockingDatum of
    Nothing -> False
    Just ld -> owner ld   == owner    dat &&
        currency ld       == currency dat &&
        token    ld       == token    dat &&
     -- (counter  ld) + 1 == (counter  dat)
     -- (counter  ld)     == (counter  dat) + 1  -- This works 
        counter  ld       == succ (counter dat)  -- This works and it's more idiomatic

I've tested it and it works.

As a side note, I'd say that your use case fits great with the Plutus.Contract.StateMachine library.

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.