ocaml http/1, http/2 and websocket client and server library
gdiazlo.tngl.sh
1(** HTTP Request Builder DSL.
2
3 This module provides a fluent API for building HTTP requests. It's designed
4 to be used with the Client module for a high-level HTTP client experience.
5
6 {1 Usage}
7
8 {[
9 open Hcs.Http
10
11 (* Simple GET request *)
12 let req = get "https://api.example.com/users" |> build
13
14 (* POST with JSON body *)
15 let req =
16 post "https://api.example.com/users"
17 |> content_type "application/json"
18 |> body_string {|{"name": "Alice"}|}
19 |> build
20
21 (* GET with query params and auth *)
22 let req =
23 get "https://api.example.com/search"
24 |> query "q" "ocaml" |> query "limit" "10" |> bearer "my-token" |> build
25 ]} *)
26
27(** {1 Types} *)
28
29(** HTTP method *)
30type meth =
31 | GET
32 | POST
33 | PUT
34 | DELETE
35 | PATCH
36 | HEAD
37 | OPTIONS
38 | CONNECT
39 | TRACE
40 | Other of string
41
42(** Body content *)
43type body = Empty | String of string | Form of (string * string) list
44
45type builder = {
46 meth : meth;
47 uri : Uri.t;
48 headers : (string * string) list;
49 body : body;
50}
51(** Request builder - accumulates request parameters *)
52
53type request = {
54 req_meth : meth;
55 req_uri : Uri.t;
56 req_headers : (string * string) list;
57 req_body : body;
58}
59(** Built request ready for execution *)
60
61(** {1 Method to H1.Method conversion} *)
62
63let meth_to_h1 = function
64 | GET -> `GET
65 | POST -> `POST
66 | PUT -> `PUT
67 | DELETE -> `DELETE
68 | PATCH -> `Other "PATCH"
69 | HEAD -> `HEAD
70 | OPTIONS -> `OPTIONS
71 | CONNECT -> `CONNECT
72 | TRACE -> `TRACE
73 | Other s -> `Other s
74
75let meth_of_string = function
76 | "GET" -> GET
77 | "POST" -> POST
78 | "PUT" -> PUT
79 | "DELETE" -> DELETE
80 | "PATCH" -> PATCH
81 | "HEAD" -> HEAD
82 | "OPTIONS" -> OPTIONS
83 | "CONNECT" -> CONNECT
84 | "TRACE" -> TRACE
85 | s -> Other s
86
87let meth_to_string = function
88 | GET -> "GET"
89 | POST -> "POST"
90 | PUT -> "PUT"
91 | DELETE -> "DELETE"
92 | PATCH -> "PATCH"
93 | HEAD -> "HEAD"
94 | OPTIONS -> "OPTIONS"
95 | CONNECT -> "CONNECT"
96 | TRACE -> "TRACE"
97 | Other s -> s
98
99(** {1 Request Builders} *)
100
101(** Create a builder with the given method and URL *)
102let create meth url =
103 let uri = Uri.of_string url in
104 { meth; uri; headers = []; body = Empty }
105
106(** Create a GET request builder *)
107let get url = create GET url
108
109(** Create a POST request builder *)
110let post url = create POST url
111
112(** Create a PUT request builder *)
113let put url = create PUT url
114
115(** Create a DELETE request builder *)
116let delete url = create DELETE url
117
118(** Create a PATCH request builder *)
119let patch url = create PATCH url
120
121(** Create a HEAD request builder *)
122let head url = create HEAD url
123
124(** Create an OPTIONS request builder *)
125let options url = create OPTIONS url
126
127(** Create a request builder from a Uri *)
128let of_uri meth uri = { meth; uri; headers = []; body = Empty }
129
130(** {2 Headers} *)
131
132(** Add a header to the request *)
133let header name value builder =
134 { builder with headers = (name, value) :: builder.headers }
135
136(** Add multiple headers to the request *)
137let headers hdrs builder =
138 { builder with headers = List.rev_append hdrs builder.headers }
139
140(** Set the Content-Type header *)
141let content_type ct builder = header "Content-Type" ct builder
142
143(** Set the Accept header *)
144let accept ct builder = header "Accept" ct builder
145
146(** Set the User-Agent header *)
147let user_agent ua builder = header "User-Agent" ua builder
148
149(** Set Bearer authentication *)
150let bearer token builder = header "Authorization" ("Bearer " ^ token) builder
151
152(** Set Basic authentication *)
153let basic_auth ~user ~pass builder =
154 let credentials = Base64.encode_string (user ^ ":" ^ pass) in
155 header "Authorization" ("Basic " ^ credentials) builder
156
157(** Set a cookie header *)
158let cookie name value builder =
159 let existing =
160 List.find_opt (fun (n, _) -> String.equal n "Cookie") builder.headers
161 in
162 let new_cookie =
163 match existing with
164 | Some (_, v) -> v ^ "; " ^ name ^ "=" ^ value
165 | None -> name ^ "=" ^ value
166 in
167 let headers =
168 List.filter (fun (n, _) -> not (String.equal n "Cookie")) builder.headers
169 in
170 { builder with headers = ("Cookie", new_cookie) :: headers }
171
172(** Set cookies from a list *)
173let cookies cs builder =
174 List.fold_left (fun b (n, v) -> cookie n v b) builder cs
175
176(** {2 Query Parameters} *)
177
178(** Add a query parameter *)
179let query name value builder =
180 let uri = Uri.add_query_param' builder.uri (name, value) in
181 { builder with uri }
182
183(** Add multiple query parameters *)
184let queries qs builder =
185 let uri =
186 List.fold_left
187 (fun u (n, v) -> Uri.add_query_param' u (n, v))
188 builder.uri qs
189 in
190 { builder with uri }
191
192(** {2 Body} *)
193
194(** Set the request body *)
195let body b builder = { builder with body = b }
196
197(** Set the body as a string with optional content type *)
198let body_string ?content_type:ct str builder =
199 let builder = { builder with body = String str } in
200 match ct with Some ct -> content_type ct builder | None -> builder
201
202(** Set the body as a JSON string *)
203let body_json json builder =
204 builder |> body_string ~content_type:"application/json" json
205
206(** Set the body as form data *)
207let form fields builder =
208 { builder with body = Form fields }
209 |> content_type "application/x-www-form-urlencoded"
210
211(** {1 Building} *)
212
213(** Build the final request *)
214let build builder =
215 {
216 req_meth = builder.meth;
217 req_uri = builder.uri;
218 req_headers = List.rev builder.headers;
219 req_body = builder.body;
220 }
221
222(** Get the URL as a string *)
223let url request = Uri.to_string request.req_uri
224
225(** Get the host from the request *)
226let host request = Uri.host request.req_uri |> Option.value ~default:"localhost"
227
228(** Get the port from the request *)
229let port request =
230 match Uri.port request.req_uri with
231 | Some p -> p
232 | None -> (
233 match Uri.scheme request.req_uri with Some "https" -> 443 | _ -> 80)
234
235(** Get the path from the request *)
236let path request =
237 let p = Uri.path request.req_uri in
238 if p = "" then "/" else p
239
240(** Get the path and query from the request *)
241let path_and_query request = Uri.path_and_query request.req_uri
242
243(** Check if the request is HTTPS *)
244let is_https request =
245 match Uri.scheme request.req_uri with Some "https" -> true | _ -> false
246
247(** {1 Body Encoding} *)
248
249(** Encode form data as URL-encoded string *)
250let encode_form fields =
251 String.concat "&"
252 (List.map (fun (k, v) -> Uri.pct_encode k ^ "=" ^ Uri.pct_encode v) fields)
253
254(** Get the body as a string *)
255let body_to_string = function
256 | Empty -> ""
257 | String s -> s
258 | Form fields -> encode_form fields
259
260(** Get the Content-Length for the body *)
261let body_length body = String.length (body_to_string body)