My agentic slop goes here. Not intended for anyone else!
anil.recoil.org
1(** JSON API Helpers for Requests *)
2
3(** {1 Response Helpers} *)
4
5let read_body response = Requests.Response.body response |> Eio.Flow.read_all
6
7let check_2xx response =
8 let status = Requests.Response.status_code response in
9 let body = read_body response in
10 if status >= 200 && status < 300 then Ok body
11 else Error (status, body)
12
13let check_ok response =
14 let status = Requests.Response.status_code response in
15 let body = read_body response in
16 if status = 200 then Ok body
17 else Error (status, body)
18
19(** {1 Request Helpers with Status Checking} *)
20
21let get_result session url =
22 try
23 let response = Requests.get session url in
24 check_2xx response
25 with exn ->
26 Error (0, Printexc.to_string exn)
27
28(** {1 JSON Helpers} *)
29
30let parse_json decoder body_str =
31 match Jsont_bytesrw.decode_string' decoder body_str with
32 | Ok v -> v
33 | Error e -> failwith (Fmt.str "JSON parse error: %s" (Jsont.Error.to_string e))
34
35let parse_json_result decoder body_str =
36 match Jsont_bytesrw.decode_string' decoder body_str with
37 | Ok v -> Ok v
38 | Error e -> Error (Jsont.Error.to_string e)
39
40let get_json_exn session url decoder =
41 let response = Requests.get session url in
42 let status = Requests.Response.status_code response in
43 if status < 200 || status >= 300 then
44 failwith (Printf.sprintf "HTTP %d" status);
45 read_body response |> parse_json decoder
46
47let get_json session url decoder =
48 match get_result session url with
49 | Ok body ->
50 (match parse_json_result decoder body with
51 | Ok result -> Ok result
52 | Error msg -> Error (`Json_error msg))
53 | Error (status, body) -> Error (`Http (status, body))
54
55let post_json session url jsont_codec value =
56 let body_str = match Jsont_bytesrw.encode_string' jsont_codec value with
57 | Ok s -> s
58 | Error e -> failwith (Fmt.str "JSON encoding error: %s" (Jsont.Error.to_string e))
59 in
60 let body = Requests.Body.of_string Requests.Mime.json body_str in
61 Requests.post session url ~body
62
63let post_json_exn session url jsont_codec value =
64 let response = post_json session url jsont_codec value in
65 let status = Requests.Response.status_code response in
66 if status < 200 || status >= 300 then
67 failwith (Printf.sprintf "HTTP %d" status);
68 read_body response
69
70let post_json_result session url jsont_codec value =
71 try
72 let response = post_json session url jsont_codec value in
73 check_2xx response
74 with exn ->
75 Error (0, Printexc.to_string exn)
76
77let post_json_decode_exn session url ~req req_value ~resp =
78 let response = post_json session url req req_value in
79 let status = Requests.Response.status_code response in
80 if status < 200 || status >= 300 then
81 failwith (Printf.sprintf "HTTP %d" status);
82 read_body response |> parse_json resp
83
84let post_json_decode session url ~req req_value ~resp =
85 try
86 let response = post_json session url req req_value in
87 match check_2xx response with
88 | Ok body ->
89 (match parse_json_result resp body with
90 | Ok result -> Ok result
91 | Error msg -> Error (`Json_error msg))
92 | Error (status, body) -> Error (`Http (status, body))
93 with exn ->
94 Error (`Http (0, Printexc.to_string exn))
95
96let put_json_exn session url jsont_codec value =
97 let body_str = match Jsont_bytesrw.encode_string' jsont_codec value with
98 | Ok s -> s
99 | Error e -> failwith (Fmt.str "JSON encoding error: %s" (Jsont.Error.to_string e))
100 in
101 let body = Requests.Body.of_string Requests.Mime.json body_str in
102 let response = Requests.put session url ~body in
103 let status = Requests.Response.status_code response in
104 if status < 200 || status >= 300 then
105 failwith (Printf.sprintf "HTTP %d" status);
106 read_body response
107
108let put_json_decode_exn session url ~req req_value ~resp =
109 let body_str = match Jsont_bytesrw.encode_string' req req_value with
110 | Ok s -> s
111 | Error e -> failwith (Fmt.str "JSON encoding error: %s" (Jsont.Error.to_string e))
112 in
113 let body = Requests.Body.of_string Requests.Mime.json body_str in
114 let response = Requests.put session url ~body in
115 let status = Requests.Response.status_code response in
116 if status < 200 || status >= 300 then
117 failwith (Printf.sprintf "HTTP %d" status);
118 read_body response |> parse_json resp
119
120let patch_json_exn session url jsont_codec value =
121 let body_str = match Jsont_bytesrw.encode_string' jsont_codec value with
122 | Ok s -> s
123 | Error e -> failwith (Fmt.str "JSON encoding error: %s" (Jsont.Error.to_string e))
124 in
125 let body = Requests.Body.of_string Requests.Mime.json body_str in
126 let response = Requests.patch session url ~body in
127 let status = Requests.Response.status_code response in
128 if status < 200 || status >= 300 then
129 failwith (Printf.sprintf "HTTP %d" status);
130 read_body response
131
132let delete_json_exn session url =
133 let response = Requests.delete session url in
134 let status = Requests.Response.status_code response in
135 if status < 200 || status >= 300 then
136 failwith (Printf.sprintf "HTTP %d" status);
137 read_body response
138
139(** {1 URL Helpers} *)
140
141let ( / ) base path =
142 (* Handle trailing slash in base and leading slash in path *)
143 let base = if String.ends_with ~suffix:"/" base then String.sub base 0 (String.length base - 1) else base in
144 let path = if String.starts_with ~prefix:"/" path then String.sub path 1 (String.length path - 1) else path in
145 base ^ "/" ^ path
146
147let make_url = ( / )
148
149(** {1 Let Syntax for Composition} *)
150
151module Syntax = struct
152 let ( let* ) x f = Result.bind x f
153 let ( let+ ) x f = Result.map f x
154 let ( and* ) a b = match a, b with
155 | Ok a, Ok b -> Ok (a, b)
156 | Error e, _ | _, Error e -> Error e
157 let ( and+ ) = ( and* )
158end
159
160(** {1 Convenience Combinators} *)
161
162let or_fail = function
163 | Ok x -> x
164 | Error (`Http (code, msg)) ->
165 failwith (Printf.sprintf "HTTP %d: %s" code msg)
166 | Error (`Json_error msg) ->
167 failwith (Printf.sprintf "JSON error: %s" msg)
168
169let or_fail_with prefix = function
170 | Ok x -> x
171 | Error (`Http (code, msg)) ->
172 failwith (Printf.sprintf "%s: HTTP %d: %s" prefix code msg)
173 | Error (`Json_error msg) ->
174 failwith (Printf.sprintf "%s: JSON error: %s" prefix msg)