Skip to content

Commit f20e522

Browse files
gpetiotgpetiot
committed
Use cohttp and eio instead of curly
1 parent 18cf841 commit f20e522

16 files changed

+172
-185
lines changed

‎CHANGES.md

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,9 @@
1+
## unreleased
2+
3+
### Changed
4+
5+
- Use cohttp and eio instead of curly (#<PR_NUMBER>, @gpetiot)
6+
17
## 2.0.1
28

39
### Fixed

‎bin/dune

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -4,9 +4,13 @@
44
(package get-activity)
55
(libraries
66
cmdliner
7+
cohttp-eio
8+
eio_main
9+
tls-eio
710
dune-build-info
811
get-activity-lib
912
logs.cli
1013
logs.fmt
14+
mirage-crypto-rng-eio
1115
fmt.cli
1216
fmt.tty))

‎bin/main.ml

Lines changed: 33 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -97,19 +97,50 @@ let version =
9797

9898
let info = Cmd.info "get-activity" ~version
9999

100+
module Client = struct
101+
let null_auth ?ip:_ ~host:_ _ = Ok None
102+
103+
let https ~authenticator =
104+
let tls_config =
105+
match Tls.Config.client ~authenticator () with
106+
| Error (`Msg msg) -> failwith ("tls configuration problem: " ^ msg)
107+
| Ok tls_config -> tls_config
108+
in
109+
fun uri raw ->
110+
let host =
111+
Uri.host uri
112+
|> Option.map (fun x -> Domain_name.(host_exn (of_string_exn x)))
113+
in
114+
Tls_eio.client_of_flow ?host tls_config raw
115+
116+
let make env =
117+
Cohttp_eio.Client.make
118+
~https:(Some (https ~authenticator:null_auth))
119+
env#net
120+
end
121+
122+
let run_eio f =
123+
Eio_main.run @@ fun env ->
124+
Mirage_crypto_rng_eio.run (module Mirage_crypto_rng.Fortuna) env @@ fun () ->
125+
Eio.Switch.run @@ fun sw ->
126+
let client = Client.make env in
127+
f env sw client
128+
100129
let run () period user : unit =
101130
match mode with
102131
| `Normal ->
132+
run_eio @@ fun _env sw client ->
103133
Period.with_period period ~last_fetch_file ~f:(fun period ->
104134
let* token = get_token () in
105135
let request = Contributions.request ~period ~user ~token in
106-
let* contributions = Graphql.exec request in
136+
let* contributions = Graphql.Request.exec client sw request in
107137
show ~period ~user contributions)
108138
| `Save ->
139+
run_eio @@ fun _env sw client ->
109140
Period.with_period period ~last_fetch_file ~f:(fun period ->
110141
let* token = get_token () in
111142
let request = Contributions.request ~period ~user ~token in
112-
let* contributions = Graphql.exec request in
143+
let* contributions = Graphql.Request.exec client sw request in
113144
Yojson.Safe.to_file "activity.json" contributions)
114145
| `Load ->
115146
(* When testing formatting changes, it is quicker to fetch the data once and then load it again for each test: *)

‎dune-project

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -30,7 +30,7 @@
3030
(alcotest :with-test)
3131
(ppx_expect :with-test)
3232
astring
33-
curly
33+
cohttp-eio
3434
(fmt
3535
(>= 0.8.7))
3636
logs

‎get-activity-lib.opam

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -10,7 +10,7 @@ depends: [
1010
"alcotest" {with-test}
1111
"ppx_expect" {with-test}
1212
"astring"
13-
"curly"
13+
"cohttp-eio"
1414
"fmt" {>= "0.8.7"}
1515
"logs"
1616
"ppx_yojson_conv"

‎lib/contributions.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -73,7 +73,7 @@ let query user =
7373
let request ~period:(start, finish) ~user ~token =
7474
let variables = [ ("from", `String start); ("to", `String finish) ] in
7575
let query = query user in
76-
Graphql.request ~token ~variables ~query ()
76+
Graphql.Request.make ~token ~variables ~query ()
7777

7878
module Datetime = struct
7979
type t = string

‎lib/contributions.mli

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -22,7 +22,7 @@ module Repo_map : Map.S with type key = string
2222
type t = { username : string; activity : item list Repo_map.t }
2323

2424
val request :
25-
period:string * string -> user:User.t -> token:Token.t -> Graphql.request
25+
period:string * string -> user:User.t -> token:Token.t -> Graphql.Request.t
2626

2727
val of_json :
2828
period:string * string ->

‎lib/dune

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
(library
22
(name get_activity)
33
(public_name get-activity-lib)
4-
(libraries astring curly fmt logs yojson)
4+
(libraries astring cohttp-eio fmt logs yojson unix)
55
(preprocess
66
(pps ppx_yojson_conv)))

‎lib/graphql.ml

Lines changed: 53 additions & 43 deletions
Original file line numberDiff line numberDiff line change
@@ -1,47 +1,57 @@
1+
let ( let* ) = Result.bind
12
let ( / ) a b = Yojson.Safe.Util.member b a
23

3-
type request = {
4-
meth : Curly.Meth.t;
5-
url : string;
6-
headers : Curly.Header.t;
7-
body : Yojson.Safe.t;
8-
}
4+
module Request = struct
5+
type t = { request : Cohttp.Request.t; uri : Uri.t; body : Cohttp_eio.Body.t }
96

10-
let request ?variables ~token ~query () =
11-
let body =
12-
`Assoc
13-
(("query", `String query)
14-
::
15-
(match variables with
16-
| None -> []
17-
| Some v -> [ ("variables", `Assoc v) ]))
18-
in
19-
let url = "https://api.github.com/graphql" in
20-
let headers = [ ("Authorization", "bearer " ^ token) ] in
21-
{ meth = `POST; url; headers; body }
7+
let make ?variables ~token ~query () =
8+
let body =
9+
`Assoc
10+
(("query", `String query)
11+
::
12+
(match variables with
13+
| None -> []
14+
| Some v -> [ ("variables", `Assoc v) ]))
15+
|> Yojson.Safe.to_string |> Cohttp_eio.Body.of_string
16+
in
17+
let uri = Uri.of_string "https://api.github.com/graphql" in
18+
let meth = `POST in
19+
let headers = Cohttp.Header.init_with "Authorization" ("bearer " ^ token) in
20+
let request = Cohttp.Request.make ~meth ~headers uri in
21+
{ request; uri; body }
2222

23-
let exec request =
24-
let { meth; url; headers; body } = request in
25-
let body = Yojson.Safe.to_string body in
26-
let request = Curly.Request.make ~headers ~body ~url ~meth () in
27-
Logs.debug (fun m -> m "request: @[%a@]@." Curly.Request.pp request);
28-
match Curly.run request with
29-
| Ok ({ Curly.Response.body; _ } as response) -> (
30-
Logs.debug (fun m -> m "response: @[%a@]@." Curly.Response.pp response);
31-
let json = Yojson.Safe.from_string body in
32-
match json / "message" with
33-
| `Null -> Ok json
34-
| `String e ->
35-
Error (`Msg (Format.asprintf "@[<v2>GitHub returned errors: %s@]" e))
36-
| _errors ->
37-
Error
38-
(`Msg
39-
(Format.asprintf "@[<v2>GitHub returned errors: %a@]"
40-
(Yojson.Safe.pretty_print ~std:true)
41-
json)))
42-
| Error e ->
43-
Error
44-
(`Msg
45-
(Format.asprintf
46-
"@[<v2>Error performing GraphQL query on GitHub: %a@]"
47-
Curly.Error.pp e))
23+
let exec client sw { request; body; uri } =
24+
Logs.debug (fun m -> m "request: @[%a@]@." Cohttp.Request.pp_hum request);
25+
let headers = request.headers in
26+
let resp, body = Cohttp_eio.Client.post ~sw ~body ~headers client uri in
27+
match resp.status with
28+
| `OK -> (
29+
Logs.debug (fun m -> m "response: @[%a@]@." Http.Response.pp resp);
30+
let* body = (Eio.Buf_read.(parse take_all) body) ~max_size:max_int in
31+
let json = Yojson.Safe.from_string body in
32+
match json / "message" with
33+
| `Null -> Ok json
34+
| `String e ->
35+
Error
36+
(`Msg (Format.asprintf "@[<v2>GitHub returned errors: %s@]" e))
37+
| _errors ->
38+
Error
39+
(`Msg
40+
(Format.asprintf "@[<v2>GitHub returned errors: %a@]"
41+
(Yojson.Safe.pretty_print ~std:true)
42+
json)))
43+
| status ->
44+
Error
45+
(`Msg
46+
(Fmt.str
47+
"@[<v2>Error performing GraphQL query on GitHub: Unexpected \
48+
HTTP status %a@]"
49+
Http.Status.pp status))
50+
51+
let pp ppf { request; uri = _; body = _ } =
52+
let pp_request ppf r =
53+
Fmt.pf ppf "@[<v>request =@;<1 2>@[<v2>%a@]@]" Cohttp.Request.pp_hum r
54+
in
55+
let pp_body ppf () = Fmt.pf ppf "@[<v>body =@;<1 2><...>@]" in
56+
Fmt.pf ppf "@[<v2>{@ %a;@ %a@ }@]" pp_request request pp_body ()
57+
end

‎lib/graphql.mli

Lines changed: 16 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -1,15 +1,18 @@
1-
type request = {
2-
meth : Curly.Meth.t;
3-
url : string;
4-
headers : Curly.Header.t;
5-
body : Yojson.Safe.t;
6-
}
1+
module Request : sig
2+
type t
73

8-
val request :
9-
?variables:(string * Yojson.Safe.t) list ->
10-
token:string ->
11-
query:string ->
12-
unit ->
13-
request
4+
val make :
5+
?variables:(string * Yojson.Safe.t) list ->
6+
token:string ->
7+
query:string ->
8+
unit ->
9+
t
1410

15-
val exec : request -> (Yojson.Safe.t, [ `Msg of string ]) result
11+
val exec :
12+
Cohttp_eio.Client.t ->
13+
Eio.Switch.t ->
14+
t ->
15+
(Yojson.Safe.t, [ `Msg of string ]) result
16+
17+
val pp : t Fmt.t
18+
end

‎test/expect/main.ml

Lines changed: 53 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,58 @@
11
open Get_activity
22

3+
let%expect_test "Graphql.Request.make" =
4+
let request = Graphql.Request.make ~token:"" ~query:"" () in
5+
Fmt.pr "%a" Graphql.Request.pp request;
6+
[%expect
7+
{|
8+
{
9+
request =
10+
((headers
11+
((Authorization "bearer ") (host api.github.com)
12+
(user-agent ocaml-cohttp/v6.0.0_beta2)))
13+
(meth POST) (scheme (https)) (resource /graphql) (version HTTP_1_1)
14+
(encoding Unknown));
15+
body =
16+
<...>
17+
}
18+
|}]
19+
20+
let%expect_test "Contributions.request viewer" =
21+
let user = User.Viewer in
22+
let request = Contributions.request ~period:("", "") ~user ~token:"" in
23+
Fmt.pr "%a" Graphql.Request.pp request;
24+
[%expect
25+
{|
26+
{
27+
request =
28+
((headers
29+
((Authorization "bearer ") (host api.github.com)
30+
(user-agent ocaml-cohttp/v6.0.0_beta2)))
31+
(meth POST) (scheme (https)) (resource /graphql) (version HTTP_1_1)
32+
(encoding Unknown));
33+
body =
34+
<...>
35+
}
36+
|}]
37+
38+
let%expect_test "Contributions.request user" =
39+
let user = User.User "me" in
40+
let request = Contributions.request ~period:("", "") ~user ~token:"" in
41+
Fmt.pr "%a" Graphql.Request.pp request;
42+
[%expect
43+
{|
44+
{
45+
request =
46+
((headers
47+
((Authorization "bearer ") (host api.github.com)
48+
(user-agent ocaml-cohttp/v6.0.0_beta2)))
49+
(meth POST) (scheme (https)) (resource /graphql) (version HTTP_1_1)
50+
(encoding Unknown));
51+
body =
52+
<...>
53+
}
54+
|}]
55+
356
let contributions_example ~user =
457
let open Contributions in
558
{

‎test/lib/alcotest_ext.ml

Lines changed: 0 additions & 48 deletions
Original file line numberDiff line numberDiff line change
@@ -25,51 +25,3 @@ module Yojson = struct
2525
end
2626

2727
let yojson = Yojson.testable
28-
29-
module Curly = struct
30-
module Meth = struct
31-
type t = Curly.Meth.t
32-
33-
let pp = Curly.Meth.pp
34-
35-
let eq (x : t) (y : t) =
36-
let x = Format.asprintf "%a" Curly.Meth.pp x in
37-
let y = Format.asprintf "%a" Curly.Meth.pp y in
38-
String.equal x y
39-
end
40-
41-
module Header = struct
42-
type t = Curly.Header.t
43-
44-
let pp = Curly.Header.pp
45-
46-
let eq (x : t) (y : t) =
47-
let x = Format.asprintf "%a" Curly.Header.pp x in
48-
let y = Format.asprintf "%a" Curly.Header.pp y in
49-
String.equal x y
50-
end
51-
end
52-
53-
module Request = struct
54-
type t = Get_activity.Graphql.request
55-
56-
let pp fs (x : t) =
57-
Format.fprintf fs
58-
"@[<hv 2>{@;\
59-
meth = %a;@;\
60-
url = %S@;\
61-
headers =@ %a@;\
62-
body =@ @[<hv 0>%a@];@]@;\
63-
}"
64-
Curly.Meth.pp x.meth x.url Curly.Header.pp x.headers Yojson.pp x.body
65-
66-
let eq (x : t) (y : t) =
67-
Curly.Meth.eq x.meth y.meth
68-
&& String.equal x.url y.url
69-
&& Curly.Header.eq x.headers y.headers
70-
&& Yojson.eq x.body y.body
71-
72-
let testable = Alcotest.testable pp eq
73-
end
74-
75-
let request = Request.testable

‎test/lib/alcotest_ext.mli

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -5,4 +5,3 @@ val or_msg :
55
'a Alcotest.testable -> ('a, [ `Msg of string ]) result Alcotest.testable
66

77
val yojson : Yojson.Safe.t Alcotest.testable
8-
val request : Get_activity.Graphql.request Alcotest.testable

‎test/lib/main.ml

Lines changed: 1 addition & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,3 @@
11
let () =
22
Alcotest.run "get-activity-lib"
3-
[
4-
Test_token.suite;
5-
Test_period.suite;
6-
Test_graphql.suite;
7-
Test_contributions.suite;
8-
]
3+
[ Test_token.suite; Test_period.suite; Test_contributions.suite ]

0 commit comments

Comments
 (0)