Adding env variable for easily switching data contexts. (#3289)

* Added env variable for easily switching data contexts.

* Removing dummy capability imports.

* Fixing Capability.Marlowe and moving API functions inside the ContractActivationId class.

* Changing PAB port for development (because the marlowe-pab runs on 8080).

* Updating follower contract state to match backend changes.

* Fixing a typo in a comment.

* Review comments.

marlowe-dashboard-client/plutus-pab.yaml

@@ -9,16 +9,16 @@ dbConfig:
     dbConfigPoolSize: 20
 
 pabWebserverConfig:
-  baseUrl: http://localhost:9080
+  baseUrl: http://localhost:8080
   staticDir: plutus-pab-client/dist
 
 walletServerConfig:
-  baseUrl: http://localhost:9081
+  baseUrl: http://localhost:8081
   wallet:
     getWallet: 1
 
 nodeServerConfig:
-  mscBaseUrl: http://localhost:9082
+  mscBaseUrl: http://localhost:8082
   mscSocketPath: ./node-server.sock
   mscSlotLength: 1
   mscKeptBlocks: 100
@@ -35,19 +35,19 @@ nodeServerConfig:
     - getWallet: 3
 
 chainIndexConfig:
-  ciBaseUrl: http://localhost:9083
+  ciBaseUrl: http://localhost:8083
   ciWatchedAddresses: []
 
 requestProcessingConfig:
   requestProcessingInterval: 1
 
 signingProcessConfig:
-  spBaseUrl: http://localhost:9084
+  spBaseUrl: http://localhost:8084
   spWallet:
     getWallet: 1
 
 metadataServerConfig:
-  mdBaseUrl: http://localhost:9085
+  mdBaseUrl: http://localhost:8085
 
 # Optional timeout (in seconds) for calls to endpoints that are not currently
 # available. If this is not set, calls to unavailable endpoints fail 

marlowe-dashboard-client/src/API/Contract.purs

@@ -1,71 +1,114 @@
 module API.Contract
-  ( activateContract
+  ( class ContractActivationId
+  , activateContract
   , deactivateContract
   , getContractInstanceClientState
   , invokeEndpoint
   , getWalletContractInstances
   , getAllContractInstances
   , getContractDefinitions
+  , defaultActivateContract
+  , defaultDeactivateContract
+  , defaultGetContractInstanceClientState
+  , defaultInvokeEndpoint
+  , defaultGetWalletContractInstances
+  , defaultGetAllContractInstances
+  , defaultGetContractDefinitions
   ) where
 
 import Prelude
 import API.Request (doGetRequest, doPostRequest, doPutRequest)
 import API.Url (toUrlPiece)
 import Control.Monad.Error.Class (class MonadError)
 import Effect.Aff.Class (class MonadAff)
-import Foreign.Generic (class Encode)
+import Foreign.Generic (class Decode, class Encode)
 import Plutus.PAB.Effects.Contract.ContractExe (ContractExe)
 import Plutus.PAB.Webserver.Types (ContractActivationArgs, ContractInstanceClientState, ContractSignatureResponse)
 import Servant.PureScript.Ajax (AjaxError)
 import Wallet.Emulator.Wallet (Wallet)
 import Wallet.Types (ContractInstanceId)
 
-activateContract ::
-  forall m.
+-- PAB contracts can be activated either with a `ContractExe` (a wrapper around a path to the exe on disk), or
+-- some custom data type that identifies the contract (for versions of the plutus-pab that are bundled up with
+-- contracts). That value is also returned in the `ContractInstanceClientState`. The implementation of the API
+-- functions is the same regardless of this type, but for greater type safety we wrap them up in a class and
+-- provide an instance for the `ContractExe`. To create an alternative type to use instead, simply make it an
+-- instance of this class and give it all the default implementations.
+-- Note that the implementation of some API functions is also the same regardless of the value of the type in
+-- question that is passed, but we always have to pass one so that the compiler can determine the type of the
+-- function.
+class
+  (Decode a, Encode a) <= ContractActivationId a where
+  activateContract :: forall m. MonadError AjaxError m => MonadAff m => ContractActivationArgs a -> m ContractInstanceId
+  deactivateContract :: forall m. MonadError AjaxError m => MonadAff m => a -> ContractInstanceId -> m Unit
+  getContractInstanceClientState :: forall m. MonadError AjaxError m => MonadAff m => a -> ContractInstanceId -> m (ContractInstanceClientState a)
+  invokeEndpoint :: forall d m. MonadError AjaxError m => MonadAff m => Encode d => a -> ContractInstanceId -> String -> d -> m Unit
+  getWalletContractInstances :: forall m. MonadError AjaxError m => MonadAff m => a -> Wallet -> m (Array (ContractInstanceClientState a))
+  getAllContractInstances :: forall m. MonadError AjaxError m => MonadAff m => a -> m (Array (ContractInstanceClientState a))
+  getContractDefinitions :: forall m. MonadError AjaxError m => MonadAff m => a -> m (Array (ContractSignatureResponse a))
+
+instance contractExeContractActivationId :: ContractActivationId ContractExe where
+  activateContract = defaultActivateContract
+  deactivateContract = defaultDeactivateContract
+  getContractInstanceClientState = defaultGetContractInstanceClientState
+  invokeEndpoint = defaultInvokeEndpoint
+  getWalletContractInstances = defaultGetWalletContractInstances
+  getAllContractInstances = defaultGetAllContractInstances
+  getContractDefinitions = defaultGetContractDefinitions
+
+defaultActivateContract ::
+  forall a m.
+  ContractActivationId a =>
   MonadError AjaxError m =>
   MonadAff m =>
-  ContractActivationArgs ContractExe -> m ContractInstanceId
-activateContract contractActivationArgs = doPostRequest "/api/new/contract/activate" contractActivationArgs
+  ContractActivationArgs a -> m ContractInstanceId
+defaultActivateContract contractActivationArgs = doPostRequest "/api/new/contract/activate" contractActivationArgs
 
-deactivateContract ::
-  forall m.
+defaultDeactivateContract ::
+  forall a m.
+  ContractActivationId a =>
   MonadError AjaxError m =>
   MonadAff m =>
-  ContractInstanceId -> m Unit
-deactivateContract contractInstanceId = doPutRequest $ "api/new/contract/instance/" <> toUrlPiece contractInstanceId <> "/stop"
+  a -> ContractInstanceId -> m Unit
+defaultDeactivateContract contractActivationId contractInstanceId = doPutRequest $ "api/new/contract/instance/" <> toUrlPiece contractInstanceId <> "/stop"
 
-getContractInstanceClientState ::
-  forall m.
+defaultGetContractInstanceClientState ::
+  forall a m.
+  ContractActivationId a =>
   MonadError AjaxError m =>
   MonadAff m =>
-  ContractInstanceId -> m (ContractInstanceClientState ContractExe)
-getContractInstanceClientState contractInstanceId = doGetRequest $ "/api/new/contract/instance/" <> toUrlPiece contractInstanceId <> "/status"
+  a -> ContractInstanceId -> m (ContractInstanceClientState a)
+defaultGetContractInstanceClientState contractActivationId contractInstanceId = doGetRequest $ "/api/new/contract/instance/" <> toUrlPiece contractInstanceId <> "/status"
 
-invokeEndpoint ::
-  forall d m.
+defaultInvokeEndpoint ::
+  forall a d m.
+  ContractActivationId a =>
+  Encode d =>
   MonadError AjaxError m =>
   MonadAff m =>
-  Encode d =>
-  ContractInstanceId -> String -> d -> m Unit
-invokeEndpoint contractInstanceId endpoint payload = doPostRequest ("/api/new/contract/instance/" <> toUrlPiece contractInstanceId <> "/endpoint/" <> endpoint) payload
+  a -> ContractInstanceId -> String -> d -> m Unit
+defaultInvokeEndpoint contractActivationId contractInstanceId endpoint payload = doPostRequest ("/api/new/contract/instance/" <> toUrlPiece contractInstanceId <> "/endpoint/" <> endpoint) payload
 
-getWalletContractInstances ::
-  forall m.
+defaultGetWalletContractInstances ::
+  forall a m.
+  ContractActivationId a =>
   MonadError AjaxError m =>
   MonadAff m =>
-  Wallet -> m (Array (ContractInstanceClientState ContractExe))
-getWalletContractInstances wallet = doGetRequest $ "/api/new/contract/instances/wallet/" <> toUrlPiece wallet
+  a -> Wallet -> m (Array (ContractInstanceClientState a))
+defaultGetWalletContractInstances contractActivationId wallet = doGetRequest $ "/api/new/contract/instances/wallet/" <> toUrlPiece wallet
 
-getAllContractInstances ::
-  forall m.
+defaultGetAllContractInstances ::
+  forall a m.
+  ContractActivationId a =>
   MonadError AjaxError m =>
   MonadAff m =>
-  m (Array (ContractInstanceClientState ContractExe))
-getAllContractInstances = doGetRequest "/api/new/contract/instances"
+  a -> m (Array (ContractInstanceClientState a))
+defaultGetAllContractInstances contractActivationId = doGetRequest "/api/new/contract/instances"
 
-getContractDefinitions ::
-  forall m.
+defaultGetContractDefinitions ::
+  forall a m.
+  ContractActivationId a =>
   MonadError AjaxError m =>
   MonadAff m =>
-  m (Array (ContractSignatureResponse ContractExe))
-getContractDefinitions = doGetRequest "/api/new/contract/definitions"
+  a -> m (Array (ContractSignatureResponse a))
+defaultGetContractDefinitions contractActivationId = doGetRequest "/api/new/contract/definitions"

marlowe-dashboard-client/src/API/Lenses.purs

@@ -11,29 +11,29 @@ module API.Lenses
   ) where
 
 import Prelude
+import API.Contract (class ContractActivationId)
 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.Resumable (Request, _Request)
-import Plutus.PAB.Effects.Contract.ContractExe (ContractExe)
 import Plutus.PAB.Events.ContractInstanceState (PartiallyDecodedResponse, _PartiallyDecodedResponse)
 import Plutus.PAB.Webserver.Types (ContractInstanceClientState, _ContractInstanceClientState)
 import Wallet.Emulator.Wallet (Wallet)
 import Wallet.Types (ContractInstanceId, EndpointDescription, _EndpointDescription)
 
-_cicContract :: Lens' (ContractInstanceClientState ContractExe) ContractInstanceId
+_cicContract :: forall a. ContractActivationId a => Lens' (ContractInstanceClientState a) ContractInstanceId
 _cicContract = _ContractInstanceClientState <<< prop (SProxy :: SProxy "cicContract")
 
-_cicCurrentState :: Lens' (ContractInstanceClientState ContractExe) (PartiallyDecodedResponse ActiveEndpoint)
+_cicCurrentState :: forall a. ContractActivationId a => Lens' (ContractInstanceClientState a) (PartiallyDecodedResponse ActiveEndpoint)
 _cicCurrentState = _ContractInstanceClientState <<< prop (SProxy :: SProxy "cicCurrentState")
 
 -- TODO: fix Haskell typo ("cicDefintion" instead of "cicDefinition")
-_cicDefinition :: Lens' (ContractInstanceClientState ContractExe) ContractExe
+_cicDefinition :: forall a. ContractActivationId a => Lens' (ContractInstanceClientState a) a
 _cicDefinition = _ContractInstanceClientState <<< prop (SProxy :: SProxy "cicDefintion")
 
-_cicWallet :: Lens' (ContractInstanceClientState ContractExe) Wallet
+_cicWallet :: forall a. ContractActivationId a => Lens' (ContractInstanceClientState a) Wallet
 _cicWallet = _ContractInstanceClientState <<< prop (SProxy :: SProxy "cicWallet")
 
 ----------

marlowe-dashboard-client/src/Capability/Contract.purs

@@ -13,6 +13,7 @@ module Capability.Contract
   ) where
 
 import Prelude
+import API.Contract (class ContractActivationId)
 import API.Lenses (_cicCurrentState, _hooks, _observableState)
 import AppM (AppM)
 import Bridge (toBack, toFront)
@@ -25,7 +26,6 @@ import Halogen (HalogenM)
 import Marlowe.PAB (PlutusAppId)
 import Plutus.Contract.Effects.ExposeEndpoint (ActiveEndpoint)
 import Plutus.Contract.Resumable (Request)
-import Plutus.PAB.Effects.Contract.ContractExe (ContractExe)
 import Plutus.PAB.Events.ContractInstanceState (PartiallyDecodedResponse)
 import Plutus.PAB.Webserver.Types (ContractActivationArgs(..), ContractInstanceClientState, ContractSignatureResponse)
 import Types (AjaxResponse)
@@ -34,43 +34,43 @@ import WalletData.Types (Wallet)
 -- TODO (possibly): make `AppM` a `MonadError` and remove all the `runExceptT`s
 class
   Monad m <= ManageContract m where
-  activateContract :: ContractExe -> Wallet -> m (AjaxResponse PlutusAppId)
-  deactivateContract :: PlutusAppId -> m (AjaxResponse Unit)
-  getContractInstanceClientState :: PlutusAppId -> m (AjaxResponse (ContractInstanceClientState ContractExe))
-  getContractInstanceCurrentState :: PlutusAppId -> m (AjaxResponse (PartiallyDecodedResponse ActiveEndpoint))
-  getContractInstanceObservableState :: PlutusAppId -> m (AjaxResponse RawJson)
-  getContractInstanceHooks :: PlutusAppId -> m (AjaxResponse (Array (Request ActiveEndpoint)))
-  invokeEndpoint :: forall d. Encode d => PlutusAppId -> String -> d -> m (AjaxResponse Unit)
-  getWalletContractInstances :: Wallet -> m (AjaxResponse (Array (ContractInstanceClientState ContractExe)))
-  getAllContractInstances :: m (AjaxResponse (Array (ContractInstanceClientState ContractExe)))
-  getContractDefinitions :: m (AjaxResponse (Array (ContractSignatureResponse ContractExe)))
+  activateContract :: forall a. ContractActivationId a => a -> Wallet -> m (AjaxResponse PlutusAppId)
+  deactivateContract :: forall a. ContractActivationId a => a -> PlutusAppId -> m (AjaxResponse Unit)
+  getContractInstanceClientState :: forall a. ContractActivationId a => a -> PlutusAppId -> m (AjaxResponse (ContractInstanceClientState a))
+  getContractInstanceCurrentState :: forall a. ContractActivationId a => a -> PlutusAppId -> m (AjaxResponse (PartiallyDecodedResponse ActiveEndpoint))
+  getContractInstanceObservableState :: forall a. ContractActivationId a => a -> PlutusAppId -> m (AjaxResponse RawJson)
+  getContractInstanceHooks :: forall a. ContractActivationId a => a -> PlutusAppId -> m (AjaxResponse (Array (Request ActiveEndpoint)))
+  invokeEndpoint :: forall a d. ContractActivationId a => Encode d => a -> PlutusAppId -> String -> d -> m (AjaxResponse Unit)
+  getWalletContractInstances :: forall a. ContractActivationId a => a -> Wallet -> m (AjaxResponse (Array (ContractInstanceClientState a)))
+  getAllContractInstances :: forall a. ContractActivationId a => a -> m (AjaxResponse (Array (ContractInstanceClientState a)))
+  getContractDefinitions :: forall a. ContractActivationId a => a -> m (AjaxResponse (Array (ContractSignatureResponse a)))
 
 instance monadContractAppM :: ManageContract AppM where
-  activateContract contractExe wallet = map toFront $ runExceptT $ API.activateContract $ ContractActivationArgs { caID: contractExe, caWallet: toBack wallet }
-  deactivateContract plutusAppId = runExceptT $ API.deactivateContract (toBack plutusAppId)
-  getContractInstanceClientState plutusAppId = runExceptT $ API.getContractInstanceClientState $ toBack plutusAppId
-  getContractInstanceCurrentState plutusAppId = do
-    clientState <- getContractInstanceClientState plutusAppId
+  activateContract contractActivationId wallet = map toFront $ runExceptT $ API.activateContract $ ContractActivationArgs { caID: contractActivationId, caWallet: toBack wallet }
+  deactivateContract contractActivationId plutusAppId = runExceptT $ API.deactivateContract contractActivationId (toBack plutusAppId)
+  getContractInstanceClientState contractActivationId plutusAppId = runExceptT $ API.getContractInstanceClientState contractActivationId $ toBack plutusAppId
+  getContractInstanceCurrentState contractActivationId plutusAppId = do
+    clientState <- getContractInstanceClientState contractActivationId plutusAppId
     pure $ map (view _cicCurrentState) clientState
-  getContractInstanceObservableState plutusAppId = do
-    currentState <- getContractInstanceCurrentState plutusAppId
+  getContractInstanceObservableState contractActivationId plutusAppId = do
+    currentState <- getContractInstanceCurrentState contractActivationId plutusAppId
     pure $ map (view _observableState) currentState
-  getContractInstanceHooks plutusAppId = do
-    currentState <- getContractInstanceCurrentState plutusAppId
+  getContractInstanceHooks contractActivationId plutusAppId = do
+    currentState <- getContractInstanceCurrentState contractActivationId plutusAppId
     pure $ map (view _hooks) currentState
-  invokeEndpoint plutusAppId endpoint payload = runExceptT $ API.invokeEndpoint (toBack plutusAppId) endpoint payload
-  getWalletContractInstances wallet = runExceptT $ API.getWalletContractInstances $ toBack wallet
-  getAllContractInstances = runExceptT API.getAllContractInstances
-  getContractDefinitions = runExceptT API.getContractDefinitions
+  invokeEndpoint contractActivationId plutusAppId endpoint payload = runExceptT $ API.invokeEndpoint contractActivationId (toBack plutusAppId) endpoint payload
+  getWalletContractInstances contractActivationId wallet = runExceptT $ API.getWalletContractInstances contractActivationId $ toBack wallet
+  getAllContractInstances contractActivationId = runExceptT $ API.getAllContractInstances contractActivationId
+  getContractDefinitions contractActivationId = runExceptT $ API.getContractDefinitions contractActivationId
 
 instance monadContractHalogenM :: ManageContract m => ManageContract (HalogenM state action slots msg m) where
-  activateContract contractExe wallet = lift $ activateContract contractExe wallet
-  deactivateContract = lift <<< deactivateContract
-  getContractInstanceClientState = lift <<< getContractInstanceClientState
-  getContractInstanceCurrentState = lift <<< getContractInstanceCurrentState
-  getContractInstanceObservableState = lift <<< getContractInstanceObservableState
-  getContractInstanceHooks = lift <<< getContractInstanceHooks
-  invokeEndpoint plutusAppId endpointDescription payload = lift $ invokeEndpoint plutusAppId endpointDescription payload
-  getWalletContractInstances = lift <<< getWalletContractInstances
-  getAllContractInstances = lift getAllContractInstances
-  getContractDefinitions = lift getContractDefinitions
+  activateContract contractActivationId wallet = lift $ activateContract contractActivationId wallet
+  deactivateContract contractActivationId plutusAppId = lift $ deactivateContract contractActivationId plutusAppId
+  getContractInstanceClientState contractActivationId plutusAppId = lift $ getContractInstanceClientState contractActivationId plutusAppId
+  getContractInstanceCurrentState contractActivationId plutusAppId = lift $ getContractInstanceCurrentState contractActivationId plutusAppId
+  getContractInstanceObservableState contractActivationId plutusAppId = lift $ getContractInstanceObservableState contractActivationId plutusAppId
+  getContractInstanceHooks contractActivationId plutusAppId = lift $ getContractInstanceHooks contractActivationId plutusAppId
+  invokeEndpoint contractActivationId plutusAppId endpointDescription payload = lift $ invokeEndpoint contractActivationId plutusAppId endpointDescription payload
+  getWalletContractInstances contractActivationId wallet = lift $ getWalletContractInstances contractActivationId wallet
+  getAllContractInstances = lift <<< getAllContractInstances
+  getContractDefinitions = lift <<< getContractDefinitions