use trace logger for sql statements

IntersectMBO · Jun 14, 2021 · 24273da · 24273da
1 parent 685599c
commit 24273da
Show file tree

Hide file tree

Showing 5 changed files with 34 additions and 20 deletions.
diff --git a/plutus-pab/app/Cli.hs b/plutus-pab/app/Cli.hs
@@ -193,14 +193,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 (LM.convertLog (LM.PABMsg . LM.SLoggerBridge) ccaTrace)
+            $ Beam.runBeamStoreAction connection (LM.convertLog LM.PABMsg 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 (LM.convertLog (LM.PABMsg . LM.SLoggerBridge) ccaTrace)
+        $ Beam.runBeamStoreAction connection (LM.convertLog LM.PABMsg ccaTrace)
         $ interpret (LM.handleLogMsgTrace ccaTrace)
         $ do
             s <- Contract.getState @ContractExe contractInstanceId
@@ -212,7 +212,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 (LM.convertLog (LM.PABMsg . LM.SLoggerBridge) ccaTrace)
+        $ Beam.runBeamStoreAction connection (LM.convertLog LM.PABMsg ccaTrace)
         $ interpret (LM.handleLogMsgTrace ccaTrace)
         $ do
             installedContracts <- Contract.getDefinitions @ContractExe
@@ -225,7 +225,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 (LM.convertLog (LM.PABMsg . LM.SLoggerBridge) ccaTrace)
+        $ Beam.runBeamStoreAction connection (LM.convertLog LM.PABMsg ccaTrace)
         $ interpret (LM.handleLogMsgTrace ccaTrace)
         $ do
             logInfo @(LM.AppMsg ContractExe) LM.ActiveContractsMsg
@@ -238,7 +238,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 (LM.convertLog (LM.PABMsg . LM.SLoggerBridge) ccaTrace)
+        $ Beam.runBeamStoreAction connection (LM.convertLog LM.PABMsg ccaTrace)
         $ interpret (LM.handleLogMsgTrace ccaTrace)
         $ do
             logInfo @(LM.AppMsg ContractExe) LM.ContractHistoryMsg

diff --git a/plutus-pab/src/Plutus/PAB/App.hs b/plutus-pab/src/Plutus/PAB/App.hs
@@ -58,7 +58,7 @@ import qualified Plutus.PAB.Db.Beam.ContractStore               as BeamEff
 import           Plutus.PAB.Db.Memory.ContractStore             (InMemInstances, initialInMemInstances)
 -- TODO: Use this or delete it
 import qualified Plutus.PAB.Db.Memory.ContractStore             as InMem
-import           Plutus.PAB.Effects.Contract.ContractExe        (ContractExe, handleContractEffectContractExe)
+import           Plutus.PAB.Effects.Contract.ContractExe        (ContractExe (..), handleContractEffectContractExe)
 import           Plutus.PAB.Effects.DbStore                     (checkedSqliteDb, handleDbStore)
 import           Plutus.PAB.Monitoring.MonadLoggerBridge        (TraceLoggerT (..))
 import           Plutus.PAB.Monitoring.Monitoring               (convertLog, handleLogMsgTrace)
@@ -104,16 +104,20 @@ appEffectHandlers config trace =
             . reinterpret (handleContractEffectContractExe @IO)
 
         , handleContractStoreEffect =
-            interpret (Core.handleUserEnvReader @ContractExe @AppEnv)
+            interpret (handleLogMsgTrace trace)
+            . reinterpret (mapLog @_ @(PABLogMsg ContractExe) SMultiAgent)
+            . interpret (Core.handleUserEnvReader @ContractExe @AppEnv)
             . interpret (Core.handleMappedReader @AppEnv dbConnection)
-            . interpret (handleDbStore (convertLog SLoggerBridge trace))
-            . reinterpret3 BeamEff.handleContractStore
+            . interpret (handleDbStore trace)
+            . reinterpretN @'[_, _, _, _] BeamEff.handleContractStore
 
         , handleContractDefinitionStoreEffect =
-            interpret (Core.handleUserEnvReader @ContractExe @AppEnv)
+            interpret (handleLogMsgTrace trace)
+            . reinterpret (mapLog @_ @(PABLogMsg ContractExe) SMultiAgent)
+           .  interpret (Core.handleUserEnvReader @ContractExe @AppEnv)
             . interpret (Core.handleMappedReader @AppEnv dbConnection)
-            . interpret (handleDbStore (convertLog SLoggerBridge trace))
-            . reinterpret3 BeamEff.handleContractDefinitionStore
+            . interpret (handleDbStore trace)
+            . reinterpretN @'[_, _, _, _] BeamEff.handleContractDefinitionStore
 
         , handleServicesEffects = \wallet ->
             -- handle 'NodeClientEffect'

diff --git a/plutus-pab/src/Plutus/PAB/Db/Beam.hs b/plutus-pab/src/Plutus/PAB/Db/Beam.hs
@@ -23,15 +23,15 @@ 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.Monitoring.PABLogMsg            (PABLogMsg)
 import           Plutus.PAB.Types                           (PABError)
 
 -- | Run the ContractStore and ContractDefinitionStore effects on the
 --   SQLite database.
 runBeamStoreAction ::
     forall a.
     Connection
-    -> Trace IO MonadLoggerMsg
+    -> Trace IO (PABLogMsg ContractExe)
     -> Eff '[ContractDefinitionStore ContractExe, ContractStore ContractExe, DelayEffect, IO] a
     -> IO (Either PABError a)
 runBeamStoreAction connection trace =

diff --git a/plutus-pab/src/Plutus/PAB/Effects/DbStore.hs b/plutus-pab/src/Plutus/PAB/Effects/DbStore.hs
@@ -18,19 +18,21 @@
 module Plutus.PAB.Effects.DbStore where
 
 import           Cardano.BM.Trace                        (Trace)
-import           Control.Monad.Freer                     (Eff, LastMember, Member, type (~>))
+import           Control.Monad.Freer                     (Eff, LastMember, Member, interpret, reinterpret, runM,
+                                                          type (~>))
+import           Control.Monad.Freer.Extras.Log          (logDebug, mapLog)
 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           Plutus.PAB.Monitoring.MonadLoggerBridge (MonadLoggerMsg, TraceLoggerT (..))
+import           Plutus.PAB.Effects.Contract.ContractExe (ContractExe)
+import           Plutus.PAB.Monitoring.Monitoring        (handleLogMsgTrace)
+import           Plutus.PAB.Monitoring.PABLogMsg         (PABLogMsg (..), PABMultiAgentMsg (..))
 
 data ContractT f
     = Contract
@@ -125,12 +127,17 @@ handleDbStore ::
   ( Member (Reader Connection) effs
   , LastMember IO effs
   )
-  => Trace IO MonadLoggerMsg
+  => Trace IO (PABLogMsg ContractExe)
   -> DbStoreEffect
   ~> Eff effs
 handleDbStore trace eff = do
   connection <- ask @Connection
-  let traceSql = flip runTraceLoggerT trace . MonadLogger.logDebugN . Text.pack
+
+  let traceSql s =
+          runM
+            . interpret (handleLogMsgTrace trace)
+            . reinterpret (mapLog @_ @(PABLogMsg ContractExe) SMultiAgent)
+          $ logDebug @(PABMultiAgentMsg ContractExe) $ SqlLog s
 
   case eff of
     AddRow table record ->

diff --git a/plutus-pab/src/Plutus/PAB/Monitoring/PABLogMsg.hs b/plutus-pab/src/Plutus/PAB/Monitoring/PABLogMsg.hs
@@ -171,6 +171,7 @@ data PABMultiAgentMsg t =
     | CoreLog (CoreMsg t)
     | RuntimeLog ContractRuntimeMsg
     | UserLog T.Text
+    | SqlLog String
     | StartingPABBackendServer Int
     | StartingMetadataServer Int
     deriving stock Generic
@@ -185,6 +186,7 @@ instance (StructuredLog (ContractDef t), ToJSON (ContractDef t)) => ToObject (PA
         CoreLog m                  -> toObject v m
         RuntimeLog m               -> toObject v m
         UserLog t                  -> toObject v t
+        SqlLog s                   -> toObject v s
         StartingPABBackendServer i -> mkObjectStr "starting backend server" (Tagged @"port" i)
         StartingMetadataServer i   -> mkObjectStr "starting backend server" (Tagged @"port" i)
 
@@ -202,6 +204,7 @@ instance Pretty (ContractDef t) => Pretty (PABMultiAgentMsg t) where
         CoreLog m             -> pretty m
         RuntimeLog m          -> pretty m
         UserLog m             -> pretty m
+        SqlLog m              -> pretty m
         StartingPABBackendServer port ->
             "Starting PAB backend server on port:" <+> pretty port
         StartingMetadataServer port ->