Json logging

libs/extended/package.yaml

@@ -17,6 +17,7 @@ dependencies:
 - base
 - bytestring
 - extra
+- aeson
 - imports
 - optparse-applicative
 - tinylog
@@ -34,6 +35,7 @@ dependencies:
 - servant-swagger
 - string-conversions
 - transformers
+- text
 - wai
 library:
   source-dirs: src

libs/extended/src/System/Logger/Extended.hs

@@ -1,32 +1,86 @@
+{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE DerivingStrategies         #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
 -- | Tinylog convenience things.
 module System.Logger.Extended
     ( module Log
+    , LogFormat(..)
     , mkLogger
     , mkLogger'
     , LoggerT(..)
     , runWithLogger
+    , netStringsToLogFormat
     ) where
 
-import Imports
 import Control.Monad.Catch
+import Data.Aeson
+import Data.Aeson.Encoding (pair, list, text)
 import Database.CQL.IO
+import GHC.Generics
+import Imports
 import System.Logger as Log
-
-import qualified Data.ByteString.Lazy.Char8 as L
+import Data.String.Conversions (cs)
 import qualified Data.ByteString.Lazy.Builder as B
+import qualified Data.ByteString.Lazy.Char8 as L
 import qualified System.Logger.Class as LC
 
--- TODO(arianvp): Get rid of boolean blindness
--- TODO(arianvp): Add JSON log format. This will make our lives a lot easier
---    This will add a dependency on aeson for this package,
---    but it already transitively depended on it through imports.
---    Interestingly, the only place where imports uses Aeson
---    is in the Orphans module which defines Aeson Orphans instances for Log.Level.
---    So while we're at it, we should probably move those orphans here.
-mkLogger :: Log.Level -> Bool -> IO Log.Logger
-mkLogger lvl netstr = Log.new
+
+deriving instance Generic LC.Level
+instance FromJSON LC.Level
+instance ToJSON LC.Level
+
+-- | The log formats supported
+data LogFormat = JSON | Plain | Netstring 
+  deriving stock (Eq, Show, Generic)
+  deriving anyclass (ToJSON, FromJSON) -- TODO write this instance manually?
+
+-- | We use this as an intermediate structure to ease the implementation of the
+-- ToJSON instance but we could just inline everything. I think this has
+-- negligible impact and makes the code a bit more readable. Let me know
+data Element' = Element' Series [Builder]
+
+elementToEncoding :: Element' -> Encoding
+elementToEncoding (Element' fields msgs) = pairs $ fields <> msgsToSeries msgs
+    where
+      msgsToSeries :: [Builder] -> Series
+      msgsToSeries  = pair "msgs" . list (text . cs . eval)
+
+collect :: [Element] -> Element'
+collect = foldr go (Element' mempty [])
+  where
+    go :: Element -> Element' -> Element'
+    go (Bytes b) (Element' f m) =
+      Element' f (b : m)
+    go (Field k v) (Element' f m) = 
+      Element' (f <> pair (cs . eval $ k) (text . cs . eval $ v)) m
+
+jsonRenderer :: Renderer
+jsonRenderer _sep _dateFormat _logLevel = fromEncoding  . elementToEncoding . collect
+
+-- | Here for backwards-compatibility reasons
+netStringsToLogFormat :: Bool -> LogFormat
+netStringsToLogFormat True = Netstring
+netStringsToLogFormat False = Plain
+
+-- | Creates a logger given a log format Also takes an useNetstrings argument
+-- which is there because we cannot immediatelly deprecate the old interface.
+-- Old configs only provide the useNetstrings argument and not the logFormat
+-- argument, and in that case implement the old behaviour of either enabling
+-- plain text logging or netstring logging.  If both arguments are set,
+-- logFormat takes presedence over useNetstrings
+--
+-- TODO: Once we get rid of the useNetstrings in our config files, we can
+-- change the type of mkLogger to  mkLogger :: Log.Level -> LogFormat -> IO
+-- Log.Logger
+mkLogger :: Log.Level -> Maybe (Last Bool) -> Maybe (Last LogFormat) -> IO  Log.Logger
+mkLogger lvl useNetstrings logFormat = do
+  mkLogger'' lvl $
+    case (fmap netStringsToLogFormat <$> useNetstrings) <> logFormat of
+      Just x -> getLast x
+      Nothing -> Plain
+
+mkLogger'' :: Log.Level -> LogFormat -> IO Log.Logger
+mkLogger'' lvl netstr = Log.new
     . Log.setReadEnvironment False
     . Log.setOutput Log.StdOut
     . Log.setFormat Nothing
@@ -40,15 +94,16 @@ mkLogger lvl netstr = Log.new
 --
 --   * use 'canonicalizeWhitespace'.
 --
-simpleSettings :: Log.Level -> Bool -> Log.Settings
+simpleSettings :: Log.Level -> LogFormat -> Log.Settings
 simpleSettings lvl netstr
   = Log.setLogLevel lvl
   . Log.setRenderer (canonicalizeWhitespace rndr)
   $ Log.defSettings
   where
     rndr = case netstr of
-      True  -> \_separator _dateFormat _level -> Log.renderNetstr
-      False -> \ separator _dateFormat _level -> Log.renderDefault separator
+      Netstring  -> \_separator _dateFormat _level -> Log.renderNetstr
+      Plain -> \ separator _dateFormat _level -> Log.renderDefault separator
+      JSON -> jsonRenderer
 
 -- | Replace all whitespace characters in the output of a renderer by @' '@.
 -- Log output must be ASCII encoding.

libs/imports/src/Imports.hs

@@ -71,8 +71,6 @@ module Imports
     , unlessM
     ) where
 
-import Orphans ()
-
 -- Explicitly saying what to import because some things from Prelude clash
 -- with e.g. UnliftIO modules
 import Prelude (
@@ -100,8 +98,8 @@ import Data.Void
 import Data.Bool
 import Data.Char
 import Data.Ord
-import Data.Semigroup (Semigroup)
-import Data.Monoid
+import Data.Semigroup hiding (diff, Option, option) -- conflicts with Options.Applicative.Option (should we care?)
+import Data.Monoid hiding (First(..), Last(..)) -- First and Last are going to be deprecated. Use Semigroup instead
 import Data.Maybe
 import Data.Either
 import Data.Foldable

services/brig/src/Brig/App.hs

@@ -155,7 +155,7 @@ newEnv o = do
     Just sha256 <- getDigestByName "SHA256"
     Just sha512 <- getDigestByName "SHA512"
     mtr <- Metrics.metrics
-    lgr <- Log.mkLogger (Opt.logLevel o) (Opt.logNetStrings o)
+    lgr <- Log.mkLogger (Opt.logLevel o) (Opt.logNetStrings o) (Opt.logFormat o)
     cas <- initCassandra o lgr
     mgr <- initHttpManager
     ext <- initExtGetManager

services/brig/src/Brig/Options.hs

@@ -17,7 +17,7 @@ import Data.Scientific (toBoundedInteger)
 import Data.Time.Clock (NominalDiffTime)
 import Data.Yaml (FromJSON(..), ToJSON(..))
 import Util.Options
-import System.Logger.Class (Level)
+import System.Logger.Extended (Level, LogFormat)
 
 import qualified Brig.ZAuth  as ZAuth
 import qualified Data.Yaml   as Y
@@ -257,9 +257,9 @@ data Opts = Opts
 
     -- Logging
     , logLevel      :: !Level                  -- ^ Log level (Debug, Info, etc)
-    , logNetStrings :: !Bool                   -- ^ Use netstrings encoding (see
+    , logNetStrings :: !(Maybe (Last Bool))    -- ^ Use netstrings encoding (see
                                                --   <http://cr.yp.to/proto/netstrings.txt>)
-
+    , logFormat     :: !(Maybe (Last LogFormat)) -- ^ Logformat to use
     -- TURN
     , turn          :: !TurnOpts               -- ^ TURN server settings
 

services/cannon/src/Cannon/Options.hs

@@ -10,14 +10,15 @@ module Cannon.Options
     , externalHostFile
     , logLevel
     , logNetStrings
+    , logFormat
     , Opts
     )
 where
 
 import Imports
 import Control.Lens (makeFields)
 import Data.Aeson.APIFieldJsonTH
-import System.Logger.Class (Level)
+import System.Logger.Extended (Level, LogFormat)
 
 
 data Cannon = Cannon
@@ -42,7 +43,8 @@ data Opts = Opts
     { _optsCannon         :: !Cannon
     , _optsGundeck        :: !Gundeck
     , _optsLogLevel       :: !Level
-    , _optsLogNetStrings  :: !Bool
+    , _optsLogNetStrings  :: !(Maybe (Last Bool))
+    , _optsLogFormat      :: !(Maybe (Last LogFormat))
     } deriving (Eq, Show, Generic)
 
 makeFields ''Opts

services/cannon/src/Cannon/Run.hs

@@ -28,7 +28,7 @@ run :: Opts -> IO ()
 run o = do
     ext <- loadExternal
     m <- Middleware.metrics
-    g <- L.mkLogger (o ^. logLevel) (o ^. logNetStrings)
+    g <- L.mkLogger (o ^. logLevel) (o ^. logNetStrings) (o ^. logFormat)
     e <- mkEnv <$> pure m
                <*> pure ext
                <*> pure o

services/cargohold/src/CargoHold/App.hs

@@ -84,7 +84,7 @@ makeLenses ''Env
 newEnv :: Opts -> IO Env
 newEnv o = do
     met  <- Metrics.metrics
-    lgr  <- Log.mkLogger (o^.optLogLevel) (o^.optLogNetStrings)
+    lgr  <- Log.mkLogger (o^.optLogLevel) (o^.optLogNetStrings) (o^.optLogFormat)
     mgr  <- initHttpManager
     awe  <- initAws o lgr mgr
     return $ Env awe met lgr mgr def (o^.optSettings)

services/cargohold/src/CargoHold/Options.hs

@@ -6,7 +6,7 @@ import Imports
 import CargoHold.CloudFront (Domain (..), KeyPairId (..))
 import Control.Lens hiding (Level)
 import Data.Aeson.TH
-import System.Logger (Level)
+import System.Logger.Extended (Level, LogFormat)
 import Util.Options
 import Util.Options.Common
 
@@ -62,8 +62,9 @@ data Opts = Opts
     , _optSettings  :: !Settings
     -- Logging
     , _optLogLevel      :: !Level  -- ^ Log level (Debug, Info, etc)
-    , _optLogNetStrings :: !Bool   -- ^ Use netstrings encoding:
-                                   --   <http://cr.yp.to/proto/netstrings.txt>
+    , _optLogNetStrings :: !(Maybe (Last Bool))   -- ^ Use netstrings encoding:
+                                                  --   <http://cr.yp.to/proto/netstrings.txt>
+    , _optLogFormat :: !(Maybe (Last LogFormat))  --- ^ Log format
     } deriving (Show, Generic)
 
 deriveFromJSON toOptionFieldName ''Opts

services/galley/galley.integration.yaml

@@ -27,8 +27,8 @@ settings:
   intraListing: false
   conversationCodeURI: https://app.wire.com/join/
 
-logLevel: Info
-logNetStrings: false
+logLevel: Debug
+logFormat: JSON
 
 journal: # if set, journals; if not set, disables journaling
   queueName: integration-team-events.fifo

services/galley/src/Galley/App.hs

@@ -128,7 +128,7 @@ instance HasRequestId Galley where
 
 createEnv :: Metrics -> Opts -> IO Env
 createEnv m o = do
-    l   <- Logger.mkLogger (o ^. optLogLevel) (o ^. optLogNetStrings)
+    l   <- Logger.mkLogger (o ^. optLogLevel) (o ^. optLogNetStrings) (o ^. optLogFormat)
     mgr <- initHttpManager o
     Env def m o l mgr <$> initCassandra o l
                       <*> Q.new 16000

services/galley/src/Galley/Options.hs

@@ -5,7 +5,7 @@ import Control.Lens hiding ((.=), Level)
 import Data.Aeson.TH (deriveFromJSON)
 import Util.Options
 import Util.Options.Common
-import System.Logger.Class (Level)
+import System.Logger.Extended (Level, LogFormat)
 import Data.Misc
 
 data Settings = Settings
@@ -45,8 +45,9 @@ data Opts = Opts
                                              --   disables journaling)
     -- Logging
     , _optLogLevel      :: !Level            -- ^ Log level (Debug, Info, etc)
-    , _optLogNetStrings :: !Bool             -- ^ Use netstrings encoding:
-                                             --   <http://cr.yp.to/proto/netstrings.txt>
+    , _optLogNetStrings :: !(Maybe (Last Bool))             -- ^ Use netstrings encoding
+                                                            --  <http://cr.yp.to/proto/netstrings.txt>
+    , _optLogFormat     :: !(Maybe (Last LogFormat)) -- ^ What log format to use
     }
 
 deriveFromJSON toOptionFieldName ''Opts

services/gundeck/src/Gundeck/Env.hs

@@ -41,7 +41,7 @@ schemaVersion = 7
 
 createEnv :: Metrics -> Opts -> IO Env
 createEnv m o = do
-    l <- Logger.mkLogger (o ^. optLogLevel) (o ^. optLogNetStrings)
+    l <- Logger.mkLogger (o ^. optLogLevel) (o ^. optLogNetStrings) (o ^. optLogFormat)
     c <- maybe (C.initialContactsPlain (o^.optCassandra.casEndpoint.epHost))
                (C.initialContactsDisco "cassandra_gundeck")
                (unpack <$> o^.optDiscoUrl)

services/gundeck/src/Gundeck/Options.hs

@@ -7,7 +7,7 @@ import Control.Lens hiding (Level)
 import Data.Aeson.TH
 import Data.Yaml (FromJSON)
 import Gundeck.Aws.Arn
-import System.Logger (Level)
+import System.Logger.Extended (Level, LogFormat)
 import Util.Options
 import Util.Options.Common
 
@@ -50,8 +50,9 @@ data Opts = Opts
     , _optSettings  :: !Settings
     -- Logging
     , _optLogLevel      :: !Level       -- ^ Log level (Debug, Info, etc)
-    , _optLogNetStrings :: !Bool        -- ^ Use netstrings encoding:
+    , _optLogNetStrings :: !(Maybe (Last Bool))        -- ^ Use netstrings encoding:
                                         --   <http://cr.yp.to/proto/netstrings.txt>
+    , _optLogFormat :: !(Maybe (Last LogFormat))
     } deriving (Show, Generic)
 
 deriveFromJSON toOptionFieldName ''Opts

services/proxy/src/Proxy/Env.hs

@@ -37,7 +37,7 @@ makeLenses ''Env
 
 createEnv :: Metrics -> Opts -> IO Env
 createEnv m o = do
-    g <- Logger.mkLogger (o^.logLevel) (o^.logNetStrings)
+    g <- Logger.mkLogger (o^.logLevel) (o^.logNetStrings) (o^.logFormat)
     n <- newManager tlsManagerSettings
             { managerConnCount           = o^.httpPoolSize
             , managerIdleConnectionCount = 3 * (o^.httpPoolSize)

services/proxy/src/Proxy/Options.hs

@@ -7,14 +7,15 @@ module Proxy.Options
     , maxConns
     , logLevel
     , logNetStrings
+    , logFormat
     , mockOpts
     ) where
 
 import Imports
 import Control.Lens hiding (Level)
 import Data.Aeson
 import Data.Aeson.TH
-import System.Logger.Class (Level(Debug))
+import System.Logger.Extended (Level(Debug), LogFormat)
 
 data Opts = Opts
     { _host          :: !String     -- ^ Host to listen on
@@ -24,8 +25,8 @@ data Opts = Opts
     , _maxConns      :: !Int        -- ^ Maximum number of incoming connections
     -- Logging
     , _logLevel      :: !Level       -- ^ Log level (Debug, Info, etc)
-    , _logNetStrings :: !Bool        -- ^ Use netstrings encoding (see
-                                     --   <http://cr.yp.to/proto/netstrings.txt>)
+    , _logNetStrings :: !(Maybe (Last Bool)) -- ^ Use netstrings encoding
+    , _logFormat     :: !(Maybe (Last LogFormat))-- ^ choose Encoding
     } deriving (Show, Generic)
 
 makeLenses ''Opts
@@ -41,5 +42,6 @@ mockOpts secrets = Opts
     , _httpPoolSize  = 0
     , _maxConns      = 0
     , _logLevel      = Debug
-    , _logNetStrings = True
+    , _logNetStrings = pure $ pure $ True
+    , _logFormat     = mempty
     }

services/spar/src/Spar/Run.hs

@@ -83,7 +83,7 @@ runServer sparCtxOpts = do
 mkApp :: Opts -> IO (Application, Env)
 mkApp sparCtxOpts = do
   let logLevel = toLevel $ saml sparCtxOpts ^. SAML.cfgLogLevel
-  sparCtxLogger <- Log.mkLogger logLevel (logNetStrings sparCtxOpts)
+  sparCtxLogger <- Log.mkLogger logLevel (logNetStrings sparCtxOpts) (logFormat sparCtxOpts)
   sparCtxCas <- initCassandra sparCtxOpts sparCtxLogger
   sparCtxHttpManager <- newManager defaultManagerSettings
   let sparCtxHttpBrig =