Always extract the installation id and use it when we know it's available.

Author: Zimmi48

bot-components/GitHub_subscriptions.ml

@@ -227,24 +227,30 @@ let github_event ~event json =
       Ok (UnsupportedEvent "Unsupported GitHub event.")
 
 let receive_github ~secret headers body =
-  let open Result in
-  ( match Header.get headers "X-Hub-Signature" with
-  | Some signature ->
-      let expected =
-        Mirage_crypto.Hash.SHA1.hmac ~key:(Cstruct.of_string secret)
-          (Cstruct.of_string body)
-        |> Hex.of_cstruct |> Hex.show |> f "sha1=%s"
-      in
-      if Eqaf.equal signature expected then return true
-      else Error "Webhook signed but with wrong signature."
-  | None ->
-      return false )
-  >>= fun signed ->
+  let open Result.Monad_infix in
   match Header.get headers "X-GitHub-Event" with
   | Some event -> (
     try
       let json = Yojson.Basic.from_string body in
-      github_event ~event json |> Result.map ~f:(fun r -> (signed, r))
+      ( try
+          let install_id =
+            json |> member "installation" |> member "id" |> to_int
+          in
+          (* if there is an install id, the webhook should be signed *)
+          match Header.get headers "X-Hub-Signature" with
+          | Some signature ->
+              let expected =
+                Mirage_crypto.Hash.SHA1.hmac ~key:(Cstruct.of_string secret)
+                  (Cstruct.of_string body)
+                |> Hex.of_cstruct |> Hex.show |> f "sha1=%s"
+              in
+              if Eqaf.equal signature expected then Ok (Some install_id)
+              else Error "Webhook signed but with wrong signature."
+          | None ->
+              Error "Webhook comes from a GitHub App, but it is not signed."
+        with Yojson.Json_error _ | Type_error _ -> Ok None )
+      >>= fun install_id ->
+      github_event ~event json |> Result.map ~f:(fun r -> (install_id, r))
     with
     | Yojson.Json_error err ->
         Error (f "Json error: %s" err)

bot-components/GitHub_subscriptions.mli

@@ -17,4 +17,7 @@ type msg =
   | UnsupportedEvent of string
 
 val receive_github :
-  secret:string -> Cohttp.Header.t -> string -> (bool * msg, string) result
+     secret:string
+  -> Cohttp.Header.t
+  -> string
+  -> (int option * msg, string) result

src/bot.ml

@@ -199,15 +199,17 @@ let callback _conn req body =
           (Request.headers req) body
       with
       | Ok
-          ( true
+          ( Some install_id
           , PushEvent
               {owner= "coq"; repo= "coq"; base_ref; head_sha; commits_msg} ) ->
           (fun () ->
             init_git_bare_repository ~bot_info
             >>= fun () ->
-            action_as_github_app ~bot_info ~key ~app_id ~owner:"coq"
+            action_as_github_app_from_install_id ~bot_info ~key ~app_id
+              ~install_id
               (coq_push_action ~base_ref ~commits_msg)
-            <&> action_as_github_app ~bot_info ~key ~app_id ~owner:"coq"
+            <&> action_as_github_app_from_install_id ~bot_info ~key ~app_id
+                  ~install_id
                   (mirror_action ~gitlab_domain:"gitlab.inria.fr" ~owner:"coq"
                      ~repo:"coq" ~base_ref ~head_sha () ) )
           |> Lwt.async ;
@@ -216,13 +218,15 @@ let callback _conn req body =
               "Processing push event on Coq repository: analyzing merge / \
                backporting info."
             ()
-      | Ok (true, PushEvent {owner; repo; base_ref; head_sha; _}) -> (
+      | Ok (Some install_id, PushEvent {owner; repo; base_ref; head_sha; _})
+        -> (
         match (owner, repo) with
         | "coq-community", ("docker-base" | "docker-coq") ->
             (fun () ->
               init_git_bare_repository ~bot_info
               >>= fun () ->
-              action_as_github_app ~bot_info ~key ~app_id ~owner
+              action_as_github_app_from_install_id ~bot_info ~key ~app_id
+                ~install_id
                 (mirror_action ~gitlab_domain:"gitlab.com" ~owner ~repo
                    ~base_ref ~head_sha () ) )
             |> Lwt.async ;
@@ -237,7 +241,8 @@ let callback _conn req body =
             (fun () ->
               init_git_bare_repository ~bot_info
               >>= fun () ->
-              action_as_github_app ~bot_info ~key ~app_id ~owner
+              action_as_github_app_from_install_id ~bot_info ~key ~app_id
+                ~install_id
                 (mirror_action ~gitlab_domain:"gitlab.inria.fr" ~owner ~repo
                    ~base_ref ~head_sha () ) )
             |> Lwt.async ;
@@ -333,7 +338,7 @@ let callback _conn req body =
               Server.respond_string ~status:`OK
                 ~body:(f "Unhandled new issue: %s" body)
                 () )
-      | Ok (signed, CommentCreated comment_info) -> (
+      | Ok (install_id, CommentCreated comment_info) -> (
           let body =
             comment_info.body |> trim_comments
             |> strip_quoted_bot_name ~github_bot_name
@@ -394,7 +399,7 @@ let callback _conn req body =
                     && comment_info.issue.pull_request
                     && String.equal comment_info.issue.issue.owner "coq"
                     && String.equal comment_info.issue.issue.repo "coq"
-                    && signed
+                    && Option.is_some install_id
                   then
                     let full_ci =
                       match Str.matched_group 1 body with
@@ -421,7 +426,7 @@ let callback _conn req body =
                     && comment_info.issue.pull_request
                     && String.equal comment_info.issue.issue.owner "coq"
                     && String.equal comment_info.issue.issue.repo "coq"
-                    && signed
+                    && Option.is_some install_id
                   then (
                     (fun () ->
                       action_as_github_app ~bot_info ~key ~app_id
@@ -439,7 +444,7 @@ let callback _conn req body =
                     && comment_info.issue.pull_request
                     && String.equal comment_info.issue.issue.owner "coq"
                     && String.equal comment_info.issue.issue.repo "coq"
-                    && signed
+                    && Option.is_some install_id
                   then (
                     (fun () ->
                       action_as_github_app ~bot_info ~key ~app_id
@@ -458,7 +463,7 @@ let callback _conn req body =
                     && comment_info.issue.pull_request
                     && String.equal comment_info.issue.issue.owner "coq"
                     && String.equal comment_info.issue.issue.repo "coq"
-                    && signed
+                    && Option.is_some install_id
                   then (
                     (fun () ->
                       action_as_github_app ~bot_info ~key ~app_id
@@ -472,11 +477,11 @@ let callback _conn req body =
                     Server.respond_string ~status:`OK
                       ~body:(f "Unhandled comment: %s" body)
                       () ) ) )
-      | Ok (signed, CheckRunReRequested {external_id}) -> (
-          if not signed then
-            Server.respond_string ~status:(Code.status_of_code 401)
-              ~body:"Request to rerun check run must be signed." ()
-          else if String.is_empty external_id then
+      | Ok (None, CheckRunReRequested _) ->
+          Server.respond_string ~status:(Code.status_of_code 401)
+            ~body:"Request to rerun check run must be signed." ()
+      | Ok (Some _, CheckRunReRequested {external_id}) -> (
+          if String.is_empty external_id then
             Server.respond_string ~status:(Code.status_of_code 400)
               ~body:"Request to rerun check run but empty external ID." ()
           else