Add more debug logging

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

@@ -18,12 +18,19 @@ import qualified Data.ByteString.Lazy.Char8 as L
 import qualified Data.ByteString.Lazy.Builder as B
 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
     . Log.setReadEnvironment False
     . Log.setOutput Log.StdOut
     . Log.setFormat Nothing
-    $ simpleSettings (Just lvl) (Just netstr)
+    $ simpleSettings lvl netstr
 
 -- | Variant of Log.defSettings:
 --
@@ -33,15 +40,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  -> \_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.
@@ -50,7 +57,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

services/galley/src/Galley/API/LegalHold.hs

@@ -3,12 +3,12 @@ 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, (^.))
 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,10 @@ createSettings (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.msg (Log.val "LegalHold.createSettings")
+
     void $ permissionCheck zusr ChangeLegalHoldTeamSettings membs
 
     newService :: NewLegalHoldService
@@ -71,8 +75,11 @@ getSettings (zusr ::: tid ::: _) = do
 removeSettings :: UserId ::: TeamId ::: JsonRequest RemoveLegalHoldSettingsRequest ::: JSON -> Galley Response
 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.msg (Log.val "LegalHold.removeSettings")
+
     void $ permissionCheck zusr ChangeLegalHoldTeamSettings membs
     RemoveLegalHoldSettingsRequest mPassword <- fromJsonBody req
     ensureReAuthorised zusr mPassword
@@ -87,6 +94,10 @@ removeSettings'
     -> Galley ()
 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.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 +140,8 @@ requestDevice :: UserId ::: TeamId ::: UserId ::: JSON -> Galley Response
 requestDevice (zusr ::: tid ::: uid ::: _) = do
     assertLegalHoldEnabled tid
 
+    Log.debug $ Log.field "targets" (toByteString uid)
+              . Log.msg (Log.val "LegalHold.requestDevice")
     membs <- Data.teamMembers tid
     void $ permissionCheck zusr ChangeLegalHoldUserSettings membs
 
@@ -164,6 +177,8 @@ approveDevice
     -> Galley Response
 approveDevice (zusr ::: tid ::: uid ::: connId ::: req ::: _) = do
     assertLegalHoldEnabled tid
+    Log.debug $ Log.field "targets" (toByteString uid)
+              . Log.msg (Log.val "LegalHold.approveDevice")
 
     unless (zusr == uid) (throwM accessDenied)
     assertOnTeam uid tid
@@ -199,6 +214,8 @@ disableForUser
   :: UserId ::: TeamId ::: UserId ::: JsonRequest DisableLegalHoldForUserRequest ::: JSON
   -> Galley Response
 disableForUser (zusr ::: tid ::: uid ::: req ::: _) = do
+    Log.debug $ Log.field "targets" (toByteString uid)
+              . Log.msg (Log.val "LegalHold.disableForUser")
     membs <- Data.teamMembers tid
     void $ permissionCheck zusr ChangeLegalHoldUserSettings membs
     if userLHNotDisabled membs

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 "Teams.createNonBindingTeam")
     team <- Data.createTeam Nothing zusr (body^.newTeamName) (body^.newTeamIcon) (body^.newTeamIconKey) NonBinding
     finishCreateTeam team owner others (Just zcon)
 
@@ -149,6 +152,9 @@ updateTeam :: UserId ::: ConnId ::: TeamId ::: JsonRequest TeamUpdateData ::: JS
 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.msg (Log.val "Teams.updateTeam")
     void $ permissionCheck zusr SetTeamData membs
     Data.updateTeam tid body
     now <- liftIO getCurrentTime
@@ -243,16 +249,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 "targets" (toByteString uid)
+              . Log.msg (Log.val "Teams.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 +279,9 @@ updateTeamMember (zusr ::: zcon ::: tid ::: req ::: _) = do
     let targetId          = targetMember^.userId
         targetPermissions = targetMember^.permissions
 
+    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)
     members <- Data.teamMembers tid
@@ -305,6 +315,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 +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 "targets" (toByteString remove)
+              . Log.msg (Log.val "Teams.deleteTeamMember")
     mems <- Data.teamMembers tid
     void $ permissionCheck zusr RemoveTeamMember mems
     okToDelete <- canBeDeleted [] remove tid
@@ -447,10 +460,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 "targets" (toByteString (new^.userId))
+              . Log.msg (Log.val "Teams.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