From 99d0d146dd5679c663e7128a85ca6582c8a54554 Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Wed, 8 Jun 2022 07:10:02 +0000 Subject: [PATCH 01/29] Lint tools. --- .../src/Network/Wire/Simulations/SmokeTest.hs | 2 +- tools/bonanza/src/Bonanza/App.hs | 10 ++--- tools/bonanza/src/Bonanza/Geo.hs | 6 +-- tools/bonanza/src/Bonanza/Parser/CommonLog.hs | 6 +-- .../bonanza/src/Bonanza/Parser/Netstrings.hs | 7 ++-- tools/bonanza/src/Bonanza/Parser/Time.hs | 7 ++-- tools/bonanza/src/Bonanza/Parser/Tinylog.hs | 4 +- tools/bonanza/src/Bonanza/Streaming/Kibana.hs | 1 - tools/bonanza/src/Bonanza/Types.hs | 1 - .../test/unit/Test/Bonanza/Arbitrary.hs | 42 +++++++++---------- .../test/unit/Test/Bonanza/Streaming.hs | 9 ++-- tools/db/auto-whitelist/src/Work.hs | 3 +- tools/db/migrate-sso-feature-flag/src/Work.hs | 1 - tools/db/move-team/src/ParseSchema.hs | 16 +++---- tools/db/move-team/src/Types.hs | 1 - tools/db/repair-handles/src/Work.hs | 9 ++-- tools/db/service-backfill/src/Work.hs | 3 +- tools/rex/Main.hs | 10 ++--- 18 files changed, 62 insertions(+), 76 deletions(-) diff --git a/tools/api-simulations/smoketest/src/Network/Wire/Simulations/SmokeTest.hs b/tools/api-simulations/smoketest/src/Network/Wire/Simulations/SmokeTest.hs index dfc7b601be..f55335059b 100644 --- a/tools/api-simulations/smoketest/src/Network/Wire/Simulations/SmokeTest.hs +++ b/tools/api-simulations/smoketest/src/Network/Wire/Simulations/SmokeTest.hs @@ -110,7 +110,7 @@ mainBotNet n = do c <- getConv meetup assertEqual (Just True) - ((memOtrArchived . cmSelf . cnvMembers) <$> c) + (memOtrArchived . cmSelf . cnvMembers <$> c) "Archived update failed" info $ msg "Bill kicks and then re-adds Ally" runBotSession bill $ do diff --git a/tools/bonanza/src/Bonanza/App.hs b/tools/bonanza/src/Bonanza/App.hs index 0582839262..ba24e86c08 100644 --- a/tools/bonanza/src/Bonanza/App.hs +++ b/tools/bonanza/src/Bonanza/App.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} @@ -195,14 +194,12 @@ runBonanza = .| runDecompress decomp .| Conduit.mapM ( \bs -> - modifyIORef' bytes_in (+ fromIntegral (BS.length bs)) - *> pure bs + modifyIORef' bytes_in (+ fromIntegral (BS.length bs)) $> bs ) .| readWith parser .| Conduit.mapM ( \evt -> - modifyIORef' events_in (+ 1) - *> pure evt + modifyIORef' events_in (+ 1) $> evt ) .| runGeo geo geoDB .| runAnonymise anon @@ -210,8 +207,7 @@ runBonanza = .| runCompress comp .| Conduit.mapM ( \bs -> - modifyIORef' bytes_out (+ fromIntegral (BS.length bs)) - *> pure bs + modifyIORef' bytes_out (+ fromIntegral (BS.length bs)) $> bs ) .| sinkHandle stdout completed <- getCurrentTime diff --git a/tools/bonanza/src/Bonanza/Geo.hs b/tools/bonanza/src/Bonanza/Geo.hs index 106baff7fe..6e85565614 100644 --- a/tools/bonanza/src/Bonanza/Geo.hs +++ b/tools/bonanza/src/Bonanza/Geo.hs @@ -60,12 +60,10 @@ geolocate db t evt = .~ fmap (toJSON . toGeo) x ip :: Text -> LogEvent -> Maybe IP.IP -ip t = join . fmap parse . view (logTags . _Wrapped' . at (Key.fromText t)) +ip t = parse <=< view (logTags . _Wrapped' . at (Key.fromText t)) where parse = - join - . fmap (preview _Right . Safe.readEitherSafe . Text.unpack) - . preview _String + (preview _Right . Safe.readEitherSafe . Text.unpack) <=< preview _String toGeo :: GeoResult -> Geo toGeo GeoResult {..} = diff --git a/tools/bonanza/src/Bonanza/Parser/CommonLog.hs b/tools/bonanza/src/Bonanza/Parser/CommonLog.hs index 66d24fe644..9e47966b8e 100644 --- a/tools/bonanza/src/Bonanza/Parser/CommonLog.hs +++ b/tools/bonanza/src/Bonanza/Parser/CommonLog.hs @@ -127,7 +127,7 @@ commonLogRecord moreFieldParsers = do parseField name parser = do v <- optional parser _ <- skipHSpace - return $ maybe (name, CEmpty) ((,) name) v + return $ maybe (name, CEmpty) (name,) v field :: Parser TagValue -> Parser CommonLogField field p = emptyField <|> (go "field") @@ -139,7 +139,7 @@ field p = emptyField <|> (go "field") _ -> CField <$> p emptyField :: Parser CommonLogField -emptyField = const CEmpty <$> (string "\"-\"" <|> string "-") "empty field" +emptyField = CEmpty <$ ((string "\"-\"" <|> string "-") "empty field") stringField :: Parser CommonLogField stringField = emptyField <|> (go "string field") @@ -155,7 +155,7 @@ stringField = emptyField <|> (go "string field") (char '"' *> takeWhile1 (/= '"') <* char '"') "quoted string field" unquoted = - (takeWhile1 (not . isSpace)) + takeWhile1 (not . isSpace) "unquoted string field" intField :: Parser CommonLogField diff --git a/tools/bonanza/src/Bonanza/Parser/Netstrings.hs b/tools/bonanza/src/Bonanza/Parser/Netstrings.hs index 81b26baeba..6bdff69344 100644 --- a/tools/bonanza/src/Bonanza/Parser/Netstrings.hs +++ b/tools/bonanza/src/Bonanza/Parser/Netstrings.hs @@ -30,8 +30,7 @@ import Imports netstring :: Parser ByteString netstring = do len <- decimal <* char ':' - str <- A.take len <* char ',' <* skipWhile (== ' ') - pure str + A.take len <* char ',' <* skipWhile (== ' ') -- | Find pairs in a stream of netstrings. -- @@ -53,8 +52,8 @@ tagged sep = do strs <- many' netstring pure . reverse . fst $ foldl' go ([], False) strs where - go ((h : t), True) e = ((Just (snd h), e) : t, False) - go ([], _) e = ((Nothing, e) : [], False) + go (h : t, True) e = ((Just (snd h), e) : t, False) + go ([], _) e = ([(Nothing, e)], False) go (acc, False) e | is_sep e = (acc, True) | otherwise = ((Nothing, e) : acc, False) diff --git a/tools/bonanza/src/Bonanza/Parser/Time.hs b/tools/bonanza/src/Bonanza/Parser/Time.hs index cbd5aac74d..8aad8f54b4 100644 --- a/tools/bonanza/src/Bonanza/Parser/Time.hs +++ b/tools/bonanza/src/Bonanza/Parser/Time.hs @@ -28,6 +28,7 @@ where import Control.Applicative (optional) import Data.Attoparsec.ByteString.Char8 +import Data.Bifunctor (first) import qualified Data.List as List import Data.Time import Data.Time.Clock.POSIX @@ -36,7 +37,7 @@ import Imports hiding (take) tai64N :: Parser UTCTime tai64N = do - secs <- take 16 >>= int >>= return . subtract taiBase + secs <- (take 16 >>= int) <&> subtract taiBase nano <- take 8 >>= int let t = posixSecondsToUTCTime $ posix secs nano l = (-1) * fromIntegral (leapSeconds t) @@ -46,7 +47,7 @@ tai64N = do int bs = either (const $ fail "not a hexadecimal number") - (return . id) + return (parseOnly hexadecimal bs) posix :: Integer -> Integer -> POSIXTime posix secs nano = @@ -132,7 +133,7 @@ leapSeconds = fromMaybe def . leapSecondsMap . utctDay -- Source: https://www.ietf.org/timezones/data/leap-seconds.list leapSecondsMap :: LeapSecondMap -leapSecondsMap v = List.lookup v $ map (\(x, y) -> (read x, y)) leap +leapSecondsMap v = List.lookup v $ map (first read) leap where leap = [ ("1972-01-01", 10), diff --git a/tools/bonanza/src/Bonanza/Parser/Tinylog.hs b/tools/bonanza/src/Bonanza/Parser/Tinylog.hs index 39f488293d..9313a13e2e 100644 --- a/tools/bonanza/src/Bonanza/Parser/Tinylog.hs +++ b/tools/bonanza/src/Bonanza/Parser/Tinylog.hs @@ -127,7 +127,7 @@ tinyFields = pair `sepBy` char sep _ -> do k <- optional $ takeWhile1 (\c -> c /= '\n' && c /= '=') <* char '=' q' <- peekChar - let tup = (,) ((T.strip . toText) <$> k) + let tup = (,) (T.strip . toText <$> k) tup <$> case q' of Just y | y == '"' -> quoted' <* skipToSepOrEnd _ -> unquoted @@ -145,7 +145,7 @@ tinyFieldsNetstr = map (bimap (fmap toText) toText) <$> tagged '=' -- Internal filterFields :: [(Maybe Text, Text)] -> [(Text, Text)] -filterFields = mapMaybe (\(k, v) -> flip (,) v `fmap` k) +filterFields = mapMaybe (\(k, v) -> (,v) <$> k) {-# INLINEABLE filterFields #-} filterMessage :: [(Maybe Text, Text)] -> [Text] diff --git a/tools/bonanza/src/Bonanza/Streaming/Kibana.hs b/tools/bonanza/src/Bonanza/Streaming/Kibana.hs index af6dafc172..d940ed6491 100644 --- a/tools/bonanza/src/Bonanza/Streaming/Kibana.hs +++ b/tools/bonanza/src/Bonanza/Streaming/Kibana.hs @@ -1,6 +1,5 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE StandaloneDeriving #-} diff --git a/tools/bonanza/src/Bonanza/Types.hs b/tools/bonanza/src/Bonanza/Types.hs index 1320d5f93a..4ee69b2741 100644 --- a/tools/bonanza/src/Bonanza/Types.hs +++ b/tools/bonanza/src/Bonanza/Types.hs @@ -1,7 +1,6 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} -{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} diff --git a/tools/bonanza/test/unit/Test/Bonanza/Arbitrary.hs b/tools/bonanza/test/unit/Test/Bonanza/Arbitrary.hs index 6c43687061..a6e7a1daba 100644 --- a/tools/bonanza/test/unit/Test/Bonanza/Arbitrary.hs +++ b/tools/bonanza/test/unit/Test/Bonanza/Arbitrary.hs @@ -328,7 +328,7 @@ mkSvInput df rec msg = msg ] -instance Arbitrary (ParseInput (NginzLogRecord)) where +instance Arbitrary (ParseInput NginzLogRecord) where arbitrary = do raddr <- genIPv4Field ruser <- genStringField @@ -365,25 +365,24 @@ instance Arbitrary (ParseInput (NginzLogRecord)) where where genFields :: Gen [(Text, CommonLogField)] genFields = - sequence $ - map - (\(f, g) -> (f,) <$> g) - [ ("status", genIntField), - ("body_bytes_sent", genIntField), - ("http_referer", genStringField), - ("http_user_agent", genStringField), - ("http_x_forwarded_for", genIPv4Field), - ("separator", genEmptyField), - ("connection", genIntField), - ("request_time", genDoubleField), - ("upstream_response_time", genDoubleField), - ("upstream_cache_status", genStringField), - ("user", genStringField), - ("zconn", genStringField), - ("request", genStringField), - ("proxy_protocol_addr", genIPv4Field), - ("tracestate", genStringField) - ] + mapM + (\(f, g) -> (f,) <$> g) + [ ("status", genIntField), + ("body_bytes_sent", genIntField), + ("http_referer", genStringField), + ("http_user_agent", genStringField), + ("http_x_forwarded_for", genIPv4Field), + ("separator", genEmptyField), + ("connection", genIntField), + ("request_time", genDoubleField), + ("upstream_response_time", genDoubleField), + ("upstream_cache_status", genStringField), + ("user", genStringField), + ("zconn", genStringField), + ("request", genStringField), + ("proxy_protocol_addr", genIPv4Field), + ("tracestate", genStringField) + ] genIntField :: Gen CommonLogField genIntField = maybe CEmpty (CField . Number . fromIntegral . getNonNegative) @@ -478,8 +477,7 @@ mkSockInput df rec msg = mconcat [ "|", BC.intercalate "," - . map (\(k, v) -> BC.intercalate "=" [k, v]) - . map (encodeUtf8 *** encodeUtf8) + . map ((\(k, v) -> BC.intercalate "=" [k, v]) . (encodeUtf8 *** encodeUtf8)) $ sockTags rec, "|" ], diff --git a/tools/bonanza/test/unit/Test/Bonanza/Streaming.hs b/tools/bonanza/test/unit/Test/Bonanza/Streaming.hs index c1ce07b44e..550cce9fd4 100644 --- a/tools/bonanza/test/unit/Test/Bonanza/Streaming.hs +++ b/tools/bonanza/test/unit/Test/Bonanza/Streaming.hs @@ -112,10 +112,11 @@ run_prop :: run_prop p i = ioProperty $ runConduit $ - Conduit.sourceLbs inp - .| P.stream (P.MkParser p) - .| Conduit.consume - >>= pure . (=== out) . map secs + ( Conduit.sourceLbs inp + .| P.stream (P.MkParser p) + .| Conduit.consume + ) + <&> ((=== out) . map secs) where inp = BL.fromStrict . B.intercalate "\n" $ map (snd . parseInput) i out = map (secs . toLogEvent . fst . parseInput) i diff --git a/tools/db/auto-whitelist/src/Work.hs b/tools/db/auto-whitelist/src/Work.hs index b57456ebcc..d824d974dd 100644 --- a/tools/db/auto-whitelist/src/Work.hs +++ b/tools/db/auto-whitelist/src/Work.hs @@ -1,5 +1,4 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} @@ -57,7 +56,7 @@ getServices = retry x5 $ query cql (params LocalQuorum ()) -- | Check if a service exists doesServiceExist :: (ProviderId, ServiceId, a) -> Client Bool doesServiceExist (pid, sid, _) = - retry x5 $ fmap isJust $ query1 cql (params LocalQuorum (pid, sid)) + retry x5 $ isJust <$> query1 cql (params LocalQuorum (pid, sid)) where cql :: PrepQuery R (ProviderId, ServiceId) (Identity ServiceId) cql = diff --git a/tools/db/migrate-sso-feature-flag/src/Work.hs b/tools/db/migrate-sso-feature-flag/src/Work.hs index e62edb9aa2..37d3d29812 100644 --- a/tools/db/migrate-sso-feature-flag/src/Work.hs +++ b/tools/db/migrate-sso-feature-flag/src/Work.hs @@ -1,5 +1,4 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} diff --git a/tools/db/move-team/src/ParseSchema.hs b/tools/db/move-team/src/ParseSchema.hs index 369bd985e2..38405f12e0 100644 --- a/tools/db/move-team/src/ParseSchema.hs +++ b/tools/db/move-team/src/ParseSchema.hs @@ -167,14 +167,14 @@ argParser :: OA.Parser Arguments argParser = Arguments <$> OA.argument OA.str (OA.metavar "SCHEMA_FILE") - <*> ( optional $ - OA.strOption - ( OA.long "output" - <> OA.short 'o' - <> OA.metavar "FILE" - <> OA.help "Write output to FILE" - ) - ) + <*> optional + ( OA.strOption + ( OA.long "output" + <> OA.short 'o' + <> OA.metavar "FILE" + <> OA.help "Write output to FILE" + ) + ) moduleTemplate :: Text moduleTemplate = diff --git a/tools/db/move-team/src/Types.hs b/tools/db/move-team/src/Types.hs index 44ec7d6dc6..863db9327b 100644 --- a/tools/db/move-team/src/Types.hs +++ b/tools/db/move-team/src/Types.hs @@ -1,7 +1,6 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeApplications #-} diff --git a/tools/db/repair-handles/src/Work.hs b/tools/db/repair-handles/src/Work.hs index 86f95c576c..cf5c1dced6 100644 --- a/tools/db/repair-handles/src/Work.hs +++ b/tools/db/repair-handles/src/Work.hs @@ -60,7 +60,7 @@ type HandleMap = Map UserId [Handle] readHandleMap :: Env -> IO HandleMap readHandleMap Env {..} = runConduit $ - (transPipe (runClient envBrig) $ paginateC selectUserHandle (paramsP LocalQuorum () envPageSize) x1) + transPipe (runClient envBrig) (paginateC selectUserHandle (paramsP LocalQuorum () envPageSize) x1) .| (C.foldM insertAndLog (Map.empty, 0) <&> fst) where selectUserHandle :: PrepQuery R () (Maybe UserId, Maybe Handle) @@ -120,10 +120,11 @@ decideAction uid (Just currentHandle) handles = sourceActions :: Env -> HandleMap -> ConduitM () ActionResult IO () sourceActions Env {..} hmap = - ( transPipe (runClient envGalley) $ - paginateC selectTeam (paramsP LocalQuorum (pure envTeam) envPageSize) x5 + transPipe + (runClient envGalley) + ( paginateC selectTeam (paramsP LocalQuorum (pure envTeam) envPageSize) x5 .| C.map (fmap runIdentity) - ) + ) .| C.mapM readUsersPage .| C.concat .| C.map diff --git a/tools/db/service-backfill/src/Work.hs b/tools/db/service-backfill/src/Work.hs index a5636a1e6c..a711b1520e 100644 --- a/tools/db/service-backfill/src/Work.hs +++ b/tools/db/service-backfill/src/Work.hs @@ -1,5 +1,4 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} @@ -73,7 +72,7 @@ resolveBot :: Client (Maybe (ProviderId, ServiceId, BotId, ConvId, Maybe TeamId)) resolveBot (Just pid, Just sid, bid, cid) = do tid <- retry x5 $ query1 teamSelect (params LocalQuorum (Identity cid)) - pure (Just (pid, sid, bid, cid, join (fmap runIdentity tid))) + pure (Just (pid, sid, bid, cid, runIdentity =<< tid)) where teamSelect :: PrepQuery R (Identity ConvId) (Identity (Maybe TeamId)) teamSelect = "SELECT team FROM conversation WHERE conv = ?" diff --git a/tools/rex/Main.hs b/tools/rex/Main.hs index 70daf4d335..9820c80fe8 100644 --- a/tools/rex/Main.hs +++ b/tools/rex/Main.hs @@ -1,5 +1,4 @@ {-# LANGUAGE BangPatterns #-} -{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -Wno-incomplete-patterns #-} @@ -32,6 +31,7 @@ import Data.Bitraversable import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as ByteString import Data.Foldable +import Data.Functor (($>)) import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap import Data.IP @@ -53,8 +53,7 @@ import Options.Applicative import System.Clock import qualified System.Logger as Log import System.Logger.Message (msg, val) --- this library sucks -import System.Metrics.Prometheus.Concurrent.RegistryT +import System.Metrics.Prometheus.Concurrent.RegistryT -- this library sucks import System.Metrics.Prometheus.Encode.Text import qualified System.Metrics.Prometheus.Metric.Counter as Counter import System.Metrics.Prometheus.Metric.Gauge (Gauge) @@ -226,8 +225,7 @@ getSocketStats :: Word16 -> IO (Maybe SocketStats) getSocketStats port = do pnu <- Text.readFile "/proc/net/udp" return - . listToMaybe - . filter ((== port) . lPort) + . find ((== port) . lPort) . map (mk . Text.words) . drop 1 $ Text.lines pnu @@ -337,7 +335,7 @@ getPeerConnectivityStats lgr seed dom = do ) shakehands (addr, port) = - handleIOError (\e -> logUnreachable addr port e *> pure Nothing) + handleIOError (\e -> logUnreachable addr port e $> Nothing) . timeout (5 * 1000000) $ bracket (socket AF_INET Stream defaultProtocol) From 8244f40c6607a08da7b07aa1339dade7fc0cac42 Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Wed, 8 Jun 2022 07:35:56 +0000 Subject: [PATCH 02/29] r/return/pure ;) --- .../lib/src/Network/Wire/Simulations.hs | 24 +++++++------- .../src/Network/Wire/Simulations/LoadTest.hs | 14 ++++---- .../src/Network/Wire/Simulations/SmokeTest.hs | 4 +-- tools/bonanza/main/Kibanana.hs | 4 +-- tools/bonanza/src/Bonanza/Parser/CommonLog.hs | 6 ++-- tools/bonanza/src/Bonanza/Parser/IP.hs | 2 +- tools/bonanza/src/Bonanza/Parser/Rkt.hs | 2 +- tools/bonanza/src/Bonanza/Parser/Time.hs | 32 +++++++++---------- tools/bonanza/src/Bonanza/Parser/Tinylog.hs | 6 ++-- tools/bonanza/src/Bonanza/Streaming/Binary.hs | 2 +- tools/bonanza/src/Bonanza/Streaming/Kibana.hs | 4 +-- tools/bonanza/src/Bonanza/Streaming/Parser.hs | 4 +-- .../bonanza/src/Bonanza/Streaming/Protobuf.hs | 4 +-- .../test/unit/Test/Bonanza/Arbitrary.hs | 20 ++++++------ tools/db/assets/src/Assets/Lib.hs | 2 +- tools/db/find-undead/src/Work.hs | 10 +++--- tools/makedeb/src/System/MakeDeb/FileUtils.hs | 2 +- tools/rex/Main.hs | 4 +-- 18 files changed, 73 insertions(+), 73 deletions(-) diff --git a/tools/api-simulations/lib/src/Network/Wire/Simulations.hs b/tools/api-simulations/lib/src/Network/Wire/Simulations.hs index 8bd692a632..10635b3635 100644 --- a/tools/api-simulations/lib/src/Network/Wire/Simulations.hs +++ b/tools/api-simulations/lib/src/Network/Wire/Simulations.hs @@ -83,7 +83,7 @@ prepareConv (a : bs) = do conv <- qUnqualified . cnvQualifiedId <$> runBotSession a (createConv bIds Nothing) lconv <- qualifyLocal conv assertConvCreated lconv a bs - return conv + pure conv -- | Make sure that there is a connection between two bots. connectIfNeeded :: Bot -> Bot -> BotNet () @@ -93,7 +93,7 @@ connectIfNeeded = go 6 -- six turns should be enough -- (first one side takes a step towards a connection, then another, -- etc). If we make more than N turns, we give up. go :: Int -> Bot -> Bot -> BotNet () - go 0 _ _ = return () + go 0 _ _ = pure () go n a b = do connected <- runBotSession a $ do s <- fmap ucStatus <$> getConnection (botId b) @@ -102,16 +102,16 @@ connectIfNeeded = go 6 -- six turns should be enough Nothing -> do void $ connectTo (ConnectionRequest (botId b) (unsafeRange (fromMaybe "" (botEmail a)))) assertConnectRequested a b - return False + pure False -- If there's a pending connection to us: accept it Just Pending -> do void $ updateConnection (botId b) (ConnectionUpdate Accepted) assertConnectAccepted a b - return True + pure True -- If we have sent a request, we can't do anything - Just Sent -> return False + Just Sent -> pure False -- In case of any other status, we pretend it's good - _ -> return True + _ -> pure True unless connected (go (n - 1) b a) -------------------------------------------------------------------------------- @@ -133,7 +133,7 @@ instance Serialize BotMessage where bs <- remaining >>= getByteString either (fail . show) - (return . BotTextMessage) + (pure . BotTextMessage) (Text.decodeUtf8' bs) 2 -> BotAssetMessage <$> get _ -> fail $ "Unexpected message type: " ++ show t @@ -161,17 +161,17 @@ instance Serialize AssetInfo where k <- maybe (fail "Invalid asset key") - return + pure (fromByteString kbs) tlen <- getWord16be t <- if tlen == 0 - then return Nothing + then pure Nothing else do tbs <- getByteString (fromIntegral tlen) maybe (fail "Invalid asset token") - (return . Just) + (pure . Just) (fromByteString tbs) AssetInfo k t <$> get @@ -188,14 +188,14 @@ requireAssetMsg :: MonadThrow m => ByteString -> m AssetInfo requireAssetMsg bs = do m <- requireMessage bs case m of - BotAssetMessage info -> return info + BotAssetMessage info -> pure info x -> throwM $ RequirementFailed ("Unexpected message: " <> Text.pack (show x)) requireTextMsg :: MonadThrow m => ByteString -> m Text requireTextMsg bs = do m <- requireMessage bs case m of - BotTextMessage t -> return t + BotTextMessage t -> pure t x -> throwM $ RequirementFailed ("Unexpected message: " <> Text.pack (show x)) requireMessage :: MonadThrow m => ByteString -> m BotMessage diff --git a/tools/api-simulations/loadtest/src/Network/Wire/Simulations/LoadTest.hs b/tools/api-simulations/loadtest/src/Network/Wire/Simulations/LoadTest.hs index f7a386d804..fea1d222af 100644 --- a/tools/api-simulations/loadtest/src/Network/Wire/Simulations/LoadTest.hs +++ b/tools/api-simulations/loadtest/src/Network/Wire/Simulations/LoadTest.hs @@ -68,7 +68,7 @@ runLoadTest s = (conversationMinPassiveMembers s) (conversationMaxPassiveMembers s) -- since we use 'cachedBot' here, all returned accounts will be distinct - return + pure ( [cachedBot (fromString ("bot" <> show i)) | i <- [1 .. active]], [cachedBot (fromString ("passiveBot" <> show i)) | i <- [1 .. passive]] ) @@ -101,7 +101,7 @@ runConv s g = do otherClients <- for [1 .. nClients - 1] $ \i -> do let label = "client-" <> Text.pack (show i) <> "-" <> UUID.toText uniq addBotClient b PermanentClientType (Just label) - return $! BotState mainClient otherClients conv bots nmsg nast + pure $! BotState mainClient otherClients conv bots nmsg nast -- Run ----------------------------- log Info $ msg $ val "Running" pooledForConcurrentlyN_ (parallelRequests s) (zip bots states) $ \(b, st) -> @@ -124,15 +124,15 @@ runConv s g = do drainBot b runBot :: LoadTestSettings -> BotState -> BotSession () -runBot _ BotState {..} | done = return () +runBot _ BotState {..} | done = pure () where done = messagesLeft <= 0 && assetsLeft <= 0 runBot ls s@BotState {..} = do liftIO . threadDelay $ stepDelay ls runBot ls =<< if messagesLeft >= assetsLeft - then postMsg >> return s {messagesLeft = messagesLeft - 1} - else postAst >> return s {assetsLeft = assetsLeft - 1} + then postMsg >> pure s {messagesLeft = messagesLeft - 1} + else postAst >> pure s {assetsLeft = assetsLeft - 1} where postMsg = do self <- getBot @@ -178,10 +178,10 @@ runBot ls s@BotState {..} = do assertEqual plainData' (Just plainData) "OTR asset plaintext mismatch" mkMsg = do l <- between (messageMinLength ls) (messageMaxLength ls) - return $ Text.replicate l "A" + pure $ Text.replicate l "A" mkAst = do l <- between (assetMinSize ls) (assetMaxSize ls) - return $ BS.replicate (fromIntegral l) 42 + pure $ BS.replicate (fromIntegral l) 42 data BotState = BotState { botClient :: !BotClient, -- "main" client (sends messages, etc) diff --git a/tools/api-simulations/smoketest/src/Network/Wire/Simulations/SmokeTest.hs b/tools/api-simulations/smoketest/src/Network/Wire/Simulations/SmokeTest.hs index f55335059b..02da54b0b8 100644 --- a/tools/api-simulations/smoketest/src/Network/Wire/Simulations/SmokeTest.hs +++ b/tools/api-simulations/smoketest/src/Network/Wire/Simulations/SmokeTest.hs @@ -77,7 +77,7 @@ mainBotNet n = do -- number of un-accepted connections a user can have; in this case -- the test would have to be rewritten slightly a2goons <- mapM allyConnectTo goons - return (a2b, a2c, a2goons) + pure (a2b, a2c, a2goons) -- Accept a connection request from Ally let allyAccept :: Bot -> BotNet () allyAccept user = runBotSession user $ do @@ -91,7 +91,7 @@ mainBotNet n = do conv <- qUnqualified . cnvQualifiedId <$> createConv (map botId others) (Just "Meetup") lconv <- qualifyLocal conv assertConvCreated lconv ally others - return conv + pure conv info $ msg "Bill updates his member state" localDomain <- viewFederationDomain runBotSession bill $ do diff --git a/tools/bonanza/main/Kibanana.hs b/tools/bonanza/main/Kibanana.hs index c09241ae56..3a877baae6 100644 --- a/tools/bonanza/main/Kibanana.hs +++ b/tools/bonanza/main/Kibanana.hs @@ -131,12 +131,12 @@ main = chunk <- atomically $ readTVar s >>= \case - Stop -> return Seq.empty + Stop -> pure Seq.empty Go -> do (now, later) <- Seq.splitAt i <$> readTVar b if Seq.null now then retry - else writeTVar b later >> return now + else writeTVar b later >> pure now unless (Seq.null chunk) $ do let body = requestBodySourceChunked (mapM_ yield chunk) let req = r {requestBody = body} diff --git a/tools/bonanza/src/Bonanza/Parser/CommonLog.hs b/tools/bonanza/src/Bonanza/Parser/CommonLog.hs index 9e47966b8e..79f7fce6d5 100644 --- a/tools/bonanza/src/Bonanza/Parser/CommonLog.hs +++ b/tools/bonanza/src/Bonanza/Parser/CommonLog.hs @@ -105,7 +105,7 @@ commonLogRecord moreFieldParsers = do time <- commonLogDate <* ws req <- dq *> request <* dq <* ws flds <- mapM (uncurry parseField) fields - return + pure CommonLogRecord { cTime = time, cFields = @@ -127,7 +127,7 @@ commonLogRecord moreFieldParsers = do parseField name parser = do v <- optional parser _ <- skipHSpace - return $ maybe (name, CEmpty) (name,) v + pure $ maybe (name, CEmpty) (name,) v field :: Parser TagValue -> Parser CommonLogField field p = emptyField <|> (go "field") @@ -177,7 +177,7 @@ request = do p <- takeWhile1 (\c -> c /= '?' && c /= ' ') q <- optional $ char '?' *> takeWhile1 (/= ' ') _ <- skipSpace *> string "HTTP/1." *> choice [char '0', char '1'] - return $ HttpRequest m (toText p) (fmap toText q) + pure $ HttpRequest m (toText p) (fmap toText q) method :: Parser StdMethod method = takeWhile1 isUpper >>= either (fail . unpack) pure . parseMethod diff --git a/tools/bonanza/src/Bonanza/Parser/IP.hs b/tools/bonanza/src/Bonanza/Parser/IP.hs index 5e832d0e0f..67f3c4e53b 100644 --- a/tools/bonanza/src/Bonanza/Parser/IP.hs +++ b/tools/bonanza/src/Bonanza/Parser/IP.hs @@ -68,7 +68,7 @@ octet :: Parser Word16 octet = do x <- decimal guard (0 <= x && x < 256) - return x + pure x showIPv4Text :: IPv4 -> Text showIPv4Text (IPv4 ip) = diff --git a/tools/bonanza/src/Bonanza/Parser/Rkt.hs b/tools/bonanza/src/Bonanza/Parser/Rkt.hs index a388672c72..89ae24ed46 100644 --- a/tools/bonanza/src/Bonanza/Parser/Rkt.hs +++ b/tools/bonanza/src/Bonanza/Parser/Rkt.hs @@ -58,4 +58,4 @@ rktLogRecord = do srv <- (toText <$> takeTill (== '[')) <* char '[' <* scientific <* char ']' <* char ':' <* skipSpace tags <- option [] (try svTags') msg <- strip . toText <$> takeTill (== '\n') - return $ RktLogRecord up srv tags msg + pure $ RktLogRecord up srv tags msg diff --git a/tools/bonanza/src/Bonanza/Parser/Time.hs b/tools/bonanza/src/Bonanza/Parser/Time.hs index 8aad8f54b4..93723d916a 100644 --- a/tools/bonanza/src/Bonanza/Parser/Time.hs +++ b/tools/bonanza/src/Bonanza/Parser/Time.hs @@ -41,13 +41,13 @@ tai64N = do nano <- take 8 >>= int let t = posixSecondsToUTCTime $ posix secs nano l = (-1) * fromIntegral (leapSeconds t) - return $ addUTCTime l t + pure $ addUTCTime l t where int :: ByteString -> Parser Integer int bs = either (const $ fail "not a hexadecimal number") - return + pure (parseOnly hexadecimal bs) posix :: Integer -> Integer -> POSIXTime posix secs nano = @@ -69,7 +69,7 @@ isoTime = do s <- decimal u <- option 0 (char '.' *> decimal) _ <- optional (string "Z" <|> string "+0000") - return . picosecondsToDiffTime $ + pure . picosecondsToDiffTime $ toPico h fHour + toPico m fMinute + toPico s fSecond @@ -89,20 +89,20 @@ commonLogDate = do let ld = fromGregorian y m d lt = TimeOfDay h m' (fromInteger s) tz = hoursToTimeZone z - in return $ localTimeToUTC tz (LocalTime ld lt) + in pure $ localTimeToUTC tz (LocalTime ld lt) where - month "Jan" = return 1 - month "Feb" = return 2 - month "Mar" = return 3 - month "Apr" = return 4 - month "May" = return 5 - month "Jun" = return 6 - month "Jul" = return 7 - month "Aug" = return 8 - month "Sep" = return 9 - month "Oct" = return 10 - month "Nov" = return 11 - month "Dec" = return 12 + month "Jan" = pure 1 + month "Feb" = pure 2 + month "Mar" = pure 3 + month "Apr" = pure 4 + month "May" = pure 5 + month "Jun" = pure 6 + month "Jul" = pure 7 + month "Aug" = pure 8 + month "Sep" = pure 9 + month "Oct" = pure 10 + month "Nov" = pure 11 + month "Dec" = pure 12 month x = fail $ "not a valid month name: " ++ show x -------------------------------------------------------------------------------- diff --git a/tools/bonanza/src/Bonanza/Parser/Tinylog.hs b/tools/bonanza/src/Bonanza/Parser/Tinylog.hs index 9313a13e2e..adf224e4da 100644 --- a/tools/bonanza/src/Bonanza/Parser/Tinylog.hs +++ b/tools/bonanza/src/Bonanza/Parser/Tinylog.hs @@ -66,7 +66,7 @@ tinyLogRecord = tinyLogRecordNetstr <|> tinyLogRecordLegacy <|> tinyLogCatchAll tinyLogCatchAll :: Parser TinyLogRecord tinyLogCatchAll = do ms <- T.strip . toText <$> takeTill (== '\n') - return + pure TinyLogRecord { tDate = Nothing, tLevel = 'T', @@ -79,7 +79,7 @@ tinyLogRecordLegacy = do dt <- optional date lv <- tinyLevel fs <- tinyFields <* (endOfLine <|> endOfInput) - return + pure TinyLogRecord { tDate = dt, tLevel = lv, @@ -92,7 +92,7 @@ tinyLogRecordNetstr = do dt <- optional dateNetstr lv <- tinyLevelNetstr fs <- tinyFieldsNetstr <* (endOfLine <|> endOfInput) - return + pure TinyLogRecord { tDate = dt, tLevel = lv, diff --git a/tools/bonanza/src/Bonanza/Streaming/Binary.hs b/tools/bonanza/src/Bonanza/Streaming/Binary.hs index 80500549a8..4df423568f 100644 --- a/tools/bonanza/src/Bonanza/Streaming/Binary.hs +++ b/tools/bonanza/src/Bonanza/Streaming/Binary.hs @@ -40,7 +40,7 @@ decode g = start start = do mx <- await case mx of - Nothing -> return () + Nothing -> pure () Just x -> go (runGetIncremental g `pushChunk` x) go (Fail u o e) = throwM $ ParseError u o e go (Partial n) = await >>= go . n diff --git a/tools/bonanza/src/Bonanza/Streaming/Kibana.hs b/tools/bonanza/src/Bonanza/Streaming/Kibana.hs index d940ed6491..75eb2d9720 100644 --- a/tools/bonanza/src/Bonanza/Streaming/Kibana.hs +++ b/tools/bonanza/src/Bonanza/Streaming/Kibana.hs @@ -92,7 +92,7 @@ instance ToJSON KibanaEvent where fromLogEvent :: LogEvent -> IO KibanaEvent fromLogEvent evt = do ts <- utcToZonedTime utc <$> maybe getCurrentTime pure (evt ^. logTime) - return + pure KibanaEvent { esTimestamp = ts, esOrigin = fromMaybe thisHost (evt ^. logOrigin), @@ -159,7 +159,7 @@ thisHost = unsafePerformIO $ do (Just defaultHints {addrFlags = [AI_CANONNAME]}) (Just localhost) Nothing - return . Host . pack + pure . Host . pack . fromMaybe localhost . head' . mapMaybe addrCanonName diff --git a/tools/bonanza/src/Bonanza/Streaming/Parser.hs b/tools/bonanza/src/Bonanza/Streaming/Parser.hs index da64a3d0e7..2f3687940e 100644 --- a/tools/bonanza/src/Bonanza/Streaming/Parser.hs +++ b/tools/bonanza/src/Bonanza/Streaming/Parser.hs @@ -70,13 +70,13 @@ jsonParser = do js <- AB.skipSpace *> json' <* AB.skipSpace case fromJSON js of Error e -> fail e - Success a -> return a + Success a -> pure a stream :: Monad m => Parser -> ConduitT ByteString LogEvent m () stream (MkParser p) = next where next = Conduit.await >>= go - go Nothing = return () + go Nothing = pure () go (Just b) | BC.null b = next | otherwise = run b >>= finish b diff --git a/tools/bonanza/src/Bonanza/Streaming/Protobuf.hs b/tools/bonanza/src/Bonanza/Streaming/Protobuf.hs index 80de54d099..988f398f0a 100644 --- a/tools/bonanza/src/Bonanza/Streaming/Protobuf.hs +++ b/tools/bonanza/src/Bonanza/Streaming/Protobuf.hs @@ -55,7 +55,7 @@ decodeLengthPrefixedMessage = do bs <- getBytes $ fromIntegral (len :: Int64) case runGetState decodeMessage bs 0 of Right (a, bs') - | BS.null bs' -> return (Decoded a) - | otherwise -> return (Truncated a) + | BS.null bs' -> pure (Decoded a) + | otherwise -> pure (Truncated a) Left e -> fail e {-# INLINE decodeLengthPrefixedMessage #-} diff --git a/tools/bonanza/test/unit/Test/Bonanza/Arbitrary.hs b/tools/bonanza/test/unit/Test/Bonanza/Arbitrary.hs index a6e7a1daba..cde85504b8 100644 --- a/tools/bonanza/test/unit/Test/Bonanza/Arbitrary.hs +++ b/tools/bonanza/test/unit/Test/Bonanza/Arbitrary.hs @@ -274,7 +274,7 @@ instance Arbitrary (ParseInput TinyLogRecord) where map (\(k, v) -> alnum k <> "=" <> fieldValue v) fields ++ [message] ] - return $ ParseInput (rec, inp) + pure $ ParseInput (rec, inp) where stripQuotes t = case T.strip t of t' @@ -294,7 +294,7 @@ instance Arbitrary (ParseInput (SvLogRecord Text)) where svMessage = T.strip message } inp = mkSvInput df rec (encodeUtf8 message) - return $ ParseInput (rec, inp) + pure $ ParseInput (rec, inp) instance Arbitrary (ParseInput (SvLogRecord TinyLogRecord)) where arbitrary = do @@ -310,7 +310,7 @@ instance Arbitrary (ParseInput (SvLogRecord TinyLogRecord)) where let rec = sv {svMessage = tiny} inp = mkSvInput df rec tinyIn - return $ ParseInput (rec, inp) + pure $ ParseInput (rec, inp) mkSvInput :: DateFormat -> SvLogRecord a -> ByteString -> ByteString mkSvInput df rec msg = @@ -361,7 +361,7 @@ instance Arbitrary (ParseInput NginzLogRecord) where ] ] ++ map (unField . snd) fields - return $ ParseInput (NginzLogRecord rec, inp) + pure $ ParseInput (NginzLogRecord rec, inp) where genFields :: Gen [(Text, CommonLogField)] genFields = @@ -441,7 +441,7 @@ instance Arbitrary (ParseInput (SockLogRecord (SvLogRecord Text))) where sockMessage = sv } inp = mkSockInput df rec svIn - return $ ParseInput (rec, inp) + pure $ ParseInput (rec, inp) instance Arbitrary (ParseInput (SockLogRecord (SvLogRecord TinyLogRecord))) where arbitrary = do @@ -463,7 +463,7 @@ instance Arbitrary (ParseInput (SockLogRecord (SvLogRecord TinyLogRecord))) wher sockMessage = sv } inp = mkSockInput df rec svIn - return $ ParseInput (rec, inp) + pure $ ParseInput (rec, inp) mkSockInput :: DateFormat -> SockLogRecord a -> ByteString -> ByteString mkSockInput df rec msg = @@ -505,7 +505,7 @@ instance Arbitrary (ParseInput TaggedNetstring) where arbitrary = do tns <- arbitrary let inp = B.concat . map netstr' . taggedNetstring $ tns - return $ ParseInput (tns, inp) + pure $ ParseInput (tns, inp) where netstr' (Nothing, v) = netstr . taggedValue $ v netstr' (Just k, v) = @@ -561,7 +561,7 @@ instance Arbitrary (ParseInput TinylogNetstr) where f = flip map fields $ \(k, v) -> case k of Just k' -> mconcat . map netstr $ [taggedValue k', "=", taggedValue v] Nothing -> netstr (taggedValue v) - return $ ParseInput (rec, inp) + pure $ ParseInput (rec, inp) instance Arbitrary (ParseInput (SvLogRecord TinylogNetstr)) where arbitrary = do @@ -572,7 +572,7 @@ instance Arbitrary (ParseInput (SvLogRecord TinylogNetstr)) where `suchThat` (isJust . svTime . fst . parseInput) let rec = sv {svMessage = tiny} inp = mkSvInput df rec tinyIn - return $ ParseInput (rec, inp) + pure $ ParseInput (rec, inp) instance Arbitrary (ParseInput (SockLogRecord (SvLogRecord TinylogNetstr))) where arbitrary = do @@ -594,7 +594,7 @@ instance Arbitrary (ParseInput (SockLogRecord (SvLogRecord TinylogNetstr))) wher sockMessage = sv } inp = mkSockInput df rec svIn - return $ ParseInput (rec, inp) + pure $ ParseInput (rec, inp) -------------------------------------------------------------------------------- -- Reduce timestamp precision diff --git a/tools/db/assets/src/Assets/Lib.hs b/tools/db/assets/src/Assets/Lib.hs index 7c018cea28..f150e90ed6 100644 --- a/tools/db/assets/src/Assets/Lib.hs +++ b/tools/db/assets/src/Assets/Lib.hs @@ -148,7 +148,7 @@ instance Cql AssetText where t <- required "typ" k <- required "key" case (t :: Int32) of - 0 -> return $! ImageAssetText k + 0 -> pure $! ImageAssetText k _ -> Left $ "unexpected user asset type: " ++ show t where required :: Cql r => Text -> Either String r diff --git a/tools/db/find-undead/src/Work.hs b/tools/db/find-undead/src/Work.hs index cd3ff8a347..d7b366efdb 100644 --- a/tools/db/find-undead/src/Work.hs +++ b/tools/db/find-undead/src/Work.hs @@ -136,10 +136,10 @@ instance Cql AccountStatus where toCql PendingInvitation = CqlInt 4 fromCql (CqlInt i) = case i of - 0 -> return Active - 1 -> return Suspended - 2 -> return Deleted - 3 -> return Ephemeral - 4 -> return PendingInvitation + 0 -> pure Active + 1 -> pure Suspended + 2 -> pure Deleted + 3 -> pure Ephemeral + 4 -> pure PendingInvitation n -> Left $ "unexpected account status: " ++ show n fromCql _ = Left "account status: int expected" diff --git a/tools/makedeb/src/System/MakeDeb/FileUtils.hs b/tools/makedeb/src/System/MakeDeb/FileUtils.hs index fc2729ef4c..bf7c97e5e0 100644 --- a/tools/makedeb/src/System/MakeDeb/FileUtils.hs +++ b/tools/makedeb/src/System/MakeDeb/FileUtils.hs @@ -28,7 +28,7 @@ foldFiles f !a !d = do case c of (True, True, False) -> f a d (True, False, True) -> foldDir - _ -> return a + _ -> pure a where foldDir = do xs <- map (d ) . filter dots <$> liftIO (getDirectoryContents d) diff --git a/tools/rex/Main.hs b/tools/rex/Main.hs index 9820c80fe8..82c9f3ded1 100644 --- a/tools/rex/Main.hs +++ b/tools/rex/Main.hs @@ -224,7 +224,7 @@ data SocketStats = SocketStats getSocketStats :: Word16 -> IO (Maybe SocketStats) getSocketStats port = do pnu <- Text.readFile "/proc/net/udp" - return + pure . find ((== port) . lPort) . map (mk . Text.words) . drop 1 @@ -245,7 +245,7 @@ getAppStats lgr addr sock = fmap mconcat . for cmds $ \cmd -> do sendAllTo sock cmd addr (reply, _) <- recvFrom sock 1024 Log.trace lgr $ msg (ByteString.intercalate "\n" (ByteString.lines reply)) - return $ + pure $ parseAppStats reply where cmds = ["stat", "turnstats", "turnreply", "tcpstats", "authstats"] From 510c2243025db9283540194a78a4f20a6f276739 Mon Sep 17 00:00:00 2001 From: Arthur Wolf Date: Wed, 8 Jun 2022 12:22:22 +0200 Subject: [PATCH 03/29] Make it clearer this runs on the client After Vedran asked about it --- docs/src/how-to/install/kubernetes.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/src/how-to/install/kubernetes.rst b/docs/src/how-to/install/kubernetes.rst index 4d51fa2a03..d4e423dfa4 100644 --- a/docs/src/how-to/install/kubernetes.rst +++ b/docs/src/how-to/install/kubernetes.rst @@ -40,7 +40,7 @@ And on the server (X.X.X.X), run: echo 'wire ALL=(ALL) NOPASSWD:ALL' | sudo tee -a /etc/sudoers -Then: +Then on the client: .. code:: shell From 6a59db0fb1dca823734c0d2341965c15819437a9 Mon Sep 17 00:00:00 2001 From: Florian Klink Date: Wed, 8 Jun 2022 13:31:18 +0200 Subject: [PATCH 04/29] docs/src/how-to/install/dependencies.rst: require Docker >= 20.10.14 glibc 2.34 uses the clone3 syscall, which is not part of the seccomp filters that moby ships on older versions. While as a workaround you might be able to run containers with `--privileged`, it's the better call to just run a more recent Docker runtime. References: - https://github.com/docker/buildx/issues/772 - https://github.com/moby/buildkit/pull/2379 - https://github.com/moby/moby/pull/42836 - https://github.com/NixOS/nixpkgs/pull/170900 --- docs/src/how-to/install/dependencies.rst | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) diff --git a/docs/src/how-to/install/dependencies.rst b/docs/src/how-to/install/dependencies.rst index 0b2138aec2..4c50f38d25 100644 --- a/docs/src/how-to/install/dependencies.rst +++ b/docs/src/how-to/install/dependencies.rst @@ -21,14 +21,11 @@ Checkout the repository, including its submodules: We provide a container containing all needed tools for setting up and interacting with a wire-server cluster. -Ensure you have docker installed: - -:: - - sudo apt install docker.io - -Or, depending on your distro, see `how to install docker `__. +Ensure you have Docker >= 20.10.14 installed, as the glibc version used is +incompatible with older container runtimes. +Your Distro might ship an older version, so best see `how to install docker +`__. To bring the tools in scope, we run the container, and mount the local ``wire-server-deploy`` checkout into it. From 8eb04e73500a1e7eac2ee78c6a6fad38d84a9fad Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Wed, 8 Jun 2022 13:58:05 +0200 Subject: [PATCH 05/29] charts/nginz: Forward `/i/legalhold/whitelisted-teams` to galley instead of brig (#2460) --- changelog.d/5-internal/nginz-legalhold | 1 + charts/nginz/values.yaml | 12 ++++++------ 2 files changed, 7 insertions(+), 6 deletions(-) create mode 100644 changelog.d/5-internal/nginz-legalhold diff --git a/changelog.d/5-internal/nginz-legalhold b/changelog.d/5-internal/nginz-legalhold new file mode 100644 index 0000000000..c733c6770c --- /dev/null +++ b/changelog.d/5-internal/nginz-legalhold @@ -0,0 +1 @@ +charts/nginz: Forward `/i/legalhold/whitelisted-teams` to galley instead of brig \ No newline at end of file diff --git a/charts/nginz/values.yaml b/charts/nginz/values.yaml index 4b860e400e..8826c1af6a 100644 --- a/charts/nginz/values.yaml +++ b/charts/nginz/values.yaml @@ -288,12 +288,6 @@ nginx_conf: disable_zauth: true basic_auth: true versioned: false - - path: /i/legalhold/whitelisted-teams(.*) - envs: - - staging - disable_zauth: true - basic_auth: true - versioned: false - path: /cookies envs: - all @@ -418,6 +412,12 @@ nginx_conf: envs: - staging versioned: false + - path: /i/legalhold/whitelisted-teams(.*) + envs: + - staging + disable_zauth: true + basic_auth: true + versioned: false - path: /teams/api-docs envs: - all From 8c3dfd1a2b5cde3f424bca4055301d0728bafa42 Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Wed, 8 Jun 2022 13:41:26 +0000 Subject: [PATCH 06/29] Reverted back to sequence+map to avoid GHC issue. --- .../test/unit/Test/Bonanza/Arbitrary.hs | 42 +++++++++++-------- 1 file changed, 24 insertions(+), 18 deletions(-) diff --git a/tools/bonanza/test/unit/Test/Bonanza/Arbitrary.hs b/tools/bonanza/test/unit/Test/Bonanza/Arbitrary.hs index cde85504b8..357a2d9ee6 100644 --- a/tools/bonanza/test/unit/Test/Bonanza/Arbitrary.hs +++ b/tools/bonanza/test/unit/Test/Bonanza/Arbitrary.hs @@ -1,7 +1,10 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} {-# OPTIONS_GHC -fno-warn-orphans #-} +{-# HLINT ignore "Use mapM" #-} + -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2022 Wire Swiss GmbH @@ -365,24 +368,27 @@ instance Arbitrary (ParseInput NginzLogRecord) where where genFields :: Gen [(Text, CommonLogField)] genFields = - mapM - (\(f, g) -> (f,) <$> g) - [ ("status", genIntField), - ("body_bytes_sent", genIntField), - ("http_referer", genStringField), - ("http_user_agent", genStringField), - ("http_x_forwarded_for", genIPv4Field), - ("separator", genEmptyField), - ("connection", genIntField), - ("request_time", genDoubleField), - ("upstream_response_time", genDoubleField), - ("upstream_cache_status", genStringField), - ("user", genStringField), - ("zconn", genStringField), - ("request", genStringField), - ("proxy_protocol_addr", genIPv4Field), - ("tracestate", genStringField) - ] + -- we're disabling the linter rule here to avoid an issue from GHC + -- https://gitlab.haskell.org/ghc/ghc/-/issues/18730 + sequence $ + map + (\(f, g) -> (f,) <$> g) + [ ("status", genIntField), + ("body_bytes_sent", genIntField), + ("http_referer", genStringField), + ("http_user_agent", genStringField), + ("http_x_forwarded_for", genIPv4Field), + ("separator", genEmptyField), + ("connection", genIntField), + ("request_time", genDoubleField), + ("upstream_response_time", genDoubleField), + ("upstream_cache_status", genStringField), + ("user", genStringField), + ("zconn", genStringField), + ("request", genStringField), + ("proxy_protocol_addr", genIPv4Field), + ("tracestate", genStringField) + ] genIntField :: Gen CommonLogField genIntField = maybe CEmpty (CField . Number . fromIntegral . getNonNegative) From 06ec735ccb2a9ebaeb572229c81c98e3747233ae Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Wed, 8 Jun 2022 08:21:33 +0000 Subject: [PATCH 07/29] Linted libs (except hscim and wire-api). --- libs/api-bot/src/Network/Wire/Bot/Clients.hs | 2 +- .../src/Network/Wire/Bot/Crypto/Glue.hs | 2 +- libs/api-bot/src/Network/Wire/Bot/Monad.hs | 2 +- .../src/Network/Wire/Bot/Report/Text.hs | 4 ++-- libs/api-bot/src/Network/Wire/Bot/Settings.hs | 2 +- .../Network/Wire/Client/API/Conversation.hs | 2 +- libs/bilge/src/Bilge/IO.hs | 4 ++-- libs/bilge/src/Bilge/Request.hs | 6 ++---- libs/bilge/src/Bilge/Response.hs | 2 +- libs/brig-types/src/Brig/Types/Connection.hs | 4 ++-- .../src/Brig/Types/Team/LegalHold.hs | 4 ++-- .../test/unit/Test/Brig/Types/User.hs | 4 ++-- libs/cassandra-util/src/Cassandra/Schema.hs | 19 +++++++---------- libs/dns-util/src/Wire/Network/DNS/SRV.hs | 4 ++-- libs/extended/src/Servant/API/Extended.hs | 2 +- libs/extended/src/System/Logger/Extended.hs | 5 ++--- .../src/Galley/Types/Conversations/Roles.hs | 2 +- .../test/unit/Test/Galley/Types.hs | 2 +- .../src/Gundeck/Types/Presence.hs | 2 +- libs/metrics-wai/src/Data/Metrics/Test.hs | 2 +- libs/metrics-wai/src/Data/Metrics/WaiRoute.hs | 4 ++-- libs/ropes/src/Ropes/Nexmo.hs | 4 ++-- .../test/unit/Test/Data/Schema.hs | 2 +- libs/types-common-aws/src/Util/Test/SQS.hs | 5 +++-- libs/types-common/src/Data/Id.hs | 5 +++-- libs/types-common/src/Data/Range.hs | 3 +-- libs/types-common/src/Data/Text/Ascii.hs | 2 +- libs/types-common/src/Util/Options.hs | 4 ++-- libs/types-common/src/Util/Options/Common.hs | 8 +++---- libs/types-common/src/Util/Test.hs | 4 ++-- .../src/Network/Wai/Utilities/Error.hs | 2 +- .../src/Network/Wai/Utilities/Server.hs | 4 ++-- .../src/Wire/API/Federation/Client.hs | 21 +++++++++---------- .../src/Wire/API/Routes/Public/Brig.hs | 6 ++---- libs/zauth/main/Main.hs | 4 ++-- libs/zauth/src/Data/ZAuth/Token.hs | 2 +- libs/zauth/test/Arbitraries.hs | 2 +- libs/zauth/test/ZAuth.hs | 8 +++---- 38 files changed, 79 insertions(+), 87 deletions(-) diff --git a/libs/api-bot/src/Network/Wire/Bot/Clients.hs b/libs/api-bot/src/Network/Wire/Bot/Clients.hs index 707b02ce90..d237cbd9c2 100644 --- a/libs/api-bot/src/Network/Wire/Bot/Clients.hs +++ b/libs/api-bot/src/Network/Wire/Bot/Clients.hs @@ -57,7 +57,7 @@ addMembers self c uu = -- TODO: Move / inline to Network.Wire.Bot.Crypto and remove this module foldSessions :: MonadIO m => Clients -> ConvId -> a -> (UserId -> ClientId -> Session -> a -> m a) -> m a foldSessions self c a f = - foldrM fun a =<< Map.findWithDefault Set.empty c <$> liftIO (readTVarIO (members self)) + foldrM fun a . Map.findWithDefault Set.empty c =<< liftIO (readTVarIO (members self)) where fun u acc1 = do cm <- Map.findWithDefault Map.empty u . clients <$> liftIO (readTVarIO (sessions self)) diff --git a/libs/api-bot/src/Network/Wire/Bot/Crypto/Glue.hs b/libs/api-bot/src/Network/Wire/Bot/Crypto/Glue.hs index 1905fe82b1..2545e4c9e9 100644 --- a/libs/api-bot/src/Network/Wire/Bot/Crypto/Glue.hs +++ b/libs/api-bot/src/Network/Wire/Bot/Crypto/Glue.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE LambdaCase #-} + -- This file is part of the Wire Server implementation. -- diff --git a/libs/api-bot/src/Network/Wire/Bot/Monad.hs b/libs/api-bot/src/Network/Wire/Bot/Monad.hs index 04dcd73c4f..26eecef5e6 100644 --- a/libs/api-bot/src/Network/Wire/Bot/Monad.hs +++ b/libs/api-bot/src/Network/Wire/Bot/Monad.hs @@ -551,7 +551,7 @@ whenAsserts ma = liftBotNet $ do -- | Wait for the Bot's assertion queue to become empty. awaitAssertions :: MonadBotNet m => Bot -> m () awaitAssertions bot = whenAsserts $ do - n <- liftIO . atomically $ readTVar (botAssertCount bot) + n <- liftIO (readTVarIO (botAssertCount bot)) unless (n <= 0) $ do liftIO $ threadDelay 1000000 awaitAssertions bot diff --git a/libs/api-bot/src/Network/Wire/Bot/Report/Text.hs b/libs/api-bot/src/Network/Wire/Bot/Report/Text.hs index d12a59a30b..17afb49786 100644 --- a/libs/api-bot/src/Network/Wire/Bot/Report/Text.hs +++ b/libs/api-bot/src/Network/Wire/Bot/Report/Text.hs @@ -60,8 +60,8 @@ formatReport pretty r = pp bold <> fromText (sectionName s) <> "\n" <> pp clear <> foldMap metric (sectionMetrics s) <> "\n" - metric (Counter l p) = single l . fromString . show $ (reportCounter r p) - metric (Gauge l p) = single l . fromString . show $ (reportGauge r p) + metric (Counter l p) = single l . fromString . show $ reportCounter r p + metric (Gauge l p) = single l . fromString . show $ reportGauge r p metric (Histogram l p _) = multi l $ sort $ Map.toList (reportBucket r p) single k v = "\t" <> fromText k <> ": " <> value v <> "\n" multi k v = "\t" <> subsection k <> "\n" <> foldMap pair v diff --git a/libs/api-bot/src/Network/Wire/Bot/Settings.hs b/libs/api-bot/src/Network/Wire/Bot/Settings.hs index 823adb2697..2a3d7139c9 100644 --- a/libs/api-bot/src/Network/Wire/Bot/Settings.hs +++ b/libs/api-bot/src/Network/Wire/Bot/Settings.hs @@ -147,7 +147,7 @@ usersFileOption = \ containing a list of ALREADY EXISTING users with the columns: \ \ User-Id,Email,Password" -usersFederationDomain :: Parser (Domain) +usersFederationDomain :: Parser Domain usersFederationDomain = domainOption $ long "users-federation-domain" diff --git a/libs/api-client/src/Network/Wire/Client/API/Conversation.hs b/libs/api-client/src/Network/Wire/Client/API/Conversation.hs index b4a2cb4717..b443e1c78a 100644 --- a/libs/api-client/src/Network/Wire/Client/API/Conversation.hs +++ b/libs/api-client/src/Network/Wire/Client/API/Conversation.hs @@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ViewPatterns #-} + -- This file is part of the Wire Server implementation. -- diff --git a/libs/bilge/src/Bilge/IO.hs b/libs/bilge/src/Bilge/IO.hs index 16db8d84c9..eb3b1f7a3b 100644 --- a/libs/bilge/src/Bilge/IO.hs +++ b/libs/bilge/src/Bilge/IO.hs @@ -270,7 +270,7 @@ http :: (Request -> Request) -> (Response BodyReader -> IO a) -> m a -http r f h = handleRequestWithCont (f r) h +http r f = handleRequestWithCont (f r) httpDebug :: (MonadIO m, MonadHttp m) => @@ -289,7 +289,7 @@ httpDebug debug r f h = do consumeBody >=> \rsp -> do if debug > Head then putStrLn (showResponse rsp) - else putStrLn (showResponse $ rsp {responseBody = ("" :: String)}) + else putStrLn (showResponse $ rsp {responseBody = "" :: String}) putStrLn "--" h rsp diff --git a/libs/bilge/src/Bilge/Request.hs b/libs/bilge/src/Bilge/Request.hs index f7461d0523..b9afd0b88c 100644 --- a/libs/bilge/src/Bilge/Request.hs +++ b/libs/bilge/src/Bilge/Request.hs @@ -156,14 +156,12 @@ expectStatus property r = r {Rq.checkResponse = check} | property (HTTP.statusCode (Rq.responseStatus res)) = return () | otherwise = do some <- Lazy.toStrict <$> brReadSome (Rq.responseBody res) 1024 - throwHttp $ Rq.StatusCodeException (const () <$> res) some + throwHttp $ Rq.StatusCodeException (() <$ res) some checkStatus :: (Status -> ResponseHeaders -> CookieJar -> Maybe SomeException) -> Request -> Request checkStatus f r = r {Rq.checkResponse = check} where - check _ res = case mayThrow res of - Nothing -> return () - Just ex -> throwIO ex + check _ res = forM_ (mayThrow res) throwIO mayThrow res = f (Rq.responseStatus res) diff --git a/libs/bilge/src/Bilge/Response.hs b/libs/bilge/src/Bilge/Response.hs index 22c1b75507..f8019c32f3 100644 --- a/libs/bilge/src/Bilge/Response.hs +++ b/libs/bilge/src/Bilge/Response.hs @@ -140,7 +140,7 @@ responseJsonUnsafeWithMsg :: responseJsonUnsafeWithMsg userErr = either err id . responseJsonEither where err parserErr = - error . intercalate " " $ + error . unwords $ ["responseJsonUnsafeWithMsg:"] <> [userErr | not $ null userErr] <> [parserErr] diff --git a/libs/brig-types/src/Brig/Types/Connection.hs b/libs/brig-types/src/Brig/Types/Connection.hs index f9f24145fa..a1820e3811 100644 --- a/libs/brig-types/src/Brig/Types/Connection.hs +++ b/libs/brig-types/src/Brig/Types/Connection.hs @@ -1,6 +1,6 @@ -{-# LANGUAGE NamedFieldPuns #-} + {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} + -- This file is part of the Wire Server implementation. -- diff --git a/libs/brig-types/src/Brig/Types/Team/LegalHold.hs b/libs/brig-types/src/Brig/Types/Team/LegalHold.hs index 321f65f22e..42ce2926e2 100644 --- a/libs/brig-types/src/Brig/Types/Team/LegalHold.hs +++ b/libs/brig-types/src/Brig/Types/Team/LegalHold.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} + {-# LANGUAGE OverloadedStrings #-} -- This file is part of the Wire Server implementation. @@ -80,7 +80,7 @@ instance FromJSON LegalHoldService where <*> o .: "public_key" legalHoldService :: TeamId -> Fingerprint Rsa -> NewLegalHoldService -> ServiceKey -> LegalHoldService -legalHoldService tid fpr (NewLegalHoldService u _ t) k = LegalHoldService tid u fpr t k +legalHoldService tid fpr (NewLegalHoldService u _ t) = LegalHoldService tid u fpr t viewLegalHoldService :: LegalHoldService -> ViewLegalHoldService viewLegalHoldService (LegalHoldService tid u fpr t k) = diff --git a/libs/brig-types/test/unit/Test/Brig/Types/User.hs b/libs/brig-types/test/unit/Test/Brig/Types/User.hs index 5605784c55..c0be5ac26e 100644 --- a/libs/brig-types/test/unit/Test/Brig/Types/User.hs +++ b/libs/brig-types/test/unit/Test/Brig/Types/User.hs @@ -1,11 +1,11 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE QuasiQuotes #-} + {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE ViewPatterns #-} + {-# OPTIONS_GHC -Wno-orphans #-} -- This file is part of the Wire Server implementation. diff --git a/libs/cassandra-util/src/Cassandra/Schema.hs b/libs/cassandra-util/src/Cassandra/Schema.hs index 4877f8df06..7287bbedf6 100644 --- a/libs/cassandra-util/src/Cassandra/Schema.hs +++ b/libs/cassandra-util/src/Cassandra/Schema.hs @@ -130,7 +130,7 @@ versionCheck v = do "Schema Version too old! Expecting at least: " <> show v <> ", but got: " - <> fromMaybe "" (show <$> v') + <> maybe "" show v' createKeyspace :: Keyspace -> ReplicationStrategy -> Client () createKeyspace (Keyspace k) rs = void $ schema (cql rs) (params All ()) @@ -276,19 +276,17 @@ migrationPolicy = do migrationOptsParser :: Parser MigrationOpts migrationOptsParser = MigrationOpts - <$> ( strOption $ + <$> strOption ( long "host" <> metavar "HOST" <> value "localhost" - <> help "Cassandra host" - ) - <*> ( option auto $ + <> help "Cassandra host") + <*> option auto ( long "port" <> metavar "PORT" <> value 9042 - <> help "Cassandra port" - ) - <*> ( (fmap pack) . strOption $ + <> help "Cassandra port") + <*> ( fmap pack . strOption $ long "keyspace" <> metavar "STRING" <> help "Cassandra Keyspace" @@ -304,7 +302,6 @@ migrationOptsParser = <> help "Replication Map (i.e. \"eu-west:3,us-east:3\")" ) ) - <*> ( switch $ + <*> switch ( long "reset" - <> help "Reset the keyspace before running migrations" - ) + <> help "Reset the keyspace before running migrations") diff --git a/libs/dns-util/src/Wire/Network/DNS/SRV.hs b/libs/dns-util/src/Wire/Network/DNS/SRV.hs index ee05c3b837..eed0364e25 100644 --- a/libs/dns-util/src/Wire/Network/DNS/SRV.hs +++ b/libs/dns-util/src/Wire/Network/DNS/SRV.hs @@ -129,10 +129,10 @@ orderSrvResult = -- than or equal to the random number. let (beginning, (firstSrv, _), end) = case break (\(_, running) -> randomNumber <= running) sublistWithRunning of - (b, (c : e)) -> (b, c, e) + (b, c : e) -> (b, c, e) _ -> error "orderSrvResult: no record with running sum greater than random number" -- Remove the running total number from the remaining elements. - let remainingSrvs = map fst (concat [beginning, end]) + let remainingSrvs = map fst (beginning ++ end) -- Repeat the ordering procedure on the remaining elements. rest <- orderSublist remainingSrvs return $ firstSrv : rest diff --git a/libs/extended/src/Servant/API/Extended.hs b/libs/extended/src/Servant/API/Extended.hs index 7f71777dd7..8842b1763b 100644 --- a/libs/extended/src/Servant/API/Extended.hs +++ b/libs/extended/src/Servant/API/Extended.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} + -- This file is part of the Wire Server implementation. -- diff --git a/libs/extended/src/System/Logger/Extended.hs b/libs/extended/src/System/Logger/Extended.hs index 9bf0cdddcf..a66f732469 100644 --- a/libs/extended/src/System/Logger/Extended.hs +++ b/libs/extended/src/System/Logger/Extended.hs @@ -149,9 +149,8 @@ netStringsToLogFormat False = Plain mkLogger :: Log.Level -> Maybe (Last Bool) -> Maybe (Last LogFormat) -> IO Log.Logger mkLogger lvl useNetstrings logFormat = do mkLoggerNew lvl $ - case (fmap netStringsToLogFormat <$> useNetstrings) <> logFormat of - Just x -> getLast x - Nothing -> Plain + maybe Plain getLast + ((fmap netStringsToLogFormat <$> useNetstrings) <> logFormat) -- | Version of mkLogger that doesn't support the deprecated useNetstrings option mkLoggerNew :: Log.Level -> LogFormat -> IO Log.Logger diff --git a/libs/galley-types/src/Galley/Types/Conversations/Roles.hs b/libs/galley-types/src/Galley/Types/Conversations/Roles.hs index c33dc0add2..48788a8116 100644 --- a/libs/galley-types/src/Galley/Types/Conversations/Roles.hs +++ b/libs/galley-types/src/Galley/Types/Conversations/Roles.hs @@ -53,7 +53,7 @@ isActionAllowed action rn -- | Custom RoleNames _must not_ start with `wire_` isCustomRoleName :: RoleName -> Bool -isCustomRoleName (fromRoleName -> r) = isValidRoleName r && (not $ "wire_" `T.isPrefixOf` r) +isCustomRoleName (fromRoleName -> r) = isValidRoleName r && not ("wire_" `T.isPrefixOf` r) roleNameToActions :: RoleName -> Maybe (Set Action) roleNameToActions r = roleActions <$> toConvRole r Nothing diff --git a/libs/galley-types/test/unit/Test/Galley/Types.hs b/libs/galley-types/test/unit/Test/Galley/Types.hs index 7f59c06e49..cbb1f86e3a 100644 --- a/libs/galley-types/test/unit/Test/Galley/Types.hs +++ b/libs/galley-types/test/unit/Test/Galley/Types.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} + {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -Wno-orphans -Wno-incomplete-uni-patterns #-} diff --git a/libs/gundeck-types/src/Gundeck/Types/Presence.hs b/libs/gundeck-types/src/Gundeck/Types/Presence.hs index 01895b6ccd..25bab5c43f 100644 --- a/libs/gundeck-types/src/Gundeck/Types/Presence.hs +++ b/libs/gundeck-types/src/Gundeck/Types/Presence.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} + {-# LANGUAGE OverloadedStrings #-} -- This file is part of the Wire Server implementation. diff --git a/libs/metrics-wai/src/Data/Metrics/Test.hs b/libs/metrics-wai/src/Data/Metrics/Test.hs index e7e34363ee..50e07b9811 100644 --- a/libs/metrics-wai/src/Data/Metrics/Test.hs +++ b/libs/metrics-wai/src/Data/Metrics/Test.hs @@ -44,7 +44,7 @@ pathsConsistencyCheck :: Paths -> [SiteConsistencyError] pathsConsistencyCheck (Paths forest) = mconcat $ go [] <$> forest where go :: [PathSegment] -> Tree.Tree PathSegment -> [SiteConsistencyError] - go prefix (Tree.Node root trees) = maybeToList here <> (mconcat $ go (root : prefix) <$> trees) + go prefix (Tree.Node root trees) = maybeToList here <> mconcat (go (root : prefix) <$> trees) where here = findSiteConsistencyError (reverse $ root : prefix) trees findSiteConsistencyError :: [PathSegment] -> Tree.Forest PathSegment -> Maybe SiteConsistencyError diff --git a/libs/metrics-wai/src/Data/Metrics/WaiRoute.hs b/libs/metrics-wai/src/Data/Metrics/WaiRoute.hs index 92b953d377..8592cd1797 100644 --- a/libs/metrics-wai/src/Data/Metrics/WaiRoute.hs +++ b/libs/metrics-wai/src/Data/Metrics/WaiRoute.hs @@ -1,6 +1,6 @@ -{-# LANGUAGE OverloadedStrings #-} + {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE ViewPatterns #-} + -- This file is part of the Wire Server implementation. -- diff --git a/libs/ropes/src/Ropes/Nexmo.hs b/libs/ropes/src/Ropes/Nexmo.hs index 1de3ec41ad..934b2368ff 100644 --- a/libs/ropes/src/Ropes/Nexmo.hs +++ b/libs/ropes/src/Ropes/Nexmo.hs @@ -2,7 +2,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE ViewPatterns #-} + -- This file is part of the Wire Server implementation. -- @@ -154,7 +154,7 @@ instance FromJSON Charset where parseJSON "text" = return GSM7 parseJSON "binary" = return GSM8 parseJSON "unicode" = return UCS2 - parseJSON x = fail $ "Unsupported charset " <> (show x) + parseJSON x = fail $ "Unsupported charset " <> show x instance ToJSON Charset where toJSON GSM7 = "text" diff --git a/libs/schema-profunctor/test/unit/Test/Data/Schema.hs b/libs/schema-profunctor/test/unit/Test/Data/Schema.hs index fac73016ea..0a4c79d192 100644 --- a/libs/schema-profunctor/test/unit/Test/Data/Schema.hs +++ b/libs/schema-profunctor/test/unit/Test/Data/Schema.hs @@ -351,7 +351,7 @@ testNullable = A.parse (schemaIn sch) A.Null @?= Success Nothing, testCase "Nullable schemas should produce either a value or null" $ do schemaOut sch (Just 5) @?= Just (A.Number 5) - schemaOut sch Nothing @?= Just (A.Null), + schemaOut sch Nothing @?= Just A.Null, testCase "Nullable schemas should return an error when parsing invalid non-null values" $ do case A.parse (schemaIn sch) (A.String "foo") of Success _ -> assertFailure "fromJSON should fail" diff --git a/libs/types-common-aws/src/Util/Test/SQS.hs b/libs/types-common-aws/src/Util/Test/SQS.hs index a0c86086bd..8a75b0d235 100644 --- a/libs/types-common-aws/src/Util/Test/SQS.hs +++ b/libs/types-common-aws/src/Util/Test/SQS.hs @@ -2,7 +2,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE StandaloneDeriving #-} + {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} @@ -101,7 +101,8 @@ fetchMessage url label callback = do parseDeleteMessage :: (Monad m, Message a, MonadIO m, MonadReader AWS.Env m, MonadResource m) => Text -> SQS.Message -> m (Maybe a) parseDeleteMessage url m = do - evt <- case (>>= decodeMessage) . B64.decode . Text.encodeUtf8 <$> (m ^. SQS.message_body) of + let decodedMessage = decodeMessage <=< (B64.decode . Text.encodeUtf8) + evt <- case decodedMessage <$> (m ^. SQS.message_body) of Just (Right e) -> return (Just e) _ -> do liftIO $ print ("Failed to parse SQS message or event" :: String) diff --git a/libs/types-common/src/Data/Id.hs b/libs/types-common/src/Data/Id.hs index b587f102d1..2c753f779a 100644 --- a/libs/types-common/src/Data/Id.hs +++ b/libs/types-common/src/Data/Id.hs @@ -85,6 +85,7 @@ import Imports import Servant (FromHttpApiData (..), ToHttpApiData (..)) import Test.QuickCheck import Test.QuickCheck.Instances () +import Data.Bifunctor (first) data IdTag = A | C | I | U | P | S | T | STo @@ -173,7 +174,7 @@ instance Show (Id a) where show = UUID.toString . toUUID instance Read (Id a) where - readsPrec n = map (\(a, x) -> (Id a, x)) . readsPrec n + readsPrec n = map (first Id) . readsPrec n instance FromByteString (Id a) where parser = do @@ -339,7 +340,7 @@ instance Show BotId where show = show . botUserId instance Read BotId where - readsPrec n = map (\(a, x) -> (BotId a, x)) . readsPrec n + readsPrec n = map (first BotId) . readsPrec n deriving instance Cql BotId diff --git a/libs/types-common/src/Data/Range.hs b/libs/types-common/src/Data/Range.hs index 5589004e35..d46bb82171 100644 --- a/libs/types-common/src/Data/Range.hs +++ b/libs/types-common/src/Data/Range.hs @@ -496,8 +496,7 @@ genRangeAsciiText :: (HasCallStack, KnownNat n, KnownNat m, LTE n m, AsciiChars c) => Gen (AsciiChar c) -> Gen (Range n m (AsciiText c)) -genRangeAsciiText gc = - genRange @n @m fromAsciiChars gc +genRangeAsciiText = genRange @n @m fromAsciiChars genRange :: forall (n :: Nat) (m :: Nat) (a :: *) (b :: *). diff --git a/libs/types-common/src/Data/Text/Ascii.hs b/libs/types-common/src/Data/Text/Ascii.hs index 0a993c3a1a..1e32ac5ac0 100644 --- a/libs/types-common/src/Data/Text/Ascii.hs +++ b/libs/types-common/src/Data/Text/Ascii.hs @@ -4,7 +4,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeSynonymInstances #-} + -- This file is part of the Wire Server implementation. -- diff --git a/libs/types-common/src/Util/Options.hs b/libs/types-common/src/Util/Options.hs index 95d269110a..1efc65d75c 100644 --- a/libs/types-common/src/Util/Options.hs +++ b/libs/types-common/src/Util/Options.hs @@ -50,7 +50,7 @@ instance FromByteString AWSEndpoint where "https" -> return True "http" -> return False x -> fail ("Unsupported scheme: " ++ show x) - host <- case (url ^. authorityL <&> view (authorityHostL . hostBSL)) of + host <- case url ^. authorityL <&> view (authorityHostL . hostBSL) of Just h -> return h Nothing -> fail ("No host in: " ++ show url) port <- case urlPort url of @@ -109,7 +109,7 @@ loadSecret (FilePathSecrets p) = do path <- canonicalizePath p exists <- doesFileExist path if exists - then return . over _Left show . decodeEither' =<< BS.readFile path + then over _Left show . decodeEither' <$> BS.readFile path else return (Left "File doesn't exist") getOptions :: diff --git a/libs/types-common/src/Util/Options/Common.hs b/libs/types-common/src/Util/Options/Common.hs index 13e52e5197..d8601f8103 100644 --- a/libs/types-common/src/Util/Options/Common.hs +++ b/libs/types-common/src/Util/Options/Common.hs @@ -1,6 +1,6 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE TemplateHaskell #-} + + + -- This file is part of the Wire Server implementation. -- @@ -50,7 +50,7 @@ toOptionFieldName = defaultOptions {fieldLabelModifier = lowerFirst . dropPrefix dropPrefix :: String -> String dropPrefix = dropWhile (not . isUpper) -optOrEnv :: (a -> b) -> (Maybe a) -> (String -> b) -> String -> IO b +optOrEnv :: (a -> b) -> Maybe a -> (String -> b) -> String -> IO b optOrEnv getter conf reader var = case conf of Nothing -> reader <$> getEnv var Just c -> pure $ getter c diff --git a/libs/types-common/src/Util/Test.hs b/libs/types-common/src/Util/Test.hs index e83d190dd8..629de9301e 100644 --- a/libs/types-common/src/Util/Test.hs +++ b/libs/types-common/src/Util/Test.hs @@ -1,6 +1,6 @@ -{-# LANGUAGE DeriveGeneric #-} + {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} + -- This file is part of the Wire Server implementation. -- diff --git a/libs/wai-utilities/src/Network/Wai/Utilities/Error.hs b/libs/wai-utilities/src/Network/Wai/Utilities/Error.hs index bd8f127c44..9bd1f39d15 100644 --- a/libs/wai-utilities/src/Network/Wai/Utilities/Error.hs +++ b/libs/wai-utilities/src/Network/Wai/Utilities/Error.hs @@ -79,7 +79,7 @@ instance ToJSON Error where "label" .= l, "message" .= m ] - ++ fromMaybe [] (fmap dataFields md) + ++ maybe [] dataFields md where dataFields :: ErrorData -> [Pair] dataFields d = ["data" .= d] diff --git a/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs b/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs index ed679c8780..ecc24eb55c 100644 --- a/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs +++ b/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs @@ -284,7 +284,7 @@ emitLByteString lbs = do rethrow5xx :: Logger -> Middleware rethrow5xx logger app req k = app req k' where - k' resp@(WaiInt.ResponseRaw {}) = do + k' resp@WaiInt.ResponseRaw {} = do -- See Note [Raw Response] let logMsg = field "canoncalpath" (show $ pathInfo req) @@ -362,7 +362,7 @@ logErrorMsg :: Wai.Error -> Msg -> Msg logErrorMsg (Wai.Error c l m md) = field "code" (statusCode c) . field "label" l - . fromMaybe id (fmap logErrorData md) + . maybe id logErrorData md . msg (val "\"" +++ m +++ val "\"") where logErrorData (Wai.FederationErrorData d p) = diff --git a/libs/wire-api-federation/src/Wire/API/Federation/Client.hs b/libs/wire-api-federation/src/Wire/API/Federation/Client.hs index 7b6a601156..a2f3f1896f 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/Client.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/Client.hs @@ -38,6 +38,7 @@ import Control.Monad.Codensity import Control.Monad.Except import Control.Monad.Trans.Maybe import qualified Data.Aeson as Aeson +import Data.Bifunctor (first) import qualified Data.ByteString as BS import Data.ByteString.Builder import Data.ByteString.Conversion (toByteString') @@ -112,8 +113,7 @@ liftCodensity :: Codensity IO a -> FederatorClient c a liftCodensity = FederatorClient . lift . lift . lift headersFromTable :: HTTP2.HeaderTable -> [HTTP.Header] -headersFromTable (headerList, _) = flip map headerList $ \(token, headerValue) -> - (HTTP2.tokenKey token, headerValue) +headersFromTable (headerList, _) = flip map headerList $ first HTTP2.tokenKey connectSocket :: ByteString -> Int -> IO NS.Socket connectSocket hostname port = @@ -130,7 +130,7 @@ performHTTP2Request :: performHTTP2Request mtlsConfig req hostname port = try $ do withHTTP2Request mtlsConfig req hostname port $ \resp -> do b <- - fmap (either (const mempty) id) + fmap (fromRight mempty) . runExceptT . runSourceT . responseBody @@ -199,12 +199,11 @@ instance KnownComponent c => RunStreamingClient (FederatorClient c) where withStreamingRequest = withHTTP2StreamingRequest HTTP.statusIsSuccessful streamingResponseStrictBody :: StreamingResponse -> IO Builder -streamingResponseStrictBody resp = +streamingResponseStrictBody = fmap (either stringUtf8 (foldMap byteString)) . runExceptT . runSourceT . responseBody - $ resp -- Perform a streaming request to the local federator. withHTTP2StreamingRequest :: @@ -225,13 +224,11 @@ withHTTP2StreamingRequest successfulStatus req handleResponse = do let path = baseUrlPath <> requestPath req body <- do - body <- case requestBody req of + case requestBody req of Just (RequestBodyLBS lbs, _) -> pure lbs Just (RequestBodyBS bs, _) -> pure (LBS.fromStrict bs) - Just (RequestBodySource _, _) -> - throwError FederatorClientStreamingNotSupported + Just (RequestBodySource _, _) -> throwError FederatorClientStreamingNotSupported Nothing -> pure mempty - pure body let req' = HTTP2.requestBuilder (requestMethod req) @@ -240,7 +237,7 @@ withHTTP2StreamingRequest successfulStatus req handleResponse = do (lazyByteString body) let Endpoint (Text.encodeUtf8 -> hostname) (fromIntegral -> port) = ceFederator env resp <- - (either throwError pure =<<) . liftCodensity $ + either throwError pure <=< liftCodensity $ Codensity $ \k -> E.catch (withHTTP2Request Nothing req' hostname port (k . Right)) @@ -326,9 +323,11 @@ runVersionedFederatorClientToCodensity :: ExceptT FederatorClientError (Codensity IO) a runVersionedFederatorClientToCodensity env = flip runReaderT env - . (maybe (E.throw FederatorClientVersionMismatch) pure =<<) + . unmaybe . runMaybeT . unFederatorClient + where + unmaybe = (maybe (E.throw FederatorClientVersionMismatch) pure =<<) versionNegotiation :: FederatorClient 'Brig Version versionNegotiation = diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs index fc59035912..89833863b6 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -803,7 +803,7 @@ type MLSKeyPackageAPI = :> ReqBody '[JSON] KeyPackageUpload :> MultiVerb 'POST '[JSON, MLS] '[RespondEmpty 201 "Key packages uploaded"] () ) - :<|> ( Named + :<|> Named "mls-key-packages-claim" ( "claim" :> Summary "Claim one key package for each client of the given user" @@ -817,8 +817,7 @@ type MLSKeyPackageAPI = ClientId :> MultiVerb1 'POST '[JSON] (Respond 200 "Claimed key packages" KeyPackageBundle) ) - ) - :<|> ( Named + :<|> Named "mls-key-packages-count" ( "self" :> CaptureClientId "client" @@ -826,7 +825,6 @@ type MLSKeyPackageAPI = :> Summary "Return the number of unused key packages for the given client" :> MultiVerb1 'GET '[JSON] (Respond 200 "Number of key packages" KeyPackageCount) ) - ) ) type MLSAPI = LiftNamed (ZLocalUser :> "mls" :> MLSKeyPackageAPI) diff --git a/libs/zauth/main/Main.hs b/libs/zauth/main/Main.hs index 61e00e4193..cbcfaf7ff9 100644 --- a/libs/zauth/main/Main.hs +++ b/libs/zauth/main/Main.hs @@ -102,14 +102,14 @@ go CreateAccess o = do go CreateBot o = do when (length (o ^. dat) /= 3) $ error "invalid --data, must have 3 elements" - let p = uuid $ (o ^. dat) !! 0 + let p = uuid $ head (o ^. dat) b = uuid $ (o ^. dat) !! 1 c = uuid $ (o ^. dat) !! 2 runCreate' o $ toByteString <$> botToken p b c go CreateProvider o = do when (length (o ^. dat) /= 1) $ error "missing --data" - let p = uuid $ (o ^. dat) !! 0 + let p = uuid $ head (o ^. dat) runCreate' o $ toByteString <$> providerToken (o ^. dur) p go GenKeyPair _ = do (p, s) <- newKeyPair diff --git a/libs/zauth/src/Data/ZAuth/Token.hs b/libs/zauth/src/Data/ZAuth/Token.hs index 52ea198c45..ff4a03b1a5 100644 --- a/libs/zauth/src/Data/ZAuth/Token.hs +++ b/libs/zauth/src/Data/ZAuth/Token.hs @@ -236,7 +236,7 @@ mkToken :: Signature -> Header -> a -> Token a mkToken = Token mkHeader :: Int -> Int -> Integer -> Type -> Maybe Tag -> Header -mkHeader v k d t g = Header v k d t g +mkHeader = Header mkAccess :: UUID -> Word64 -> Access mkAccess = Access diff --git a/libs/zauth/test/Arbitraries.hs b/libs/zauth/test/Arbitraries.hs index bb17ae9b58..7bdc155f8d 100644 --- a/libs/zauth/test/Arbitraries.hs +++ b/libs/zauth/test/Arbitraries.hs @@ -74,7 +74,7 @@ instance Arbitrary LegalHoldUser where arbitrary = mkLegalHoldUser <$> arbitrary <*> arbitrary instance Arbitrary ByteString where - arbitrary = fromString <$> arbitrary `suchThat` (not . any (== '.')) + arbitrary = fromString <$> arbitrary `suchThat` notElem '.' instance Arbitrary Signature where arbitrary = Signature <$> arbitrary diff --git a/libs/zauth/test/ZAuth.hs b/libs/zauth/test/ZAuth.hs index 703cbd69b5..bd2e5d472d 100644 --- a/libs/zauth/test/ZAuth.hs +++ b/libs/zauth/test/ZAuth.hs @@ -69,10 +69,10 @@ defDuration :: Integer defDuration = 1 testUserIsNotLegalHoldUser :: Token LegalHoldUser -> Bool -testUserIsNotLegalHoldUser t = fromByteString @(Token User) (toByteString' t) == Nothing +testUserIsNotLegalHoldUser t = isNothing (fromByteString @(Token User) (toByteString' t)) testUserIsNotLegalHoldUser' :: Token User -> Bool -testUserIsNotLegalHoldUser' t = fromByteString @(Token LegalHoldUser) (toByteString' t) == Nothing +testUserIsNotLegalHoldUser' t = isNothing (fromByteString @(Token LegalHoldUser) (toByteString' t)) testDecEncAccessToken :: Token Access -> Bool testDecEncAccessToken t = fromByteString (toByteString' t) == Just t @@ -117,8 +117,8 @@ testSignAndVerify p = do testRandDevIds :: Create () testRandDevIds = do u <- liftIO nextRandom - t1 <- (view body) <$> accessToken1 defDuration u - t2 <- (view body) <$> accessToken1 defDuration u + t1 <- view body <$> accessToken1 defDuration u + t2 <- view body <$> accessToken1 defDuration u liftIO $ assertBool "unexpected: Same device ID." (t1 ^. connection /= t2 ^. connection) -- Helpers: From c061d63268f4edce3154587b57f620f0137559ed Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Wed, 8 Jun 2022 10:29:41 +0000 Subject: [PATCH 08/29] s/return/pure --- libs/api-bot/src/Network/Wire/Bot/Assert.hs | 8 +-- libs/api-bot/src/Network/Wire/Bot/Cache.hs | 6 +- libs/api-bot/src/Network/Wire/Bot/Clients.hs | 2 +- libs/api-bot/src/Network/Wire/Bot/Crypto.hs | 12 ++-- .../src/Network/Wire/Bot/Crypto/Glue.hs | 4 +- libs/api-bot/src/Network/Wire/Bot/Email.hs | 14 ++--- libs/api-bot/src/Network/Wire/Bot/Monad.hs | 58 +++++++++---------- libs/api-bot/src/Network/Wire/Bot/Report.hs | 8 +-- libs/api-bot/src/Network/Wire/Bot/Settings.hs | 2 +- .../src/Network/Wire/Client/API/Asset.hs | 4 +- .../src/Network/Wire/Client/API/Auth.hs | 8 +-- .../src/Network/Wire/Client/API/Client.hs | 4 +- .../Network/Wire/Client/API/Conversation.hs | 8 +-- .../src/Network/Wire/Client/API/Push.hs | 10 ++-- .../src/Network/Wire/Client/API/User.hs | 6 +- .../src/Network/Wire/Client/HTTP.hs | 4 +- .../src/Network/Wire/Client/Session.hs | 2 +- libs/bilge/src/Bilge/Assert.hs | 2 +- libs/bilge/src/Bilge/IO.hs | 4 +- libs/bilge/src/Bilge/RPC.hs | 4 +- libs/bilge/src/Bilge/Request.hs | 4 +- libs/bilge/src/Bilge/Retry.hs | 4 +- libs/brig-types/src/Brig/Types/Common.hs | 4 +- libs/brig-types/src/Brig/Types/Instances.hs | 6 +- libs/brig-types/src/Brig/Types/Intra.hs | 2 +- libs/cassandra-util/src/Cassandra/Exec.hs | 8 +-- libs/cassandra-util/src/Cassandra/Schema.hs | 12 ++-- libs/cassandra-util/src/Cassandra/Settings.hs | 2 +- libs/dns-util/src/Wire/Network/DNS/SRV.hs | 4 +- .../gundeck-types/src/Gundeck/Types/Common.hs | 2 +- .../src/Gundeck/Types/Push/V2.hs | 6 +- libs/metrics-core/src/Data/Metrics.hs | 2 +- libs/ropes/src/Ropes/Nexmo.hs | 56 +++++++++--------- libs/ropes/src/Ropes/Twilio.hs | 10 ++-- libs/ssl-util/src/Ssl/Util.hs | 6 +- libs/tasty-cannon/src/Test/Tasty/Cannon.hs | 12 ++-- libs/types-common-aws/src/Util/Test/SQS.hs | 12 ++-- libs/types-common/src/Data/Id.hs | 4 +- libs/types-common/src/Data/Misc.hs | 10 ++-- libs/types-common/src/Data/Range.hs | 6 +- libs/types-common/src/Util/Options.hs | 22 +++---- libs/types-common/src/Util/Test.hs | 6 +- .../src/Network/Wai/Utilities/Request.hs | 4 +- .../src/Network/Wai/Utilities/Server.hs | 8 +-- .../src/Network/Wai/Utilities/ZAuth.hs | 2 +- libs/zauth/main/Main.hs | 22 +++---- libs/zauth/src/Data/ZAuth/Creation.hs | 2 +- libs/zauth/src/Data/ZAuth/Token.hs | 12 ++-- libs/zauth/src/Data/ZAuth/Validation.hs | 10 ++-- libs/zauth/test/Arbitraries.hs | 2 +- libs/zauth/test/ZAuth.hs | 2 +- 51 files changed, 217 insertions(+), 217 deletions(-) diff --git a/libs/api-bot/src/Network/Wire/Bot/Assert.hs b/libs/api-bot/src/Network/Wire/Bot/Assert.hs index 138c2fd4ab..ed40c15e95 100644 --- a/libs/api-bot/src/Network/Wire/Bot/Assert.hs +++ b/libs/api-bot/src/Network/Wire/Bot/Assert.hs @@ -63,8 +63,8 @@ awaitOtrMessage :: m (Maybe (ConvEvent OtrMessage)) awaitOtrMessage c (from, fc) (to, tc) = awaitEvent to TConvOtrMessageAdd assertion >>= \case - Just (EOtrMessage m) -> return (Just m) - _ -> return Nothing + Just (EOtrMessage m) -> pure (Just m) + _ -> pure Nothing where assertion (EOtrMessage evt) = let e = convEvtData evt @@ -83,7 +83,7 @@ assertMembersJoined :: -- | Users who have (presumably) joined Maybe (ConvEvent SimpleMembers) -> m () -assertMembersJoined _ Nothing = return () +assertMembersJoined _ Nothing = pure () assertMembersJoined bs (Just e) = forM_ bs $ \b -> assertEvent b TConvMemberJoin memAdd where @@ -99,7 +99,7 @@ assertMembersLeft :: -- | Users who have (presumably) left Maybe (ConvEvent UserIdList) -> m () -assertMembersLeft _ Nothing = return () +assertMembersLeft _ Nothing = pure () assertMembersLeft bs (Just e) = forM_ bs $ \b -> assertEvent b TConvMemberLeave memRem where diff --git a/libs/api-bot/src/Network/Wire/Bot/Cache.hs b/libs/api-bot/src/Network/Wire/Bot/Cache.hs index 612a7c9eb1..1a8b41d2cd 100644 --- a/libs/api-bot/src/Network/Wire/Bot/Cache.hs +++ b/libs/api-bot/src/Network/Wire/Bot/Cache.hs @@ -58,7 +58,7 @@ fromFile logger gen domain path = do triples <- map (Text.splitOn ",") . Text.lines <$> Text.readFile path shuffled <- V.toList <$> uniformShuffle (V.fromList triples) gen c <- newIORef =<< foldM (toUser logger domain) [] shuffled - return (Cache c) + pure (Cache c) empty :: IO Cache empty = Cache <$> newIORef [] @@ -82,7 +82,7 @@ toUser _ domain acc [i, e, p] = do let ie = error "Cache.toUser: invalid email" let ui = fromMaybe iu . fromByteString . encodeUtf8 . Text.toStrict . Text.strip $ i let em = fromMaybe ie . parseEmail . Text.toStrict . Text.strip $ e - return . (: acc) $ + pure . (: acc) $ CachedUser pw User @@ -103,4 +103,4 @@ toUser _ domain acc [i, e, p] = do } toUser g _ acc entry = do warn g $ msg (val "invalid entry: " +++ show entry) - return acc + pure acc diff --git a/libs/api-bot/src/Network/Wire/Bot/Clients.hs b/libs/api-bot/src/Network/Wire/Bot/Clients.hs index d237cbd9c2..80c22247d2 100644 --- a/libs/api-bot/src/Network/Wire/Bot/Clients.hs +++ b/libs/api-bot/src/Network/Wire/Bot/Clients.hs @@ -66,4 +66,4 @@ foldSessions self c a f = lookupSession :: MonadIO m => Clients -> UserId -> ClientId -> m (Maybe Session) lookupSession self u d = do s <- liftIO $ readTVarIO (sessions self) - return $ Map.lookup u (clients s) >>= Map.lookup d + pure $ Map.lookup u (clients s) >>= Map.lookup d diff --git a/libs/api-bot/src/Network/Wire/Bot/Crypto.hs b/libs/api-bot/src/Network/Wire/Bot/Crypto.hs index 3e7ca8b526..84e037529b 100644 --- a/libs/api-bot/src/Network/Wire/Bot/Crypto.hs +++ b/libs/api-bot/src/Network/Wire/Bot/Crypto.hs @@ -95,7 +95,7 @@ clientInitSession cl uid = do k <- decodePrekey c let i = mkSID uid (prekeyClient c) s <- liftIO $ unwrap =<< CBox.sessionFromPrekey b i k - return (prekeyClient c, s) + pure (prekeyClient c, s) -- | Initialise an OTR session between the given 'BotClient' and the sender of -- the given OTR message. @@ -116,12 +116,12 @@ encrypt cl cnv val = fmap (OtrRecipients . UserClientMap) . foldSessions (botClientSessions cl) cnv Map.empty $ \u c s rcps -> if botClientId cl == c - then return rcps + then pure rcps else liftIO $ do ciphertext <- do bs <- CBox.encrypt s val >>= unwrap >>= CBox.copyBytes - return $! decodeUtf8 $! B64.encode bs - return $ Map.insertWith Map.union u (Map.singleton c ciphertext) rcps + pure $! decodeUtf8 $! B64.encode bs + pure $ Map.insertWith Map.union u (Map.singleton c ciphertext) rcps -- | Decrypt an OTR message received from a given user and client. decrypt :: BotClient -> UserId -> ClientId -> ByteString -> BotSession ByteString @@ -172,7 +172,7 @@ encryptSymmetric clt (SymmetricKeys ekey mkey) msg = liftIO $ do iv <- randomBytes (botClientBox clt) 16 let ciphertext = iv <> cbcEncrypt aes (aesIV iv) (padPKCS7 msg) let mac = hmac (toByteString' mkey) ciphertext :: HMAC SHA256 - return $ convert mac <> ciphertext + pure $ convert mac <> ciphertext decryptSymmetric :: MonadIO m => BotClient -> SymmetricKeys -> Ciphertext -> m Plaintext decryptSymmetric _ (SymmetricKeys ekey mkey) msg = liftIO $ do @@ -184,7 +184,7 @@ decryptSymmetric _ (SymmetricKeys ekey mkey) msg = liftIO $ do throwM $ RequirementFailed "Bad MAC" let (iv, dat) = BS.splitAt 16 ciphertext - return $ unpadPKCS7 $ cbcDecrypt aes (aesIV iv) dat + pure $ unpadPKCS7 $ cbcDecrypt aes (aesIV iv) dat ----------------------------------------------------------------------------- -- Helpers diff --git a/libs/api-bot/src/Network/Wire/Bot/Crypto/Glue.hs b/libs/api-bot/src/Network/Wire/Bot/Crypto/Glue.hs index 2545e4c9e9..18760524bb 100644 --- a/libs/api-bot/src/Network/Wire/Bot/Crypto/Glue.hs +++ b/libs/api-bot/src/Network/Wire/Bot/Crypto/Glue.hs @@ -67,7 +67,7 @@ randomBytes :: MonadIO m => Box -> Word32 -> m ByteString randomBytes b n = liftIO $ CBox.randomBytes b n >>= unwrap >>= CBox.copyBytes unwrap :: (Show a, MonadThrow m) => CBox.Result a -> m a -unwrap (CBox.Success a) = return a +unwrap (CBox.Success a) = pure a unwrap other = throwM $ userError (show other) getBoxDir :: UserId -> Maybe Text -> IO FilePath @@ -75,4 +75,4 @@ getBoxDir uid label = do tmp <- getTemporaryDirectory let usrDir = show (toUUID uid) let cltDir = maybe "" Text.unpack label - return $ tmp "wire-bot" usrDir cltDir + pure $ tmp "wire-bot" usrDir cltDir diff --git a/libs/api-bot/src/Network/Wire/Bot/Email.hs b/libs/api-bot/src/Network/Wire/Bot/Email.hs index 73406dea5b..2d5dada326 100644 --- a/libs/api-bot/src/Network/Wire/Bot/Email.hs +++ b/libs/api-bot/src/Network/Wire/Bot/Email.hs @@ -78,7 +78,7 @@ instance Exception MailException loadMailboxConfig :: FilePath -> IO [Mailbox] loadMailboxConfig p = do cfg <- LB.readFile p - mbs <- either error return (eitherDecode' cfg) :: IO [MailboxSettings] + mbs <- either error pure (eitherDecode' cfg) :: IO [MailboxSettings] mapM newMailbox mbs newMailbox :: MailboxSettings -> IO Mailbox @@ -88,7 +88,7 @@ newMailbox s@(MailboxSettings host usr pwd conns) = connect = do c <- connectIMAPSSLWithSettings host defaultSettingsIMAPSSL login c (show usr) pwd - return c + pure c -- | Awaits activation e-mail to arrive at a mailbox with -- the designated recipient address. @@ -109,7 +109,7 @@ awaitActivationMail mbox folders from to = do let codeHdr = find ((== "x-zeta-code") . paramName) hdrs case liftM2 (,) keyHdr codeHdr of Just (k, c) -> - return $ + pure $ ( ActivationKey $ Ascii.unsafeFromText $ paramValue k, ActivationCode $ Ascii.unsafeFromText $ paramValue c ) @@ -132,7 +132,7 @@ awaitPasswordResetMail mbox folders from to = do let codeHdr = find ((== "x-zeta-code") . paramName) hdrs case liftM2 (,) keyHdr codeHdr of Just (k, c) -> - return $ + pure $ ( PasswordResetKey $ Ascii.unsafeFromText $ paramValue k, PasswordResetCode $ Ascii.unsafeFromText $ paramValue c ) @@ -153,7 +153,7 @@ awaitInvitationMail mbox folders from to = do let hdrs = mime_val_headers msg let invHdr = find ((== "x-zeta-code") . paramName) hdrs case invHdr of - Just i -> return . read . T.unpack $ paramValue i + Just i -> pure . read . T.unpack $ paramValue i Nothing -> throwIO MissingEmailHeaders awaitMail :: @@ -176,7 +176,7 @@ awaitMail mbox folders from to purpose = go 0 case msgs of [] | t >= timeout -> throwIO EmailTimeout [] -> threadDelay sleep >> go (t + sleep) - (m : ms) -> return (m :| ms) + (m : ms) -> pure (m :| ms) fetchMail :: Mailbox -> @@ -192,7 +192,7 @@ fetchMail :: fetchMail mbox folders from to purpose = withResource (mailboxPool mbox) $ \c -> do msgIds <- concat <$> forM folders (searchMail c) msgs <- mapM (fetch c) msgIds - return $ map (parseMIMEMessage . T.decodeLatin1) msgs + pure $ map (parseMIMEMessage . T.decodeLatin1) msgs where searchMail c folder = do select c folder diff --git a/libs/api-bot/src/Network/Wire/Bot/Monad.hs b/libs/api-bot/src/Network/Wire/Bot/Monad.hs index 26eecef5e6..6e36bc8efb 100644 --- a/libs/api-bot/src/Network/Wire/Bot/Monad.hs +++ b/libs/api-bot/src/Network/Wire/Bot/Monad.hs @@ -158,7 +158,7 @@ newBotNetEnv manager logger o = do gen <- MWC.createSystemRandom let domain = setBotNetFederationDomain o usr <- maybe Cache.empty (Cache.fromFile logger gen domain) (setBotNetUsersFile o) - mbx <- maybe (return []) loadMailboxConfig (setBotNetMailboxConfig o) + mbx <- maybe (pure []) loadMailboxConfig (setBotNetMailboxConfig o) met <- initMetrics let srv = Server @@ -169,7 +169,7 @@ newBotNetEnv manager logger o = do serverSSL = setBotNetApiSSL o, serverManager = manager } - return + pure $! BotNetEnv { botNetGen = gen, botNetMailboxes = mbx, @@ -192,7 +192,7 @@ initMetrics = do m <- Metrics.metrics forM_ counters $ \c -> Metrics.counterGet c m forM_ gauges $ \g -> Metrics.gaugeGet g m - return m + pure m where counters = Metrics.assertionsTotal : @@ -403,7 +403,7 @@ addBotClient self cty label = do cid <- clientId <$> runBotSession self (registerClient nc) clt <- BotClient cid label box <$> liftIO Clients.empty liftIO . atomically $ modifyTVar' (botClients self) (clt :) - return clt + pure clt -- TODO: withBotClient :: MonadBotNet m => Bot -> ClientType -> Maybe Text -> (BotClient -> m a) -> m a @@ -455,7 +455,7 @@ newBot tag = liftBotNet $ do bot <- mkBot tag user pw -- TODO: addBotClient? incrBotsCreatedNew - return bot + pure bot -- | Obtain a "cached" 'Bot' based on an existing user identity. The same -- bot will never be returned again by 'cachedBot'. @@ -466,7 +466,7 @@ cachedBot t = liftBotNet $ do CachedUser p u <- BotNet (asks botNetUsers) >>= Cache.get bot <- mkBot t (tagged t u) p incrBotsCreatedCached - return bot + pure bot -- | Wait for the Bot's assertions to finish (through matching -- an event or through timeout) before killing it (see 'killBot'). @@ -560,20 +560,20 @@ awaitAssertions bot = whenAsserts $ do -- enabled or not. If the requirement fails, a 'RequirementFailed' exception -- is thrown. require :: MonadThrow m => Bool -> Text -> m () -require True _ = return () +require True _ = pure () require False m = throwM $ RequirementFailed m -- | Require a 'Maybe a' to be 'Just a', regardless of whether assertions are -- enabled or not. If it is 'Nothing' a 'RequirementFailed' exception is thrown. requireMaybe :: MonadThrow m => Maybe a -> Text -> m a requireMaybe Nothing m = throwM $ RequirementFailed m -requireMaybe (Just a) _ = return a +requireMaybe (Just a) _ = pure a -- | Require a 'Either e a' to be 'Right a', regardless of whether assertions are -- enabled or not. If it is 'Left e 'RequirementFailed' exception is thrown. requireRight :: (Show e, MonadThrow m) => Either e a -> m a requireRight (Left e) = throwM $ RequirementFailed (pack $ show e) -requireRight (Right a) = return a +requireRight (Right a) = pure a -- TODO: change argument order to match 'assertEqual' from tasty-hunit assertEqual :: (HasCallStack, MonadBotNet m, Show a, Eq a) => a -> a -> Text -> m () @@ -630,11 +630,11 @@ scheduleAssert bot typ f out = whenAsserts $ do r <- liftIO . atomically $ do n <- readTVar (botAssertCount bot) if n >= botMaxAsserts (botSettings bot) - then return False + then pure False else do writeTQueue (botAsserts bot) (EventAssertion typ t f out callStack) writeTVar (botAssertCount bot) (n + 1) - return True + pure True unless r . liftBotNet $ do incrAssertFailed runBotSession bot . log Error . msg $ @@ -675,13 +675,13 @@ try ma = do Left e -> do liftBotNet $ log Error . msg $ show e incrExceptionsTotal - return $ Left e - Right a -> return $ Right a + pure $ Left e + Right a -> pure $ Right a where handlers = - [ Handler $ \e -> return . Left $ BotNetFailure e, - Handler $ \e -> return . Left $ HttpFailure e, - Handler $ \e -> return . Left $ ClientFailure e + [ Handler $ \e -> pure . Left $ BotNetFailure e, + Handler $ \e -> pure . Left $ HttpFailure e, + Handler $ \e -> pure . Left $ ClientFailure e ] ------------------------------------------------------------------------------- @@ -692,7 +692,7 @@ mkBot tag user pw = do log Info $ botLogFields (userId user) tag . msg (val "Login") let ident = fromMaybe (error "No email") (userEmail user) let cred = PasswordLogin (LoginByEmail ident) pw Nothing Nothing - auth <- login cred >>= maybe (throwM LoginFailed) return + auth <- login cred >>= maybe (throwM LoginFailed) pure aref <- nextAuthRefresh auth env <- BotNet ask bot <- @@ -715,7 +715,7 @@ mkBot tag user pw = do when (botNetAssert env) $ writeIORef (botAssertThread bot) . Just =<< async (assert bot env) incrBotsAlive - return bot + pure bot connectPush :: Bot -> BotNetEnv -> IO (Async ()) connectPush bot e = runBotNet e . runBotSession bot $ do @@ -775,7 +775,7 @@ heartbeat bot e = forever $ do <> "\nAssertion was created at: " <> pack (prettyCallStack stack) -- Re-establish the push connection, if it died - push <- maybe (return Nothing) poll =<< readIORef (botPushThread bot) + push <- maybe (pure Nothing) poll =<< readIORef (botPushThread bot) case push of Just x -> do case x of @@ -783,7 +783,7 @@ heartbeat bot e = forever $ do Right _ -> botLog l bot Warn $ msg $ val "Unexpected exit of push thread" a <- connectPush bot e writeIORef (botPushThread bot) (Just a) - Nothing -> return () + Nothing -> pure () assert :: Bot -> BotNetEnv -> IO a assert bot e = forever $ do @@ -807,7 +807,7 @@ matchAssertion bot a@(EventAssertion _ _ f out _) = do modifyTVar' (botAssertCount bot) (subtract 1) incrEventsAckd bot (eventType ev) Nothing -> modifyTVar' (botBacklog bot) (a :) - return found + pure found where go (events, found) (et, ev) | isNothing found && f ev = (events, Just ev) @@ -833,7 +833,7 @@ gcEvents bot now = do when (numDel > 0) $ do writeTVar (botEvents bot) (num - numDel, keep) mapM_ (incrEventsIgnd bot . eventType . snd) del - return $ fmap snd del + pure $ fmap snd del gcBacklog :: Bot -> UTCTime -> STM [EventAssertion] gcBacklog bot now = do @@ -847,12 +847,12 @@ gcBacklog bot now = do forM_ del $ \(EventAssertion typ _ _ out _) -> do for_ out $ flip tryPutTMVar Nothing incrEventsMssd bot typ - return del + pure del nextAuthRefresh :: MonadIO m => Auth -> m UTCTime nextAuthRefresh (Auth _ tok) = liftIO $ do now <- getCurrentTime - return $ (fromInteger (expiresIn tok) - 60) `addUTCTime` now + pure $ (fromInteger (expiresIn tok) - 60) `addUTCTime` now ------------------------------------------------------------------------------- @@ -869,7 +869,7 @@ report t s = do f = showString (unpack t) . showString "-" . showString d $ ".bot" in writeReport (dir f) r Nothing -> printReport r - return r + pure r getMetrics :: MonadBotNet m => m Metrics getMetrics = liftBotNet . BotNet $ asks botNetMetrics @@ -883,7 +883,7 @@ timed p ma = do m <- getMetrics let timeHisto = Metrics.deprecatedRequestDurationHistogram p liftIO $ Metrics.histoSubmit durationInMillis timeHisto m - return a + pure a incrAssertTotal :: MonadBotNet m => m () incrAssertTotal = getMetrics >>= liftIO . Metrics.counterIncr Metrics.assertionsTotal @@ -951,7 +951,7 @@ transferBotMetrics b = ackd <- readTVar $ botEventsAckd (botMetrics b) ignd <- readTVar $ botEventsIgnd (botMetrics b) mssd <- readTVar $ botEventsMssd (botMetrics b) - return [rcvd, ackd, ignd, mssd] + pure [rcvd, ackd, ignd, mssd] -- Update per event type counters let add (p, n) = Metrics.counterAdd n p m mapM_ add (concatMap HashMap.toList l) @@ -981,7 +981,7 @@ randUser (Email loc dom) (BotTag tag) = do pwdUuid <- nextRandom let email = Email (loc <> "+" <> tag <> "-" <> pack (toString uuid)) dom let passw = PlainTextPassword (pack (toString pwdUuid)) - return + pure ( NewUser { newUserDisplayName = Name (tag <> "-Wirebot-" <> pack (toString uuid)), newUserUUID = Nothing, @@ -1005,7 +1005,7 @@ randMailbox :: BotNet Mailbox randMailbox = do e <- BotNet ask i <- liftIO $ MWC.uniformR (0, length (botNetMailboxes e) - 1) (botNetGen e) - return $ botNetMailboxes e !! i + pure $ botNetMailboxes e !! i tagged :: BotTag -> User -> User tagged t u = u {userDisplayName = Name $ unTag t <> "-" <> fromName (userDisplayName u)} diff --git a/libs/api-bot/src/Network/Wire/Bot/Report.hs b/libs/api-bot/src/Network/Wire/Bot/Report.hs index a729ad0cd9..9a59026006 100644 --- a/libs/api-bot/src/Network/Wire/Bot/Report.hs +++ b/libs/api-bot/src/Network/Wire/Bot/Report.hs @@ -71,19 +71,19 @@ createReport :: MonadIO m => Text -> Metrics -> SectionS -> m Report createReport t m (SectionS (Endo f)) = do d <- liftIO getCurrentTime v <- liftIO $ foldM go mempty (concatMap sectionMetrics s) - return $! Report t d s v + pure $! Report t d s v where s = f [] go (Data cs ls bs gs) metric = case metric of Counter _ p -> do v <- counterValue =<< counterGet p m - return $! Data (HashMap.insert p v cs) ls bs gs + pure $! Data (HashMap.insert p v cs) ls bs gs Gauge _ p -> do v <- gaugeValue =<< gaugeGet p m - return $! Data cs ls bs (HashMap.insert p v gs) + pure $! Data cs ls bs (HashMap.insert p v gs) Histogram _ p hi -> do v <- histoGet hi m >>= histoValue - return $! Data cs ls (HashMap.insert p v bs) gs + pure $! Data cs ls (HashMap.insert p v bs) gs ------------------------------------------------------------------------------- diff --git a/libs/api-bot/src/Network/Wire/Bot/Settings.hs b/libs/api-bot/src/Network/Wire/Bot/Settings.hs index 2a3d7139c9..15d0f447b9 100644 --- a/libs/api-bot/src/Network/Wire/Bot/Settings.hs +++ b/libs/api-bot/src/Network/Wire/Bot/Settings.hs @@ -275,7 +275,7 @@ assertTimeoutOption = greater :: (Integral a, Show a) => a -> a -> ReadM a greater n a | a <= n = readerError ("must be > " ++ show n) - | otherwise = return a + | otherwise = pure a bsOption :: Mod OptionFields String -> Parser ByteString bsOption = fmap pack . strOption diff --git a/libs/api-client/src/Network/Wire/Client/API/Asset.hs b/libs/api-client/src/Network/Wire/Client/API/Asset.hs index 9fc48d8318..e68c771947 100644 --- a/libs/api-client/src/Network/Wire/Client/API/Asset.hs +++ b/libs/api-client/src/Network/Wire/Client/API/Asset.hs @@ -69,8 +69,8 @@ getAsset :: MonadSession m => AssetKey -> Maybe AssetToken -> m (Maybe AssetData getAsset key tok = do rs <- sessionRequest req rsc consumeBody liftIO $ case statusCode rs of - 200 -> maybe (unexpected rs "getAsset: missing body") (return . Just) (responseBody rs) - 404 -> return Nothing + 200 -> maybe (unexpected rs "getAsset: missing body") (pure . Just) (responseBody rs) + 404 -> pure Nothing _ -> unexpected rs "getAsset: response code" where req = diff --git a/libs/api-client/src/Network/Wire/Client/API/Auth.hs b/libs/api-client/src/Network/Wire/Client/API/Auth.hs index 12c6c7816e..aaaa54b6e4 100644 --- a/libs/api-client/src/Network/Wire/Client/API/Auth.hs +++ b/libs/api-client/src/Network/Wire/Client/API/Auth.hs @@ -110,17 +110,17 @@ tokenResponse :: IO (Maybe Auth) tokenResponse rq rs ck | statusCode rs == 200 = mkAuth - | statusCode rs == 403 = return Nothing + | statusCode rs == 403 = pure Nothing | otherwise = unexpected rs "tokenResponse: status code" where mkAuth = do cok <- mkCookie $ parseSetCookie <$> getHeader "Set-Cookie" rs tok <- responseJsonThrow (ParseError . pack) rs - return . Just $ Auth cok tok - mkCookie Nothing = maybe (unexpected rs "missing set-cookie") return ck + pure . Just $ Auth cok tok + mkCookie Nothing = maybe (unexpected rs "missing set-cookie") pure ck mkCookie (Just hdr) = do now <- getCurrentTime case generateCookie hdr rq now True of - Just cok | cookie_name cok == "zuid" -> return $ AuthCookie cok + Just cok | cookie_name cok == "zuid" -> pure $ AuthCookie cok Just (cookie_name -> cok) -> unexpected rs $ "unknown cookie: " <> T.decodeLatin1 cok Nothing -> unexpected rs "invalid cookie" diff --git a/libs/api-client/src/Network/Wire/Client/API/Client.hs b/libs/api-client/src/Network/Wire/Client/API/Client.hs index 4d436ce479..ff41887026 100644 --- a/libs/api-client/src/Network/Wire/Client/API/Client.hs +++ b/libs/api-client/src/Network/Wire/Client/API/Client.hs @@ -52,7 +52,7 @@ registerClient a = sessionRequest req rsc readBody rsc = status201 :| [] removeClient :: MonadSession m => ClientId -> RmClient -> m () -removeClient cid r = sessionRequest req rsc (const $ return ()) +removeClient cid r = sessionRequest req rsc (const $ pure ()) where req = method DELETE @@ -73,7 +73,7 @@ getClients = sessionRequest req rsc readBody rsc = status200 :| [] updateClient :: MonadSession m => ClientId -> UpdateClient -> m () -updateClient cid r = sessionRequest req rsc (const $ return ()) +updateClient cid r = sessionRequest req rsc (const $ pure ()) where req = method PUT diff --git a/libs/api-client/src/Network/Wire/Client/API/Conversation.hs b/libs/api-client/src/Network/Wire/Client/API/Conversation.hs index b443e1c78a..577522dd27 100644 --- a/libs/api-client/src/Network/Wire/Client/API/Conversation.hs +++ b/libs/api-client/src/Network/Wire/Client/API/Conversation.hs @@ -72,7 +72,7 @@ addMembers cnv mems = do rs <- sessionRequest req rsc consumeBody case statusCode rs of 200 -> Just <$> responseJsonThrow (ParseError . pack) rs - 204 -> return Nothing + 204 -> pure Nothing _ -> unexpected rs "addMembers: status code" where req = @@ -90,7 +90,7 @@ removeMember cnv mem = do rs <- sessionRequest req rsc consumeBody case statusCode rs of 200 -> Just <$> responseJsonThrow (ParseError . pack) rs - 204 -> return Nothing + 204 -> pure Nothing _ -> unexpected rs "removeMember: status code" where req = @@ -102,7 +102,7 @@ removeMember cnv mem = do -- FUTUREWORK: probably should be 'Wire.API.Conversation.Member.MemberUpdate'. memberUpdate :: MonadSession m => ConvId -> MemberUpdateData -> m () -memberUpdate cnv updt = sessionRequest req rsc (const $ return ()) +memberUpdate cnv updt = sessionRequest req rsc (const $ pure ()) where req = method PUT @@ -117,7 +117,7 @@ getConv cnv = do rs <- sessionRequest req rsc consumeBody case statusCode rs of 200 -> responseJsonThrow (ParseError . pack) rs - 404 -> return Nothing + 404 -> pure Nothing _ -> unexpected rs "getConv: status code" where req = diff --git a/libs/api-client/src/Network/Wire/Client/API/Push.hs b/libs/api-client/src/Network/Wire/Client/API/Push.hs index b74419fb16..cddd7be34c 100644 --- a/libs/api-client/src/Network/Wire/Client/API/Push.hs +++ b/libs/api-client/src/Network/Wire/Client/API/Push.hs @@ -118,7 +118,7 @@ awaitNotifications f = do putMVar latch () >> consume l c `onException` tryPutMVar latch () takeMVar latch - return worker + pure worker where params h p = ConnectionParams h p Nothing Nothing consume l c = forever (WS.receiveData c >>= forward l) `finally` close c @@ -130,7 +130,7 @@ awaitNotifications f = do Right event -> f event Left e -> Log.err l $ Log.msg ("parse-event: " ++ e) readChunk c = (\x -> if C.null x then Nothing else Just x) <$> connectionGetChunk c - writeChunk c = maybe (return ()) (connectionPut c . L.toStrict) + writeChunk c = maybe (pure ()) (connectionPut c . L.toStrict) fetchNotifications :: (MonadSession m, MonadThrow m) => @@ -156,7 +156,7 @@ lastNotification = do rs <- sessionRequest req rsc consumeBody case statusCode rs of 200 -> Just <$> responseJsonThrow (ParseError . pack) rs - 404 -> return Nothing + 404 -> pure Nothing _ -> unexpected rs "last: status code" where req = @@ -279,7 +279,7 @@ instance FromJSON Event where instance FromJSON NotifId where parseJSON = withText "notification-id" $ - maybe (fail "invalid uuid") (return . NotifId) . fromString . T.unpack + maybe (fail "invalid uuid") (pure . NotifId) . fromString . T.unpack instance FromJSON Notification where parseJSON = withObject "notification" $ \o -> @@ -293,7 +293,7 @@ instance FromJSON a => FromJSON (ConvEvent a) where <*> o .: "data" instance FromJSON NoData where - parseJSON Null = return NoData + parseJSON Null = pure NoData parseJSON _ = fail "Unexpected event data. Expecting nothing/null." instance FromJSON UserInfo where diff --git a/libs/api-client/src/Network/Wire/Client/API/User.hs b/libs/api-client/src/Network/Wire/Client/API/User.hs index 7bb4f472e6..7013d48c70 100644 --- a/libs/api-client/src/Network/Wire/Client/API/User.hs +++ b/libs/api-client/src/Network/Wire/Client/API/User.hs @@ -64,8 +64,8 @@ registerUser u = clientRequest req rsc readBody activateKey :: (MonadClient m, MonadUnliftIO m, MonadMask m) => ActivationKey -> ActivationCode -> m Bool activateKey (ActivationKey key) (ActivationCode code) = do - status <- clientRequest req rsc (return . statusCode) - return $ status /= 404 + status <- clientRequest req rsc (pure . statusCode) + pure $ status /= 404 where req = method GET @@ -124,7 +124,7 @@ getConnection u = do rs <- sessionRequest req rsc consumeBody case statusCode rs of 200 -> responseJsonThrow (ParseError . pack) rs - 404 -> return Nothing + 404 -> pure Nothing _ -> unexpected rs "getConnection: status code" where req = diff --git a/libs/api-client/src/Network/Wire/Client/HTTP.hs b/libs/api-client/src/Network/Wire/Client/HTTP.hs index 4e5090d0fa..20a4b499bd 100644 --- a/libs/api-client/src/Network/Wire/Client/HTTP.hs +++ b/libs/api-client/src/Network/Wire/Client/HTTP.hs @@ -80,7 +80,7 @@ clientRequest rq expected f = do [ const $ Handler ( \(e :: ClientException) -> case e of - ErrorResponse c _ _ -> return (canRetry c) + ErrorResponse c _ _ -> pure (canRetry c) x -> throwIO x ), const $ Handler (\(e :: SomeException) -> throwIO e) @@ -123,6 +123,6 @@ mkErrorResponse rs = do (eitherDecode bdy) ) (responseBody r) - return $ case re of + pure $ case re of Left m -> ErrorResponse (statusCode rs) "N/A" m Right e -> ErrorResponse (code e) (label e) (message e) diff --git a/libs/api-client/src/Network/Wire/Client/Session.hs b/libs/api-client/src/Network/Wire/Client/Session.hs index 51aa5f0cad..740a4c6ff9 100644 --- a/libs/api-client/src/Network/Wire/Client/Session.hs +++ b/libs/api-client/src/Network/Wire/Client/Session.hs @@ -75,7 +75,7 @@ sessionRequest :: (Response BodyReader -> IO a) -> m a sessionRequest rq expected f = - either retry return + either retry pure =<< exec ( \rs -> if Bilge.statusCode rs == 401 diff --git a/libs/bilge/src/Bilge/Assert.hs b/libs/bilge/src/Bilge/Assert.hs index 03393bd9bc..71159fcd04 100644 --- a/libs/bilge/src/Bilge/Assert.hs +++ b/libs/bilge/src/Bilge/Assert.hs @@ -90,7 +90,7 @@ io String msg (i, Just m) = printf "%2d: " i ++ err m diff --git a/libs/bilge/src/Bilge/IO.hs b/libs/bilge/src/Bilge/IO.hs index eb3b1f7a3b..18ed2b5b65 100644 --- a/libs/bilge/src/Bilge/IO.hs +++ b/libs/bilge/src/Bilge/IO.hs @@ -128,7 +128,7 @@ instance MonadIO m => MonadHttp (HttpT m) where trivialBodyReader :: ByteString -> IO BodyReader trivialBodyReader bodyBytes = do bodyVar <- newTVarIO bodyBytes - return $ mkBodyReader bodyVar + pure $ mkBodyReader bodyVar where mkBodyReader :: TVar ByteString -> BodyReader mkBodyReader bodyVar = do @@ -300,4 +300,4 @@ consumeBody r = do if null chunks then Nothing else Just (LBS.fromChunks chunks) - return $ r {responseBody = bdy} + pure $ r {responseBody = bdy} diff --git a/libs/bilge/src/Bilge/RPC.hs b/libs/bilge/src/Bilge/RPC.hs index fbdf4bae7b..34bd8d059b 100644 --- a/libs/bilge/src/Bilge/RPC.hs +++ b/libs/bilge/src/Bilge/RPC.hs @@ -95,7 +95,7 @@ rpc' sys r f = do res <- try $ httpLbs rq id case res of Left x -> throwM $ RPCException sys rq x - Right x -> return x + Right x -> pure x rpcExceptionMsg :: RPCException -> Msg -> Msg rpcExceptionMsg (RPCException sys req ex) = @@ -120,6 +120,6 @@ parseResponse :: (LText -> e) -> Response (Maybe LByteString) -> m a -parseResponse f r = either throwM return $ do +parseResponse f r = either throwM pure $ do b <- note (f "no response body") (responseBody r) fmapL (f . pack) (eitherDecode' b) diff --git a/libs/bilge/src/Bilge/Request.hs b/libs/bilge/src/Bilge/Request.hs index b9afd0b88c..99d4acfc38 100644 --- a/libs/bilge/src/Bilge/Request.hs +++ b/libs/bilge/src/Bilge/Request.hs @@ -153,7 +153,7 @@ expectStatus :: (Int -> Bool) -> Request -> Request expectStatus property r = r {Rq.checkResponse = check} where check _ res - | property (HTTP.statusCode (Rq.responseStatus res)) = return () + | property (HTTP.statusCode (Rq.responseStatus res)) = pure () | otherwise = do some <- Lazy.toStrict <$> brReadSome (Rq.responseBody res) 1024 throwHttp $ Rq.StatusCodeException (() <$ res) some @@ -242,4 +242,4 @@ extPort :: URI.URI -> Maybe Word16 extPort u = do a <- u ^. URI.authorityL p <- a ^. URI.authorityPortL - return (fromIntegral (p ^. URI.portNumberL)) + pure (fromIntegral (p ^. URI.portNumberL)) diff --git a/libs/bilge/src/Bilge/Retry.hs b/libs/bilge/src/Bilge/Retry.hs index 0b499b9c18..01f2dc7ab0 100644 --- a/libs/bilge/src/Bilge/Retry.hs +++ b/libs/bilge/src/Bilge/Retry.hs @@ -26,12 +26,12 @@ import Network.HTTP.Client (HttpException (..), HttpExceptionContent (..), respo import Network.HTTP.Types httpHandlers :: Monad m => [a -> Handler m Bool] -httpHandlers = [const . Handler $ return . canRetry] +httpHandlers = [const . Handler $ pure . canRetry] rpcHandlers :: Monad m => [a -> Handler m Bool] rpcHandlers = [ const . Handler $ \(RPCException _ _ cause) -> - return $ maybe False canRetry (fromException cause) + pure $ maybe False canRetry (fromException cause) ] canRetry :: HttpException -> Bool diff --git a/libs/brig-types/src/Brig/Types/Common.hs b/libs/brig-types/src/Brig/Types/Common.hs index b92ec41867..a7a8b3a17a 100644 --- a/libs/brig-types/src/Brig/Types/Common.hs +++ b/libs/brig-types/src/Brig/Types/Common.hs @@ -118,14 +118,14 @@ allPrefixes t = catMaybes $ parsePhonePrefix <$> Text.inits t instance FromJSON PhonePrefix where parseJSON = withText "PhonePrefix" $ \s -> case parsePhonePrefix s of - Just p -> return p + Just p -> pure p Nothing -> fail $ "Invalid phone number prefix: [" ++ show s ++ "]. Expected format similar to E.164 (with 1-15 digits after the +)." instance FromByteString PhonePrefix where - parser = parser >>= maybe (fail "Invalid phone") return . parsePhonePrefix + parser = parser >>= maybe (fail "Invalid phone") pure . parsePhonePrefix instance ToByteString PhonePrefix where builder = builder . fromPhonePrefix diff --git a/libs/brig-types/src/Brig/Types/Instances.hs b/libs/brig-types/src/Brig/Types/Instances.hs index c9e19c7797..de70e73e79 100644 --- a/libs/brig-types/src/Brig/Types/Instances.hs +++ b/libs/brig-types/src/Brig/Types/Instances.hs @@ -32,14 +32,14 @@ import Imports instance Cql PrekeyId where ctype = Tagged IntColumn toCql = CqlInt . fromIntegral . keyId - fromCql (CqlInt i) = return $ PrekeyId (fromIntegral i) + fromCql (CqlInt i) = pure $ PrekeyId (fromIntegral i) fromCql _ = Left "PrekeyId: Int expected" instance Cql ServiceTag where ctype = Tagged BigIntColumn fromCql (CqlBigInt i) = case intToTag i of - Just t -> return t + Just t -> pure t Nothing -> Left $ "unexpected service tag: " ++ show i fromCql _ = Left "service tag: int expected" @@ -73,7 +73,7 @@ instance Cql ServiceKey where s <- required "size" p <- required "pem" case (t :: Int32) of - 0 -> return $! ServiceKey RsaServiceKey s p + 0 -> pure $! ServiceKey RsaServiceKey s p _ -> Left $ "Unexpected service key type: " ++ show t where required :: Cql r => Text -> Either String r diff --git a/libs/brig-types/src/Brig/Types/Intra.hs b/libs/brig-types/src/Brig/Types/Intra.hs index 65e7e822f9..a16610f0b0 100644 --- a/libs/brig-types/src/Brig/Types/Intra.hs +++ b/libs/brig-types/src/Brig/Types/Intra.hs @@ -107,7 +107,7 @@ instance FromJSON UserAccount where parseJSON j@(Object o) = do u <- parseJSON j s <- o .: "status" - return $ UserAccount u s + pure $ UserAccount u s parseJSON _ = mzero instance ToJSON UserAccount where diff --git a/libs/cassandra-util/src/Cassandra/Exec.hs b/libs/cassandra-util/src/Cassandra/Exec.hs index 6cb9c56129..ae7589deb3 100644 --- a/libs/cassandra-util/src/Cassandra/Exec.hs +++ b/libs/cassandra-util/src/Cassandra/Exec.hs @@ -84,9 +84,9 @@ syncCassandra :: (Functor m, MonadIO m, MonadCatch m) => m a -> m (Either Cassan syncCassandra m = catches (Right <$> m) - [ Handler $ \(e :: Error) -> return . Left . Cassandra $ e, - Handler $ \(e :: IOException) -> return . Left . Comm $ e, - Handler $ \(e :: SomeException) -> return . Left . Other $ e + [ Handler $ \(e :: Error) -> pure . Left . Cassandra $ e, + Handler $ \(e :: IOException) -> pure . Left . Comm $ e, + Handler $ \(e :: SomeException) -> pure . Left . Other $ e ] -- | Stream results of a query. @@ -122,7 +122,7 @@ paginateWithState q p = do r <- runQ q p' getResult r >>= \case Protocol.RowsResult m b -> - return $ PageWithState b (pagingState m) + pure $ PageWithState b (pagingState m) _ -> throwM $ UnexpectedResponse (hrHost r) (hrResponse r) paramsPagingState :: Consistency -> a -> Int32 -> Maybe Protocol.PagingState -> QueryParams a diff --git a/libs/cassandra-util/src/Cassandra/Schema.hs b/libs/cassandra-util/src/Cassandra/Schema.hs index 7287bbedf6..b4131b3498 100644 --- a/libs/cassandra-util/src/Cassandra/Schema.hs +++ b/libs/cassandra-util/src/Cassandra/Schema.hs @@ -231,7 +231,7 @@ waitForSchemaConsistency = do mbLocalVersion <- systemLocalVersion peers <- systemPeerVersions case mbLocalVersion of - Just localVersion -> return $ (localVersion, peers) + Just localVersion -> pure $ (localVersion, peers) Nothing -> error "No system_version in system.local (should never happen)" inDisagreement :: (UUID, [UUID]) -> Bool inDisagreement (localVersion, peers) = not $ all (== localVersion) peers @@ -252,26 +252,26 @@ retryWhileN :: (MonadIO m) => Int -> (a -> Bool) -> m a -> m a retryWhileN n f m = retrying (constantDelay 1000000 <> limitRetries n) - (const (return . f)) + (const (pure . f)) (const m) -- | The migrationPolicy selects only one and always the same host migrationPolicy :: IO Policy migrationPolicy = do h <- newIORef Nothing - return $ + pure $ Policy { setup = setHost h, - onEvent = const $ return (), + onEvent = const $ pure (), select = readIORef h, - acceptable = const $ return True, + acceptable = const $ pure True, hostCount = fromIntegral . length . maybeToList <$> readIORef h, display = ("migrationPolicy: " ++) . show <$> readIORef h, current = maybeToList <$> readIORef h } where setHost h (a : _) _ = writeIORef h (Just a) - setHost _ _ _ = return () + setHost _ _ _ = pure () migrationOptsParser :: Parser MigrationOpts migrationOptsParser = diff --git a/libs/cassandra-util/src/Cassandra/Settings.hs b/libs/cassandra-util/src/Cassandra/Settings.hs index c20a6dfc3e..1fb3bf2007 100644 --- a/libs/cassandra-util/src/Cassandra/Settings.hs +++ b/libs/cassandra-util/src/Cassandra/Settings.hs @@ -59,7 +59,7 @@ initialContactsDisco (pack -> srv) url = liftIO $ do . _String & map unpack case ip of - i : ii -> return (i :| ii) + i : ii -> pure (i :| ii) _ -> error "initial-contacts: no IP addresses found." -- | Puts the address into a list using the same signature as the other initialContacts diff --git a/libs/dns-util/src/Wire/Network/DNS/SRV.hs b/libs/dns-util/src/Wire/Network/DNS/SRV.hs index eed0364e25..597eaa9afc 100644 --- a/libs/dns-util/src/Wire/Network/DNS/SRV.hs +++ b/libs/dns-util/src/Wire/Network/DNS/SRV.hs @@ -117,7 +117,7 @@ orderSrvResult = >>> fmap concat where orderSublist :: [SrvEntry] -> IO [SrvEntry] - orderSublist [] = return [] + orderSublist [] = pure [] orderSublist sublist = do -- Compute the running sum, as well as the total sum of the sublist. -- Add the running sum to the SRV tuples. @@ -135,4 +135,4 @@ orderSrvResult = let remainingSrvs = map fst (beginning ++ end) -- Repeat the ordering procedure on the remaining elements. rest <- orderSublist remainingSrvs - return $ firstSrv : rest + pure $ firstSrv : rest diff --git a/libs/gundeck-types/src/Gundeck/Types/Common.hs b/libs/gundeck-types/src/Gundeck/Types/Common.hs index fad0df493d..37208a1339 100644 --- a/libs/gundeck-types/src/Gundeck/Types/Common.hs +++ b/libs/gundeck-types/src/Gundeck/Types/Common.hs @@ -58,4 +58,4 @@ instance FromByteString URI where parser = takeByteString >>= parse . Bytes.unpack parse :: (Monad m, MonadFail m) => String -> m URI -parse = maybe (fail "Invalid URI") (return . URI) . Net.parseURI +parse = maybe (fail "Invalid URI") (pure . URI) . Net.parseURI diff --git a/libs/gundeck-types/src/Gundeck/Types/Push/V2.hs b/libs/gundeck-types/src/Gundeck/Types/Push/V2.hs index f1b708fadd..c491d89963 100644 --- a/libs/gundeck-types/src/Gundeck/Types/Push/V2.hs +++ b/libs/gundeck-types/src/Gundeck/Types/Push/V2.hs @@ -101,9 +101,9 @@ data Route deriving (Eq, Ord, Enum, Bounded, Show) instance FromJSON Route where - parseJSON (String "any") = return RouteAny - parseJSON (String "direct") = return RouteDirect - parseJSON (String "native") = return RouteNative + parseJSON (String "any") = pure RouteAny + parseJSON (String "direct") = pure RouteDirect + parseJSON (String "native") = pure RouteNative parseJSON x = fail $ "Invalid routing: " ++ show (encode x) instance ToJSON Route where diff --git a/libs/metrics-core/src/Data/Metrics.hs b/libs/metrics-core/src/Data/Metrics.hs index 85ef004845..b5fdcbd14c 100644 --- a/libs/metrics-core/src/Data/Metrics.hs +++ b/libs/metrics-core/src/Data/Metrics.hs @@ -150,7 +150,7 @@ toInfo (Path p) = getOrCreate :: (MonadIO m, Eq k, Hashable k) => IORef (HashMap k v) -> k -> IO v -> m v getOrCreate mapRef key initializer = liftIO $ do hMap <- readIORef mapRef - maybe initialize return (HM.lookup key hMap) + maybe initialize pure (HM.lookup key hMap) where initialize = do val <- initializer diff --git a/libs/ropes/src/Ropes/Nexmo.hs b/libs/ropes/src/Ropes/Nexmo.hs index 934b2368ff..1af840932c 100644 --- a/libs/ropes/src/Ropes/Nexmo.hs +++ b/libs/ropes/src/Ropes/Nexmo.hs @@ -113,18 +113,18 @@ data MessageErrorStatus deriving (Eq, Show) instance FromJSON MessageErrorStatus where - parseJSON "1" = return MessageThrottled - parseJSON "5" = return MessageInternal - parseJSON "6" = return MessageUnroutable - parseJSON "7" = return MessageNumBarred - parseJSON "8" = return MessagePartnerAccountBarred - parseJSON "9" = return MessagePartnerQuotaExceeded - parseJSON "12" = return MessageTooLong - parseJSON "13" = return MessageCommunicationFailed - parseJSON "15" = return MessageInvalidSenderAddress - parseJSON "19" = return MessageFacilityNotAllowed - parseJSON "20" = return MessageInvalidMessageClass - parseJSON _ = return MessageOther + parseJSON "1" = pure MessageThrottled + parseJSON "5" = pure MessageInternal + parseJSON "6" = pure MessageUnroutable + parseJSON "7" = pure MessageNumBarred + parseJSON "8" = pure MessagePartnerAccountBarred + parseJSON "9" = pure MessagePartnerQuotaExceeded + parseJSON "12" = pure MessageTooLong + parseJSON "13" = pure MessageCommunicationFailed + parseJSON "15" = pure MessageInvalidSenderAddress + parseJSON "19" = pure MessageFacilityNotAllowed + parseJSON "20" = pure MessageInvalidMessageClass + parseJSON _ = pure MessageOther data MessageErrorResponse = MessageErrorResponse { erStatus :: !MessageErrorStatus, @@ -145,15 +145,15 @@ newtype ParseError = ParseError String instance Exception ParseError instance FromJSON MessageId where - parseJSON = withText "MessageId" $ return . MessageId + parseJSON = withText "MessageId" $ pure . MessageId instance ToJSON MessageId where toJSON = String . messageIdText instance FromJSON Charset where - parseJSON "text" = return GSM7 - parseJSON "binary" = return GSM8 - parseJSON "unicode" = return UCS2 + parseJSON "text" = pure GSM7 + parseJSON "binary" = pure GSM8 + parseJSON "unicode" = pure UCS2 parseJSON x = fail $ "Unsupported charset " <> show x instance ToJSON Charset where @@ -179,8 +179,8 @@ parseMessageResponse = withObject "nexmo-response" $ \o -> do xs <- o .: "messages" ys <- sequence <$> mapM parseMessageFeedback xs case ys of - Left e -> return $ Left e - Right (f : fs) -> return $ Right $ MessageResponse (f :| fs) + Left e -> pure $ Left e + Right (f : fs) -> pure $ Right $ MessageResponse (f :| fs) Right _ -> fail "Must have at least one message-id" -- * Call related @@ -207,14 +207,14 @@ data CallErrorStatus deriving (Eq, Show) instance FromJSON CallErrorStatus where - parseJSON "1" = return CallThrottled - parseJSON "5" = return CallInternal - parseJSON "6" = return CallDestinationNotPermitted - parseJSON "7" = return CallDestinationBarred - parseJSON "9" = return CallPartnerQuotaExceeded - parseJSON "15" = return CallInvalidDestinationAddress - parseJSON "17" = return CallUnroutable - parseJSON _ = return CallOther + parseJSON "1" = pure CallThrottled + parseJSON "5" = pure CallInternal + parseJSON "6" = pure CallDestinationNotPermitted + parseJSON "7" = pure CallDestinationBarred + parseJSON "9" = pure CallPartnerQuotaExceeded + parseJSON "15" = pure CallInvalidDestinationAddress + parseJSON "17" = pure CallUnroutable + parseJSON _ = pure CallOther data CallErrorResponse = CallErrorResponse { caStatus :: !CallErrorStatus, @@ -264,7 +264,7 @@ sendCall cr mgr call = httpLbs req mgr >>= parseResult where parseResult res = case parseEither parseCallResponse =<< eitherDecode (responseBody res) of Left e -> throwIO $ ParseError e - Right r -> either throwIO return r + Right r -> either throwIO pure r req = defaultRequest { method = "POST", @@ -331,7 +331,7 @@ sendMessages cr mgr msgs = forM msgs $ \m -> httpLbs (req m) mgr >>= parseResult where parseResult res = case parseEither parseMessageResponse =<< eitherDecode (responseBody res) of Left e -> throwIO $ ParseError e - Right r -> either throwIO return r + Right r -> either throwIO pure r req m = defaultRequest { method = "POST", diff --git a/libs/ropes/src/Ropes/Twilio.hs b/libs/ropes/src/Ropes/Twilio.hs index eefbf53226..5696708135 100644 --- a/libs/ropes/src/Ropes/Twilio.hs +++ b/libs/ropes/src/Ropes/Twilio.hs @@ -142,9 +142,9 @@ instance FromJSON CarrierInfo where instance FromJSON PhoneType where parseJSON = withText "PhoneType" $ \t -> case t of - "mobile" -> return Mobile - "landline" -> return Landline - "voip" -> return VoIp + "mobile" -> pure Mobile + "landline" -> pure Landline + "voip" -> pure VoIp x -> fail $ "Unexpected phone type: " ++ show x -- * Functions @@ -161,7 +161,7 @@ sendMessages cr mgr msgs = forM msgs $ \m -> do rsp <- httpLbs req mgr if responseStatus rsp == status201 then case eitherDecode (responseBody rsp) of - Right r -> return $ msgId r + Right r -> pure $ msgId r Left e -> throwIO $ ParseError e else case eitherDecode (responseBody rsp) of Right e -> throwIO (e :: ErrorResponse) @@ -194,7 +194,7 @@ lookupPhone cr mgr phone detail country = do rsp <- httpLbs req mgr if responseStatus rsp == status200 then case eitherDecode (responseBody rsp) of - Right r -> return r + Right r -> pure r Left e -> throwIO $ ParseError e else case eitherDecode (responseBody rsp) of Right e -> throwIO (e :: ErrorResponse) diff --git a/libs/ssl-util/src/Ssl/Util.hs b/libs/ssl-util/src/Ssl/Util.hs index 5fc17fc3da..9f9d8ece4e 100644 --- a/libs/ssl-util/src/Ssl/Util.hs +++ b/libs/ssl-util/src/Ssl/Util.hs @@ -128,7 +128,7 @@ verifyFingerprint :: SSL -> IO () verifyFingerprint hash fprs ssl = do - cert <- SSL.getPeerCertificate ssl >>= maybe (throwIO PinMissingCert) return + cert <- SSL.getPeerCertificate ssl >>= maybe (throwIO PinMissingCert) pure pkey <- X509.getPublicKey cert mfpr <- hash pkey case mfpr of @@ -161,13 +161,13 @@ rsaFingerprint d k = fmap (digestLBS d . toLazyByteString) $ do let s = rsaSize k n <- integerToMPI (rsaN k) e <- integerToMPI (rsaE k) - return $! intDec s <> byteString n <> byteString e + pure $! intDec s <> byteString n <> byteString e -- | 'verifyFingerprint' specialised to 'RSAPubKey's using 'rsaFingerprint'. verifyRsaFingerprint :: Digest -> [ByteString] -> SSL -> IO () verifyRsaFingerprint d = verifyFingerprint $ \pk -> case toPublicKey pk of - Nothing -> return Nothing + Nothing -> pure Nothing Just k -> Just <$> rsaFingerprint d (k :: RSAPubKey) -- [Note: Hostname verification] diff --git a/libs/tasty-cannon/src/Test/Tasty/Cannon.hs b/libs/tasty-cannon/src/Test/Tasty/Cannon.hs index 57c8cfd78e..f7f556886f 100644 --- a/libs/tasty-cannon/src/Test/Tasty/Cannon.hs +++ b/libs/tasty-cannon/src/Test/Tasty/Cannon.hs @@ -114,7 +114,7 @@ connectAsMaybeClient can uid client conn = liftIO $ do nchan <- newTChanIO latch <- newEmptyMVar wsapp <- run can uid client conn (clientApp nchan latch) - return $ WebSocket nchan latch wsapp + pure $ WebSocket nchan latch wsapp close :: MonadIO m => WebSocket -> m () close ws = liftIO $ do @@ -299,7 +299,7 @@ awaitMatch t ws match = go [] [] do liftIO (match n) refill buf - return (Right n) + pure (Right n) `catchAll` \e -> case asyncExceptionFromException e of Just x -> throwM (x :: SomeAsyncException) Nothing -> @@ -307,7 +307,7 @@ awaitMatch t ws match = go [] [] in go (n : buf) (e' : errs) Nothing -> do refill buf - return (Left (MatchTimeout errs)) + pure (Left (MatchTimeout errs)) refill = mapM_ (liftIO . atomically . writeTChan (wsChan ws)) awaitMatch_ :: @@ -367,7 +367,7 @@ assertMatchN_ :: assertMatchN_ t wss f = void $ assertMatchN t wss f assertSuccess :: (HasCallStack, MonadIO m, MonadThrow m) => Either MatchTimeout Notification -> m Notification -assertSuccess = either throwM return +assertSuccess = either throwM pure assertNoEvent :: (HasCallStack, MonadIO m, MonadCatch m) => Timeout -> [WebSocket] -> m () assertNoEvent t ww = do @@ -393,7 +393,7 @@ unpackPayload = fmap decodeEvent . ntfPayload randomConnId :: MonadIO m => m ConnId randomConnId = liftIO $ do r <- randomIO :: IO Word32 - return . ConnId $ C.pack $ show r + pure . ConnId $ C.pack $ show r ----------------------------------------------------------------------------- -- Internals @@ -419,7 +419,7 @@ run cannon@(($ Http.defaultRequest) -> ca) uid client connId app = liftIO $ do stat <- poll wsapp case stat of Just (Left ex) -> throwIO ex - _ -> waitForRegistry numRetries >> return wsapp + _ -> waitForRegistry numRetries >> pure wsapp where caHost = C.unpack (Http.host ca) caPort = Http.port ca diff --git a/libs/types-common-aws/src/Util/Test/SQS.hs b/libs/types-common-aws/src/Util/Test/SQS.hs index 8a75b0d235..22d8e03e15 100644 --- a/libs/types-common-aws/src/Util/Test/SQS.hs +++ b/libs/types-common-aws/src/Util/Test/SQS.hs @@ -62,7 +62,7 @@ readAndDeleteAllUntilEmpty url = do firstBatch <- fromMaybe [] . view SQS.receiveMessageResponse_messages <$> sendEnv (receive 1 url) readUntilEmpty firstBatch firstBatch where - readUntilEmpty acc [] = return acc + readUntilEmpty acc [] = pure acc readUntilEmpty acc msgs = do forM_ msgs $ deleteMessage url newMsgs <- fromMaybe [] . view SQS.receiveMessageResponse_messages <$> sendEnv (receive 1 url) @@ -103,12 +103,12 @@ parseDeleteMessage :: (Monad m, Message a, MonadIO m, MonadReader AWS.Env m, Mon parseDeleteMessage url m = do let decodedMessage = decodeMessage <=< (B64.decode . Text.encodeUtf8) evt <- case decodedMessage <$> (m ^. SQS.message_body) of - Just (Right e) -> return (Just e) + Just (Right e) -> pure (Just e) _ -> do liftIO $ print ("Failed to parse SQS message or event" :: String) - return Nothing + pure Nothing deleteMessage url m - return evt + pure evt queueMessage :: (MonadReader AWS.Env m, Message a, MonadResource m) => Text -> a -> m () queueMessage url e = do @@ -144,10 +144,10 @@ tryMatch label tries url callback = go tries check e = do liftIO $ callback label e - return (Right $ show e) + pure (Right $ show e) `catchAll` \ex -> case asyncExceptionFromException ex of Just x -> throwM (x :: SomeAsyncException) - Nothing -> return . Left $ MatchFailure (e, ex) + Nothing -> pure . Left $ MatchFailure (e, ex) sendEnv :: (MonadReader AWS.Env m, MonadResource m, AWS.AWSRequest a) => a -> m (AWS.AWSResponse a) sendEnv x = flip AWS.send x =<< ask diff --git a/libs/types-common/src/Data/Id.hs b/libs/types-common/src/Data/Id.hs index 2c753f779a..65fa107a96 100644 --- a/libs/types-common/src/Data/Id.hs +++ b/libs/types-common/src/Data/Id.hs @@ -190,7 +190,7 @@ instance FromByteString (Id a) where void $ Atto.count 12 hexDigit case UUID.fromASCIIBytes match of Nothing -> fail "Invalid UUID" - Just ui -> return (Id ui) + Just ui -> pure (Id ui) where matching = fmap fst . Atto.match hexDigit = Atto.satisfy Char.isHexDigit "hexadecimal digit" @@ -316,7 +316,7 @@ instance EncodeWire ClientId where encodeWire t = encodeWire t . client instance DecodeWire ClientId where - decodeWire (DelimitedField _ x) = either fail return (runParser parser x) + decodeWire (DelimitedField _ x) = either fail pure (runParser parser x) decodeWire _ = fail "Invalid ClientId" -- BotId ----------------------------------------------------------------------- diff --git a/libs/types-common/src/Data/Misc.hs b/libs/types-common/src/Data/Misc.hs index 85ad78537c..0807be0e76 100644 --- a/libs/types-common/src/Data/Misc.hs +++ b/libs/types-common/src/Data/Misc.hs @@ -103,7 +103,7 @@ instance FromByteString IpAddr where s <- Chars.takeWhile1 (not . isSpace) case readMaybe (unpack s) of Nothing -> fail "Failed parsing bytestring as IpAddr." - Just ip -> return (IpAddr ip) + Just ip -> pure (IpAddr ip) instance ToByteString IpAddr where builder = string8 . show . ipAddr @@ -136,7 +136,7 @@ instance FromJSON IpAddr where parseJSON = A.withText "IpAddr" $ \txt -> case readMaybe (Text.unpack txt) of Nothing -> fail "Failed parsing IP address." - Just ip -> return (IpAddr ip) + Just ip -> pure (IpAddr ip) instance ToJSON Port where toJSON (Port p) = toJSON p @@ -198,7 +198,7 @@ instance Cql Latitude where toCql (Latitude x) = CqlDouble x - fromCql (CqlDouble x) = return (Latitude x) + fromCql (CqlDouble x) = pure (Latitude x) fromCql _ = Left "Latitude: Expected CqlDouble." instance Cql Longitude where @@ -206,7 +206,7 @@ instance Cql Longitude where toCql (Longitude x) = CqlDouble x - fromCql (CqlDouble x) = return (Longitude x) + fromCql (CqlDouble x) = pure (Longitude x) fromCql _ = Left "Longitude: Expected CqlDouble." -------------------------------------------------------------------------------- @@ -329,7 +329,7 @@ instance Cql (Fingerprint a) where ctype = Tagged BlobColumn toCql = CqlBlob . toByteString - fromCql (CqlBlob b) = return (Fingerprint (toStrict b)) + fromCql (CqlBlob b) = pure (Fingerprint (toStrict b)) fromCql _ = Left "Fingerprint: Expected CqlBlob" instance Arbitrary (Fingerprint Rsa) where diff --git a/libs/types-common/src/Data/Range.hs b/libs/types-common/src/Data/Range.hs index d46bb82171..137b1ed840 100644 --- a/libs/types-common/src/Data/Range.hs +++ b/libs/types-common/src/Data/Range.hs @@ -116,7 +116,7 @@ instance ToJSON a => ToJSON (Range n m a) where toJSON = toJSON . fromRange instance (Within a n m, FromJSON a) => FromJSON (Range n m a) where - parseJSON v = parseJSON v >>= maybe (msg sing sing) return . checked + parseJSON v = parseJSON v >>= maybe (msg sing sing) pure . checked where msg :: Bounds a => SNat n -> SNat m -> Aeson.Parser (Range n m a) msg sn sm = fail (errorMsg (fromSing sn) (fromSing sm) "") @@ -184,7 +184,7 @@ instance (Within a n m, ToSchema a, HasRangedSchemaDocModifier NamedSwaggerDoc a instance (Within a n m, Cql a) => Cql (Range n m a) where ctype = retag (ctype :: Tagged a ColumnType) toCql = toCql . fromRange - fromCql c = fromCql c >>= maybe (msg sing sing) return . checked + fromCql c = fromCql c >>= maybe (msg sing sing) pure . checked where msg :: Bounds a => SNat n -> SNat m -> Either String (Range n m a) msg sn sm = Left (errorMsg (fromSing sn) (fromSing sm) "") @@ -423,7 +423,7 @@ instance (Within a n m, Read a) => Read (Range n m a) where ----------------------------------------------------------------------------- instance (Within a n m, FromByteString a) => FromByteString (Range n m a) where - parser = parser >>= maybe (msg sing sing) return . checked + parser = parser >>= maybe (msg sing sing) pure . checked where msg :: Bounds a => SNat n -> SNat m -> Atto.Parser (Range n m a) msg sn sm = fail (errorMsg (fromSing sn) (fromSing sm) "") diff --git a/libs/types-common/src/Util/Options.hs b/libs/types-common/src/Util/Options.hs index 1efc65d75c..c3991f4018 100644 --- a/libs/types-common/src/Util/Options.hs +++ b/libs/types-common/src/Util/Options.hs @@ -47,31 +47,31 @@ instance FromByteString AWSEndpoint where parser = do url <- uriParser strictURIParserOptions secure <- case url ^. uriSchemeL . schemeBSL of - "https" -> return True - "http" -> return False + "https" -> pure True + "http" -> pure False x -> fail ("Unsupported scheme: " ++ show x) host <- case url ^. authorityL <&> view (authorityHostL . hostBSL) of - Just h -> return h + Just h -> pure h Nothing -> fail ("No host in: " ++ show url) port <- case urlPort url of - Just p -> return p + Just p -> pure p Nothing -> - return $ + pure $ if secure then 443 else 80 - return $ AWSEndpoint host secure port + pure $ AWSEndpoint host secure port instance FromJSON AWSEndpoint where parseJSON = withText "AWSEndpoint" $ - either fail return . runParser parser . encodeUtf8 + either fail pure . runParser parser . encodeUtf8 urlPort :: URIRef Absolute -> Maybe Int urlPort u = do a <- u ^. authorityL p <- a ^. authorityPortL - return (fromIntegral (p ^. portNumberL)) + pure (fromIntegral (p ^. portNumberL)) makeLenses ''AWSEndpoint @@ -110,7 +110,7 @@ loadSecret (FilePathSecrets p) = do exists <- doesFileExist path if exists then over _Left show . decodeEither' <$> BS.readFile path - else return (Left "File doesn't exist") + else pure (Left "File doesn't exist") getOptions :: FromJSON a => @@ -130,7 +130,7 @@ getOptions desc pars defaultPath = do configFile <- decodeFileEither path case configFile of Left e -> fail $ show e - Right o -> return o + Right o -> pure o -- Config doesn't exist but at least we have a CLI options parser (False, Just p) -> do hPutStrLn stderr $ @@ -160,7 +160,7 @@ parseConfigPath defaultPath desc = do <> value defaultPath parseAWSEndpoint :: ReadM AWSEndpoint -parseAWSEndpoint = readerAsk >>= maybe (error "Could not parse AWS endpoint") return . fromByteString . fromString +parseAWSEndpoint = readerAsk >>= maybe (error "Could not parse AWS endpoint") pure . fromByteString . fromString discoUrlParser :: Parser Text discoUrlParser = diff --git a/libs/types-common/src/Util/Test.hs b/libs/types-common/src/Util/Test.hs index 629de9301e..6661953245 100644 --- a/libs/types-common/src/Util/Test.hs +++ b/libs/types-common/src/Util/Test.hs @@ -32,12 +32,12 @@ newtype IntegrationConfigFile = IntegrationConfigFile String instance IsOption IntegrationConfigFile where defaultValue = IntegrationConfigFile "/etc/wire/integration/integration.yaml" parseValue = fmap IntegrationConfigFile . safeRead - optionName = return "integration-config" - optionHelp = return "Integration config file to read from" + optionName = pure "integration-config" + optionHelp = pure "Integration config file to read from" optionCLParser = fmap IntegrationConfigFile $ strOption $ - ( short (untag (return 'i' :: Tagged IntegrationConfigFile Char)) + ( short (untag (pure 'i' :: Tagged IntegrationConfigFile Char)) <> long (untag (optionName :: Tagged IntegrationConfigFile String)) <> help (untag (optionHelp :: Tagged IntegrationConfigFile String)) ) diff --git a/libs/wai-utilities/src/Network/Wai/Utilities/Request.hs b/libs/wai-utilities/src/Network/Wai/Utilities/Request.hs index c07d29782a..878311f164 100644 --- a/libs/wai-utilities/src/Network/Wai/Utilities/Request.hs +++ b/libs/wai-utilities/src/Network/Wai/Utilities/Request.hs @@ -82,7 +82,7 @@ jsonRequest :: Predicate r Error (JsonRequest body) jsonRequest = contentType "application" "json" - .&> (return . JsonRequest . getRequest) + .&> (pure . JsonRequest . getRequest) newtype OptionalJsonRequest body = OptionalJsonRequest {fromOptionalJsonRequest :: Request} @@ -92,7 +92,7 @@ optionalJsonRequest :: Predicate r Error (OptionalJsonRequest body) optionalJsonRequest = opt (contentType "application" "json") - .&> (return . OptionalJsonRequest . getRequest) + .&> (pure . OptionalJsonRequest . getRequest) ---------------------------------------------------------------------------- -- Instances diff --git a/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs b/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs index ecc24eb55c..8bbf528649 100644 --- a/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs +++ b/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs @@ -103,11 +103,11 @@ newSettings (Server h p l m t) = do -- (Atomically) initialise the standard metrics, to avoid races. void $ gaugeGet (path "net.connections") m void $ counterGet (path "net.errors") m - return $ + pure $ setHost (fromString h) . setPort (fromIntegral p) . setBeforeMainLoop logStart - . setOnOpen (const $ connStart >> return True) + . setOnOpen (const $ connStart >> pure True) . setOnClose (const connEnd) . setTimeout (fromMaybe 300 t) $ defaultSettings @@ -148,7 +148,7 @@ runSettingsWithShutdown s app secs = do compile :: Monad m => Routes a m b -> Tree (App m) compile routes = Route.prepare (Route.renderer predicateError >> routes) where - predicateError e = return (encode $ Wai.mkError (P.status e) "client-error" (format e), [jsonContent]) + predicateError e = pure (encode $ Wai.mkError (P.status e) "client-error" (format e), [jsonContent]) -- [label] 'source' reason: message format e = let l = labelStr $ labels e @@ -277,7 +277,7 @@ emitLByteString :: LByteString -> IO (IO ByteString) emitLByteString lbs = do tvar <- newTVarIO (cs lbs) -- Emit the bytestring on the first read, then always return "" on subsequent reads - return . atomically $ swapTVar tvar mempty + pure . atomically $ swapTVar tvar mempty -- | Run the 'Application'; check the response status; if >=500, throw a 'Wai.Error' with -- label @"server-error"@ and the body as the error message. diff --git a/libs/wai-utilities/src/Network/Wai/Utilities/ZAuth.hs b/libs/wai-utilities/src/Network/Wai/Utilities/ZAuth.hs index 14f2fc7a92..c70d65f7a6 100644 --- a/libs/wai-utilities/src/Network/Wai/Utilities/ZAuth.hs +++ b/libs/wai-utilities/src/Network/Wai/Utilities/ZAuth.hs @@ -73,7 +73,7 @@ zauthType = zheader "Z-Type" zauth :: HasHeaders r => ZAuthType -> Predicate r Error () zauth t = do r <- zauthType - return $ case r of + pure $ case r of Okay _ z | z == t -> Okay 0 () _ -> Fail accessDenied diff --git a/libs/zauth/main/Main.hs b/libs/zauth/main/Main.hs index cbcfaf7ff9..e09be731bf 100644 --- a/libs/zauth/main/Main.hs +++ b/libs/zauth/main/Main.hs @@ -123,7 +123,7 @@ uuid :: ByteString -> UUID uuid s = fromMaybe (error $ "Invalid UUID: " ++ show s) $ fromASCIIBytes s check' :: ToByteString a => ByteString -> Token a -> IO () -check' k t = exceptT (\e -> putStrLn e >> exitFailure) (const $ return ()) $ do +check' k t = exceptT (\e -> putStrLn e >> exitFailure) (const $ pure ()) $ do p <- hoistEither $ PublicKey <$> decode k e <- liftIO $ runValidate (V.mkEnv p (replicate (t ^. header . key) p)) (check t) hoistEither $ fmapL show e @@ -181,14 +181,14 @@ options = <> help "token data" toMode = readerAsk >>= \s -> case s of - "create-user" -> return CreateUser - "create-session" -> return CreateSession - "create-access" -> return CreateAccess - "create-bot" -> return CreateBot - "create-provider" -> return CreateProvider - "verify-user" -> return VerifyUser - "verify-access" -> return VerifyAccess - "verify-bot" -> return VerifyBot - "verify-provider" -> return VerifyProvider - "gen-keypair" -> return GenKeyPair + "create-user" -> pure CreateUser + "create-session" -> pure CreateSession + "create-access" -> pure CreateAccess + "create-bot" -> pure CreateBot + "create-provider" -> pure CreateProvider + "verify-user" -> pure VerifyUser + "verify-access" -> pure VerifyAccess + "verify-bot" -> pure VerifyBot + "verify-provider" -> pure VerifyProvider + "gen-keypair" -> pure GenKeyPair other -> readerError $ "invalid mode: " <> other diff --git a/libs/zauth/src/Data/ZAuth/Creation.hs b/libs/zauth/src/Data/ZAuth/Creation.hs index 003dd4c259..179317a726 100644 --- a/libs/zauth/src/Data/ZAuth/Creation.hs +++ b/libs/zauth/src/Data/ZAuth/Creation.hs @@ -156,7 +156,7 @@ newToken ti ty ta a = do k <- Create $ asks keyIdx let h = mkHeader tokenVersion k (floor ti) ty ta s <- signToken h a - return $ mkToken s h a + pure $ mkToken s h a ----------------------------------------------------------------------------- -- Internal diff --git a/libs/zauth/src/Data/ZAuth/Token.hs b/libs/zauth/src/Data/ZAuth/Token.hs index ff4a03b1a5..a4319822dc 100644 --- a/libs/zauth/src/Data/ZAuth/Token.hs +++ b/libs/zauth/src/Data/ZAuth/Token.hs @@ -189,42 +189,42 @@ instance FromByteString (Token Access) where takeLazyByteString >>= \b -> case readToken A readAccessBody b of Nothing -> fail "Invalid access token" - Just t -> return t + Just t -> pure t instance FromByteString (Token User) where parser = takeLazyByteString >>= \b -> case readToken U readUserBody b of Nothing -> fail "Invalid user token" - Just t -> return t + Just t -> pure t instance FromByteString (Token Bot) where parser = takeLazyByteString >>= \b -> case readToken B readBotBody b of Nothing -> fail "Invalid bot token" - Just t -> return t + Just t -> pure t instance FromByteString (Token Provider) where parser = takeLazyByteString >>= \b -> case readToken P readProviderBody b of Nothing -> fail "Invalid provider token" - Just t -> return t + Just t -> pure t instance FromByteString (Token LegalHoldAccess) where parser = takeLazyByteString >>= \b -> case readToken LA readLegalHoldAccessBody b of Nothing -> fail "Invalid access token" - Just t -> return t + Just t -> pure t instance FromByteString (Token LegalHoldUser) where parser = takeLazyByteString >>= \b -> case readToken LU readLegalHoldUserBody b of Nothing -> fail "Invalid user token" - Just t -> return t + Just t -> pure t instance ToByteString a => ToByteString (Token a) where builder = writeToken diff --git a/libs/zauth/src/Data/ZAuth/Validation.hs b/libs/zauth/src/Data/ZAuth/Validation.hs index 6bafd2e87e..97c2a96836 100644 --- a/libs/zauth/src/Data/ZAuth/Validation.hs +++ b/libs/zauth/src/Data/ZAuth/Validation.hs @@ -104,13 +104,13 @@ validate Nothing Nothing = throwError Invalid validate (Just _) Nothing = throwError Invalid validate Nothing (Just t) = validateAccess t validate (Just c) (Just t) = do - u <- maybe (throwError Invalid) return (fromByteString c) - a <- maybe (throwError Invalid) return (fromByteString t) + u <- maybe (throwError Invalid) pure (fromByteString c) + a <- maybe (throwError Invalid) pure (fromByteString t) void $ check u void $ check a unless (u ^. body . user == a ^. body . userId) $ throwError Invalid - return a + pure a check :: ToByteString a => Token a -> Validate (Token a) check t = do @@ -124,11 +124,11 @@ check t = do throwError Falsified isExpired <- if t ^. header . time == -1 - then return False + then pure False else (t ^. header . time <) <$> now when isExpired $ throwError Expired - return t + pure t now :: (Functor m, MonadIO m) => m Integer now = floor <$> liftIO getPOSIXTime diff --git a/libs/zauth/test/Arbitraries.hs b/libs/zauth/test/Arbitraries.hs index 7bdc155f8d..16d2f9c8d6 100644 --- a/libs/zauth/test/Arbitraries.hs +++ b/libs/zauth/test/Arbitraries.hs @@ -83,7 +83,7 @@ instance Arbitrary Type where arbitrary = elements [A, U, LA, LU] instance Arbitrary Tag where - arbitrary = return S + arbitrary = pure S instance Bounded UUID where minBound = nil diff --git a/libs/zauth/test/ZAuth.hs b/libs/zauth/test/ZAuth.hs index bd2e5d472d..1b6fd4d518 100644 --- a/libs/zauth/test/ZAuth.hs +++ b/libs/zauth/test/ZAuth.hs @@ -42,7 +42,7 @@ tests = do (p3, s3) <- newKeyPair z <- C.mkEnv s1 [s2, s3] let v = V.mkEnv p1 [p2, p3] - return $ + pure $ testGroup "ZAuth" [ testGroup From e57adacf41a10c0ea5fe167d620fae2eb88fda33 Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Thu, 9 Jun 2022 08:19:44 +0000 Subject: [PATCH 09/29] Fixed formatting after rebase. --- .../src/Network/Wire/Bot/Crypto/Glue.hs | 2 - .../Network/Wire/Client/API/Conversation.hs | 1 - libs/brig-types/src/Brig/Types/Connection.hs | 2 - .../src/Brig/Types/Team/LegalHold.hs | 1 - .../test/unit/Test/Brig/Types/User.hs | 2 - libs/cassandra-util/src/Cassandra/Schema.hs | 30 ++++++++------ libs/extended/src/Servant/API/Extended.hs | 2 - libs/extended/src/System/Logger/Extended.hs | 4 +- .../test/unit/Test/Galley/Types.hs | 1 - .../src/Gundeck/Types/Presence.hs | 1 - libs/metrics-wai/src/Data/Metrics/WaiRoute.hs | 2 - libs/ropes/src/Ropes/Nexmo.hs | 1 - libs/types-common-aws/src/Util/Test/SQS.hs | 1 - libs/types-common/src/Data/Id.hs | 2 +- libs/types-common/src/Data/Text/Ascii.hs | 1 - libs/types-common/src/Util/Options/Common.hs | 4 -- libs/types-common/src/Util/Test.hs | 2 - .../src/Wire/API/Routes/Public/Brig.hs | 40 +++++++++---------- 18 files changed, 41 insertions(+), 58 deletions(-) diff --git a/libs/api-bot/src/Network/Wire/Bot/Crypto/Glue.hs b/libs/api-bot/src/Network/Wire/Bot/Crypto/Glue.hs index 18760524bb..c0eec265b0 100644 --- a/libs/api-bot/src/Network/Wire/Bot/Crypto/Glue.hs +++ b/libs/api-bot/src/Network/Wire/Bot/Crypto/Glue.hs @@ -1,5 +1,3 @@ - - -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2022 Wire Swiss GmbH diff --git a/libs/api-client/src/Network/Wire/Client/API/Conversation.hs b/libs/api-client/src/Network/Wire/Client/API/Conversation.hs index 577522dd27..3dc4ace781 100644 --- a/libs/api-client/src/Network/Wire/Client/API/Conversation.hs +++ b/libs/api-client/src/Network/Wire/Client/API/Conversation.hs @@ -1,6 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} - -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2022 Wire Swiss GmbH diff --git a/libs/brig-types/src/Brig/Types/Connection.hs b/libs/brig-types/src/Brig/Types/Connection.hs index a1820e3811..eaac6f88ed 100644 --- a/libs/brig-types/src/Brig/Types/Connection.hs +++ b/libs/brig-types/src/Brig/Types/Connection.hs @@ -1,7 +1,5 @@ - {-# LANGUAGE OverloadedStrings #-} - -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2022 Wire Swiss GmbH diff --git a/libs/brig-types/src/Brig/Types/Team/LegalHold.hs b/libs/brig-types/src/Brig/Types/Team/LegalHold.hs index 42ce2926e2..5156e6ca63 100644 --- a/libs/brig-types/src/Brig/Types/Team/LegalHold.hs +++ b/libs/brig-types/src/Brig/Types/Team/LegalHold.hs @@ -1,4 +1,3 @@ - {-# LANGUAGE OverloadedStrings #-} -- This file is part of the Wire Server implementation. diff --git a/libs/brig-types/test/unit/Test/Brig/Types/User.hs b/libs/brig-types/test/unit/Test/Brig/Types/User.hs index c0be5ac26e..a3c2002bc9 100644 --- a/libs/brig-types/test/unit/Test/Brig/Types/User.hs +++ b/libs/brig-types/test/unit/Test/Brig/Types/User.hs @@ -1,11 +1,9 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} - {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} - {-# OPTIONS_GHC -Wno-orphans #-} -- This file is part of the Wire Server implementation. diff --git a/libs/cassandra-util/src/Cassandra/Schema.hs b/libs/cassandra-util/src/Cassandra/Schema.hs index b4131b3498..5205078b9e 100644 --- a/libs/cassandra-util/src/Cassandra/Schema.hs +++ b/libs/cassandra-util/src/Cassandra/Schema.hs @@ -276,16 +276,19 @@ migrationPolicy = do migrationOptsParser :: Parser MigrationOpts migrationOptsParser = MigrationOpts - <$> strOption ( - long "host" - <> metavar "HOST" - <> value "localhost" - <> help "Cassandra host") - <*> option auto ( - long "port" - <> metavar "PORT" - <> value 9042 - <> help "Cassandra port") + <$> strOption + ( long "host" + <> metavar "HOST" + <> value "localhost" + <> help "Cassandra host" + ) + <*> option + auto + ( long "port" + <> metavar "PORT" + <> value 9042 + <> help "Cassandra port" + ) <*> ( fmap pack . strOption $ long "keyspace" <> metavar "STRING" @@ -302,6 +305,7 @@ migrationOptsParser = <> help "Replication Map (i.e. \"eu-west:3,us-east:3\")" ) ) - <*> switch ( - long "reset" - <> help "Reset the keyspace before running migrations") + <*> switch + ( long "reset" + <> help "Reset the keyspace before running migrations" + ) diff --git a/libs/extended/src/Servant/API/Extended.hs b/libs/extended/src/Servant/API/Extended.hs index 8842b1763b..e045711599 100644 --- a/libs/extended/src/Servant/API/Extended.hs +++ b/libs/extended/src/Servant/API/Extended.hs @@ -1,5 +1,3 @@ - - -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2022 Wire Swiss GmbH diff --git a/libs/extended/src/System/Logger/Extended.hs b/libs/extended/src/System/Logger/Extended.hs index a66f732469..34de83ee42 100644 --- a/libs/extended/src/System/Logger/Extended.hs +++ b/libs/extended/src/System/Logger/Extended.hs @@ -149,7 +149,9 @@ netStringsToLogFormat False = Plain mkLogger :: Log.Level -> Maybe (Last Bool) -> Maybe (Last LogFormat) -> IO Log.Logger mkLogger lvl useNetstrings logFormat = do mkLoggerNew lvl $ - maybe Plain getLast + maybe + Plain + getLast ((fmap netStringsToLogFormat <$> useNetstrings) <> logFormat) -- | Version of mkLogger that doesn't support the deprecated useNetstrings option diff --git a/libs/galley-types/test/unit/Test/Galley/Types.hs b/libs/galley-types/test/unit/Test/Galley/Types.hs index cbb1f86e3a..996022d8b2 100644 --- a/libs/galley-types/test/unit/Test/Galley/Types.hs +++ b/libs/galley-types/test/unit/Test/Galley/Types.hs @@ -1,4 +1,3 @@ - {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -Wno-orphans -Wno-incomplete-uni-patterns #-} diff --git a/libs/gundeck-types/src/Gundeck/Types/Presence.hs b/libs/gundeck-types/src/Gundeck/Types/Presence.hs index 25bab5c43f..40d9aa37da 100644 --- a/libs/gundeck-types/src/Gundeck/Types/Presence.hs +++ b/libs/gundeck-types/src/Gundeck/Types/Presence.hs @@ -1,4 +1,3 @@ - {-# LANGUAGE OverloadedStrings #-} -- This file is part of the Wire Server implementation. diff --git a/libs/metrics-wai/src/Data/Metrics/WaiRoute.hs b/libs/metrics-wai/src/Data/Metrics/WaiRoute.hs index 8592cd1797..cd8a993c2c 100644 --- a/libs/metrics-wai/src/Data/Metrics/WaiRoute.hs +++ b/libs/metrics-wai/src/Data/Metrics/WaiRoute.hs @@ -1,7 +1,5 @@ - {-# LANGUAGE ScopedTypeVariables #-} - -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2022 Wire Swiss GmbH diff --git a/libs/ropes/src/Ropes/Nexmo.hs b/libs/ropes/src/Ropes/Nexmo.hs index 1af840932c..ba770c4db4 100644 --- a/libs/ropes/src/Ropes/Nexmo.hs +++ b/libs/ropes/src/Ropes/Nexmo.hs @@ -3,7 +3,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} - -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2022 Wire Swiss GmbH diff --git a/libs/types-common-aws/src/Util/Test/SQS.hs b/libs/types-common-aws/src/Util/Test/SQS.hs index 22d8e03e15..e68e684484 100644 --- a/libs/types-common-aws/src/Util/Test/SQS.hs +++ b/libs/types-common-aws/src/Util/Test/SQS.hs @@ -2,7 +2,6 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} - {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} diff --git a/libs/types-common/src/Data/Id.hs b/libs/types-common/src/Data/Id.hs index 65fa107a96..bcdd57aa12 100644 --- a/libs/types-common/src/Data/Id.hs +++ b/libs/types-common/src/Data/Id.hs @@ -61,6 +61,7 @@ import qualified Data.Aeson.Key as Key import qualified Data.Aeson.Types as A import Data.Attoparsec.ByteString (()) import qualified Data.Attoparsec.ByteString.Char8 as Atto +import Data.Bifunctor (first) import Data.Binary import Data.ByteString.Builder (byteString) import Data.ByteString.Conversion @@ -85,7 +86,6 @@ import Imports import Servant (FromHttpApiData (..), ToHttpApiData (..)) import Test.QuickCheck import Test.QuickCheck.Instances () -import Data.Bifunctor (first) data IdTag = A | C | I | U | P | S | T | STo diff --git a/libs/types-common/src/Data/Text/Ascii.hs b/libs/types-common/src/Data/Text/Ascii.hs index 1e32ac5ac0..bc669d5bd6 100644 --- a/libs/types-common/src/Data/Text/Ascii.hs +++ b/libs/types-common/src/Data/Text/Ascii.hs @@ -5,7 +5,6 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TypeFamilies #-} - -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2022 Wire Swiss GmbH diff --git a/libs/types-common/src/Util/Options/Common.hs b/libs/types-common/src/Util/Options/Common.hs index d8601f8103..39adc0092f 100644 --- a/libs/types-common/src/Util/Options/Common.hs +++ b/libs/types-common/src/Util/Options/Common.hs @@ -1,7 +1,3 @@ - - - - -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2022 Wire Swiss GmbH diff --git a/libs/types-common/src/Util/Test.hs b/libs/types-common/src/Util/Test.hs index 6661953245..33a185e713 100644 --- a/libs/types-common/src/Util/Test.hs +++ b/libs/types-common/src/Util/Test.hs @@ -1,7 +1,5 @@ - {-# LANGUAGE OverloadedStrings #-} - -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2022 Wire Swiss GmbH diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs index 89833863b6..f424a11078 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -804,27 +804,27 @@ type MLSKeyPackageAPI = :> MultiVerb 'POST '[JSON, MLS] '[RespondEmpty 201 "Key packages uploaded"] () ) :<|> Named - "mls-key-packages-claim" - ( "claim" - :> Summary "Claim one key package for each client of the given user" - :> QualifiedCaptureUserId "user" - :> QueryParam' - [ Optional, - Strict, - Description "Do not claim a key package for the given own client" - ] - "skip_own" - ClientId - :> MultiVerb1 'POST '[JSON] (Respond 200 "Claimed key packages" KeyPackageBundle) - ) + "mls-key-packages-claim" + ( "claim" + :> Summary "Claim one key package for each client of the given user" + :> QualifiedCaptureUserId "user" + :> QueryParam' + [ Optional, + Strict, + Description "Do not claim a key package for the given own client" + ] + "skip_own" + ClientId + :> MultiVerb1 'POST '[JSON] (Respond 200 "Claimed key packages" KeyPackageBundle) + ) :<|> Named - "mls-key-packages-count" - ( "self" - :> CaptureClientId "client" - :> "count" - :> Summary "Return the number of unused key packages for the given client" - :> MultiVerb1 'GET '[JSON] (Respond 200 "Number of key packages" KeyPackageCount) - ) + "mls-key-packages-count" + ( "self" + :> CaptureClientId "client" + :> "count" + :> Summary "Return the number of unused key packages for the given client" + :> MultiVerb1 'GET '[JSON] (Respond 200 "Number of key packages" KeyPackageCount) + ) ) type MLSAPI = LiftNamed (ZLocalUser :> "mls" :> MLSKeyPackageAPI) From a1a4842549aaa3698f6b3b103b375f67102b8847 Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Tue, 7 Jun 2022 14:19:30 +0000 Subject: [PATCH 10/29] Linted remaining services. --- services/federator/src/Federator/Monitor.hs | 8 +++----- .../federator/test/unit/Test/Federator/Options.hs | 2 +- services/proxy/src/Proxy/API/Public.hs | 2 +- .../src/Spar/DataMigration/V1_ExternalIds.hs | 13 ++++++++----- 4 files changed, 13 insertions(+), 12 deletions(-) diff --git a/services/federator/src/Federator/Monitor.hs b/services/federator/src/Federator/Monitor.hs index 4015729da9..af5049d2f8 100644 --- a/services/federator/src/Federator/Monitor.hs +++ b/services/federator/src/Federator/Monitor.hs @@ -32,11 +32,9 @@ import qualified Polysemy.Error as Polysemy import System.Logger (Logger) mkTLSSettingsOrThrow :: RunSettings -> IO TLSSettings -mkTLSSettingsOrThrow = - Polysemy.runM - . (either (Polysemy.embed @IO . throw) pure =<<) - . Polysemy.runError @FederationSetupError - . mkTLSSettings +mkTLSSettingsOrThrow = Polysemy.runM . runEither . Polysemy.runError @FederationSetupError . mkTLSSettings + where + runEither = (either (Polysemy.embed @IO . throw) pure =<<) withMonitor :: Logger -> IORef TLSSettings -> RunSettings -> IO a -> IO a withMonitor logger tlsVar rs action = diff --git a/services/federator/test/unit/Test/Federator/Options.hs b/services/federator/test/unit/Test/Federator/Options.hs index b6b2e884b0..e121cd20f7 100644 --- a/services/federator/test/unit/Test/Federator/Options.hs +++ b/services/federator/test/unit/Test/Federator/Options.hs @@ -80,7 +80,7 @@ parseFederationStrategy = let allowA = toStrict $ Aeson.encode AllowAll assertParsesAs AllowAll $ allowA -- manual roundtrip example AllowList - let allowWire = (withAllowList ["wire.com"]) + let allowWire = withAllowList ["wire.com"] let allowedDom = toStrict $ Aeson.encode allowWire assertParsesAs allowWire $ allowedDom where diff --git a/services/proxy/src/Proxy/API/Public.hs b/services/proxy/src/Proxy/API/Public.hs index 83459497bf..c9650cee10 100644 --- a/services/proxy/src/Proxy/API/Public.hs +++ b/services/proxy/src/Proxy/API/Public.hs @@ -187,7 +187,7 @@ handler :: (MonadIO m, MonadMask m) => RetryStatus -> Handler m Bool handler = const . Handler $ \case Client.HttpExceptionRequest _ Client.NoResponseDataReceived -> return True Client.HttpExceptionRequest _ Client.IncompleteHeaders -> return True - Client.HttpExceptionRequest _ (Client.ConnectionTimeout) -> return True + Client.HttpExceptionRequest _ Client.ConnectionTimeout -> return True Client.HttpExceptionRequest _ (Client.ConnectionFailure _) -> return True _ -> return False diff --git a/services/spar/migrate-data/src/Spar/DataMigration/V1_ExternalIds.hs b/services/spar/migrate-data/src/Spar/DataMigration/V1_ExternalIds.hs index 9d3aa101fc..ca5b9baf2a 100644 --- a/services/spar/migrate-data/src/Spar/DataMigration/V1_ExternalIds.hs +++ b/services/spar/migrate-data/src/Spar/DataMigration/V1_ExternalIds.hs @@ -186,11 +186,14 @@ sink = go logDebug ("No team for user " <> show uid <> " from extid " <> show extid) NewExternalId (tid, extid, uid) -> lift $ - dryRun <$> askMigEnv >>= \case - DryRun -> pure () - NoDryRun -> - runSpar $ - write insert (params LocalQuorum (tid, extid, uid)) + askMigEnv + >>= ( \case + DryRun -> pure () + NoDryRun -> + runSpar $ + write insert (params LocalQuorum (tid, extid, uid)) + ) + . dryRun go insert :: PrepQuery W (TeamId, Text, UserId) () insert = "INSERT INTO scim_external (team, external_id, user) VALUES (?, ?, ?)" From 488bf5495fad1d5a65d02c3819de0132c6e82065 Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Tue, 7 Jun 2022 14:35:59 +0000 Subject: [PATCH 11/29] Replace return with pure. --- services/federator/src/Federator/Run.hs | 2 +- .../test/integration/Test/Federator/Util.hs | 12 ++++----- services/proxy/src/Proxy/API.hs | 4 +-- services/proxy/src/Proxy/API/Public.hs | 26 +++++++++---------- services/proxy/src/Proxy/Env.hs | 2 +- 5 files changed, 23 insertions(+), 23 deletions(-) diff --git a/services/federator/src/Federator/Run.hs b/services/federator/src/Federator/Run.hs index b07eecf20a..550113aff3 100644 --- a/services/federator/src/Federator/Run.hs +++ b/services/federator/src/Federator/Run.hs @@ -98,7 +98,7 @@ newEnv o _dnsResolver = do _service Cargohold = Opt.cargohold o _httpManager <- initHttpManager _tls <- mkTLSSettingsOrThrow _runSettings >>= newIORef - return Env {..} + pure Env {..} closeEnv :: Env -> IO () closeEnv e = do diff --git a/services/federator/test/integration/Test/Federator/Util.hs b/services/federator/test/integration/Test/Federator/Util.hs index f3b94ad326..fef77bef6d 100644 --- a/services/federator/test/integration/Test/Federator/Util.hs +++ b/services/federator/test/integration/Test/Federator/Util.hs @@ -283,9 +283,9 @@ randomNameWithMaxLen :: MonadIO m => Word -> m Name randomNameWithMaxLen maxLen = liftIO $ do len <- randomRIO (2, maxLen) chars <- fill len [] - return $ Name (Text.pack chars) + pure $ Name (Text.pack chars) where - fill 0 characters = return characters + fill 0 characters = pure characters fill 1 characters = (: characters) <$> randLetter fill n characters = do c <- randChar @@ -296,14 +296,14 @@ randomNameWithMaxLen maxLen = liftIO $ do randLetter = do c <- randChar if isLetter c - then return c + then pure c else randLetter randomPhone :: MonadIO m => m Phone randomPhone = liftIO $ do nrs <- map show <$> replicateM 14 (randomRIO (0, 9) :: IO Int) let phone = parsePhone . Text.pack $ "+0" ++ concat nrs - return $ fromMaybe (error "Invalid random phone#") phone + pure $ fromMaybe (error "Invalid random phone#") phone defPassword :: PlainTextPassword defPassword = PlainTextPassword "secret" @@ -323,7 +323,7 @@ mkEmailRandomLocalSuffix :: MonadIO m => Text -> m Email mkEmailRandomLocalSuffix e = do uid <- liftIO UUID.nextRandom case parseEmail e of - Just (Email loc dom) -> return $ Email (loc <> "+" <> UUID.toText uid) dom + Just (Email loc dom) -> pure $ Email (loc <> "+" <> UUID.toText uid) dom Nothing -> error $ "Invalid email address: " ++ Text.unpack e zUser :: UserId -> Bilge.Request -> Bilge.Request @@ -335,7 +335,7 @@ zConn = header "Z-Connection" randomHandle :: MonadIO m => m Text randomHandle = liftIO $ do nrs <- replicateM 21 (randomRIO (97, 122)) -- a-z - return (Text.pack (map chr nrs)) + pure (Text.pack (map chr nrs)) assertNoError :: (Show e, Member (Embed IO) r) => Sem (Error e ': r) x -> Sem r x assertNoError = diff --git a/services/proxy/src/Proxy/API.hs b/services/proxy/src/Proxy/API.hs index 15bc7de4ba..80c3f943f6 100644 --- a/services/proxy/src/Proxy/API.hs +++ b/services/proxy/src/Proxy/API.hs @@ -35,5 +35,5 @@ sitemap e = do routesInternal :: Routes a Proxy () routesInternal = do - head "/i/status" (continue $ const (return empty)) true - get "/i/status" (continue $ const (return empty)) true + head "/i/status" (continue $ const (pure empty)) true + get "/i/status" (continue $ const (pure empty)) true diff --git a/services/proxy/src/Proxy/API/Public.hs b/services/proxy/src/Proxy/API/Public.hs index c9650cee10..4abd83367a 100644 --- a/services/proxy/src/Proxy/API/Public.hs +++ b/services/proxy/src/Proxy/API/Public.hs @@ -52,22 +52,22 @@ sitemap e = do get "/proxy/youtube/v3/:path" (proxy e "key" "secrets.youtube" Prefix "/youtube/v3" youtube) - return + pure get "/proxy/googlemaps/api/staticmap" (proxy e "key" "secrets.googlemaps" Static "/maps/api/staticmap" googleMaps) - return + pure get "/proxy/googlemaps/maps/api/geocode/:path" (proxy e "key" "secrets.googlemaps" Prefix "/maps/api/geocode" googleMaps) - return + pure get "/proxy/giphy/v1/gifs/:path" (proxy e "api_key" "secrets.giphy" Prefix "/v1/gifs" giphy) - return + pure post "/proxy/spotify/api/token" (continue spotifyToken) request @@ -98,7 +98,7 @@ proxy e qparam keyname reroute path phost rq k = do liftIO $ loop runInIO (2 :: Int) r (WPRModifiedRequestSecure r' phost) where loop runInIO !n waiReq req = - waiProxyTo (const $ return req) (onUpstreamError runInIO) (e ^. manager) waiReq $ \res -> + waiProxyTo (const $ pure req) (onUpstreamError runInIO) (e ^. manager) waiReq $ \res -> if responseStatus res == status502 && n > 0 then do threadDelay 5000 @@ -123,7 +123,7 @@ spotifyToken rq = do ~~ "upstream" .= val "spotify::token" ~~ "status" .= S (Client.responseStatus res) ~~ "body" .= B.take 256 (Client.responseBody res) - return $ + pure $ plain (Client.responseBody res) & setStatus (Client.responseStatus res) . maybeHeader hContentType res @@ -148,7 +148,7 @@ soundcloudResolve url = do ~~ "upstream" .= val "soundcloud::resolve" ~~ "status" .= S (Client.responseStatus res) ~~ "body" .= B.take 256 (Client.responseBody res) - return $ + pure $ plain (Client.responseBody res) & setStatus (Client.responseStatus res) . maybeHeader hContentType res @@ -178,18 +178,18 @@ soundcloudStream url = do failWith "unexpected upstream response" case Res.getHeader hLocation res of Nothing -> failWith "missing location header" - Just loc -> return (empty & setStatus status302 . addHeader hLocation loc) + Just loc -> pure (empty & setStatus status302 . addHeader hLocation loc) x2 :: RetryPolicy x2 = exponentialBackoff 5000 <> limitRetries 2 handler :: (MonadIO m, MonadMask m) => RetryStatus -> Handler m Bool handler = const . Handler $ \case - Client.HttpExceptionRequest _ Client.NoResponseDataReceived -> return True - Client.HttpExceptionRequest _ Client.IncompleteHeaders -> return True - Client.HttpExceptionRequest _ Client.ConnectionTimeout -> return True - Client.HttpExceptionRequest _ (Client.ConnectionFailure _) -> return True - _ -> return False + Client.HttpExceptionRequest _ Client.NoResponseDataReceived -> pure True + Client.HttpExceptionRequest _ Client.IncompleteHeaders -> pure True + Client.HttpExceptionRequest _ Client.ConnectionTimeout -> pure True + Client.HttpExceptionRequest _ (Client.ConnectionFailure _) -> pure True + _ -> pure False safeQuery :: Query -> Query safeQuery = filter noAccessToken diff --git a/services/proxy/src/Proxy/Env.hs b/services/proxy/src/Proxy/Env.hs index 49e515cd01..108f5694a8 100644 --- a/services/proxy/src/Proxy/Env.hs +++ b/services/proxy/src/Proxy/Env.hs @@ -66,7 +66,7 @@ createEnv m o = do } let ac = AutoConfig 60 (reloadError g) (c, t) <- autoReload ac [Required $ o ^. secretsConfig] - return $! Env def m o g n c t + pure $! Env def m o g n c t where reloadError g x = Logger.err g (Logger.msg $ Logger.val "Failed reloading config: " Logger.+++ show x) From df1385545191691f73e5fbaef8918230aa20be7f Mon Sep 17 00:00:00 2001 From: fisx Date: Thu, 9 Jun 2022 13:48:00 +0200 Subject: [PATCH 12/29] Fix: saml-auto-provisioned users don't get to change email address. (#2464) --- changelog.d/3-bug-fixes/fix-saml-corner-case | 1 + services/brig/src/Brig/API/User.hs | 54 ++++++++++++-------- services/brig/src/Brig/Data/User.hs | 20 +++++--- services/brig/src/Brig/User/Auth.hs | 2 +- 4 files changed, 46 insertions(+), 31 deletions(-) create mode 100644 changelog.d/3-bug-fixes/fix-saml-corner-case diff --git a/changelog.d/3-bug-fixes/fix-saml-corner-case b/changelog.d/3-bug-fixes/fix-saml-corner-case new file mode 100644 index 0000000000..00f26d06fd --- /dev/null +++ b/changelog.d/3-bug-fixes/fix-saml-corner-case @@ -0,0 +1 @@ +saml-auto-provisioned users don't get to change email address diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index 4272fb3cb8..0fc21c80b3 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -607,32 +607,42 @@ changeSelfEmail u email allowScim = do -- | Prepare changing the email (checking a number of invariants). changeEmail :: UserId -> Email -> AllowSCIMUpdates -> ExceptT ChangeEmailError (AppT r) ChangeEmailResult changeEmail u email allowScim = do - em <- - either - (throwE . InvalidNewEmail email) - pure - (validateEmail email) - let ek = userEmailKey em - blacklisted <- lift . wrapClient $ Blacklist.exists ek + eml <- either (throwE . InvalidNewEmail email) pure (validateEmail email) + let eky = userEmailKey eml + + blacklisted <- lift . wrapClient $ Blacklist.exists eky when blacklisted $ throwE (ChangeBlacklistedEmail email) - available <- lift . wrapClient $ Data.keyAvailable ek (Just u) + + available <- lift . wrapClient $ Data.keyAvailable eky (Just u) unless available $ - throwE $ - EmailExists email - usr <- maybe (throwM $ UserProfileNotFound u) pure =<< lift (wrapClient $ Data.lookupUser WithPendingInvitations u) - case emailIdentity =<< userIdentity usr of - -- The user already has an email address and the new one is exactly the same - Just current | current == em -> pure ChangeEmailIdempotent - _ -> do - unless - ( userManagedBy usr /= ManagedByScim - || allowScim == AllowSCIMUpdates - ) - $ throwE EmailManagedByScim + throwE (EmailExists email) + + usr <- + maybe (throwM $ UserProfileNotFound u) pure + =<< lift (wrapClient $ Data.lookupUser WithPendingInvitations u) + + if (emailIdentity =<< userIdentity usr) == Just eml + then do + -- The user already has an email address and the new one is exactly the same + pure ChangeEmailIdempotent + else do + -- case 2: No or different old email address + let changeAllowed = + ( userManagedBy usr /= ManagedByScim + || allowScim == AllowSCIMUpdates -- spar is always allowed to call this function (from the scim handlers) + ) + && not + ( -- user is auto-provisioned by saml (deprecated use case) + userManagedBy usr /= ManagedByScim && userHasSAML usr + ) + + unless changeAllowed $ + throwE EmailManagedByScim + timeout <- setActivationTimeout <$> view settings - act <- lift . wrapClient $ Data.newActivation ek timeout (Just u) - pure $ ChangeEmailNeedsActivation (usr, act, em) + act <- lift . wrapClient $ Data.newActivation eky timeout (Just u) + pure $ ChangeEmailNeedsActivation (usr, act, eml) ------------------------------------------------------------------------------- -- Change Phone diff --git a/services/brig/src/Brig/Data/User.hs b/services/brig/src/Brig/Data/User.hs index 10fe01409d..c89811da92 100644 --- a/services/brig/src/Brig/Data/User.hs +++ b/services/brig/src/Brig/Data/User.hs @@ -31,7 +31,8 @@ module Brig.Data.User reauthenticate, filterActive, isActivated, - isSamlUser, + userIdHasSAML, + userHasSAML, -- * Lookups lookupAccount, @@ -212,17 +213,20 @@ reauthenticate u pw = Just (Just pw', Ephemeral) -> maybeReAuth pw' where maybeReAuth pw' = case pw of - Nothing -> unlessM (isSamlUser u) $ throwE ReAuthMissingPassword + Nothing -> unlessM (userIdHasSAML u) $ throwE ReAuthMissingPassword Just p -> unless (verifyPassword p pw') $ throwE (ReAuthError AuthInvalidCredentials) -isSamlUser :: (MonadClient m, MonadReader Env m) => UserId -> m Bool -isSamlUser uid = do - account <- lookupAccount uid - case userIdentity . accountUser =<< account of - Just (SSOIdentity (UserSSOId _) _ _) -> pure True - _ -> pure False +userIdHasSAML :: (MonadClient m, MonadReader Env m) => UserId -> m Bool +userIdHasSAML uid = do + maybe False (userHasSAML . accountUser) <$> lookupAccount uid + +userHasSAML :: User -> Bool +userHasSAML user = do + case userIdentity user of + Just (SSOIdentity (UserSSOId _) _ _) -> True + _ -> False insertAccount :: MonadClient m => diff --git a/services/brig/src/Brig/User/Auth.hs b/services/brig/src/Brig/User/Auth.hs index 3088a6eb61..b09ec22b83 100644 --- a/services/brig/src/Brig/User/Auth.hs +++ b/services/brig/src/Brig/User/Auth.hs @@ -288,7 +288,7 @@ revokeAccess :: ExceptT AuthError m () revokeAccess u pw cc ll = do lift $ Log.debug $ field "user" (toByteString u) . field "action" (Log.val "User.revokeAccess") - unlessM (Data.isSamlUser u) $ Data.authenticate u pw + unlessM (Data.userIdHasSAML u) $ Data.authenticate u pw lift $ revokeCookies u cc ll -------------------------------------------------------------------------------- From e067d04f02274165637d370006f9ebd6c009f5f9 Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Thu, 9 Jun 2022 16:50:15 +0200 Subject: [PATCH 13/29] charts/nginz: Forward /i/users/:uid/features/:feature to brig (#2468) --- changelog.d/5-internal/nginz-ifeatures-route | 1 + charts/nginz/values.yaml | 6 ++++++ 2 files changed, 7 insertions(+) create mode 100644 changelog.d/5-internal/nginz-ifeatures-route diff --git a/changelog.d/5-internal/nginz-ifeatures-route b/changelog.d/5-internal/nginz-ifeatures-route new file mode 100644 index 0000000000..f961f83907 --- /dev/null +++ b/changelog.d/5-internal/nginz-ifeatures-route @@ -0,0 +1 @@ +Forward /i/users/:uid/features/:feature to brig diff --git a/charts/nginz/values.yaml b/charts/nginz/values.yaml index 8826c1af6a..3d87195e81 100644 --- a/charts/nginz/values.yaml +++ b/charts/nginz/values.yaml @@ -270,6 +270,12 @@ nginx_conf: disable_zauth: true basic_auth: true versioned: false + - path: /i/users/([^/]*)/features/([^/])* + envs: + - staging + disable_zauth: true + basic_auth: true + versioned: false - path: /i/teams/([^/]*)/suspend envs: - staging From 52d8a2e580b2c77b19bb3632cd0f9873997950cd Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Thu, 9 Jun 2022 17:29:31 +0200 Subject: [PATCH 14/29] Revert "Fix: saml-auto-provisioned users don't get to change email address. (#2464)" (#2469) This reverts commit df1385545191691f73e5fbaef8918230aa20be7f. --- changelog.d/3-bug-fixes/fix-saml-corner-case | 1 - services/brig/src/Brig/API/User.hs | 54 ++++++++------------ services/brig/src/Brig/Data/User.hs | 20 +++----- services/brig/src/Brig/User/Auth.hs | 2 +- 4 files changed, 31 insertions(+), 46 deletions(-) delete mode 100644 changelog.d/3-bug-fixes/fix-saml-corner-case diff --git a/changelog.d/3-bug-fixes/fix-saml-corner-case b/changelog.d/3-bug-fixes/fix-saml-corner-case deleted file mode 100644 index 00f26d06fd..0000000000 --- a/changelog.d/3-bug-fixes/fix-saml-corner-case +++ /dev/null @@ -1 +0,0 @@ -saml-auto-provisioned users don't get to change email address diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index 0fc21c80b3..4272fb3cb8 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -607,42 +607,32 @@ changeSelfEmail u email allowScim = do -- | Prepare changing the email (checking a number of invariants). changeEmail :: UserId -> Email -> AllowSCIMUpdates -> ExceptT ChangeEmailError (AppT r) ChangeEmailResult changeEmail u email allowScim = do - eml <- either (throwE . InvalidNewEmail email) pure (validateEmail email) - let eky = userEmailKey eml - - blacklisted <- lift . wrapClient $ Blacklist.exists eky + em <- + either + (throwE . InvalidNewEmail email) + pure + (validateEmail email) + let ek = userEmailKey em + blacklisted <- lift . wrapClient $ Blacklist.exists ek when blacklisted $ throwE (ChangeBlacklistedEmail email) - - available <- lift . wrapClient $ Data.keyAvailable eky (Just u) + available <- lift . wrapClient $ Data.keyAvailable ek (Just u) unless available $ - throwE (EmailExists email) - - usr <- - maybe (throwM $ UserProfileNotFound u) pure - =<< lift (wrapClient $ Data.lookupUser WithPendingInvitations u) - - if (emailIdentity =<< userIdentity usr) == Just eml - then do - -- The user already has an email address and the new one is exactly the same - pure ChangeEmailIdempotent - else do - -- case 2: No or different old email address - let changeAllowed = - ( userManagedBy usr /= ManagedByScim - || allowScim == AllowSCIMUpdates -- spar is always allowed to call this function (from the scim handlers) - ) - && not - ( -- user is auto-provisioned by saml (deprecated use case) - userManagedBy usr /= ManagedByScim && userHasSAML usr - ) - - unless changeAllowed $ - throwE EmailManagedByScim - + throwE $ + EmailExists email + usr <- maybe (throwM $ UserProfileNotFound u) pure =<< lift (wrapClient $ Data.lookupUser WithPendingInvitations u) + case emailIdentity =<< userIdentity usr of + -- The user already has an email address and the new one is exactly the same + Just current | current == em -> pure ChangeEmailIdempotent + _ -> do + unless + ( userManagedBy usr /= ManagedByScim + || allowScim == AllowSCIMUpdates + ) + $ throwE EmailManagedByScim timeout <- setActivationTimeout <$> view settings - act <- lift . wrapClient $ Data.newActivation eky timeout (Just u) - pure $ ChangeEmailNeedsActivation (usr, act, eml) + act <- lift . wrapClient $ Data.newActivation ek timeout (Just u) + pure $ ChangeEmailNeedsActivation (usr, act, em) ------------------------------------------------------------------------------- -- Change Phone diff --git a/services/brig/src/Brig/Data/User.hs b/services/brig/src/Brig/Data/User.hs index c89811da92..10fe01409d 100644 --- a/services/brig/src/Brig/Data/User.hs +++ b/services/brig/src/Brig/Data/User.hs @@ -31,8 +31,7 @@ module Brig.Data.User reauthenticate, filterActive, isActivated, - userIdHasSAML, - userHasSAML, + isSamlUser, -- * Lookups lookupAccount, @@ -213,20 +212,17 @@ reauthenticate u pw = Just (Just pw', Ephemeral) -> maybeReAuth pw' where maybeReAuth pw' = case pw of - Nothing -> unlessM (userIdHasSAML u) $ throwE ReAuthMissingPassword + Nothing -> unlessM (isSamlUser u) $ throwE ReAuthMissingPassword Just p -> unless (verifyPassword p pw') $ throwE (ReAuthError AuthInvalidCredentials) -userIdHasSAML :: (MonadClient m, MonadReader Env m) => UserId -> m Bool -userIdHasSAML uid = do - maybe False (userHasSAML . accountUser) <$> lookupAccount uid - -userHasSAML :: User -> Bool -userHasSAML user = do - case userIdentity user of - Just (SSOIdentity (UserSSOId _) _ _) -> True - _ -> False +isSamlUser :: (MonadClient m, MonadReader Env m) => UserId -> m Bool +isSamlUser uid = do + account <- lookupAccount uid + case userIdentity . accountUser =<< account of + Just (SSOIdentity (UserSSOId _) _ _) -> pure True + _ -> pure False insertAccount :: MonadClient m => diff --git a/services/brig/src/Brig/User/Auth.hs b/services/brig/src/Brig/User/Auth.hs index b09ec22b83..3088a6eb61 100644 --- a/services/brig/src/Brig/User/Auth.hs +++ b/services/brig/src/Brig/User/Auth.hs @@ -288,7 +288,7 @@ revokeAccess :: ExceptT AuthError m () revokeAccess u pw cc ll = do lift $ Log.debug $ field "user" (toByteString u) . field "action" (Log.val "User.revokeAccess") - unlessM (Data.userIdHasSAML u) $ Data.authenticate u pw + unlessM (Data.isSamlUser u) $ Data.authenticate u pw lift $ revokeCookies u cc ll -------------------------------------------------------------------------------- From 4ff579bcf0310990c864e0afc1f0bbd6ef479e50 Mon Sep 17 00:00:00 2001 From: Sebastian Willenborg Date: Thu, 9 Jun 2022 19:18:05 +0200 Subject: [PATCH 15/29] fix: add missing newline in code-block (#2470) --- docs/src/understand/single-sign-on/main.rst | 1 + 1 file changed, 1 insertion(+) diff --git a/docs/src/understand/single-sign-on/main.rst b/docs/src/understand/single-sign-on/main.rst index 47f39a79fb..acfe8ff313 100644 --- a/docs/src/understand/single-sign-on/main.rst +++ b/docs/src/understand/single-sign-on/main.rst @@ -520,6 +520,7 @@ Email address (and/or SAML NameID, if /a): Wire handle: same request, just replace the query part with .. code-block:: bash + '?filter=userName%20eq%20%22me%22' **Update a specific user** From 46d5edbf431fe433e516b88c322d35ec21bacba6 Mon Sep 17 00:00:00 2001 From: Florian Klink Date: Fri, 10 Jun 2022 09:53:52 +0200 Subject: [PATCH 16/29] charts/*: drop wireService label, use app= instead, add servicemonitor support (#2413) * charts/*: drop wireService label, use app= instead, add servicemonitor support This aligns labels a bit more with how they look like in other deployments. In some cases, we were already setting the `app` label, too. There's one possible regression: The wire-server-metrics helm chart configured kube-prometheus-stack to automatically scrape everything with a wireService label at port http, path /i/metrics. This will be fixed in a followup, by adding ServiceProbe resources to each workload that exposes metrics. * charts/brig: add servicemonitor support * charts/cannon: add servicemonitor support * chart/cargohold: add servicemonitor support * charts/galley: add servicemonitor support * charts/gundeck: add servicemonitor support * charts/proxy: add servicemonitor support * charts/spar: add servicemonitor support * changelog.d: add wireService label removal to changelog --- Makefile | 8 ++--- .../0-release-notes/wire-service-label | 34 +++++++++++++++++++ .../account-pages/templates/deployment.yaml | 4 +-- .../templates/ELB_account_pages_https.yaml | 2 +- .../templates/ELB_nginz_https.yaml | 2 +- .../aws-ingress/templates/ELB_nginz_wss.yaml | 2 +- .../templates/ELB_team_settings_https.yaml | 2 +- .../templates/ELB_webapp_https.yaml | 2 +- charts/backoffice/templates/deployment.yaml | 6 ++-- charts/backoffice/templates/service.yaml | 4 +-- charts/brig/templates/configmap.yaml | 2 +- charts/brig/templates/deployment.yaml | 6 ++-- charts/brig/templates/geoip-secret.yaml | 2 +- charts/brig/templates/secret.yaml | 2 +- charts/brig/templates/service.yaml | 4 +-- charts/brig/templates/serviceaccount.yaml | 2 +- charts/brig/templates/servicemonitor.yaml | 19 +++++++++++ .../templates/tests/brig-integration.yaml | 6 ++-- .../brig/templates/tests/nginz-service.yaml | 2 +- charts/brig/templates/turnconfigmap.yaml | 2 +- charts/brig/values.yaml | 3 ++ charts/cannon/templates/headless-service.yaml | 4 +-- .../templates/nginz-certificate-secret.yaml | 1 - charts/cannon/templates/nginz-secret.yaml | 1 - charts/cannon/templates/nginz-service.yaml | 4 +-- charts/cannon/templates/servicemonitor.yaml | 19 +++++++++++ charts/cannon/templates/statefulset.yaml | 6 ++-- charts/cannon/values.yaml | 4 +++ charts/cargohold/templates/deployment.yaml | 6 ++-- charts/cargohold/templates/service.yaml | 4 +-- .../cargohold/templates/serviceaccount.yaml | 2 +- .../cargohold/templates/servicemonitor.yaml | 19 +++++++++++ charts/cargohold/values.yaml | 3 ++ .../templates/galley-migrate-data.yaml | 4 +-- .../templates/migrate-schema.yaml | 4 +-- .../templates/spar-migrate-data.yaml | 3 +- .../templates/es-svc.yaml | 1 - .../elasticsearch-ephemeral/templates/es.yaml | 1 - .../templates/create-index.yaml | 2 -- .../templates/migrate-data.yaml | 2 -- charts/federator/templates/ca.yaml | 2 +- charts/federator/templates/configmap.yaml | 2 +- charts/federator/templates/deployment.yaml | 6 ++-- charts/federator/templates/secret.yaml | 2 +- charts/federator/templates/service.yaml | 4 +-- charts/galley/templates/deployment.yaml | 6 ++-- charts/galley/templates/service.yaml | 4 +-- charts/galley/templates/serviceaccount.yaml | 2 +- charts/galley/templates/servicemonitor.yaml | 19 +++++++++++ .../templates/tests/galley-integration.yaml | 6 ++-- charts/galley/values.yaml | 3 ++ charts/gundeck/templates/deployment.yaml | 6 ++-- charts/gundeck/templates/secret.yaml | 2 +- charts/gundeck/templates/service.yaml | 4 +-- charts/gundeck/templates/serviceaccount.yaml | 2 +- charts/gundeck/templates/servicemonitor.yaml | 19 +++++++++++ charts/gundeck/values.yaml | 3 ++ .../ldap-scim-bridge/templates/cronjob.yaml | 4 +-- charts/ldap-scim-bridge/templates/secret.yaml | 4 +-- .../templates/service.yaml | 12 +++---- charts/nginz/templates/deployment.yaml | 4 +-- charts/nginz/templates/secret.yaml | 1 - charts/openldap/templates/openldap.yaml | 4 +-- .../openldap/templates/secret-newusers.yaml | 2 +- charts/openldap/templates/service.yaml | 4 +-- charts/proxy/templates/deployment.yaml | 6 ++-- charts/proxy/templates/service.yaml | 4 +-- charts/proxy/templates/servicemonitor.yaml | 19 +++++++++++ charts/proxy/values.yaml | 5 ++- charts/reaper/templates/deployment.yaml | 6 ++-- charts/spar/templates/deployment.yaml | 6 ++-- charts/spar/templates/service.yaml | 4 +-- charts/spar/templates/servicemonitor.yaml | 19 +++++++++++ .../templates/tests/spar-integration.yaml | 2 +- charts/spar/values.yaml | 5 ++- .../team-settings/templates/deployment.yaml | 4 +-- charts/webapp/templates/deployment.yaml | 4 +-- charts/wire-server-metrics/values.yaml | 25 -------------- docs/src/how-to/administrate/restund.rst | 2 +- services/brig/federation-tests.sh | 2 +- 80 files changed, 296 insertions(+), 150 deletions(-) create mode 100644 changelog.d/0-release-notes/wire-service-label create mode 100644 charts/brig/templates/servicemonitor.yaml create mode 100644 charts/cannon/templates/servicemonitor.yaml create mode 100644 charts/cargohold/templates/servicemonitor.yaml create mode 100644 charts/galley/templates/servicemonitor.yaml create mode 100644 charts/gundeck/templates/servicemonitor.yaml create mode 100644 charts/proxy/templates/servicemonitor.yaml create mode 100644 charts/spar/templates/servicemonitor.yaml diff --git a/Makefile b/Makefile index 8ccab6b483..6b6852351f 100644 --- a/Makefile +++ b/Makefile @@ -360,8 +360,8 @@ kube-integration-teardown-sans-federation: .PHONY: kube-restart-% kube-restart-%: - kubectl delete pod -n $(NAMESPACE) -l wireService=$(*) - kubectl delete pod -n $(NAMESPACE)-fed2 -l wireService=$(*) + kubectl delete pod -n $(NAMESPACE) -l app=$(*) + kubectl delete pod -n $(NAMESPACE)-fed2 -l app=$(*) .PHONY: latest-tag latest-tag: @@ -522,8 +522,8 @@ kind-restart-nginx-ingress: .local/kind-kubeconfig kind-restart-%: .local/kind-kubeconfig export KUBECONFIG=$(CURDIR)/.local/kind-kubeconfig && \ - kubectl delete pod -n $(NAMESPACE) -l wireService=$(*) && \ - kubectl delete pod -n $(NAMESPACE)-fed2 -l wireService=$(*) + kubectl delete pod -n $(NAMESPACE) -l app=$(*) && \ + kubectl delete pod -n $(NAMESPACE)-fed2 -l app=$(*) # This target can be used to template a helm chart with values filled in from # hack/helm_vars (what CI uses) as overrrides, if available. This allows debugging helm diff --git a/changelog.d/0-release-notes/wire-service-label b/changelog.d/0-release-notes/wire-service-label new file mode 100644 index 0000000000..08990ae136 --- /dev/null +++ b/changelog.d/0-release-notes/wire-service-label @@ -0,0 +1,34 @@ +The `wireService` label has been removed. + +In some cases, we were already setting the `app` label too. + +Now we consistently use the `app` label to label different wire services. + +The `wire-server-metrics` chart was previously running some custom +configuration to automatically add all payloads with a `wireService` label into +metrics scraping. + +With the removal of the `wireService` label, this custom configuration has been +removed. + +Instead, all services that expose metrics will now create `ServiceMonitor` +resources, if their helm chart is applied with `metrics.serviceMonitor.enable` +set to true. + +This prevents scraping agents from querying services that don't expose metrics +at /i/metrics unnecessarily. + +Additionally, makes it easier to run other metric scraping operators, like +`grafana-agent-operator`, without the need to also create some custom +`wireService` label config there. + +Generally, if you have any monitoring solution installed in your cluster that +uses the Prometheus CRDs, set `metrics.serviceMonitor.enable` for the following charts: + + - brig + - cannon + - cargohold + - galley + - gundeck + - proxy + - spar diff --git a/charts/account-pages/templates/deployment.yaml b/charts/account-pages/templates/deployment.yaml index 138e0ce4dd..10001c35fe 100644 --- a/charts/account-pages/templates/deployment.yaml +++ b/charts/account-pages/templates/deployment.yaml @@ -3,7 +3,7 @@ kind: Deployment metadata: name: account-pages labels: - wireService: account-pages + app: account-pages chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} @@ -16,12 +16,10 @@ spec: maxSurge: {{ .Values.replicaCount | mul 2 }} selector: matchLabels: - wireService: account-pages app: account-pages template: metadata: labels: - wireService: account-pages app: account-pages release: {{ .Release.Name }} spec: diff --git a/charts/aws-ingress/templates/ELB_account_pages_https.yaml b/charts/aws-ingress/templates/ELB_account_pages_https.yaml index 02ef360501..4613cdffe5 100644 --- a/charts/aws-ingress/templates/ELB_account_pages_https.yaml +++ b/charts/aws-ingress/templates/ELB_account_pages_https.yaml @@ -14,7 +14,7 @@ metadata: spec: type: LoadBalancer selector: - wireService: account-pages + app: account-pages ports: - name: https protocol: TCP diff --git a/charts/aws-ingress/templates/ELB_nginz_https.yaml b/charts/aws-ingress/templates/ELB_nginz_https.yaml index 64a0798fdb..cb5c511466 100644 --- a/charts/aws-ingress/templates/ELB_nginz_https.yaml +++ b/charts/aws-ingress/templates/ELB_nginz_https.yaml @@ -13,7 +13,7 @@ metadata: spec: type: LoadBalancer selector: - wireService: nginz + app: nginz ports: - name: https protocol: TCP diff --git a/charts/aws-ingress/templates/ELB_nginz_wss.yaml b/charts/aws-ingress/templates/ELB_nginz_wss.yaml index 10e6afb526..ce6c8a2c1c 100644 --- a/charts/aws-ingress/templates/ELB_nginz_wss.yaml +++ b/charts/aws-ingress/templates/ELB_nginz_wss.yaml @@ -14,7 +14,7 @@ metadata: spec: type: LoadBalancer selector: - wireService: nginz + app: nginz ports: - name: wss protocol: TCP diff --git a/charts/aws-ingress/templates/ELB_team_settings_https.yaml b/charts/aws-ingress/templates/ELB_team_settings_https.yaml index 3476bad0fe..c0d4e2fa69 100644 --- a/charts/aws-ingress/templates/ELB_team_settings_https.yaml +++ b/charts/aws-ingress/templates/ELB_team_settings_https.yaml @@ -14,7 +14,7 @@ metadata: spec: type: LoadBalancer selector: - wireService: team-settings + app: team-settings ports: - name: https protocol: TCP diff --git a/charts/aws-ingress/templates/ELB_webapp_https.yaml b/charts/aws-ingress/templates/ELB_webapp_https.yaml index 7924e2a8a2..ab52913f51 100644 --- a/charts/aws-ingress/templates/ELB_webapp_https.yaml +++ b/charts/aws-ingress/templates/ELB_webapp_https.yaml @@ -13,7 +13,7 @@ metadata: spec: type: LoadBalancer selector: - wireService: webapp + app: webapp ports: - name: https protocol: TCP diff --git a/charts/backoffice/templates/deployment.yaml b/charts/backoffice/templates/deployment.yaml index ce5fe28801..172e3fc135 100644 --- a/charts/backoffice/templates/deployment.yaml +++ b/charts/backoffice/templates/deployment.yaml @@ -3,7 +3,7 @@ kind: Deployment metadata: name: backoffice labels: - wireService: backoffice + app: backoffice chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} @@ -16,11 +16,11 @@ spec: maxSurge: {{ .Values.replicaCount }} selector: matchLabels: - wireService: backoffice + app: backoffice template: metadata: labels: - wireService: backoffice + app: backoffice release: {{ .Release.Name }} annotations: # An annotation of the configmap checksum ensures changes to the configmap cause a redeployment upon `helm upgrade` diff --git a/charts/backoffice/templates/service.yaml b/charts/backoffice/templates/service.yaml index de343846e3..3422d81a77 100644 --- a/charts/backoffice/templates/service.yaml +++ b/charts/backoffice/templates/service.yaml @@ -3,7 +3,7 @@ kind: Service metadata: name: backoffice labels: - wireService: backoffice + app: backoffice chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} @@ -14,5 +14,5 @@ spec: port: {{ .Values.service.externalPort }} targetPort: {{ .Values.service.internalPort }} selector: - wireService: backoffice + app: backoffice release: {{ .Release.Name }} diff --git a/charts/brig/templates/configmap.yaml b/charts/brig/templates/configmap.yaml index 7b06eb9b55..210fa59a26 100644 --- a/charts/brig/templates/configmap.yaml +++ b/charts/brig/templates/configmap.yaml @@ -3,7 +3,7 @@ kind: ConfigMap metadata: name: "brig" labels: - wireService: brig + app: brig chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} diff --git a/charts/brig/templates/deployment.yaml b/charts/brig/templates/deployment.yaml index 531f816948..860b7acf51 100644 --- a/charts/brig/templates/deployment.yaml +++ b/charts/brig/templates/deployment.yaml @@ -3,7 +3,7 @@ kind: Deployment metadata: name: brig labels: - wireService: brig + app: brig chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} @@ -16,11 +16,11 @@ spec: maxSurge: {{ .Values.replicaCount }} selector: matchLabels: - wireService: brig + app: brig template: metadata: labels: - wireService: brig + app: brig release: {{ .Release.Name }} annotations: # An annotation of the configmap checksum ensures changes to the configmap cause a redeployment upon `helm upgrade` diff --git a/charts/brig/templates/geoip-secret.yaml b/charts/brig/templates/geoip-secret.yaml index db6df8a1ee..8e96ea70c9 100644 --- a/charts/brig/templates/geoip-secret.yaml +++ b/charts/brig/templates/geoip-secret.yaml @@ -4,7 +4,7 @@ kind: Secret metadata: name: brig-geoip labels: - wireService: brig + app: brig chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: "{{ .Release.Name }}" heritage: "{{ .Release.Service }}" diff --git a/charts/brig/templates/secret.yaml b/charts/brig/templates/secret.yaml index 55d90ff9eb..2ffebba629 100644 --- a/charts/brig/templates/secret.yaml +++ b/charts/brig/templates/secret.yaml @@ -3,7 +3,7 @@ kind: Secret metadata: name: brig labels: - wireService: brig + app: brig chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: "{{ .Release.Name }}" heritage: "{{ .Release.Service }}" diff --git a/charts/brig/templates/service.yaml b/charts/brig/templates/service.yaml index 9a12b07bad..432be27dd1 100644 --- a/charts/brig/templates/service.yaml +++ b/charts/brig/templates/service.yaml @@ -3,7 +3,7 @@ kind: Service metadata: name: brig labels: - wireService: brig + app: brig chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} @@ -14,5 +14,5 @@ spec: port: {{ .Values.service.externalPort }} targetPort: {{ .Values.service.internalPort }} selector: - wireService: brig + app: brig release: {{ .Release.Name }} diff --git a/charts/brig/templates/serviceaccount.yaml b/charts/brig/templates/serviceaccount.yaml index 48800b82bd..bc120b624d 100644 --- a/charts/brig/templates/serviceaccount.yaml +++ b/charts/brig/templates/serviceaccount.yaml @@ -4,7 +4,7 @@ kind: ServiceAccount metadata: name: {{ .Values.serviceAccount.name }} labels: - wireService: brig + app: brig chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} diff --git a/charts/brig/templates/servicemonitor.yaml b/charts/brig/templates/servicemonitor.yaml new file mode 100644 index 0000000000..03c0b87244 --- /dev/null +++ b/charts/brig/templates/servicemonitor.yaml @@ -0,0 +1,19 @@ +{{- if .Values.metrics.serviceMonitor.enabled }} +apiVersion: monitoring.coreos.com/v1 +kind: ServiceMonitor +metadata: + name: brig + labels: + app: brig + chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} + release: {{ .Release.Name }} + heritage: {{ .Release.Service }} +spec: + endpoints: + - port: http + path: /i/metrics + selector: + matchLabels: + app: brig + release: {{ .Release.Name }} +{{- end }} diff --git a/charts/brig/templates/tests/brig-integration.yaml b/charts/brig/templates/tests/brig-integration.yaml index dc2018a0d7..17921894bf 100644 --- a/charts/brig/templates/tests/brig-integration.yaml +++ b/charts/brig/templates/tests/brig-integration.yaml @@ -3,7 +3,7 @@ kind: Service metadata: name: "brig-integration" labels: - wireService: brig-integration + app: brig-integration chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} @@ -13,7 +13,7 @@ spec: - port: 9000 targetPort: 9000 selector: - wireService: brig-integration + app: brig-integration release: {{ .Release.Name }} --- apiVersion: v1 @@ -23,7 +23,7 @@ metadata: annotations: "helm.sh/hook": test-success labels: - wireService: brig-integration + app: brig-integration release: {{ .Release.Name }} spec: volumes: diff --git a/charts/brig/templates/tests/nginz-service.yaml b/charts/brig/templates/tests/nginz-service.yaml index 598ff296db..c31128667c 100644 --- a/charts/brig/templates/tests/nginz-service.yaml +++ b/charts/brig/templates/tests/nginz-service.yaml @@ -11,4 +11,4 @@ spec: - port: 8080 targetPort: 8080 selector: - wireService: nginz + app: nginz diff --git a/charts/brig/templates/turnconfigmap.yaml b/charts/brig/templates/turnconfigmap.yaml index 3f4ef4f54c..7a62071b57 100644 --- a/charts/brig/templates/turnconfigmap.yaml +++ b/charts/brig/templates/turnconfigmap.yaml @@ -4,7 +4,7 @@ kind: ConfigMap metadata: name: "turn" labels: - wireService: brig + app: brig chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} diff --git a/charts/brig/values.yaml b/charts/brig/values.yaml index 0106d38620..82d215da49 100644 --- a/charts/brig/values.yaml +++ b/charts/brig/values.yaml @@ -12,6 +12,9 @@ resources: limits: memory: "512Mi" cpu: "500m" +metrics: + serviceMonitor: + enable: false config: logLevel: Info logFormat: JSON diff --git a/charts/cannon/templates/headless-service.yaml b/charts/cannon/templates/headless-service.yaml index e8b0e2b368..5c107d0bc2 100644 --- a/charts/cannon/templates/headless-service.yaml +++ b/charts/cannon/templates/headless-service.yaml @@ -9,7 +9,7 @@ kind: Service metadata: name: {{ .Values.service.name }} labels: - wireService: cannon + app: cannon chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} @@ -23,5 +23,5 @@ spec: targetPort: {{ .Values.service.internalPort }} protocol: TCP selector: - wireService: cannon + app: cannon release: {{ .Release.Name }} diff --git a/charts/cannon/templates/nginz-certificate-secret.yaml b/charts/cannon/templates/nginz-certificate-secret.yaml index 4531ad19e3..8394ebd8c0 100644 --- a/charts/cannon/templates/nginz-certificate-secret.yaml +++ b/charts/cannon/templates/nginz-certificate-secret.yaml @@ -4,7 +4,6 @@ kind: Secret metadata: name: {{ .Values.service.nginz.tls.secretName }} labels: - wireService: cannon-nginz app: cannon-nginz chart: "{{ .Chart.Name }}-{{ .Chart.Version }}" release: "{{ .Release.Name }}" diff --git a/charts/cannon/templates/nginz-secret.yaml b/charts/cannon/templates/nginz-secret.yaml index 23dd7c7d0c..0670f7fe27 100644 --- a/charts/cannon/templates/nginz-secret.yaml +++ b/charts/cannon/templates/nginz-secret.yaml @@ -4,7 +4,6 @@ kind: Secret metadata: name: cannon-nginz labels: - wireService: cannon-nginz app: cannon-nginz chart: "{{ .Chart.Name }}-{{ .Chart.Version }}" release: "{{ .Release.Name }}" diff --git a/charts/cannon/templates/nginz-service.yaml b/charts/cannon/templates/nginz-service.yaml index fd820c2b75..704e2e2a25 100644 --- a/charts/cannon/templates/nginz-service.yaml +++ b/charts/cannon/templates/nginz-service.yaml @@ -13,7 +13,7 @@ kind: Service metadata: name: {{ .Values.service.nginz.name }} labels: - wireService: cannon + app: cannon chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} @@ -35,6 +35,6 @@ spec: targetPort: {{ .Values.service.nginz.internalPort }} protocol: TCP selector: - wireService: cannon + app: cannon release: {{ .Release.Name }} {{- end }} diff --git a/charts/cannon/templates/servicemonitor.yaml b/charts/cannon/templates/servicemonitor.yaml new file mode 100644 index 0000000000..df91d18654 --- /dev/null +++ b/charts/cannon/templates/servicemonitor.yaml @@ -0,0 +1,19 @@ +{{- if .Values.metrics.serviceMonitor.enabled }} +apiVersion: monitoring.coreos.com/v1 +kind: ServiceMonitor +metadata: + name: cannon + labels: + app: cannon + chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} + release: {{ .Release.Name }} + heritage: {{ .Release.Service }} +spec: + endpoints: + - port: http + path: /i/metrics + selector: + matchLabels: + app: cannon + release: {{ .Release.Name }} +{{- end }} diff --git a/charts/cannon/templates/statefulset.yaml b/charts/cannon/templates/statefulset.yaml index c9adaae62b..01eebcf2ba 100644 --- a/charts/cannon/templates/statefulset.yaml +++ b/charts/cannon/templates/statefulset.yaml @@ -9,7 +9,7 @@ kind: StatefulSet metadata: name: cannon labels: - wireService: cannon + app: cannon chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} @@ -17,7 +17,7 @@ spec: serviceName: {{ .Values.service.name }} selector: matchLabels: - wireService: cannon + app: cannon replicas: {{ .Values.replicaCount }} updateStrategy: type: RollingUpdate @@ -25,7 +25,7 @@ spec: template: metadata: labels: - wireService: cannon + app: cannon release: {{ .Release.Name }} annotations: checksum/configmap: {{ include (print .Template.BasePath "/configmap.yaml") . | sha256sum }} diff --git a/charts/cannon/values.yaml b/charts/cannon/values.yaml index f5f4970df2..16c77ee347 100644 --- a/charts/cannon/values.yaml +++ b/charts/cannon/values.yaml @@ -20,6 +20,10 @@ config: millisecondsBetweenBatches: 50 minBatchSize: 20 +metrics: + serviceMonitor: + enable: false + nginx_conf: user: nginx group: nginx diff --git a/charts/cargohold/templates/deployment.yaml b/charts/cargohold/templates/deployment.yaml index 25146020f5..771d97f94f 100644 --- a/charts/cargohold/templates/deployment.yaml +++ b/charts/cargohold/templates/deployment.yaml @@ -3,7 +3,7 @@ kind: Deployment metadata: name: cargohold labels: - wireService: cargohold + app: cargohold chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} @@ -16,11 +16,11 @@ spec: maxSurge: {{ .Values.replicaCount }} selector: matchLabels: - wireService: cargohold + app: cargohold template: metadata: labels: - wireService: cargohold + app: cargohold release: {{ .Release.Name }} annotations: # An annotation of the configmap checksum ensures changes to the configmap cause a redeployment upon `helm upgrade` diff --git a/charts/cargohold/templates/service.yaml b/charts/cargohold/templates/service.yaml index 3621ea652f..af4957e907 100644 --- a/charts/cargohold/templates/service.yaml +++ b/charts/cargohold/templates/service.yaml @@ -3,7 +3,7 @@ kind: Service metadata: name: cargohold labels: - wireService: cargohold + app: cargohold chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} @@ -14,5 +14,5 @@ spec: port: {{ .Values.service.externalPort }} targetPort: {{ .Values.service.internalPort }} selector: - wireService: cargohold + app: cargohold release: {{ .Release.Name }} diff --git a/charts/cargohold/templates/serviceaccount.yaml b/charts/cargohold/templates/serviceaccount.yaml index 0460ce90d4..199206e427 100644 --- a/charts/cargohold/templates/serviceaccount.yaml +++ b/charts/cargohold/templates/serviceaccount.yaml @@ -4,7 +4,7 @@ kind: ServiceAccount metadata: name: {{ .Values.serviceAccount.name }} labels: - wireService: cargohold + app: cargohold chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} diff --git a/charts/cargohold/templates/servicemonitor.yaml b/charts/cargohold/templates/servicemonitor.yaml new file mode 100644 index 0000000000..106fad9ff3 --- /dev/null +++ b/charts/cargohold/templates/servicemonitor.yaml @@ -0,0 +1,19 @@ +{{- if .Values.metrics.serviceMonitor.enabled }} +apiVersion: monitoring.coreos.com/v1 +kind: ServiceMonitor +metadata: + name: cargohold + labels: + app: cargohold + chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} + release: {{ .Release.Name }} + heritage: {{ .Release.Service }} +spec: + endpoints: + - port: http + path: /i/metrics + selector: + matchLabels: + app: cargohold + release: {{ .Release.Name }} +{{- end }} diff --git a/charts/cargohold/values.yaml b/charts/cargohold/values.yaml index b72ebb6b7b..b9cc40ff5c 100644 --- a/charts/cargohold/values.yaml +++ b/charts/cargohold/values.yaml @@ -5,6 +5,9 @@ image: service: externalPort: 8080 internalPort: 8080 +metrics: + serviceMonitor: + enable: false resources: requests: memory: "256Mi" diff --git a/charts/cassandra-migrations/templates/galley-migrate-data.yaml b/charts/cassandra-migrations/templates/galley-migrate-data.yaml index 3800615d2b..69a15f8238 100644 --- a/charts/cassandra-migrations/templates/galley-migrate-data.yaml +++ b/charts/cassandra-migrations/templates/galley-migrate-data.yaml @@ -7,7 +7,7 @@ kind: Job metadata: name: galley-migrate-data labels: - wireService: "cassandra-migrations" + app: "cassandra-migrations" chart: "{{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }}" release: "{{ .Release.Name }}" heritage: "{{ .Release.Service }}" @@ -20,7 +20,7 @@ spec: metadata: name: "{{.Release.Name}}" labels: - wireService: galley-migrate-data + app: galley-migrate-data app: galley-migrate-data heritage: {{.Release.Service | quote }} release: {{.Release.Name | quote }} diff --git a/charts/cassandra-migrations/templates/migrate-schema.yaml b/charts/cassandra-migrations/templates/migrate-schema.yaml index b64815b655..5bd3c06055 100644 --- a/charts/cassandra-migrations/templates/migrate-schema.yaml +++ b/charts/cassandra-migrations/templates/migrate-schema.yaml @@ -3,7 +3,7 @@ kind: Job metadata: name: cassandra-migrations labels: - wireService: cassandra-migrations + app: cassandra-migrations chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} @@ -15,7 +15,7 @@ spec: template: metadata: labels: - wireService: cassandra-migrations + app: cassandra-migrations release: {{ .Release.Name }} spec: restartPolicy: OnFailure diff --git a/charts/cassandra-migrations/templates/spar-migrate-data.yaml b/charts/cassandra-migrations/templates/spar-migrate-data.yaml index 26710c7369..1b9c48e066 100644 --- a/charts/cassandra-migrations/templates/spar-migrate-data.yaml +++ b/charts/cassandra-migrations/templates/spar-migrate-data.yaml @@ -7,7 +7,7 @@ kind: Job metadata: name: spar-migrate-data labels: - wireService: "cassandra-migrations" + app: "cassandra-migrations" chart: "{{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }}" release: "{{ .Release.Name }}" heritage: "{{ .Release.Service }}" @@ -20,7 +20,6 @@ spec: metadata: name: "{{.Release.Name}}" labels: - wireService: spar-migrate-data app: spar-migrate-data heritage: {{.Release.Service | quote }} release: {{.Release.Name | quote }} diff --git a/charts/elasticsearch-ephemeral/templates/es-svc.yaml b/charts/elasticsearch-ephemeral/templates/es-svc.yaml index b8189bcf8c..499652ee77 100644 --- a/charts/elasticsearch-ephemeral/templates/es-svc.yaml +++ b/charts/elasticsearch-ephemeral/templates/es-svc.yaml @@ -3,7 +3,6 @@ kind: Service metadata: name: {{ template "fullname" . }} labels: - wireService: {{ template "fullname" . }} app: {{ template "fullname" . }} chart: "{{ .Chart.Name }}-{{ .Chart.Version }}" release: "{{ .Release.Name }}" diff --git a/charts/elasticsearch-ephemeral/templates/es.yaml b/charts/elasticsearch-ephemeral/templates/es.yaml index 855c4488bb..79526560ad 100644 --- a/charts/elasticsearch-ephemeral/templates/es.yaml +++ b/charts/elasticsearch-ephemeral/templates/es.yaml @@ -3,7 +3,6 @@ kind: Deployment metadata: name: {{ template "fullname" . }} labels: - wireService: {{ template "fullname" . }} app: {{ template "fullname" . }} chart: "{{ .Chart.Name }}-{{ .Chart.Version }}" release: "{{ .Release.Name }}" diff --git a/charts/elasticsearch-index/templates/create-index.yaml b/charts/elasticsearch-index/templates/create-index.yaml index 4a1d8db107..804ed4af83 100644 --- a/charts/elasticsearch-index/templates/create-index.yaml +++ b/charts/elasticsearch-index/templates/create-index.yaml @@ -3,7 +3,6 @@ kind: Job metadata: name: elasticsearch-index-create labels: - wireService: elasticsearch-index-create app: elasticsearch-index-create heritage: {{.Release.Service | quote }} release: {{.Release.Name | quote }} @@ -16,7 +15,6 @@ spec: metadata: name: "{{.Release.Name}}" labels: - wireService: elasticsearch-index-create app: elasticsearch-index-create heritage: {{.Release.Service | quote }} release: {{.Release.Name | quote }} diff --git a/charts/elasticsearch-index/templates/migrate-data.yaml b/charts/elasticsearch-index/templates/migrate-data.yaml index 2e5ae1f7e8..3ef47bcf5e 100644 --- a/charts/elasticsearch-index/templates/migrate-data.yaml +++ b/charts/elasticsearch-index/templates/migrate-data.yaml @@ -3,7 +3,6 @@ kind: Job metadata: name: brig-index-migrate-data labels: - wireService: elasticsearch-index-migrate-data app: elasticsearch-index-migrate-data heritage: {{.Release.Service | quote }} release: {{.Release.Name | quote }} @@ -16,7 +15,6 @@ spec: metadata: name: "{{.Release.Name}}" labels: - wireService: elasticsearch-index-migrate-data app: elasticsearch-index-migrate-data heritage: {{.Release.Service | quote }} release: {{.Release.Name | quote }} diff --git a/charts/federator/templates/ca.yaml b/charts/federator/templates/ca.yaml index 8363507e1b..2a14449224 100644 --- a/charts/federator/templates/ca.yaml +++ b/charts/federator/templates/ca.yaml @@ -3,7 +3,7 @@ kind: ConfigMap metadata: name: "federator-ca" labels: - wireService: federator + app: federator chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} diff --git a/charts/federator/templates/configmap.yaml b/charts/federator/templates/configmap.yaml index 58c1310684..287e4a9ac7 100644 --- a/charts/federator/templates/configmap.yaml +++ b/charts/federator/templates/configmap.yaml @@ -3,7 +3,7 @@ kind: ConfigMap metadata: name: "federator" labels: - wireService: federator + app: federator chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} diff --git a/charts/federator/templates/deployment.yaml b/charts/federator/templates/deployment.yaml index c09a239710..b87dc660ef 100644 --- a/charts/federator/templates/deployment.yaml +++ b/charts/federator/templates/deployment.yaml @@ -3,7 +3,7 @@ kind: Deployment metadata: name: federator labels: - wireService: federator + app: federator chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} @@ -16,11 +16,11 @@ spec: maxSurge: {{ .Values.replicaCount }} selector: matchLabels: - wireService: federator + app: federator template: metadata: labels: - wireService: federator + app: federator release: {{ .Release.Name }} annotations: # An annotation of the configmap checksum ensures changes to the configmap cause a redeployment upon `helm upgrade` diff --git a/charts/federator/templates/secret.yaml b/charts/federator/templates/secret.yaml index f1337b952d..201b5c83bd 100644 --- a/charts/federator/templates/secret.yaml +++ b/charts/federator/templates/secret.yaml @@ -4,7 +4,7 @@ kind: Secret metadata: name: "federator-secret" labels: - wireService: federator + app: federator chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} diff --git a/charts/federator/templates/service.yaml b/charts/federator/templates/service.yaml index 65da250677..5394e54b1a 100644 --- a/charts/federator/templates/service.yaml +++ b/charts/federator/templates/service.yaml @@ -3,7 +3,7 @@ kind: Service metadata: name: federator labels: - wireService: federator + app: federator chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} @@ -18,5 +18,5 @@ spec: port: {{ .Values.service.externalFederatorPort }} targetPort: {{ .Values.service.externalFederatorPort }} selector: - wireService: federator + app: federator release: {{ .Release.Name }} diff --git a/charts/galley/templates/deployment.yaml b/charts/galley/templates/deployment.yaml index 3f8f4344fe..ca23d99967 100644 --- a/charts/galley/templates/deployment.yaml +++ b/charts/galley/templates/deployment.yaml @@ -3,7 +3,7 @@ kind: Deployment metadata: name: galley labels: - wireService: galley + app: galley chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} @@ -16,11 +16,11 @@ spec: maxSurge: {{ .Values.replicaCount }} selector: matchLabels: - wireService: galley + app: galley template: metadata: labels: - wireService: galley + app: galley release: {{ .Release.Name }} annotations: # An annotation of the configmap checksum ensures changes to the configmap cause a redeployment upon `helm upgrade` diff --git a/charts/galley/templates/service.yaml b/charts/galley/templates/service.yaml index 805ea9a89f..f79d3a70e9 100644 --- a/charts/galley/templates/service.yaml +++ b/charts/galley/templates/service.yaml @@ -3,7 +3,7 @@ kind: Service metadata: name: galley labels: - wireService: galley + app: galley chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} @@ -14,5 +14,5 @@ spec: port: {{ .Values.service.externalPort }} targetPort: {{ .Values.service.internalPort }} selector: - wireService: galley + app: galley release: {{ .Release.Name }} diff --git a/charts/galley/templates/serviceaccount.yaml b/charts/galley/templates/serviceaccount.yaml index 32c155679f..29b763c398 100644 --- a/charts/galley/templates/serviceaccount.yaml +++ b/charts/galley/templates/serviceaccount.yaml @@ -4,7 +4,7 @@ kind: ServiceAccount metadata: name: {{ .Values.serviceAccount.name }} labels: - wireService: galley + app: galley chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} diff --git a/charts/galley/templates/servicemonitor.yaml b/charts/galley/templates/servicemonitor.yaml new file mode 100644 index 0000000000..8d9e43f8e5 --- /dev/null +++ b/charts/galley/templates/servicemonitor.yaml @@ -0,0 +1,19 @@ +{{- if .Values.metrics.serviceMonitor.enabled }} +apiVersion: monitoring.coreos.com/v1 +kind: ServiceMonitor +metadata: + name: galley + labels: + app: galley + chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} + release: {{ .Release.Name }} + heritage: {{ .Release.Service }} +spec: + endpoints: + - port: http + path: /i/metrics + selector: + matchLabels: + app: galley + release: {{ .Release.Name }} +{{- end }} diff --git a/charts/galley/templates/tests/galley-integration.yaml b/charts/galley/templates/tests/galley-integration.yaml index 33034050bf..a688764dfe 100644 --- a/charts/galley/templates/tests/galley-integration.yaml +++ b/charts/galley/templates/tests/galley-integration.yaml @@ -3,7 +3,7 @@ kind: Service metadata: name: "galley-integration" labels: - wireService: galley-integration + app: galley-integration chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} @@ -13,7 +13,7 @@ spec: - port: 9000 targetPort: 9000 selector: - wireService: galley-integration + app: galley-integration release: {{ .Release.Name }} --- apiVersion: v1 @@ -23,7 +23,7 @@ metadata: annotations: "helm.sh/hook": test-success labels: - wireService: galley-integration + app: galley-integration release: {{ .Release.Name }} spec: volumes: diff --git a/charts/galley/values.yaml b/charts/galley/values.yaml index a070ebea49..1ff14e4123 100644 --- a/charts/galley/values.yaml +++ b/charts/galley/values.yaml @@ -6,6 +6,9 @@ image: service: externalPort: 8080 internalPort: 8080 +metrics: + serviceMonitor: + enable: false resources: requests: memory: "256Mi" diff --git a/charts/gundeck/templates/deployment.yaml b/charts/gundeck/templates/deployment.yaml index 4ff4ef0185..a083addfb9 100644 --- a/charts/gundeck/templates/deployment.yaml +++ b/charts/gundeck/templates/deployment.yaml @@ -3,7 +3,7 @@ kind: Deployment metadata: name: gundeck labels: - wireService: gundeck + app: gundeck chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} @@ -16,11 +16,11 @@ spec: maxSurge: {{ .Values.replicaCount }} selector: matchLabels: - wireService: gundeck + app: gundeck template: metadata: labels: - wireService: gundeck + app: gundeck release: {{ .Release.Name }} annotations: # An annotation of the configmap checksum ensures changes to the configmap cause a redeployment upon `helm upgrade` diff --git a/charts/gundeck/templates/secret.yaml b/charts/gundeck/templates/secret.yaml index e9de2b6979..459ab0f24f 100644 --- a/charts/gundeck/templates/secret.yaml +++ b/charts/gundeck/templates/secret.yaml @@ -4,7 +4,7 @@ kind: Secret metadata: name: gundeck labels: - wireService: gundeck + app: gundeck chart: "{{ .Chart.Name }}-{{ .Chart.Version }}" release: "{{ .Release.Name }}" heritage: "{{ .Release.Service }}" diff --git a/charts/gundeck/templates/service.yaml b/charts/gundeck/templates/service.yaml index 14921fc655..0d27085f1a 100644 --- a/charts/gundeck/templates/service.yaml +++ b/charts/gundeck/templates/service.yaml @@ -3,7 +3,7 @@ kind: Service metadata: name: gundeck labels: - wireService: gundeck + app: gundeck chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} @@ -14,5 +14,5 @@ spec: port: {{ .Values.service.externalPort }} targetPort: {{ .Values.service.internalPort }} selector: - wireService: gundeck + app: gundeck release: {{ .Release.Name }} diff --git a/charts/gundeck/templates/serviceaccount.yaml b/charts/gundeck/templates/serviceaccount.yaml index 93de4b25f5..59bdd51128 100644 --- a/charts/gundeck/templates/serviceaccount.yaml +++ b/charts/gundeck/templates/serviceaccount.yaml @@ -4,7 +4,7 @@ kind: ServiceAccount metadata: name: {{ .Values.serviceAccount.name }} labels: - wireService: gundeck + app: gundeck chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} diff --git a/charts/gundeck/templates/servicemonitor.yaml b/charts/gundeck/templates/servicemonitor.yaml new file mode 100644 index 0000000000..bd1adc4c1d --- /dev/null +++ b/charts/gundeck/templates/servicemonitor.yaml @@ -0,0 +1,19 @@ +{{- if .Values.metrics.serviceMonitor.enabled }} +apiVersion: monitoring.coreos.com/v1 +kind: ServiceMonitor +metadata: + name: gundeck + labels: + app: gundeck + chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} + release: {{ .Release.Name }} + heritage: {{ .Release.Service }} +spec: + endpoints: + - port: http + path: /i/metrics + selector: + matchLabels: + app: gundeck + release: {{ .Release.Name }} +{{- end }} diff --git a/charts/gundeck/values.yaml b/charts/gundeck/values.yaml index 618c7cf867..9e8f022004 100644 --- a/charts/gundeck/values.yaml +++ b/charts/gundeck/values.yaml @@ -5,6 +5,9 @@ image: service: externalPort: 8080 internalPort: 8080 +metrics: + serviceMonitor: + enable: false resources: requests: memory: "256Mi" diff --git a/charts/ldap-scim-bridge/templates/cronjob.yaml b/charts/ldap-scim-bridge/templates/cronjob.yaml index fbd10986a2..d5592b49ad 100644 --- a/charts/ldap-scim-bridge/templates/cronjob.yaml +++ b/charts/ldap-scim-bridge/templates/cronjob.yaml @@ -3,7 +3,7 @@ kind: CronJob metadata: name: ldap-scim-bridge labels: - wireService: ldap-scim-bridge + app: ldap-scim-bridge chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} @@ -13,7 +13,7 @@ spec: jobTemplate: metadata: labels: - wireService: ldap-scim-bridge + app: ldap-scim-bridge release: {{ .Release.Name }} annotations: # An annotation of the configmap checksum ensures changes to the configmap cause a redeployment upon `helm upgrade` diff --git a/charts/ldap-scim-bridge/templates/secret.yaml b/charts/ldap-scim-bridge/templates/secret.yaml index 01e8bc3568..93f979cecb 100644 --- a/charts/ldap-scim-bridge/templates/secret.yaml +++ b/charts/ldap-scim-bridge/templates/secret.yaml @@ -3,11 +3,11 @@ kind: Secret metadata: name: ldap-scim-bridge labels: - wireService: ldap-scim-bridge + app: ldap-scim-bridge chart: "{{ .Chart.Name }}-{{ .Chart.Version }}" release: "{{ .Release.Name }}" heritage: "{{ .Release.Service }}" type: Opaque stringData: config.yaml: | -{{ toYaml .Values.config | indent 4 }} \ No newline at end of file +{{ toYaml .Values.config | indent 4 }} diff --git a/charts/nginx-ingress-services/templates/service.yaml b/charts/nginx-ingress-services/templates/service.yaml index 236789b856..c55c69b152 100644 --- a/charts/nginx-ingress-services/templates/service.yaml +++ b/charts/nginx-ingress-services/templates/service.yaml @@ -9,7 +9,7 @@ spec: - port: {{ .Values.service.nginz.externalHttpPort }} targetPort: 8080 selector: - wireService: nginz + app: nginz {{- if .Values.websockets.enabled }} --- apiVersion: v1 @@ -22,7 +22,7 @@ spec: - port: {{ .Values.service.nginz.externalTcpPort }} targetPort: 8081 selector: - wireService: nginz + app: nginz {{- end }} {{- if .Values.webapp.enabled }} --- @@ -36,7 +36,7 @@ spec: - port: {{ .Values.service.webapp.externalPort }} targetPort: 8080 selector: - wireService: webapp + app: webapp {{- end }} {{- if not .Values.service.s3.externallyCreated }} --- @@ -50,7 +50,7 @@ spec: - port: {{ .Values.service.s3.externalPort }} targetPort: 9000 selector: - wireService: {{ .Values.service.s3.serviceName }} + app: {{ .Values.service.s3.serviceName }} {{- end }} {{- if .Values.teamSettings.enabled }} --- @@ -64,7 +64,7 @@ spec: - port: {{ .Values.service.teamSettings.externalPort }} targetPort: 8080 selector: - wireService: team-settings + app: team-settings {{- end }} {{- if .Values.accountPages.enabled }} --- @@ -78,5 +78,5 @@ spec: - port: {{ .Values.service.accountPages.externalPort }} targetPort: 8080 selector: - wireService: account-pages + app: account-pages {{- end }} diff --git a/charts/nginz/templates/deployment.yaml b/charts/nginz/templates/deployment.yaml index d790e22913..3abda67744 100644 --- a/charts/nginz/templates/deployment.yaml +++ b/charts/nginz/templates/deployment.yaml @@ -3,7 +3,7 @@ kind: Deployment metadata: name: nginz labels: - wireService: nginz + app: nginz chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} @@ -16,12 +16,10 @@ spec: maxSurge: {{ .Values.replicaCount | mul 2 }} selector: matchLabels: - wireService: nginz app: nginz template: metadata: labels: - wireService: nginz app: nginz release: {{ .Release.Name }} annotations: diff --git a/charts/nginz/templates/secret.yaml b/charts/nginz/templates/secret.yaml index 2dc5ab8509..12779270f6 100644 --- a/charts/nginz/templates/secret.yaml +++ b/charts/nginz/templates/secret.yaml @@ -3,7 +3,6 @@ kind: Secret metadata: name: nginz labels: - wireService: nginz app: nginz chart: "{{ .Chart.Name }}-{{ .Chart.Version }}" release: "{{ .Release.Name }}" diff --git a/charts/openldap/templates/openldap.yaml b/charts/openldap/templates/openldap.yaml index 0e2281d27d..28ed001aa6 100644 --- a/charts/openldap/templates/openldap.yaml +++ b/charts/openldap/templates/openldap.yaml @@ -3,7 +3,7 @@ kind: Pod metadata: name: "openldap" labels: - wireService: openldap + app: openldap chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} @@ -51,4 +51,4 @@ spec: - name: LDAP_ORGANISATION value: "People" - name: LDAP_ADMIN_PASSWORD - value: "admin" \ No newline at end of file + value: "admin" diff --git a/charts/openldap/templates/secret-newusers.yaml b/charts/openldap/templates/secret-newusers.yaml index b78ef5a220..0397cb0af5 100644 --- a/charts/openldap/templates/secret-newusers.yaml +++ b/charts/openldap/templates/secret-newusers.yaml @@ -3,7 +3,7 @@ kind: Secret metadata: name: openldap-newusers-ldif labels: - wireService: ldap-scim-bridge + app: ldap-scim-bridge chart: "{{ .Chart.Name }}-{{ .Chart.Version }}" release: "{{ .Release.Name }}" heritage: "{{ .Release.Service }}" diff --git a/charts/openldap/templates/service.yaml b/charts/openldap/templates/service.yaml index 356597c605..b140faf368 100644 --- a/charts/openldap/templates/service.yaml +++ b/charts/openldap/templates/service.yaml @@ -4,9 +4,9 @@ metadata: name: openldap spec: selector: - wireService: openldap + app: openldap ports: - name: openldap protocol: TCP port: 389 - targetPort: 389 \ No newline at end of file + targetPort: 389 diff --git a/charts/proxy/templates/deployment.yaml b/charts/proxy/templates/deployment.yaml index bedb30e16f..d2f1f4f6a8 100644 --- a/charts/proxy/templates/deployment.yaml +++ b/charts/proxy/templates/deployment.yaml @@ -3,7 +3,7 @@ kind: Deployment metadata: name: proxy labels: - wireService: proxy + app: proxy chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} @@ -16,11 +16,11 @@ spec: maxSurge: {{ .Values.replicaCount }} selector: matchLabels: - wireService: proxy + app: proxy template: metadata: labels: - wireService: proxy + app: proxy release: {{ .Release.Name }} annotations: # An annotation of the configmap checksum ensures changes to the configmap cause a redeployment upon `helm upgrade` diff --git a/charts/proxy/templates/service.yaml b/charts/proxy/templates/service.yaml index 0b60d66f6d..2bda5053b2 100644 --- a/charts/proxy/templates/service.yaml +++ b/charts/proxy/templates/service.yaml @@ -3,7 +3,7 @@ kind: Service metadata: name: proxy labels: - wireService: proxy + app: proxy chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} @@ -14,5 +14,5 @@ spec: port: {{ .Values.service.externalPort }} targetPort: {{ .Values.service.internalPort }} selector: - wireService: proxy + app: proxy release: {{ .Release.Name }} diff --git a/charts/proxy/templates/servicemonitor.yaml b/charts/proxy/templates/servicemonitor.yaml new file mode 100644 index 0000000000..88120fe7cd --- /dev/null +++ b/charts/proxy/templates/servicemonitor.yaml @@ -0,0 +1,19 @@ +{{- if .Values.metrics.serviceMonitor.enabled }} +apiVersion: monitoring.coreos.com/v1 +kind: ServiceMonitor +metadata: + name: proxy + labels: + app: proxy + chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} + release: {{ .Release.Name }} + heritage: {{ .Release.Service }} +spec: + endpoints: + - port: http + path: /i/metrics + selector: + matchLabels: + app: proxy + release: {{ .Release.Name }} +{{- end }} diff --git a/charts/proxy/values.yaml b/charts/proxy/values.yaml index ec7b8a8182..f7de774ea0 100644 --- a/charts/proxy/values.yaml +++ b/charts/proxy/values.yaml @@ -5,6 +5,9 @@ image: service: externalPort: 8080 internalPort: 8080 +metrics: + serviceMonitor: + enable: false resources: requests: memory: "128Mi" @@ -14,4 +17,4 @@ resources: cpu: "500m" config: logLevel: Debug - proxy: {} \ No newline at end of file + proxy: {} diff --git a/charts/reaper/templates/deployment.yaml b/charts/reaper/templates/deployment.yaml index 1601a2acbe..8a11b60b4f 100644 --- a/charts/reaper/templates/deployment.yaml +++ b/charts/reaper/templates/deployment.yaml @@ -3,7 +3,7 @@ kind: Deployment metadata: name: reaper labels: - wireService: reaper + app: reaper chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} @@ -11,12 +11,12 @@ spec: replicas: 1 selector: matchLabels: - wireService: reaper + app: reaper release: {{ .Release.Name }} template: metadata: labels: - wireService: reaper + app: reaper release: {{ .Release.Name }} spec: serviceAccountName: reaper-role diff --git a/charts/spar/templates/deployment.yaml b/charts/spar/templates/deployment.yaml index a6b86f8bbd..874caafc42 100644 --- a/charts/spar/templates/deployment.yaml +++ b/charts/spar/templates/deployment.yaml @@ -3,7 +3,7 @@ kind: Deployment metadata: name: spar labels: - wireService: spar + app: spar chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} @@ -16,11 +16,11 @@ spec: maxSurge: {{ .Values.replicaCount }} selector: matchLabels: - wireService: spar + app: spar template: metadata: labels: - wireService: spar + app: spar release: {{ .Release.Name }} annotations: # An annotation of the configmap checksum ensures changes to the configmap cause a redeployment upon `helm upgrade` diff --git a/charts/spar/templates/service.yaml b/charts/spar/templates/service.yaml index e360ac0f3d..711967459f 100644 --- a/charts/spar/templates/service.yaml +++ b/charts/spar/templates/service.yaml @@ -3,7 +3,7 @@ kind: Service metadata: name: spar labels: - wireService: spar + app: spar chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} @@ -14,5 +14,5 @@ spec: port: {{ .Values.service.externalPort }} targetPort: {{ .Values.service.internalPort }} selector: - wireService: spar + app: spar release: {{ .Release.Name }} diff --git a/charts/spar/templates/servicemonitor.yaml b/charts/spar/templates/servicemonitor.yaml new file mode 100644 index 0000000000..f2b23703b6 --- /dev/null +++ b/charts/spar/templates/servicemonitor.yaml @@ -0,0 +1,19 @@ +{{- if .Values.metrics.serviceMonitor.enabled }} +apiVersion: monitoring.coreos.com/v1 +kind: ServiceMonitor +metadata: + name: spar + labels: + app: spar + chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} + release: {{ .Release.Name }} + heritage: {{ .Release.Service }} +spec: + endpoints: + - port: http + path: /i/metrics + selector: + matchLabels: + app: spar + release: {{ .Release.Name }} +{{- end }} diff --git a/charts/spar/templates/tests/spar-integration.yaml b/charts/spar/templates/tests/spar-integration.yaml index 19646326a7..c4735ffd15 100644 --- a/charts/spar/templates/tests/spar-integration.yaml +++ b/charts/spar/templates/tests/spar-integration.yaml @@ -5,7 +5,7 @@ metadata: annotations: "helm.sh/hook": test-success labels: - wireService: spar-integration + app: spar-integration release: {{ .Release.Name }} spec: volumes: diff --git a/charts/spar/values.yaml b/charts/spar/values.yaml index 60f7e8d10d..3cdd3b8490 100644 --- a/charts/spar/values.yaml +++ b/charts/spar/values.yaml @@ -2,6 +2,9 @@ replicaCount: 3 image: repository: quay.io/wire/spar tag: do-not-use +metrics: + serviceMonitor: + enable: false resources: requests: memory: "128Mi" @@ -20,4 +23,4 @@ config: logLevel: Info maxttlAuthreq: 7200 maxttlAuthresp: 7200 - proxy: {} \ No newline at end of file + proxy: {} diff --git a/charts/team-settings/templates/deployment.yaml b/charts/team-settings/templates/deployment.yaml index 467d632445..b560d8ca57 100644 --- a/charts/team-settings/templates/deployment.yaml +++ b/charts/team-settings/templates/deployment.yaml @@ -3,7 +3,7 @@ kind: Deployment metadata: name: team-settings labels: - wireService: team-settings + app: team-settings chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} @@ -16,12 +16,10 @@ spec: maxSurge: {{ .Values.replicaCount | mul 2 }} selector: matchLabels: - wireService: team-settings app: team-settings template: metadata: labels: - wireService: team-settings app: team-settings release: {{ .Release.Name }} spec: diff --git a/charts/webapp/templates/deployment.yaml b/charts/webapp/templates/deployment.yaml index 14c8f15c78..457d9547b9 100644 --- a/charts/webapp/templates/deployment.yaml +++ b/charts/webapp/templates/deployment.yaml @@ -3,7 +3,7 @@ kind: Deployment metadata: name: webapp labels: - wireService: webapp + app: webapp chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} @@ -16,12 +16,10 @@ spec: maxSurge: {{ .Values.replicaCount | mul 2 }} selector: matchLabels: - wireService: webapp app: webapp template: metadata: labels: - wireService: webapp app: webapp release: {{ .Release.Name }} spec: diff --git a/charts/wire-server-metrics/values.yaml b/charts/wire-server-metrics/values.yaml index 44bac846a3..7a9a8b8763 100644 --- a/charts/wire-server-metrics/values.yaml +++ b/charts/wire-server-metrics/values.yaml @@ -1,29 +1,4 @@ kube-prometheus-stack: - prometheus: - additionalServiceMonitors: - - name: wire-services - # We copy these labels from the pod onto the collected metrics from that pod - targetLabels: - - wireService - endpoints: - - path: '/i/metrics' - port: http - interval: 10s - metricRelabelings: - # Rename 'service' to 'role' to allow sharing of grafana dashboards - # between k8s and AWS services. - - sourceLabels: [service] - targetLabel: role - # This monitors _all_ namespaces and selects all - # pods that with a wireServices selector - namespaceSelector: - any: true - selector: - matchExpressions: - # select any pod with a 'wireService' label - - key: wireService - operator: Exists - prometheusOperator: # Don't try to create custom resource types; we prefer to do it manually # Otherwise we run into race conditions when installing helm charts diff --git a/docs/src/how-to/administrate/restund.rst b/docs/src/how-to/administrate/restund.rst index b62731e6bd..584066ab43 100644 --- a/docs/src/how-to/administrate/restund.rst +++ b/docs/src/how-to/administrate/restund.rst @@ -220,7 +220,7 @@ You then need to restart the ``brig`` pods if your code is older than September .. code:: bash - kubectl delete pod -l wireService=brig + kubectl delete pod -l app=brig 2. Wait for traffic to drain. This can take up to 12 hours after the configuration change. Wait until current allocations (people connected to the restund server) return 0. See :ref:`allocations`. 3. It's now safe to ``systemctl stop restund``, and take any necessary actions. diff --git a/services/brig/federation-tests.sh b/services/brig/federation-tests.sh index 76acd31691..6212f75f85 100755 --- a/services/brig/federation-tests.sh +++ b/services/brig/federation-tests.sh @@ -34,7 +34,7 @@ sed -i "s=publicKeys: /etc/wire/brig/secrets/publickey.txt=publicKeys: test/reso declare -a alsoProxyOptions while read -r ip; do alsoProxyOptions+=("--also-proxy=${ip}") -done < <(kubectl get pods -n "$NAMESPACE" -l wireService=cannon -o json | jq -r '.items[].status.podIPs[].ip') +done < <(kubectl get pods -n "$NAMESPACE" -l app=cannon -o json | jq -r '.items[].status.podIPs[].ip') # shellcheck disable=SC2086 telepresence --namespace "$NAMESPACE" --also-proxy=cassandra-ephemeral ${alsoProxyOptions[*]} --run bash -c "export INTEGRATION_FEDERATION_TESTS=1; ./dist/brig-integration -p federation-end2end-user -i i.yaml -s b.yaml" From 1ae174dfc8e3f1ed24ce60845cbb51d82ca22067 Mon Sep 17 00:00:00 2001 From: Sebastian Willenborg Date: Fri, 10 Jun 2022 10:10:22 +0200 Subject: [PATCH 17/29] fix(docs): use if-block to support older version of sphinx when adding the logo (#2471) --- docs/src/_templates/layout.html | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/docs/src/_templates/layout.html b/docs/src/_templates/layout.html index cdf6b5c4a8..357a7a120b 100644 --- a/docs/src/_templates/layout.html +++ b/docs/src/_templates/layout.html @@ -2,7 +2,11 @@ {% block sidebartitle %} + {%- if logo %} + + {%- else %} + {%- endif %}