Skip to content

Commit

Permalink
plutus-contract: Reduce our use of row-types, delete `BlockchainAct…
Browse files Browse the repository at this point in the history 
…ions` (#3342)

* "BlockchainActions" can be deleted, use "EmptySchema" if there are no user-defined endpoints
* Roll all 'Effects' into the 'Contract.Request' module
  • Loading branch information
@j-mueller
j-mueller authored Jun 15, 2021
1 parent fdd2ac6 commit 7c2a01f
Show file tree
Hide file tree
Showing 114 changed files with 1,634 additions and 2,599 deletions.
3 changes: 1 addition & 2 deletions doc/plutus/tutorials/BasicApps.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -78,8 +78,7 @@ data LockArgs =
deriving anyclass (ToJSON, FromJSON, ToSchema)

type SplitSchema =
BlockchainActions
.\/ Endpoint "lock" LockArgs
Endpoint "lock" LockArgs
.\/ Endpoint "unlock" LockArgs

-- BLOCK5
Expand Down
16 changes: 12 additions & 4 deletions doc/plutus/tutorials/HelloWorldApp.hs
View file
Original file line number Diff line number Diff line change
@@ -1,22 +1,30 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module HelloWorldApp where

import qualified Data.Text as T
import Playground.Contract
import Plutus.Contract hiding (when)
import Plutus.Contract
import PlutusTx.Prelude


-- BLOCK1

-- | A 'Contract' that logs a message.
hello :: Contract () BlockchainActions T.Text ()
hello :: Contract () EmptySchema T.Text ()
hello = logInfo @String "Hello, world"

-- BLOCK2

endpoints :: Contract () BlockchainActions T.Text ()
endpoints :: Contract () EmptySchema T.Text ()
endpoints = hello

mkSchemaDefinitions ''BlockchainActions
type DummySchema = Endpoint "dummy" ()

mkSchemaDefinitions ''DummySchema

$(mkKnownCurrencies [])
2 changes: 1 addition & 1 deletion doc/plutus/tutorials/basic-apps.rst
View file
Original file line number Diff line number Diff line change
Expand Up @@ -98,7 +98,7 @@ You are going to convert the wallet values to their corresponding public key has
That way, the user can simply identify the recipient by a number and doesn't have to enter a public key into a text box.
This type of conversion from a nickname to a unique identifier is a common task for Plutus apps.

To use the ``lock`` endpoint in our app, you call the :hsobj:`Plutus.Contract.Effects.ExposeEndpoint.endpoint` function:
To use the ``lock`` endpoint in our app, you call the :hsobj:`Plutus.Contract.Request.endpoint` function:

.. literalinclude:: BasicApps.hs
:start-after: BLOCK5
Expand Down
2 changes: 1 addition & 1 deletion marlowe-dashboard-client/src/API/Lenses.purs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -16,7 +16,7 @@ import Data.Lens (Lens')
import Data.Lens.Record (prop)
import Data.RawJson (RawJson)
import Data.Symbol (SProxy(..))
import Plutus.Contract.Effects.ExposeEndpoint (ActiveEndpoint, _ActiveEndpoint)
import Plutus.Contract.Effects (ActiveEndpoint, _ActiveEndpoint)
import Plutus.Contract.Resumable (Request, _Request)
import Plutus.PAB.Events.ContractInstanceState (PartiallyDecodedResponse, _PartiallyDecodedResponse)
import Plutus.PAB.Webserver.Types (ContractInstanceClientState, _ContractInstanceClientState)
Expand Down
2 changes: 1 addition & 1 deletion marlowe-dashboard-client/src/Capability/Contract.purs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -24,7 +24,7 @@ import Data.RawJson (RawJson)
import Foreign.Generic (class Encode)
import Halogen (HalogenM)
import Marlowe.PAB (PlutusAppId)
import Plutus.Contract.Effects.ExposeEndpoint (ActiveEndpoint)
import Plutus.Contract.Effects (ActiveEndpoint)
import Plutus.Contract.Resumable (Request)
import Plutus.PAB.Events.ContractInstanceState (PartiallyDecodedResponse)
import Plutus.PAB.Webserver.Types (ContractActivationArgs(..), ContractInstanceClientState, ContractSignatureResponse)
Expand Down
15 changes: 4 additions & 11 deletions marlowe/src/Language/Marlowe/Client.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -66,18 +66,15 @@ type MarloweSlotRange = (Slot, Slot)
type MarloweInput = (MarloweSlotRange, [Input])

type MarloweSchema =
BlockchainActions
.\/ Endpoint "create" (AssocMap.Map Val.TokenName PubKeyHash, Marlowe.Contract)
Endpoint "create" (AssocMap.Map Val.TokenName PubKeyHash, Marlowe.Contract)
.\/ Endpoint "apply-inputs" (MarloweParams, Maybe SlotInterval, [Input])
.\/ Endpoint "auto" (MarloweParams, Party, Slot)
.\/ Endpoint "redeem" (MarloweParams, TokenName, PubKeyHash)
.\/ Endpoint "close" ()


type MarloweCompanionSchema = BlockchainActions
type MarloweFollowSchema =
BlockchainActions
.\/ Endpoint "follow" MarloweParams
type MarloweCompanionSchema = EmptySchema
type MarloweFollowSchema = Endpoint "follow" MarloweParams


data MarloweError =
Expand Down Expand Up @@ -350,11 +347,7 @@ marlowePlutusContract = do

setupMarloweParams
:: forall s e i o.
( HasWriteTx s
, HasOwnPubKey s
, HasTxConfirmation s
, AsMarloweError e
)
(AsMarloweError e)
=> RoleOwners -> Marlowe.Contract -> Contract MarloweContractState s e (MarloweParams, TxConstraints i o)
setupMarloweParams owners contract = mapError (review _MarloweError) $ do
creator <- pubKeyHash <$> ownPubKey
Expand Down
9 changes: 1 addition & 8 deletions nix/pkgs/haskell/materialized-unix/.plan.nix/plutus-contract.nix
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

18 changes: 15 additions & 3 deletions playground-common/src/PSGenerator/Common.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -23,7 +23,7 @@ import Ledger (Address, Datum, Datu
TxInType, TxOut, TxOutRef, TxOutTx, UtxoIndex,
ValidationPhase, Validator)
import Ledger.Ada (Ada)
import Ledger.Constraints.OffChain (MkTxError)
import Ledger.Constraints.OffChain (MkTxError, UnbalancedTx)
import Ledger.Credential (Credential, StakingCredential)
import Ledger.DCert (DCert)
import Ledger.Index (ScriptType, ScriptValidationEvent, ValidationError)
Expand All @@ -34,6 +34,8 @@ import Ledger.Typed.Tx (ConnectionError, Wro
import Ledger.Value (CurrencySymbol, TokenName, Value)
import Playground.Types (ContractCall, FunctionSchema, KnownCurrency)
import Plutus.Contract.Checkpoint (CheckpointError)
import Plutus.Contract.Effects (ActiveEndpoint, PABReq, PABResp, UtxoAtAddress,
WriteTxResponse)
import Plutus.Contract.Resumable (IterationID, Request, RequestID, Response)
import Plutus.Trace.Emulator.Types (ContractInstanceLog, ContractInstanceMsg,
ContractInstanceTag, EmulatorRuntimeError, UserThreadMsg)
Expand All @@ -44,8 +46,9 @@ import Wallet.API (WalletAPIError)
import qualified Wallet.Emulator.Wallet as EM
import Wallet.Rollup.Types (AnnotatedTx, BeneficialOwner, DereferencedInput, SequenceId,
TxKey)
import Wallet.Types (AssertionError, ContractError, ContractInstanceId,
EndpointDescription, MatchingError, Notification,
import Wallet.Types (AddressChangeRequest, AddressChangeResponse, AssertionError,
ContractError, ContractInstanceId, EndpointDescription,
EndpointValue, MatchingError, Notification,
NotificationError, Payment)

psJson :: PSType
Expand Down Expand Up @@ -293,6 +296,15 @@ ledgerTypes =
, (order <*> (genericShow <*> mkSumType)) (Proxy @IterationID)
, (equal <*> (genericShow <*> mkSumType)) (Proxy @ScriptValidationEvent)
, (equal <*> (genericShow <*> mkSumType)) (Proxy @ScriptType)
, (equal <*> (genericShow <*> mkSumType)) (Proxy @PABReq)
, (equal <*> (genericShow <*> mkSumType)) (Proxy @PABResp)
, (equal <*> (genericShow <*> mkSumType)) (Proxy @AddressChangeRequest)
, (equal <*> (genericShow <*> mkSumType)) (Proxy @AddressChangeResponse)
, (equal <*> (genericShow <*> mkSumType)) (Proxy @(EndpointValue A))
, (equal <*> (genericShow <*> mkSumType)) (Proxy @WriteTxResponse)
, (equal <*> (genericShow <*> mkSumType)) (Proxy @UtxoAtAddress)
, (equal <*> (genericShow <*> mkSumType)) (Proxy @ActiveEndpoint)
, (equal <*> (genericShow <*> mkSumType)) (Proxy @UnbalancedTx)
]

walletTypes :: [SumType 'Haskell]
Expand Down
44 changes: 20 additions & 24 deletions playground-common/src/Playground/Contract.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -42,7 +42,6 @@ module Playground.Contract
, type (.\/)
, interval
, ownPubKey
, BlockchainActions
, awaitSlot
, modifiesUtxoSet
, nextTransactionsAt
Expand All @@ -54,30 +53,27 @@ module Playground.Contract
, Expression
) where

import Data.Aeson (FromJSON, ToJSON)
import qualified Data.Aeson as JSON
import qualified Data.ByteString.Lazy.Char8 as LBC8
import Data.List.NonEmpty (NonEmpty ((:|)))
import GHC.Generics (Generic)
import Ledger.Constraints (modifiesUtxoSet)
import Ledger.Interval (interval)
import Ledger.Scripts (ValidatorHash (ValidatorHash))
import Ledger.Tx (Tx, TxOutRef (TxOutRef), txOutRefId)
import Ledger.Value (TokenName (TokenName))
import Data.Aeson (FromJSON, ToJSON)
import qualified Data.Aeson as JSON
import qualified Data.ByteString.Lazy.Char8 as LBC8
import Data.List.NonEmpty (NonEmpty ((:|)))
import GHC.Generics (Generic)
import Ledger.Constraints (modifiesUtxoSet)
import Ledger.Interval (interval)
import Ledger.Scripts (ValidatorHash (ValidatorHash))
import Ledger.Tx (Tx, TxOutRef (TxOutRef), txOutRefId)
import Ledger.Value (TokenName (TokenName))
import Playground.Interpreter.Util
import Playground.Schema (endpointsToSchemas)
import Playground.TH (ensureKnownCurrencies, mkFunction, mkFunctions,
mkKnownCurrencies, mkSchemaDefinitions)
import Playground.Types (Expression, FunctionSchema, KnownCurrency (KnownCurrency),
adaCurrency)
import Plutus.Contract (AsContractError, BlockchainActions, Contract, Endpoint,
awaitSlot, nextTransactionsAt, submitTx, type (.\/), utxoAt,
watchAddressUntil)
import Plutus.Contract.Effects.ExposeEndpoint (endpoint)
import Plutus.Contract.Effects.OwnPubKey (ownPubKey)
import Plutus.Contract.Trace (TraceError (..))
import Schema (FormSchema, ToArgument, ToSchema)
import Wallet.Emulator.Types (Wallet (..))
import Playground.Schema (endpointsToSchemas)
import Playground.TH (ensureKnownCurrencies, mkFunction, mkFunctions, mkKnownCurrencies,
mkSchemaDefinitions)
import Playground.Types (Expression, FunctionSchema, KnownCurrency (KnownCurrency), adaCurrency)
import Plutus.Contract (AsContractError, Contract, Endpoint, awaitSlot, endpoint,
nextTransactionsAt, ownPubKey, submitTx, type (.\/), utxoAt,
watchAddressUntil)
import Plutus.Contract.Trace (TraceError (..))
import Schema (FormSchema, ToArgument, ToSchema)
import Wallet.Emulator.Types (Wallet (..))

printSchemas :: ([FunctionSchema FormSchema], [KnownCurrency]) -> IO ()
printSchemas (userSchemas, currencies) =
Expand Down
95 changes: 50 additions & 45 deletions playground-common/src/Playground/Interpreter/Util.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -14,48 +14,48 @@ module Playground.Interpreter.Util
, renderInstanceTrace
) where

import qualified Control.Foldl as L
import Control.Lens (Traversal', preview)
import Control.Monad (void)
import Control.Monad.Freer (run)
import Control.Monad.Freer.Error (Error, runError, throwError)
import Data.Aeson (FromJSON, eitherDecode)
import qualified Data.Aeson as JSON
import Data.Bifunctor (first)
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.Foldable (traverse_)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe (isJust)
import Data.Text (Text)
import qualified Control.Foldl as L
import Control.Lens (Traversal', preview)
import Control.Monad (void)
import Control.Monad.Freer (run)
import Control.Monad.Freer.Error (Error, runError, throwError)
import Data.Aeson (FromJSON, eitherDecode)
import qualified Data.Aeson as JSON
import Data.Bifunctor (first)
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.Foldable (traverse_)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe (isJust)
import Data.Text (Text)

import qualified Data.Text.Encoding as Text
import Data.Text.Prettyprint.Doc (defaultLayoutOptions, layoutPretty, pretty, vsep)
import Data.Text.Prettyprint.Doc.Render.Text (renderStrict)
import Ledger.Crypto (pubKeyHash)
import Ledger.Value (Value)
import Playground.Types (ContractCall (AddBlocks, AddBlocksUntil, CallEndpoint, PayToWallet),
EvaluationResult, Expression, FunctionSchema (FunctionSchema),
PlaygroundError (JsonDecodingError, OtherError),
SimulatorWallet (SimulatorWallet), amount, argument,
argumentValues, caller, decodingError, endpointDescription,
expected, input, recipient, sender, simulatorWalletWallet)
import qualified Data.Text.Encoding as Text
import Data.Text.Prettyprint.Doc (defaultLayoutOptions, layoutPretty, pretty, vsep)
import Data.Text.Prettyprint.Doc.Render.Text (renderStrict)
import Ledger.Crypto (pubKeyHash)
import Ledger.Value (Value)
import Playground.Types (ContractCall (AddBlocks, AddBlocksUntil, CallEndpoint, PayToWallet),
EvaluationResult, Expression, FunctionSchema (FunctionSchema),
PlaygroundError (JsonDecodingError, OtherError),
SimulatorWallet (SimulatorWallet), amount, argument,
argumentValues, caller, decodingError, endpointDescription,
expected, input, recipient, sender, simulatorWalletWallet)
import qualified Playground.Types
import Plutus.Contract (Contract, HasBlockchainActions)
import Plutus.Contract.Effects.ExposeEndpoint (EndpointDescription (getEndpointDescription))
import Plutus.Trace (ContractConstraints, ContractInstanceTag)
import Plutus.Trace.Emulator.Types (EmulatorRuntimeError (JSONDecodingError), _ContractLog,
_ReceiveEndpointCall, cilMessage)
import Plutus.Trace.Playground (PlaygroundTrace, runPlaygroundStream, walletInstanceTag)
import Plutus.Contract (Contract)
import Plutus.Trace (ContractConstraints, ContractInstanceTag)
import Plutus.Trace.Emulator.Types (EmulatorRuntimeError (EmulatorJSONDecodingError), _ContractLog,
_ReceiveEndpointCall, cilMessage)
import Plutus.Trace.Playground (PlaygroundTrace, runPlaygroundStream, walletInstanceTag)
import qualified Plutus.Trace.Playground
import qualified Plutus.Trace.Playground as Trace
import Streaming.Prelude (fst')
import Wallet.Emulator.Folds (EmulatorEventFoldM)
import qualified Wallet.Emulator.Folds as Folds
import Wallet.Emulator.MultiAgent (EmulatorEvent, chainEvent, eteEvent, instanceEvent)
import Wallet.Emulator.Stream (foldEmulatorStreamM)
import Wallet.Emulator.Types (Wallet, walletPubKey)
import qualified Plutus.Trace.Playground as Trace
import Streaming.Prelude (fst')
import Wallet.Emulator.Folds (EmulatorEventFoldM)
import qualified Wallet.Emulator.Folds as Folds
import Wallet.Emulator.MultiAgent (EmulatorEvent, chainEvent, eteEvent, instanceEvent)
import Wallet.Emulator.Stream (foldEmulatorStreamM)
import Wallet.Emulator.Types (Wallet, walletPubKey)
import Wallet.Types (EndpointDescription (getEndpointDescription))


-- | Unfortunately any uncaught errors in the interpreter kill the
Expand Down Expand Up @@ -110,8 +110,7 @@ evaluationResultFold wallets =
-- | Evaluate a JSON payload from the Playground frontend against a given contract schema.
stage ::
forall w s a.
( HasBlockchainActions s
, ContractConstraints s
( ContractConstraints s
, JSON.ToJSON w
, Monoid w
)
Expand Down Expand Up @@ -151,9 +150,15 @@ expressionToTrace = \case
Just string ->
case JSON.eitherDecode string of
Left errs ->
throwError $ JSONDecodingError $
"Error extracting JSON from arguments. Expected an array of JSON strings. " <>
show errs
throwError
$ EmulatorJSONDecodingError
("Error extracting JSON from arguments. Expected an array of JSON strings. " <>
show errs)
rawArgument
Right argument -> do
Trace.callEndpoint caller (getEndpointDescription endpointDescription) argument
Nothing -> throwError $ JSONDecodingError $ "Expected a String, but got: " <> show rawArgument
Nothing ->
throwError
$ EmulatorJSONDecodingError
("Expected a String, but got: " <> show rawArgument)
rawArgument
Loading

0 comments on commit 7c2a01f

Please sign in to comment.