Skip to content

Commit

Permalink
api_remote: normalize github url scheme based on secrets
Browse files Browse the repository at this point in the history
  • Loading branch information
Khady committed Aug 8, 2024
1 parent e40a483 commit 3c18db3
Showing 1 changed file with 32 additions and 24 deletions.
56 changes: 32 additions & 24 deletions lib/api_remote.ml
Original file line number Diff line number Diff line change
Expand Up @@ -27,12 +27,36 @@ module Github : Api.Github = struct
let headers = [ "Accept: application/vnd.github.v3+json" ] in
Option.map_default (fun v -> sprintf "Authorization: token %s" v :: headers) headers token

let get_config ~(ctx : Context.t) ~repo =
let secrets = Context.get_secrets_exn ctx in
let url = contents_url ~repo ~path:ctx.config_filename in
let prepare_request ~secrets ~(repo : Github_t.repository) url =
let token = Context.gh_token_of_secrets secrets repo.url in
let headers = build_headers ?token () in
let url =
match Context.gh_repo_of_secrets secrets repo.url with
| None -> url
| Some repo_config ->
(* The url might have been built based on information received through an untrusted source such as a slack message.
Normalizing it using trusted secrets. *)
let repo_config_url_scheme = repo_config.url |> Uri.of_string |> Uri.scheme in
url |> Uri.of_string |> flip Uri.with_scheme repo_config_url_scheme |> Uri.to_string
in
headers, url

This comment has been minimized.

Copy link
@Khady

Khady Aug 8, 2024

Author Contributor

I'm not a complete fan of this solution, because it becomes complicated to query an arbitrary github url without some magic happening. But I couldn't find a way to consistently apply the normalization elsewhere.

It could have been maybe there

monorobot/lib/github.ml

Lines 173 to 235 in e40a483

(** [gh_link_of_string s] parses a URL string [s] to try to match a supported
GitHub link type, generating repository endpoints if necessary *)
let gh_link_of_string url_str =
let url = Uri.of_string url_str in
let path = Uri.path url in
let gh_com_html_base owner name = sprintf "https://github.com/%s/%s" owner name in
let gh_com_api_base owner name = sprintf "https://api.github.com/repos/%s/%s" owner name in
let custom_html_base ?(scheme = "https") base owner name = sprintf "%s://%s/%s/%s" scheme base owner name in
let custom_api_base ?(scheme = "https") base owner name =
sprintf "%s://%s/api/v3/repos/%s/%s" scheme base owner name
in
match Uri.host url with
| None -> None
| Some host ->
match String.starts_with path ~prefix:"/" with
| false -> None
| true ->
let path =
Stre.drop_prefix path "/" |> flip Stre.drop_suffix "/" |> flip Stre.nsplitc '/' |> List.map Web.urldecode
in
let make_repo ~prefix ~owner ~name =
let base = String.concat "/" (List.rev prefix) in
let scheme = Uri.scheme url in
let html_base, api_base =
if String.ends_with base ~suffix:"github.com" then gh_com_html_base owner name, gh_com_api_base owner name
else custom_html_base ?scheme base owner name, custom_api_base ?scheme base owner name
in
{
name;
full_name = sprintf "%s/%s" owner name;
url = html_base;
commits_url = sprintf "%s/commits{/sha}" api_base;
contents_url = sprintf "%s/contents/{+path}" api_base;
pulls_url = sprintf "%s/pulls{/number}" api_base;
issues_url = sprintf "%s/issues{/number}" api_base;
compare_url = sprintf "%s/compare{/basehead}" api_base;
}
in
let rec extract_link_type ~prefix path =
try
match path with
| [ owner; name; "pull"; n ] ->
let repo = make_repo ~prefix ~owner ~name in
Some (repo, Pull_request (int_of_string n))
| [ owner; name; "issues"; n ] ->
let repo = make_repo ~prefix ~owner ~name in
Some (repo, Issue (int_of_string n))
| [ owner; name; "commit"; commit_hash ] | [ owner; name; "pull"; _; "commits"; commit_hash ] ->
let repo = make_repo ~prefix ~owner ~name in
if Re2.matches commit_sha_re commit_hash then Some (repo, Commit commit_hash) else None
| owner :: name :: "compare" :: base_head | owner :: name :: "pull" :: _ :: "files" :: base_head ->
let base_head = String.concat "/" base_head in
let repo = make_repo ~prefix ~owner ~name in
begin
match Re2.find_submatches_exn compare_basehead_re base_head with
| [| _; Some base; _; Some merge |] -> Some (repo, Compare (base, merge))
| _ | (exception Re2.Exceptions.Regex_match_failed _) -> None
end
| [] -> None
| next :: path -> extract_link_type ~prefix:(next :: prefix) path
with _exn -> (* no hard fail when invalid format, slack user can compose any url string *) None
in
extract_link_type ~prefix:[ host ] path

Though for now it has nothing to do with the secrets and the context, which felt like a nice property to preserve. And nothing guarantees that the Github_t.repository will always be built only by this function.

This comment has been minimized.

Copy link
@thatportugueseguy

thatportugueseguy Aug 8, 2024

Collaborator

why not just enforce https? is there a legit reason not to? Do we want to support custom schemes?

This comment has been minimized.

Copy link
@Khady

Khady Aug 8, 2024

Author Contributor

I suppose that technically one could deploy GHE without https. Or that we could have a non https proxy between monorobot and GHE. Is it a real use case? I don't know

This comment has been minimized.

Copy link
@thatportugueseguy

thatportugueseguy Aug 8, 2024

Collaborator

yes, that was what i was thinking. We probably don't have real use cases for this atm and could do with just enforcing https if we don't feel comfortable with this solution.

In any case, this is already implemented, so i'd say it's better than not having it. I would probably extract this logic into a function with a descriptive name, so that it would look cleaner


let get_resource ~secrets ~repo url =
let headers, url = prepare_request ~secrets ~repo url in
match%lwt http_request ~headers `GET url with
| Ok res -> Lwt.return @@ Ok res
| Error e -> Lwt.return @@ fmt_error "error while querying remote: %s\nfailed to get resource from %s" e url

let post_resource ~secrets ~repo body url =
let headers, url = prepare_request ~secrets ~repo url in
match%lwt http_request ~headers ~body:(`Raw ("application/json; charset=utf-8", body)) `POST url with
| Ok res -> Lwt.return @@ Ok res
| Error e -> Lwt.return @@ fmt_error "POST to %s failed : %s" url e

let get_config ~(ctx : Context.t) ~repo =
let secrets = Context.get_secrets_exn ctx in
let url = contents_url ~repo ~path:ctx.config_filename in
match%lwt get_resource ~secrets ~repo url with
| Error e -> Lwt.return @@ fmt_error "error while querying remote: %s\nfailed to get config from file %s" e url
| Ok res ->
let response = Github_j.content_api_response_of_string res in
Expand All @@ -53,43 +77,27 @@ module Github : Api.Github = struct
Lwt.return
@@ fmt_error "unexpected encoding '%s' in Github response\nfailed to get config from file %s" encoding url)

let get_resource ~secrets ~repo_url url =
let token = Context.gh_token_of_secrets secrets repo_url in
let headers = build_headers ?token () in
match%lwt http_request ~headers `GET url with
| Ok res -> Lwt.return @@ Ok res
| Error e -> Lwt.return @@ fmt_error "error while querying remote: %s\nfailed to get resource from %s" e url

let post_resource ~secrets ~repo_url body url =
let token = Context.gh_token_of_secrets secrets repo_url in
let headers = build_headers ?token () in
match%lwt http_request ~headers ~body:(`Raw ("application/json; charset=utf-8", body)) `POST url with
| Ok res -> Lwt.return @@ Ok res
| Error e -> Lwt.return @@ fmt_error "POST to %s failed : %s" url e

let get_api_commit ~(ctx : Context.t) ~(repo : Github_t.repository) ~sha =
let%lwt res = commits_url ~repo ~sha |> get_resource ~secrets:(Context.get_secrets_exn ctx) ~repo_url:repo.url in
let%lwt res = commits_url ~repo ~sha |> get_resource ~secrets:(Context.get_secrets_exn ctx) ~repo in
Lwt.return @@ Result.map Github_j.api_commit_of_string res

let get_pull_request ~(ctx : Context.t) ~(repo : Github_t.repository) ~number =
let%lwt res = pulls_url ~repo ~number |> get_resource ~secrets:(Context.get_secrets_exn ctx) ~repo_url:repo.url in
let%lwt res = pulls_url ~repo ~number |> get_resource ~secrets:(Context.get_secrets_exn ctx) ~repo in
Lwt.return @@ Result.map Github_j.pull_request_of_string res

let get_issue ~(ctx : Context.t) ~(repo : Github_t.repository) ~number =
let%lwt res = issues_url ~repo ~number |> get_resource ~secrets:(Context.get_secrets_exn ctx) ~repo_url:repo.url in
let%lwt res = issues_url ~repo ~number |> get_resource ~secrets:(Context.get_secrets_exn ctx) ~repo in
Lwt.return @@ Result.map Github_j.issue_of_string res

let get_compare ~(ctx : Context.t) ~(repo : Github_t.repository) ~basehead =
let%lwt res =
compare_url ~repo ~basehead |> get_resource ~secrets:(Context.get_secrets_exn ctx) ~repo_url:repo.url
in
let%lwt res = compare_url ~repo ~basehead |> get_resource ~secrets:(Context.get_secrets_exn ctx) ~repo in
Lwt.return @@ Result.map Github_j.compare_of_string res

let request_reviewers ~(ctx : Context.t) ~(repo : Github_t.repository) ~number ~reviewers =
let body = Github_j.string_of_request_reviewers_req reviewers in
let%lwt res =
pulls_url ~repo ~number ^ "/requested_reviewers"
|> post_resource ~secrets:(Context.get_secrets_exn ctx) ~repo_url:repo.url body
|> post_resource ~secrets:(Context.get_secrets_exn ctx) ~repo body
in
Lwt.return @@ Result.map ignore res
end
Expand Down

0 comments on commit 3c18db3

Please sign in to comment.