From 34cafd20f6d8ae295fa7164e14ff1e5baf52d5da Mon Sep 17 00:00:00 2001 From: silky Date: Mon, 7 Jun 2021 15:03:14 +0100 Subject: [PATCH] wip --- plutus-pab/plutus-pab.yaml | 1 - plutus-pab/put-data-in-pab.sh | 15 ++- plutus-pab/run-marlowe-workflow.sh | 106 ++++++++++++++++++ plutus-pab/src/Plutus/PAB/App.hs | 4 +- .../src/Plutus/PAB/Core/ContractInstance.hs | 1 + plutus-pab/src/Plutus/PAB/Db/Beam.hs | 4 +- .../src/Plutus/PAB/Db/Beam/ContractStore.hs | 14 +-- plutus-pab/src/Plutus/PAB/Effects/Contract.hs | 23 ++++ plutus-pab/src/Plutus/PAB/Effects/DbStore.hs | 76 +++++++------ 9 files changed, 194 insertions(+), 50 deletions(-) create mode 100755 plutus-pab/run-marlowe-workflow.sh diff --git a/plutus-pab/plutus-pab.yaml b/plutus-pab/plutus-pab.yaml index 567a0df9874..6ae34e94c2c 100644 --- a/plutus-pab/plutus-pab.yaml +++ b/plutus-pab/plutus-pab.yaml @@ -1,7 +1,6 @@ dbConfig: dbConfigFile: pab-core.db dbConfigPoolSize: 20 - dbConfigKind: BeamKind pabWebserverConfig: baseUrl: http://localhost:9080 diff --git a/plutus-pab/put-data-in-pab.sh b/plutus-pab/put-data-in-pab.sh index ef3355fe060..4a7ce7aaff1 100755 --- a/plutus-pab/put-data-in-pab.sh +++ b/plutus-pab/put-data-in-pab.sh @@ -8,6 +8,17 @@ rm -rf pab-core.db* cabal run exe:plutus-pab -- --config plutus-pab.yaml migrate pab-core.db -cabal run exe:plutus-pab -- --config plutus-pab.yaml contracts install --path "$(cabal exec -- which plutus-game)" +contracts=(marlowe-app marlowe-companion-app marlowe-follow-app) -cabal run exe:plutus-pab -- all-servers --config plutus-pab.yaml +for c in "${contracts[@]}"; do + # shellcheck disable=SC2086 + cabal run exe:plutus-pab -- \ + --config plutus-pab.yaml \ + contracts install --path "$(cabal exec -- which $c)" +done; + +cabal run exe:plutus-pab -- \ + --config plutus-pab.yaml \ + contracts installed + +cabal run exe:plutus-pab -- -e --config plutus-pab.yaml all-servers diff --git a/plutus-pab/run-marlowe-workflow.sh b/plutus-pab/run-marlowe-workflow.sh new file mode 100755 index 00000000000..962f89162ed --- /dev/null +++ b/plutus-pab/run-marlowe-workflow.sh @@ -0,0 +1,106 @@ +#!/bin/bash + +set -ex + +# ---------------------------------------------------------------- +# 1. create a wallet (remember its ID and pubKeyHash): +output=$(curl -s -d '' http://localhost:9080/wallet/create) +walletId=$(echo "$output" | sed -r -n 's/.*:([0123456789]*)\}.*/\1/p') +pubKeyHash=$(echo "$output" | jq -r '.wiPubKeyHash.getPubKeyHash') + + +# ---------------------------------------------------------------- +# 2. activate a wallet companion contract for this wallet (remember its instance ID): +companionAppPath=$(cabal exec -- which marlowe-companion-app) +json=$(cat <<-END + { "caID": + { "contractPath":"${companionAppPath}"}, + "caWallet":{"getWallet":${walletId}} + } +END +) +companionInstanceId=$(curl -s -H "Content-Type: application/json" \ + -d "$json" http://localhost:9080/api/new/contract/activate \ + | jq -r '.unContractInstanceId') + + +# ---------------------------------------------------------------- +# 3. activate a marlowe plutus contract (remember its instance ID) +marloweAppPath=$(cabal exec -- which marlowe-app) +json=$(cat <<-END + { "caID": + { "contractPath":"${marloweAppPath}"}, + "caWallet":{"getWallet":${walletId}} + } +END +) +appInstanceId=$(curl -s -H "Content-Type: application/json" \ + -d "$json" http://localhost:9080/api/new/contract/activate \ + | jq -r '.unContractInstanceId') + +sleep 5 + +# ---------------------------------------------------------------- +# 4. use the marlowe plutus contract you just activated to create a marlowe +# contract, and give all the roles to the wallet from step 1 +json=$(cat <<-END + [ + [ + [ { "unTokenName": "Investor" }, { "getPubKeyHash": "${pubKeyHash}" } ], + [ { "unTokenName": "Issuer" }, { "getPubKeyHash": "${pubKeyHash}" } ] + ], + { + "when": [ + { + "then": { + "token": { "token_name": "", "currency_symbol": "" }, + "to": { "party": { "role_token": "Issuer" } }, + "then": { + "when": [ + { + "then": { + "token": { "token_name": "", "currency_symbol": "" }, + "to": { "party": { "role_token": "Investor" } }, + "then": "close", + "pay": 20, + "from_account": { "role_token": "Issuer" } + }, + "case": { + "party": { "role_token": "Issuer" }, + "of_token": { "token_name": "", "currency_symbol": "" }, + "into_account": { "role_token": "Issuer" }, + "deposits": 20 + } + } + ], + "timeout_continuation": "close", + "timeout": 26936589 + }, + "pay": 10, + "from_account": { "role_token": "Investor" } + }, + "case": { + "party": { "role_token": "Investor" }, + "of_token": { "token_name": "", "currency_symbol": "" }, + "into_account": { "role_token": "Investor" }, + "deposits": 10 + } + } + ], + "timeout_continuation": "close", + "timeout": 26936589 + } + ] +END +) + +thing=$(curl -s -H "Content-Type: application/json" \ + -d "$json" \ + "http://localhost:9080/api/new/contract/instance/${appInstanceId}/endpoint/create" \ + ) + +echo "thing=$thing" + +# output status +curl -s "http://localhost:9080/api/new/contract/instance/${companionInstanceId}/status" + diff --git a/plutus-pab/src/Plutus/PAB/App.hs b/plutus-pab/src/Plutus/PAB/App.hs index d90718963cd..5c7c87048fd 100644 --- a/plutus-pab/src/Plutus/PAB/App.hs +++ b/plutus-pab/src/Plutus/PAB/App.hs @@ -108,13 +108,13 @@ appEffectHandlers config trace = , handleContractStoreEffect = interpret (Core.handleUserEnvReader @ContractExe @AppEnv) . interpret (Core.handleMappedReader @AppEnv dbConnection) - . interpret (handleDbStore undefined) + . interpret handleDbStore . reinterpret3 BeamEff.handleContractStore , handleContractDefinitionStoreEffect = interpret (Core.handleUserEnvReader @ContractExe @AppEnv) . interpret (Core.handleMappedReader @AppEnv dbConnection) - . interpret (handleDbStore undefined) + . interpret handleDbStore . reinterpret3 BeamEff.handleContractDefinitionStore , handleServicesEffects = \wallet -> diff --git a/plutus-pab/src/Plutus/PAB/Core/ContractInstance.hs b/plutus-pab/src/Plutus/PAB/Core/ContractInstance.hs index 07f233bf21c..5b96f1abb02 100644 --- a/plutus-pab/src/Plutus/PAB/Core/ContractInstance.hs +++ b/plutus-pab/src/Plutus/PAB/Core/ContractInstance.hs @@ -91,6 +91,7 @@ activateContractSTM runAppBackend a@ContractActivationArgs{caID, caWallet} = do activeContractInstanceId <- ContractInstanceId <$> uuidNextRandom logDebug @(ContractInstanceMsg t) $ InitialisingContract caID activeContractInstanceId initialState <- Contract.initialState @t activeContractInstanceId caID + Contract.putStartInstance @t a activeContractInstanceId Contract.putState @t a activeContractInstanceId initialState s <- startSTMInstanceThread @t @m runAppBackend a activeContractInstanceId ask >>= void . liftIO . STM.atomically . InstanceState.insertInstance activeContractInstanceId s diff --git a/plutus-pab/src/Plutus/PAB/Db/Beam.hs b/plutus-pab/src/Plutus/PAB/Db/Beam.hs index 30579a0e2ab..69c7005b2c0 100644 --- a/plutus-pab/src/Plutus/PAB/Db/Beam.hs +++ b/plutus-pab/src/Plutus/PAB/Db/Beam.hs @@ -15,6 +15,7 @@ import Control.Monad.Freer (Eff, interpret, run import Control.Monad.Freer.Delay (DelayEffect, handleDelayEffect) import Control.Monad.Freer.Error (runError) import qualified Control.Monad.Freer.Extras.Modify as Modify +import Control.Monad.Freer.Reader (runReader) import Database.SQLite.Simple (Connection) import Plutus.PAB.Db.Beam.ContractDefinitionStore (handleContractDefinitionStore) import Plutus.PAB.Db.Beam.ContractStore (handleContractStore) @@ -33,7 +34,8 @@ runBeamStoreAction :: runBeamStoreAction connection = runM . runError - . interpret (handleDbStore connection) + . runReader connection + . interpret handleDbStore . subsume @IO . handleDelayEffect . interpret handleContractStore diff --git a/plutus-pab/src/Plutus/PAB/Db/Beam/ContractStore.hs b/plutus-pab/src/Plutus/PAB/Db/Beam/ContractStore.hs index 85ec580415a..d3cd0c411d0 100644 --- a/plutus-pab/src/Plutus/PAB/Db/Beam/ContractStore.hs +++ b/plutus-pab/src/Plutus/PAB/Db/Beam/ContractStore.hs @@ -51,7 +51,7 @@ mkRow (ContractActivationArgs{caID, caWallet}) instanceId = ContractInstance (uuidStr instanceId) (Text.pack $ contractPath caID) - (fromInteger . getWallet $ caWallet) + (Text.pack . show . getWallet $ caWallet) Nothing -- No state, initially True -- 'Active' immediately @@ -63,10 +63,10 @@ mkContracts xs = where xs' = map f xs toId = ContractInstanceId . fromMaybe (error "Couldn't convert String to UUID") . fromText - f ci = ( toId . _contractInstanceInstanceId $ ci + f ci = ( toId . _contractInstanceId $ ci , ContractActivationArgs (ContractExe . Text.unpack . _contractInstanceContractPath $ ci) - (Wallet . toInteger . _contractInstanceWallet $ ci) + (Wallet . read . Text.unpack . _contractInstanceWallet $ ci) ) uuidStr :: ContractInstanceId -> Text @@ -98,12 +98,12 @@ handleContractStore = \case $ mkRow args instanceId -- TODO: Should we use 'args' ? - PutState args instanceId state -> + PutState _ instanceId state -> let encode' = Just . Text.decodeUtf8 . B.concat . LB.toChunks . encode in updateRow $ update (_contractInstances db) (\ci -> ci ^. contractInstanceState <-. val_ (encode' state)) - (\ci -> ci ^. contractInstanceInstanceId ==. val_ (uuidStr instanceId)) + (\ci -> ci ^. contractInstanceId ==. val_ (uuidStr instanceId)) GetState instanceId -> fmap extractState @@ -111,14 +111,14 @@ handleContractStore = \case $ select $ do inst <- all_ (_contractInstances db) - guard_ ( inst ^. contractInstanceInstanceId ==. val_ (uuidStr instanceId) ) + guard_ ( inst ^. contractInstanceId ==. val_ (uuidStr instanceId) ) pure inst PutStopInstance instanceId -> updateRow $ update (_contractInstances db) (\ci -> ci ^. contractInstanceActive <-. val_ False) - (\ci -> ci ^. contractInstanceInstanceId ==. val_ (uuidStr instanceId)) + (\ci -> ci ^. contractInstanceId ==. val_ (uuidStr instanceId)) GetActiveContracts -> fmap mkContracts diff --git a/plutus-pab/src/Plutus/PAB/Effects/Contract.hs b/plutus-pab/src/Plutus/PAB/Effects/Contract.hs index a43eb330ef6..4ecea71c06f 100644 --- a/plutus-pab/src/Plutus/PAB/Effects/Contract.hs +++ b/plutus-pab/src/Plutus/PAB/Effects/Contract.hs @@ -29,6 +29,8 @@ module Plutus.PAB.Effects.Contract( , getState , getDefinition , getActiveContracts + , putStartInstance + , putStopInstance -- * Storing and retrieving definitions of contracts , ContractDefinitionStore(..) , addDefinition @@ -126,6 +128,27 @@ data ContractStore t r where PutStopInstance :: ContractInstanceId -> ContractStore t () -- ^ Record the fact that a contract instance has stopped GetActiveContracts :: ContractStore t (Map ContractInstanceId (ContractActivationArgs (ContractDef t))) -- ^ Get all active contracts with their activation args +putStartInstance :: + forall t effs. + ( Member (ContractStore t) effs + ) + => ContractActivationArgs (ContractDef t) + -> ContractInstanceId + -> Eff effs () +putStartInstance def i = + let command :: ContractStore t () = PutStartInstance def i + in send command + +putStopInstance :: + forall t effs. + ( Member (ContractStore t) effs + ) + => ContractInstanceId + -> Eff effs () +putStopInstance i = + let command :: ContractStore t () = PutStopInstance i + in send command + -- | Store the state of the contract instance putState :: forall t effs. diff --git a/plutus-pab/src/Plutus/PAB/Effects/DbStore.hs b/plutus-pab/src/Plutus/PAB/Effects/DbStore.hs index d24799673fb..fef5b6a0191 100644 --- a/plutus-pab/src/Plutus/PAB/Effects/DbStore.hs +++ b/plutus-pab/src/Plutus/PAB/Effects/DbStore.hs @@ -13,11 +13,12 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} - +{-# options_ghc -Wno-missing-signatures #-} module Plutus.PAB.Effects.DbStore where -import Control.Monad.Freer (Eff, LastMember, type (~>)) +import Control.Monad.Freer (Eff, LastMember, Member, type (~>)) +import Control.Monad.Freer.Reader (Reader, ask) import Control.Monad.Freer.TH (makeEffect) import Data.Text (Text) import Database.Beam @@ -26,7 +27,6 @@ import Database.Beam.Migrate import Database.Beam.Schema.Tables import Database.Beam.Sqlite import Database.SQLite.Simple (Connection) -import GHC.Int (Int32) data ContractT f = Contract @@ -47,15 +47,15 @@ instance Table ContractT where data ContractInstanceT f = ContractInstance - { _contractInstanceInstanceId :: Columnar f Text + { _contractInstanceId :: Columnar f Text , _contractInstanceContractPath :: Columnar f Text -- TODO: Foreign Key - , _contractInstanceWallet :: Columnar f Int32 + , _contractInstanceWallet :: Columnar f Text -- Note/Sadness: Sqlite doesn't have a integer type large enough. , _contractInstanceState :: Columnar f (Maybe Text) , _contractInstanceActive :: Columnar f Bool } deriving (Generic, Beamable) ContractInstance - (LensFor contractInstanceInstanceId) + (LensFor contractInstanceId) (LensFor contractInstanceContractPath) (LensFor contractInstanceWallet) (LensFor contractInstanceState) @@ -68,7 +68,7 @@ type ContractInstanceId = PrimaryKey ContractInstanceT Identity instance Table ContractInstanceT where data PrimaryKey ContractInstanceT f = ContractInstanceId (Columnar f Text) deriving (Generic, Beamable) - primaryKey = ContractInstanceId . _contractInstanceInstanceId + primaryKey = ContractInstanceId . _contractInstanceId data Db f = Db { _contracts :: f (TableEntity ContractT) @@ -91,12 +91,12 @@ initialSetupStep = { _contractPath = field "path" (varchar Nothing) notNull unique } ) <*> - (createTable "contract_instances" $ ContractInstance - { _contractInstanceInstanceId = field "instance_id" (varchar Nothing) notNull unique - , _contractInstanceWallet = field "wallet" int notNull - , _contractInstanceContractPath = field "contract_path" (varchar Nothing) notNull - , _contractInstanceState = field "state" (maybeType characterLargeObject) - , _contractInstanceActive = field "active" boolean notNull + (createTable "instances" $ ContractInstance + { _contractInstanceId = field "instance_id" (varchar Nothing) notNull unique + , _contractInstanceWallet = field "instance_wallet" (varchar Nothing) notNull + , _contractInstanceContractPath = field "instance_contract_path" (varchar Nothing) notNull + , _contractInstanceState = field "instance_state" (maybeType characterLargeObject) + , _contractInstanceActive = field "instance_active" boolean notNull } ) @@ -137,31 +137,33 @@ data DbStoreEffect r where handleDbStore :: forall effs. - ( LastMember IO effs + ( Member (Reader Connection) effs + , LastMember IO effs ) - => Connection - -> DbStoreEffect + => DbStoreEffect ~> Eff effs -handleDbStore connection = \case - AddRow table record -> - liftIO - $ runBeamSqliteDebug putStrLn connection - $ runInsert - $ insert table (insertValues [record]) - - SelectList q -> - liftIO - $ runBeamSqliteDebug putStrLn connection - $ runSelectReturningList q - - SelectOne q -> - liftIO - $ runBeamSqliteDebug putStrLn connection - $ runSelectReturningOne q - - UpdateRow q -> - liftIO - $ runBeamSqliteDebug putStrLn connection - $ runUpdate q +handleDbStore eff = do + connection <- ask @Connection + case eff of + AddRow table record -> + liftIO + $ runBeamSqliteDebug putStrLn connection + $ runInsert + $ insert table (insertValues [record]) + + SelectList q -> + liftIO + $ runBeamSqliteDebug putStrLn connection + $ runSelectReturningList q + + SelectOne q -> + liftIO + $ runBeamSqliteDebug putStrLn connection + $ runSelectReturningOne q + + UpdateRow q -> + liftIO + $ runBeamSqliteDebug putStrLn connection + $ runUpdate q makeEffect ''DbStoreEffect