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
