diff --git a/changelog.d/5-internal/hlint-federator b/changelog.d/5-internal/hlint-federator new file mode 100644 index 0000000000..96c1fac4dc --- /dev/null +++ b/changelog.d/5-internal/hlint-federator @@ -0,0 +1 @@ +Fix non-controversial HLint issues in federator to improve code quality diff --git a/services/federator/src/Federator/ExternalServer.hs b/services/federator/src/Federator/ExternalServer.hs index b81c7b1869..092c1a31af 100644 --- a/services/federator/src/Federator/ExternalServer.hs +++ b/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) $ diff --git a/services/federator/src/Federator/InternalServer.hs b/services/federator/src/Federator/InternalServer.hs index 5493448f32..c9aeace7b5 100644 --- a/services/federator/src/Federator/InternalServer.hs +++ b/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 diff --git a/services/federator/src/Federator/MockServer.hs b/services/federator/src/Federator/MockServer.hs index ec28270ca9..1284e2e281 100644 --- a/services/federator/src/Federator/MockServer.hs +++ b/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) diff --git a/services/federator/src/Federator/Monitor/Internal.hs b/services/federator/src/Federator/Monitor/Internal.hs index 28351d384d..9833077cdf 100644 --- a/services/federator/src/Federator/Monitor/Internal.hs +++ b/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 [] = [] diff --git a/services/federator/test/integration/Test/Federator/IngressSpec.hs b/services/federator/test/integration/Test/Federator/IngressSpec.hs index 34b6af1d32..f1b2b891bf 100644 --- a/services/federator/test/integration/Test/Federator/IngressSpec.hs +++ b/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" diff --git a/services/federator/test/unit/Test/Federator/Client.hs b/services/federator/test/unit/Test/Federator/Client.hs index 854ac57087..13d92f5cd3 100644 --- a/services/federator/test/unit/Test/Federator/Client.hs +++ b/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) diff --git a/services/federator/test/unit/Test/Federator/InternalServer.hs b/services/federator/test/unit/Test/Federator/InternalServer.hs index b384d0b88f..55452911f4 100644 --- a/services/federator/test/unit/Test/Federator/InternalServer.hs +++ b/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 ] diff --git a/services/federator/test/unit/Test/Federator/Util.hs b/services/federator/test/unit/Test/Federator/Util.hs index a299276c39..ff8acc1be2 100644 --- a/services/federator/test/unit/Test/Federator/Util.hs +++ b/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)] diff --git a/services/federator/test/unit/Test/Federator/Validation.hs b/services/federator/test/unit/Test/Federator/Validation.hs index 785757927f..012ab59308 100644 --- a/services/federator/test/unit/Test/Federator/Validation.hs +++ b/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,