Skip to content

Lint remaining services #2458

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
elland merged 2 commits into from
Jun 9, 2022
Merged

Lint remaining services #2458

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
a1a4842
Linted remaining services.
elland Jun 7, 2022
488bf54
Replace return with pure.
elland Jun 7, 2022
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
8 changes: 3 additions & 5 deletions services/federator/src/Federator/Monitor.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down
2 changes: 1 addition & 1 deletion services/federator/src/Federator/Run.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
12 changes: 6 additions & 6 deletions services/federator/test/integration/Test/Federator/Util.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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"
Expand All @@ -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
Expand All @@ -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 =
Expand Down
2 changes: 1 addition & 1 deletion services/federator/test/unit/Test/Federator/Options.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
4 changes: 2 additions & 2 deletions services/proxy/src/Proxy/API.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
26 changes: 13 additions & 13 deletions services/proxy/src/Proxy/API/Public.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion services/proxy/src/Proxy/Env.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
13 changes: 8 additions & 5 deletions services/spar/migrate-data/src/Spar/DataMigration/V1_ExternalIds.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Comment on lines +189 to +196
Copy link
Contributor

@fisx fisx Jun 8, 2022

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I strongly disagree. what does hlint say if we put brackets around dryRun <$> askMigEnv in the original code?

Copy link
Contributor Author

@elland elland Jun 8, 2022

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Yeah, I'm not sold on this either… A few suggestions seem to be counter-productive when we have code like this.

Copy link
Contributor Author

@elland elland Jun 8, 2022 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Same, redundant <$>. How about extracting the case match?

Something along these lines (needs a better name):

sink ::
  ( HasSpar env,
    HasLogger env,
    HasMigEnv env,
    HasFailCount env
  ) =>
  ConduitM [ResolveTeamResult] Void (RIO env) ()
sink = go
  where
    go = do
      mbResult <- await
      for_ mbResult $ \results -> do
        for_ results $ \case
          UserHasNoTeam uid extid -> do
            lift $ do
              modifyRef failCount (+ 1)
              dbg <- debug <$> askMigEnv
              when (dbg == Debug) $
                logDebug ("No team for user " <> show uid <> " from extid " <> show extid)
          NewExternalId (tid, extid, uid) ->
            lift $
              askMigEnv >>= whetherDryRun tid extid uid . dryRun
        go
    insert :: PrepQuery W (TeamId, Text, UserId) ()
    insert = "INSERT INTO scim_external (team, external_id, user) VALUES (?, ?, ?)"
    whetherDryRun tid extid uid = \case
      DryRun -> pure ()
      NoDryRun ->
        runSpar $
          write insert (params LocalQuorum (tid, extid, uid))

go
insert :: PrepQuery W (TeamId, Text, UserId) ()
insert = "INSERT INTO scim_external (team, external_id, user) VALUES (?, ?, ?)"