log sql with the loggers

IntersectMBO · Jun 8, 2021 · ccaecaa · ccaecaa
1 parent 37009aa
commit ccaecaa
Show file tree

Hide file tree

Showing 5 changed files with 33 additions and 20 deletions.
diff --git a/plutus-pab/app/Cli.hs b/plutus-pab/app/Cli.hs
@@ -192,14 +192,14 @@ runConfigCommand ConfigCommandArgs{ccaTrace, ccaPABConfig=Config{dbConfig}} (Ins
       do
         connection <- App.dbConnect (LM.convertLog LM.PABMsg ccaTrace) dbConfig
         fmap (either (error . show) id)
-            $ Beam.runBeamStoreAction connection
+            $ Beam.runBeamStoreAction 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
     connection <- App.dbConnect (LM.convertLog LM.PABMsg ccaTrace) dbConfig
     fmap (either (error . show) id)
-        $ Beam.runBeamStoreAction connection
+        $ Beam.runBeamStoreAction connection (LM.convertLog (LM.PABMsg . LM.SLoggerBridge) ccaTrace)
         $ interpret (LM.handleLogMsgTrace ccaTrace)
         $ do
             s <- Contract.getState @ContractExe contractInstanceId
@@ -211,7 +211,7 @@ runConfigCommand ConfigCommandArgs{ccaTrace, ccaPABConfig=Config{dbConfig}} (Con
 runConfigCommand ConfigCommandArgs{ccaTrace, ccaPABConfig=Config{dbConfig}} ReportInstalledContracts = do
     connection <- App.dbConnect (LM.convertLog LM.PABMsg ccaTrace) dbConfig
     fmap (either (error . show) id)
-        $ Beam.runBeamStoreAction connection
+        $ Beam.runBeamStoreAction connection (LM.convertLog (LM.PABMsg . LM.SLoggerBridge) ccaTrace)
         $ interpret (LM.handleLogMsgTrace ccaTrace)
         $ do
             installedContracts <- Contract.getDefinitions @ContractExe
@@ -224,7 +224,7 @@ runConfigCommand ConfigCommandArgs{ccaTrace, ccaPABConfig=Config{dbConfig}} Repo
 runConfigCommand ConfigCommandArgs{ccaTrace, ccaPABConfig=Config{dbConfig}} ReportActiveContracts = do
     connection <- App.dbConnect (LM.convertLog LM.PABMsg ccaTrace) dbConfig
     fmap (either (error . show) id)
-        $ Beam.runBeamStoreAction connection
+        $ Beam.runBeamStoreAction connection (LM.convertLog (LM.PABMsg . LM.SLoggerBridge) ccaTrace)
         $ interpret (LM.handleLogMsgTrace ccaTrace)
         $ do
             logInfo @(LM.AppMsg ContractExe) LM.ActiveContractsMsg
@@ -237,7 +237,7 @@ runConfigCommand ConfigCommandArgs{ccaTrace, ccaPABConfig=Config{dbConfig}} Repo
 runConfigCommand ConfigCommandArgs{ccaTrace, ccaPABConfig=Config{dbConfig}} (ReportContractHistory contractInstanceId) = do
     connection <- App.dbConnect (LM.convertLog LM.PABMsg ccaTrace) dbConfig
     fmap (either (error . show) id)
-        $ Beam.runBeamStoreAction connection
+        $ Beam.runBeamStoreAction connection (LM.convertLog (LM.PABMsg . LM.SLoggerBridge) ccaTrace)
         $ interpret (LM.handleLogMsgTrace ccaTrace)
         $ do
             logInfo @(LM.AppMsg ContractExe) LM.ContractHistoryMsg

diff --git a/plutus-pab/put-data-in-pab.sh b/plutus-pab/put-data-in-pab.sh
@@ -8,6 +8,9 @@ rm -rf pab-core.db*
 
 cabal run exe:plutus-pab -- --config plutus-pab.yaml migrate pab-core.db
 
+# Ensure marlowe apps are up-to-date
+cd ../marlowe && cabal build && cd -
+
 contracts=(marlowe-app marlowe-companion-app marlowe-follow-app)
 
 for c in "${contracts[@]}"; do

diff --git a/plutus-pab/src/Plutus/PAB/App.hs b/plutus-pab/src/Plutus/PAB/App.hs
@@ -108,13 +108,13 @@ appEffectHandlers config trace =
         , handleContractStoreEffect =
             interpret (Core.handleUserEnvReader @ContractExe @AppEnv)
             . interpret (Core.handleMappedReader @AppEnv dbConnection)
-            . interpret handleDbStore
+            . interpret (handleDbStore (convertLog SLoggerBridge trace))
             . reinterpret3 BeamEff.handleContractStore
 
         , handleContractDefinitionStoreEffect =
             interpret (Core.handleUserEnvReader @ContractExe @AppEnv)
             . interpret (Core.handleMappedReader @AppEnv dbConnection)
-            . interpret handleDbStore
+            . interpret (handleDbStore (convertLog SLoggerBridge trace))
             . reinterpret3 BeamEff.handleContractDefinitionStore
 
         , handleServicesEffects = \wallet ->

diff --git a/plutus-pab/src/Plutus/PAB/Db/Beam.hs b/plutus-pab/src/Plutus/PAB/Db/Beam.hs
@@ -11,6 +11,7 @@ Interface to beam ecosystem used by the PAB to store contracts.
 module Plutus.PAB.Db.Beam
   where
 
+import           Cardano.BM.Trace                           (Trace)
 import           Control.Monad.Freer                        (Eff, interpret, runM, subsume)
 import           Control.Monad.Freer.Delay                  (DelayEffect, handleDelayEffect)
 import           Control.Monad.Freer.Error                  (runError)
@@ -22,20 +23,22 @@ import           Plutus.PAB.Db.Beam.ContractStore           (handleContractStore
 import           Plutus.PAB.Effects.Contract                (ContractDefinitionStore, ContractStore)
 import           Plutus.PAB.Effects.Contract.ContractExe    (ContractExe)
 import           Plutus.PAB.Effects.DbStore
+import           Plutus.PAB.Monitoring.MonadLoggerBridge    (MonadLoggerMsg)
 import           Plutus.PAB.Types                           (PABError)
 
 -- | Run the ContractStore and ContractDefinitionStore effects on the
 --   SQLite database.
 runBeamStoreAction ::
     forall a.
     Connection
+    -> Trace IO MonadLoggerMsg
     -> Eff '[ContractDefinitionStore ContractExe, ContractStore ContractExe, DelayEffect, IO] a
     -> IO (Either PABError a)
-runBeamStoreAction connection =
+runBeamStoreAction connection trace =
     runM
     . runError
     . runReader connection
-    . interpret handleDbStore
+    . interpret (handleDbStore trace)
     . subsume @IO
     . handleDelayEffect
     . interpret handleContractStore

diff --git a/plutus-pab/src/Plutus/PAB/Effects/DbStore.hs b/plutus-pab/src/Plutus/PAB/Effects/DbStore.hs
@@ -17,16 +17,20 @@
 
 module Plutus.PAB.Effects.DbStore where
 
-import           Control.Monad.Freer         (Eff, LastMember, Member, type (~>))
-import           Control.Monad.Freer.Reader  (Reader, ask)
-import           Control.Monad.Freer.TH      (makeEffect)
-import           Data.Text                   (Text)
+import           Cardano.BM.Trace                        (Trace)
+import           Control.Monad.Freer                     (Eff, LastMember, Member, type (~>))
+import           Control.Monad.Freer.Reader              (Reader, ask)
+import           Control.Monad.Freer.TH                  (makeEffect)
+import qualified Control.Monad.Logger                    as MonadLogger
+import           Data.Text                               (Text)
+import qualified Data.Text                               as Text
 import           Database.Beam
 import           Database.Beam.Backend.SQL
 import           Database.Beam.Migrate
 import           Database.Beam.Schema.Tables
 import           Database.Beam.Sqlite
-import           Database.SQLite.Simple      (Connection)
+import           Database.SQLite.Simple                  (Connection)
+import           Plutus.PAB.Monitoring.MonadLoggerBridge (MonadLoggerMsg, TraceLoggerT (..))
 
 data ContractT f
     = Contract
@@ -140,30 +144,33 @@ handleDbStore ::
   ( Member (Reader Connection) effs
   , LastMember IO effs
   )
-  => DbStoreEffect
+  => Trace IO MonadLoggerMsg
+  -> DbStoreEffect
   ~> Eff effs
-handleDbStore eff = do
+handleDbStore trace eff = do
   connection <- ask @Connection
+  let traceSql = flip runTraceLoggerT trace . MonadLogger.logDebugN . Text.pack
+
   case eff of
     AddRow table record ->
       liftIO
-        $ runBeamSqliteDebug putStrLn connection
+        $ runBeamSqliteDebug traceSql connection
         $ runInsert
         $ insert table (insertValues [record])
 
     SelectList q ->
       liftIO
-        $ runBeamSqliteDebug putStrLn connection
+        $ runBeamSqliteDebug traceSql connection
         $ runSelectReturningList q
 
     SelectOne q ->
       liftIO
-        $ runBeamSqliteDebug putStrLn connection
+        $ runBeamSqliteDebug traceSql connection
         $ runSelectReturningOne q
 
     UpdateRow q ->
       liftIO
-        $ runBeamSqliteDebug putStrLn connection
+        $ runBeamSqliteDebug traceSql connection
         $ runUpdate q
 
 makeEffect ''DbStoreEffect