Adds automated linting

.hlint.yaml

@@ -0,0 +1,15 @@
+# We need quasi quotes support.
+- arguments: [ -XQuasiQuotes, --color ]
+# Used to enforce ormolu styling. Can be revisited if we change formatters.
+- ignore: { name: Redundant $ }
+- ignore: { name: Redundant do }
+- ignore: { name: Use newtype instead of data  }
+#
+# Left for the programmer to decide. See discussion at https://github.com/wireapp/wire-server/pull/2382#discussion_r871194424
+- ignore: { name: Avoid lambda }
+- ignore: { name: Avoid lambda using `infix` }
+
+- ignore: { name: Use section }
+# custom rules:
+- hint: { lhs: (() <$), rhs: void }
+- hint: { lhs: return, rhs: pure }

Makefile

@@ -79,7 +79,7 @@ ci: c
 # pass target=package:name to specify which target is watched.
 .PHONY: ghcid
 ghcid:
-	ghcid --command "cabal repl $(target)"
+	ghcid -l=hlint --command "cabal repl $(target)"
 
 # reset db using cabal
 .PHONY: db-reset-package

nix/default.nix

@@ -80,6 +80,7 @@ let
     pkgs.gnused
     pkgs.helm
     pkgs.helmfile
+    pkgs.hlint
     pkgs.jq
     pkgs.kind
     pkgs.kubectl

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

@@ -50,20 +50,20 @@ getClients usr = do
     if isInternal
       then fromUserClients <$> E.lookupClients [usr]
       else E.getClients [usr]
-  return $ clientIds usr clts
+  pure (clientIds usr clts)
 
 addClientH ::
   Member ClientStore r =>
   UserId ::: ClientId ->
   Sem r Response
 addClientH (usr ::: clt) = do
   E.createClient usr clt
-  return empty
+  pure empty
 
 rmClientH ::
   Member ClientStore r =>
   UserId ::: ClientId ->
   Sem r Response
 rmClientH (usr ::: clt) = do
   E.deleteClient usr clt
-  return empty
+  pure empty

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

@@ -426,35 +426,34 @@ createConnectConversation lusr conn j = do
     update n conv = do
       let mems = Data.convLocalMembers conv
        in conversationExisted lusr
-            =<< if
-                | (tUnqualified lusr) `isMember` mems ->
-                  -- we already were in the conversation, maybe also other
-                  connect n conv
-                | otherwise -> do
-                  let lcid = qualifyAs lusr (Data.convId conv)
-                  mm <- E.createMember lcid lusr
-                  let conv' =
-                        conv
-                          { Data.convLocalMembers = Data.convLocalMembers conv <> toList mm
-                          }
-                  if null mems
-                    then do
-                      -- the conversation was empty
-                      connect n conv'
-                    else do
-                      -- we were not in the conversation, but someone else
-                      conv'' <- acceptOne2One lusr conv' conn
-                      if Data.convType conv'' == ConnectConv
-                        then connect n conv''
-                        else return conv''
+            =<< if tUnqualified lusr `isMember` mems
+              then -- we already were in the conversation, maybe also other
+                connect n conv
+              else do
+                let lcid = qualifyAs lusr (Data.convId conv)
+                mm <- E.createMember lcid lusr
+                let conv' =
+                      conv
+                        { Data.convLocalMembers = Data.convLocalMembers conv <> toList mm
+                        }
+                if null mems
+                  then do
+                    -- the conversation was empty
+                    connect n conv'
+                  else do
+                    -- we were not in the conversation, but someone else
+                    conv'' <- acceptOne2One lusr conv' conn
+                    if Data.convType conv'' == ConnectConv
+                      then connect n conv''
+                      else pure conv''
     connect n conv
       | Data.convType conv == ConnectConv = do
         let lcnv = qualifyAs lusr (Data.convId conv)
         n' <- case n of
           Just x -> do
             E.setConversationName (Data.convId conv) x
-            return . Just $ fromRange x
-          Nothing -> return $ Data.convName conv
+            pure . Just $ fromRange x
+          Nothing -> pure $ Data.convName conv
         t <- input
         let e = Event (qUntagged lcnv) (qUntagged lusr) t (EdConnect j)
         for_ (newPushLocal ListComplete (tUnqualified lusr) (ConvEvent e) (recipient <$> Data.convLocalMembers conv)) $ \p ->
@@ -463,7 +462,7 @@ createConnectConversation lusr conn j = do
               & pushRoute .~ RouteDirect
               & pushConn .~ conn
         pure $ Data.convSetName n' conv
-      | otherwise = return conv
+      | otherwise = pure conv
 
 --------------------------------------------------------------------------------
 -- Conversation creation records
@@ -525,7 +524,7 @@ notifyCreatedConversation ::
   Data.Conversation ->
   Sem r ()
 notifyCreatedConversation dtime lusr conn c = do
-  now <- maybe (input) pure dtime
+  now <- maybe input pure dtime
   -- FUTUREWORK: Handle failures in notifying so it does not abort half way
   -- through (either when notifying remotes or locals)
   --
@@ -542,7 +541,7 @@ notifyCreatedConversation dtime lusr conn c = do
       let lconv = qualifyAs lusr (Data.convId c)
       c' <- conversationView (qualifyAs lusr (lmId m)) c
       let e = Event (qUntagged lconv) (qUntagged lusr) t (EdConversation c')
-      return $
+      pure $
         newPushLocal1 ListComplete (tUnqualified lusr) (ConvEvent e) (list1 (recipient m) [])
           & pushConn .~ conn
           & pushRoute .~ route
@@ -564,7 +563,7 @@ toUUIDs ::
 toUUIDs a b = do
   a' <- U.fromUUID (toUUID a) & note InvalidUUID4
   b' <- U.fromUUID (toUUID b) & note InvalidUUID4
-  return (a', b')
+  pure (a', b')
 
 accessRoles :: NewConv -> Set AccessRoleV2
 accessRoles b = fromMaybe Data.defRole (newConvAccessRoles b)

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

@@ -299,7 +299,6 @@ leaveConversation requestingDomain lc = do
       _event <- notifyConversationAction SConversationLeaveTag (qUntagged leaver) Nothing lcnv botsAndMembers action
 
       pure $ F.LeaveConversationResponse (Right ())
-  where
 
 -- FUTUREWORK: report errors to the originating backend
 -- FUTUREWORK: error handling for missing / mismatched clients

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

@@ -443,7 +443,7 @@ featureAPI =
 internalSitemap :: Routes a (Sem GalleyEffects) ()
 internalSitemap = do
   -- Conversation API (internal) ----------------------------------------
-  put "/i/conversations/:cnv/channel" (continue $ const (return empty)) $
+  put "/i/conversations/:cnv/channel" (continue $ const (pure empty)) $
     zauthUserId
       .&. (capture "cnv" :: HasCaptures r => Predicate r Predicate.Error ConvId)
       .&. request
@@ -581,7 +581,7 @@ rmUser lusr conn = do
       cc <- getConversations ids
       now <- input
       pp <- for cc $ \c -> case Data.convType c of
-        SelfConv -> return Nothing
+        SelfConv -> pure Nothing
         One2OneConv -> deleteMembers (Data.convId c) (UserList [tUnqualified lusr] []) $> Nothing
         ConnectConv -> deleteMembers (Data.convId c) (UserList [tUnqualified lusr] []) $> Nothing
         RegularConv
@@ -598,7 +598,7 @@ rmUser lusr conn = do
               Intra.newPushLocal ListComplete (tUnqualified lusr) (Intra.ConvEvent e) (Intra.recipient <$> Data.convLocalMembers c)
                 <&> set Intra.pushConn conn
                   . set Intra.pushRoute Intra.RouteDirect
-          | otherwise -> return Nothing
+          | otherwise -> pure Nothing
 
       for_
         (maybeList1 (catMaybes pp))

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

@@ -105,7 +105,7 @@ isLegalHoldEnabledForTeam tid = do
     FeatureLegalHoldDisabledByDefault -> do
       statusValue <-
         Public.tfwoStatus <$$> TeamFeatures.getFeatureStatusNoConfig @'Public.TeamFeatureLegalHold tid
-      return $ case statusValue of
+      pure $ case statusValue of
         Just Public.TeamFeatureEnabled -> True
         Just Public.TeamFeatureDisabled -> False
         Nothing -> False
@@ -471,7 +471,7 @@ requestDevice lzusr tid uid = do
       LegalHoldData.dropPendingPrekeys (tUnqualified luid)
       lhDevice <- LHService.requestNewDevice tid (tUnqualified luid)
       let NewLegalHoldClient prekeys lastKey = lhDevice
-      return (lastKey, prekeys)
+      pure (lastKey, prekeys)
 
 -- | Approve the adding of a Legal Hold device to the user.
 --

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

@@ -1,5 +1,3 @@
-{-# LANGUAGE RecordWildCards #-}
-
 -- This file is part of the Wire Server implementation.
 --
 -- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
@@ -39,7 +37,7 @@ import Polysemy
 import Polysemy.Error
 import qualified Polysemy.TinyLog as P
 import System.Logger.Message (msg, val, (+++))
-import Wire.API.Conversation hiding (Member (..))
+import Wire.API.Conversation
 import qualified Wire.API.Conversation as Conversation
 import Wire.API.Federation.API.Galley
 

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

@@ -195,12 +195,12 @@ filterMissing :: HasQuery r => Predicate r P.Error Public.OtrFilterMissing
 filterMissing = (>>= go) <$> (query "ignore_missing" ||| query "report_missing")
   where
     go (Left ign) = case fromByteString ign of
-      Just True -> return Public.OtrIgnoreAllMissing
-      Just False -> return Public.OtrReportAllMissing
+      Just True -> pure Public.OtrIgnoreAllMissing
+      Just False -> pure Public.OtrReportAllMissing
       Nothing -> Public.OtrIgnoreMissing <$> users "ignore_missing" ign
     go (Right rep) = case fromByteString rep of
-      Just True -> return Public.OtrReportAllMissing
-      Just False -> return Public.OtrIgnoreAllMissing
+      Just True -> pure Public.OtrReportAllMissing
+      Just False -> pure Public.OtrIgnoreAllMissing
       Nothing -> Public.OtrReportMissing <$> users "report_missing" rep
     users :: ByteString -> ByteString -> P.Result P.Error (Set UserId)
     users src bs = case fromByteString bs of

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

@@ -381,7 +381,7 @@ getConversationsInternal luser mids mstart msize = do
   let localConvIds = ids
   cs <-
     E.getConversations localConvIds
-      >>= filterM (removeDeleted)
+      >>= filterM removeDeleted
       >>= filterM (pure . isMember (tUnqualified luser) . Data.convLocalMembers)
   pure $ Public.ConversationList cs more
   where

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

@@ -14,6 +14,7 @@
 --
 -- 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 LambdaCase #-}
 
 module Galley.API.Teams
   ( createBindingTeam,
@@ -293,11 +294,11 @@ updateTeamStatus tid (TeamStatusUpdate newStatus cur) = do
     journal _ _ = throwS @'InvalidTeamStatusUpdate
     validateTransition :: Member (ErrorS 'InvalidTeamStatusUpdate) r => (TeamStatus, TeamStatus) -> Sem r Bool
     validateTransition = \case
-      (PendingActive, Active) -> return True
-      (Active, Active) -> return False
-      (Active, Suspended) -> return True
-      (Suspended, Active) -> return True
-      (Suspended, Suspended) -> return False
+      (PendingActive, Active) -> pure True
+      (Active, Active) -> pure False
+      (Active, Suspended) -> pure True
+      (Suspended, Active) -> pure True
+      (Suspended, Suspended) -> pure False
       (_, _) -> throwS @'InvalidTeamStatusUpdate
 
 updateTeamH ::
@@ -326,7 +327,7 @@ updateTeamH zusr zcon tid updateData = do
   memList <- getTeamMembersForFanout tid
   let e = newEvent tid now (EdTeamUpdate updateData)
   let r = list1 (userRecipient zusr) (membersToRecipients (Just zusr) (memList ^. teamMembers))
-  E.push1 $ newPushLocal1 (memList ^. teamMemberListType) zusr (TeamEvent e) r & pushConn .~ Just zcon
+  E.push1 $ newPushLocal1 (memList ^. teamMemberListType) zusr (TeamEvent e) r & pushConn ?~ zcon
 
 deleteTeam ::
   forall r.
@@ -357,7 +358,7 @@ deleteTeam zusr zcon tid body = do
   where
     checkPermissions team = do
       void $ permissionCheck DeleteTeam =<< E.getTeamMember tid zusr
-      when ((tdTeam team) ^. teamBinding == Binding) $ do
+      when (tdTeam team ^. teamBinding == Binding) $ do
         ensureReAuthorised zusr (body ^. tdAuthPassword) (body ^. tdVerificationCode) (Just U.DeleteTeam)
 
 -- This can be called by stern
@@ -438,8 +439,8 @@ uncheckedDeleteTeam lusr zcon tid = do
       -- To avoid DoS on gundeck, send team deletion events in chunks
       let chunkSize = fromMaybe defConcurrentDeletionEvents (o ^. setConcurrentDeletionEvents)
       let chunks = List.chunksOf chunkSize (toList r)
-      forM_ chunks $ \chunk -> case chunk of
-        [] -> return ()
+      forM_ chunks $ \case
+        [] -> pure ()
         -- push TeamDelete events. Note that despite having a complete list, we are guaranteed in the
         -- push module to never fan this out to more than the limit
         x : xs -> E.push1 (newPushLocal1 ListComplete (tUnqualified lusr) (TeamEvent e) (list1 x xs) & pushConn .~ zcon)
@@ -652,7 +653,7 @@ uncheckedGetTeamMembers ::
   TeamId ->
   Range 1 HardTruncationLimit Int32 ->
   Sem r TeamMemberList
-uncheckedGetTeamMembers tid maxResults = E.getTeamMembersWithLimit tid maxResults
+uncheckedGetTeamMembers = E.getTeamMembersWithLimit
 
 addTeamMember ::
   Members
@@ -812,7 +813,7 @@ updateTeamMember lzusr zcon tid newMember = do
       let ePriv = newEvent tid now privilegedUpdate
       -- push to all members (user is privileged)
       let pushPriv = newPushLocal (updatedMembers ^. teamMemberListType) zusr (TeamEvent ePriv) $ privilegedRecipients
-      for_ pushPriv $ \p -> E.push1 $ p & pushConn .~ Just zcon
+      for_ pushPriv $ \p -> E.push1 $ p & pushConn ?~ zcon
 
 deleteTeamMember ::
   Members
@@ -1130,7 +1131,7 @@ ensureUnboundUsers uids = do
   -- can only be part of one team.
   teams <- Map.elems <$> E.getUsersTeams uids
   binds <- E.getTeamsBindings teams
-  when (any (== Binding) binds) $
+  when (Binding `elem` binds) $
     throwS @'UserBindingExists
 
 ensureNonBindingTeam ::
@@ -1139,7 +1140,7 @@ ensureNonBindingTeam ::
   Sem r ()
 ensureNonBindingTeam tid = do
   team <- noteS @'TeamNotFound =<< E.getTeam tid
-  when ((tdTeam team) ^. teamBinding == Binding) $
+  when (tdTeam team ^. teamBinding == Binding) $
     throwS @'NoAddToBinding
 
 -- ensure that the permissions are not "greater" than the user's copy permissions
@@ -1161,7 +1162,7 @@ ensureNotTooLarge tid = do
   (TeamSize size) <- E.getSize tid
   unless (size < fromIntegral (o ^. optSettings . setMaxTeamSize)) $
     throwS @'TooManyTeamMembers
-  return $ TeamSize size
+  pure $ TeamSize size
 
 -- | Ensure that a team doesn't exceed the member count limit for the LegalHold
 -- feature. A team with more members than the fanout limit is too large, because
@@ -1239,7 +1240,7 @@ addTeamMemberInternal tid origin originConn (ntmNewTeamMember -> new) memList =
   E.push1 $
     newPushLocal1 (memList ^. teamMemberListType) (new ^. userId) (TeamEvent e) (recipients origin new) & pushConn .~ originConn
   APITeamQueue.pushTeamEvent tid e
-  return sizeBeforeAdd
+  pure sizeBeforeAdd
   where
     recipients (Just o) n =
       list1

services/galley/src/Galley/API/Teams/Features.hs

@@ -14,7 +14,6 @@
 --
 -- 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 RecordWildCards #-}
 
 module Galley.API.Teams.Features
   ( getFeatureStatus,