1

I'm trying to implement some simple two tocken lockup similary to what has been done in Vesting.hs on week03

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

import           Control.Monad        hiding (fmap)
import           Data.Aeson           (ToJSON, FromJSON)
import           Data.List.NonEmpty   (NonEmpty (..))
import           Data.Map             as Map
import           Data.Void            (Void)
import           Data.Text            (pack, Text)
import           GHC.Generics         (Generic)
import           Ledger               hiding (singleton)
import           Ledger.Constraints   (TxConstraints)
import qualified Ledger.Constraints   as Constraints
import qualified Ledger.Typed.Scripts as Scripts
import           Ledger.Value         as Value
import           Ledger.Ada           as Ada
import           Playground.Contract  (IO, ensureKnownCurrencies, printSchemas, stage, printJson)
import           Playground.TH        (mkKnownCurrencies, mkSchemaDefinitions)
import           Playground.Types     (KnownCurrency (..))
import           Plutus.Contract
import qualified PlutusTx
import           PlutusTx.Prelude     hiding (unless)
import qualified Prelude              as P
import           Schema               (ToSchema)
import           Text.Printf          (printf)

minLovelace :: Integer
minLovelace = 2000000

data BreedingDatum = BreedingDatum
    { bOwner :: !PaymentPubKeyHash
    , bNft1  :: !TokenName
    , bNftCurr1 :: !CurrencySymbol
    , bNft2  :: !TokenName
    , bNftCurr2 :: !CurrencySymbol
    , bDeadline  :: !POSIXTime
    } deriving (P.Show, Generic, ToJSON, FromJSON, ToSchema)

instance Eq BreedingDatum where
    {-# INLINABLE (==) #-}
    a == b = (bOwner   a == bOwner   b) &&
             (bNft1 a == bNft1 b) &&
             (bNftCurr1   a == bNftCurr1   b) &&
             (bNft2 a == bNft2 b) &&
             (bNftCurr2    a == bNftCurr2    b) &&
             (bDeadline    a == bDeadline    b) &&
             (bDeadline    a == bDeadline    b)

PlutusTx.unstableMakeIsData ''BreedingDatum
PlutusTx.makeLift ''BreedingDatum

{-# INLINABLE mkValidator #-}
mkValidator :: BreedingDatum -> () -> ScriptContext -> Bool
mkValidator dat () ctx = traceIfFalse "owner signature missing" signedByOwner &&
                         traceIfFalse "breeding not ended" breedingNotEnded
  where
    info :: TxInfo
    info = scriptContextTxInfo ctx

    signedByOwner :: Bool
    signedByOwner = txSignedBy info $ unPaymentPubKeyHash $ bOwner dat

    breedingNotEnded :: Bool
    breedingNotEnded = contains (from $ bDeadline dat) $ txInfoValidRange info

data Breeding
instance Scripts.ValidatorTypes Breeding where
    type instance DatumType Breeding = BreedingDatum
    type instance RedeemerType Breeding = ()

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

validator :: Validator
validator = Scripts.validatorScript typedValidator

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

scrAddress :: Ledger.Address
scrAddress = scriptAddress validator


data BreedingParams = BreedingParams
    { bpOwner :: !PaymentPubKeyHash
    , bpNft1  :: !TokenName
    , bpNftCurr1 :: !CurrencySymbol
    , bpNft2  :: !TokenName
    , bpNftCurr2 :: !CurrencySymbol
    , bpDeadline  :: !POSIXTime
    , bpPrice :: !Integer
    } deriving (Generic, ToJSON, FromJSON, ToSchema)

type BreedingSchema =
            Endpoint "breed" BreedingParams
        .\/ Endpoint "claim" ()

breed :: AsContractError e => BreedingParams -> Contract w s e ()
breed bp = do
    let dat = BreedingDatum
                { 
                    bOwner = bpOwner bp
                    ,bNft1  = bpNft1 bp
                    ,bNftCurr1 = bpNftCurr1 bp
                    ,bNft2  = bpNft2 bp
                    ,bNftCurr2 = bpNftCurr2 bp
                    ,bDeadline = bpDeadline bp
                }
        v = Value.singleton (bpNftCurr1 bp) (bpNft1 bp) 1 <> Value.singleton (bpNftCurr2 bp) (bpNft2 bp) 1 <> Ada.lovelaceValueOf (bpPrice bp)
        tx  = Constraints.mustPayToTheScript dat v
    ledgerTx <- submitTxConstraints typedValidator tx
    void $ awaitTxConfirmed $ getCardanoTxId ledgerTx
    logInfo @P.String $ "locked two tokens"
        

claim :: forall w s e. AsContractError e => Contract w s e ()
claim = do
    now   <- currentTime
    pkh   <- ownPaymentPubKeyHash
    utxos <- Map.filter (isSuitable pkh now) <$> utxosAt scrAddress
    if Map.null utxos
        then logInfo @P.String $ "no breeding finished yet"
        else do
            logInfo @P.String $ "start claiming tokens"  
            let orefs   = fst <$> Map.toList utxos
                lookups = Constraints.unspentOutputs utxos P.<>
                          Constraints.otherScript validator
                tx :: TxConstraints Void Void
                tx      = mconcat [Constraints.mustSpendScriptOutput oref unitRedeemer | oref <- orefs] P.<>
                          Constraints.mustValidateIn (from now)
            logInfo @P.String $ "before submitTxConstraintsWith"  
            ledgerTx <- submitTxConstraintsWith @Void lookups tx
            void $ awaitTxConfirmed $ getCardanoTxId ledgerTx
            logInfo @P.String $ "collected tokens"
            logInfo @P.String $ "collected tokens2"

  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  -> bOwner d == pkh && bDeadline d <= now

endpoints :: Contract () BreedingSchema Text ()
endpoints = awaitPromise (breed' `select` claim') >> endpoints
  where
    breed' = endpoint @"breed" breed
    claim' = endpoint @"claim" $ const claim

mkSchemaDefinitions ''BreedingSchema

myToken1 :: KnownCurrency
myToken1 = KnownCurrency (ValidatorHash "f") "Token" (TokenName "T1" :| [])


myToken2 :: KnownCurrency
myToken2 = KnownCurrency (ValidatorHash "f") "Token" (TokenName "T2" :| [])

mkKnownCurrencies ['myToken1, 'myToken2]

however if my code has this validation enabled

                 traceIfFalse "breeding not ended" breedingNotEnded

in the mkValidator and if I add this on the claim side from the web part

P.<>
                          Constraints.mustValidateIn (from now)

I cannot claim tokens I was running it in the plutus-playground-client but I cannot figure out what I'm doing wrong. To compute deadline I used following command:

slotToEndPOSIXTime def 10
POSIXTime {getPOSIXTime = 1596059101999}

I use only one wallet and I'm gettings it's public key hash using this command:

mockWalletPaymentPubKeyHash $ knownWallet 1

First operation is breed. Next I wait until slot 11. Next operation is claim and after it I wait one slot. Tokens are stay locked in the smart contract.

Logs:

Validating transaction: 0867c69e68ffc5825d6ef4d4fa2a8f2362dd78e22a2b51cadd2a6aaffcc5eea6
Add slot 1
Contract instance for W872cb83: (ReceiveEndpointCall (EndpointDescription { getEndpointDescription: "breed" }) (RawJson "{\"contents\":[{\"getEndpointDescription\":\"breed\"},{\"unEndpointValue\":{\"bpNft2\":{\"unTokenName\":\"T2\"},\"bpNftCurr1\":{\"unCurrencySymbol\":\"66\"},\"bpOwner\":{\"unPaymentPubKeyHash\":{\"getPubKeyHash\":\"a2c20c77887ace1cd986193e4e75babd8993cfd56995cd5cfce609c2\"}},\"bpDeadline\":1596059101999,\"bpPrice\":5000000,\"bpNft1\":{\"unTokenName\":\"T1\"},\"bpNftCurr2\":{\"unCurrencySymbol\":\"66\"}}}],\"tag\":\"ExposeEndpointResp\"}"))
Contract instance for W872cb83: (ContractLog (RawJson "{\"mkTxLogResult\":{\"Right\":{\"unBalancedTxTx\":{\"txData\":[[\"0661ffdf5634559c3239fcd8f84bd2ec83213c79bf94fde4c8ab537918000831\",\"d8799f581ca2c20c77887ace1cd986193e4e75babd8993cfd56995cd5cfce609c2425431416642543241661b000001739c892b2fff\"]],\"txInputs\":[],\"txRedeemers\":[],\"txOutputs\":[{\"txOutValue\":{\"getValue\":[[{\"unCurrencySymbol\":\"66\"},[[{\"unTokenName\":\"T1\"},1],[{\"unTokenName\":\"T2\"},1]]],[{\"unCurrencySymbol\":\"\"},[[{\"unTokenName\":\"\"},5000000]]]]},\"txOutAddress\":{\"addressStakingCredential\":null,\"addressCredential\":{\"contents\":\"6a94edbec4f04aae3b09dec9382f0f742413976728cad1e67715086c\",\"tag\":\"ScriptCredential\"}},\"txOutDatumHash\":\"0661ffdf5634559c3239fcd8f84bd2ec83213c79bf94fde4c8ab537918000831\"}],\"txValidRange\":{\"ivTo\":[{\"tag\":\"PosInf\"},true],\"ivFrom\":[{\"tag\":\"NegInf\"},true]},\"txMint\":{\"getValue\":[]},\"txFee\":{\"getValue\":[]},\"txCollateral\":[],\"txMintScripts\":[],\"txSignatures\":[]},\"unBalancedTxRequiredSignatories\":[],\"unBalancedTxValidityTimeRange\":{\"ivTo\":[{\"tag\":\"PosInf\"},true],\"ivFrom\":[{\"tag\":\"NegInf\"},true]},\"unBalancedTxUtxoIndex\":[]}},\"mkTxLogTxConstraints\":{\"txOwnInputs\":[],\"txOwnOutputs\":[{\"ocValue\":{\"getValue\":[[{\"unCurrencySymbol\":\"66\"},[[{\"unTokenName\":\"T1\"},1],[{\"unTokenName\":\"T2\"},1]]],[{\"unCurrencySymbol\":\"\"},[[{\"unTokenName\":\"\"},5000000]]]]},\"ocDatum\":\"d8799f581ca2c20c77887ace1cd986193e4e75babd8993cfd56995cd5cfce609c2425431416642543241661b000001739c892b2fff\"}],\"txConstraints\":[{\"contents\":\"d8799f581ca2c20c77887ace1cd986193e4e75babd8993cfd56995cd5cfce609c2425431416642543241661b000001739c892b2fff\",\"tag\":\"MustIncludeDatum\"}]},\"mkTxLogLookups\":{\"slOtherScripts\":[],\"slPaymentPubKeyHashes\":[],\"slOwnPaymentPubKeyHash\":null,\"slOwnStakePubKeyHash\":null,\"slOtherData\":[],\"slTypedValidator\":{\"tvForwardingMPSHash\":\"880b3b18ecc486c237105484b3557cd4a7dced9987da9ffb4f44a623\",\"tvForwardingMPS\":{\"getMintingPolicy\":\"mintingPolicyBytesRemovedOnPurpose\"},\"tvValidator\":{\"getValidator\":\"validatorBytesRemovedOnPurpose\"},\"tvValidatorHash\":\"6a94edbec4f04aae3b09dec9382f0f742413976728cad1e67715086c\"},\"slTxOutputs\":[],\"slMPS\":[[\"880b3b18ecc486c237105484b3557cd4a7dced9987da9ffb4f44a623\",{\"getMintingPolicy\":\"mintingPolicyBytesRemovedOnPurpose\"}]]}}"))
Validating transaction: e6095dc750a9d0786ff4b627d99239a3a9a1c8058839aad3a9019f74a352da72
Add slot 2
Contract instance for W872cb83: (ContractLog (RawJson "locked two tokens"))
Add slot 3
Add slot 4
Add slot 5
Add slot 6
Add slot 7
Add slot 8
Add slot 9
Add slot 10
Add slot 11
Contract instance for W872cb83: (ReceiveEndpointCall (EndpointDescription { getEndpointDescription: "claim" }) (RawJson "{\"contents\":[{\"getEndpointDescription\":\"claim\"},{\"unEndpointValue\":[]}],\"tag\":\"ExposeEndpointResp\"}"))
Contract instance for W872cb83: (ContractLog (RawJson "start claiming tokens"))
Contract instance for W872cb83: (ContractLog (RawJson "before submitTxConstraintsWith"))
Contract instance for W872cb83: (ContractLog (RawJson "{\"mkTxLogResult\":{\"Right\":{\"unBalancedTxTx\":{\"txData\":[[\"0661ffdf5634559c3239fcd8f84bd2ec83213c79bf94fde4c8ab537918000831\",\"d8799f581ca2c20c77887ace1cd986193e4e75babd8993cfd56995cd5cfce609c2425431416642543241661b000001739c892b2fff\"]],\"txInputs\":[{\"txInType\":{\"contents\":[{\"getValidator\":\"validatorBytesRemovedOnPurpose\"},\"d87980\",\"d8799f581ca2c20c77887ace1cd986193e4e75babd8993cfd56995cd5cfce609c2425431416642543241661b000001739c892b2fff\"],\"tag\":\"ConsumeScriptAddress\"},\"txInRef\":{\"txOutRefId\":{\"getTxId\":\"e6095dc750a9d0786ff4b627d99239a3a9a1c8058839aad3a9019f74a352da72\"},\"txOutRefIdx\":1}}],\"txRedeemers\":[],\"txOutputs\":[],\"txValidRange\":{\"ivTo\":[{\"tag\":\"PosInf\"},true],\"ivFrom\":[{\"tag\":\"NegInf\"},true]},\"txMint\":{\"getValue\":[]},\"txFee\":{\"getValue\":[]},\"txCollateral\":[],\"txMintScripts\":[],\"txSignatures\":[]},\"unBalancedTxRequiredSignatories\":[],\"unBalancedTxValidityTimeRange\":{\"ivTo\":[{\"tag\":\"PosInf\"},true],\"ivFrom\":[{\"contents\":1596059102999,\"tag\":\"Finite\"},true]},\"unBalancedTxUtxoIndex\":[[{\"txOutRefId\":{\"getTxId\":\"e6095dc750a9d0786ff4b627d99239a3a9a1c8058839aad3a9019f74a352da72\"},\"txOutRefIdx\":1},{\"scriptOutputValue\":{\"getValue\":[[{\"unCurrencySymbol\":\"66\"},[[{\"unTokenName\":\"T1\"},1],[{\"unTokenName\":\"T2\"},1]]],[{\"unCurrencySymbol\":\"\"},[[{\"unTokenName\":\"\"},5000000]]]]},\"scriptOutputValidatorHash\":\"6a94edbec4f04aae3b09dec9382f0f742413976728cad1e67715086c\",\"scriptOutputDatumHash\":\"0661ffdf5634559c3239fcd8f84bd2ec83213c79bf94fde4c8ab537918000831\"}]]}},\"mkTxLogTxConstraints\":{\"txOwnInputs\":[],\"txOwnOutputs\":[],\"txConstraints\":[{\"contents\":[{\"txOutRefId\":{\"getTxId\":\"e6095dc750a9d0786ff4b627d99239a3a9a1c8058839aad3a9019f74a352da72\"},\"txOutRefIdx\":1},\"d87980\"],\"tag\":\"MustSpendScriptOutput\"},{\"contents\":{\"ivTo\":[{\"tag\":\"PosInf\"},true],\"ivFrom\":[{\"contents\":1596059102999,\"tag\":\"Finite\"},true]},\"tag\":\"MustValidateIn\"}]},\"mkTxLogLookups\":{\"slOtherScripts\":[[\"6a94edbec4f04aae3b09dec9382f0f742413976728cad1e67715086c\",{\"getValidator\":\"validatorBytesRemovedOnPurpose\"}]],\"slPaymentPubKeyHashes\":[],\"slOwnPaymentPubKeyHash\":null,\"slOwnStakePubKeyHash\":null,\"slOtherData\":[],\"slTypedValidator\":null,\"slTxOutputs\":[[{\"txOutRefId\":{\"getTxId\":\"e6095dc750a9d0786ff4b627d99239a3a9a1c8058839aad3a9019f74a352da72\"},\"txOutRefIdx\":1},{\"_ciTxOutAddress\":{\"addressStakingCredential\":null,\"addressCredential\":{\"contents\":\"6a94edbec4f04aae3b09dec9382f0f742413976728cad1e67715086c\",\"tag\":\"ScriptCredential\"}},\"_ciTxOutValidator\":{\"Left\":\"6a94edbec4f04aae3b09dec9382f0f742413976728cad1e67715086c\"},\"_ciTxOutDatum\":{\"Right\":\"d8799f581ca2c20c77887ace1cd986193e4e75babd8993cfd56995cd5cfce609c2425431416642543241661b000001739c892b2fff\"},\"_ciTxOutValue\":{\"getValue\":[[{\"unCurrencySymbol\":\"66\"},[[{\"unTokenName\":\"T1\"},1],[{\"unTokenName\":\"T2\"},1]]],[{\"unCurrencySymbol\":\"\"},[[{\"unTokenName\":\"\"},5000000]]]]},\"tag\":\"ScriptChainIndexTxOut\"}]],\"slMPS\":[]}}"))
Add slot 12
1
  • This line can be a bit confusing in order to debug: then logInfo @P.String $ "no breeding finished yet" Better use: "no gifts available" as a message.
    – kindofdev
    Jan 30 at 13:53

1 Answer 1

1

After reproducing the scenario in my local playground, I've checked that the error comes from the fact that the last action is Wait For 1 slot. If you set Wait For 2 instead, you will able to grab the assets.

Honestly, I don't know why setting Wait For 1 slot doesn't work.

2
  • 1
    Even if correct, this answer is an opportunity for somebody to write a better one. It was auto-flagged as likely to be insufficient. Would be much better if it actually spelt out what you mean. Looks more like advice than an answer to the question.
    – gRebel
    Jan 31 at 0:38
  • 1
    @gRebel you are right. It should have been a comment better than a answer.
    – kindofdev
    Jan 31 at 5:56

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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