Skip to main content
Cardano

Return to Question

Became Hot Network Question
edited body
Source Link
SwiftlyUnmoving
SwiftlyUnmoving
  • 114
  • 5
module Foo.Offchain where
import Plutus.V1.Ledger.Scripts (MintingPolicy)
import Plutus.V1.Ledger.Address (Address)

import Cardano.Hydra.Cardano.API
import Hydra.Prelude
import Test.Hydra.Prelude
import Cardano.Api.UTxO qualified as UTxO

import Foo.Onchain(fooPolicy)

userAddress :: Address ShelleyAddr
...

txFoo = do
  let policyScript = fromPlutusScript @PlutusScriptV2 
        $ getMintingPolicy fooPolicy
      policyId = PolicyId $ hashScript $ PlutusScript policyScript
      mintingWitness = BuildTxWith . Map.singleton policyId
        $ mkScriptWitness policyScript NoScriptDatumForMint (toScriptData ())
      mintingValue = valueFromList [(AssetId policyId "", 1)]
  ...
  pparams <- queryProtocolParameters networkId nodeSocket QueryTip
  systemStart <- querySystemStart networkId nodeSocket QueryTip
  eraHistory <- queryEraHistory networkId nodeSocket QueryTip
  stakePools <- queryStakePools networkId nodeSocket QueryTip
  utxoSet <- ...
  someUtxo <- ...
  someTxOut <- ...
  ...
  let unbalancedBody =
        TxBodyContent
          (withWitness <$> toList (UTxO.inputSet utxoSet))
          (TxInsCollateral [someUtxo])
          TxInsReferenceNone
          [someTxOut]
          TxTotalCollateralNone
          TxReturnCollateralNone
          (TxFeeExplicit 0)
          (TxValidityNoLowerBound, TxValidityNoUpperBound)
          TxMetadataNone
          TxAuxScriptsNone
          TxExtraKeyWitnessesNone
          (BuildTxWith $ Just pparams)
          TxWithdrawalsNone
          TxCertificatesNone
          TxUpdateProposalNone
          (TxMintValue mintingValue mintingWitness)
          TxScriptValidityNone
  let balancedBody = either (error . show) balancedTxBody $
        makeTransactionBodyAutoBalance
          BabbageEraInCardanoMode
          systemStart
          eraHistory
          pparams
          stakePools
          (UTxO.toApi utxoSet)
          preBody
          (ShelleyAddressInEra userAddress)
          Nothing

module Foo.Offchain where
import Plutus.V1.Ledger.Scripts (MintingPolicy)
import Plutus.V1.Ledger.Address (Address)

import Cardano.Hydra.API
import Hydra.Prelude
import Test.Hydra.Prelude
import Cardano.Api.UTxO qualified as UTxO

import Foo.Onchain(fooPolicy)

userAddress :: Address ShelleyAddr
...

txFoo = do
  let policyScript = fromPlutusScript @PlutusScriptV2 
        $ getMintingPolicy fooPolicy
      policyId = PolicyId $ hashScript $ PlutusScript policyScript
      mintingWitness = BuildTxWith . Map.singleton policyId
        $ mkScriptWitness policyScript NoScriptDatumForMint (toScriptData ())
      mintingValue = valueFromList [(AssetId policyId "", 1)]
  ...
  pparams <- queryProtocolParameters networkId nodeSocket QueryTip
  systemStart <- querySystemStart networkId nodeSocket QueryTip
  eraHistory <- queryEraHistory networkId nodeSocket QueryTip
  stakePools <- queryStakePools networkId nodeSocket QueryTip
  utxoSet <- ...
  someUtxo <- ...
  someTxOut <- ...
  ...
  let unbalancedBody =
        TxBodyContent
          (withWitness <$> toList (UTxO.inputSet utxoSet))
          (TxInsCollateral [someUtxo])
          TxInsReferenceNone
          [someTxOut]
          TxTotalCollateralNone
          TxReturnCollateralNone
          (TxFeeExplicit 0)
          (TxValidityNoLowerBound, TxValidityNoUpperBound)
          TxMetadataNone
          TxAuxScriptsNone
          TxExtraKeyWitnessesNone
          (BuildTxWith $ Just pparams)
          TxWithdrawalsNone
          TxCertificatesNone
          TxUpdateProposalNone
          (TxMintValue mintingValue mintingWitness)
          TxScriptValidityNone
  let balancedBody = either (error . show) balancedTxBody $
        makeTransactionBodyAutoBalance
          BabbageEraInCardanoMode
          systemStart
          eraHistory
          pparams
          stakePools
          (UTxO.toApi utxoSet)
          preBody
          (ShelleyAddressInEra userAddress)
          Nothing

module Foo.Offchain where
import Plutus.V1.Ledger.Scripts (MintingPolicy)
import Plutus.V1.Ledger.Address (Address)

import Hydra.Cardano.API
import Hydra.Prelude
import Test.Hydra.Prelude
import Cardano.Api.UTxO qualified as UTxO

import Foo.Onchain(fooPolicy)

userAddress :: Address ShelleyAddr
...

txFoo = do
  let policyScript = fromPlutusScript @PlutusScriptV2 
        $ getMintingPolicy fooPolicy
      policyId = PolicyId $ hashScript $ PlutusScript policyScript
      mintingWitness = BuildTxWith . Map.singleton policyId
        $ mkScriptWitness policyScript NoScriptDatumForMint (toScriptData ())
      mintingValue = valueFromList [(AssetId policyId "", 1)]
  ...
  pparams <- queryProtocolParameters networkId nodeSocket QueryTip
  systemStart <- querySystemStart networkId nodeSocket QueryTip
  eraHistory <- queryEraHistory networkId nodeSocket QueryTip
  stakePools <- queryStakePools networkId nodeSocket QueryTip
  utxoSet <- ...
  someUtxo <- ...
  someTxOut <- ...
  ...
  let unbalancedBody =
        TxBodyContent
          (withWitness <$> toList (UTxO.inputSet utxoSet))
          (TxInsCollateral [someUtxo])
          TxInsReferenceNone
          [someTxOut]
          TxTotalCollateralNone
          TxReturnCollateralNone
          (TxFeeExplicit 0)
          (TxValidityNoLowerBound, TxValidityNoUpperBound)
          TxMetadataNone
          TxAuxScriptsNone
          TxExtraKeyWitnessesNone
          (BuildTxWith $ Just pparams)
          TxWithdrawalsNone
          TxCertificatesNone
          TxUpdateProposalNone
          (TxMintValue mintingValue mintingWitness)
          TxScriptValidityNone
  let balancedBody = either (error . show) balancedTxBody $
        makeTransactionBodyAutoBalance
          BabbageEraInCardanoMode
          systemStart
          eraHistory
          pparams
          stakePools
          (UTxO.toApi utxoSet)
          preBody
          (ShelleyAddressInEra userAddress)
          Nothing
Source Link
SwiftlyUnmoving
SwiftlyUnmoving
  • 114
  • 5

Unclear error during Plutus ScriptContext construction (force headList [])

I ran into an error while trying to autobalance a transaction body:

module Foo.Offchain where
import Plutus.V1.Ledger.Scripts (MintingPolicy)
import Plutus.V1.Ledger.Address (Address)

import Cardano.Hydra.API
import Hydra.Prelude
import Test.Hydra.Prelude
import Cardano.Api.UTxO qualified as UTxO

import Foo.Onchain(fooPolicy)

userAddress :: Address ShelleyAddr
...

txFoo = do
  let policyScript = fromPlutusScript @PlutusScriptV2 
        $ getMintingPolicy fooPolicy
      policyId = PolicyId $ hashScript $ PlutusScript policyScript
      mintingWitness = BuildTxWith . Map.singleton policyId
        $ mkScriptWitness policyScript NoScriptDatumForMint (toScriptData ())
      mintingValue = valueFromList [(AssetId policyId "", 1)]
  ...
  pparams <- queryProtocolParameters networkId nodeSocket QueryTip
  systemStart <- querySystemStart networkId nodeSocket QueryTip
  eraHistory <- queryEraHistory networkId nodeSocket QueryTip
  stakePools <- queryStakePools networkId nodeSocket QueryTip
  utxoSet <- ...
  someUtxo <- ...
  someTxOut <- ...
  ...
  let unbalancedBody =
        TxBodyContent
          (withWitness <$> toList (UTxO.inputSet utxoSet))
          (TxInsCollateral [someUtxo])
          TxInsReferenceNone
          [someTxOut]
          TxTotalCollateralNone
          TxReturnCollateralNone
          (TxFeeExplicit 0)
          (TxValidityNoLowerBound, TxValidityNoUpperBound)
          TxMetadataNone
          TxAuxScriptsNone
          TxExtraKeyWitnessesNone
          (BuildTxWith $ Just pparams)
          TxWithdrawalsNone
          TxCertificatesNone
          TxUpdateProposalNone
          (TxMintValue mintingValue mintingWitness)
          TxScriptValidityNone
  let balancedBody = either (error . show) balancedTxBody $
        makeTransactionBodyAutoBalance
          BabbageEraInCardanoMode
          systemStart
          eraHistory
          pparams
          stakePools
          (UTxO.toApi utxoSet)
          preBody
          (ShelleyAddressInEra userAddress)
          Nothing

I got the following error:

TxBodyScriptExecutionError
  [ ( ScriptWitnessIndexMint 0
    , ScriptErrorEvaluationFailed
        (CekError An error has occurred:
           User error:
             The machine terminated because of an error, either from a built-in
             function or from an explicit use of 'error'.
           Caused by: (force headList [])
        )
        []
    )
  ]

The strange thing is that I still get this error even if I reduce fooPolicy down to a trivial check that depends only the ScriptContext:

module Foo.Onchain where

import PlutusTx.Prelude
import Plutus.V1.Ledger.Api (BuiltinData(..), Data(..), MintingPolicy, ScriptContext, UnsafeFromData (unsafeFromBuiltinData), mkMintingPolicyScript)
import Plutus.V1.Ledger.Contexts (ScriptPurpose(..), scriptContextPurpose)
import PlutusTx qualified

{-# INLINEABLE fooPolicyValidator #-}
fooPolicyValidator :: BuiltinData -> BuiltinData -> ScriptContext -> Bool
fooPolicyValidator _ _ ctx =
  case scriptContextPurpose ctx of
    Minting _cSymbol ->
      traceIfTrue "Here" True
    _other ->
      traceIfTrue "There" True

fooPolicy :: MintingPolicy
fooPolicy =
  mkMintingPolicyScript $
    $$(PlutusTx.compile
      [||\y z -> checkBool 
        (fooPolicyValidator
          (BuiltinData (I 0))
          (BuiltinData (I 0)) 
          (unsafeFromBuiltinData z)
        )||])

{-# INLINEABLE checkBool #-}
checkBool :: Bool -> ()
checkBool True = ()
checkBool False = traceError "Check error"

How can it be possible to get an on-chain script execution error when all that my on-chain code does is look at the script context?