SCB: Tidying the MonadEventStore class.
Tighter API, better naming.
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") =