SCB: Tidying the MonadEventStore class.
Tighter API, better naming.
Tighter API, better naming.
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") =
CAD-2484: search error messages.
It's generate-allocs, not generate-alloc
Branch is https://github.com/input-output-hk/ouroboros-network/tree/ECIP-Checkpointing-SRV SRV records are used if no port is specified in the topology file. The specified address is used for the SRV lookup.
Branch is https://github.com/input-output-hk/ouroboros-network/tree/ECIP-Checkpointing-SRV SRV records are used if no port is specified in the topology file. The specified address is used for the SRV lookup.