Fix issue with headers

bot-components/Utils.ml

@@ -81,7 +81,13 @@ let api_json_header = [("Accept", "application/vnd.github+json")]
 let github_header bot_info =
   [("Authorization", "bearer " ^ github_token bot_info)]
 
-let rec client_get ?(follow_redirects = true) ~headers uri =
+let headers_of_list = headers
+
+(* when following a redirect from GitHub to Azure, passing along the
+   Authorization header results in 403 Forbidden.  So we strip the
+   headers when we recurse by default. *)
+let rec client_get ?(follow_redirects = true)
+    ?(include_headers_in_redirects = false) ~user_agent ~headers uri =
   Client.get ~headers uri
   >>= fun (resp, body) ->
   match Response.status resp with
@@ -93,15 +99,22 @@ let rec client_get ?(follow_redirects = true) ~headers uri =
   | `Temporary_redirect
   | `Permanent_redirect
     when follow_redirects -> (
-    match Header.get_location (Response.headers resp) with
-    | Some new_uri ->
-        client_get ~follow_redirects ~headers new_uri
-    | None ->
-        let msg =
-          f "Redirected from %s, but no Location header found"
-            (Uri.to_string uri)
-        in
-        Lwt.return_error msg )
+      let headers =
+        if include_headers_in_redirects then headers
+        else headers_of_list [] user_agent
+      in
+      match Header.get_location (Response.headers resp) with
+      | Some new_uri ->
+          Lwt_io.printlf "Following redirect to %s" (Uri.to_string new_uri)
+          >>= fun () ->
+          client_get ~follow_redirects ~include_headers_in_redirects ~headers
+            ~user_agent new_uri
+      | None ->
+          let msg =
+            f "Redirected from %s, but no Location header found"
+              (Uri.to_string uri)
+          in
+          Lwt.return_error msg )
   | status_code ->
       let msg =
         f "HTTP request to %s failed with status code: %s" (Uri.to_string uri)
@@ -112,10 +125,9 @@ let rec client_get ?(follow_redirects = true) ~headers uri =
 let generic_get ~bot_info relative_uri ?(header_list = []) handler =
   let open Lwt_result.Infix in
   let uri = "https://api.github.com/" ^ relative_uri |> Uri.of_string in
-  let headers =
-    headers (header_list @ github_header bot_info) bot_info.github_name
-  in
-  client_get ~headers uri
+  let user_agent = bot_info.github_name in
+  let headers = headers (header_list @ github_header bot_info) user_agent in
+  client_get ~headers ~user_agent uri
   >>= (fun body -> Cohttp_lwt.Body.to_string body |> Lwt_result.ok)
   >>= handler