Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

plutus-contract: Reduce our use of row-types, delete BlockchainActions #3342

Merged
merged 19 commits into from
Jun 15, 2021
Merged

plutus-contract: Reduce our use of row-types, delete BlockchainActions #3342

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
19 commits
Select commit Hold shift + click to select a range
fa5643f
Fix playground server
j-mueller Jun 11, 2021
8e85a16
SCP-2018: Waiting vs non-waiting actions
j-mueller Apr 8, 2021
2ceff93
Fix playground-common
j-mueller Jun 8, 2021
ab65c54
* Fix use-cases
j-mueller Jun 9, 2021
b762e5b
Fix plutus-pab
j-mueller Jun 10, 2021
5e194d1
Fix marlowe
j-mueller Jun 10, 2021
4161352
Fix plutus-playground-server
j-mueller Jun 11, 2021
3aca46a
Fix doc
j-mueller Jun 11, 2021
163e052
Fix uniswap example
j-mueller Jun 12, 2021
52e0f49
Fix PSGenerator
j-mueller Jun 12, 2021
9e0a26f
Fix plutus-pab-client
j-mueller Jun 12, 2021
ac691a7
Fix plutus-playground
j-mueller Jun 14, 2021
2229655
Fix pab-client
j-mueller Jun 14, 2021
5d584fc
Fix docs
j-mueller Jun 14, 2021
f0a67d5
Delete unused modules
j-mueller Jun 15, 2021
0084936
Review comments
j-mueller Jun 15, 2021
b113e11
Compiler warning
j-mueller Jun 15, 2021
c650fec
Fix tutorial code
j-mueller Jun 15, 2021
4679e5d
Fix marlowe-dashboard-client
j-mueller Jun 15, 2021
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 1 addition & 2 deletions doc/plutus/tutorials/BasicApps.hs
View file
Open in desktop
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
Open in desktop
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
Open in desktop
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
Open in desktop
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
Open in desktop
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
Open in desktop
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
Open in desktop

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
Open in desktop
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
Open in desktop
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
Open in desktop
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