wip

plutus-pab/plutus-pab.yaml

@@ -1,7 +1,6 @@
 dbConfig:
     dbConfigFile: pab-core.db
     dbConfigPoolSize: 20
-    dbConfigKind: BeamKind
 
 pabWebserverConfig:
   baseUrl: http://localhost:9080

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

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"
+

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 ->

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

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

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,27 +98,27 @@ 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
       $ selectOne
       $ 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

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.

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