Address hlint warnings/suggestions

.github/workflows/code-style.yaml

@@ -1,4 +1,4 @@
-name: Code style check
+name: Code style checks
 
 concurrency:
   group: formatting-${{ github.ref_name }}
@@ -20,4 +20,17 @@ jobs:
         uses: cachix/install-nix-action@v31
       - name: Check code formatting
         run: |
-          nix develop '#haskellFormatter' --command fourmolu --mode=check --check-idempotence servant servant-*
+          nix develop '#haskellFormatter' --command fourmolu --mode=check --check-idempotence servant servant-*
+
+  lint:
+    runs-on: ubuntu-latest
+    steps:
+      - name: Checkout Code
+        uses: actions/checkout@v4
+        with:
+          fetch-depth: 1
+      - name: Install Nix
+        uses: cachix/install-nix-action@v31
+      - name: Run hlint check
+        run: |
+          nix develop '#haskellLinter' --command hlint servant servant-*

hlint.yaml → .hlint.yaml

@@ -45,15 +45,12 @@
 #
 # Generalise map to fmap, ++ to <>
 # - group: {name: generalise, enabled: true}
+#
+# Replace return with pure
+# - group: {name: future, enabled: true}
 
 
 # Ignore some builtin hints
-- ignore: {name: Redundant do}
-- ignore: {name: Parse error}
-- ignore: {name: Use fmap}
-- ignore: {name: Use list comprehension}
-- ignore: {name: Use lambda-case}
-- ignore: {name: Eta reduce}
 # - ignore: {name: Use const, within: SpecialModule} # Only within certain modules
 
 

doc/tutorial/test/JavascriptSpec.hs

@@ -27,7 +27,7 @@ spec = do
   describe "app" $ with (return app) $ do
     context "/api.js" $ do
       it "delivers apiJS" $ do
-        get "/api.js" `shouldRespondWith` (fromString (cs apiJS1))
+        get "/api.js" `shouldRespondWith` fromString (cs apiJS1)
 
     context "/" $ do
       it "delivers something" $ do

servant-auth/servant-auth-client/test/Servant/Auth/ClientSpec.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveAnyClass #-}
 
 module Servant.Auth.ClientSpec (spec) where
 

servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/Cookie.hs

@@ -29,42 +29,40 @@ import Servant.Auth.Server.Internal.Types
 cookieAuthCheck :: FromJWT usr => CookieSettings -> JWTSettings -> AuthCheck usr
 cookieAuthCheck ccfg jwtSettings = do
   req <- ask
-  jwtCookie <- maybe mempty return $ do
+  jwtCookie <- maybe mempty pure $ do
     cookies' <- lookup hCookie $ requestHeaders req
     let cookies = parseCookies cookies'
     -- Apply the XSRF check if enabled.
     guard $ fromMaybe True $ do
       xsrfCookieCfg <- xsrfCheckRequired ccfg req
-      return $ xsrfCookieAuthCheck xsrfCookieCfg req cookies
+      pure $ xsrfCookieAuthCheck xsrfCookieCfg req cookies
     -- session cookie *must* be HttpOnly and Secure
     lookup (sessionCookieName ccfg) cookies
   verifiedJWT <- liftIO $ verifyJWT jwtSettings jwtCookie
-  case verifiedJWT of
-    Nothing -> mzero
-    Just v -> return v
+  maybe mzero pure verifiedJWT
 
 xsrfCheckRequired :: CookieSettings -> Request -> Maybe XsrfCookieSettings
 xsrfCheckRequired cookieSettings req = do
   xsrfCookieCfg <- cookieXsrfSetting cookieSettings
   let disableForGetReq = xsrfExcludeGet xsrfCookieCfg && requestMethod req == methodGet
   guard $ not disableForGetReq
-  return xsrfCookieCfg
+  pure xsrfCookieCfg
 
 xsrfCookieAuthCheck :: XsrfCookieSettings -> Request -> [(BS.ByteString, BS.ByteString)] -> Bool
 xsrfCookieAuthCheck xsrfCookieCfg req cookies = fromMaybe False $ do
   xsrfCookie <- lookup (xsrfCookieName xsrfCookieCfg) cookies
   xsrfHeader <- lookup (mk $ xsrfHeaderName xsrfCookieCfg) $ requestHeaders req
-  return $ xsrfCookie `constEq` xsrfHeader
+  pure $ xsrfCookie `constEq` xsrfHeader
 
 -- | Makes a cookie to be used for XSRF.
 makeXsrfCookie :: CookieSettings -> IO SetCookie
 makeXsrfCookie cookieSettings = case cookieXsrfSetting cookieSettings of
   Just xsrfCookieSettings -> makeRealCookie xsrfCookieSettings
-  Nothing -> return $ noXsrfTokenCookie cookieSettings
+  Nothing -> pure $ noXsrfTokenCookie cookieSettings
   where
     makeRealCookie xsrfCookieSettings = do
       xsrfValue <- BS64.encode <$> getEntropy 32
-      return $
+      pure $
         applyXsrfCookieSettings xsrfCookieSettings $
           applyCookieSettings cookieSettings $
             def{setCookieValue = xsrfValue}
@@ -79,9 +77,9 @@ makeSessionCookie :: ToJWT v => CookieSettings -> JWTSettings -> v -> IO (Maybe
 makeSessionCookie cookieSettings jwtSettings v = do
   ejwt <- makeJWT v jwtSettings (cookieExpires cookieSettings)
   case ejwt of
-    Left _ -> return Nothing
+    Left _ -> pure Nothing
     Right jwt ->
-      return $
+      pure $
         Just $
           applySessionCookieSettings cookieSettings $
             applyCookieSettings cookieSettings $
@@ -128,7 +126,7 @@ applySessionCookieSettings cookieSettings setCookie =
     , setCookieHttpOnly = True
     }
 
--- | For a JWT-serializable session, returns a function that decorates a
+-- | For a JWT-serializable session, pures a function that decorates a
 -- provided response object with XSRF and session cookies. This should be used
 -- when a user successfully authenticates with credentials.
 acceptLogin
@@ -146,7 +144,7 @@ acceptLogin cookieSettings jwtSettings session = do
     Nothing -> pure Nothing
     Just sessionCookie -> do
       xsrfCookie <- makeXsrfCookie cookieSettings
-      return $ Just $ addHeader' sessionCookie . addHeader' xsrfCookie
+      pure $ Just $ addHeader' sessionCookie . addHeader' xsrfCookie
 
 -- | Arbitrary cookie expiry time set back in history after unix time 0
 expireTime :: UTCTime

servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/JWT.hs

@@ -21,16 +21,14 @@ import Servant.Auth.Server.Internal.Types
 jwtAuthCheck :: FromJWT usr => JWTSettings -> AuthCheck usr
 jwtAuthCheck jwtSettings = do
   req <- ask
-  token <- maybe mempty return $ do
+  token <- maybe mempty pure $ do
     authHdr <- lookup "Authorization" $ requestHeaders req
     let bearer = "Bearer "
         (mbearer, rest) = BS.splitAt (BS.length bearer) authHdr
     guard (mbearer `constEq` bearer)
-    return rest
+    pure rest
   verifiedJWT <- liftIO $ verifyJWT jwtSettings token
-  case verifiedJWT of
-    Nothing -> mzero
-    Just v -> return v
+  maybe mzero pure verifiedJWT
 
 -- | Creates a JWT containing the specified data. The data is stored in the
 -- @dat@ claim. The 'Maybe UTCTime' argument indicates the time at which the
@@ -50,7 +48,7 @@ makeJWT v cfg expiry = Jose.runJOSE $ do
       (Jose.newJWSHeader ((), alg))
       (addExp $ encodeJWT v)
 
-  return $ Jose.encodeCompact ejwt
+  pure $ Jose.encodeCompact ejwt
   where
     addExp claims = case expiry of
       Nothing -> claims
@@ -65,7 +63,7 @@ verifyJWT jwtCfg input = do
       (jwtSettingsToJwtValidationSettings jwtCfg)
       keys
       unverifiedJWT
-  return $ case verifiedJWT of
+  pure $ case verifiedJWT of
     Left (_ :: Jose.JWTError) -> Nothing
     Right v -> case decodeJWT v of
       Left _ -> Nothing