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
103
104
105
open Eio.Std
include Client_intf
open Utils
type connection = Eio.Flow.two_way_ty r
type t = sw:Switch.t -> Uri.t -> connection
include
Cohttp.Generic.Client.Make
(struct
type 'a io = 'a
type body = Body.t
type 'a with_context = t -> sw:Eio.Switch.t -> 'a
let map_context v f t ~sw = f (v t ~sw)
let call (t : t) ~sw ? ?body ?(chunked = false) meth uri =
let socket = t ~sw uri in
let body_length =
if chunked then None
else
match body with
| None -> Some 0L
| Some (Eio.Resource.T (body, ops)) ->
let module X = (val Eio.Resource.get ops Eio.Flow.Pi.Source) in
List.find_map
(function
| Body.String m ->
Some (String.length (m body) |> Int64.of_int)
| _ -> None)
X.read_methods
in
let request =
Cohttp.Request.make_for_client ?headers
~chunked:(Option.is_none body_length)
?body_length meth uri
in
Eio.Buf_write.with_flow socket @@ fun output ->
let () =
Eio.Fiber.fork ~sw @@ fun () ->
Io.Request.write
(fun writer ->
match body with
| None -> ()
| Some body -> flow_to_writer body writer Io.Request.write_body)
request output
in
let input = Eio.Buf_read.of_flow ~max_size:max_int socket in
match Io.Response.read input with
| `Eof -> failwith "connection closed by peer"
| `Invalid reason -> failwith reason
| `Ok response -> (
match Cohttp.Response.has_body response with
| `No -> (response, Eio.Flow.string_source "")
| `Yes | `Unknown ->
let body =
let reader = Io.Response.make_body_reader response input in
flow_of_reader (fun () -> Io.Response.read_body_chunk reader)
in
(response, body))
end)
(Io.IO)
let make_generic fn = (fn :> t)
let unix_address uri =
match Uri.host uri with
| Some path -> `Unix path
| None -> Fmt.failwith "no host specified (in %a)" Uri.pp uri
let tcp_address ~net uri =
let service =
match Uri.port uri with
| Some port -> Int.to_string port
| _ -> Uri.scheme uri |> Option.value ~default:"http"
in
match
Eio.Net.getaddrinfo_stream ~service net
(Uri.host_with_default ~default:"localhost" uri)
with
| ip :: _ -> ip
| [] -> failwith "failed to resolve hostname"
let make ~https net : t =
let net = (net :> [ `Generic ] Eio.Net.ty r) in
let https =
(https
:> (Uri.t -> [ `Generic ] Eio.Net.stream_socket_ty r -> connection) option)
in
fun ~sw uri ->
match Uri.scheme uri with
| Some "httpunix" ->
(Eio.Net.connect ~sw net (unix_address uri) :> connection)
| Some "http" ->
(Eio.Net.connect ~sw net (tcp_address ~net uri) :> connection)
| Some "https" -> (
match https with
| Some wrap ->
wrap uri @@ Eio.Net.connect ~sw net (tcp_address ~net uri)
| None -> Fmt.failwith "HTTPS not enabled (for %a)" Uri.pp uri)
| x ->
Fmt.failwith "Unknown scheme %a"
Fmt.(option ~none:(any "None") Dump.string)
x