From 9ccd4b5c969e136a4c5f5e9b7db74b089d10d9e2 Mon Sep 17 00:00:00 2001
From: Tristan Cacqueray <tdecacqu@redhat.com>
Date: Tue, 12 Dec 2023 21:41:06 +0000
Subject: [PATCH] crawler: use a different proxy environment for the api

Fix: #1090
---
 CHANGELOG.md           |  2 +-
 src/Lentille/Gerrit.hs |  2 +-
 src/Monocle/Client.hs  | 14 ++++++++------
 src/Monocle/Effects.hs |  2 +-
 4 files changed, 11 insertions(+), 9 deletions(-)

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