Fix (some) HLint issues in wire-api

changelog.d/5-internal/fix-hlint-issues-in-wire-api

@@ -0,0 +1 @@
+Fix some HLint issues in libs/wire-api.

libs/wire-api/src/Wire/API/Arbitrary.hs

@@ -1,6 +1,5 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DisambiguateRecordFields #-}
 {-# LANGUAGE KindSignatures #-}
-{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 

libs/wire-api/src/Wire/API/Conversation/Member.hs

@@ -252,13 +252,12 @@ instance Arbitrary MemberUpdate where
 
 validateMemberUpdate :: MemberUpdate -> Either String MemberUpdate
 validateMemberUpdate u =
-  if ( isJust (mupOtrMuteStatus u)
-         || isJust (mupOtrMuteRef u)
-         || isJust (mupOtrArchive u)
-         || isJust (mupOtrArchiveRef u)
-         || isJust (mupHidden u)
-         || isJust (mupHiddenRef u)
-     )
+  if isJust (mupOtrMuteStatus u)
+    || isJust (mupOtrMuteRef u)
+    || isJust (mupOtrArchive u)
+    || isJust (mupOtrArchiveRef u)
+    || isJust (mupHidden u)
+    || isJust (mupHiddenRef u)
     then Right u
     else
       Left

libs/wire-api/src/Wire/API/Conversation/Role.hs

@@ -137,7 +137,7 @@ instance FromJSON ConversationRole where
   parseJSON = A.withObject "conversationRole" $ \o -> do
     role <- o A..: "conversation_role"
     actions <- o A..: "actions"
-    case (toConvRole role (Just $ Actions actions)) of
+    case toConvRole role (Just $ Actions actions) of
       Just cr -> return cr
       Nothing -> fail ("Failed to parse: " ++ show o)
 

libs/wire-api/src/Wire/API/CustomBackend.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE StrictData #-}
 
 -- This file is part of the Wire Server implementation.

libs/wire-api/src/Wire/API/Push/V2/Token.hs

@@ -83,7 +83,7 @@ data PushToken = PushToken
   deriving (Arbitrary) via (GenericUniform PushToken)
 
 pushToken :: Transport -> AppName -> Token -> ClientId -> PushToken
-pushToken tp an tk cl = PushToken tp an tk cl
+pushToken = PushToken
 
 modelPushToken :: Doc.Model
 modelPushToken = Doc.defineModel "PushToken" $ do

libs/wire-api/src/Wire/API/Routes/Internal/Brig/Connection.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE DisambiguateRecordFields #-}
 
 -- This file is part of the Wire Server implementation.
 --

libs/wire-api/src/Wire/API/Routes/MultiVerb.hs

@@ -325,7 +325,7 @@ instance
   type ResponseStatus (WithHeaders hs a r) = ResponseStatus r
   type ResponseBody (WithHeaders hs a r) = ResponseBody r
 
-  responseRender acc x = fmap addHeaders $ responseRender @cs @r acc y
+  responseRender acc x = addHeaders <$> responseRender @cs @r acc y
     where
       (hs, y) = toHeaders @xs x
       addHeaders r =

libs/wire-api/src/Wire/API/Routes/Public/Galley.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE DerivingVia #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
 -- This file is part of the Wire Server implementation.

libs/wire-api/src/Wire/API/Team/Invitation.hs

@@ -74,7 +74,7 @@ modelTeamInvitationRequest = Doc.defineModel "TeamInvitationRequest" $ do
 
 instance ToJSON InvitationRequest where
   toJSON i =
-    object $
+    object
       [ "locale" .= irLocale i,
         "role" .= irRole i,
         "name" .= irInviteeName i,
@@ -137,7 +137,7 @@ modelTeamInvitation = Doc.defineModel "TeamInvitation" $ do
 
 instance ToJSON Invitation where
   toJSON i =
-    object $
+    object
       [ "team" .= inTeam i,
         "role" .= inRole i,
         "id" .= inInvitation i,

libs/wire-api/src/Wire/API/Team/LegalHold.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE StrictData #-}
 
 -- This file is part of the Wire Server implementation.
@@ -198,8 +197,8 @@ instance ToSchema ViewLegalHoldServiceInfo where
           [ ("team_id", Inline (toSchema (Proxy @UUID))),
             ("base_url", Inline (toSchema (Proxy @HttpsUrl))),
             ("fingerprint", Inline (toSchema (Proxy @(Fingerprint Rsa)))),
-            ("auth_token", Inline (toSchema (Proxy @(ServiceToken)))),
-            ("public_key", Inline (toSchema (Proxy @(ServiceKeyPEM))))
+            ("auth_token", Inline (toSchema (Proxy @ServiceToken))),
+            ("public_key", Inline (toSchema (Proxy @ServiceKeyPEM)))
           ]
       example_ =
         ViewLegalHoldService

libs/wire-api/src/Wire/API/Team/LegalHold/External.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE StrictData #-}
 
 -- This file is part of the Wire Server implementation.

libs/wire-api/src/Wire/API/Team/Permission.hs

@@ -198,6 +198,5 @@ instance Cql.Cql Permissions where
     let f = intToPerms . fromIntegral :: Int64 -> Set.Set Perm
     s <- Err.note "missing 'self' permissions" ("self" `lookup` p) >>= Cql.fromCql
     d <- Err.note "missing 'copy' permissions" ("copy" `lookup` p) >>= Cql.fromCql
-    r <- Err.note "invalid permissions" (newPermissions (f s) (f d))
-    pure r
+    Err.note "invalid permissions" (newPermissions (f s) (f d))
   fromCql _ = Left "permissions: udt expected"

libs/wire-api/src/Wire/API/User/Client.hs

@@ -730,11 +730,10 @@ instance ToSchema UpdateClient where
       UpdateClient
         <$> updateClientPrekeys
           .= ( fromMaybe []
-                 <$> ( optFieldWithDocModifier
-                         "prekeys"
-                         (description ?~ "New prekeys for other clients to establish OTR sessions.")
-                         (array schema)
-                     )
+                 <$> optFieldWithDocModifier
+                   "prekeys"
+                   (description ?~ "New prekeys for other clients to establish OTR sessions.")
+                   (array schema)
              )
         <*> updateClientLastKey
           .= maybe_

libs/wire-api/src/Wire/API/User/Client/Prekey.hs

@@ -75,8 +75,7 @@ instance ToSchema Prekey where
         <*> prekeyKey .= field "key" schema
 
 clientIdFromPrekey :: Prekey -> ClientId
-clientIdFromPrekey prekey =
-  newClientId . fromIntegral . hash . prekeyKey $ prekey
+clientIdFromPrekey = newClientId . fromIntegral . hash . prekeyKey
 
 --------------------------------------------------------------------------------
 -- LastPrekey

libs/wire-api/src/Wire/API/User/Orphans.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE StrictData #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 

libs/wire-api/src/Wire/API/User/Password.hs

@@ -1,5 +1,5 @@
+{-# LANGUAGE DisambiguateRecordFields #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE StrictData #-}
 
 -- This file is part of the Wire Server implementation.

libs/wire-api/src/Wire/API/User/RichInfo.hs

@@ -1,5 +1,4 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE DisambiguateRecordFields #-}
 {-# LANGUAGE StrictData #-}
 
 -- This file is part of the Wire Server implementation.
@@ -49,6 +48,7 @@ where
 
 import Data.Aeson
 import qualified Data.Aeson.Types as Aeson
+import Data.Bifunctor
 import Data.CaseInsensitive (CI)
 import qualified Data.CaseInsensitive as CI
 import qualified Data.HashMap.Strict as HM
@@ -130,7 +130,7 @@ toRichInfoAssocList (RichInfoMapAndList mp al) =
     go rfs (key, val) =
       case break (\(RichField rfKey _) -> rfKey == key) rfs of
         (xs, []) -> xs <> [RichField key val]
-        (xs, (_ : ys)) -> xs <> [RichField key val] <> ys
+        (xs, _ : ys) -> xs <> [RichField key val] <> ys
 
 -- | This is called by spar to recover the more type that also contains a map.  Since we don't
 -- know where the data came from when it was posted or where the SCIM peer expects the data to
@@ -168,7 +168,7 @@ instance ToJSON RichInfoMapAndList where
                     "version" .= (0 :: Int)
                   ]
             ],
-        richInfoMapURN .= (Map.mapKeys CI.original $ richInfoMap u)
+        richInfoMapURN .= Map.mapKeys CI.original (richInfoMap u)
       ]
 
 instance FromJSON RichInfoMapAndList where
@@ -197,14 +197,13 @@ instance FromJSON RichInfoMapAndList where
             richInfo <- lookupOrFail "richinfo" $ hmMapKeys CI.mk innerObj
             case richInfo of
               Object richinfoObj -> do
-                fields <- richInfoAssocListFromObject richinfoObj
-                pure fields
+                richInfoAssocListFromObject richinfoObj
               Array fields -> parseJSON (Array fields)
               v -> Aeson.typeMismatch "Object or Array" v
           Just v -> Aeson.typeMismatch "Object" v
 
       hmMapKeys :: (Eq k2, Hashable k2) => (k1 -> k2) -> HashMap k1 v -> HashMap k2 v
-      hmMapKeys f = HashMap.fromList . (map (\(k, v) -> (f k, v))) . HashMap.toList
+      hmMapKeys f = HashMap.fromList . map (Data.Bifunctor.first f) . HashMap.toList
 
       lookupOrFail :: (MonadFail m, Show k, Eq k, Hashable k) => k -> HashMap k v -> m v
       lookupOrFail key theMap = case HM.lookup key theMap of

libs/wire-api/src/Wire/API/User/Saml.hs

@@ -123,7 +123,7 @@ newtype TTL (tablename :: Symbol) = TTL {fromTTL :: Int32}
   deriving (Eq, Ord, Show, Num)
 
 showTTL :: KnownSymbol a => TTL a -> String
-showTTL (TTL i :: TTL a) = "TTL:" <> (symbolVal (Proxy @a)) <> ":" <> show i
+showTTL (TTL i :: TTL a) = "TTL:" <> symbolVal (Proxy @a) <> ":" <> show i
 
 instance FromJSON (TTL a) where
   parseJSON = withScientific "TTL value (seconds)" (pure . TTL . round)

libs/wire-api/test/unit/Test/Wire/API/User.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 -- This file is part of the Wire Server implementation.
@@ -34,13 +33,13 @@ import Test.Tasty.HUnit
 import Wire.API.User
 
 tests :: TestTree
-tests = testGroup "User (types vs. aeson)" $ unitTests
+tests = testGroup "User (types vs. aeson)" unitTests
 
 unitTests :: [TestTree]
 unitTests = parseIdentityTests ++ jsonNullTests
 
 jsonNullTests :: [TestTree]
-jsonNullTests = [testGroup "JSON null" [testCase "userProfile" $ testUserProfile]]
+jsonNullTests = [testGroup "JSON null" [testCase "userProfile" testUserProfile]]
 
 testUserProfile :: Assertion
 testUserProfile = do

libs/wire-api/test/unit/Test/Wire/API/User/RichInfo.hs

@@ -161,7 +161,7 @@ moreRichInfoNormalizationTests =
               y = (fromRichInfoAssocList . toRichInfoAssocList) x
           assertEqual mempty (toRichInfoAssocList x) (toRichInfoAssocList y),
         testProperty "works (property)" $ \(someAssocs :: RichInfoAssocList) ->
-          (jsonroundtrip someAssocs) === someAssocs
+          jsonroundtrip someAssocs === someAssocs
             .&&. (toRichInfoAssocList . fromRichInfoAssocList $ someAssocs) === someAssocs
             .&&. (toRichInfoAssocList . jsonroundtrip . fromRichInfoAssocList $ someAssocs) === someAssocs
       ]