IntersectMBO / plutus

The Plutus language implementation and tools
Apache License 2.0
1.56k stars 479 forks source link

GHC Core to PLC plugin: E042:Error: Unsupported feature: Type constructor: GHC.Prim.ByteArray# with no literals #3946

Closed gpsanant closed 2 years ago

gpsanant commented 3 years ago

Area

[x] Plutus Foundation Related to the GHC plugin, Haskell-to-Plutus compiler, on-chain code [] Plutus Application Framework Related to the Plutus application backend (PAB), emulator, Plutus libraries [] Marlowe Related to Marlowe [] Other Any other topic (Playgrounds, etc.)

Summary

I keep running into the following compiler error

GHC Core to PLC plugin: E042:Error: Unsupported feature: Type constructor: GHC.Prim.ByteArray#
Context: Compiling type: GHC.Prim.ByteArray#
Context: Compiling data constructor type: GHC.Integer.Type.BN#
Context: Compiling type: GHC.Integer.Type.BigNat
Context: Compiling data constructor type: GHC.Natural.NatJ#
Context: Compiling type: GHC.Natural.Natural
Context: Compiling data constructor type: PlutusCore.Core.Type.Version
Context: Compiling type: PlutusCore.Core.Type.Version ann
Context: Compiling data constructor type: UntypedPlutusCore.Core.Type.Program
Context: Compiling type: UntypedPlutusCore.Core.Type.Program
                           PlutusCore.DeBruijn.Internal.DeBruijn
                           PlutusCore.Default.Universe.DefaultUni
                           PlutusCore.Default.Builtins.DefaultFun
                           ()
Context: Compiling type: Plutus.V1.Ledger.Scripts.Script
Context: Compiling type: Plutus.V1.Ledger.Scripts.Validator
Context: Compiling type: Plutus.V1.Ledger.Scripts.Validator
                         -> Data.ByteString.Internal.ByteString
Context: Compiling definition of: Ledger.Scripts.validatorHash_$sscriptHash
Context: Compiling expr: Ledger.Scripts.validatorHash_$sscriptHash
Context: Compiling expr: Ledger.Scripts.validatorHash_$sscriptHash
                           (case EigenLayer.TruthMarket.typedTruthMarketValidator
                                   (EigenLayer.TruthMarket.$WTruthMarketParams
                                      (case potentialTmDatum of
                                       { EigenLayer.EigenLayerUtils.TruthMarketDatum ds1 [Occ=Once]
...

Steps to reproduce

Copy the following files into the same directory.

I am trying to load the TruthMarketFactory.hs contract.

{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE DeriveAnyClass      #-}
{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE NoImplicitPrelude   #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell     #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE TypeFamilies        #-}
{-# LANGUAGE TypeOperators       #-}
{-# OPTIONS_GHC -fno-strictness #-}
{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-}
{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
{-# OPTIONS_GHC -fobject-code #-}

module  EigenLayer.TruthMarketFactory where

import           Control.Monad          hiding (fmap)
import           Data.Aeson             (ToJSON, FromJSON)
import           Data.Text              (Text)
import           Data.Void              (Void)
import           Plutus.Contract        as Contract
import           Plutus.Trace.Emulator  as Emulator
import qualified PlutusTx
import           PlutusTx.Prelude       hiding (Semigroup(..), unless)
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           Text.Printf            (printf)
import           Wallet.Emulator.Wallet
import           PlutusTx.Eq
import qualified Basement.Compat.Base as Base
import qualified Plutus.Contract.StateMachine as SM
import qualified EigenLayer.TruthMarket as TM
import           EigenLayer.EigenLayerUtils  

data EigenLayerInitialDatum = EigenLayerInitialDatum
    {   latestDumpNumber            :: !Integer 
    ,   latestOutcome               :: !BuiltinByteString
    } 

PlutusTx.unstableMakeIsData ''EigenLayerInitialDatum

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

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

{-# INLINABLE mkPolicy #-}
mkPolicy :: AssetClass -> AssetClass -> PubKeyHash -> Integer -> ScriptContext -> Bool
mkPolicy elidNFT collatAsset pkh dn ctx = 
            traceIfFalse "Dump number is not valid yet"  (from (expectedDumpTime dn) `contains` txInfoValidRange info)  &&
            traceIfFalse "ELID is not updated in the transaction" secondOutputHasELIDNFT  &&
            let tm = truthMarketDatum
                elidDatum = eigenLayerInitialDatum in
                traceIfFalse "ELID is not updated correctly in transaction" (outcome tm == latestOutcome elidDatum) -- &&
                -- traceIfFalse "ELID is not updated correctly in transaction" (tmEqual tm $ initTruthMarketDatum dn pkh (outcome tm) (truthMarketColateral) (expectedDumpTime dn) ) -- &&

            -- traceIfFalse "Dump number is not the same in ELID and TM" 
    where
        info :: TxInfo
        info = scriptContextTxInfo ctx

        secondOutput :: TxOut
        secondOutput = case txInfoOutputs info of 
            (a:b:_) -> b
            _ -> traceError "Second output doesn't exist"

        secondOutputHasELIDNFT :: Bool
        secondOutputHasELIDNFT = case txInfoOutputs info of 
            (a:b:_) -> assetClassValueOf (txOutValue b) elidNFT == 1
            _ -> False

        truthMarketColateral :: Integer
        truthMarketColateral = assetClassValueOf (txOutValue firstOutput) collatAsset

        eigenLayerInitialDatum :: EigenLayerInitialDatum
        eigenLayerInitialDatum = case eigenLayerInitialDatumFromOutput secondOutput (`findDatum` info) of
            Nothing -> traceError "ELID output datum not found"
            Just d  -> d

        firstOutput :: TxOut 
        firstOutput = case txInfoOutputs info of
            (o:_) -> o
            _      -> traceError "expected exactly one oracle output"

        truthMarketDatumWithoutCheckingAddress :: TruthMarketDatum
        truthMarketDatumWithoutCheckingAddress = case truthMarketDatumFromOutput firstOutput (`findDatum` info) of
            Nothing -> traceError "TruthMarketDatum not found"
            Just d -> d

        truthMarketDatum :: TruthMarketDatum
        truthMarketDatum = let potentialTmDatum = truthMarketDatumWithoutCheckingAddress
                               in 
            if (txOutAddress firstOutput) == (TM.truthMarketAddress 
                                                    TM.TruthMarketParams{
                                                        TM.tmDumpNumber=(dumpNumber potentialTmDatum), 
                                                        TM.threadToken=SM.ThreadToken{
                                                            SM.ttOutRef=TxOutRef{
                                                                txOutRefId=(txInfoId info),
                                                                txOutRefIdx=0 
                                                            },
                                                            SM.ttCurrencySymbol=(ownCurrencySymbol ctx)
                                                        }
                                                    }
                                            )
                then potentialTmDatum
            else traceError "Truth market datum is incorrect"

        -- validateElidDatumUpdate :: TruthMarketDatum -> EigenLayerInitialDatum -> EigenLayerInitialDatum -> Bool
        -- validateElidDatumUpdate tmDatum elidDatum outElidDatum = (dumpNumber tmDatum) == (latestDumpNumber elidDatum + 1) 
        --     && ((outcome tmDatum) == (latestOutcome outElidDatum) && (dumpNumber tmDatum) == (latestDumpNumber outElidDatum))

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

curSymbol :: AssetClass -> AssetClass -> PubKeyHash -> CurrencySymbol
curSymbol elidNFT collatAsset pkh = scriptCurrencySymbol $ policy elidNFT collatAsset pkh 

This is TruthMarket.hs

{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DeriveAnyClass        #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE DerivingStrategies    #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE NoImplicitPrelude     #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE ViewPatterns          #-}
{-# OPTIONS_GHC -fno-strictness #-}
{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-}
{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
{-# OPTIONS_GHC -fobject-code #-}
-- | A state machine with two states and two roles that take turns.
module EigenLayer.TruthMarket (
    TruthMarketParams(..),
    -- TruthMarketSchema(..),
    TruthMarketError(..),
    TruthMarketDatum(..),
    InitialiseParams(..),
    truthMarketStateMachine,
    truthMarketAddress,
    -- outcome1, outcome2,
    -- initialiseMarket,
    -- test',
    -- makeIp,
    -- getPkh
    -- initialiseTruthMarket
    -- runPing,
    -- runPong,
    -- ping,
    -- pong,
    -- initialise,
    -- runStop,
    -- runWaitForUpdate,
    -- combined,
    -- simplePingPong
    ) where

import           Control.Lens
import           Control.Monad                (forever, void)
import           Control.Monad.Freer.Extras as Extras
import           Data.Aeson                   (FromJSON, ToJSON)
import           Data.Monoid                  (Last (..))
import           Data.Text                    (Text, pack)
import qualified Ledger.Ada                   as Ada
import           Ledger.Constraints           as Constraints
import qualified Ledger.Typed.Scripts         as Scripts
import           Plutus.Contract              as Contract
import           Ledger.Typed.Tx              (TypedScriptTxOut (..))
import qualified PlutusTx
import           PlutusTx.Prelude             hiding (Applicative (..), check)
import           Ledger                       hiding (singleton)
import           Plutus.Contract
import qualified PlutusTx.AssocMap
import           Plutus.Contract.StateMachine (AsSMContractError (..), OnChainState, State (..), Void)
import qualified Plutus.Contract.StateMachine as SM
import qualified Basement.Compat.Base as Base
import           Playground.Contract        
import           Wallet.Emulator.Wallet
import           Plutus.Trace.Emulator  as Emulator
import           EigenLayer.EigenLayerUtils
import           PlutusTx.Builtins
import           PlutusTx.Builtins.Internal

data TruthMarketAction = Bet PubKeyHash BuiltinByteString Integer | Settle PubKeyHash | Claim PubKeyHash 
    deriving Base.Show

data TruthMarketParams =  TruthMarketParams{
      tmDumpNumber :: !Integer
    , threadToken  :: !SM.ThreadToken
}

PlutusTx.unstableMakeIsData ''TruthMarketAction
PlutusTx.makeLift ''TruthMarketParams
PlutusTx.unstableMakeIsData ''TruthMarketDatum

data InitialiseParams = InitialiseParams{
    initialiseDumpNumber :: !Integer,
    initialiseOutcome    :: !BuiltinByteString,
    initialiseAmt        :: !Integer
} deriving (Base.Show, Generic, FromJSON, ToJSON)

data BetParams = BetParams {
    betDumpNumber :: !Integer,
    betOutcome    :: !BuiltinByteString,
    betThreadToken   :: !SM.ThreadToken,
    betAmt           :: !Integer
} deriving (Base.Show, Generic, FromJSON, ToJSON)

data SettleParams = SettleParams {
    settleDumpNumber :: !Integer,
    settleThreadToken :: !SM.ThreadToken
} deriving (Base.Show, Generic, FromJSON, ToJSON)

data ClaimParams = ClaimParams {
    claimDumpNumber :: !Integer,
    claimThreadToken :: !SM.ThreadToken
} deriving (Base.Show, Generic, FromJSON, ToJSON)

-- type TruthMarketSchema = 
--     Endpoint "initialise" InitialiseParams .\/
--     Endpoint "bet" BetParams -- .\/ 
--     -- Endpoint "settle" SettleParams .\/ 
--     -- Endpoint "claim" ClaimParams

data TruthMarketError =
    TruthMarketContractError ContractError
    | TruthMarketSMError SM.SMContractError
    | StoppedUnexpectedly
    deriving stock (Base.Show, Generic)
    deriving anyclass (ToJSON, FromJSON)

makeClassyPrisms ''TruthMarketError

instance AsSMContractError TruthMarketError where
    _SMContractError = _TruthMarketSMError

instance AsContractError TruthMarketError where
    _ContractError = _TruthMarketContractError

{-# INLINABLE lovelaces #-}
lovelaces :: Value -> Integer
lovelaces = Ada.getLovelace . Ada.fromValue

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

{-# INLINABLE transition #-}
transition :: TruthMarketParams -> State TruthMarketDatum -> TruthMarketAction -> Maybe (TxConstraints Void Void, State TruthMarketDatum)
transition tmp s r = case (stateValue s, stateData s, r) of
    (v, tm, Bet pkh outcome amt) -> case betAfterTeller tm pkh outcome amt of
        Just modifiedTm -> Just ( Constraints.mustBeSignedBy pkh  <>
                                  Constraints.mustValidateIn (Ledger.to $ checkpointTime tm)
                                , State modifiedTm (v <> Ada.lovelaceValueOf amt)
                                )
        Nothing         -> Nothing
    (v, tm, Settle pkh) -> Just ( Constraints.mustBeSignedBy pkh <>
                                           Constraints.mustValidateIn (Ledger.from $ checkpointTime tm)
                                         , State tm $ Ada.lovelaceValueOf (lovelaces v - 100) 
                                         )
    (v, tm, Claim pkh) -> Just ( Constraints.mustBeSignedBy pkh <>
                              Constraints.mustValidateIn (Ledger.from $ checkpointTime tm)
                              , State tm $ Ada.lovelaceValueOf (lovelaces v - 100) 
                            )
    _ -> Nothing
    where 

{-# INLINABLE final #-}
final :: TruthMarketDatum -> Bool
final _        = False

{-# INLINABLE check #-}
check :: TruthMarketParams -> TruthMarketDatum -> TruthMarketAction -> ScriptContext -> Bool
check _ _ _ _ = True

{-# INLINABLE truthMarketStateMachine #-}
truthMarketStateMachine :: TruthMarketParams -> SM.StateMachine TruthMarketDatum TruthMarketAction
truthMarketStateMachine tmp = SM.StateMachine
    { SM.smTransition  = transition tmp
    , SM.smFinal       = final
    , SM.smCheck       = check tmp
    , SM.smThreadToken = Just $ threadToken tmp
    }

{-# INLINABLE mkTruthMarketValidator #-}
mkTruthMarketValidator :: TruthMarketParams -> TruthMarketDatum -> TruthMarketAction -> ScriptContext -> Bool
mkTruthMarketValidator tmp = SM.mkValidator $ truthMarketStateMachine tmp

type TruthMarketing = SM.StateMachine TruthMarketDatum TruthMarketAction

{-# INLINABLE typedTruthMarketValidator #-}
typedTruthMarketValidator :: TruthMarketParams -> Scripts.TypedValidator TruthMarketing
typedTruthMarketValidator tmp = Scripts.mkTypedValidator @TruthMarketing
    ($$(PlutusTx.compile [|| mkTruthMarketValidator ||])
        `PlutusTx.applyCode` PlutusTx.liftCode tmp)
    $$(PlutusTx.compile [|| wrap ||])
  where
    wrap = Scripts.wrapValidator @TruthMarketDatum @TruthMarketAction

{-# INLINABLE truthMarketValidator #-}
truthMarketValidator :: TruthMarketParams -> Validator
truthMarketValidator = Scripts.validatorScript . typedTruthMarketValidator

{-# INLINABLE truthMarketAddress #-}
truthMarketAddress :: TruthMarketParams -> Ledger.Address
truthMarketAddress = scriptAddress . truthMarketValidator

truthMarketClient :: TruthMarketParams -> SM.StateMachineClient TruthMarketDatum TruthMarketAction
truthMarketClient tmp = SM.mkStateMachineClient $ SM.StateMachineInstance (truthMarketStateMachine tmp) (typedTruthMarketValidator tmp)

Where

data TruthMarketDatum = TruthMarketDatum
    {   dumpNumber            :: !BuiltinInteger 
    ,   outcome               :: !BuiltinByteString
    ,   outcomeDetermined     :: !Bool
    ,   pots                  :: !(PlutusTx.AssocMap.Map BuiltinByteString BuiltinInteger)
    ,   bets                  :: !(PlutusTx.AssocMap.Map BuiltinByteString (PlutusTx.AssocMap.Map PubKeyHash BuiltinInteger))
    ,   totalPot              :: !BuiltinInteger
    ,   potCheckpoint         :: !BuiltinInteger
    ,   checkpointTime        :: !POSIXTime
    ,   teller                :: !PubKeyHash
    ,   tellerOutcome         :: !BuiltinByteString
    } deriving (Base.Show, PlutusTx.Eq.Eq)

Expected behavior

I want this to compile but something seems to be uncompilable here...

System info (please complete the following information):

ghost commented 3 years ago

The error happens because of truthMarketAddress usage. Scripts.mkTypedValidator and Scripts.validatorScript are off-chain functions and plutus can't compile them. You should use mkTruthMarketValidator directly.

gpsanant commented 3 years ago

The error happens because of truthMarketAddress usage. Scripts.mkTypedValidator and Scripts.validatorScript are off-chain functions and plutus can't compile them. You should use mkTruthMarketValidator directly.

Thanks for the clarification. How would I go about getting the address from the mkTruthMarketValidator output?

ghost commented 3 years ago

I guess you need to introduce a new argument validatorHash to policy and mkPolicy functions and pass the hash to them.

gpsanant commented 3 years ago

I guess you need to introduce a new argument validatorHash to policy and mkPolicy functions and pass the hash to them.

What if the validator is parameterized as in this case? Within another script, how would I refer to the address of a script with a parameterized validator given the parameter?

ghost commented 3 years ago

Well I can only suggest to try and check. There is a limitation that you can't mix on-chain and off-chain code. You can pass values as arguments, but without direct calling.

gpsanant commented 3 years ago

Well I can only suggest to try and check. There is a limitation that you can't mix on-chain and off-chain code. You can pass values as arguments, but without direct calling.

People haven't run into this before? Getting a parameterized script address from within another script seems like it would be a pretty common task. Have you seen any solutions for this?

michaelpj commented 3 years ago

Within another script, how would I refer to the address of a script with a parameterized validator given the parameter?

What I think you're asking is impossible. I think you're asking: "on-chain, I want to be passed a parameter at runtime, and then calculate the hash of whatever the parameterized validator would look like, given that parameter". That would require running the whole compiler. If you want to compute with scripts themselves you have to do that off-chain, and then you can pass in the hash to another script.

ghost commented 2 years ago

Closing this issue as the initial problem was solved.