1

Im getting an interpreter error on the Plutus playground commit 3f84ea4fe3924cb7ee614da2b22c64c02c1177e6. I get it whenever I run the purchase endpoint.

This is the error

Main.hs: This must be replaced by the core-to-plc plugin during compilation: error CallStack (from HasCallStack): error, called at src/PlutusTx/Utils.hs:7:26 in plutus-tx-0.1.0.0-I9Dln998VX1LKsuzHCjcJz:PlutusTx.Utils

Do I need to upgrade versions or is there something wrong with my code?

    import           Control.Monad          hiding (fmap)
import           Data.Aeson             (ToJSON, FromJSON)
import           Data.Text              (Text)
import           Data.Void              (Void)
import           GHC.Generics           (Generic)
import           Data.Map              as Map hiding (foldl)
import           Plutus.Contract        
import           Plutus.Contract        as Contract
import           Ledger.Address         as Add
import           Plutus.Trace.Emulator  as Emulator
import qualified PlutusTx
import           Ledger                 hiding (mint, singleton)
import           Ledger.Constraints     as Constraints
import qualified Ledger.Typed.Scripts   as Scripts
import           Ledger.Value           as Value
import           Playground.Contract    (printJson, printSchemas, ensureKnownCurrencies, stage, ToSchema)
import           Playground.TH          (mkKnownCurrencies, mkSchemaDefinitions)
import           Playground.Types       (KnownCurrency (..))
import           Prelude                (IO, Show (..), String)
import           Text.Printf            (printf)
import           Wallet.Emulator.Wallet
import           Wallet.Effects         as Effects
import qualified PlutusTx.Builtins      as Builtins
import           Plutus.V1.Ledger.Ada as Ada
import           Ledger.Tx              (scriptTxOut, ChainIndexTxOut)
import           Plutus.ChainIndex.Tx 
import           Ledger.Blockchain 
import           Playground.Contract
import           PlutusTx.Prelude     hiding (Semigroup(..), unless)
import           Prelude              (IO, Semigroup (..), String, Show(..))
import qualified Prelude              as Haskell
import           Cardano.Api hiding (Value, TxOut,Address)
import           Cardano.Api.Shelley hiding (Value, TxOut, Address)
import           Codec.Serialise hiding (encode)
import           Plutus.ChainIndex as Chain




minADA :: Value
minADA = Ada.lovelaceValueOf 2000000

price :: Value 
price = Ada.lovelaceValueOf 12000000

data ContractInfo = ContractInfo
    { policyID :: !CurrencySymbol
    , walletOwner :: !PubKeyHash
    , nameOfToken :: !TokenName
    } deriving (Generic, ToJSON, FromJSON)


contractInfo = ContractInfo 
    { policyID = "8b0dbdd6504ff8f129400ab3b21f12a52ffb09f0b3cff594cb5bb868"
    , walletOwner = "a2c20c77887ace1cd986193e4e75babd8993cfd56995cd5cfce609c2"
    , nameOfToken = "reward"
    }

--purchase portion of the contract 
data LootBoxData
instance Scripts.ValidatorTypes LootBoxData where
    type instance RedeemerType LootBoxData = ()
    type instance DatumType LootBoxData = Integer

--Checks the validatorHash to make sure the LootBox has tokens to host the transaction
--If never changed by the end of the project use the builtins script validator
{-# INLINABLE mkValidator #-}
mkValidator :: Integer -> () -> ScriptContext -> Bool
mkValidator i x ctx = True

lootBox :: Scripts.TypedValidator LootBoxData
lootBox = Scripts.mkTypedValidator @LootBoxData
    $$(PlutusTx.compile [|| mkValidator ||])
    $$(PlutusTx.compile [|| wrap ||]) where
        wrap = Scripts.wrapValidator @Integer @()

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

validate :: Validator
validate = Scripts.validatorScript lootBox

valAddress :: Address
valAddress = Scripts.validatorAddress lootBox



--Start of minting portion of the smart contract

{-# INLINABLE mkPolicy #-}
mkPolicy :: PubKeyHash -> () -> ScriptContext -> Bool
mkPolicy pkh () ctx = txSignedBy (scriptContextTxInfo ctx) pkh

policy :: PubKeyHash -> Scripts.MintingPolicy
policy pkh = mkMintingPolicyScript $
    $$(PlutusTx.compile [|| Scripts.wrapMintingPolicy . mkPolicy||])
    `PlutusTx.applyCode`
    (PlutusTx.liftCode pkh)

--dont need
curSymbol :: PubKeyHash -> CurrencySymbol
curSymbol = scriptCurrencySymbol . policy

data MintParams = MintParams
    { mpAmount    :: !Integer
    } deriving (Generic, ToJSON, FromJSON, ToSchema)

PlutusTx.makeLift ''MintParams


--Start of endpoints
type SignedSchema = 
    Endpoint "mint" MintParams
     .\/ Endpoint "lock" MintParams
     .\/ Endpoint "purchase" ()

mint :: AsContractError e => MintParams -> Contract w s e ()
mint mp = do
    ppkh <- Contract.ownPaymentPubKeyHash
    let pkh     = unPaymentPubKeyHash ppkh
        val     = Value.singleton (curSymbol pkh) (nameOfToken contractInfo) (mpAmount mp)
        lookups = Constraints.mintingPolicy $ policy (pkh)
        tx      = Constraints.mustMintValue val
    ledgerTx <- submitTxConstraintsWith @Void lookups tx
    void $ awaitTxConfirmed $ getCardanoTxId ledgerTx
    logInfo @String $ printf "forged %s" (show val)

lock :: MintParams -> Contract w SignedSchema Text ()
lock mp =  do
-- make a recusive function that allows for the creation of a 1000 utxos of diffrent datums from a wallet (cheap if implemented correctly) 
        
    let v   = Value.singleton (policyID contractInfo) (nameOfToken contractInfo) (mpAmount mp) <> minADA
        tx  =   foldl
                (\acc i -> acc <> (Constraints.mustPayToTheScript (i) $ v))
                (TxConstraints [] [] [])
                [1..1000]
                
    void (submitTxConstraints lootBox tx)

purchase :: () -> Contract w SignedSchema Text ()
purchase _ =  do
    utxos <- utxosAt valAddress
    
    let outputs = Map.toList utxos
        r      = Redeemer $ PlutusTx.toBuiltinData ()
        (oref, o) = head outputs
        ppkh     = walletOwner contractInfo
        lookups = Constraints.unspentOutputs utxos <>
                  Constraints.otherScript validate
        tx      = mustPayToPubKey (Add.PaymentPubKeyHash ppkh) price <> mconcat [Constraints.mustSpendScriptOutput oref unitRedeemer ] 
    ledgerTx <- submitTxConstraintsWith @Void lookups tx
    void $ awaitTxConfirmed $ getCardanoTxId ledgerTx
    logInfo @String $ "loot box used"

-- Sort through the Utxos so that it only collect the right one

endpoints :: Contract () SignedSchema Text ()
endpoints = awaitPromise (mint' `select` lock' `select` purchase') >> endpoints
  where
    mint' = endpoint @"mint" mint
    lock' = endpoint @"lock" lock
    purchase' = endpoint @"purchase" purchase

mkSchemaDefinitions ''SignedSchema

mkKnownCurrencies []
2
  • With tag: 62efdd2bfab3e076d40e07f8f4d7864a7f2ccc9 (week05) also fails.
    – kindofdev
    Feb 15, 2022 at 19:35
  • I don't see the pragmas at the beginning of the module in your code...
    – kindofdev
    Feb 15, 2022 at 19:38

1 Answer 1

2

After debugging your code I've found that the issue comes from lock contract which it's not minting nor transferring funds to the script. So when you try to purchase there's no utxo sitting at the script address. I guess that the weird error comes from this line:

(oref, o) = head outputs   

takeaway 1: never use head because if the list is empty you'll get an exception

If in the purchase contract you check whether the list is not empty before continuing (like in purchase below), the weird error will disappear. However, the purchase is not going to work because there's nothing purchase.

purchase :: () -> Contract w SignedSchema Text ()
purchase _ =  do
    utxos <- utxosAt valAddress
    unless (Haskell.null utxos) $ do   -- HERE checks whether there's any utxo.
        let outputs = Map.toList utxos
            r      = Redeemer $ PlutusTx.toBuiltinData ()
            (oref, o) = head outputs
            ppkh     = walletOwner contractInfo
            lookups = Constraints.unspentOutputs utxos <>
                    Constraints.otherScript validate
            tx      = mustPayToPubKey (Add.PaymentPubKeyHash ppkh) price <> mconcat [Constraints.mustSpendScriptOutput oref unitRedeemer ] 
        ledgerTx <- submitTxConstraintsWith @Void lookups tx
        void $ awaitTxConfirmed $ getCardanoTxId ledgerTx
        logInfo @String $ "loot box used"

You can check all of this reducing your scenario to only lock and then wait. You'll see no funds going to the script.

Ok, now the FIX.

Why doesn't lock contract work ? Basically, because it's uncompleted. You missed the lookups for the validator and the minting policy script, and also the constraint for mint values. (I think you copied-pasted from other thread (takeaway 2)). I've implemented the following code which locks funds properly.

lock :: MintParams -> Contract w SignedSchema Text ()
lock mp =  do
-- make a recusive function that allows for the creation of a 100 utxos of diffrent datums from a wallet (cheap if implemented correctly) 
    pkh <- unPaymentPubKeyHash <$> Contract.ownPaymentPubKeyHash
    let n            = 10  -- If you need 100 you must use a custom configuration different to the default one (1000 ADAS per wallet)
        symbol       = curSymbol pkh
        tn           = nameOfToken contractInfo
        tokenPerUtxo = Value.singleton symbol tn (mpAmount mp)
        adaPerUtxo   = minADA
        valuePerUtxo = tokenPerUtxo <> adaPerUtxo
        tx           = foldl
                         (\acc i -> acc <> Constraints.mustPayToTheScript i valuePerUtxo)
                         (TxConstraints [] [] [])
                         [1..(Haskell.fromIntegral n)]
                    <> Constraints.mustMintValue (mconcat (Haskell.replicate n tokenPerUtxo )) 
        lookups = Constraints.typedValidatorLookups lootBox
                <> Constraints.mintingPolicy (policy pkh)

Your code might have more issues (I haven't tested the full workflow), but at least now you can lock funds in the script address, and hopefully you'll be able to purchase. Good luck!

As a side note if I were you, I'd use traces (Emulator.Trace) with different scenarios instead of the playground. Errors are more meaningful and you'll debug the code faster (takeaway 3).

Hope this will be useful.

Your Answer

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

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