A batteries included HTTP/1.1 client in OCaml
anil.recoil.org
1(*---------------------------------------------------------------------------
2 Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3 SPDX-License-Identifier: ISC
4 ---------------------------------------------------------------------------*)
5
6open Eio
7
8let () =
9 Mirage_crypto_rng_unix.use_default ();
10 Eio_main.run @@ fun env ->
11 Switch.run @@ fun sw ->
12
13 (* Example 1: Basic GET request *)
14 Printf.printf "\n=== Example 1: Basic GET Request ===\n%!";
15 let req = Requests.create ~sw env in
16 let resp1 = Requests.get req "https://httpbin.org/get" in
17 Printf.printf "Status: %d\n%!" (Requests.Response.status_code resp1);
18 let body1 = Requests.Response.body resp1 |> Buf_read.of_flow ~max_size:max_int |> Buf_read.take_all in
19 Printf.printf "Body length: %d bytes\n%!" (String.length body1);
20
21 (* Example 2: POST with JSON body *)
22 Printf.printf "\n=== Example 2: POST with JSON ===\n%!";
23 let json_data = Jsont.Object ([
24 ("name", Jsont.String "Alice");
25 ("email", Jsont.String "alice@example.com");
26 ("age", Jsont.Number 30.0)
27 ], Jsont.Meta.none) in
28 let resp2 = Requests.post req
29 ~body:(Requests.Body.json json_data)
30 "https://httpbin.org/post" in
31 Printf.printf "POST status: %d\n%!" (Requests.Response.status_code resp2);
32
33 (* Example 3: Custom headers and authentication *)
34 Printf.printf "\n=== Example 3: Custom Headers and Auth ===\n%!";
35 let headers = Requests.Headers.empty
36 |> Requests.Headers.set "X-Custom-Header" "MyValue"
37 |> Requests.Headers.user_agent "OCaml-Requests-Example/1.0" in
38 let resp3 = Requests.get req
39 ~headers
40 ~auth:(Requests.Auth.bearer ~token:"demo-token-123")
41 "https://httpbin.org/bearer" in
42 Printf.printf "Auth status: %d\n%!" (Requests.Response.status_code resp3);
43
44 (* Example 4: Session with default headers *)
45 Printf.printf "\n=== Example 4: Session with Default Headers ===\n%!";
46 let req2 = Requests.create ~sw env in
47 let req2 = Requests.set_default_header req2 "User-Agent" "OCaml-Requests/1.0" in
48 let req2 = Requests.set_default_header req2 "Accept" "application/json" in
49
50 (* All requests with req2 will include these headers *)
51 let resp4 = Requests.get req2 "https://httpbin.org/headers" in
52 Printf.printf "Headers response status: %d\n%!" (Requests.Response.status_code resp4);
53
54 (* Example 5: Query parameters *)
55 Printf.printf "\n=== Example 5: Query Parameters ===\n%!";
56 let resp5 = Requests.get req
57 ~params:[("key1", "value1"); ("key2", "value2")]
58 "https://httpbin.org/get" in
59 Printf.printf "Query params status: %d\n%!" (Requests.Response.status_code resp5);
60
61 (* Example 6: Form data submission *)
62 Printf.printf "\n=== Example 6: Form Data ===\n%!";
63 let form_body = Requests.Body.form [
64 ("username", "demo");
65 ("password", "secret123")
66 ] in
67 let resp6 = Requests.post req
68 ~body:form_body
69 "https://httpbin.org/post" in
70 Printf.printf "Form POST status: %d\n%!" (Requests.Response.status_code resp6);
71
72 (* Example 7: Retry configuration *)
73 Printf.printf "\n=== Example 7: Retry Configuration ===\n%!";
74 let retry_config = Requests.Retry.create_config
75 ~max_retries:3
76 ~backoff_factor:0.5
77 () in
78 let req_with_retry = Requests.create ~sw ~retry:retry_config env in
79 let req_with_retry = Requests.set_timeout req_with_retry
80 (Requests.Timeout.create ~total:10.0 ()) in
81
82 (* This will retry on 5xx errors *)
83 (try
84 let resp7 = Requests.get req_with_retry "https://httpbin.org/status/200" in
85 Printf.printf "Retry test status: %d\n%!" (Requests.Response.status_code resp7)
86 with _ ->
87 Printf.printf "Request failed even after retries\n%!");
88
89 (* Example 8: Concurrent requests using Fiber.both *)
90 Printf.printf "\n=== Example 8: Concurrent Requests ===\n%!";
91 let start_time = Unix.gettimeofday () in
92
93 let (r1, r2) = Fiber.both
94 (fun () -> Requests.get req "https://httpbin.org/delay/1")
95 (fun () -> Requests.get req "https://httpbin.org/delay/1") in
96
97 let elapsed = Unix.gettimeofday () -. start_time in
98 Printf.printf "Two 1-second delays completed in %.2f seconds (concurrent)\n%!" elapsed;
99 Printf.printf "Response 1 status: %d\n%!" (Requests.Response.status_code r1);
100 Printf.printf "Response 2 status: %d\n%!" (Requests.Response.status_code r2);
101
102 (* Example 9: One-shot stateless request *)
103 Printf.printf "\n=== Example 9: One-Shot Stateless Request ===\n%!";
104 let resp9 = Requests.One.get
105 ~sw
106 ~clock:env#clock
107 ~net:env#net
108 "https://httpbin.org/get" in
109 Printf.printf "One-shot status: %d\n%!" (Requests.Response.status_code resp9);
110
111 (* Example 10: Error handling *)
112 Printf.printf "\n=== Example 10: Error Handling ===\n%!";
113 (try
114 let resp = Requests.get req "https://httpbin.org/status/404" in
115 (* By default, 4xx/5xx status codes don't raise exceptions *)
116 if Requests.Response.ok resp then
117 Printf.printf "Success\n%!"
118 else
119 Printf.printf "Got %d response (no exception by default)\n%!"
120 (Requests.Response.status_code resp);
121 (* Use raise_for_status to get exception behavior *)
122 let _resp = Requests.Response.raise_for_status resp in
123 ()
124 with
125 | Eio.Io (Requests.Error.E (Requests.Error.Http_error_status _), _) ->
126 Printf.printf "HTTP error status raised via raise_for_status\n%!"
127 | exn ->
128 Printf.printf "Other error: %s\n%!" (Printexc.to_string exn));
129
130 (* Example 11: Timeouts *)
131 Printf.printf "\n=== Example 11: Timeouts ===\n%!";
132 let req_timeout = Requests.create ~sw env in
133 let req_timeout = Requests.set_timeout req_timeout
134 (Requests.Timeout.create ~total:5.0 ()) in
135
136 (try
137 let resp11 = Requests.get req_timeout "https://httpbin.org/delay/2" in
138 Printf.printf "Timeout test completed: %d\n%!" (Requests.Response.status_code resp11)
139 with
140 | Eio.Time.Timeout ->
141 Printf.printf "Request correctly timed out\n%!"
142 | exn ->
143 Printf.printf "Other timeout error: %s\n%!" (Printexc.to_string exn));
144
145 (* Example 12: Multiple concurrent requests with Fiber.all *)
146 Printf.printf "\n=== Example 12: Multiple Concurrent Requests ===\n%!";
147 let urls = [
148 "https://httpbin.org/delay/1";
149 "https://httpbin.org/get";
150 "https://httpbin.org/headers";
151 ] in
152
153 let start_time = Unix.gettimeofday () in
154 let responses = ref [] in
155
156 Fiber.all (List.map (fun url ->
157 fun () ->
158 let resp = Requests.get req url in
159 responses := resp :: !responses
160 ) urls);
161
162 let elapsed = Unix.gettimeofday () -. start_time in
163 Printf.printf "Three requests completed in %.2f seconds (concurrent)\n%!" elapsed;
164 List.iter (fun r ->
165 Printf.printf " Status: %d\n%!" (Requests.Response.status_code r)
166 ) !responses;
167
168 Printf.printf "\n=== All examples completed successfully! ===\n%!"