diff --git a/services/brig/src/Brig/API/Client.hs b/services/brig/src/Brig/API/Client.hs index 9d0a5b8775..16aa14c0a7 100644 --- a/services/brig/src/Brig/API/Client.hs +++ b/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) diff --git a/services/brig/src/Brig/API/Public/Swagger.hs b/services/brig/src/Brig/API/Public/Swagger.hs index ba103186d3..801e57f60c 100644 --- a/services/brig/src/Brig/API/Public/Swagger.hs +++ b/services/brig/src/Brig/API/Public/Swagger.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE TemplateHaskell #-} - module Brig.API.Public.Swagger ( SwaggerDocsAPI, pregenSwagger, diff --git a/services/brig/src/Brig/CanonicalInterpreter.hs b/services/brig/src/Brig/CanonicalInterpreter.hs index e57229eeef..d6076ce31a 100644 --- a/services/brig/src/Brig/CanonicalInterpreter.hs +++ b/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 diff --git a/services/brig/src/Brig/Provider/API.hs b/services/brig/src/Brig/Provider/API.hs index f8c1c4ad0f..c533f636ea 100644 --- a/services/brig/src/Brig/Provider/API.hs +++ b/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, diff --git a/services/brig/src/Brig/User/API/Handle.hs b/services/brig/src/Brig/User/API/Handle.hs index c32303e49c..fb3d49c4f1 100644 --- a/services/brig/src/Brig/User/API/Handle.hs +++ b/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 diff --git a/services/brig/test/integration/API/User/Client.hs b/services/brig/test/integration/API/User/Client.hs index 1123a89481..48ec40b666 100644 --- a/services/brig/test/integration/API/User/Client.hs +++ b/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") - responseJsonError resp deleteClient brig uid lhClientId Nothing !!! const 400 === statusCode diff --git a/tools/hlint.sh b/tools/hlint.sh index 15d391d1dc..0f16b6e4ae 100755 --- a/tools/hlint.sh +++ b/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 diff --git a/tools/rex/Main.hs b/tools/rex/Main.hs index 82c9f3ded1..12e9ad777c 100644 --- a/tools/rex/Main.hs +++ b/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