Something went wrong. Try again.
A local Git merge queue with content-bound gate verdicts
Something went wrong. Try again.
3.5 kB · 107 lines
OCaml
at main
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108type t = { clock : float Eio.Time.clock_ty Eio.Resource.t; proc : [ `Generic | `Unix ] Eio.Process.mgr_ty Eio.Resource.t; session : Requests_eio.t Lazy.t option; lookup : string -> string option;}
let v ~sw ~clock ~proc ~net ~lookup = let session = Option.map (fun net -> lazy (let limits = Requests.Response_limits.v ~response_body_size:1_048_576L ~decompressed_size:1_048_576L ~header_size:16384 ~header_count:100 () in Requests_eio.v ~sw ~clock ~proxy_env:lookup ~timeout:(Requests.Timeout.v ~total:30. ()) ~follow_redirects:false ~limits net)) net in { clock; proc; session; lookup }
let token_limit = 4096
let bounded_token input = let output = Buffer.create 128 in let rec read remaining = match Eio.Buf_read.peek_char input with | None -> Buffer.contents output | Some _ when remaining = 0 -> failwith "GitHub token exceeds 4 KiB" | Some _ -> Buffer.add_char output (Eio.Buf_read.any_char input); read (remaining - 1) in read token_limit
let nonempty_token value = if String.length value > token_limit then Error "GitHub token exceeds 4 KiB" else match String.trim value with | "" -> Error "GitHub token is empty" | token -> Ok token
let token t = let configured name = match t.lookup name with | Some value when String.length value > token_limit || String.trim value <> "" -> Some value | _ -> None in match configured "GH_TOKEN" with | Some value -> nonempty_token value | None -> ( match configured "GITHUB_TOKEN" with | Some value -> nonempty_token value | None -> ( match Eio.Time.with_timeout_exn t.clock 4. (fun () -> Eio.Process.parse_out t.proc bounded_token ~stderr:Eio.Flow.null [ "gh"; "auth"; "token" ]) with | value -> nonempty_token value | exception Eio.Time.Timeout -> Error "gh auth token timed out" | exception Eio.Io _ -> Error "gh auth token is unavailable" | exception Failure _ -> Error "gh auth token exceeds its output limit"))
let request session ~owner ~repo token = let session = Lazy.force session in let headers = Requests.Headers.of_list [ ("Accept", "application/vnd.github+json"); ("X-GitHub-Api-Version", "2022-11-28"); ("User-Agent", "mq"); ] in let response = Requests_eio.get session ~headers ~auth:(Requests.Auth.bearer ~token) ~path_params:[ ("owner", owner); ("repo", repo) ] "https://api.github.com/repos/{owner}/{repo}" in Visibility.of_github_response ~status:(Requests.Response.status_code response) (Requests.Response.text response)
let github t ~owner ~repo = match t.session with | None -> Visibility.Unknown "GitHub visibility requires network resources" | Some session -> ( match Eio.Time.with_timeout_exn t.clock 30. (fun () -> match token t with | Error why -> Visibility.Unknown why | Ok token -> request session ~owner ~repo token) with | verdict -> verdict | exception Eio.Time.Timeout -> Visibility.Unknown "GitHub visibility timed out" | exception Eio.Io _ -> Visibility.Unknown "GitHub visibility request failed" | exception Invalid_argument _ -> Visibility.Unknown "GitHub visibility request is invalid")