diff --git a/services/cannon/src/Cannon/API/Internal.hs b/services/cannon/src/Cannon/API/Internal.hs index df1f98445c..be9141e791 100644 --- a/services/cannon/src/Cannon/API/Internal.hs +++ b/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 diff --git a/services/cannon/src/Cannon/App.hs b/services/cannon/src/Cannon/App.hs index f4e08807ca..21d1973aa8 100644 --- a/services/cannon/src/Cannon/App.hs +++ b/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 -- . -- since the browser may silently lose a websocket connection, wire clients are allowed send diff --git a/services/cannon/src/Cannon/Dict.hs b/services/cannon/src/Cannon/Dict.hs index 765c6043bb..a937db8569 100644 --- a/services/cannon/src/Cannon/Dict.hs +++ b/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 = diff --git a/services/cannon/src/Cannon/Run.hs b/services/cannon/src/Cannon/Run.hs index d72119823e..635e414a9f 100644 --- a/services/cannon/src/Cannon/Run.hs +++ b/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 diff --git a/services/cannon/src/Cannon/Types.hs b/services/cannon/src/Cannon/Types.hs index 4d0caab6f6..295160a601 100644 --- a/services/cannon/src/Cannon/Types.hs +++ b/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 diff --git a/services/cannon/src/Cannon/WS.hs b/services/cannon/src/Cannon/WS.hs index 2813a8fe69..553e9eba8c 100644 --- a/services/cannon/src/Cannon/WS.hs +++ b/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), diff --git a/services/cannon/test/Test/Cannon/Dict.hs b/services/cannon/test/Test/Cannon/Dict.hs index 051daf847c..0b4b4e8c46 100644 --- a/services/cannon/test/Test/Cannon/Dict.hs +++ b/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