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
open Riot
type body_reader =
Atacama.Connection.t ->
[ `ok of Bytestring.t | `more of Bytestring.t | `error of IO.io_error ]
type t = {
body_remaining : int;
buffer : Bytestring.t;
encoding : Http.Transfer.encoding;
headers : Http.Header.t;
meth : Http.Method.t;
path : string list;
query : (string * string list) list;
uri : Uri.t;
version : Http.Version.t;
}
module StringSet = Set.Make (String)
let content_length req =
match Http.Header.get req.headers "content-length" with
| None -> None
| Some value -> (
let values =
String.split_on_char ',' value
|> List.map String.trim |> StringSet.of_list |> StringSet.to_list
|> List.map Int64.of_string_opt
in
match values with
| [ Some first ] when first > 0L -> Some (first |> Int64.to_int)
| _ :: _ -> raise Invalid_content_header
| _ -> None)
let make ?(body = Bytestring.of_string "") ?(meth = `GET) ?(version = `HTTP_1_1)
?( = []) uri =
let uri = Uri.of_string uri in
let = Http.Header.of_list headers in
let encoding = Http.Header.get_transfer_encoding headers in
let path =
(match Uri.path uri |> String.split_on_char '/' with
| "" :: path -> path
| path -> path)
|> List.filter (fun part -> String.length part > 0)
in
let query = Uri.query uri in
let req =
{
body_remaining = 0;
buffer = body;
encoding;
headers;
meth;
path;
query;
uri;
version;
}
in
let body_remaining = content_length req |> Option.value ~default:0 in
{ req with body_remaining }
let pp fmt ({ ; meth; uri; version; _ } : t) =
let req = Http.Request.make ~meth ~headers ~version (Uri.to_string uri) in
Http.Request.pp fmt req
let from_http req =
let meth = Http.Request.meth req in
let = Http.Request.headers req |> Http.Header.to_list in
let target = Http.Request.resource req in
let version = Http.Request.version req in
make ~meth ~version ~headers target
let is_keep_alive t =
match Http.Header.get t.headers "connection" with
| Some "keep_alive" -> true
| _ -> false
let body_encoding req = Http.Header.get_transfer_encoding req.headers