From 85f131537b1e0d98fbb35b6c9dd93932313be204 Mon Sep 17 00:00:00 2001 From: Arian van Putten Date: Wed, 7 Aug 2019 17:15:48 +0200 Subject: [PATCH 01/11] Add logs for team operations Will log as soon as possible in the operation. Whether the operation actually failed or not should be deduced from other sources. --- services/galley/src/Galley/API/Teams.hs | 24 +++++++++++++++++++----- 1 file changed, 19 insertions(+), 5 deletions(-) diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index d8a6f19c9b7..de3f12361c7 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -71,6 +71,7 @@ import qualified Galley.Types as Conv import qualified Galley.Types.Teams as Teams import qualified Galley.Intra.Journal as Journal import qualified Galley.Intra.Spar as Spar +import qualified System.Logger.Class as Log getTeam :: UserId ::: TeamId ::: JSON -> Galley Response getTeam (zusr::: tid ::: _) = @@ -112,6 +113,8 @@ createNonBindingTeam (zusr::: zcon ::: req ::: _) = do let zothers = map (view userId) others ensureUnboundUsers (zusr : zothers) ensureConnected zusr zothers + Log.debug $ Log.field "targets" (toByteString (show zothers)) + . Log.msg (Log.val "createNonBindingTeam") team <- Data.createTeam Nothing zusr (body^.newTeamName) (body^.newTeamIcon) (body^.newTeamIconKey) NonBinding finishCreateTeam team owner others (Just zcon) @@ -149,6 +152,8 @@ updateTeam :: UserId ::: ConnId ::: TeamId ::: JsonRequest TeamUpdateData ::: JS updateTeam (zusr::: zcon ::: tid ::: req ::: _) = do body <- fromJsonBody req membs <- Data.teamMembers tid + Log.debug $ Log.field "targets" (toByteString (show membs)) + . Log.msg (Log.val "updateTeam") void $ permissionCheck zusr SetTeamData membs Data.updateTeam tid body now <- liftIO getCurrentTime @@ -243,16 +248,17 @@ uncheckedGetTeamMembers (tid ::: _) = do addTeamMember :: UserId ::: ConnId ::: TeamId ::: JsonRequest NewTeamMember ::: JSON -> Galley Response addTeamMember (zusr ::: zcon ::: tid ::: req ::: _) = do nmem <- fromJsonBody req + let uid = nmem^.ntmNewTeamMember.userId + Log.debug $ Log.field "target" (toByteString uid) + . Log.msg (Log.val "addTeamMember") mems <- Data.teamMembers tid - -- verify permissions tmem <- permissionCheck zusr AddTeamMember mems let targetPermissions = nmem^.ntmNewTeamMember.permissions targetPermissions `ensureNotElevated` tmem - ensureNonBindingTeam tid - ensureUnboundUsers [nmem^.ntmNewTeamMember.userId] - ensureConnected zusr [nmem^.ntmNewTeamMember.userId] + ensureUnboundUsers [uid] + ensureConnected zusr [uid] addTeamMemberInternal tid (Just zusr) (Just zcon) nmem mems -- This function is "unchecked" because there is no need to check for user binding (invite only). @@ -272,6 +278,9 @@ updateTeamMember (zusr ::: zcon ::: tid ::: req ::: _) = do let targetId = targetMember^.userId targetPermissions = targetMember^.permissions + Log.debug $ Log.field "target" (toByteString targetId) + . Log.msg (Log.val "updateTeamMember") + -- get the team and verify permissions team <- tdTeam <$> (Data.team tid >>= ifNothing teamNotFound) members <- Data.teamMembers tid @@ -305,6 +314,7 @@ updateTeamMember (zusr ::: zcon ::: tid ::: req ::: _) = do privilegedUpdate = mkUpdate $ Just targetPermissions privilegedRecipients = membersToRecipients Nothing privileged + now <- liftIO getCurrentTime let ePriv = newEvent MemberUpdate tid now & eventData ?~ privilegedUpdate @@ -315,6 +325,8 @@ updateTeamMember (zusr ::: zcon ::: tid ::: req ::: _) = do deleteTeamMember :: UserId ::: ConnId ::: TeamId ::: UserId ::: Request ::: Maybe JSON ::: JSON -> Galley Response deleteTeamMember (zusr::: zcon ::: tid ::: remove ::: req ::: _ ::: _) = do + Log.debug $ Log.field "target" (toByteString remove) + . Log.msg (Log.val "deleteTeamMember") mems <- Data.teamMembers tid void $ permissionCheck zusr RemoveTeamMember mems okToDelete <- canBeDeleted [] remove tid @@ -447,10 +459,12 @@ ensureNotElevated targetPermissions member = addTeamMemberInternal :: TeamId -> Maybe UserId -> Maybe ConnId -> NewTeamMember -> [TeamMember] -> Galley Response addTeamMemberInternal tid origin originConn newMem mems = do + let new = newMem^.ntmNewTeamMember + Log.debug $ Log.field "target" (toByteString (new^.userId)) + . Log.msg (Log.val "addTeamMemberInternal") o <- view options unless (length mems < fromIntegral (o^.optSettings.setMaxTeamSize)) $ throwM tooManyTeamMembers - let new = newMem^.ntmNewTeamMember Data.addTeamMember tid new cc <- filter (view managedConversation) <$> Data.teamConversations tid now <- liftIO getCurrentTime From cc6c0ef63a61274bca48ddb750a30581e1da9a3f Mon Sep 17 00:00:00 2001 From: Arian van Putten Date: Tue, 13 Aug 2019 11:08:27 +0200 Subject: [PATCH 02/11] Add logging for legalhold --- services/galley/src/Galley/API/LegalHold.hs | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) diff --git a/services/galley/src/Galley/API/LegalHold.hs b/services/galley/src/Galley/API/LegalHold.hs index d570a66fd2f..36d9728bb80 100644 --- a/services/galley/src/Galley/API/LegalHold.hs +++ b/services/galley/src/Galley/API/LegalHold.hs @@ -8,7 +8,7 @@ import Brig.Types.Client.Prekey import Control.Monad.Catch import Control.Lens (view, (^.)) import Data.Id -import Data.ByteString.Conversion (toByteString') +import Data.ByteString.Conversion (toByteString', toByteString) import Data.Misc import Data.LegalHold (UserLegalHoldStatus(..)) import Galley.API.Util @@ -42,6 +42,9 @@ createSettings (zusr ::: tid ::: req ::: _) = do assertLegalHoldEnabled tid membs <- Data.teamMembers tid + Log.debug $ Log.field "targets" (toByteString (show membs)) + . Log.msg (Log.val "LegalHold.createSettings") + void $ permissionCheck zusr ChangeLegalHoldTeamSettings membs newService :: NewLegalHoldService @@ -71,8 +74,10 @@ getSettings (zusr ::: tid ::: _) = do removeSettings :: UserId ::: TeamId ::: JsonRequest RemoveLegalHoldSettingsRequest ::: JSON -> Galley Response removeSettings (zusr ::: tid ::: req ::: _) = do assertLegalHoldEnabled tid - membs <- Data.teamMembers tid + Log.debug $ Log.field "targets" (toByteString (show membs)) + . Log.msg (Log.val "LegalHold.removeSettings") + void $ permissionCheck zusr ChangeLegalHoldTeamSettings membs RemoveLegalHoldSettingsRequest mPassword <- fromJsonBody req ensureReAuthorised zusr mPassword @@ -87,6 +92,9 @@ removeSettings' -> Galley () removeSettings' tid mMembers = do membs <- maybe (Data.teamMembers tid) pure mMembers + Log.debug $ Log.field "targets" (toByteString (show membs)) + . Log.msg (Log.val "LegalHold.removeSettings'") + let lhMembers = filter ((== UserLegalHoldEnabled) . view legalHoldStatus) membs -- I picked this number by fair dice roll, feel free to change it :P pooledMapConcurrentlyN_ 6 removeLHForUser lhMembers @@ -129,6 +137,8 @@ requestDevice :: UserId ::: TeamId ::: UserId ::: JSON -> Galley Response requestDevice (zusr ::: tid ::: uid ::: _) = do assertLegalHoldEnabled tid + Log.debug $ Log.field "target" (toByteString uid) + . Log.msg (Log.val "LegalHold.requestDevice") membs <- Data.teamMembers tid void $ permissionCheck zusr ChangeLegalHoldUserSettings membs @@ -164,6 +174,8 @@ approveDevice -> Galley Response approveDevice (zusr ::: tid ::: uid ::: connId ::: req ::: _) = do assertLegalHoldEnabled tid + Log.debug $ Log.field "target" (toByteString uid) + . Log.msg (Log.val "LegalHold.approveDevice") unless (zusr == uid) (throwM accessDenied) assertOnTeam uid tid @@ -199,6 +211,8 @@ disableForUser :: UserId ::: TeamId ::: UserId ::: JsonRequest DisableLegalHoldForUserRequest ::: JSON -> Galley Response disableForUser (zusr ::: tid ::: uid ::: req ::: _) = do + Log.debug $ Log.field "target" (toByteString uid) + . Log.msg (Log.val "LegalHold.disableForUser") membs <- Data.teamMembers tid void $ permissionCheck zusr ChangeLegalHoldUserSettings membs if userLHNotDisabled membs From 3887f7032c0958c37f8bebd0fc7b7445299cda48 Mon Sep 17 00:00:00 2001 From: Arian van Putten Date: Tue, 13 Aug 2019 18:12:38 +0200 Subject: [PATCH 03/11] Remove superfleous maybe. There is no codepath where the argument to simpleSettings is not isJust. Also use qualified imports. bit more pretty --- libs/extended/src/System/Logger/Extended.hs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/libs/extended/src/System/Logger/Extended.hs b/libs/extended/src/System/Logger/Extended.hs index b9ed9144628..93615722f10 100644 --- a/libs/extended/src/System/Logger/Extended.hs +++ b/libs/extended/src/System/Logger/Extended.hs @@ -23,7 +23,7 @@ mkLogger lvl netstr = Log.new . Log.setReadEnvironment False . Log.setOutput Log.StdOut . Log.setFormat Nothing - $ simpleSettings (Just lvl) (Just netstr) + $ simpleSettings lvl netstr -- | Variant of Log.defSettings: -- @@ -33,15 +33,15 @@ mkLogger lvl netstr = Log.new -- -- * use 'canonicalizeWhitespace'. -- -simpleSettings :: Maybe Level -> Maybe Bool -> Log.Settings +simpleSettings :: Log.Level -> Bool -> Log.Settings simpleSettings lvl netstr - = maybe id setLogLevel lvl - . setRenderer (canonicalizeWhitespace rndr) + = Log.setLogLevel lvl + . Log.setRenderer (canonicalizeWhitespace rndr) $ Log.defSettings where rndr = case netstr of - Just True -> \_ _ _ -> renderNetstr - _ -> \s _ _ -> renderDefault s + True -> \_ _ _ -> Log.renderNetstr + False -> \s _ _ -> Log.renderDefault s -- | Replace all whitespace characters in the output of a renderer by @' '@. -- Log output must be ASCII encoding. @@ -50,7 +50,7 @@ simpleSettings lvl netstr -- places and situations in your code and your dependencies that inject newlines -- into your log messages, you can choose to call 'canonicalizeWhitespace' on -- your renderer.) -canonicalizeWhitespace :: Renderer -> Renderer +canonicalizeWhitespace :: Log.Renderer -> Log.Renderer canonicalizeWhitespace rndrRaw delim df lvl = B.lazyByteString . nl2sp . B.toLazyByteString . rndrRaw delim df lvl where From 939daa44aed0d4e59f645c2bffec98f89f0d1375 Mon Sep 17 00:00:00 2001 From: Arian van Putten Date: Tue, 13 Aug 2019 18:28:42 +0200 Subject: [PATCH 04/11] Make clear waht is being ignored by our renderer e.g. we're not logging the log level --- libs/extended/src/System/Logger/Extended.hs | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/libs/extended/src/System/Logger/Extended.hs b/libs/extended/src/System/Logger/Extended.hs index 93615722f10..90722df0224 100644 --- a/libs/extended/src/System/Logger/Extended.hs +++ b/libs/extended/src/System/Logger/Extended.hs @@ -18,6 +18,11 @@ import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.ByteString.Lazy.Builder as B import qualified System.Logger.Class as LC +data Renderer + = JSON + | Netstring + | Default + mkLogger :: Log.Level -> Bool -> IO Log.Logger mkLogger lvl netstr = Log.new . Log.setReadEnvironment False @@ -40,8 +45,8 @@ simpleSettings lvl netstr $ Log.defSettings where rndr = case netstr of - True -> \_ _ _ -> Log.renderNetstr - False -> \s _ _ -> Log.renderDefault s + True -> \_separator _dateFormat _level -> Log.renderNetstr + False -> \ separator _dateFormat _level -> Log.renderDefault separator -- | Replace all whitespace characters in the output of a renderer by @' '@. -- Log output must be ASCII encoding. From 32ec4458070889c5c7b03099b75cbc7010521b43 Mon Sep 17 00:00:00 2001 From: Arian van Putten Date: Tue, 13 Aug 2019 18:32:34 +0200 Subject: [PATCH 05/11] Add TODOs --- libs/extended/src/System/Logger/Extended.hs | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/libs/extended/src/System/Logger/Extended.hs b/libs/extended/src/System/Logger/Extended.hs index 90722df0224..21cf8928483 100644 --- a/libs/extended/src/System/Logger/Extended.hs +++ b/libs/extended/src/System/Logger/Extended.hs @@ -18,11 +18,13 @@ import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.ByteString.Lazy.Builder as B import qualified System.Logger.Class as LC -data Renderer - = JSON - | Netstring - | Default - +-- 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 . Log.setReadEnvironment False From 4debcf1b96219b1e8e8ff6e2d38ab3e9f8f9bca3 Mon Sep 17 00:00:00 2001 From: Arian van Putten Date: Thu, 22 Aug 2019 14:26:55 +0200 Subject: [PATCH 06/11] Namespace the debug log messages and print member ids instead of members --- services/galley/src/Galley/API/LegalHold.hs | 16 ++++++++------ services/galley/src/Galley/API/Teams.hs | 23 +++++++++++---------- 2 files changed, 22 insertions(+), 17 deletions(-) diff --git a/services/galley/src/Galley/API/LegalHold.hs b/services/galley/src/Galley/API/LegalHold.hs index 36d9728bb80..56945e54088 100644 --- a/services/galley/src/Galley/API/LegalHold.hs +++ b/services/galley/src/Galley/API/LegalHold.hs @@ -42,7 +42,8 @@ createSettings (zusr ::: tid ::: req ::: _) = do assertLegalHoldEnabled tid membs <- Data.teamMembers tid - Log.debug $ Log.field "targets" (toByteString (show membs)) + let zothers = map (view userId) membs + Log.debug $ Log.field "targets" (toByteString (show zothers)) . Log.msg (Log.val "LegalHold.createSettings") void $ permissionCheck zusr ChangeLegalHoldTeamSettings membs @@ -75,7 +76,9 @@ removeSettings :: UserId ::: TeamId ::: JsonRequest RemoveLegalHoldSettingsReque removeSettings (zusr ::: tid ::: req ::: _) = do assertLegalHoldEnabled tid membs <- Data.teamMembers tid - Log.debug $ Log.field "targets" (toByteString (show membs)) + let zothers = map (view userId) membs + -- TODO user id's of members + Log.debug $ Log.field "targets" (toByteString (show zothers)) . Log.msg (Log.val "LegalHold.removeSettings") void $ permissionCheck zusr ChangeLegalHoldTeamSettings membs @@ -92,7 +95,8 @@ removeSettings' -> Galley () removeSettings' tid mMembers = do membs <- maybe (Data.teamMembers tid) pure mMembers - Log.debug $ Log.field "targets" (toByteString (show membs)) + let zothers = map (view userId) membs + Log.debug $ Log.field "targets" (toByteString (show zothers)) . Log.msg (Log.val "LegalHold.removeSettings'") let lhMembers = filter ((== UserLegalHoldEnabled) . view legalHoldStatus) membs @@ -137,7 +141,7 @@ requestDevice :: UserId ::: TeamId ::: UserId ::: JSON -> Galley Response requestDevice (zusr ::: tid ::: uid ::: _) = do assertLegalHoldEnabled tid - Log.debug $ Log.field "target" (toByteString uid) + Log.debug $ Log.field "targets" (toByteString uid) . Log.msg (Log.val "LegalHold.requestDevice") membs <- Data.teamMembers tid void $ permissionCheck zusr ChangeLegalHoldUserSettings membs @@ -174,7 +178,7 @@ approveDevice -> Galley Response approveDevice (zusr ::: tid ::: uid ::: connId ::: req ::: _) = do assertLegalHoldEnabled tid - Log.debug $ Log.field "target" (toByteString uid) + Log.debug $ Log.field "targets" (toByteString uid) . Log.msg (Log.val "LegalHold.approveDevice") unless (zusr == uid) (throwM accessDenied) @@ -211,7 +215,7 @@ disableForUser :: UserId ::: TeamId ::: UserId ::: JsonRequest DisableLegalHoldForUserRequest ::: JSON -> Galley Response disableForUser (zusr ::: tid ::: uid ::: req ::: _) = do - Log.debug $ Log.field "target" (toByteString uid) + Log.debug $ Log.field "targets" (toByteString uid) . Log.msg (Log.val "LegalHold.disableForUser") membs <- Data.teamMembers tid void $ permissionCheck zusr ChangeLegalHoldUserSettings membs diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index de3f12361c7..73db8bbd1c0 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -114,7 +114,7 @@ createNonBindingTeam (zusr::: zcon ::: req ::: _) = do ensureUnboundUsers (zusr : zothers) ensureConnected zusr zothers Log.debug $ Log.field "targets" (toByteString (show zothers)) - . Log.msg (Log.val "createNonBindingTeam") + . Log.msg (Log.val "Teams.createNonBindingTeam") team <- Data.createTeam Nothing zusr (body^.newTeamName) (body^.newTeamIcon) (body^.newTeamIconKey) NonBinding finishCreateTeam team owner others (Just zcon) @@ -152,8 +152,9 @@ updateTeam :: UserId ::: ConnId ::: TeamId ::: JsonRequest TeamUpdateData ::: JS updateTeam (zusr::: zcon ::: tid ::: req ::: _) = do body <- fromJsonBody req membs <- Data.teamMembers tid - Log.debug $ Log.field "targets" (toByteString (show membs)) - . Log.msg (Log.val "updateTeam") + let zothers = map (view userId) membs + Log.debug $ Log.field "targets" (toByteString (show zothers)) + . Log.msg (Log.val "Teams.updateTeam") void $ permissionCheck zusr SetTeamData membs Data.updateTeam tid body now <- liftIO getCurrentTime @@ -249,8 +250,8 @@ addTeamMember :: UserId ::: ConnId ::: TeamId ::: JsonRequest NewTeamMember ::: addTeamMember (zusr ::: zcon ::: tid ::: req ::: _) = do nmem <- fromJsonBody req let uid = nmem^.ntmNewTeamMember.userId - Log.debug $ Log.field "target" (toByteString uid) - . Log.msg (Log.val "addTeamMember") + Log.debug $ Log.field "targets" (toByteString uid) + . Log.msg (Log.val "Teams.addTeamMember") mems <- Data.teamMembers tid -- verify permissions tmem <- permissionCheck zusr AddTeamMember mems @@ -278,8 +279,8 @@ updateTeamMember (zusr ::: zcon ::: tid ::: req ::: _) = do let targetId = targetMember^.userId targetPermissions = targetMember^.permissions - Log.debug $ Log.field "target" (toByteString targetId) - . Log.msg (Log.val "updateTeamMember") + Log.debug $ Log.field "targets" (toByteString targetId) + . Log.msg (Log.val "Teams.updateTeamMember") -- get the team and verify permissions team <- tdTeam <$> (Data.team tid >>= ifNothing teamNotFound) @@ -325,8 +326,8 @@ updateTeamMember (zusr ::: zcon ::: tid ::: req ::: _) = do deleteTeamMember :: UserId ::: ConnId ::: TeamId ::: UserId ::: Request ::: Maybe JSON ::: JSON -> Galley Response deleteTeamMember (zusr::: zcon ::: tid ::: remove ::: req ::: _ ::: _) = do - Log.debug $ Log.field "target" (toByteString remove) - . Log.msg (Log.val "deleteTeamMember") + Log.debug $ Log.field "targets" (toByteString remove) + . Log.msg (Log.val "Teams.deleteTeamMember") mems <- Data.teamMembers tid void $ permissionCheck zusr RemoveTeamMember mems okToDelete <- canBeDeleted [] remove tid @@ -460,8 +461,8 @@ ensureNotElevated targetPermissions member = addTeamMemberInternal :: TeamId -> Maybe UserId -> Maybe ConnId -> NewTeamMember -> [TeamMember] -> Galley Response addTeamMemberInternal tid origin originConn newMem mems = do let new = newMem^.ntmNewTeamMember - Log.debug $ Log.field "target" (toByteString (new^.userId)) - . Log.msg (Log.val "addTeamMemberInternal") + Log.debug $ Log.field "targets" (toByteString (new^.userId)) + . Log.msg (Log.val "Teams.addTeamMemberInternal") o <- view options unless (length mems < fromIntegral (o^.optSettings.setMaxTeamSize)) $ throwM tooManyTeamMembers From 01b9600e440b4f7545820d18ada23a7b7a0daf52 Mon Sep 17 00:00:00 2001 From: Arian van Putten Date: Thu, 22 Aug 2019 14:35:54 +0200 Subject: [PATCH 07/11] Fix ambigious variable error --- services/galley/src/Galley/API/LegalHold.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/services/galley/src/Galley/API/LegalHold.hs b/services/galley/src/Galley/API/LegalHold.hs index 56945e54088..cb150fbae64 100644 --- a/services/galley/src/Galley/API/LegalHold.hs +++ b/services/galley/src/Galley/API/LegalHold.hs @@ -3,7 +3,7 @@ module Galley.API.LegalHold where import Imports import Galley.API.Error import Brig.Types.Provider -import Brig.Types.Team.LegalHold +import Brig.Types.Team.LegalHold hiding (userId) import Brig.Types.Client.Prekey import Control.Monad.Catch import Control.Lens (view, (^.)) From 3b98bd74b4acc51b27271854ad2060544b51091a Mon Sep 17 00:00:00 2001 From: Arian van Putten Date: Thu, 22 Aug 2019 16:49:30 +0200 Subject: [PATCH 08/11] Remove todo --- services/galley/src/Galley/API/LegalHold.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/services/galley/src/Galley/API/LegalHold.hs b/services/galley/src/Galley/API/LegalHold.hs index cb150fbae64..3b9ca88dd29 100644 --- a/services/galley/src/Galley/API/LegalHold.hs +++ b/services/galley/src/Galley/API/LegalHold.hs @@ -77,7 +77,6 @@ removeSettings (zusr ::: tid ::: req ::: _) = do assertLegalHoldEnabled tid membs <- Data.teamMembers tid let zothers = map (view userId) membs - -- TODO user id's of members Log.debug $ Log.field "targets" (toByteString (show zothers)) . Log.msg (Log.val "LegalHold.removeSettings") From 1cc871583955c6765a0f0404a78b6f8c63a6c994 Mon Sep 17 00:00:00 2001 From: Arian van Putten Date: Tue, 27 Aug 2019 14:47:00 +0200 Subject: [PATCH 09/11] Fix logging of multiple zusers --- services/galley/src/Galley/API/LegalHold.hs | 6 +++--- services/galley/src/Galley/API/Teams.hs | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/services/galley/src/Galley/API/LegalHold.hs b/services/galley/src/Galley/API/LegalHold.hs index 3b9ca88dd29..9abb37d61b4 100644 --- a/services/galley/src/Galley/API/LegalHold.hs +++ b/services/galley/src/Galley/API/LegalHold.hs @@ -43,7 +43,7 @@ createSettings (zusr ::: tid ::: req ::: _) = do membs <- Data.teamMembers tid let zothers = map (view userId) membs - Log.debug $ Log.field "targets" (toByteString (show zothers)) + Log.debug $ Log.field "targets" (toByteString . show $ toByteString <$> zothers) . Log.msg (Log.val "LegalHold.createSettings") void $ permissionCheck zusr ChangeLegalHoldTeamSettings membs @@ -77,7 +77,7 @@ removeSettings (zusr ::: tid ::: req ::: _) = do assertLegalHoldEnabled tid membs <- Data.teamMembers tid let zothers = map (view userId) membs - Log.debug $ Log.field "targets" (toByteString (show zothers)) + Log.debug $ Log.field "targets" (toByteString . show $ toByteString <$> zothers) . Log.msg (Log.val "LegalHold.removeSettings") void $ permissionCheck zusr ChangeLegalHoldTeamSettings membs @@ -95,7 +95,7 @@ removeSettings' removeSettings' tid mMembers = do membs <- maybe (Data.teamMembers tid) pure mMembers let zothers = map (view userId) membs - Log.debug $ Log.field "targets" (toByteString (show zothers)) + Log.debug $ Log.field "targets" (toByteString . show $ toByteString <$> zothers) . Log.msg (Log.val "LegalHold.removeSettings'") let lhMembers = filter ((== UserLegalHoldEnabled) . view legalHoldStatus) membs diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index 73db8bbd1c0..7e79720315b 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -113,7 +113,7 @@ createNonBindingTeam (zusr::: zcon ::: req ::: _) = do let zothers = map (view userId) others ensureUnboundUsers (zusr : zothers) ensureConnected zusr zothers - Log.debug $ Log.field "targets" (toByteString (show zothers)) + Log.debug $ Log.field "targets" (toByteString . show $ toByteString <$> zothers) . Log.msg (Log.val "Teams.createNonBindingTeam") team <- Data.createTeam Nothing zusr (body^.newTeamName) (body^.newTeamIcon) (body^.newTeamIconKey) NonBinding finishCreateTeam team owner others (Just zcon) @@ -153,7 +153,7 @@ updateTeam (zusr::: zcon ::: tid ::: req ::: _) = do body <- fromJsonBody req membs <- Data.teamMembers tid let zothers = map (view userId) membs - Log.debug $ Log.field "targets" (toByteString (show zothers)) + Log.debug $ Log.field "targets" (toByteString . show $ toByteString <$> zothers) . Log.msg (Log.val "Teams.updateTeam") void $ permissionCheck zusr SetTeamData membs Data.updateTeam tid body From 8084a8672cafa77342bf8326d1cc2c23634f18d8 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Thu, 29 Aug 2019 10:48:03 +0200 Subject: [PATCH 10/11] hi ci From dfabfecd2f84670c4ab036df000d1d8bd91489ea Mon Sep 17 00:00:00 2001 From: Arian van Putten Date: Thu, 29 Aug 2019 11:48:54 +0200 Subject: [PATCH 11/11] Json logging (#836) * Allow to set log format The old netstrings option is now deprecated, use logFormat instead. logFormat takes presedence of netstrings if both are set. If none are set, log format defaults to Plain * Implement json renderer for tinylog --- libs/extended/package.yaml | 2 + libs/extended/src/System/Logger/Extended.hs | 93 ++++++++++++++++----- libs/imports/package.yaml | 1 - libs/imports/src/Imports.hs | 6 +- libs/imports/src/Orphans.hs | 15 ---- services/brig/src/Brig/App.hs | 2 +- services/brig/src/Brig/Options.hs | 6 +- services/cannon/src/Cannon/Options.hs | 6 +- services/cannon/src/Cannon/Run.hs | 2 +- services/cargohold/src/CargoHold/App.hs | 2 +- services/cargohold/src/CargoHold/Options.hs | 7 +- services/galley/src/Galley/App.hs | 2 +- services/galley/src/Galley/Options.hs | 7 +- services/gundeck/src/Gundeck/Env.hs | 2 +- services/gundeck/src/Gundeck/Options.hs | 5 +- services/proxy/src/Proxy/Env.hs | 2 +- services/proxy/src/Proxy/Options.hs | 10 ++- services/spar/src/Spar/Run.hs | 2 +- services/spar/src/Spar/Types.hs | 4 +- services/spar/test-integration/Util/Core.hs | 2 +- tools/stern/src/Stern/App.hs | 2 +- tools/stern/src/Stern/Options.hs | 5 +- 22 files changed, 117 insertions(+), 68 deletions(-) delete mode 100644 libs/imports/src/Orphans.hs diff --git a/libs/extended/package.yaml b/libs/extended/package.yaml index 13164a797f3..f6b4816d370 100644 --- a/libs/extended/package.yaml +++ b/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 diff --git a/libs/extended/src/System/Logger/Extended.hs b/libs/extended/src/System/Logger/Extended.hs index 21cf8928483..fb8f66ccb7b 100644 --- a/libs/extended/src/System/Logger/Extended.hs +++ b/libs/extended/src/System/Logger/Extended.hs @@ -1,36 +1,90 @@ +{-# 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) + +-- | 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 +-- +-- FUTUREWORK: Once we get rid of the useNetstrings in our config files, we can +-- remove this function and rename 'mkLoggerNew' to 'mkLogger' +mkLogger :: Log.Level -> Maybe (Last Bool) -> Maybe (Last LogFormat) -> IO Log.Logger +mkLogger lvl useNetstrings logFormat = do + mkLoggerNew lvl $ + case (fmap netStringsToLogFormat <$> useNetstrings) <> logFormat of + Just x -> getLast x + Nothing -> Plain + +-- | Version of mkLogger that doesn't support the deprecated useNetstrings option +mkLoggerNew :: Log.Level -> LogFormat -> IO Log.Logger +mkLoggerNew lvl logFormat = Log.new . Log.setReadEnvironment False . Log.setOutput Log.StdOut . Log.setFormat Nothing - $ simpleSettings lvl netstr + $ simpleSettings lvl logFormat -- | Variant of Log.defSettings: -- @@ -40,15 +94,16 @@ mkLogger lvl netstr = Log.new -- -- * use 'canonicalizeWhitespace'. -- -simpleSettings :: Log.Level -> Bool -> Log.Settings -simpleSettings lvl netstr +simpleSettings :: Log.Level -> LogFormat -> Log.Settings +simpleSettings lvl logFormat = 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 + rndr = case logFormat of + 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. diff --git a/libs/imports/package.yaml b/libs/imports/package.yaml index b35af54fcbe..0a9c5e70352 100644 --- a/libs/imports/package.yaml +++ b/libs/imports/package.yaml @@ -16,7 +16,6 @@ copyright: (c) 2018 Wire Swiss GmbH license: AGPL-3 dependencies: - base -- aeson - extra - unliftio - unliftio-core diff --git a/libs/imports/src/Imports.hs b/libs/imports/src/Imports.hs index 24e08befdd5..a58274e5d0a 100644 --- a/libs/imports/src/Imports.hs +++ b/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 diff --git a/libs/imports/src/Orphans.hs b/libs/imports/src/Orphans.hs deleted file mode 100644 index f46e6a08ce2..00000000000 --- a/libs/imports/src/Orphans.hs +++ /dev/null @@ -1,15 +0,0 @@ -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE DeriveGeneric #-} - -{-# OPTIONS_GHC -Wno-orphans #-} - --- | Orphan instances for non-Wire-specific types and classes. -module Orphans () where - -import Data.Aeson -import GHC.Generics -import System.Logger.Class as Logger - -deriving instance Generic Logger.Level -instance FromJSON Logger.Level -instance ToJSON Logger.Level diff --git a/services/brig/src/Brig/App.hs b/services/brig/src/Brig/App.hs index efe703240de..b3a960e434c 100644 --- a/services/brig/src/Brig/App.hs +++ b/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 diff --git a/services/brig/src/Brig/Options.hs b/services/brig/src/Brig/Options.hs index 612dd832a6b..8814c873b3d 100644 --- a/services/brig/src/Brig/Options.hs +++ b/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 -- ) - + , logFormat :: !(Maybe (Last LogFormat)) -- ^ Logformat to use -- TURN , turn :: !TurnOpts -- ^ TURN server settings diff --git a/services/cannon/src/Cannon/Options.hs b/services/cannon/src/Cannon/Options.hs index 0be4389ecf1..62267c9f5e1 100644 --- a/services/cannon/src/Cannon/Options.hs +++ b/services/cannon/src/Cannon/Options.hs @@ -10,6 +10,7 @@ module Cannon.Options , externalHostFile , logLevel , logNetStrings + , logFormat , Opts ) where @@ -17,7 +18,7 @@ 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 diff --git a/services/cannon/src/Cannon/Run.hs b/services/cannon/src/Cannon/Run.hs index 715a9af36d3..8cee8f35a51 100644 --- a/services/cannon/src/Cannon/Run.hs +++ b/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 diff --git a/services/cargohold/src/CargoHold/App.hs b/services/cargohold/src/CargoHold/App.hs index 62859d36b07..f075b53e9c9 100644 --- a/services/cargohold/src/CargoHold/App.hs +++ b/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) diff --git a/services/cargohold/src/CargoHold/Options.hs b/services/cargohold/src/CargoHold/Options.hs index 3043dad1afb..2791fe07e21 100644 --- a/services/cargohold/src/CargoHold/Options.hs +++ b/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: - -- + , _optLogNetStrings :: !(Maybe (Last Bool)) -- ^ Use netstrings encoding: + -- + , _optLogFormat :: !(Maybe (Last LogFormat)) --- ^ Log format } deriving (Show, Generic) deriveFromJSON toOptionFieldName ''Opts diff --git a/services/galley/src/Galley/App.hs b/services/galley/src/Galley/App.hs index f043a62c4aa..eb7eb137427 100644 --- a/services/galley/src/Galley/App.hs +++ b/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 diff --git a/services/galley/src/Galley/Options.hs b/services/galley/src/Galley/Options.hs index 019a37ad480..6b736a49476 100644 --- a/services/galley/src/Galley/Options.hs +++ b/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: - -- + , _optLogNetStrings :: !(Maybe (Last Bool)) -- ^ Use netstrings encoding + -- + , _optLogFormat :: !(Maybe (Last LogFormat)) -- ^ What log format to use } deriveFromJSON toOptionFieldName ''Opts diff --git a/services/gundeck/src/Gundeck/Env.hs b/services/gundeck/src/Gundeck/Env.hs index 6670955f5d3..df349104d52 100644 --- a/services/gundeck/src/Gundeck/Env.hs +++ b/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) diff --git a/services/gundeck/src/Gundeck/Options.hs b/services/gundeck/src/Gundeck/Options.hs index 87fcad453b0..eb0effdc4f0 100644 --- a/services/gundeck/src/Gundeck/Options.hs +++ b/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: -- + , _optLogFormat :: !(Maybe (Last LogFormat)) } deriving (Show, Generic) deriveFromJSON toOptionFieldName ''Opts diff --git a/services/proxy/src/Proxy/Env.hs b/services/proxy/src/Proxy/Env.hs index 1fbb7f27c01..f997da756c0 100644 --- a/services/proxy/src/Proxy/Env.hs +++ b/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) diff --git a/services/proxy/src/Proxy/Options.hs b/services/proxy/src/Proxy/Options.hs index 8a1da25d44f..5c86858bbfe 100644 --- a/services/proxy/src/Proxy/Options.hs +++ b/services/proxy/src/Proxy/Options.hs @@ -7,6 +7,7 @@ module Proxy.Options , maxConns , logLevel , logNetStrings + , logFormat , mockOpts ) where @@ -14,7 +15,7 @@ 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 - -- ) + , _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 } diff --git a/services/spar/src/Spar/Run.hs b/services/spar/src/Spar/Run.hs index 3684c3e6c36..33f363c281c 100644 --- a/services/spar/src/Spar/Run.hs +++ b/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 = diff --git a/services/spar/src/Spar/Types.hs b/services/spar/src/Spar/Types.hs index e1a5651473a..425ccf7654b 100644 --- a/services/spar/src/Spar/Types.hs +++ b/services/spar/src/Spar/Types.hs @@ -27,6 +27,7 @@ import URI.ByteString import Util.Options import Web.Cookie import Web.HttpApiData +import System.Logger.Extended (LogFormat) import qualified Data.ByteString.Builder as Builder import qualified Data.Text as ST @@ -189,7 +190,8 @@ data Opts' a = Opts -- | Wire/AWS specific; optional; used to discover Cassandra instance -- IPs using describe-instances. , discoUrl :: !(Maybe Text) - , logNetStrings :: !Bool + , logNetStrings :: !(Maybe (Last Bool)) + , logFormat :: !(Maybe (Last LogFormat)) -- , optSettings :: !Settings -- (nothing yet; see other services for what belongs in here.) , derivedOpts :: !a } diff --git a/services/spar/test-integration/Util/Core.hs b/services/spar/test-integration/Util/Core.hs index 9876836efe6..2deac91f144 100644 --- a/services/spar/test-integration/Util/Core.hs +++ b/services/spar/test-integration/Util/Core.hs @@ -182,7 +182,7 @@ cliOptsParser = (,) <$> mkEnv :: HasCallStack => IntegrationConfig -> Opts -> IO TestEnv mkEnv _teTstOpts _teOpts = do _teMgr :: Manager <- newManager defaultManagerSettings - sparCtxLogger <- Log.mkLogger (toLevel $ saml _teOpts ^. SAML.cfgLogLevel) (logNetStrings _teOpts) + sparCtxLogger <- Log.mkLogger (toLevel $ saml _teOpts ^. SAML.cfgLogLevel) (logNetStrings _teOpts) (logFormat _teOpts) _teCql :: ClientState <- initCassandra _teOpts sparCtxLogger let _teBrig = endpointToReq (cfgBrig _teTstOpts) _teGalley = endpointToReq (cfgGalley _teTstOpts) diff --git a/tools/stern/src/Stern/App.hs b/tools/stern/src/Stern/App.hs index cd20dc649fd..b26e3a3946a 100644 --- a/tools/stern/src/Stern/App.hs +++ b/tools/stern/src/Stern/App.hs @@ -56,7 +56,7 @@ makeLenses ''Env newEnv :: Opts -> IO Env newEnv o = do mt <- Metrics.metrics - l <- Log.mkLogger (O.logLevel o) (O.logNetStrings o) + l <- Log.mkLogger (O.logLevel o) (O.logNetStrings o) (O.logFormat o) Env (mkRequest $ O.brig o) (mkRequest $ O.galley o) (mkRequest $ O.gundeck o) (mkRequest $ O.ibis o) (mkRequest $ O.galeb o) l mt <$> pure def <*> Bilge.newManager (Bilge.defaultManagerSettings { Bilge.managerResponseTimeout = responseTimeoutMicro 10000000 }) diff --git a/tools/stern/src/Stern/Options.hs b/tools/stern/src/Stern/Options.hs index 595ef90fced..9c4c4032106 100644 --- a/tools/stern/src/Stern/Options.hs +++ b/tools/stern/src/Stern/Options.hs @@ -7,7 +7,7 @@ import Data.Yaml (FromJSON(..)) import GHC.Generics import Imports import Util.Options -import System.Logger (Level) +import System.Logger.Extended (Level, LogFormat) -- | Options that are consumed on startup data Opts = Opts @@ -21,7 +21,8 @@ data Opts = Opts , galeb :: !Endpoint -- Logging , logLevel :: !Level - , logNetStrings :: !Bool + , logNetStrings :: !(Maybe (Last Bool)) + , logFormat :: !(Maybe (Last LogFormat)) } deriving (Show, Generic) instance FromJSON Opts