server: Fix a bunch of HLint suggestions

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/4738
GitOrigin-RevId: d0c0b13ac02ca80e51ae3d582f2e6917f76ad202

.hlint.yaml

@@ -84,6 +84,7 @@
 - ignore: {name: Redundant multi-way if}
 - ignore: {name: Use newtype instead of data}
 - ignore: {name: Use bimap}
+- ignore: {name: Use fromRight}
 - ignore: {name: Use $>}
 - ignore: {name: Use <$>}
 - ignore: {name: "Use ?~"}

server/src-lib/Data/Sequence/NonEmpty.hs

@@ -1,6 +1,9 @@
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ViewPatterns #-}
 
+-- we can't use onNothing without creating a dependency cycle
+{- HLINT ignore "Use onNothing" -}
+
 module Data.Sequence.NonEmpty
   ( NESeq,
     pattern (:<||),

server/src-lib/Data/Text/NonEmpty.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TemplateHaskellQuotes #-}
 
 module Data.Text.NonEmpty
   ( NonEmptyText,

server/src-lib/Hasura/Backends/Postgres/Translate/Select/Internal/OrderBy.hs

@@ -192,7 +192,7 @@ processOrderByItems sourcePrefix' fieldAlias' similarArrayFields distOnCols = \c
           if all (isJust . getColumnOrderBy . obiColumn) restOrderBys
             then -- Collect column order by expressions from the rest.
 
-              let restColumnOrderBys = mapMaybe (sequenceA . (getColumnOrderBy <$>)) restOrderBys
+              let restColumnOrderBys = mapMaybe (traverse getColumnOrderBy) restOrderBys
                   firstColumnOrderBy = firstOrderBy {obiColumn = columnInfo}
                in sortAtNodeAndBase $ firstColumnOrderBy NE.:| restColumnOrderBys
             else -- Else rest order by expressions contain atleast one non-column order by.

server/src-lib/Hasura/Backends/Postgres/Translate/Select/Internal/Process.hs

@@ -147,7 +147,7 @@ processSelectParams
         case (inpLimitM, permLimit) of
           (inpLim, Nothing) -> inpLim
           (Nothing, permLim) -> permLim
-          (Just inp, Just perm) -> Just if inp < perm then inp else perm
+          (Just inp, Just perm) -> Just (min inp perm)
 
       -- You should be able to retrieve this information
       -- from the FromItem generated with selectFromToFromItem

server/src-lib/Hasura/HTTP.hs

@@ -85,7 +85,7 @@ serializeHTTPExceptionMessage (HttpException (HTTP.HttpExceptionRequest _ httpEx
     HTTP.InternalException err -> case fromException err of
       Just (Restricted.ConnectionRestricted _ _) -> "Blocked connection to private IP address"
       Nothing -> "Internal Exception"
-    HTTP.ProxyConnectException _ _ _ -> "Proxy connection exception"
+    HTTP.ProxyConnectException {} -> "Proxy connection exception"
     HTTP.NoResponseDataReceived -> "No response data received"
     HTTP.TlsNotSupported -> "TLS not supported"
     HTTP.InvalidDestinationHost _ -> "Invalid destination host"

server/src-lib/Hasura/SQL/Time.hs

@@ -20,9 +20,9 @@ utc = Local.TimeZone 0 False ""
 
 zonedTimeOfDay :: Text -> Aeson.Parser ZonedTimeOfDay
 zonedTimeOfDay t =
-  case A.parseOnly (p <* endOfInput) t of
-    Left err -> fail $ "could not parse timetz: " ++ err
-    Right r -> return r
+  onLeft
+    (A.parseOnly (p <* endOfInput) t)
+    (\err -> fail $ "could not parse timetz: " ++ err)
   where
     p = ZonedTimeOfDay <$> timeOfDay <*> (fromMaybe utc <$> timeZone)
 

server/src-lib/Hasura/Server/Auth/JWT.hs

@@ -175,7 +175,7 @@ data JWTCustomClaimsMapValueG v
 instance (J.FromJSON v) => J.FromJSON (JWTCustomClaimsMapValueG v) where
   parseJSON (J.Object obj) = do
     path <- obj J..: "path" >>= (either fail pure . parseJSONPath)
-    defaultVal <- obj J..:? "default" >>= traverse pure
+    defaultVal <- obj J..:? "default" >>= pure
     pure $ JWTCustomClaimsMapJSONPath path defaultVal
   parseJSON v = JWTCustomClaimsMapStatic <$> J.parseJSON v
 

server/src-lib/Hasura/Server/Migrate/Version.hs

@@ -11,7 +11,6 @@ module Hasura.Server.Migrate.Version
 where
 
 import Data.FileEmbed (embedStringFile, makeRelativeToProject)
-import Data.Text qualified as T
 import Hasura.Prelude
 import Language.Haskell.TH.Syntax qualified as TH
 
@@ -26,4 +25,4 @@ latestCatalogVersion =
    )
 
 latestCatalogVersionString :: Text
-latestCatalogVersionString = T.pack $ show latestCatalogVersion
+latestCatalogVersionString = tshow latestCatalogVersion

server/src-lib/Network/HTTP/Client/Restricted.hs

@@ -16,6 +16,7 @@ import Control.Exception
 import Data.Default
 import Data.Maybe
 import Data.Typeable
+import Hasura.Prelude (onNothing)
 import Network.BSD (getProtocolNumber)
 import Network.Connection qualified as NC
 import Network.HTTP.Client qualified as HTTP
@@ -118,7 +119,7 @@ getConnection ::
   Maybe NC.ConnectionContext ->
   IO (Maybe HostAddress -> String -> Int -> IO HTTP.Connection)
 getConnection restriction tls mcontext = do
-  context <- maybe NC.initConnectionContext return mcontext
+  context <- onNothing mcontext NC.initConnectionContext
   return $ \_hostAddress hostName port ->
     bracketOnError
       (go context hostName port)

server/src-test/Hasura/AppSpec.hs

@@ -43,7 +43,7 @@ shutdownLatchSpec = do
       pollThrow async
         `shouldReturn` Nothing
       shutdownGracefully latch
-      (timeout 1_000_000 $ Async.wait async)
+      timeout 1_000_000 (Async.wait async)
         `shouldReturn` Just "shut down"
 
   it "allows multiple threads to wait for shutdown" $ do

server/src-test/Hasura/RQL/Types/TableSpec.hs

@@ -47,7 +47,6 @@ columnConfigSpec = describe "ColumnConfig" $ do
     prop "Right identity" $ \(x :: ColumnConfig) -> x <> mempty `shouldBe` x
     prop "Left identity" $ \(x :: ColumnConfig) -> mempty <> x `shouldBe` x
     prop "Associativity" $ \(x :: ColumnConfig) (y :: ColumnConfig) (z :: ColumnConfig) -> x <> (y <> z) `shouldBe` (x <> y) <> z
-    prop "Concatenation" $ \(xs :: [ColumnConfig]) -> mconcat xs `shouldBe` foldr (<>) mempty xs
 
 tableConfigSpec :: Spec
 tableConfigSpec = describe "TableConfig" $ do

server/src-test/Hasura/Server/AuthSpec.hs

@@ -81,7 +81,8 @@ getUserInfoWithExpTimeTests = describe "getUserInfo" $ do
       getUserInfoWithExpTime o claims authMode = gqlUserInfoWithExpTime o claims authMode Nothing
 
   let setupAuthMode'E a b c d =
-        either (const $ error "fixme") id <$> setupAuthMode' a b c d
+        either (const $ error "fixme") id
+          <$> setupAuthMode' a b c d
 
   let ourUnauthRole = mkRoleNameE "an0nymous"
 

server/tests-hspec/Test/RemoteRelationship/MetadataAPI/Common.hs

@@ -507,9 +507,7 @@ lhsRemoteServerMkLocalTestEnvironment _ = do
           orderByFunction = case ta_order_by of
             Nothing -> \_ _ -> EQ
             Just orderByArg -> orderTrack orderByArg
-          limitFunction = case ta_limit of
-            Nothing -> Prelude.id
-            Just limitArg -> take limitArg
+          limitFunction = maybe Prelude.id take ta_limit
       pure $
         tracks
           & filter filterFunction

server/tests-hspec/Test/RemoteRelationship/XToDBObjectRelationshipSpec.hs

@@ -456,9 +456,7 @@ lhsRemoteServerMkLocalTestEnvironment _ = do
           orderByFunction = case ta_order_by of
             Nothing -> \_ _ -> EQ
             Just orderByArg -> orderTrack orderByArg
-          limitFunction = case ta_limit of
-            Nothing -> Prelude.id
-            Just limitArg -> take limitArg
+          limitFunction = maybe Prelude.id take ta_limit
       pure $
         tracks
           & filter filterFunction

server/tests-hspec/Test/RemoteRelationship/XToRemoteSchemaRelationshipSpec.hs

@@ -347,9 +347,7 @@ lhsRemoteServerMkLocalTestEnvironment _ = do
           orderByFunction = case ta_order_by of
             Nothing -> \_ _ -> EQ
             Just orderByArg -> orderTrack orderByArg
-          limitFunction = case ta_limit of
-            Nothing -> Prelude.id
-            Just limitArg -> take limitArg
+          limitFunction = maybe Prelude.id take ta_limit
       pure $
         tracks
           & filter filterFunction