Skip to content

Commit

Permalink
Simplify process to generate a new install key and store install ids.
Browse files Browse the repository at this point in the history
  • Loading branch information
Zimmi48 committed Jul 5, 2024
1 parent fb39e7c commit ad0c361
Show file tree
Hide file tree
Showing 6 changed files with 98 additions and 83 deletions.
53 changes: 20 additions & 33 deletions bot-components/GitHub_app.ml
Original file line number Diff line number Diff line change
Expand Up @@ -56,40 +56,26 @@ let post ~bot_info ~body ~token ~url =
in
Cohttp_lwt.Body.to_string body

let get_installation_token ~bot_info ~owner ~repo ~jwt :
let get_installation_token ~bot_info ~key ~app_id ~install_id :
(string * float, string) Result.t Lwt.t =
get ~bot_info ~token:jwt
~url:(f "https://api.github.com/repos/%s/%s/installation" owner repo)
>>= (fun body ->
try
let json = Yojson.Basic.from_string body in
let access_token_url =
Yojson.Basic.Util.(json |> member "access_tokens_url" |> to_string)
in
post ~bot_info ~body:None ~token:jwt ~url:access_token_url
>|= Result.return
with
| Yojson.Json_error err ->
Lwt.return_error (f "Json error: %s" err)
| Yojson.Basic.Util.Type_error (err, _) ->
Lwt.return_error (f "Json type error: %s" err) )
>|= Result.bind ~f:(fun resp ->
try
let json = Yojson.Basic.from_string resp in
Ok
(* Installation tokens expire after one hour, let's stop using them after 40 minutes *)
( Yojson.Basic.Util.(json |> member "token" |> to_string)
, Unix.time () +. (40. *. 60.) )
with
| Yojson.Json_error err ->
Error (f "Json error: %s" err)
| Yojson.Basic.Util.Type_error (err, _) ->
Error (f "Json type error: %s" err) )

let get_installation_token ~bot_info ~key ~app_id ~owner ~repo =
match make_jwt ~key ~app_id with
| Ok jwt ->
get_installation_token ~bot_info ~jwt ~owner ~repo
| Ok jwt -> (
let access_token_url =
f "https://api.github.com/app/installations/%d/access_tokens" install_id
in
post ~bot_info ~body:None ~token:jwt ~url:access_token_url
>|= fun resp ->
try
let json = Yojson.Basic.from_string resp in
Ok
(* Installation tokens expire after one hour, let's stop using them after 40 minutes *)
( Yojson.Basic.Util.(json |> member "token" |> to_string)
, Unix.time () +. (40. *. 60.) )
with
| Yojson.Json_error err ->
Error (f "Json error: %s" err)
| Yojson.Basic.Util.Type_error (err, _) ->
Error (f "Json type error: %s" err) )
| Error e ->
Lwt.return (Error e)

Expand All @@ -104,7 +90,8 @@ let get_installations ~bot_info ~key ~app_id =
Ok
( json |> to_list
|> List.map ~f:(fun json ->
json |> member "account" |> member "login" |> to_string ) )
( json |> member "account" |> member "login" |> to_string
, json |> member "id" |> to_int ) ) )
with
| Yojson.Json_error err ->
Error (f "Json error: %s" err)
Expand Down
5 changes: 2 additions & 3 deletions bot-components/GitHub_app.mli
Original file line number Diff line number Diff line change
Expand Up @@ -2,12 +2,11 @@ val get_installation_token :
bot_info:Bot_info.t
-> key:Mirage_crypto_pk.Rsa.priv
-> app_id:int
-> owner:string
-> repo:string
-> install_id:int
-> (string * float, string) result Lwt.t

val get_installations :
bot_info:Bot_info.t
-> key:Mirage_crypto_pk.Rsa.priv
-> app_id:int
-> (string list, string) result Lwt.t
-> ((string * int) list, string) result Lwt.t
8 changes: 4 additions & 4 deletions src/actions.ml
Original file line number Diff line number Diff line change
Expand Up @@ -1963,11 +1963,11 @@ let coq_bug_minimizer_results_action ~bot_info ~ci ~key ~app_id body =
let stamp = Str.matched_group 1 body in
let message = Str.matched_group 2 body in
match Str.split (Str.regexp " ") stamp with
| [id; author; repo_name; branch_name; owner; repo; _ (*pr_number*)]
| [id; author; repo_name; branch_name; owner; repo] ->
| [id; author; repo_name; branch_name; owner; _repo; _ (*pr_number*)]
| [id; author; repo_name; branch_name; owner; _repo] ->
(fun () ->
Github_installations.action_as_github_app ~bot_info ~key ~app_id
~owner ~repo
~owner
(GitHub_mutations.post_comment ~id:(GitHub_ID.of_string id)
~message:(if ci then message else f "@%s, %s" author message) )
>>= GitHub_mutations.report_on_posting_comment
Expand Down Expand Up @@ -2015,7 +2015,7 @@ let coq_bug_minimizer_resume_ci_minimization_action ~bot_info ~key ~app_id body
init_git_bare_repository ~bot_info
>>= fun () ->
Github_installations.action_as_github_app ~bot_info ~key ~app_id
~owner ~repo
~owner
(run_ci_minimization
~comment_thread_id:(GitHub_ID.of_string comment_thread_id)
~owner ~repo ~base ~pr_number ~head
Expand Down
33 changes: 12 additions & 21 deletions src/bot.ml
Original file line number Diff line number Diff line change
Expand Up @@ -162,9 +162,9 @@ let callback _conn req body =
| Error error_msg ->
(fun () -> Lwt_io.printl error_msg) |> Lwt.async ;
Server.respond_string ~status:`Bad_request ~body:error_msg ()
| Ok (owner, repo) ->
| Ok (owner, _) ->
(fun () ->
action_as_github_app ~bot_info ~key ~app_id ~owner ~repo
action_as_github_app ~bot_info ~key ~app_id ~owner
(job_action ~gitlab_mapping job_info) )
|> Lwt.async ;
Server.respond_string ~status:`OK ~body:"Job event." () )
Expand All @@ -174,9 +174,9 @@ let callback _conn req body =
| Error error_msg ->
(fun () -> Lwt_io.printl error_msg) |> Lwt.async ;
Server.respond_string ~status:`Bad_request ~body:error_msg ()
| Ok (owner, repo) ->
| Ok (owner, _) ->
(fun () ->
action_as_github_app ~bot_info ~key ~app_id ~owner ~repo
action_as_github_app ~bot_info ~key ~app_id ~owner
(pipeline_action ~gitlab_mapping pipeline_info) )
|> Lwt.async ;
Server.respond_string ~status:`OK ~body:"Pipeline event." () )
Expand Down Expand Up @@ -205,10 +205,9 @@ let callback _conn req body =
(fun () ->
init_git_bare_repository ~bot_info
>>= fun () ->
action_as_github_app ~bot_info ~key ~app_id ~owner:"coq" ~repo:"coq"
action_as_github_app ~bot_info ~key ~app_id ~owner:"coq"
(coq_push_action ~base_ref ~commits_msg)
<&> action_as_github_app ~bot_info ~key ~app_id ~owner:"coq"
~repo:"coq"
(mirror_action ~gitlab_domain:"gitlab.inria.fr" ~owner:"coq"
~repo:"coq" ~base_ref ~head_sha () ) )
|> Lwt.async ;
Expand All @@ -223,7 +222,7 @@ let callback _conn req body =
(fun () ->
init_git_bare_repository ~bot_info
>>= fun () ->
action_as_github_app ~bot_info ~key ~app_id ~owner ~repo
action_as_github_app ~bot_info ~key ~app_id ~owner
(mirror_action ~gitlab_domain:"gitlab.com" ~owner ~repo
~base_ref ~head_sha () ) )
|> Lwt.async ;
Expand All @@ -238,7 +237,7 @@ let callback _conn req body =
(fun () ->
init_git_bare_repository ~bot_info
>>= fun () ->
action_as_github_app ~bot_info ~key ~app_id ~owner ~repo
action_as_github_app ~bot_info ~key ~app_id ~owner
(mirror_action ~gitlab_domain:"gitlab.inria.fr" ~owner ~repo
~base_ref ~head_sha () ) )
|> Lwt.async ;
Expand All @@ -256,7 +255,7 @@ let callback _conn req body =
init_git_bare_repository ~bot_info
>>= fun () ->
action_as_github_app ~bot_info ~key ~app_id
~owner:pr_info.issue.issue.owner ~repo:pr_info.issue.issue.repo
~owner:pr_info.issue.issue.owner
(pull_request_closed_action ~gitlab_mapping ~github_mapping
pr_info ) )
|> Lwt.async ;
Expand All @@ -272,14 +271,13 @@ let callback _conn req body =
init_git_bare_repository ~bot_info
>>= fun () ->
action_as_github_app ~bot_info ~key ~app_id
~owner:pr_info.issue.issue.owner ~repo:pr_info.issue.issue.repo
~owner:pr_info.issue.issue.owner
(pull_request_updated_action ~action ~pr_info ~gitlab_mapping
~github_mapping )
| Ok (_, IssueClosed {issue}) ->
(* TODO: only for projects that requested this feature *)
(fun () ->
action_as_github_app ~bot_info ~key ~app_id ~owner:issue.owner
~repo:issue.repo
(adjust_milestone ~issue ~sleep_time:5.) )
|> Lwt.async ;
Server.respond_string ~status:`OK
Expand Down Expand Up @@ -323,7 +321,7 @@ let callback _conn req body =
init_git_bare_repository ~bot_info
>>= fun () ->
action_as_github_app ~bot_info ~key ~app_id
~owner:issue_info.issue.owner ~repo:issue_info.issue.repo
~owner:issue_info.issue.owner
(run_coq_minimizer ~script ~comment_thread_id:issue_info.id
~comment_author:issue_info.user
~owner:issue_info.issue.owner ~repo:issue_info.issue.repo
Expand All @@ -347,7 +345,6 @@ let callback _conn req body =
>>= fun () ->
action_as_github_app ~bot_info ~key ~app_id
~owner:comment_info.issue.issue.owner
~repo:comment_info.issue.issue.repo
(run_coq_minimizer ~script
~comment_thread_id:comment_info.issue.id
~comment_author:comment_info.author
Expand All @@ -368,7 +365,6 @@ let callback _conn req body =
>>= fun () ->
action_as_github_app ~bot_info ~key ~app_id
~owner:comment_info.issue.issue.owner
~repo:comment_info.issue.issue.repo
(ci_minimize ~comment_info ~requests ~comment_on_error:true
~options ~bug_file_contents:(Some bug_file_contents) ) )
|> Lwt.async ;
Expand All @@ -382,7 +378,6 @@ let callback _conn req body =
>>= fun () ->
action_as_github_app ~bot_info ~key ~app_id
~owner:comment_info.issue.issue.owner
~repo:comment_info.issue.issue.repo
(ci_minimize ~comment_info ~requests
~comment_on_error:true ~options ~bug_file_contents:None )
)
Expand Down Expand Up @@ -416,7 +411,6 @@ let callback _conn req body =
>>= fun () ->
action_as_github_app ~bot_info ~key ~app_id
~owner:comment_info.issue.issue.owner
~repo:comment_info.issue.issue.repo
(run_ci_action ~comment_info ?full_ci ~gitlab_mapping
~github_mapping () )
else if
Expand All @@ -432,7 +426,6 @@ let callback _conn req body =
(fun () ->
action_as_github_app ~bot_info ~key ~app_id
~owner:comment_info.issue.issue.owner
~repo:comment_info.issue.issue.repo
(merge_pull_request_action comment_info) )
|> Lwt.async ;
Server.respond_string ~status:`OK
Expand All @@ -451,7 +444,6 @@ let callback _conn req body =
(fun () ->
action_as_github_app ~bot_info ~key ~app_id
~owner:comment_info.issue.issue.owner
~repo:comment_info.issue.issue.repo
(run_bench
~key_value_pairs:[("coq_native", "yes")]
comment_info ) )
Expand All @@ -471,7 +463,6 @@ let callback _conn req body =
(fun () ->
action_as_github_app ~bot_info ~key ~app_id
~owner:comment_info.issue.issue.owner
~repo:comment_info.issue.issue.repo
(run_bench comment_info) )
|> Lwt.async ;
Server.respond_string ~status:`OK
Expand Down Expand Up @@ -558,11 +549,11 @@ let callback _conn req body =
let warn_after = 30 in
let close_after = 30 in
(fun () ->
action_as_github_app ~bot_info ~key ~app_id ~owner ~repo
action_as_github_app ~bot_info ~key ~app_id ~owner
(coq_check_needs_rebase_pr ~owner ~repo ~warn_after ~close_after
~throttle:6 )
>>= fun () ->
action_as_github_app ~bot_info ~key ~app_id ~owner ~repo
action_as_github_app ~bot_info ~key ~app_id ~owner
(coq_check_stale_pr ~owner ~repo ~after:close_after ~throttle:4)
)
|> Lwt.async ;
Expand Down
69 changes: 49 additions & 20 deletions src/github_installations.ml
Original file line number Diff line number Diff line change
@@ -1,51 +1,80 @@
open Base
open Bot_components
open Helpers
open Lwt

let installation_tokens : (string, string * float) Base.Hashtbl.t =
let installation_ids : (string, int) Base.Hashtbl.t =
Hashtbl.create (module String)

let action_with_new_installation_token ~bot_info ~key ~app_id ~owner ~repo
action =
let installation_tokens : (int, string * float) Base.Hashtbl.t =
Hashtbl.create (module Int)

let action_with_new_installation_token ~bot_info ~key ~app_id ~install_id action
=
(* Installation tokens expire after one hour, we stop using them after 40 minutes *)
GitHub_app.get_installation_token ~bot_info ~key ~app_id ~owner ~repo
GitHub_app.get_installation_token ~bot_info ~key ~app_id ~install_id
>>= function
| Ok (install_token, expiration_date) ->
let _ =
Hashtbl.add installation_tokens ~key:owner
Hashtbl.add installation_tokens ~key:install_id
~data:(install_token, expiration_date)
in
let bot_info : Bot_info.t =
{bot_info with github_install_token= Some install_token}
in
action ~bot_info
| Error _ ->
(* If we cannot retrieve an installation token for the repository
repo owned by owner, we execute the action with the github access token. *)
action ~bot_info
| Error err ->
failwith
(f
"We did not manage to get an installation token for installation \
%d: %s"
install_id err )

let action_as_github_app ~bot_info ~key ~app_id ~owner ~repo action =
let action_as_github_app_from_install_id ~bot_info ~key ~app_id ~install_id
action =
(* Executes an action with an installation token if the repository has
the GitHub app installed.
Generates a new installation token if the existing one has expired. *)
match Hashtbl.find installation_tokens owner with
match Hashtbl.find installation_tokens install_id with
| Some (install_token, expiration_date) ->
if Float.(expiration_date < Unix.time ()) then (
Hashtbl.remove installation_tokens owner ;
action_with_new_installation_token ~bot_info ~key ~app_id ~owner ~repo
Hashtbl.remove installation_tokens install_id ;
action_with_new_installation_token ~bot_info ~key ~app_id ~install_id
action )
else
let bot_info : Bot_info.t =
{bot_info with github_install_token= Some install_token}
in
action ~bot_info
| None ->
action_with_new_installation_token ~bot_info ~key ~app_id ~install_id
action

let action_as_github_app ~bot_info ~key ~app_id ~owner action =
(* Executes an action with an installation token if the repository has
the GitHub app installed.
Generates a new installation token if the existing one has expired. *)
match Hashtbl.find installation_ids owner with
| Some install_id ->
action_as_github_app_from_install_id ~bot_info ~key ~app_id ~install_id
action
| None -> (
GitHub_app.get_installations ~bot_info ~key ~app_id
>>= function
| Ok installs ->
if List.exists installs ~f:(String.equal owner) then
action_with_new_installation_token ~bot_info ~key ~app_id ~owner
~repo action
else action ~bot_info
| Error _ ->
action ~bot_info )
| Ok installs -> (
match
installs
|> List.find_map ~f:(fun (owner', install_id) ->
if String.equal owner owner' then Some install_id else None )
with
| Some install_id ->
let _ = Hashtbl.add installation_ids ~key:owner ~data:install_id in
action_as_github_app_from_install_id ~bot_info ~key ~app_id
~install_id action
| None ->
(* If the owner does not have the GitHub app installed,
we execute the action with the github access token. *)
action ~bot_info )
| Error err ->
failwith
(f "We did not manage to get the list of installations: %s" err) )
13 changes: 11 additions & 2 deletions src/github_installations.mli
Original file line number Diff line number Diff line change
@@ -1,12 +1,21 @@
open Bot_components

val installation_tokens : (string, string * float) Base.Hashtbl.t
val installation_ids : (string, int) Base.Hashtbl.t

val installation_tokens : (int, string * float) Base.Hashtbl.t

val action_as_github_app_from_install_id :
bot_info:Bot_info.t
-> key:Mirage_crypto_pk.Rsa.priv
-> app_id:int
-> install_id:int
-> (bot_info:Bot_info.t -> 'a Lwt.t)
-> 'a Lwt.t

val action_as_github_app :
bot_info:Bot_info.t
-> key:Mirage_crypto_pk.Rsa.priv
-> app_id:int
-> owner:string
-> repo:string
-> (bot_info:Bot_info.t -> 'a Lwt.t)
-> 'a Lwt.t

0 comments on commit ad0c361

Please sign in to comment.