[Polysemy] Generalise and Move the Logger Effect to polysemy-wire-zoo

changelog.d/5-internal/logger-effect

@@ -0,0 +1 @@
+Generalise and move the Logger effect

libs/polysemy-wire-zoo/polysemy-wire-zoo.cabal

@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: be6e191f98f61663091d940ccdb428f4f844cf94b6defd13f19a3c65d9e4e894
+-- hash: 0204c1b2ab38844b968c4c7d7eaa789d6a585ce3d7b9f347de6b9f18792b1055
 
 name:           polysemy-wire-zoo
 version:        0.1.0
@@ -21,6 +21,9 @@ library
   exposed-modules:
       Polysemy.TinyLog
       Wire.Sem.FromUTC
+      Wire.Sem.Logger
+      Wire.Sem.Logger.Level
+      Wire.Sem.Logger.TinyLog
       Wire.Sem.Now
       Wire.Sem.Now.Input
       Wire.Sem.Now.IO

libs/polysemy-wire-zoo/src/Polysemy/TinyLog.hs

@@ -14,40 +14,22 @@
 --
 -- You should have received a copy of the GNU Affero General Public License along
 -- with this program. If not, see <https://www.gnu.org/licenses/>.
-{-# LANGUAGE TemplateHaskell #-}
 
-module Polysemy.TinyLog where
+-- NOTE: This is an obsolete module. Instead, please use the more general
+-- Wire.Sem.Logger logging effect.
+module Polysemy.TinyLog
+  ( module Polysemy.TinyLog,
+    Logger (..),
+    trace,
+    debug,
+    info,
+    warn,
+    err,
+    fatal,
+  )
+where
 
-import Imports
-import Polysemy
-import System.Logger (Level (..))
 import qualified System.Logger as Log
+import Wire.Sem.Logger
 
-data TinyLog m a where
-  Polylog :: Log.Level -> (Log.Msg -> Log.Msg) -> TinyLog m ()
-
-makeSem ''TinyLog
-
-runTinyLog :: Member (Embed IO) r => Log.Logger -> Sem (TinyLog ': r) a -> Sem r a
-runTinyLog logger = interpret $ \(Polylog lvl msg) -> Log.log logger lvl msg
-
-discardLogs :: Sem (TinyLog ': r) a -> Sem r a
-discardLogs = interpret f
-  where
-    f :: Applicative n => TinyLog m x -> n x
-    f (Polylog _ _) = pure ()
-
--- | Abbreviation of 'log' using the corresponding log level.
-trace, debug, info, warn, err, fatal :: Member TinyLog r => (Log.Msg -> Log.Msg) -> Sem r ()
-trace = polylog Trace
-debug = polylog Debug
-info = polylog Info
-warn = polylog Warn
-err = polylog Error
-fatal = polylog Fatal
-{-# INLINE trace #-}
-{-# INLINE debug #-}
-{-# INLINE info #-}
-{-# INLINE warn #-}
-{-# INLINE err #-}
-{-# INLINE fatal #-}
+type TinyLog = Logger (Log.Msg -> Log.Msg)

services/spar/src/Spar/Sem/Logger.hs → libs/polysemy-wire-zoo/src/Wire/Sem/Logger.hs

@@ -17,45 +17,51 @@
 -- You should have received a copy of the GNU Affero General Public License along
 -- with this program. If not, see <https://www.gnu.org/licenses/>.
 
-module Spar.Sem.Logger
-  ( module Spar.Sem.Logger,
-    SAML.Level (..),
+module Wire.Sem.Logger
+  ( module Wire.Sem.Logger,
+    module Wire.Sem.Logger.Level,
   )
 where
 
 import Imports hiding (log)
 import Polysemy
-import qualified SAML2.WebSSO as SAML
+import Wire.Sem.Logger.Level
 
 data Logger msg m a where
-  Log :: SAML.Level -> msg -> Logger msg m ()
+  Log :: Level -> msg -> Logger msg m ()
 
 -- TODO(sandy): Inline this definition --- no TH
 makeSem ''Logger
 
-mapLogger ::
-  forall msg msg' r a.
-  Member (Logger msg') r =>
-  (msg -> msg') ->
-  Sem (Logger msg ': r) a ->
-  Sem r a
-mapLogger f = interpret $ \case
-  Log lvl msg -> log lvl $ f msg
-
 trace :: Member (Logger msg) r => msg -> Sem r ()
-trace = log SAML.Trace
+trace = log Trace
 
 debug :: Member (Logger msg) r => msg -> Sem r ()
-debug = log SAML.Debug
+debug = log Debug
 
 info :: Member (Logger msg) r => msg -> Sem r ()
-info = log SAML.Info
+info = log Info
 
 warn :: Member (Logger msg) r => msg -> Sem r ()
-warn = log SAML.Warn
+warn = log Warn
 
 err :: Member (Logger msg) r => msg -> Sem r ()
-err = log SAML.Error
+err = log Error
 
 fatal :: Member (Logger msg) r => msg -> Sem r ()
-fatal = log SAML.Fatal
+fatal = log Fatal
+
+--------------------------------------------------------------------------------
+-- General interpreters
+
+mapLogger ::
+  forall msg msg' r a.
+  Member (Logger msg') r =>
+  (msg -> msg') ->
+  Sem (Logger msg ': r) a ->
+  Sem r a
+mapLogger f = interpret $ \case
+  Log lvl msg -> log lvl $ f msg
+
+discardLogs :: Sem (Logger msg ': r) a -> Sem r a
+discardLogs = interpret $ \(Log _ _) -> pure ()

services/spar/src/Spar/Sem/Logger/TinyLog.hs → libs/polysemy-wire-zoo/src/Wire/Sem/Logger/Level.hs

@@ -15,24 +15,21 @@
 -- You should have received a copy of the GNU Affero General Public License along
 -- with this program. If not, see <https://www.gnu.org/licenses/>.
 
-module Spar.Sem.Logger.TinyLog (loggerToTinyLog, stringLoggerToTinyLog, toLevel, fromLevel) where
+module Wire.Sem.Logger.Level where
 
 import Imports
-import Polysemy
-import Spar.Sem.Logger (Level (..), Logger (..), mapLogger)
+import qualified SAML2.WebSSO as SAML
 import qualified System.Logger as Log
 
-loggerToTinyLog ::
-  Member (Embed IO) r =>
-  Log.Logger ->
-  Sem (Logger (Log.Msg -> Log.Msg) ': r) a ->
-  Sem r a
-loggerToTinyLog tinylog = interpret $ \case
-  Log lvl msg ->
-    embed @IO $ Log.log tinylog (toLevel lvl) msg
-
-stringLoggerToTinyLog :: Member (Logger (Log.Msg -> Log.Msg)) r => Sem (Logger String ': r) a -> Sem r a
-stringLoggerToTinyLog = mapLogger @String Log.msg
+-- | The logging level
+data Level
+  = Fatal
+  | Error
+  | Warn
+  | Info
+  | Debug
+  | Trace
+  deriving (Eq, Show)
 
 toLevel :: Level -> Log.Level
 toLevel = \case
@@ -51,3 +48,21 @@ fromLevel = \case
   Log.Info -> Info
   Log.Debug -> Debug
   Log.Trace -> Trace
+
+samlToLevel :: SAML.Level -> Log.Level
+samlToLevel = \case
+  SAML.Fatal -> Log.Fatal
+  SAML.Error -> Log.Error
+  SAML.Warn -> Log.Warn
+  SAML.Info -> Log.Info
+  SAML.Debug -> Log.Debug
+  SAML.Trace -> Log.Trace
+
+samlFromLevel :: SAML.Level -> Level
+samlFromLevel = \case
+  SAML.Fatal -> Fatal
+  SAML.Error -> Error
+  SAML.Warn -> Warn
+  SAML.Info -> Info
+  SAML.Debug -> Debug
+  SAML.Trace -> Trace

libs/polysemy-wire-zoo/src/Wire/Sem/Logger/TinyLog.hs

@@ -0,0 +1,60 @@
+-- This file is part of the Wire Server implementation.
+--
+-- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
+--
+-- This program is free software: you can redistribute it and/or modify it under
+-- the terms of the GNU Affero General Public License as published by the Free
+-- Software Foundation, either version 3 of the License, or (at your option) any
+-- later version.
+--
+-- This program is distributed in the hope that it will be useful, but WITHOUT
+-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
+-- details.
+--
+-- You should have received a copy of the GNU Affero General Public License along
+-- with this program. If not, see <https://www.gnu.org/licenses/>.
+
+module Wire.Sem.Logger.TinyLog
+  ( loggerToTinyLog,
+    loggerToTinyLogReqId,
+    stringLoggerToTinyLog,
+    discardTinyLogs,
+    module Wire.Sem.Logger.Level,
+  )
+where
+
+import Data.Id
+import Imports
+import Polysemy
+import qualified System.Logger as Log
+import Wire.Sem.Logger
+import Wire.Sem.Logger.Level
+
+loggerToTinyLog ::
+  Member (Embed IO) r =>
+  Log.Logger ->
+  Sem (Logger (Log.Msg -> Log.Msg) ': r) a ->
+  Sem r a
+loggerToTinyLog tinylog = interpret $ \case
+  Log lvl msg ->
+    embed @IO $ Log.log tinylog (toLevel lvl) msg
+
+-- | Log the request ID along with the message
+loggerToTinyLogReqId ::
+  Member (Embed IO) r =>
+  RequestId ->
+  Log.Logger ->
+  Sem (Logger (Log.Msg -> Log.Msg) ': r) a ->
+  Sem r a
+loggerToTinyLogReqId r tinylog =
+  loggerToTinyLog tinylog
+    . mapLogger
+      (Log.field "request" (unRequestId r) Log.~~)
+    . raise @(Logger (Log.Msg -> Log.Msg))
+
+stringLoggerToTinyLog :: Member (Logger (Log.Msg -> Log.Msg)) r => Sem (Logger String ': r) a -> Sem r a
+stringLoggerToTinyLog = mapLogger @String Log.msg
+
+discardTinyLogs :: Sem (Logger (Log.Msg -> Log.Msg) ': r) a -> Sem r a
+discardTinyLogs = discardLogs

services/brig/src/Brig/Calling.hs

@@ -63,6 +63,7 @@ import System.Random.MWC (GenIO, createSystemRandom)
 import System.Random.Shuffle
 import Wire.Network.DNS.Effect
 import Wire.Network.DNS.SRV
+import Wire.Sem.Logger.TinyLog
 
 -- | NOTE SFTServers:
 -- Retrieving SFTServers should give a 1) randomized and 2) limited list of servers.
@@ -162,7 +163,7 @@ mkSFTEnv opts =
 
 startSFTServiceDiscovery :: Log.Logger -> SFTEnv -> IO ()
 startSFTServiceDiscovery logger =
-  runM . runTinyLog logger . runDNSLookupDefault . sftDiscoveryLoop
+  runM . loggerToTinyLog logger . runDNSLookupDefault . sftDiscoveryLoop
 
 -- | >>> diffTimeToMicroseconds 1
 -- 1000000

services/brig/src/Brig/Calling/API.hs

@@ -56,11 +56,11 @@ import Network.Wai.Utilities hiding (code, message)
 import Network.Wai.Utilities.Swagger (document)
 import OpenSSL.EVP.Digest (Digest, hmacBS)
 import Polysemy
-import Polysemy.TinyLog
 import qualified System.Random.MWC as MWC
 import Wire.API.Call.Config (SFTServer)
 import qualified Wire.API.Call.Config as Public
 import Wire.Network.DNS.SRV (srvTarget)
+import Wire.Sem.Logger.TinyLog (loggerToTinyLog)
 
 routesPublic :: Routes Doc.ApiBuilder (Handler r) ()
 routesPublic = do
@@ -109,7 +109,7 @@ getCallsConfigV2 _ _ limit = do
   manager <- view httpManager
   liftIO
     . runM @IO
-    . runTinyLog logger
+    . loggerToTinyLog logger
     . interpretSFT manager
     $ newConfig env staticUrl sftEnv' limit sftListAllServers CallsConfigV2
 
@@ -125,7 +125,7 @@ getCallsConfig _ _ = do
   fmap dropTransport
     . liftIO
     . runM @IO
-    . runTinyLog logger
+    . loggerToTinyLog logger
     . interpretSFT manager
     $ newConfig env Nothing Nothing Nothing HideAllSFTServers CallsConfigDeprecated
   where