Re-lint the codebase

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

@@ -349,8 +349,8 @@ claimLocalMultiPrekeyBundles protectee userClients = do
       e <- ask
       AppT $
         lift $
-          fmap (Map.fromListWith (<>)) $
-            unsafePooledMapConcurrentlyN
+          Map.fromListWith (<>)
+            <$> unsafePooledMapConcurrentlyN
               16
               (\(u, cids) -> (u,) <$> lowerAppT e (getUserKeys u cids))
               (Map.toList m)

services/brig/src/Brig/API/Public/Swagger.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE TemplateHaskell #-}
-
 module Brig.API.Public.Swagger
   ( SwaggerDocsAPI,
     pregenSwagger,

services/brig/src/Brig/CanonicalInterpreter.hs

@@ -57,23 +57,25 @@ type BrigCanonicalEffects =
 
 runBrigToIO :: Env -> AppT BrigCanonicalEffects a -> IO a
 runBrigToIO e (AppT ma) = do
-  (either throwM pure =<<)
-    . runFinal
-    . unsafelyPerformConcurrency
-    . embedToFinal
-    . loggerToTinyLog (e ^. applog)
-    . runError @SomeException
-    . mapError @ParseException SomeException
-    . interpretClientToIO (e ^. casClient)
-    . interpretRpcToIO (e ^. httpManager) (e ^. requestId)
-    . interpretServiceRpcToRpc @'Galley "galley" (e ^. galley)
-    . interpretGalleyProviderToRPC
-    . codeStoreToCassandra @Cas.Client
-    . nowToIOAction (e ^. currentTime)
-    . userPendingActivationStoreToCassandra
-    . passwordResetStoreToCodeStore
-    . interpretBlacklistStoreToCassandra @Cas.Client
-    . interpretBlacklistPhonePrefixStoreToCassandra @Cas.Client
-    . interpretJwtTools
-    . interpretPublicKeyBundle
+  ( either throwM pure
+      <=< ( runFinal
+              . unsafelyPerformConcurrency
+              . embedToFinal
+              . loggerToTinyLog (e ^. applog)
+              . runError @SomeException
+              . mapError @ParseException SomeException
+              . interpretClientToIO (e ^. casClient)
+              . interpretRpcToIO (e ^. httpManager) (e ^. requestId)
+              . interpretServiceRpcToRpc @'Galley "galley" (e ^. galley)
+              . interpretGalleyProviderToRPC
+              . codeStoreToCassandra @Cas.Client
+              . nowToIOAction (e ^. currentTime)
+              . userPendingActivationStoreToCassandra
+              . passwordResetStoreToCodeStore
+              . interpretBlacklistStoreToCassandra @Cas.Client
+              . interpretBlacklistPhonePrefixStoreToCassandra @Cas.Client
+              . interpretJwtTools
+              . interpretPublicKeyBundle
+          )
+    )
     $ runReaderT ma e

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

@@ -723,7 +723,12 @@ deleteAccountH ::
   ExceptT Error (AppT r) Response
 deleteAccountH (pid ::: req) = do
   guardSecondFactorDisabled Nothing
-  empty <$ (mapExceptT wrapHttpClient $ deleteAccount pid =<< parseJsonBody req)
+  empty
+    <$ mapExceptT
+      wrapHttpClient
+      ( deleteAccount pid
+          =<< parseJsonBody req
+      )
 
 deleteAccount ::
   ( MonadReader Env m,

services/brig/src/Brig/User/API/Handle.hs

@@ -76,7 +76,7 @@ getLocalHandleInfo self handle = do
     Nothing -> pure Nothing
     Just ownerId -> do
       domain <- viewFederationDomain
-      ownerProfile <- (API.lookupProfile self (Qualified ownerId domain)) !>> fedError
+      ownerProfile <- API.lookupProfile self (Qualified ownerId domain) !>> fedError
       owner <- filterHandleResults self (maybeToList ownerProfile)
       pure $ listToMaybe owner
 

services/brig/test/integration/API/User/Client.hs

@@ -414,7 +414,8 @@ testClientsWithoutPrekeys brig cannon db opts = do
   let removeClientKeys :: DB.PrepQuery DB.W (UserId, ClientId) ()
       removeClientKeys = "DELETE FROM prekeys where user = ? and client = ?"
   liftIO $
-    DB.runClient db $ DB.write removeClientKeys (DB.params DB.LocalQuorum (uid1, clientId c11))
+    DB.runClient db $
+      DB.write removeClientKeys (DB.params DB.LocalQuorum (uid1, clientId c11))
 
   uid2 <- userId <$> randomUser brig
 
@@ -441,13 +442,12 @@ testClientsWithoutPrekeys brig cannon db opts = do
         const 200 === statusCode
         const
           ( Right $
-              ( expectedClientMap
-                  domain
-                  uid1
-                  [ (clientId c11, Nothing),
-                    (clientId c12, Just pk12)
-                  ]
-              )
+              expectedClientMap
+                domain
+                uid1
+                [ (clientId c11, Nothing),
+                  (clientId c12, Just pk12)
+                ]
           )
           === responseJsonEither
 
@@ -701,7 +701,8 @@ testRemoveClient hasPwd brig cannon = do
   -- Permanent client with attached cookie
   when hasPwd $ do
     login brig (defEmailLogin email) PersistentCookie
-      !!! const 200 === statusCode
+      !!! const 200
+      === statusCode
     numCookies <- countCookies brig uid defCookieLabel
     liftIO $ Just 1 @=? numCookies
   c <- responseJsonError =<< addClient brig uid (client PermanentClientType (someLastPrekeys !! 10))
@@ -711,7 +712,8 @@ testRemoveClient hasPwd brig cannon = do
   -- Success
   WS.bracketR cannon uid $ \ws -> do
     deleteClient brig uid (clientId c) (if hasPwd then Just defPasswordText else Nothing)
-      !!! const 200 === statusCode
+      !!! const 200
+      === statusCode
     void . liftIO . WS.assertMatch (5 # Second) ws $ \n -> do
       let j = Object $ List1.head (ntfPayload n)
       let etype = j ^? key "type" . _String
@@ -747,13 +749,15 @@ testRemoveClientShortPwd brig = do
   let Just email = userEmail u
   -- Permanent client with attached cookie
   login brig (defEmailLogin email) PersistentCookie
-    !!! const 200 === statusCode
+    !!! const 200
+    === statusCode
   numCookies <- countCookies brig uid defCookieLabel
   liftIO $ Just 1 @=? numCookies
   c <- responseJsonError =<< addClient brig uid (client PermanentClientType (someLastPrekeys !! 10))
   resp <-
     deleteClient brig uid (clientId c) (Just "a")
-      <!! const 400 === statusCode
+      <!! const 400
+      === statusCode
   err :: Object <- responseJsonError resp
   liftIO $ do
     (err ^. at "code") @?= Just (Number 400)
@@ -781,13 +785,15 @@ testRemoveClientIncorrectPwd brig = do
   let Just email = userEmail u
   -- Permanent client with attached cookie
   login brig (defEmailLogin email) PersistentCookie
-    !!! const 200 === statusCode
+    !!! const 200
+    === statusCode
   numCookies <- countCookies brig uid defCookieLabel
   liftIO $ Just 1 @=? numCookies
   c <- responseJsonError =<< addClient brig uid (client PermanentClientType (someLastPrekeys !! 10))
   resp <-
     deleteClient brig uid (clientId c) (Just "abcdef")
-      <!! const 403 === statusCode
+      <!! const 403
+      === statusCode
   err :: Object <- responseJsonError resp
   liftIO $ do
     (err ^. at "code") @?= Just (Number 403)
@@ -949,15 +955,17 @@ testUpdateClient opts brig = do
                 updateClientLabel = Just label
               }
       )
-      !!! const 200 === statusCode
+      !!! const 200
+      === statusCode
     checkClientLabel
     put
       ( brig
           . paths ["clients", toByteString' (clientId c)]
           . zUser uid
           . json defUpdateClient {updateClientCapabilities = caps}
       )
-      !!! const 200 === statusCode
+      !!! const 200
+      === statusCode
     checkClientLabel
     checkClientPrekeys prekey
     checkClientPrekeys (unpackLastPrekey lastprekey)
@@ -987,7 +995,9 @@ testMissingClient brig = do
     -- This is unfortunate, but fixing this breaks clients.
     const Nothing === responseBody
     const ["text/plain;charset=utf-8"]
-      === map snd . filter ((== "Content-Type") . fst) . responseHeaders
+      === map snd
+        . filter ((== "Content-Type") . fst)
+        . responseHeaders
 
 -- The testAddMultipleTemporary test conforms to the following testing standards:
 -- @SF.Provisioning @TSFI.RESTfulAPI @S2
@@ -1125,7 +1135,8 @@ testCan'tDeleteLegalHoldClient brig = do
   let lk = head someLastPrekeys
   resp <-
     addClientInternal brig uid (defNewClient LegalHoldClientType [pk] lk)
-      <!! const 201 === statusCode
+      <!! const 201
+      === statusCode
   lhClientId <- clientId <$> responseJsonError resp
   deleteClient brig uid lhClientId Nothing !!! const 400 === statusCode
 

tools/hlint.sh

@@ -11,7 +11,7 @@ while getopts ':f:m:k' opt
      case $opt in
          f) f=${OPTARG}
             if [ "$f" = "all" ]; then
-              files=$(find libs/ services/ -name "*.hs")
+              echo "Checking every file…"
             elif [ "$f" = "pr" ]; then
               files=$(git diff --name-only origin/develop... | grep \.hs\$)
             elif [ "$f" = "changeset" ]; then
@@ -43,17 +43,18 @@ if [ "${k}" ]; then
   set -euo pipefail
 fi
 
-
-count=$(echo "$files" | grep -c -v -e '^[[:space:]]*$')
-
-echo "Analysing $count file(s)…"
-
-for f in $files
-do
-  echo "$f"
-  if [ $check = true ]; then
-    hlint --no-summary "$f"
-  else
-    hlint --refactor --refactor-options="--inplace" "$f"
-  fi
-done
+if [ "$f" = "all" ]; then
+  hlint -g -v
+else
+  count=$(echo "$files" | grep -c -v -e '^[[:space:]]*$')
+  echo "Analysing $count file(s)…"
+  for f in $files
+  do
+    echo "$f"
+    if [ $check = true ]; then
+      hlint --no-summary "$f"
+    else
+      hlint --refactor --refactor-options="--inplace" "$f"
+    fi
+  done
+fi

tools/rex/Main.hs

@@ -1,7 +1,11 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TupleSections #-}
 {-# OPTIONS_GHC -Wno-incomplete-patterns #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
+{-# HLINT ignore "Use shutdown" #-}
 
 -- This file is part of the Wire Server implementation.
 --
@@ -343,7 +347,7 @@ getPeerConnectivityStats lgr seed dom = do
           (`connect` SockAddrInet (fromIntegral port) (toHostAddress addr))
 
     mkAddr (_, Left _) = mempty
-    mkAddr (rr, Right ips) = map (\ip -> (ip, _3 rr)) ips
+    mkAddr (rr, Right ips) = (,_3 rr) <$> ips
 
     _4 (_, _, _, x) = x
     _3 (_, _, x, _) = x