From bc675dfef23a9d2d9f878c966f8e48ab53061cea Mon Sep 17 00:00:00 2001 From: "Guillaume \"Liam\" Petiot" Date: Fri, 8 Mar 2024 15:34:03 +0000 Subject: [PATCH] Use curly instead of cohttp-lwt-unix (#12) --- CHANGES.md | 6 ++++-- bin/main.ml | 6 ++++-- dune-project | 6 +++--- get-activity-lib.opam | 6 +++--- lib/contributions.ml | 9 ++++----- lib/contributions.mli | 5 +---- lib/dune | 2 +- lib/graphql.ml | 40 ++++++++++++++++++++++++---------------- lib/graphql.mli | 13 +++++++++++-- 9 files changed, 55 insertions(+), 38 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 8ac7838..30c3f88 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -3,8 +3,10 @@ ### Changed - Replace exceptions by result types for the requests (#11, @gpetiot) - + `Graphql.exec` now returns `_ result Lwt.t` - + `Contributions.fetch` now returns `_ result` +- Depends on `curly` instead of `cohttp-lwt-unix` (#12, @gpetiot) +- Redesign the graphql requests (#12, @gpetiot) + + `Graphql.exec` now takes a `request` + + `Contributions.fetch` has been replaced by `Contributions.request` that builds a `request` ## 0.2.0 diff --git a/bin/main.ml b/bin/main.ml index 860066a..d352a42 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -76,12 +76,14 @@ let run period : unit = Period.with_period period ~last_fetch_file ~f:(fun period -> (* Fmt.pr "period: %a@." Fmt.(pair string string) period; *) let* token = get_token () in - let* contributions = Contributions.fetch ~period ~token in + let request = Contributions.request ~period ~token in + let* contributions = Graphql.exec request in show ~from:(fst period) contributions) | `Save -> Period.with_period period ~last_fetch_file ~f:(fun period -> let* token = get_token () in - let* contributions = Contributions.fetch ~period ~token in + let request = Contributions.request ~period ~token in + let* contributions = Graphql.exec request in Yojson.Safe.to_file "activity.json" contributions) | `Load -> (* When testing formatting changes, it is quicker to fetch the data once and then load it again for each test: *) diff --git a/dune-project b/dune-project index 327ad69..c04ced4 100644 --- a/dune-project +++ b/dune-project @@ -16,8 +16,8 @@ (name get-activity-lib) (synopsis "Collect activity as markdown") (depends - cohttp - cohttp-lwt - cohttp-lwt-unix + astring + curly + fmt yojson (ocaml (>= 4.08)))) diff --git a/get-activity-lib.opam b/get-activity-lib.opam index 9f576d4..a98a942 100644 --- a/get-activity-lib.opam +++ b/get-activity-lib.opam @@ -7,9 +7,9 @@ homepage: "https://github.com/tarides/get-activity" bug-reports: "https://github.com/tarides/get-activity/issues" depends: [ "dune" {>= "2.8"} - "cohttp" - "cohttp-lwt" - "cohttp-lwt-unix" + "astring" + "curly" + "fmt" "yojson" "ocaml" {>= "4.08"} "odoc" {with-doc} diff --git a/lib/contributions.ml b/lib/contributions.ml index 581b2e6..ac61024 100644 --- a/lib/contributions.ml +++ b/lib/contributions.ml @@ -3,7 +3,7 @@ module Json = Yojson.Safe let ( / ) a b = Json.Util.member b a let query = - {| query($from: DateTime!, $to: DateTime!) { + {|query($from: DateTime!, $to: DateTime!) { viewer { login contributionsCollection(from: $from, to: $to) { @@ -55,10 +55,9 @@ let query = } }|} -let fetch ~period:(start, finish) ~token = - Lwt_main.run - (let variables = [ ("from", `String start); ("to", `String finish) ] in - Graphql.exec ~token ~variables ~query ()) +let request ~period:(start, finish) ~token = + let variables = [ ("from", `String start); ("to", `String finish) ] in + Graphql.request ~token ~variables ~query () module Datetime = struct type t = string diff --git a/lib/contributions.mli b/lib/contributions.mli index 2377546..cf59050 100644 --- a/lib/contributions.mli +++ b/lib/contributions.mli @@ -15,10 +15,7 @@ module Repo_map : Map.S with type key = string type t = { username : string; activity : item list Repo_map.t } -val fetch : - period:string * string -> - token:Token.t -> - (Yojson.Safe.t, [ `Msg of string ]) result +val request : period:string * string -> token:Token.t -> Graphql.request val of_json : from:string -> Yojson.Safe.t -> t (** We pass [from] again here so we can filter out anything that GitHub included by accident. *) diff --git a/lib/dune b/lib/dune index cd7ce68..f2a7f8e 100644 --- a/lib/dune +++ b/lib/dune @@ -1,4 +1,4 @@ (library (name get_activity) (public_name get-activity-lib) - (libraries cohttp cohttp-lwt cohttp-lwt-unix yojson)) + (libraries astring curly fmt yojson)) diff --git a/lib/graphql.ml b/lib/graphql.ml index 4bfed1c..af5a7b8 100644 --- a/lib/graphql.ml +++ b/lib/graphql.ml @@ -1,9 +1,13 @@ -open Lwt.Infix - -let graphql_endpoint = Uri.of_string "https://api.github.com/graphql" let ( / ) a b = Yojson.Safe.Util.member b a -let exec ?variables ~token ~query () = +type request = { + meth : Curly.Meth.t; + url : string; + headers : Curly.Header.t; + body : Yojson.Safe.t; +} + +let request ?variables ~token ~query () = let body = `Assoc (("query", `String query) @@ -11,27 +15,31 @@ let exec ?variables ~token ~query () = (match variables with | None -> [] | Some v -> [ ("variables", `Assoc v) ])) - |> Yojson.Safe.to_string |> Cohttp_lwt.Body.of_string in - let headers = Cohttp.Header.init_with "Authorization" ("bearer " ^ token) in - Cohttp_lwt_unix.Client.post ~headers ~body graphql_endpoint - >>= fun (resp, body) -> - Cohttp_lwt.Body.to_string body >|= fun body -> - match Cohttp.Response.status resp with - | `OK -> ( + let url = "https://api.github.com/graphql" in + let headers = [ ("Authorization", "bearer " ^ token) ] in + { meth = `POST; url; headers; body } + +let exec request = + let { meth; url; headers; body } = request in + let body = Yojson.Safe.to_string body in + let request = Curly.Request.make ~headers ~body ~url ~meth () in + match Curly.run request with + | Ok { Curly.Response.body; _ } -> ( let json = Yojson.Safe.from_string body in - match json / "errors" with + match json / "message" with | `Null -> Ok json + | `String e -> + Error (`Msg (Format.asprintf "@[GitHub returned errors: %s@]" e)) | _errors -> Error (`Msg (Format.asprintf "@[GitHub returned errors: %a@]" (Yojson.Safe.pretty_print ~std:true) json))) - | err -> + | Error e -> Error (`Msg (Format.asprintf - "@[Error performing GraphQL query on GitHub: %s@,%s@]" - (Cohttp.Code.string_of_status err) - body)) + "@[Error performing GraphQL query on GitHub: %a@]" + Curly.Error.pp e)) diff --git a/lib/graphql.mli b/lib/graphql.mli index 57899fb..f0094c8 100644 --- a/lib/graphql.mli +++ b/lib/graphql.mli @@ -1,6 +1,15 @@ -val exec : +type request = { + meth : Curly.Meth.t; + url : string; + headers : Curly.Header.t; + body : Yojson.Safe.t; +} + +val request : ?variables:(string * Yojson.Safe.t) list -> token:string -> query:string -> unit -> - (Yojson.Safe.t, [ `Msg of string ]) result Lwt.t + request + +val exec : request -> (Yojson.Safe.t, [ `Msg of string ]) result