this repo has no description
anil.recoil.org
1(**
2 * JMAP protocol implementation based on RFC8620
3 * https://datatracker.ietf.org/doc/html/rfc8620
4 *)
5
6(** Whether to redact sensitive information *)
7let should_redact_sensitive = ref true
8
9(** Initialize and configure logging for JMAP *)
10let init_logging ?(level=2) ?(enable_logs=true) ?(redact_sensitive=true) () =
11 if enable_logs then begin
12 Logs.set_reporter (Logs.format_reporter ());
13 match level with
14 | 0 -> Logs.set_level None
15 | 1 -> Logs.set_level (Some Logs.Error)
16 | 2 -> Logs.set_level (Some Logs.Info)
17 | 3 -> Logs.set_level (Some Logs.Debug)
18 | _ -> Logs.set_level (Some Logs.Debug)
19 end else
20 Logs.set_level None;
21 should_redact_sensitive := redact_sensitive
22
23(** Redact sensitive data like tokens *)
24let redact_token ?(redact=true) token =
25 if redact && !should_redact_sensitive && String.length token > 8 then
26 let prefix = String.sub token 0 4 in
27 let suffix = String.sub token (String.length token - 4) 4 in
28 prefix ^ "..." ^ suffix
29 else
30 token
31
32(** Redact sensitive headers like Authorization *)
33let redact_headers headers =
34 List.map (fun (k, v) ->
35 if String.lowercase_ascii k = "authorization" then
36 if !should_redact_sensitive then
37 let parts = String.split_on_char ' ' v in
38 match parts with
39 | scheme :: token :: _ -> (k, scheme ^ " " ^ redact_token token)
40 | _ -> (k, v)
41 else (k, v)
42 else (k, v)
43 ) headers
44
45(* Initialize logging with defaults *)
46let () = init_logging ()
47
48(** Module for managing JMAP capability URIs and other constants *)
49module Capability = struct
50 (** Core JMAP capability URI *)
51 type core = Core
52
53 (** JMAP capability URI as specified in RFC8620 *)
54 let core_uri = "urn:ietf:params:jmap:core"
55
56 (** Convert core capability to URI string *)
57 let string_of_core = function
58 | Core -> core_uri
59
60 (** Parse a string to a core capability, returns None if not a valid capability URI *)
61 let core_of_string = function
62 | s when s = core_uri -> Some Core
63 | _ -> None
64
65 (** All JMAP capability types *)
66 type t =
67 | Core of core
68 | Extension of string
69
70 (** Convert capability to URI string *)
71 let to_string = function
72 | Core c -> string_of_core c
73 | Extension s -> s
74
75 (** Parse a string to a capability, returns Extension for non-core capabilities *)
76 let of_string s =
77 match core_of_string s with
78 | Some c -> Core c
79 | None -> Extension s
80
81 (** Check if a capability matches a core capability *)
82 let is_core = function
83 | Core _ -> true
84 | Extension _ -> false
85
86 (** Check if a capability string is a core capability *)
87 let is_core_string s =
88 match of_string s with
89 | Core _ -> true
90 | Extension _ -> false
91
92 (** Create a list of capability strings *)
93 let strings_of_capabilities capabilities =
94 List.map to_string capabilities
95end
96
97module Types = struct
98 (** Id string as per Section 1.2 *)
99 type id = string
100
101 (** Int bounded within the range -2^53+1 to 2^53-1 as per Section 1.3 *)
102 type int_t = int
103
104 (** UnsignedInt bounded within the range 0 to 2^53-1 as per Section 1.3 *)
105 type unsigned_int = int
106
107 (** Date string in RFC3339 format as per Section 1.4 *)
108 type date = string
109
110 (** UTCDate is a Date with 'Z' time zone as per Section 1.4 *)
111 type utc_date = string
112
113 (** Error object as per Section 3.6.2 *)
114 type error = {
115 type_: string;
116 description: string option;
117 }
118
119 (** Set error object as per Section 5.3 *)
120 type set_error = {
121 type_: string;
122 description: string option;
123 properties: string list option;
124 (* Additional properties for specific error types *)
125 existing_id: id option; (* For alreadyExists error *)
126 }
127
128 (** Invocation object as per Section 3.2 *)
129 type 'a invocation = {
130 name: string;
131 arguments: 'a;
132 method_call_id: string;
133 }
134
135 (** ResultReference object as per Section 3.7 *)
136 type result_reference = {
137 result_of: string;
138 name: string;
139 path: string;
140 }
141
142 (** FilterOperator, FilterCondition and Filter as per Section 5.5 *)
143 type filter_operator = {
144 operator: string; (* "AND", "OR", "NOT" *)
145 conditions: filter list;
146 }
147 and filter_condition = (string * Ezjsonm.value) list
148 and filter =
149 | Operator of filter_operator
150 | Condition of filter_condition
151
152 (** Comparator object for sorting as per Section 5.5 *)
153 type comparator = {
154 property: string;
155 is_ascending: bool option; (* Optional, defaults to true *)
156 collation: string option; (* Optional, server-dependent default *)
157 }
158
159 (** PatchObject as per Section 5.3 *)
160 type patch_object = (string * Ezjsonm.value) list
161
162 (** AddedItem structure as per Section 5.6 *)
163 type added_item = {
164 id: id;
165 index: unsigned_int;
166 }
167
168 (** Account object as per Section 1.6.2 *)
169 type account = {
170 name: string;
171 is_personal: bool;
172 is_read_only: bool;
173 account_capabilities: (string * Ezjsonm.value) list;
174 }
175
176 (** Core capability object as per Section 2 *)
177 type core_capability = {
178 max_size_upload: unsigned_int;
179 max_concurrent_upload: unsigned_int;
180 max_size_request: unsigned_int;
181 max_concurrent_requests: unsigned_int;
182 max_calls_in_request: unsigned_int;
183 max_objects_in_get: unsigned_int;
184 max_objects_in_set: unsigned_int;
185 collation_algorithms: string list;
186 }
187
188 (** PushSubscription keys object as per Section 7.2 *)
189 type push_keys = {
190 p256dh: string;
191 auth: string;
192 }
193
194 (** Session object as per Section 2 *)
195 type session = {
196 capabilities: (string * Ezjsonm.value) list;
197 accounts: (id * account) list;
198 primary_accounts: (string * id) list;
199 username: string;
200 api_url: string;
201 download_url: string;
202 upload_url: string;
203 event_source_url: string option;
204 state: string;
205 }
206
207 (** TypeState for state changes as per Section 7.1 *)
208 type type_state = (string * string) list
209
210 (** StateChange object as per Section 7.1 *)
211 type state_change = {
212 changed: (id * type_state) list;
213 }
214
215 (** PushVerification object as per Section 7.2.2 *)
216 type push_verification = {
217 push_subscription_id: id;
218 verification_code: string;
219 }
220
221 (** PushSubscription object as per Section 7.2 *)
222 type push_subscription = {
223 id: id;
224 device_client_id: string;
225 url: string;
226 keys: push_keys option;
227 verification_code: string option;
228 expires: utc_date option;
229 types: string list option;
230 }
231
232 (** Request object as per Section 3.3 *)
233 type request = {
234 using: string list;
235 method_calls: Ezjsonm.value invocation list;
236 created_ids: (id * id) list option;
237 }
238
239 (** Response object as per Section 3.4 *)
240 type response = {
241 method_responses: Ezjsonm.value invocation list;
242 created_ids: (id * id) list option;
243 session_state: string;
244 }
245
246 (** Standard method arguments and responses *)
247
248 (** Arguments for Foo/get method as per Section 5.1 *)
249 type 'a get_arguments = {
250 account_id: id;
251 ids: id list option;
252 properties: string list option;
253 }
254
255 (** Response for Foo/get method as per Section 5.1 *)
256 type 'a get_response = {
257 account_id: id;
258 state: string;
259 list: 'a list;
260 not_found: id list;
261 }
262
263 (** Arguments for Foo/changes method as per Section 5.2 *)
264 type changes_arguments = {
265 account_id: id;
266 since_state: string;
267 max_changes: unsigned_int option;
268 }
269
270 (** Response for Foo/changes method as per Section 5.2 *)
271 type changes_response = {
272 account_id: id;
273 old_state: string;
274 new_state: string;
275 has_more_changes: bool;
276 created: id list;
277 updated: id list;
278 destroyed: id list;
279 }
280
281 (** Arguments for Foo/set method as per Section 5.3 *)
282 type 'a set_arguments = {
283 account_id: id;
284 if_in_state: string option;
285 create: (id * 'a) list option;
286 update: (id * patch_object) list option;
287 destroy: id list option;
288 }
289
290 (** Response for Foo/set method as per Section 5.3 *)
291 type 'a set_response = {
292 account_id: id;
293 old_state: string option;
294 new_state: string;
295 created: (id * 'a) list option;
296 updated: (id * 'a option) list option;
297 destroyed: id list option;
298 not_created: (id * set_error) list option;
299 not_updated: (id * set_error) list option;
300 not_destroyed: (id * set_error) list option;
301 }
302
303 (** Arguments for Foo/copy method as per Section 5.4 *)
304 type 'a copy_arguments = {
305 from_account_id: id;
306 if_from_in_state: string option;
307 account_id: id;
308 if_in_state: string option;
309 create: (id * 'a) list;
310 on_success_destroy_original: bool option;
311 destroy_from_if_in_state: string option;
312 }
313
314 (** Response for Foo/copy method as per Section 5.4 *)
315 type 'a copy_response = {
316 from_account_id: id;
317 account_id: id;
318 old_state: string option;
319 new_state: string;
320 created: (id * 'a) list option;
321 not_created: (id * set_error) list option;
322 }
323
324 (** Arguments for Foo/query method as per Section 5.5 *)
325 type query_arguments = {
326 account_id: id;
327 filter: filter option;
328 sort: comparator list option;
329 position: int_t option;
330 anchor: id option;
331 anchor_offset: int_t option;
332 limit: unsigned_int option;
333 calculate_total: bool option;
334 }
335
336 (** Response for Foo/query method as per Section 5.5 *)
337 type query_response = {
338 account_id: id;
339 query_state: string;
340 can_calculate_changes: bool;
341 position: unsigned_int;
342 ids: id list;
343 total: unsigned_int option;
344 limit: unsigned_int option;
345 }
346
347 (** Arguments for Foo/queryChanges method as per Section 5.6 *)
348 type query_changes_arguments = {
349 account_id: id;
350 filter: filter option;
351 sort: comparator list option;
352 since_query_state: string;
353 max_changes: unsigned_int option;
354 up_to_id: id option;
355 calculate_total: bool option;
356 }
357
358 (** Response for Foo/queryChanges method as per Section 5.6 *)
359 type query_changes_response = {
360 account_id: id;
361 old_query_state: string;
362 new_query_state: string;
363 total: unsigned_int option;
364 removed: id list;
365 added: added_item list option;
366 }
367
368 (** Arguments for Blob/copy method as per Section 6.3 *)
369 type blob_copy_arguments = {
370 from_account_id: id;
371 account_id: id;
372 blob_ids: id list;
373 }
374
375 (** Response for Blob/copy method as per Section 6.3 *)
376 type blob_copy_response = {
377 from_account_id: id;
378 account_id: id;
379 copied: (id * id) list option;
380 not_copied: (id * set_error) list option;
381 }
382
383 (** Upload response as per Section 6.1 *)
384 type upload_response = {
385 account_id: id;
386 blob_id: id;
387 type_: string;
388 size: unsigned_int;
389 }
390
391 (** Problem details object as per RFC7807 and Section 3.6.1 *)
392 type problem_details = {
393 type_: string;
394 status: int option;
395 detail: string option;
396 limit: string option; (* For "limit" error *)
397 }
398end
399
400module Api = struct
401 open Lwt.Syntax
402 open Types
403
404 (** Error that may occur during API requests *)
405 type error =
406 | Connection_error of string
407 | HTTP_error of int * string
408 | Parse_error of string
409 | Authentication_error
410
411 (** Result type for API operations *)
412 type 'a result = ('a, error) Stdlib.result
413
414 (** Configuration for a JMAP API client *)
415 type config = {
416 api_uri: Uri.t;
417 username: string;
418 authentication_token: string;
419 }
420
421 (** Convert Ezjsonm.value to string *)
422 let json_to_string json =
423 Ezjsonm.value_to_string ~minify:false json
424
425 (** Parse response string as JSON value *)
426 let parse_json_string str =
427 try Ok (Ezjsonm.from_string str)
428 with e -> Error (Parse_error (Printexc.to_string e))
429
430 (** Parse JSON response as a JMAP response object *)
431 let parse_response json =
432 try
433 let method_responses =
434 match Ezjsonm.find json ["methodResponses"] with
435 | `A items ->
436 List.map (fun json ->
437 match json with
438 | `A [`String name; args; `String method_call_id] ->
439 { name; arguments = args; method_call_id }
440 | _ -> raise (Invalid_argument "Invalid invocation format in response")
441 ) items
442 | _ -> raise (Invalid_argument "methodResponses is not an array")
443 in
444 let created_ids_opt =
445 try
446 let obj = Ezjsonm.find json ["createdIds"] in
447 match obj with
448 | `O items -> Some (List.map (fun (k, v) ->
449 match v with
450 | `String id -> (k, id)
451 | _ -> raise (Invalid_argument "createdIds value is not a string")
452 ) items)
453 | _ -> None
454 with Not_found -> None
455 in
456 let session_state =
457 match Ezjsonm.find json ["sessionState"] with
458 | `String s -> s
459 | _ -> raise (Invalid_argument "sessionState is not a string")
460 in
461 Ok { method_responses; created_ids = created_ids_opt; session_state }
462 with
463 | Not_found -> Error (Parse_error "Required field not found in response")
464 | Invalid_argument msg -> Error (Parse_error msg)
465 | e -> Error (Parse_error (Printexc.to_string e))
466
467 (** Serialize a JMAP request object to JSON *)
468 let serialize_request req =
469 let method_calls_json =
470 `A (List.map (fun (inv : 'a invocation) ->
471 `A [`String inv.name; inv.arguments; `String inv.method_call_id]
472 ) req.method_calls)
473 in
474 let using_json = `A (List.map (fun s -> `String s) req.using) in
475 let json = `O [
476 ("using", using_json);
477 ("methodCalls", method_calls_json)
478 ] in
479 let json = match req.created_ids with
480 | Some ids ->
481 let created_ids_json = `O (List.map (fun (k, v) -> (k, `String v)) ids) in
482 Ezjsonm.update json ["createdIds"] (Some created_ids_json)
483 | None -> json
484 in
485 json_to_string json
486
487 (** Make a raw HTTP request *)
488 let make_http_request ~method_ ~headers ~body uri =
489 let open Cohttp in
490 let open Cohttp_lwt_unix in
491 let headers = Header.add_list (Header.init ()) headers in
492
493 (* Log request details at debug level *)
494 let header_list = Cohttp.Header.to_list headers in
495 let redacted_headers = redact_headers header_list in
496 Logs.debug (fun m ->
497 m "\n===== HTTP REQUEST =====\n\
498 URI: %s\n\
499 METHOD: %s\n\
500 HEADERS:\n%s\n\
501 BODY:\n%s\n\
502 ======================\n"
503 (Uri.to_string uri)
504 method_
505 (String.concat "\n" (List.map (fun (k, v) -> Printf.sprintf " %s: %s" k v) redacted_headers))
506 body);
507
508 Lwt.catch
509 (fun () ->
510 let* resp, body =
511 match method_ with
512 | "GET" -> Client.get ~headers uri
513 | "POST" -> Client.post ~headers ~body:(Cohttp_lwt.Body.of_string body) uri
514 | _ -> failwith (Printf.sprintf "Unsupported HTTP method: %s" method_)
515 in
516 let* body_str = Cohttp_lwt.Body.to_string body in
517 let status = Response.status resp |> Code.code_of_status in
518
519 (* Log response details at debug level *)
520 let header_list = Cohttp.Header.to_list (Response.headers resp) in
521 let redacted_headers = redact_headers header_list in
522 Logs.debug (fun m ->
523 m "\n===== HTTP RESPONSE =====\n\
524 STATUS: %d\n\
525 HEADERS:\n%s\n\
526 BODY:\n%s\n\
527 ======================\n"
528 status
529 (String.concat "\n" (List.map (fun (k, v) -> Printf.sprintf " %s: %s" k v) redacted_headers))
530 body_str);
531
532 if status >= 200 && status < 300 then
533 Lwt.return (Ok body_str)
534 else
535 Lwt.return (Error (HTTP_error (status, body_str))))
536 (fun e ->
537 let error_msg = Printexc.to_string e in
538 Logs.err (fun m -> m "%s" error_msg);
539 Lwt.return (Error (Connection_error error_msg)))
540
541 (** Make a raw JMAP API request
542
543 TODO:claude *)
544 let make_request config req =
545 let body = serialize_request req in
546 (* Choose appropriate authorization header based on whether it's a bearer token or basic auth *)
547 let auth_header =
548 if String.length config.username > 0 then
549 (* Standard username/password authentication *)
550 "Basic " ^ Base64.encode_string (config.username ^ ":" ^ config.authentication_token)
551 else
552 (* API token (bearer authentication) *)
553 "Bearer " ^ config.authentication_token
554 in
555
556 (* Log auth header at debug level with redaction *)
557 let redacted_header =
558 if String.length config.username > 0 then
559 "Basic " ^ redact_token (Base64.encode_string (config.username ^ ":" ^ config.authentication_token))
560 else
561 "Bearer " ^ redact_token config.authentication_token
562 in
563 Logs.debug (fun m -> m "Using authorization header: %s" redacted_header);
564
565 let headers = [
566 ("Content-Type", "application/json");
567 ("Content-Length", string_of_int (String.length body));
568 ("Authorization", auth_header)
569 ] in
570 let* result = make_http_request ~method_:"POST" ~headers ~body config.api_uri in
571 match result with
572 | Ok response_body ->
573 (match parse_json_string response_body with
574 | Ok json ->
575 Logs.debug (fun m -> m "Successfully parsed JSON response");
576 Lwt.return (parse_response json)
577 | Error e ->
578 let msg = match e with Parse_error m -> m | _ -> "unknown error" in
579 Logs.err (fun m -> m "Failed to parse response: %s" msg);
580 Lwt.return (Error e))
581 | Error e ->
582 (match e with
583 | Connection_error msg -> Logs.err (fun m -> m "Connection error: %s" msg)
584 | HTTP_error (code, _) -> Logs.err (fun m -> m "HTTP error %d" code)
585 | Parse_error msg -> Logs.err (fun m -> m "Parse error: %s" msg)
586 | Authentication_error -> Logs.err (fun m -> m "Authentication error"));
587 Lwt.return (Error e)
588
589 (** Parse a JSON object as a Session object *)
590 let parse_session_object json =
591 try
592 let capabilities =
593 match Ezjsonm.find json ["capabilities"] with
594 | `O items -> items
595 | _ -> raise (Invalid_argument "capabilities is not an object")
596 in
597
598 let accounts =
599 match Ezjsonm.find json ["accounts"] with
600 | `O items -> List.map (fun (id, json) ->
601 match json with
602 | `O _ ->
603 let name = Ezjsonm.get_string (Ezjsonm.find json ["name"]) in
604 let is_personal = Ezjsonm.get_bool (Ezjsonm.find json ["isPersonal"]) in
605 let is_read_only = Ezjsonm.get_bool (Ezjsonm.find json ["isReadOnly"]) in
606 let account_capabilities =
607 match Ezjsonm.find json ["accountCapabilities"] with
608 | `O items -> items
609 | _ -> raise (Invalid_argument "accountCapabilities is not an object")
610 in
611 (id, { name; is_personal; is_read_only; account_capabilities })
612 | _ -> raise (Invalid_argument "account value is not an object")
613 ) items
614 | _ -> raise (Invalid_argument "accounts is not an object")
615 in
616
617 let primary_accounts =
618 match Ezjsonm.find_opt json ["primaryAccounts"] with
619 | Some (`O items) -> List.map (fun (k, v) ->
620 match v with
621 | `String id -> (k, id)
622 | _ -> raise (Invalid_argument "primaryAccounts value is not a string")
623 ) items
624 | Some _ -> raise (Invalid_argument "primaryAccounts is not an object")
625 | None -> []
626 in
627
628 let username = Ezjsonm.get_string (Ezjsonm.find json ["username"]) in
629 let api_url = Ezjsonm.get_string (Ezjsonm.find json ["apiUrl"]) in
630 let download_url = Ezjsonm.get_string (Ezjsonm.find json ["downloadUrl"]) in
631 let upload_url = Ezjsonm.get_string (Ezjsonm.find json ["uploadUrl"]) in
632 let event_source_url =
633 try Some (Ezjsonm.get_string (Ezjsonm.find json ["eventSourceUrl"]))
634 with Not_found -> None
635 in
636 let state = Ezjsonm.get_string (Ezjsonm.find json ["state"]) in
637
638 Ok { capabilities; accounts; primary_accounts; username;
639 api_url; download_url; upload_url; event_source_url; state }
640 with
641 | Not_found -> Error (Parse_error "Required field not found in session object")
642 | Invalid_argument msg -> Error (Parse_error msg)
643 | e -> Error (Parse_error (Printexc.to_string e))
644
645 (** Fetch a Session object from a JMAP server
646
647 TODO:claude *)
648 let get_session uri ?username ?authentication_token ?api_token () =
649 let headers =
650 match (username, authentication_token, api_token) with
651 | (Some u, Some t, _) ->
652 let auth = "Basic " ^ Base64.encode_string (u ^ ":" ^ t) in
653 let redacted_auth = "Basic " ^ redact_token (Base64.encode_string (u ^ ":" ^ t)) in
654 Logs.info (fun m -> m "Session using Basic auth: %s" redacted_auth);
655 [
656 ("Content-Type", "application/json");
657 ("Authorization", auth)
658 ]
659 | (_, _, Some token) ->
660 let auth = "Bearer " ^ token in
661 let redacted_token = redact_token token in
662 Logs.info (fun m -> m "Session using Bearer auth: %s" ("Bearer " ^ redacted_token));
663 [
664 ("Content-Type", "application/json");
665 ("Authorization", auth)
666 ]
667 | _ -> [("Content-Type", "application/json")]
668 in
669
670 let* result = make_http_request ~method_:"GET" ~headers ~body:"" uri in
671 match result with
672 | Ok response_body ->
673 (match parse_json_string response_body with
674 | Ok json ->
675 Logs.debug (fun m -> m "Successfully parsed session response");
676 Lwt.return (parse_session_object json)
677 | Error e ->
678 let msg = match e with Parse_error m -> m | _ -> "unknown error" in
679 Logs.err (fun m -> m "Failed to parse session response: %s" msg);
680 Lwt.return (Error e))
681 | Error e ->
682 let err_msg = match e with
683 | Connection_error msg -> "Connection error: " ^ msg
684 | HTTP_error (code, _) -> Printf.sprintf "HTTP error %d" code
685 | Parse_error msg -> "Parse error: " ^ msg
686 | Authentication_error -> "Authentication error"
687 in
688 Logs.err (fun m -> m "Failed to get session: %s" err_msg);
689 Lwt.return (Error e)
690
691 (** Upload a binary blob to the server
692
693 TODO:claude *)
694 let upload_blob config ~account_id ~content_type data =
695 let upload_url_template = config.api_uri |> Uri.to_string in
696 (* Replace {accountId} with the actual account ID *)
697 let upload_url = Str.global_replace (Str.regexp "{accountId}") account_id upload_url_template in
698 let upload_uri = Uri.of_string upload_url in
699
700 let headers = [
701 ("Content-Type", content_type);
702 ("Content-Length", string_of_int (String.length data));
703 ("Authorization", "Basic " ^ Base64.encode_string (config.username ^ ":" ^ config.authentication_token))
704 ] in
705
706 let* result = make_http_request ~method_:"POST" ~headers ~body:data upload_uri in
707 match result with
708 | Ok response_body ->
709 (match parse_json_string response_body with
710 | Ok json ->
711 (try
712 let account_id = Ezjsonm.get_string (Ezjsonm.find json ["accountId"]) in
713 let blob_id = Ezjsonm.get_string (Ezjsonm.find json ["blobId"]) in
714 let type_ = Ezjsonm.get_string (Ezjsonm.find json ["type"]) in
715 let size = Ezjsonm.get_int (Ezjsonm.find json ["size"]) in
716 Lwt.return (Ok { account_id; blob_id; type_; size })
717 with
718 | Not_found -> Lwt.return (Error (Parse_error "Required field not found in upload response"))
719 | e -> Lwt.return (Error (Parse_error (Printexc.to_string e))))
720 | Error e -> Lwt.return (Error e))
721 | Error e -> Lwt.return (Error e)
722
723 (** Download a binary blob from the server
724
725 TODO:claude *)
726 let download_blob config ~account_id ~blob_id ?type_ ?name () =
727 let download_url_template = config.api_uri |> Uri.to_string in
728
729 (* Replace template variables with actual values *)
730 let url = Str.global_replace (Str.regexp "{accountId}") account_id download_url_template in
731 let url = Str.global_replace (Str.regexp "{blobId}") blob_id url in
732
733 let url = match type_ with
734 | Some t -> Str.global_replace (Str.regexp "{type}") (Uri.pct_encode t) url
735 | None -> Str.global_replace (Str.regexp "{type}") "" url
736 in
737
738 let url = match name with
739 | Some n -> Str.global_replace (Str.regexp "{name}") (Uri.pct_encode n) url
740 | None -> Str.global_replace (Str.regexp "{name}") "file" url
741 in
742
743 let download_uri = Uri.of_string url in
744
745 let headers = [
746 ("Authorization", "Basic " ^ Base64.encode_string (config.username ^ ":" ^ config.authentication_token))
747 ] in
748
749 let* result = make_http_request ~method_:"GET" ~headers ~body:"" download_uri in
750 Lwt.return result
751end