Skip to content

Commit

Permalink
real struggle; just before deleting eventful.
Browse files Browse the repository at this point in the history
  • Loading branch information
@silky
silky committed Jun 8, 2021
1 parent d14e9fd commit 5ab0a02
Show file tree
Hide file tree
Showing 8 changed files with 122 additions and 101 deletions.
4 changes: 2 additions & 2 deletions plutus-pab/app/Cli.hs
View file
Expand Up @@ -125,7 +125,7 @@ data ConfigCommandArgs =
, ccaLoggingConfig :: Configuration -- ^ Monitoring configuration
, ccaPABConfig :: Config -- ^ PAB Configuration
, ccaAvailability :: Availability -- ^ Token for signaling service availability
, ccaDbBackend :: App.DbBackend -- ^ Which kind of backend to use
, ccaDbBackend :: App.DbBackend -- ^ Which kind of backend to use for the provided db kind.
}

-- | Interpret a 'Command' in 'Eff' using the provided tracer and configurations
Expand Down Expand Up @@ -193,7 +193,7 @@ runConfigCommand ConfigCommandArgs{ccaTrace, ccaPABConfig=Config {nodeServerConf
ccaAvailability

-- Install a contract
runConfigCommand ConfigCommandArgs{ccaTrace, ccaPABConfig=Config{dbConfig}} (InstallContract contractExe) =
runConfigCommand ConfigCommandArgs{ccaTrace, ccaDbBackend, ccaPABConfig=Config{dbConfig}} (InstallContract contractExe) =
-- case dbConfigDbKind dbConfig of
-- BeamDb ->
do
Expand Down
40 changes: 21 additions & 19 deletions plutus-pab/app/CommandParser.hs
View file
Expand Up @@ -10,27 +10,29 @@

module CommandParser (parseOptions, AppOpts(..)) where

import Command

import Cardano.BM.Data.Severity (Severity (..))

import Command
import Options.Applicative (CommandFields, Mod, Parser, argument, auto, command,
customExecParser, disambiguate, flag, fullDesc, help, helper,
idm, info, long, metavar, option, prefs, progDesc, short,
showHelpOnEmpty, showHelpOnError, str, strOption, subparser,
value)
import Plutus.PAB.App (DbBackend (..))
import Plutus.PAB.Effects.Contract.ContractExe (ContractExe (..))
import Wallet.Types (ContractInstanceId (..))

data AppOpts = AppOpts { minLogLevel :: Maybe Severity
, logConfigPath :: Maybe FilePath
, configPath :: Maybe FilePath
, runEkgServer :: Bool
, dbBackend :: DbBackend
-- , dbKind :: DbKind
, cmd :: Command
}

-- data DbKind
-- = OnDisk
-- | InMemory
-- deriving (Eq, Show, Read)

parseOptions :: IO AppOpts
parseOptions = customExecParser
(prefs $ disambiguate <> showHelpOnEmpty <> showHelpOnError)
Expand All @@ -50,24 +52,23 @@ ekgFlag =
True
(short 'e' <> long "ekg" <> help "Enable the EKG server")

dbBackendParser :: Parser DbBackend
dbBackendParser =
option
auto
(long "db-backend" <>
metavar "DB_BACKEND" <>
help "Database backend: One of: EventfulSqliteBackend, EventfulInMemoryBackend, BeamSqliteBackend" <>
value BeamSqliteBackend
)
-- dbKindParser :: Parser DbKind
-- dbKindParser =
-- option
-- auto
-- (long "db" <>
-- metavar "DB" <>
-- help "Database kind. One of: OnDisk, InMemory" <>
-- value Beam)

commandLineParser :: Parser AppOpts
commandLineParser =
AppOpts <$> logLevelFlag
<*> logConfigFileParser
<*> configFileParser
<*> ekgFlag
<*> dbBackendParser
<*> commandParser
<*> logConfigFileParser
<*> configFileParser
<*> ekgFlag
-- <*> dbKindParser
<*> commandParser

configFileParser :: Parser (Maybe FilePath)
configFileParser =
Expand Down Expand Up @@ -144,6 +145,7 @@ migrationParser =
str
(metavar "DATABASE" <>
help "The sqlite database file.")
-- TODO: This will need to be 'WithConfig'.
pure $ WithoutConfig $ Migrate{dbPath}

mockNodeParser :: Mod CommandFields Command
Expand Down
4 changes: 2 additions & 2 deletions plutus-pab/app/Main.hs
View file
Expand Up @@ -37,7 +37,7 @@ import System.Exit (ExitCode (ExitFailure)

main :: IO ()
main = do
AppOpts { minLogLevel, logConfigPath, runEkgServer, cmd, configPath, dbBackend } <- parseOptions
AppOpts { minLogLevel, logConfigPath, runEkgServer, cmd, configPath, dbKind } <- parseOptions

-- Parse config files and initialize logging
logConfig <- maybe defaultConfig loadConfig logConfigPath
Expand All @@ -62,7 +62,7 @@ main = do
, ccaLoggingConfig = logConfig
, ccaPABConfig = config
, ccaAvailability = serviceAvailability
, ccaDbBackend = dbBackend
, ccaDbKind = dbKind
}
Right <$> runConfigCommand args command
WithoutConfig command -> Right <$> runNoConfigCommand (convertLog PrettyObject trace) command
Expand Down
1 change: 1 addition & 0 deletions plutus-pab/plutus-pab.yaml
View file
@@ -1,6 +1,7 @@
dbConfig:
dbConfigFile: pab-core.db
dbConfigPoolSize: 20
dbConfigKind: BeamKind

pabWebserverConfig:
baseUrl: http://localhost:9080
Expand Down
132 changes: 69 additions & 63 deletions plutus-pab/src/Plutus/PAB/App.hs
View file
Expand Up @@ -20,7 +20,6 @@ module Plutus.PAB.App(
App,
runApp,
AppEnv(..),
DbBackend(..),
-- * App actions
migrate,
dbConnect,
Expand Down Expand Up @@ -71,37 +70,51 @@ import qualified Plutus.PAB.Db.Beam.ContractStore as BeamEff
import qualified Plutus.PAB.Db.Memory.ContractStore as InMem
import Plutus.PAB.Effects.Contract.ContractExe (ContractExe, handleContractEffectContractExe)
import Plutus.PAB.Effects.DbStore (Db, handleDbStore, initialSetupStep)
import Plutus.PAB.Effects.EventLog (Connection (..), EventLogBackend (..), handleEventLog)
import Plutus.PAB.Effects.EventLog (EventfulConnection (..), handleEventLog)
import qualified Plutus.PAB.Effects.EventLog as EventLog
import Plutus.PAB.Events (PABEvent)
import Plutus.PAB.Monitoring.MonadLoggerBridge (TraceLoggerT (..))
import Plutus.PAB.Monitoring.Monitoring (convertLog, handleLogMsgTrace)
import Plutus.PAB.Monitoring.PABLogMsg (PABLogMsg (..))
import Plutus.PAB.Timeout (Timeout (..))
import Plutus.PAB.Types (Config (Config), DbConfig (..), PABError (..),
chainIndexConfig, dbConfig, endpointTimeout,
nodeServerConfig, walletServerConfig)
import Plutus.PAB.Types (Config (Config), DbConfig (..), DbKind (..),
PABError (..), chainIndexConfig, dbConfig,
endpointTimeout, nodeServerConfig, walletServerConfig)
import Servant.Client (ClientEnv, mkClientEnv)

------------------------------------------------------------

data DbThing event
= BeamThing Sqlite.Connection
| EventfulThing (SomeEventfulThing event)
| InMemThing (InMemInstances ContractExe)

data SomeEventfulThing event
= EventfulMemThing (STM.TVar (M.EventMap event))
| EventfulSqliteThing EventfulConnection

data AppEnv =
AppEnv
{ dbConnection :: EventLogBackend (PABEvent ContractExe)
, walletClientEnv :: ClientEnv
, nodeClientEnv :: ClientEnv
, chainIndexEnv :: ClientEnv
, txSendHandle :: Client.TxSendHandle
, chainSyncHandle :: Client.ChainSyncHandle
, appConfig :: Config
, appTrace :: Trace IO (PABLogMsg ContractExe)
, appInMemContractStore :: InMemInstances ContractExe
-- Better option:
{ dbBackend :: DbThing (PABEvent ContractExe)
-- Bad option:
-- { beamBackend :: Sqlite.Connection
-- , eventfulBackend :: SomeEventfulThing (PABEvent ContractExe)
, walletClientEnv :: ClientEnv
, nodeClientEnv :: ClientEnv
, chainIndexEnv :: ClientEnv
, txSendHandle :: Client.TxSendHandle
, chainSyncHandle :: Client.ChainSyncHandle
, appConfig :: Config
, appTrace :: Trace IO (PABLogMsg ContractExe)
-- , appInMemContractStore :: InMemInstances ContractExe
}

appEffectHandlers :: DbBackend -> Config -> Trace IO (PABLogMsg ContractExe) -> EffectHandlers ContractExe AppEnv
appEffectHandlers dbBackend config trace =
appEffectHandlers :: DbKind -> Config -> Trace IO (PABLogMsg ContractExe) -> EffectHandlers ContractExe AppEnv
appEffectHandlers dbKind config trace =
EffectHandlers
{ initialiseEnvironment = do
env <- liftIO $ mkEnv dbBackend trace config
env <- liftIO $ mkEnv dbKind trace config
let Config{nodeServerConfig=MockServerConfig{mscSocketPath, mscSlotConfig}} = config
instancesState <- liftIO $ STM.atomically $ Instances.emptyInstancesState
blockchainEnv <- liftIO $ BlockchainEnv.startNodeClient mscSocketPath mscSlotConfig
Expand All @@ -117,44 +130,42 @@ appEffectHandlers dbBackend config trace =
. reinterpret (handleContractEffectContractExe @IO)

, handleContractStoreEffect =
case dbBackend of
BeamSqliteBackend ->
case dbKind of
BeamKind ->
interpret (Core.handleUserEnvReader @ContractExe @AppEnv)
. interpret (Core.handleMappedReader @AppEnv dbConnection)
. interpret (Core.handleMappedReader @AppEnv beamBackend)
. interpret (handleDbStore undefined)
. reinterpret3 BeamEff.handleContractStore

EventfulInMemoryBackend ->
EventfulSqliteKind ->
interpret (Core.handleUserEnvReader @ContractExe @AppEnv)
. interpret (Core.handleMappedReader @AppEnv appInMemContractStore)
. reinterpret2 InMem.handleContractStore

EventfulSqliteBackend ->
interpret (Core.handleUserEnvReader @ContractExe @AppEnv)
. interpret (Core.handleMappedReader @AppEnv dbConnection)
. interpret (Core.handleMappedReader @AppEnv dbBackend)
. interpret (handleEventLog @_ @(PABEvent ContractExe) (convertLog SLoggerBridge trace))
. reinterpret3 EventfulEff.handleContractStore

, handleContractDefinitionStoreEffect =
case dbBackend of
BeamSqliteBackend ->
interpret (Core.handleUserEnvReader @ContractExe @AppEnv)
. interpret (Core.handleMappedReader @AppEnv dbConnection)
. interpret (handleDbStore undefined)
. reinterpret3 BeamEff.handleContractDefinitionStore
-- InMemory ->
-- interpret (Core.handleUserEnvReader @ContractExe @AppEnv)
-- . interpret (Core.handleMappedReader @AppEnv appInMemContractStore)
-- . reinterpret2 InMem.handleContractStore

EventfulInMemoryBackend ->
-- TODO: Implement
error "Not supported!!"
-- interpret (Core.handleUserEnvReader @ContractExe @AppEnv)
-- . interpret (Core.handleMappedReader @AppEnv appInMemContractStore)
-- . reinterpret2 InMem.handleContractDefinitionStore

EventfulSqliteBackend ->
interpret (Core.handleUserEnvReader @ContractExe @AppEnv)
. interpret (Core.handleMappedReader @AppEnv dbConnection)
. interpret (handleEventLog @_ @(PABEvent ContractExe) (convertLog SLoggerBridge trace))
. reinterpret3 EventfulEff.handleContractDefinitionStore
, handleContractDefinitionStoreEffect = undefined
-- case dbKind of
-- Beam ->
-- interpret (Core.handleUserEnvReader @ContractExe @AppEnv)
-- . interpret (Core.handleMappedReader @AppEnv beamBackend)
-- . interpret (handleDbStore undefined)
-- . reinterpret3 BeamEff.handleContractDefinitionStore

-- InMemory ->
-- -- TODO: Implement
-- error "Not supported!!"

-- Eventful ->
-- interpret (Core.handleUserEnvReader @ContractExe @AppEnv)
-- . interpret (Core.handleMappedReader @AppEnv eventfulBackend)
-- . interpret (handleEventLog @_ @(PABEvent ContractExe) (convertLog SLoggerBridge trace))
-- . reinterpret3 EventfulEff.handleContractDefinitionStore

, handleServicesEffects = \wallet ->

Expand Down Expand Up @@ -188,35 +199,30 @@ appEffectHandlers dbBackend config trace =

runApp ::
forall a.
DbBackend
DbKind
-> Trace IO (PABLogMsg ContractExe) -- ^ Top-level tracer
-> Config -- ^ Client configuration
-> App a -- ^ Action
-> IO (Either PABError a)
runApp dbBackend trace config@Config{endpointTimeout} = Core.runPAB (Timeout endpointTimeout) (appEffectHandlers dbBackend config trace)
runApp dbKind trace config@Config{endpointTimeout} = Core.runPAB (Timeout endpointTimeout) (appEffectHandlers dbKind config trace)

type App a = PABAction ContractExe AppEnv a

data DbBackend
= EventfulSqliteBackend
| EventfulInMemoryBackend
| BeamSqliteBackend
deriving (Eq, Show, Read)

mkEnv :: DbBackend -> Trace IO (PABLogMsg ContractExe) -> Config -> IO AppEnv
mkEnv dbBackend appTrace appConfig@Config { dbConfig
mkEnv :: DbKind -> Trace IO (PABLogMsg ContractExe) -> Config -> IO AppEnv
mkEnv dbKind appTrace appConfig@Config { dbConfig
, nodeServerConfig = MockServerConfig{mscBaseUrl, mscSocketPath, mscSlotConfig}
, walletServerConfig
, chainIndexConfig
} = do
walletClientEnv <- clientEnv (Wallet.baseUrl walletServerConfig)
nodeClientEnv <- clientEnv mscBaseUrl
chainIndexEnv <- clientEnv (ChainIndex.ciBaseUrl chainIndexConfig)
dbConnection <- case dbBackend of
EventfulSqliteBackend -> Sqlite <$> dbConnect appTrace dbConfig
EventfulInMemoryBackend -> InMemory <$> M.eventMapTVar
-- TODO: Implement
BeamSqliteBackend -> error "!!!"

dbBackend <- case dbKind of
BeamKind -> BeamThing <$> beamDbConnect appTrace dbConfig
EventfulInMemoryKind -> EventfulThing <$> (EventfulMemThing <$> M.eventMapTVar)
EventfulSqliteKind -> EventfulThing <$> (EventfulSqliteThing <$> dbConnect appTrace dbConfig)
InMemoryKind -> undefined -- TODO

txSendHandle <- liftIO $ Client.runTxSender mscSocketPath
-- This is for access to the slot number in the interpreter
Expand Down Expand Up @@ -268,7 +274,7 @@ beamDbConnect trace DbConfig {dbConfigFile} =
-- | Initialize/update the database to hold events.
migrate :: Trace IO (PABLogMsg ContractExe) -> DbConfig -> IO ()
migrate trace config = do
Connection (sqlConfig, connectionPool) <- dbConnect trace config
EventfulConnection (sqlConfig, connectionPool) <- dbConnect trace config
flip runTraceLoggerT (convertLog SLoggerBridge trace) $ do
liftIO
$ flip runSqlPool connectionPool
Expand All @@ -278,10 +284,10 @@ migrate trace config = do
------------------------------------------------------------
-- | Create a database 'Connection' containing the connection pool
-- plus some configuration information.
dbConnect :: Trace IO (PABLogMsg ContractExe) -> DbConfig -> IO EventLog.Connection
dbConnect :: Trace IO (PABLogMsg ContractExe) -> DbConfig -> IO EventfulConnection
dbConnect trace DbConfig {dbConfigFile, dbConfigPoolSize} =
flip runTraceLoggerT (convertLog SLoggerBridge trace) $ do
let connectionInfo = mkSqliteConnectionInfo dbConfigFile
MonadLogger.logDebugN $ "Connecting to DB: " <> dbConfigFile
connectionPool <- createSqlitePoolFromInfo connectionInfo dbConfigPoolSize
pure $ EventLog.Connection (defaultSqlEventStoreConfig, connectionPool)
pure $ EventfulConnection (defaultSqlEventStoreConfig, connectionPool)
4 changes: 2 additions & 2 deletions plutus-pab/src/Plutus/PAB/Db/Eventful.hs
View file
Expand Up @@ -25,7 +25,7 @@ import Plutus.PAB.Db.Eventful.ContractDefinitionStore (handleContractD
import Plutus.PAB.Db.Eventful.ContractStore (handleContractStore)
import Plutus.PAB.Effects.Contract (ContractDefinitionStore, ContractStore)
import Plutus.PAB.Effects.Contract.ContractExe (ContractExe)
import Plutus.PAB.Effects.EventLog (EventLogBackend, handleEventLog)
import Plutus.PAB.Effects.EventLog (EventfulBackend, handleEventLog)
import Plutus.PAB.Events (PABEvent)
import Plutus.PAB.Monitoring.MonadLoggerBridge (MonadLoggerMsg)
import Plutus.PAB.Types (PABError)
Expand All @@ -34,7 +34,7 @@ import Plutus.PAB.Types (PABError)
-- SQLite database.
runEventfulStoreAction ::
forall a.
EventLogBackend (PABEvent ContractExe)
EventfulBackend (PABEvent ContractExe)
-> Trace IO MonadLoggerMsg
-> Eff '[ContractDefinitionStore ContractExe, ContractStore ContractExe, DelayEffect, IO] a
-> IO (Either PABError a)
Expand Down

0 comments on commit 5ab0a02

Please sign in to comment.