Use curly instead of cohttp-lwt-unix (#12)

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
 

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: *)

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))))

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}

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

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. *)

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))

lib/graphql.ml

@@ -1,37 +1,45 @@
-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)
       ::
       (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 "@[<v2>GitHub returned errors: %s@]" e))
       | _errors ->
           Error
             (`Msg
               (Format.asprintf "@[<v2>GitHub returned errors: %a@]"
                  (Yojson.Safe.pretty_print ~std:true)
                  json)))
-  | err ->
+  | Error e ->
       Error
         (`Msg
           (Format.asprintf
-             "@[<v2>Error performing GraphQL query on GitHub: %s@,%s@]"
-             (Cohttp.Code.string_of_status err)
-             body))
+             "@[<v2>Error performing GraphQL query on GitHub: %a@]"
+             Curly.Error.pp e))

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