Linted Cannon.

services/cannon/src/Cannon/API/Internal.hs

@@ -1,6 +1,5 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DerivingVia #-}
-{-# LANGUAGE StandaloneDeriving #-}
 
 -- This file is part of the Wire Server implementation.
 --
@@ -63,7 +62,7 @@ singlePush n (PushTarget usrid conid) = do
   case c of
     Nothing -> do
       LC.debug $ client (key2bytes k) . msg (val "push: client gone")
-      return PushStatusGone
+      pure PushStatusGone
     Just x -> do
       e <- wsenv
       runWS e $ do

services/cannon/src/Cannon/App.hs

@@ -47,11 +47,11 @@ data State = State !Int !Timeout
 newtype TTL = TTL Word64
 
 counter :: Functor f => LensLike' f State Int
-counter f (State c p) = (\x -> State x p) `fmap` (f c)
+counter f (State c p) = (\x -> State x p) `fmap` f c
 {-# INLINE counter #-}
 
 pingFreq :: Functor f => LensLike' f State Timeout
-pingFreq f (State c p) = (\x -> State c x) `fmap` (f p)
+pingFreq f (State c p) = (\x -> State c x) `fmap` f p
 {-# INLINE pingFreq #-}
 
 -- | Maximum ping interval in seconds. The ping interval controls
@@ -92,14 +92,14 @@ continue ws clock k = do
       (Right (Left x)) ->
         let text = client (key2bytes k) . msg (val "write: " +++ show x)
          in runInIO $ Logger.debug text
-      _ -> return ()
+      _ -> pure ()
 
 terminate :: Key -> Websocket -> WS ()
 terminate k ws = do
   success <- unregisterLocal k ws
   debug $ client (key2bytes k) ~~ "websocket" .= connIdent ws ~~ "removed" .= success
   when success $
-    close k ws `catchAll` const (return ())
+    close k ws `catchAll` const (pure ())
 
 writeLoop :: Websocket -> Clock -> TTL -> IORef State -> IO ()
 writeLoop ws clock (TTL ttl) st = loop
@@ -116,7 +116,7 @@ writeLoop ws clock (TTL ttl) st = loop
             send (connection ws) ping
             threadDelay $ (10 # Second) `min` (s ^. pingFreq)
             keepAlive
-          | otherwise -> return ()
+          | otherwise -> pure ()
     keepAlive = do
       time <- getTime clock
       unless (time > ttl) loop
@@ -132,14 +132,14 @@ readLoop ws s = loop
           reset counter s 0
           send (connection ws) (pong p)
           loop
-        ControlMessage (Close _ _) -> return ()
+        ControlMessage (Close _ _) -> pure ()
         perhapsPingMsg -> do
           reset counter s 0
           when (isAppLevelPing perhapsPingMsg) sendAppLevelPong
           loop
     adjustPingFreq p = case fromByteString (toStrict p) of
       Just i | i > 0 && i < maxPingInterval -> reset pingFreq s (i # Second)
-      _ -> return ()
+      _ -> pure ()
     -- control messages are internal to the browser that manages the websockets
     -- <https://developer.mozilla.org/en-US/docs/Web/API/WebSockets_API/Writing_WebSocket_servers#Pings_and_Pongs_The_Heartbeat_of_WebSockets>.
     -- since the browser may silently lose a websocket connection, wire clients are allowed send

services/cannon/src/Cannon/Dict.hs

@@ -40,7 +40,7 @@ newtype Dict a b = Dict
   }
 
 size :: MonadIO m => Dict a b -> m Int
-size d = liftIO $ sum <$> mapM (\r -> SHM.size <$> readIORef r) (_map d)
+size d = liftIO $ sum <$> mapM (fmap SHM.size . readIORef) (_map d)
 
 empty :: MonadIO m => Int -> m (Dict a b)
 empty w =

services/cannon/src/Cannon/Run.hs

@@ -100,7 +100,7 @@ run o = do
     loadExternal :: IO ByteString
     loadExternal = do
       let extFile = fromMaybe (error "One of externalHost or externalHostFile must be defined") (o ^. cannon . externalHostFile)
-      maybe (readExternal extFile) (return . encodeUtf8) (o ^. cannon . externalHost)
+      maybe (readExternal extFile) (pure . encodeUtf8) (o ^. cannon . externalHost)
     readExternal :: FilePath -> IO ByteString
     readExternal f = encodeUtf8 . strip . pack <$> Strict.readFile f
 

services/cannon/src/Cannon/Types.hs

@@ -136,7 +136,7 @@ wsenv :: Cannon WS.Env
 wsenv = Cannon $ do
   e <- asks env
   r <- asks reqId
-  return $ WS.setRequestId r e
+  pure $ WS.setRequestId r e
 
 logger :: Cannon Logger
 logger = Cannon $ asks applog

services/cannon/src/Cannon/WS.hs

@@ -124,7 +124,7 @@ mkClock = do
   void . forkIO . forever $ do
     threadDelay (1 # Second)
     modifyIORef' r (+ 1)
-  return $ Clock r
+  pure $ Clock r
 
 getClock :: WS Clock
 getClock = WS $ asks clock
@@ -230,7 +230,7 @@ isRemoteRegistered u c = do
       const $
         rpc' "gundeck" (upstream e) (method GET . paths ["/i/presences", toByteString' u] . expect2xx)
   cs <- map connId <$> parseResponse (mkError status502 "server-error") rs
-  return $ c `elem` cs
+  pure $ c `elem` cs
 
 sendMsgIO :: (WebSocketsData a) => a -> Websocket -> IO ()
 sendMsgIO m c =
@@ -330,7 +330,7 @@ regInfo k c = do
   let h = externalHostname e
       p = portnum e
       r = "http://" <> h <> ":" <> pack (show p) <> "/i/push/"
-  return . lbytes . encode . object $
+  pure . lbytes . encode . object $
     [ "user_id" .= decodeUtf8 (keyUserBytes k),
       "device_id" .= decodeUtf8 (keyConnBytes k),
       "resource" .= decodeUtf8 (r <> keyUserBytes k <> "/" <> keyConnBytes k),

services/cannon/test/Test/Cannon/Dict.hs

@@ -52,16 +52,16 @@ someDict :: ([Key], [ByteString]) -> PropertyM IO (Dict Key ByteString)
 someDict (ks, vs) = do
   let entries = zip (List.nub ks) vs
   d <- run $ D.empty 64
-  run $ forM_ entries $ \e -> D.insert (fst e) (snd e) d
+  run $ forM_ entries $ \e -> uncurry D.insert e d
   s <- run $ D.size d
   assertEq "entries length" s (length entries)
-  return d
+  pure d
 
 insertRemove :: ([Key], [ByteString]) -> PropertyM IO ()
 insertRemove kv = do
   d <- someDict kv
-  a <- head <$> (run $ sample' arbitrary)
-  b <- head <$> (run $ sample' arbitrary)
+  a <- head <$> run (sample' arbitrary)
+  b <- head <$> run (sample' arbitrary)
   exists <- run $ isJust <$> D.lookup a d
   pre $ not exists
   x <- run $ D.size d
@@ -75,16 +75,16 @@ insertRemove kv = do
 insertRemoveIf :: ([Key], [ByteString]) -> PropertyM IO ()
 insertRemoveIf kv = do
   d <- someDict kv
-  a <- head <$> (run $ sample' arbitrary)
-  b <- head <$> (run $ sample' arbitrary)
+  a <- head <$> run (sample' arbitrary)
+  b <- head <$> run (sample' arbitrary)
   b' <- run $ do
     D.insert a b d
     D.lookup a d
   pre $ Just b == b'
-  x <- run $ D.removeIf (maybe False (b ==)) a d
+  x <- run $ D.removeIf (Just b ==) a d
   assert x
-  c <- head <$> (run $ sample' arbitrary)
-  y <- run $ D.removeIf (maybe False (c ==)) a d
+  c <- head <$> run (sample' arbitrary)
+  y <- run $ D.removeIf (Just c ==) a d
   assert (not y)
 
 insertLookup :: Assertion
@@ -106,7 +106,7 @@ insertLookup = do
 
 assertEq :: (Show a, Eq a, Monad m) => String -> a -> a -> PropertyM m ()
 assertEq m a b
-  | a == b = return ()
+  | a == b = pure ()
   | otherwise =
     fail $
       "assertEq: " ++ m ++ ": " ++ show a ++ " =/= " ++ show b
@@ -115,7 +115,7 @@ samples :: Int -> Gen a -> IO [a]
 samples n (MkGen f) = do
   gen <- newQCGen
   let rands g = g1 : rands g2 where (g1, g2) = split g
-  return $ [f r i | i <- repeat n, r <- rands gen]
+  pure $ [f r i | i <- repeat n, r <- rands gen]
 
 runProp :: (Show a, Arbitrary a, Testable b) => (a -> PropertyM IO b) -> Property
 runProp = monadicIO . forAllM arbitrary