wip allow multiple db configs

IntersectMBO · Jun 8, 2021 · b6a0c4b · b6a0c4b
1 parent 2925dc8
commit b6a0c4b
Show file tree

Hide file tree

Showing 8 changed files with 134 additions and 82 deletions.
diff --git a/plutus-pab/app/Cli.hs b/plutus-pab/app/Cli.hs
@@ -86,19 +86,19 @@ import           Plutus.PAB.Effects.EventLog             (EventLogBackend (..))
 
 import           Cardano.Node.Types                      (MockServerConfig (..))
 import qualified PSGenerator
-import           Plutus.Contract.Resumable                (responses)
-import           Plutus.Contract.State                    (State (..))
-import qualified Plutus.Contract.State                    as State
-import qualified Plutus.PAB.App                           as App
-import qualified Plutus.PAB.Core                          as Core
-import qualified Plutus.PAB.Db.Beam                       as Beam
-import qualified Plutus.PAB.Db.Eventful                   as Eventful
-import           Plutus.PAB.Effects.Contract.ContractExe  (ContractExe)
-import qualified Plutus.PAB.Monitoring.Monitoring         as LM
-import           Plutus.PAB.Types                         (Config (..), DbConfig (..), chainIndexConfig,
-                                                           metadataServerConfig, nodeServerConfig, walletServerConfig)
-import qualified Plutus.PAB.Webserver.Server              as PABServer
-import           Plutus.PAB.Webserver.Types               (ContractActivationArgs (..))
+import           Plutus.Contract.Resumable               (responses)
+import           Plutus.Contract.State                   (State (..))
+import qualified Plutus.Contract.State                   as State
+import qualified Plutus.PAB.App                          as App
+import qualified Plutus.PAB.Core                         as Core
+import qualified Plutus.PAB.Db.Beam                      as Beam
+import qualified Plutus.PAB.Db.Eventful                  as Eventful
+import           Plutus.PAB.Effects.Contract.ContractExe (ContractExe)
+import qualified Plutus.PAB.Monitoring.Monitoring        as LM
+import           Plutus.PAB.Types                        (Config (..), DbConfig (..), DbKind (..), chainIndexConfig,
+                                                          metadataServerConfig, nodeServerConfig, walletServerConfig)
+import qualified Plutus.PAB.Webserver.Server             as PABServer
+import           Plutus.PAB.Webserver.Types              (ContractActivationArgs (..))
 
 runNoConfigCommand ::
     Trace IO (LM.AppMsg ContractExe)  -- ^ PAB Tracer logging instance
@@ -108,7 +108,7 @@ runNoConfigCommand trace = \case
 
     -- Run database migration
     Migrate{dbPath} ->
-        let conf = DbConfig{dbConfigPoolSize=10, dbConfigFile=Text.pack dbPath} in
+        let conf = DbConfig{dbConfigPoolSize=10, dbConfigFile=Text.pack dbPath, dbConfigDbKind=BeamDb} in
         App.beamMigrate (LM.convertLog LM.PABMsg trace) conf
         -- TODO: Restore or delete
         -- App.migrate (LM.convertLog LM.PABMsg trace) conf
@@ -121,11 +121,11 @@ runNoConfigCommand trace = \case
 
 data ConfigCommandArgs =
     ConfigCommandArgs
-        { ccaTrace           :: Trace IO (LM.AppMsg ContractExe)  -- ^ PAB Tracer logging instance
-        , ccaLoggingConfig   :: Configuration -- ^ Monitoring configuration
-        , ccaPABConfig       :: Config        -- ^ PAB Configuration
-        , ccaAvailability    :: Availability  -- ^ Token for signaling service availability
-        , ccaEventfulBackend :: App.EventfulBackend -- ^ Whether to use the sqlite or the in-memory backend
+        { ccaTrace         :: Trace IO (LM.AppMsg ContractExe)  -- ^ PAB Tracer logging instance
+        , ccaLoggingConfig :: Configuration -- ^ Monitoring configuration
+        , ccaPABConfig     :: Config        -- ^ PAB Configuration
+        , ccaAvailability  :: Availability  -- ^ Token for signaling service availability
+        , ccaDbBackend     :: App.DbBackend -- ^ Which kind of backend to use
         }
 
 -- | Interpret a 'Command' in 'Eff' using the provided tracer and configurations
@@ -160,9 +160,9 @@ runConfigCommand ConfigCommandArgs{ccaTrace, ccaPABConfig = Config {metadataServ
         ccaAvailability
 
 -- Run PAB webserver
-runConfigCommand ConfigCommandArgs{ccaTrace, ccaPABConfig=config@Config{pabWebserverConfig}, ccaAvailability, ccaEventfulBackend} PABWebserver =
+runConfigCommand ConfigCommandArgs{ccaTrace, ccaPABConfig=config@Config{pabWebserverConfig}, ccaAvailability, ccaDbBackend} PABWebserver =
         fmap (either (error . show) id)
-        $ App.runApp ccaEventfulBackend (toPABMsg ccaTrace) config
+        $ App.runApp ccaDbBackend (toPABMsg ccaTrace) config
         $ do
             App.AppEnv{App.walletClientEnv} <- Core.askUserEnv @ContractExe @App.AppEnv
             (mvar, _) <- PABServer.startServer pabWebserverConfig (Left walletClientEnv) ccaAvailability
@@ -193,17 +193,20 @@ runConfigCommand ConfigCommandArgs{ccaTrace, ccaPABConfig=Config {nodeServerConf
         ccaAvailability
 
 -- Install a contract
-runConfigCommand ConfigCommandArgs{ccaTrace, ccaPABConfig=Config{dbConfig}} (InstallContract contractExe) = do
-    connection <- App.beamDbConnect (LM.convertLog LM.PABMsg ccaTrace) dbConfig
-    fmap (either (error . show) id)
-        $ Beam.runBeamStoreAction connection
-        $ Contract.addDefinition @ContractExe contractExe
--- TODO: Restore or delete!
--- runConfigCommand ConfigCommandArgs{ccaTrace, ccaPABConfig=Config{dbConfig}} (InstallContract contractExe) = do
---     connection <- Sqlite <$> App.dbConnect (LM.convertLog LM.PABMsg ccaTrace) dbConfig
---     fmap (either (error . show) id)
---         $ Eventful.runEventfulStoreAction connection (LM.convertLog (LM.PABMsg . LM.SLoggerBridge) ccaTrace)
---         $ Contract.addDefinition @ContractExe contractExe
+runConfigCommand ConfigCommandArgs{ccaTrace, ccaPABConfig=Config{dbConfig}} (InstallContract contractExe) =
+  case dbConfigDbKind dbConfig of
+    BeamDb ->
+      do
+        connection <- App.beamDbConnect (LM.convertLog LM.PABMsg ccaTrace) dbConfig
+        fmap (either (error . show) id)
+            $ Beam.runBeamStoreAction connection
+            $ Contract.addDefinition @ContractExe contractExe
+    EventfulDb ->
+      do
+        connection <- Sqlite <$> App.dbConnect (LM.convertLog LM.PABMsg ccaTrace) dbConfig
+        fmap (either (error . show) id)
+            $ Eventful.runEventfulStoreAction connection (LM.convertLog (LM.PABMsg . LM.SLoggerBridge) ccaTrace)
+            $ Contract.addDefinition @ContractExe contractExe
 
 -- Get the state of a contract
 runConfigCommand ConfigCommandArgs{ccaTrace, ccaPABConfig=Config{dbConfig}} (ContractState contractInstanceId) = do

diff --git a/plutus-pab/app/CommandParser.hs b/plutus-pab/app/CommandParser.hs
@@ -19,16 +19,16 @@ import           Options.Applicative                     (CommandFields, Mod, Pa
                                                           idm, info, long, metavar, option, prefs, progDesc, short,
                                                           showHelpOnEmpty, showHelpOnError, str, strOption, subparser,
                                                           value)
-import           Plutus.PAB.App                          (EventfulBackend (..))
+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
-                       , eventfulBackend :: EventfulBackend
-                       , cmd             :: Command
+data AppOpts = AppOpts { minLogLevel   :: Maybe Severity
+                       , logConfigPath :: Maybe FilePath
+                       , configPath    :: Maybe FilePath
+                       , runEkgServer  :: Bool
+                       , dbBackend     :: DbBackend
+                       , cmd           :: Command
                        }
 
 parseOptions :: IO AppOpts
@@ -50,20 +50,23 @@ ekgFlag =
         True
         (short 'e' <> long "ekg" <> help "Enable the EKG server")
 
-inMemoryFlag :: Parser EventfulBackend
-inMemoryFlag =
-    flag
-        SqliteBackend
-        InMemoryBackend
-        (short 'm' <> long "memory" <> help "Use the memory-backed eventful backend. If false, the sqlite backend is used.")
+dbBackendParser :: Parser DbBackend
+dbBackendParser =
+  option
+    auto
+    (long "db-backend" <>
+     metavar "DB_BACKEND" <>
+     help "Database backend: One of: EventfulSqliteBackend, EventfulInMemoryBackend, BeamSqliteBackend" <>
+     value BeamSqliteBackend
+    )
 
 commandLineParser :: Parser AppOpts
 commandLineParser =
         AppOpts <$> logLevelFlag
                <*> logConfigFileParser
                <*> configFileParser
                <*> ekgFlag
-               <*> inMemoryFlag
+               <*> dbBackendParser
                <*> commandParser
 
 configFileParser :: Parser (Maybe FilePath)

diff --git a/plutus-pab/app/Main.hs b/plutus-pab/app/Main.hs
@@ -37,7 +37,7 @@ import           System.Exit                             (ExitCode (ExitFailure)
 
 main :: IO ()
 main = do
-    AppOpts { minLogLevel, logConfigPath, runEkgServer, cmd, configPath, eventfulBackend } <- parseOptions
+    AppOpts { minLogLevel, logConfigPath, runEkgServer, cmd, configPath, dbBackend } <- parseOptions
 
     -- Parse config files and initialize logging
     logConfig <- maybe defaultConfig loadConfig logConfigPath
@@ -62,7 +62,7 @@ main = do
                                         , ccaLoggingConfig = logConfig
                                         , ccaPABConfig = config
                                         , ccaAvailability = serviceAvailability
-                                        , ccaEventfulBackend = eventfulBackend
+                                        , ccaDbBackend = dbBackend
                                         }
                             Right <$> runConfigCommand args command
                 WithoutConfig command -> Right <$> runNoConfigCommand (convertLog PrettyObject trace) command

diff --git a/plutus-pab/plutus-pab.yaml b/plutus-pab/plutus-pab.yaml
@@ -1,6 +1,7 @@
 dbConfig:
     dbConfigFile: pab-core.db
     dbConfigPoolSize: 20
+    dbConfigDbKind: BeamDb
 
 pabWebserverConfig:
   baseUrl: http://localhost:9080

diff --git a/plutus-pab/put-data-in-pab.sh b/plutus-pab/put-data-in-pab.sh
@@ -6,8 +6,8 @@ killall plutus-pab || true
 
 rm -rf pab-core.db* 
 
-cabal exec -- plutus-pab --config plutus-pab.yaml migrate pab-core.db
+cabal run exe:plutus-pab -- --config plutus-pab.yaml migrate pab-core.db
 
-cabal exec -- plutus-pab --config plutus-pab.yaml contracts install --path "$(cabal exec -- which plutus-game)"
+cabal run exe:plutus-pab -- --config plutus-pab.yaml contracts install --path "$(cabal exec -- which plutus-game)"
 
-cabal exec -- plutus-pab all-servers --config plutus-pab.yaml
+cabal run exe:plutus-pab -- all-servers --config plutus-pab.yaml