Fix doubtless HLint issues in Federator

changelog.d/5-internal/hlint-federator

@@ -0,0 +1 @@
+Fix non-controversial HLint issues in federator to improve code quality

services/federator/src/Federator/ExternalServer.hs

@@ -107,14 +107,14 @@ parseRequestData req = do
   when (Wai.requestMethod req /= HTTP.methodPost) $
     throw InvalidRoute
   -- No query parameters are allowed
-  when (not . BS.null . Wai.rawQueryString $ req) $
+  unless (BS.null . Wai.rawQueryString $ req) $
     throw InvalidRoute
   -- check that the path has the expected form
   (componentSeg, rpcPath) <- case Wai.pathInfo req of
     ["federation", comp, rpc] -> pure (comp, rpc)
     _ -> throw InvalidRoute
 
-  when (not (Text.all isAllowedRPCChar rpcPath)) $
+  unless (Text.all isAllowedRPCChar rpcPath) $
     throw InvalidRoute
 
   when (Text.null rpcPath) $

services/federator/src/Federator/InternalServer.hs

@@ -90,7 +90,7 @@ parseRequestData req = do
   when (Wai.requestMethod req /= HTTP.methodPost) $
     throw InvalidRoute
   -- No query parameters are allowed
-  when (not . BS.null . Wai.rawQueryString $ req) $
+  unless (BS.null . Wai.rawQueryString $ req) $
     throw InvalidRoute
   -- check that the path has the expected form
   (domain, componentSeg, rpcPath) <- case Wai.pathInfo req of

services/federator/src/Federator/MockServer.hs

@@ -53,7 +53,7 @@ import Wire.API.Federation.Domain
 
 -- | Thrown in IO by mock federator if the server could not be started after 10
 -- seconds.
-data MockTimeout = MockTimeout Warp.Port
+newtype MockTimeout = MockTimeout Warp.Port
   deriving (Eq, Show, Typeable)
 
 instance Exception MockTimeout
@@ -159,7 +159,7 @@ withTempMockFederator headers resp action = do
                           frBody = rdBody
                         }
                     )
-              embed @IO $ modifyIORef remoteCalls $ (<> [fedRequest])
+              embed @IO $ modifyIORef remoteCalls (<> [fedRequest])
               body <-
                 fromException @MockException
                   . handle (throw . handleException)

services/federator/src/Federator/Monitor/Internal.hs

@@ -72,7 +72,7 @@ data WatchedPath
   deriving stock (Eq, Ord, Show, Generic)
   deriving (Arbitrary) via (GenericUniform WatchedPath)
 
-mergePaths :: [WatchedPath] -> (Set WatchedPath)
+mergePaths :: [WatchedPath] -> Set WatchedPath
 mergePaths = Set.fromList . merge . sort
   where
     merge [] = []

services/federator/test/integration/Test/Federator/IngressSpec.hs

@@ -62,13 +62,14 @@ spec env = do
         resp <-
           runTestSem
             . assertNoError @RemoteError
-            $ inwardBrigCallViaIngress "get-user-by-handle" $
+            $ inwardBrigCallViaIngress
+              "get-user-by-handle"
               (Aeson.fromEncoding (Aeson.toEncoding hdl))
         liftIO $ do
           bdy <- streamingResponseStrictBody resp
           let actualProfile = Aeson.decode (toLazyByteString bdy)
           responseStatusCode resp `shouldBe` HTTP.status200
-          actualProfile `shouldBe` (Just expectedProfile)
+          actualProfile `shouldBe` Just expectedProfile
 
   -- @SF.Federation @TSFI.RESTfulAPI @S2 @S3 @S7
   --
@@ -96,7 +97,9 @@ spec env = do
       r <-
         runTestSem
           . runError @RemoteError
-          $ inwardBrigCallViaIngressWithSettings tlsSettings "get-user-by-handle" $
+          $ inwardBrigCallViaIngressWithSettings
+            tlsSettings
+            "get-user-by-handle"
             (Aeson.fromEncoding (Aeson.toEncoding hdl))
       liftIO $ case r of
         Right _ -> expectationFailure "Expected client certificate error, got response"

services/federator/test/unit/Test/Federator/Client.hs

@@ -131,13 +131,12 @@ testClientStreaming = withInfiniteMockServer $ \port -> do
             ceFederator = Endpoint "127.0.0.1" (fromIntegral port)
           }
   let c = clientIn (Proxy @StreamingAPI) (Proxy @(FederatorClient 'Brig))
-  runCodensity (runFederatorClientToCodensity env c) $ \eout ->
-    case eout of
-      Left err -> assertFailure $ "Unexpected error: " <> displayException err
-      Right out -> do
-        let expected = mconcat (replicate 500 "Hello")
-        actual <- takeSourceT (fromIntegral (LBS.length expected)) (fmap Text.encodeUtf8 out)
-        actual @?= expected
+  runCodensity (runFederatorClientToCodensity env c) $ \case
+    Left err -> assertFailure $ "Unexpected error: " <> displayException err
+    Right out -> do
+      let expected = mconcat (replicate 500 "Hello")
+      actual <- takeSourceT (fromIntegral (LBS.length expected)) (fmap Text.encodeUtf8 out)
+      actual @?= expected
 
 testClientFailure :: IO ()
 testClientFailure = do
@@ -232,7 +231,7 @@ withInfiniteMockServer k = bracket (startMockServer Nothing app) fst (k . snd)
     app _ respond = respond $
       Wai.responseStream HTTP.ok200 mempty $ \write flush ->
         let go n = do
-              when (n == 0) $ flush
+              when (n == 0) flush
               write (byteString "Hello\n") *> go (if n == 0 then 100 else n - 1)
          in go (1000 :: Int)
 

services/federator/test/unit/Test/Federator/InternalServer.hs

@@ -49,7 +49,8 @@ tests :: TestTree
 tests =
   testGroup
     "Federate"
-    [ testGroup "with remote" $
+    [ testGroup
+        "with remote"
         [ federatedRequestSuccess,
           federatedRequestFailureAllowList
         ]

services/federator/test/unit/Test/Federator/Util.hs

@@ -62,10 +62,9 @@ testRequest tr = do
   pure . flip Wai.setPath (trPath tr) $
     Wai.defaultRequest
       { Wai.requestMethod = trMethod tr,
-        Wai.requestBody = atomicModifyIORef refChunks $ \bss ->
-          case bss of
-            [] -> ([], mempty)
-            x : y -> (y, x),
+        Wai.requestBody = atomicModifyIORef refChunks $ \case
+          [] -> ([], mempty)
+          x : y -> (y, x),
         Wai.requestHeaders =
           [("X-SSL-Certificate", HTTP.urlEncode True h) | h <- toList (trCertificateHeader tr)]
             <> [(originDomainHeaderName, h) | h <- toList (trDomainHeader tr)]

services/federator/test/unit/Test/Federator/Validation.hs

@@ -60,12 +60,15 @@ mockDiscoveryFailure = Polysemy.interpret $ \case
 
 tests :: TestTree
 tests =
-  testGroup "Validation" $
-    [ testGroup "federateWith" $
+  testGroup
+    "Validation"
+    [ testGroup
+        "federateWith"
         [ federateWithAllowListSuccess,
           federateWithAllowListFail
         ],
-      testGroup "validateDomain" $
+      testGroup
+        "validateDomain"
         [ validateDomainAllowListFailSemantic,
           validateDomainAllowListFail,
           validateDomainAllowListSuccess,