diff --git a/CHANGELOG.md b/CHANGELOG.md index e841313a7..d7ae6a128 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,7 +5,7 @@ All notable changes to this project will be documented in this file. ### Added -- [crawler] Proxy can be configured with `http_proxy` and `https_proxy` environment. +- [crawler] Proxy can be configured with `HTTP_PROXY` and `HTTPS_PROXY` environment. To proxy http requests between crawlers and the api, use the `API_PROXY` environment. - [crawler] A new `groups` sub-field in all Author fields (`on_author` and `author`) for `Change` and `Events`. Groups memberships are reflected from the config file to the database. diff --git a/src/Lentille/Gerrit.hs b/src/Lentille/Gerrit.hs index 8312d4f4f..167b5e187 100644 --- a/src/Lentille/Gerrit.hs +++ b/src/Lentille/Gerrit.hs @@ -74,7 +74,7 @@ queryChanges env count queries startM = unsafeEff_ $ G.queryChanges count querie getClient :: Text -> Maybe (Text, Secret) -> IO G.GerritClient getClient url auth = do - manager <- mkManager + manager <- mkManager Nothing pure $ G.getClientWithManager manager url (getGerritAuth <$> auth) getGerritAuth :: (Text, Secret) -> (Text, Text) diff --git a/src/Monocle/Client.hs b/src/Monocle/Client.hs index f92fbae2e..bfcb148d8 100644 --- a/src/Monocle/Client.hs +++ b/src/Monocle/Client.hs @@ -50,11 +50,11 @@ lookupTlsVerify = do _ -> Verify -- | Create a HTTP manager -mkManager :: IO Manager -mkManager = mkManager' =<< lookupTlsVerify +mkManager :: Maybe Text -> IO Manager +mkManager proxyEnv = mkManager' proxyEnv =<< lookupTlsVerify -mkManager' :: TlsVerify -> IO Manager -mkManager' verify = do +mkManager' :: Maybe Text -> TlsVerify -> IO Manager +mkManager' proxyEnv verify = do let opensslSettings = case verify of Insecure -> OpenSSL.defaultOpenSSLSettings {OpenSSL.osslSettingsVerifyMode = VerifyNone} Verify -> OpenSSL.defaultOpenSSLSettings @@ -63,7 +63,9 @@ mkManager' verify = do let settings = OpenSSL.opensslManagerSettings (pure ctx) -- setup proxy - let proxy = Network.HTTP.Client.proxyEnvironment Nothing + let proxy = case proxyEnv of + Nothing -> Network.HTTP.Client.proxyEnvironment Nothing + Just proxyEnvName -> Network.HTTP.Client.proxyEnvironmentNamed proxyEnvName Nothing newManager (Network.HTTP.Client.managerSetProxy proxy settings) -- | Create the 'MonocleClient' @@ -81,7 +83,7 @@ withClient url managerM callBack = do tokenM' <- liftIO $ lookupEnv "MONOCLE_ADMIN_TOKEN" let tokenM = from <$> tokenM' - manager <- maybe (liftIO mkManager) pure managerM + manager <- maybe (liftIO (mkManager (Just "API_PROXY"))) pure managerM callBack MonocleClient {..} where baseUrl = T.dropWhileEnd (== '/') url <> "/" diff --git a/src/Monocle/Effects.hs b/src/Monocle/Effects.hs index 7f5f43ffb..07ac408ba 100644 --- a/src/Monocle/Effects.hs +++ b/src/Monocle/Effects.hs @@ -482,7 +482,7 @@ newtype instance StaticRep HttpEffect = HttpEffect HttpEnv -- | 'runHttpEffect' simply add a Manager to the static rep env. runHttpEffect :: IOE :> es => Eff (HttpEffect : es) a -> Eff es a runHttpEffect action = do - manager <- liftIO Monocle.Client.mkManager + manager <- liftIO $ Monocle.Client.mkManager Nothing runHttpEffectWithManager manager action runHttpEffectWithManager :: IOE :> es => HTTP.Manager -> Eff (HttpEffect : es) a -> Eff es a