Source file `github_v4_api.ml`

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
open Bos_setup

let is_handled errors (affix, _) =
  List.exists
    (fun error ->
      match Json.string_field ~field:"message" error with
      | Ok x -> String.is_prefix ~affix x
      | Error _ -> false)
    errors

let pp_errors fs errors =
  List.iter
    (fun error ->
      match Json.string_field ~field:"message" error with
      | Ok message -> Fmt.string fs message
      | Error _ -> ())
    errors

let handle_errors json ~try_ ~on_ok ~default_msg ~handled_errors =
  match try_ json with
  | Ok x -> Ok (on_ok x)
  | Error _ -> (
      let errors =
        match Json.list_field ~field:"errors" json with
        | Ok errors -> errors
        | Error _ -> []
      in
      match List.find_opt (is_handled errors) handled_errors with
      | Some (_, ret) -> Ok ret
      | None ->
          R.error_msgf "@[<v 2>Github API error:@ %s@;Github API returned: %a@]"
            default_msg pp_errors errors)

let with_auth ~token Curl.{ url; meth; args } =
  Curl.
    {
      url;
      meth;
      args = Curl_option.Header (strf "Authorization: bearer %s" token) :: args;
    }

let client = "dune-release"

let url = "https://api.github.com/graphql"

module Pull_request = struct
  module Request = struct
    let node_id ~user ~repo ~id =
      let json =
        strf
          {|{ "query": "query { repository(owner:\"%s\", name:\"%s\") { pullRequest(number:%i) { id } } }" }|}
          user repo id
      in
      let args = Curl_option.[ Data (`Data json) ] in
      Curl.{ url; meth = `POST; args }

    let ready_for_review ~node_id =
      let json =
        strf
          {|{ "query": "mutation { markPullRequestReadyForReview (input : {clientMutationId:\"%s\",pullRequestId:\"%s\"}) { pullRequest { url } } }" }|}
          client node_id
      in
      let args = Curl_option.[ Data (`Data json) ] in
      Curl.{ url; meth = `POST; args }
  end

  module Response = struct
    let node_id json =
      let default_msg = "Could not retrieve node_id from pull request" in
      let try_ json =
        match
          Yojson.Basic.Util.member "data" json
          |> Yojson.Basic.Util.member "repository"
          |> Yojson.Basic.Util.member "pullRequest"
          |> Json.string_field ~field:"id"
        with
        | exception _ -> R.error_msg default_msg
        | Ok node_id -> Ok node_id
        | Error _ -> R.error_msg default_msg
      in
      handle_errors json ~try_
        ~on_ok:(fun x -> x)
        ~default_msg ~handled_errors:[]

    let url json =
      let default_msg = "Could not retrieve url from pull request" in
      let try_ json =
        match
          Yojson.Basic.Util.member "data" json
          |> Yojson.Basic.Util.member "markPullRequestReadyForReview"
          |> Yojson.Basic.Util.member "pullRequest"
          |> Json.string_field ~field:"url"
        with
        | exception _ -> R.error_msg default_msg
        | Ok node_id -> Ok node_id
        | Error _ -> R.error_msg default_msg
      in
      handle_errors json ~try_
        ~on_ok:(fun x -> x)
        ~default_msg ~handled_errors:[]
  end
end