View on GitHub
File Changes
import           Network.HTTP.Client        (defaultManagerSettings, newManager)
import           Plutus.SCB.Core            (Connection (Connection), ContractCommand (InitContract, UpdateContract),
                                             MonadContract, MonadEventStore, addProcessBus, dbConnect, invokeContract,
-
                                             refreshProjection, runAggregateCommand)
+
                                             refreshProjection, runCommand, toUUID)
import           Plutus.SCB.Types           (DbConfig,
                                             SCBError (ContractCommandError, NodeClientError, WalletClientError))
import           Servant.Client             (ClientEnv, ClientM, ServantError, mkClientEnv, parseBaseUrl, runClientM)
                    sqlGlobalEventStoreReader sqlConfig
            ExceptT . fmap Right . flip runSqlPool connectionPool $
                getLatestStreamProjection reader projection
-
    runAggregateCommand aggregate identifier input =
+
    runCommand aggregate source input =
        App $ do
            (Connection (sqlConfig, connectionPool)) <- asks dbConnection
            let reader =
                        reader
            ExceptT $
                fmap Right . retryOnBusy . flip runSqlPool connectionPool $
-
                commandStoredAggregate writer reader aggregate identifier input
+
                commandStoredAggregate
+
                    writer
+
                    reader
+
                    aggregate
+
                    (toUUID source)
+
                    input

                      
instance MonadContract App where
    invokeContract contractCommand =
    , invokeContract
    , MonadEventStore
    , refreshProjection
-
    , runAggregateCommand
+
    , runCommand
    , runGlobalQuery
    , updateContract
    , addProcessBus
+
    , Source(..)
+
    , toUUID
    ) where

                      
import           Control.Error.Util              (note)
installContract filePath = do
    logInfoN $ "Installing: " <> tshow filePath
    void $
-
        runAggregateCommand
+
        runCommand
            installCommand
-
            userEventSource
+
            UserEventSource
            (Contract {contractPath = filePath})
    logInfoN "Installed."

                      
                , partiallyDecodedResponse = response
                }
    logInfoN "Storing Initial Contract State"
-
    void $
-
        runAggregateCommand
-
            saveContractState
-
            contractEventSource
-
            activeContractState
+
    void $ runCommand saveContractState ContractEventSource activeContractState
    logInfoN . render $
        "Installed:" <+> pretty (activeContract activeContractState)
    logInfoN "Done"
                traverse
                    (mapError WalletError . Wallet.balanceWallet)
                    unbalancedTxs
-
            traverse_
-
                (runAggregateCommand saveBalancedTx walletEventSource)
-
                balancedTxs
+
            traverse_ (runCommand saveBalancedTx WalletEventSource) balancedTxs
                      --
            logInfoN $ "Submitting balanced TXs" <> tshow unbalancedTxs
            balanceResults :: [Ledger.TxId] <- traverse submitTxn balancedTxs
                      --
            traverse_
-
                (runAggregateCommand saveBalancedTxResult nodeEventSource)
+
                (runCommand saveBalancedTxResult NodeEventSource)
                balanceResults
                      --
            let updatedContractState =
                    oldContractState {partiallyDecodedResponse = response}
            logInfoN "Storing Updated Contract State"
            void $
-
                runAggregateCommand
+
                runCommand
                    saveContractState
-
                    contractEventSource
+
                    ContractEventSource
                    updatedContractState
            logInfoN . render $ "Updated:" <+> pretty updatedContractState
            logInfoN "Done"
    invokeContract ::
           ContractCommand -> m (Either SCBError PartiallyDecodedResponse)

                      
-
-- TODO Perhaps we should change runAggregateCommand to take a closed list of sources, rather than any freeform UUID.
class Monad m =>
      MonadEventStore event m
-
    -- | Update a 'Projection'.
    where
    refreshProjection ::
           GlobalStreamProjection state event
        -> m (GlobalStreamProjection state event)
-
    -- | Update a command through an 'Aggregate'.
-
    runAggregateCommand ::
-
           Aggregate state event command -> UUID -> command -> m [event]
+
    runCommand ::
+
           Aggregate state event command -> Source -> command -> m [event]

                      
instance (FromJSON event, ToJSON event) =>
         MonadEventStore event (ReaderT Connection (LoggingT IO)) where
                sqlGlobalEventStoreReader sqlConfig
        flip runSqlPool connectionPool $
            getLatestStreamProjection reader projection
-
    runAggregateCommand aggregate identifier input = do
+
    runCommand aggregate source input = do
        (Connection (sqlConfig, connectionPool)) <- ask
        let reader =
                serializedVersionedEventStoreReader jsonStringSerializer $
                     sqliteEventStoreWriter sqlConfig)
                    reader
        retryOnBusy . flip runSqlPool connectionPool $
-
            commandStoredAggregate writer reader aggregate identifier input
+
            commandStoredAggregate writer reader aggregate (toUUID source) input

                      
runGlobalQuery ::
       MonadEventStore event m
        ]

                      
------------------------------------------------------------
-
contractEventSource :: UUID
-
contractEventSource = UUID.fromWords 0 0 0 2
-

                      
-
walletEventSource :: UUID
-
walletEventSource = UUID.fromWords 0 0 0 2
-

                      
-
userEventSource :: UUID
-
userEventSource = UUID.fromWords 0 0 0 3
+
data Source
+
    = ContractEventSource
+
    | WalletEventSource
+
    | UserEventSource
+
    | NodeEventSource
+
    deriving (Show, Eq)

                      
-
nodeEventSource :: UUID
-
nodeEventSource = UUID.fromWords 0 0 0 4
+
toUUID :: Source -> UUID
+
toUUID ContractEventSource = UUID.fromWords 0 0 0 2
+
toUUID WalletEventSource   = UUID.fromWords 0 0 0 2
+
toUUID UserEventSource     = UUID.fromWords 0 0 0 3
+
toUUID NodeEventSource     = UUID.fromWords 0 0 0 4

                      
instance (WalletDiagnostics m, Monad m) =>
         WalletDiagnostics (ExceptT WalletAPIError m) where

                      
instance Monad m => MonadEventStore event (StateT (EventMap event) m) where
    refreshProjection = getLatestStreamProjection stateGlobalEventStoreReader
-
    runAggregateCommand =
-
        commandStoredAggregate stateEventStoreWriter stateEventStoreReader
+
    runCommand aggregate source =
+
        commandStoredAggregate
+
            stateEventStoreWriter
+
            stateEventStoreReader
+
            aggregate
+
            (toUUID source)

                      
instance Monad m => MonadContract (StateT state m) where
    invokeContract (InitContract "game") =