Use curly instead of cohttp-lwt-unix

dune-project

@@ -17,8 +17,8 @@
  (synopsis "Collect activity as markdown")
  (depends
   (alcotest :with-test)
-  cohttp
-  cohttp-lwt
-  cohttp-lwt-unix
+  astring
+  curly
+  fmt
   yojson
   (ocaml (>= 4.08))))

get-activity-lib.opam

@@ -8,9 +8,9 @@ bug-reports: "https://github.com/tarides/get-activity/issues"
 depends: [
   "dune" {>= "2.8"}
   "alcotest" {with-test}
-  "cohttp"
-  "cohttp-lwt"
-  "cohttp-lwt-unix"
+  "astring"
+  "curly"
+  "fmt"
   "yojson"
   "ocaml" {>= "4.08"}
   "odoc" {with-doc}

lib/contributions.ml

@@ -56,9 +56,8 @@ 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 variables = [ ("from", `String start); ("to", `String finish) ] in
+  Graphql.exec ~token ~variables ~query ()
 
 module Datetime = struct
   type t = string

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,37 @@
-open Lwt.Infix
-
-let graphql_endpoint = Uri.of_string "https://api.github.com/graphql"
+let url = "https://api.github.com/graphql"
 let ( / ) a b = Yojson.Safe.Util.member b a
 
-let exec ?variables ~token ~query () =
+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
+    |> Yojson.Safe.to_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 headers = [ ("Authorization", "bearer " ^ token) ] in
+  Curly.Request.make ~headers ~body ~url ~meth:`POST ()
+
+let exec ?variables ~token ~query () =
+  let request = request ?variables ~token ~query () 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

@@ -3,4 +3,4 @@ val exec :
   token:string ->
   query:string ->
   unit ->
-  (Yojson.Safe.t, [ `Msg of string ]) result Lwt.t
+  (Yojson.Safe.t, [ `Msg of string ]) result

test/lib/alcotest_ext.ml

@@ -16,26 +16,6 @@ let msg = Msg.testable
 let string_msg = msg string
 let or_msg x = result x string_msg
 
-module Lwt = struct
-  type 'a t = 'a Lwt.t
-
-  let pp f fs (x : 'a t) =
-    let x = Lwt_main.run x in
-    Format.fprintf fs "%a" f x
-
-  let eq f (x : 'a t) (y : 'a t) =
-    let x = Lwt_main.run x in
-    let y = Lwt_main.run y in
-    f x y
-
-  let testable (t : 'a testable) : 'a t testable =
-    let pp = pp (Alcotest.pp t) in
-    let eq = eq (Alcotest.equal t) in
-    testable pp eq
-end
-
-let lwt = Lwt.testable
-
 module Yojson = struct
   type t = Yojson.Safe.t
 

test/lib/alcotest_ext.mli

@@ -4,5 +4,4 @@ val string_msg : [ `Msg of string ] Alcotest.testable
 val or_msg :
   'a Alcotest.testable -> ('a, [ `Msg of string ]) result Alcotest.testable
 
-val lwt : 'a Alcotest.testable -> 'a Lwt.t Alcotest.testable
 val yojson : Yojson.Safe.t Alcotest.testable

test/lib/test_contributions.ml

@@ -87,11 +87,7 @@ let test_fetch =
   in
   [
     make_test "no token" ~token:"" ~period:("", "")
-      ~expected:
-        (Error
-           (`Msg
-             {|Error performing GraphQL query on GitHub: 401 Unauthorized
-  {"message":"Bad credentials","documentation_url":"https://docs.github.com/graphql"}|}));
+      ~expected:(Error (`Msg "GitHub returned errors: Bad credentials"));
   ]
 
 let activity_example =

test/lib/test_graphql.ml

@@ -5,18 +5,13 @@ let test_exec =
     let name = Printf.sprintf "exec: %s" name in
     let test_fun () =
       let actual = Graphql.exec ?variables ~token ~query () in
-      Alcotest.(check Alcotest_ext.(lwt @@ or_msg yojson)) name expected actual
+      Alcotest.(check Alcotest_ext.(or_msg yojson)) name expected actual
     in
     (name, `Quick, test_fun)
   in
   [
     make_test "no token" ~token:"" ~query:""
-      ~expected:
-        (Lwt.return
-           (Error
-              (`Msg
-                {|Error performing GraphQL query on GitHub: 401 Unauthorized
-  {"message":"Bad credentials","documentation_url":"https://docs.github.com/graphql"}|})))
+      ~expected:(Error (`Msg "GitHub returned errors: Bad credentials"))
       ();
   ]