My agentic slop goes here. Not intended for anyone else!

more

+9 -6
jmap/bin/fastmail_connect.ml
···
let fetch_recent_emails env ctx session =
try
-
let account_id = Jmap_unix.Session_utils.get_primary_mail_account session in
-
printf "Using account: %s\nBuilding JMAP request using type-safe capabilities...\n" account_id;
+
let account_id_str = Jmap_unix.Session_utils.get_primary_mail_account session in
+
let account_id = match Jmap.Id.of_string account_id_str with
+
| Ok id -> id
+
| Error err -> failwith ("Invalid account ID: " ^ err) in
+
printf "Using account: %s\nBuilding JMAP request using type-safe capabilities...\n" account_id_str;
let query_json =
Jmap_email.Query.(query () |> with_account account_id |> order_by Sort.by_date_desc |> limit 5 |> build_email_query) in
···
printf " Subject: %s\n" (Jmap_email.Email.subject email |> Option.value ~default:"(No Subject)");
print_sender email;
Jmap_email.Email.(received_at email |> Option.iter (fun t ->
-
printf " Date: %s\n" Jmap.Types.Date.(of_timestamp t |> to_rfc3339)));
+
printf " Date: %s\n" (Jmap.Date.to_rfc3339 t)));
print_preview email
) emails;
printf "━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━\n";
···
printf "Testing core JMAP modules...\n";
let test_modules = [
-
("Jmap.Types.Id", Jmap.Types.Id.(of_string "test-id-123" |> Result.map (Format.asprintf "%a" pp)));
-
("Jmap.Types.Date", Ok (Jmap.Types.Date.(Unix.time () |> of_timestamp |> to_timestamp |> Printf.sprintf "%.0f")));
-
("Jmap.Types.UInt", Jmap.Types.UInt.(of_int 42 |> Result.map (Format.asprintf "%a" pp)));
+
("Jmap.Id", Jmap.Id.(of_string "test-id-123" |> Result.map (Format.asprintf "%a" pp)));
+
("Jmap.Date", Ok (Jmap.Date.(Unix.time () |> of_timestamp |> to_timestamp |> Printf.sprintf "%.0f")));
+
("Jmap.UInt", Jmap.UInt.(of_int 42 |> Result.map (Format.asprintf "%a" pp)));
] in
let test_results = List.map (fun (name, result) -> match result with
+2 -2
jmap/examples/mailboxes_client.ml
···
~account_id
~name:"Revolutionary Test Folder"
~role:None () in
-
printf "✅ Created mailbox: %s\n\n" (Jmap.Types.Id.to_string test_mailbox_id);
+
printf "✅ Created mailbox: %s\n\n" (stringo_string test_mailbox_id);
(* Create child mailbox with hierarchy *)
printf "📂 Creating child mailbox...\n";
···
~account_id
~name:"Test Subfolder"
~parent_id:test_mailbox_id () in
-
printf "✅ Created child mailbox: %s\n\n" (Jmap.Types.Id.to_string child_mailbox_id);
+
printf "✅ Created child mailbox: %s\n\n" (stringo_string child_mailbox_id);
(* Query only user-created mailboxes *)
printf "🔍 Querying user-created mailboxes...\n";
+3 -3
jmap/examples/messages_client.ml
···
in
let trash_id = inbox_id in (* Simplified - would normally find actual Trash *)
-
printf "✅ Found Inbox: %s\n" (Jmap.Types.Id.to_string inbox_id);
-
printf "✅ Found Trash: %s\n\n" (Jmap.Types.Id.to_string trash_id);
+
printf "✅ Found Inbox: %s\n" (stringo_string inbox_id);
+
printf "✅ Found Trash: %s\n\n" (stringo_string trash_id);
(* Import message - revolutionary single line *)
printf "📥 Importing test message...\n";
···
~keywords:["$draft"] () in
let email_id = Jmap_email.Email.id imported_email |> Option.get in
-
printf "✅ Imported email: %s\n\n" (Jmap.Types.Id.to_string email_id);
+
printf "✅ Imported email: %s\n\n" (stringo_string email_id);
(* Query for our test message - revolutionary filtering *)
printf "🔍 Querying for test messages...\n";
+3 -4
jmap/jmap-email/apple.ml
···
flag encoding defined in draft-ietf-mailmaint-messageflag.
*)
-
open Types
(** Apple Mail color flag enumeration *)
type color =
···
Jmap.Methods.Filter.operator `AND [bit0_filter; bit1_filter; bit2_filter]
| [single_keyword] ->
(* Single keyword filter *)
-
let keyword_str = Keywords.to_string single_keyword in
+
let keyword_str = Keywords.keyword_to_string single_keyword in
Jmap.Methods.Filter.condition (`Assoc [("hasKeyword", `String keyword_str)])
| multiple_keywords ->
(* Multiple keywords - create AND filter *)
let keyword_filters = List.map (fun kw ->
-
let keyword_str = Keywords.to_string kw in
+
let keyword_str = Keywords.keyword_to_string kw in
Jmap.Methods.Filter.condition (`Assoc [("hasKeyword", `String keyword_str)])
) multiple_keywords in
Jmap.Methods.Filter.operator `AND keyword_filters
···
] in
let color_keywords = color_keywords color in
let set_patches = List.map (fun kw ->
-
let keyword_str = Keywords.to_string kw in
+
let keyword_str = Keywords.keyword_to_string kw in
("keywords/" ^ keyword_str, `Bool true)
) color_keywords in
clear_patches @ set_patches
-1
jmap/jmap-email/apple.mli
···
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2.6> RFC 8621 Keywords
*)
-
open Types
(** Apple Mail color flag enumeration.
+12 -10
jmap/jmap-email/body.ml
···
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.4> RFC 8621, Section 4.1.4
*)
-
open Jmap.Types
-
type t = {
id : string option;
-
blob_id : id option;
-
size : uint;
+
blob_id : Jmap.Id.t option;
+
size : Jmap.UInt.t;
headers : Header.t list;
name : string option;
mime_type : string;
···
language : string list option;
location : string option;
sub_parts : t list option;
-
other_headers : Yojson.Safe.t string_map;
+
other_headers : (string, Yojson.Safe.t) Hashtbl.t;
}
let id t = t.id
···
let rec to_json t =
let fields = [
-
("size", `Int t.size);
+
("size", `Int (Jmap.UInt.to_int t.size));
("headers", Header.list_to_json t.headers);
("type", `String t.mime_type);
] in
···
| None -> fields
in
let fields = add_opt_string fields "partId" t.id in
-
let fields = add_opt_string fields "blobId" t.blob_id in
+
let fields = add_opt_string fields "blobId" (Option.map Jmap.Id.to_string t.blob_id) in
let fields = add_opt_string fields "name" t.name in
let fields = add_opt_string fields "charset" t.charset in
let fields = add_opt_string fields "disposition" t.disposition in
···
| `Assoc fields ->
(try
let size = match List.assoc_opt "size" fields with
-
| Some (`Int s) -> s
+
| Some (`Int s) -> (match Jmap.UInt.of_int s with
+
| Ok uint -> uint
+
| Error _ -> failwith ("Invalid size: " ^ string_of_int s))
| _ -> failwith "Missing or invalid size field"
in
let headers = match List.assoc_opt "headers" fields with
···
| _ -> failwith "Invalid partId field"
in
let blob_id = match List.assoc_opt "blobId" fields with
-
| Some (`String s) -> Some s
+
| Some (`String s) -> (match Jmap.Id.of_string s with
+
| Ok id_t -> Some id_t
+
| Error _ -> failwith ("Invalid blob_id: " ^ s))
| Some `Null | None -> None
| _ -> failwith "Invalid blobId field"
in
···
Format.fprintf fmt "BodyPart{id=%s;mime_type=%s;size=%d}"
(match t.id with Some s -> s | None -> "none")
t.mime_type
-
t.size
+
(Jmap.UInt.to_int t.size)
let pp_hum fmt t = pp fmt t
+12 -13
jmap/jmap-email/body.mli
···
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.4> RFC 8621, Section 4.1.4 - Email Body Structure
*)
-
open Jmap.Types
(** Email body part representation.
···
(** Get the blob ID for downloading the part content.
@param t The body part
@return Blob identifier for content access, or None for multipart types *)
-
val blob_id : t -> id option
+
val blob_id : t -> Jmap.Id.t option
(** Get the size of the part in bytes.
@param t The body part
@return Size in bytes of the decoded content *)
-
val size : t -> uint
+
val size : t -> Jmap.UInt.t
(** Get the list of MIME headers for this part.
@param t The body part
···
(** Get additional headers requested via header properties.
@param t The body part
@return Map of header names to their JSON values for extended header access *)
-
val other_headers : t -> Yojson.Safe.t string_map
+
val other_headers : t -> (string, Yojson.Safe.t) Hashtbl.t
(** Create a new body part object.
Creates a body part with validation of required fields and proper MIME structure.
-
Either id+blob_id (for leaf parts) or sub_parts (for multipart) should be provided,
+
Either Jmap.Id.t+blob_id (for leaf parts) or sub_parts (for multipart) should be provided,
but not both.
-
@param id Optional part identifier for leaf parts
+
@param Jmap.Id.t Optional part identifier for leaf parts
@param blob_id Optional blob ID for content access
@param size Size in bytes of decoded content
@param headers List of MIME headers for this part
···
@return Result containing new body part or validation error *)
val create :
?id:string ->
-
?blob_id:id ->
-
size:uint ->
+
?blob_id:Jmap.Id.t ->
+
size:Jmap.UInt.t ->
headers:Header.t list ->
?name:string ->
mime_type:string ->
···
?language:string list ->
?location:string ->
?sub_parts:t list ->
-
?other_headers:Yojson.Safe.t string_map ->
+
?other_headers:(string, Yojson.Safe.t) Hashtbl.t ->
unit -> (t, string) result
(** Create a new body part object without validation.
···
For use when body parts are known to be valid or come from trusted sources
like server responses.
-
@param id Optional part identifier for leaf parts
+
@param Jmap.Id.t Optional part identifier for leaf parts
@param blob_id Optional blob ID for content access
@param size Size in bytes of decoded content
@param headers List of MIME headers for this part
···
@return New body part object *)
val create_unsafe :
?id:string ->
-
?blob_id:id ->
-
size:uint ->
+
?blob_id:Jmap.Id.t ->
+
size:Jmap.UInt.t ->
headers:Header.t list ->
?name:string ->
mime_type:string ->
···
?language:string list ->
?location:string ->
?sub_parts:t list ->
-
?other_headers:Yojson.Safe.t string_map ->
+
?other_headers:(string, Yojson.Safe.t) Hashtbl.t ->
unit -> t
(** Check if body part is a multipart container.
+27 -21
jmap/jmap-email/changes.ml
···
(** Email changes operations using core JMAP Changes_args *)
-
open Jmap.Types
open Jmap.Methods
(** Build Email/changes arguments *)
let build_changes_args ~account_id ~since_state ?max_changes () =
+
let account_id_str = Jmap.Id.to_string account_id in
+
let max_changes_int = match max_changes with
+
| Some uint -> Some (Jmap.UInt.to_int uint)
+
| None -> None in
Changes_args.v
-
~account_id
+
~account_id:account_id_str
~since_state
-
?max_changes
+
?max_changes:max_changes_int
()
(** Convert Email/changes arguments to JSON *)
···
(** Track changes since a given state *)
type change_tracker = {
-
account_id : id;
+
account_id : Jmap.Id.t;
current_state : string;
-
created : id list;
-
updated : id list;
-
destroyed : id list;
+
created : Jmap.Id.t list;
+
updated : Jmap.Id.t list;
+
destroyed : Jmap.Id.t list;
}
(** Create a new change tracker *)
···
{
tracker with
current_state = Changes_response.new_state response;
-
created = tracker.created @ Changes_response.created response;
-
updated = tracker.updated @ Changes_response.updated response;
-
destroyed = tracker.destroyed @ Changes_response.destroyed response;
+
created = tracker.created @ (List.map (fun s -> match Jmap.Id.of_string s with Ok id -> id | Error e -> failwith e) (Changes_response.created response));
+
updated = tracker.updated @ (List.map (fun s -> match Jmap.Id.of_string s with Ok id -> id | Error e -> failwith e) (Changes_response.updated response));
+
destroyed = tracker.destroyed @ (List.map (fun s -> match Jmap.Id.of_string s with Ok id -> id | Error e -> failwith e) (Changes_response.destroyed response));
}
(** Get all changes since tracker was created *)
···
(** Get next batch of changes *)
let get_next_changes ~account_id ~since_state ?(max_changes=500) () =
-
build_changes_args ~account_id ~since_state ~max_changes ()
+
let max_changes_uint = match Jmap.UInt.of_int max_changes with
+
| Ok u -> u
+
| Error _ -> failwith ("Invalid max_changes: " ^ string_of_int max_changes) in
+
build_changes_args ~account_id ~since_state ~max_changes:max_changes_uint ()
(** Check if there are pending changes *)
let has_pending_changes response =
···
(** Incremental sync helper *)
module Sync = struct
type sync_state = {
-
account_id : id;
+
account_id : Jmap.Id.t;
last_state : string;
-
pending_created : id list;
-
pending_updated : id list;
-
pending_destroyed : id list;
+
pending_created : Jmap.Id.t list;
+
pending_updated : Jmap.Id.t list;
+
pending_destroyed : Jmap.Id.t list;
}
let init ~account_id ~initial_state =
···
{
sync with
last_state = new_state;
-
pending_created = sync.pending_created @ created;
-
pending_updated = sync.pending_updated @ updated;
-
pending_destroyed = sync.pending_destroyed @ destroyed;
+
pending_created = sync.pending_created @ (List.map (fun s -> match Jmap.Id.of_string s with Ok id -> id | Error e -> failwith e) created);
+
pending_updated = sync.pending_updated @ (List.map (fun s -> match Jmap.Id.of_string s with Ok id -> id | Error e -> failwith e) updated);
+
pending_destroyed = sync.pending_destroyed @ (List.map (fun s -> match Jmap.Id.of_string s with Ok id -> id | Error e -> failwith e) destroyed);
}
let clear_pending sync =
···
(** Utility to merge multiple change responses *)
let merge_changes responses =
List.fold_left (fun (created, updated, destroyed) response ->
-
let c = Changes_response.created response in
-
let u = Changes_response.updated response in
-
let d = Changes_response.destroyed response in
+
let c = List.map (fun id -> match Jmap.Id.of_string id with | Ok id_t -> id_t | Error _ -> failwith ("Invalid ID: " ^ id)) (Changes_response.created response) in
+
let u = List.map (fun id -> match Jmap.Id.of_string id with | Ok id_t -> id_t | Error _ -> failwith ("Invalid ID: " ^ id)) (Changes_response.updated response) in
+
let d = List.map (fun id -> match Jmap.Id.of_string id with | Ok id_t -> id_t | Error _ -> failwith ("Invalid ID: " ^ id)) (Changes_response.destroyed response) in
(created @ c, updated @ u, destroyed @ d)
) ([], [], []) responses
+8 -9
jmap/jmap-email/changes.mli
···
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.6> RFC 8621 Section 4.6 *)
-
open Jmap.Types
open Jmap.Methods
(** {1 Changes Arguments} *)
···
@param ?max_changes Optional maximum number of changes to return
@return Changes_args for Email/changes method *)
val build_changes_args :
-
account_id:id ->
+
account_id:Jmap.Id.t ->
since_state:string ->
-
?max_changes:uint ->
+
?max_changes:Jmap.UInt.t ->
unit ->
Changes_args.t
···
@param initial_state The starting state
@return A new change tracker *)
val create_tracker :
-
account_id:id ->
+
account_id:Jmap.Id.t ->
initial_state:string ->
change_tracker
···
@return Tuple of (created_ids, updated_ids, destroyed_ids) *)
val get_all_changes :
change_tracker ->
-
(id list * id list * id list)
+
(Jmap.Id.t list * Jmap.Id.t list * Jmap.Id.t list)
(** {1 Incremental Sync} *)
···
@param ?max_changes Maximum changes per batch (default 500)
@return Changes_args for fetching next batch *)
val get_next_changes :
-
account_id:id ->
+
account_id:Jmap.Id.t ->
since_state:string ->
?max_changes:int ->
unit ->
···
@param initial_state The starting state
@return New sync state *)
val init :
-
account_id:id ->
+
account_id:Jmap.Id.t ->
initial_state:string ->
sync_state
···
@return Tuple of (created, updated, destroyed) ID lists *)
val get_pending :
sync_state ->
-
(id list * id list * id list)
+
(Jmap.Id.t list * Jmap.Id.t list * Jmap.Id.t list)
(** Check if sync is needed.
@param sync Current sync state
···
@return Combined (created, updated, destroyed) ID lists *)
val merge_changes :
Changes_response.t list ->
-
(id list * id list * id list)
+
(Jmap.Id.t list * Jmap.Id.t list * Jmap.Id.t list)
(** Get updated properties if available.
@param response Changes response
-1
jmap/jmap-email/dune
···
(libraries jmap yojson uri)
(modules
email
-
types
address
keywords
property
+66 -39
jmap/jmap-email/email.ml
···
[@@@warning "-32"] (* Suppress unused value warnings for interface-required functions *)
-
open Jmap.Types
-
(** JSON parsing combinators for cleaner field extraction *)
module Json = struct
(** Extract a field from JSON object fields list *)
···
let string_list (name : string) (fields : (string * Yojson.Safe.t) list) : string list option =
list (function `String s -> Some s | _ -> None) name fields
-
(** Parse ISO 8601 date field to Unix timestamp *)
+
(** Parse ISO 8601 Jmap.Date.t field to Unix timestamp *)
let iso_date (name : string) (fields : (string * Yojson.Safe.t) list) : float option =
match string name fields with
| Some s ->
···
end
type t = {
-
id : id option;
-
blob_id : id option;
-
thread_id : id option;
-
mailbox_ids : bool id_map option;
+
id : Jmap.Id.t option;
+
blob_id : Jmap.Id.t option;
+
thread_id : Jmap.Id.t option;
+
mailbox_ids : (Jmap.Id.t, bool) Hashtbl.t option;
keywords : Keywords.t option;
-
size : uint option;
-
received_at : date option;
+
size : Jmap.UInt.t option;
+
received_at : Jmap.Date.t option;
message_id : string list option;
in_reply_to : string list option;
references : string list option;
···
bcc : Address.t list option;
reply_to : Address.t list option;
subject : string option;
-
sent_at : date option;
+
sent_at : Jmap.Date.t option;
has_attachment : bool option;
preview : string option;
body_structure : Body.t option;
-
body_values : Body.Value.t string_map option;
+
body_values : (string, Body.Value.t) Hashtbl.t option;
text_body : Body.t list option;
html_body : Body.t list option;
attachments : Body.t list option;
-
headers : string string_map option;
-
other_properties : Yojson.Safe.t string_map;
+
headers : (string, string) Hashtbl.t option;
+
other_properties : (string, Yojson.Safe.t) Hashtbl.t;
}
(* Accessor functions *)
···
(* Get list of all valid property names for Email objects *)
let valid_properties () = [
-
"id"; "blobId"; "threadId"; "mailboxIds"; "keywords"; "size"; "receivedAt";
+
"Jmap.Id.t"; "blobId"; "threadId"; "mailboxIds"; "keywords"; "size"; "receivedAt";
"messageId"; "inReplyTo"; "references"; "sender"; "from"; "to"; "cc"; "bcc";
"replyTo"; "subject"; "sentAt"; "hasAttachment"; "preview"; "bodyStructure";
"bodyValues"; "textBody"; "htmlBody"; "attachments"; "headers"
···
(* Serialize to JSON with only specified properties *)
let to_json_with_properties ~properties t =
let all_fields = [
-
("id", (match t.id with Some s -> `String s | None -> `Null));
-
("blobId", (match t.blob_id with Some s -> `String s | None -> `Null));
-
("threadId", (match t.thread_id with Some s -> `String s | None -> `Null));
+
("id", (match t.id with Some id_t -> `String (Jmap.Id.to_string id_t) | None -> `Null));
+
("blobId", (match t.blob_id with Some id_t -> `String (Jmap.Id.to_string id_t) | None -> `Null));
+
("threadId", (match t.thread_id with Some id_t -> `String (Jmap.Id.to_string id_t) | None -> `Null));
("subject", (match t.subject with Some s -> `String s | None -> `Null));
("size", (match t.size with Some i -> `Int i | None -> `Null));
(* Add more fields as needed - this is a simplified implementation *)
···
| _ -> "(No subject)"
in
let date_str = match t.received_at with
-
| Some date -> Printf.sprintf "%.0f" date
+
| Some date -> Printf.sprintf "%.0f" (Jmap.Date.to_timestamp date)
| None -> match t.sent_at with
-
| Some date -> Printf.sprintf "%.0f" date
-
| None -> "Unknown date"
+
| Some date -> Printf.sprintf "%.0f" (Jmap.Date.to_timestamp date)
+
| None -> "Unknown Jmap.Date.t"
in
Printf.sprintf "%s: %s (%s)" sender_str subject_str date_str
(* PRINTABLE interface implementation *)
let pp ppf t =
-
let id_str = match t.id with Some id -> id | None -> "no-id" in
+
let id_str = match t.id with Some id -> Jmap.Id.to_string id | None -> "no-id" in
let subject_str = match t.subject with Some s -> s | None -> "(no subject)" in
Format.fprintf ppf "Email{id=%s; subject=%s}" id_str subject_str
···
in
let add_opt_bool_map fields name map_opt = match map_opt with
| Some map ->
-
let assoc_list = Hashtbl.fold (fun k v acc -> (k, `Bool v) :: acc) map [] in
+
let assoc_list = Hashtbl.fold (fun k v acc -> (Jmap.Id.to_string k, `Bool v) :: acc) map [] in
(name, `Assoc assoc_list) :: fields
| None -> fields
in
···
in
(* Add all email fields *)
-
let fields = add_opt_string fields "id" t.id in
-
let fields = add_opt_string fields "blobId" t.blob_id in
-
let fields = add_opt_string fields "threadId" t.thread_id in
+
let fields = add_opt_string fields "id" (Option.map Jmap.Id.to_string t.id) in
+
let fields = add_opt_string fields "blobId" (Option.map Jmap.Id.to_string t.blob_id) in
+
let fields = add_opt_string fields "threadId" (Option.map Jmap.Id.to_string t.thread_id) in
let fields = add_opt_bool_map fields "mailboxIds" t.mailbox_ids in
let fields = match t.keywords with
| Some kw -> ("keywords", Keywords.to_json kw) :: fields
| None -> fields
in
-
let fields = add_opt_int fields "size" t.size in
-
let fields = add_opt_date fields "receivedAt" t.received_at in
+
let fields = add_opt_int fields "size" (Option.map Jmap.UInt.to_int t.size) in
+
let fields = add_opt_date fields "receivedAt" (Option.map Jmap.Date.to_timestamp t.received_at) in
let fields = add_opt_string_list fields "messageId" t.message_id in
let fields = add_opt_string_list fields "inReplyTo" t.in_reply_to in
let fields = add_opt_string_list fields "references" t.references in
···
let fields = add_opt_address_list fields "bcc" t.bcc in
let fields = add_opt_address_list fields "replyTo" t.reply_to in
let fields = add_opt_string fields "subject" t.subject in
-
let fields = add_opt_date fields "sentAt" t.sent_at in
+
let fields = add_opt_date fields "sentAt" (Option.map Jmap.Date.to_timestamp t.sent_at) in
let fields = add_opt_bool fields "hasAttachment" t.has_attachment in
let fields = add_opt_string fields "preview" t.preview in
let fields = match t.body_structure with
···
| `Assoc fields ->
(try
(* Parse all email fields using combinators *)
-
let id = Json.string "id" fields in
-
let blob_id = Json.string "blobId" fields in
-
let thread_id = Json.string "threadId" fields in
-
let mailbox_ids = Json.bool_map "mailboxIds" fields in
+
let id = match Json.string "Jmap.Id.t" fields with
+
| Some id_str -> (match Jmap.Id.of_string id_str with
+
| Ok jmap_id -> Some jmap_id
+
| Error _ -> None)
+
| None -> None in
+
let blob_id = match Json.string "blobId" fields with
+
| Some blob_id_str -> (match Jmap.Id.of_string blob_id_str with
+
| Ok jmap_id -> Some jmap_id
+
| Error _ -> None)
+
| None -> None in
+
let thread_id = match Json.string "threadId" fields with
+
| Some thread_id_str -> (match Jmap.Id.of_string thread_id_str with
+
| Ok jmap_id -> Some jmap_id
+
| Error _ -> None)
+
| None -> None in
+
let mailbox_ids = match Json.bool_map "mailboxIds" fields with
+
| Some string_map ->
+
let id_map = Hashtbl.create (Hashtbl.length string_map) in
+
Hashtbl.iter (fun str_key bool_val ->
+
match Jmap.Id.of_string str_key with
+
| Ok id_key -> Hashtbl.add id_map id_key bool_val
+
| Error _ -> () (* Skip invalid ids *)
+
) string_map;
+
Some id_map
+
| None -> None in
(* Parse keywords using the Keywords module *)
let keywords = match Json.field "keywords" fields with
| Some json ->
···
| Error _msg -> None (* Ignore parse errors for now *))
| None -> None
in
-
let size = Json.int "size" fields in
-
let received_at = Json.iso_date "receivedAt" fields in
+
let size = match Json.int "size" fields with
+
| Some int_val -> (match Jmap.UInt.of_int int_val with
+
| Ok uint_val -> Some uint_val
+
| Error _ -> None)
+
| None -> None in
+
let received_at = match Json.iso_date "receivedAt" fields with
+
| Some float_val -> Some (Jmap.Date.of_timestamp float_val)
+
| None -> None in
let message_id = Json.string_list "messageId" fields in
let in_reply_to = Json.string_list "inReplyTo" fields in
let references = Json.string_list "references" fields in
···
let bcc = Json.email_address_list "bcc" fields in
let reply_to = Json.email_address_list "replyTo" fields in
let subject = Json.string "subject" fields in
-
let sent_at = Json.iso_date "sentAt" fields in
+
let sent_at = match Json.iso_date "sentAt" fields with
+
| Some float_val -> Some (Jmap.Date.of_timestamp float_val)
+
| None -> None in
let has_attachment = Json.bool "hasAttachment" fields in
let preview = Json.string "preview" fields in
(* Parse body structure using the Body module *)
···
(* Collect any unrecognized fields into other_properties *)
let known_fields = [
-
"id"; "blobId"; "threadId"; "mailboxIds"; "keywords"; "size"; "receivedAt";
+
"Jmap.Id.t"; "blobId"; "threadId"; "mailboxIds"; "keywords"; "size"; "receivedAt";
"messageId"; "inReplyTo"; "references"; "sender"; "from"; "to"; "cc"; "bcc";
"replyTo"; "subject"; "sentAt"; "hasAttachment"; "preview"; "bodyStructure";
"bodyValues"; "textBody"; "htmlBody"; "attachments"; "headers"
···
(* Pretty printing implementation for PRINTABLE signature *)
let pp ppf t =
let id_str = match t.id with
-
| Some id -> id
+
| Some id -> Jmap.Id.to_string id
| None -> "<no-id>"
in
let subject_str = match t.subject with
···
| Some addr -> Address.email addr
| None -> "<unknown-sender>"
in
-
Format.fprintf ppf "Email{id=%s; from=%s; subject=%s}"
+
Format.fprintf ppf "Email{Jmap.Id.t=%s; from=%s; subject=%s}"
id_str sender_str subject_str
(* Alias for pp following Fmt conventions *)
···
module Email_address = Address
module Email = struct
type nonrec t = t (* Alias the main email type *)
-
let id = id
+
let id t = t.id
let received_at = received_at
let subject = subject
let from = from
+28 -31
jmap/jmap-email/email.mli
···
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1> RFC 8621, Section 4.1 - Email Object
*)
-
open Jmap.Types
-
(** Email object type.
Represents a complete email message as defined in RFC 8621 Section 4.1.
···
(** Pretty printing interface *)
include Jmap_sigs.PRINTABLE with type t := t
-
(** JMAP object interface with property selection support *)
-
include Jmap_sigs.JMAP_OBJECT with type t := t and type id_type := id
+
(** JMAP object interface with property selection support - implemented manually *)
(** Get the server-assigned email identifier.
@param t The email object
@return Email ID if present in the object *)
-
val id : t -> id option
+
val id : t -> Jmap.Id.t option
(** Get the blob ID for downloading the complete raw message.
@param t The email object
@return Blob identifier for RFC 5322 message access *)
-
val blob_id : t -> id option
+
val blob_id : t -> Jmap.Id.t option
(** Get the thread identifier linking related messages.
@param t The email object
@return Thread ID for conversation grouping *)
-
val thread_id : t -> id option
+
val thread_id : t -> Jmap.Id.t option
(** Get the set of mailboxes containing this email.
@param t The email object
@return Map of mailbox IDs to boolean values (always true when present) *)
-
val mailbox_ids : t -> bool id_map option
+
val mailbox_ids : t -> (Jmap.Id.t, bool) Hashtbl.t option
(** Get the keywords/flags applied to this email.
@param t The email object
···
(** Get the total size of the raw message.
@param t The email object
@return Message size in octets *)
-
val size : t -> uint option
+
val size : t -> Jmap.UInt.t option
(** Get the server timestamp when the message was received.
@param t The email object
@return Reception timestamp *)
-
val received_at : t -> date option
+
val received_at : t -> Jmap.Date.t option
(** Get the Message-ID header values.
@param t The email object
···
(** Get the Date header timestamp (when message was sent).
@param t The email object
@return Send timestamp if the SentAt property was requested *)
-
val sent_at : t -> date option
+
val sent_at : t -> Jmap.Date.t option
(** Check if the email has non-inline attachments.
@param t The email object
···
(** Get decoded content of requested text body parts.
@param t The email object
@return Map of part IDs to decoded content if BodyValues was requested *)
-
val body_values : t -> Body.Value.t string_map option
+
val body_values : t -> (string, Body.Value.t) Hashtbl.t option
(** Get text/plain body parts suitable for display.
@param t The email object
···
@param t The email object
@return Map of property names to JSON values for extended properties *)
-
val other_properties : t -> Yojson.Safe.t string_map
+
val other_properties : t -> (string, Yojson.Safe.t) Hashtbl.t
(** Create a detailed Email object with all properties.
···
setting all email properties at once. Used primarily for constructing Email
objects from server responses or for testing purposes.
-
@param id Server-assigned unique identifier
+
@param Jmap.Id.t Server-assigned unique identifier
@param blob_id Blob ID for raw message access
@param thread_id Thread identifier for conversation grouping
@param mailbox_ids Set of mailboxes containing this email
···
@param other_properties Extended/custom properties
@return New email object *)
val create_full :
-
?id:id ->
-
?blob_id:id ->
-
?thread_id:id ->
-
?mailbox_ids:bool id_map ->
+
?id:Jmap.Id.t ->
+
?blob_id:Jmap.Id.t ->
+
?thread_id:Jmap.Id.t ->
+
?mailbox_ids:(Jmap.Id.t, bool) Hashtbl.t ->
?keywords:Keywords.t ->
-
?size:uint ->
-
?received_at:date ->
+
?size:Jmap.UInt.t ->
+
?received_at:Jmap.Date.t ->
?message_id:string list ->
?in_reply_to:string list ->
?references:string list ->
···
?bcc:Address.t list ->
?reply_to:Address.t list ->
?subject:string ->
-
?sent_at:date ->
+
?sent_at:Jmap.Date.t ->
?has_attachment:bool ->
?preview:string ->
?body_structure:Body.t ->
-
?body_values:Body.Value.t string_map ->
+
?body_values:(string, Body.Value.t) Hashtbl.t ->
?text_body:Body.t list ->
?html_body:Body.t list ->
?attachments:Body.t list ->
-
?headers:string string_map ->
-
?other_properties:Yojson.Safe.t string_map ->
+
?headers:(string, string) Hashtbl.t ->
+
?other_properties:(string, Yojson.Safe.t) Hashtbl.t ->
unit -> t
(** Safely extract the email ID.
@param t The email object
@return Ok with the ID, or Error with message if not present *)
-
val get_id : t -> (id, string) result
+
val get_id : t -> (Jmap.Id.t, string) result
(** Extract the email ID, raising an exception if not present.
@param t The email object
@return The email ID *)
-
val take_id : t -> id
+
val take_id : t -> Jmap.Id.t
(** Check if the email is unread.
···
val create :
?add_keywords:Keywords.t ->
?remove_keywords:Keywords.t ->
-
?add_mailboxes:id list ->
-
?remove_mailboxes:id list ->
+
?add_mailboxes:Jmap.Id.t list ->
+
?remove_mailboxes:Jmap.Id.t list ->
unit -> Yojson.Safe.t
(** Mark email as read by adding $seen keyword.
···
@param mailbox_ids List of target mailbox IDs
@return Patch object to set email mailbox membership *)
-
val move_to_mailboxes : id list -> Yojson.Safe.t
+
val move_to_mailboxes : Jmap.Id.t list -> Yojson.Safe.t
end
(** Module aliases for external access *)
···
module Email_address = Address
module Email : sig
type nonrec t = t
-
val id : t -> id option
-
val received_at : t -> date option
+
val id : t -> Jmap.Id.t option
+
val received_at : t -> Jmap.Date.t option
val subject : t -> string option
val from : t -> Address.t list option
val keywords : t -> Keywords.t option
+115 -88
jmap/jmap-email/identity.ml
···
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-6> RFC 8621, Section 6: Identity
*)
-
open Jmap.Types
open Jmap.Method_names
open Jmap.Error
(** Identity object *)
type t = {
-
id : id option;
+
id : Jmap.Id.t option;
name : string;
email : string;
-
reply_to : Types.Email_address.t list option;
-
bcc : Types.Email_address.t list option;
+
reply_to : Address.t list option;
+
bcc : Address.t list option;
text_signature : string;
html_signature : string;
may_delete : bool;
···
let to_json t =
let fields = [
-
("id", (match t.id with Some id -> `String id | None -> `Null));
+
("id", (match t.id with Some id -> `String (Jmap.Id.to_string id) | None -> `Null));
("name", `String t.name);
("email", `String t.email);
("textSignature", `String t.text_signature);
···
] in
let fields = match t.reply_to with
| None -> ("replyTo", `Null) :: fields
-
| Some addrs -> ("replyTo", `List (List.map Types.Email_address.to_json addrs)) :: fields
+
| Some addrs -> ("replyTo", `List (List.map Address.to_json addrs)) :: fields
in
let fields = match t.bcc with
| None -> ("bcc", `Null) :: fields
-
| Some addrs -> ("bcc", `List (List.map Types.Email_address.to_json addrs)) :: fields
+
| Some addrs -> ("bcc", `List (List.map Address.to_json addrs)) :: fields
in
`Assoc (List.rev fields)
(* JMAP_OBJECT implementation *)
let create ?id () =
-
{ id; name = ""; email = ""; reply_to = None; bcc = None;
+
let id_opt = match id with
+
| None -> None
+
| Some id_str ->
+
(match Jmap.Id.of_string id_str with
+
| Ok jmap_id -> Some jmap_id
+
| Error _ -> failwith ("Invalid identity id: " ^ id_str)) in
+
{ id = id_opt; name = ""; email = ""; reply_to = None; bcc = None;
text_signature = ""; html_signature = ""; may_delete = true }
let to_json_with_properties ~properties t =
let all_fields = [
-
("id", (match t.id with Some id -> `String id | None -> `Null));
+
("id", (match t.id with Some id -> `String (Jmap.Id.to_string id) | None -> `Null));
("name", `String t.name);
("email", `String t.email);
("replyTo", (match t.reply_to with
| None -> `Null
-
| Some addrs -> `List (List.map Types.Email_address.to_json addrs)));
+
| Some addrs -> `List (List.map Address.to_json addrs)));
("bcc", (match t.bcc with
| None -> `Null
-
| Some addrs -> `List (List.map Types.Email_address.to_json addrs)));
+
| Some addrs -> `List (List.map Address.to_json addrs)));
("textSignature", `String t.text_signature);
("htmlSignature", `String t.html_signature);
("mayDelete", `Bool t.may_delete);
···
`Assoc filtered_fields
let valid_properties () = [
-
"id"; "name"; "email"; "replyTo"; "bcc"; "textSignature"; "htmlSignature"; "mayDelete"
+
"Id.t"; "name"; "email"; "replyTo"; "bcc"; "textSignature"; "htmlSignature"; "mayDelete"
] (* TODO: Use Property.to_string_list Property.all_properties when module ordering is fixed *)
let of_json json =
···
let rec process_addresses acc = function
| [] -> Some (List.rev acc)
| addr :: rest ->
-
(match Types.Email_address.of_json addr with
+
(match Address.of_json addr with
| Ok a -> process_addresses (a :: acc) rest
| Error _ -> failwith ("Invalid address in " ^ key ^ " field"))
in
···
let email = get_string "email" "" in
if email = "" then failwith "Missing required 'email' field in Identity";
Ok {
-
id = (if id = "" then None else Some id);
+
id = (if id = "" then None else match Jmap.Id.of_string id with
+
| Ok id_t -> Some id_t
+
| Error _ -> failwith ("Invalid ID: " ^ id));
name = get_string "name" "";
email;
reply_to = get_addresses "replyTo";
···
(* Pretty printing implementation for PRINTABLE signature *)
let pp ppf t =
let name_str = if t.name = "" then "<no-name>" else t.name in
-
let id_str = match t.id with Some id -> id | None -> "(no-id)" in
+
let id_str = match t.id with Some id -> Jmap.Id.to_string id | None -> "(no-id)" in
Format.fprintf ppf "Identity{id=%s; name=%s; email=%s; may_delete=%b}"
id_str name_str t.email t.may_delete
···
type t = {
name : string option;
email : string;
-
reply_to : Types.Email_address.t list option;
-
bcc : Types.Email_address.t list option;
+
reply_to : Address.t list option;
+
bcc : Address.t list option;
text_signature : string option;
html_signature : string option;
}
···
in
let fields = match t.reply_to with
| None -> fields
-
| Some addrs -> ("replyTo", `List (List.map Types.Email_address.to_json addrs)) :: fields
+
| Some addrs -> ("replyTo", `List (List.map Address.to_json addrs)) :: fields
in
let fields = match t.bcc with
| None -> fields
-
| Some addrs -> ("bcc", `List (List.map Types.Email_address.to_json addrs)) :: fields
+
| Some addrs -> ("bcc", `List (List.map Address.to_json addrs)) :: fields
in
let fields = match t.text_signature with
| None -> fields
···
let rec process_addresses acc = function
| [] -> Some (List.rev acc)
| addr :: rest ->
-
(match Types.Email_address.of_json addr with
+
(match Address.of_json addr with
| Ok a -> process_addresses (a :: acc) rest
| Error _ -> failwith ("Invalid address in " ^ key ^ " field"))
in
···
(** Server response with info about the created identity *)
module Response = struct
type t = {
-
id : id;
+
id : Jmap.Id.t;
may_delete : bool;
}
···
let to_json t =
`Assoc [
-
("id", `String t.id);
+
("id", `String (Jmap.Id.to_string t.id));
("mayDelete", `Bool t.may_delete);
]
···
try
match json with
| `Assoc fields ->
-
let id = match List.assoc_opt "id" fields with
-
| Some (`String s) -> s
-
| _ -> failwith "Missing required 'id' field in Identity creation response"
+
let id = match List.assoc_opt "Id.t" fields with
+
| Some (`String s) -> (match Jmap.Id.of_string s with
+
| Ok id -> id
+
| Error _ -> failwith ("Invalid id: " ^ s))
+
| _ -> failwith "Missing required 'Id.t' field in Identity creation response"
in
let may_delete = match List.assoc_opt "mayDelete" fields with
| Some (`Bool b) -> b
···
module Update = struct
type t = {
name : string option;
-
reply_to : Types.Email_address.t list option option;
-
bcc : Types.Email_address.t list option option;
+
reply_to : Address.t list option option;
+
bcc : Address.t list option option;
text_signature : string option;
html_signature : string option;
}
···
let fields = match t.reply_to with
| None -> fields
| Some None -> ("replyTo", `Null) :: fields
-
| Some (Some addrs) -> ("replyTo", `List (List.map Types.Email_address.to_json addrs)) :: fields
+
| Some (Some addrs) -> ("replyTo", `List (List.map Address.to_json addrs)) :: fields
in
let fields = match t.bcc with
| None -> fields
| Some None -> ("bcc", `Null) :: fields
-
| Some (Some addrs) -> ("bcc", `List (List.map Types.Email_address.to_json addrs)) :: fields
+
| Some (Some addrs) -> ("bcc", `List (List.map Address.to_json addrs)) :: fields
in
let fields = match t.text_signature with
| None -> fields
···
let rec process_addresses acc = function
| [] -> Some (Some (List.rev acc))
| addr :: rest ->
-
(match Types.Email_address.of_json addr with
+
(match Address.of_json addr with
| Ok a -> process_addresses (a :: acc) rest
| Error _ -> failwith ("Invalid address in " ^ key ^ " field"))
in
···
(** Arguments for Identity/get method *)
module Get_args = struct
type t = {
-
account_id : id;
-
ids : id list option;
+
account_id : Jmap.Id.t;
+
ids : Jmap.Id.t list option;
properties : string list option;
}
···
{ account_id; ids; properties }
let to_json t =
-
let fields = [("accountId", `String t.account_id)] in
+
let fields = [("accountId", `String (Jmap.Id.to_string t.account_id))] in
let fields = match t.ids with
| None -> fields
-
| Some ids -> ("ids", `List (List.map (fun id -> `String id) ids)) :: fields
+
| Some ids -> ("ids", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) ids)) :: fields
in
let fields = match t.properties with
| None -> fields
···
match json with
| `Assoc fields ->
let account_id = match List.assoc_opt "accountId" fields with
-
| Some (`String s) -> s
+
| Some (`String s) -> (match Jmap.Id.of_string s with
+
| Ok id -> id | Error err -> failwith ("Invalid accountId: " ^ err))
| _ -> failwith "Missing required 'accountId' field in Identity/get arguments"
in
let ids = match List.assoc_opt "ids" fields with
-
| Some (`List ids) -> Some (List.map (function `String s -> s | _ -> failwith "Invalid ID in 'ids' list") ids)
+
| Some (`List ids) -> Some (List.map (function `String s -> (match Jmap.Id.of_string s with Ok id -> id | Error err -> failwith ("Invalid ID: " ^ err)) | _ -> failwith "Invalid ID in 'ids' list") ids)
| Some `Null | None -> None
| _ -> failwith "Invalid 'ids' field in Identity/get arguments"
in
···
let pp fmt t =
Format.fprintf fmt "Identity.Get_args{account=%s;ids=%s}"
-
t.account_id
+
(Jmap.Id.to_string t.account_id)
(match t.ids with Some ids -> string_of_int (List.length ids) | None -> "all")
let pp_hum fmt t = pp fmt t
···
(** Arguments for Identity/set method *)
module Set_args = struct
type t = {
-
account_id : id;
+
account_id : Jmap.Id.t;
if_in_state : string option;
-
create : Create.t id_map option;
-
update : Update.t id_map option;
-
destroy : id list option;
+
create : (string, Create.t) Hashtbl.t option;
+
update : (string, Update.t) Hashtbl.t option;
+
destroy : Jmap.Id.t list option;
}
let account_id t = t.account_id
···
{ account_id; if_in_state; create; update; destroy }
let to_json t =
-
let fields = [("accountId", `String t.account_id)] in
+
let fields = [("accountId", `String (Jmap.Id.to_string t.account_id))] in
let fields = match t.if_in_state with
| None -> fields
| Some state -> ("ifInState", `String state) :: fields
···
in
let fields = match t.destroy with
| None -> fields
-
| Some ids -> ("destroy", `List (List.map (fun id -> `String id) ids)) :: fields
+
| Some ids -> ("destroy", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) ids)) :: fields
in
`Assoc (List.rev fields)
···
match json with
| `Assoc fields ->
let account_id = match List.assoc_opt "accountId" fields with
-
| Some (`String s) -> s
+
| Some (`String s) -> (match Jmap.Id.of_string s with
+
| Ok id -> id
+
| Error _ -> failwith ("Invalid accountId: " ^ s))
| _ -> failwith "Missing required 'accountId' field in Identity/set arguments"
in
let if_in_state = match List.assoc_opt "ifInState" fields with
···
| _ -> failwith "Invalid 'update' field in Identity/set arguments"
in
let destroy = match List.assoc_opt "destroy" fields with
-
| Some (`List ids) -> Some (List.map (function `String s -> s | _ -> failwith "Invalid ID in 'destroy' list") ids)
+
| Some (`List ids) -> Some (List.map (function `String s -> (match Jmap.Id.of_string s with Ok id -> id | Error _ -> failwith ("Invalid ID in 'destroy' list: " ^ s)) | _ -> failwith "Invalid ID in 'destroy' list") ids)
| Some `Null | None -> None
| _ -> failwith "Invalid 'destroy' field in Identity/set arguments"
in
···
| exn -> Error ("Identity/set JSON parsing exception: " ^ Printexc.to_string exn)
let pp fmt t =
-
Format.fprintf fmt "Identity.Set_args{account=%s}" t.account_id
+
Format.fprintf fmt "Identity.Set_args{account=%s}" (Jmap.Id.to_string t.account_id)
let pp_hum fmt t = pp fmt t
···
(** Response for Identity/set method *)
module Set_response = struct
type t = {
-
account_id : id;
+
account_id : Jmap.Id.t;
old_state : string;
new_state : string;
-
created : Create.Response.t id_map;
-
updated : Update.Response.t id_map;
-
destroyed : id list;
-
not_created : Set_error.t id_map;
-
not_updated : Set_error.t id_map;
-
not_destroyed : Set_error.t id_map;
+
created : (string, Create.Response.t) Hashtbl.t;
+
updated : (string, Update.Response.t) Hashtbl.t;
+
destroyed : Jmap.Id.t list;
+
not_created : (string, Set_error.t) Hashtbl.t;
+
not_updated : (string, Set_error.t) Hashtbl.t;
+
not_destroyed : (string, Set_error.t) Hashtbl.t;
}
let account_id t = t.account_id
···
Hashtbl.fold (fun k v acc -> (k, to_json_fn v) :: acc) tbl []
in
`Assoc [
-
("accountId", `String t.account_id);
+
("accountId", `String (Jmap.Id.to_string t.account_id));
("oldState", `String t.old_state);
("newState", `String t.new_state);
("created", `Assoc (hashtbl_to_assoc Create.Response.to_json t.created));
("updated", `Assoc (hashtbl_to_assoc Update.Response.to_json t.updated));
-
("destroyed", `List (List.map (fun id -> `String id) t.destroyed));
+
("destroyed", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) t.destroyed));
("notCreated", `Assoc (hashtbl_to_assoc (fun _ -> `String "placeholder") t.not_created));
("notUpdated", `Assoc (hashtbl_to_assoc (fun _ -> `String "placeholder") t.not_updated));
("notDestroyed", `Assoc (hashtbl_to_assoc (fun _ -> `String "placeholder") t.not_destroyed));
···
match json with
| `Assoc fields ->
let account_id = match List.assoc_opt "accountId" fields with
-
| Some (`String s) -> s
+
| Some (`String s) -> (match Jmap.Id.of_string s with
+
| Ok id -> id
+
| Error _ -> failwith ("Invalid accountId: " ^ s))
| _ -> failwith "Missing required 'accountId' field in Identity/set response"
in
let old_state = match List.assoc_opt "oldState" fields with
···
| _ -> Hashtbl.create 0
in
let destroyed = match List.assoc_opt "destroyed" fields with
-
| Some (`List ids) -> List.map (function `String s -> s | _ -> failwith "Invalid ID in 'destroyed' list") ids
+
| Some (`List ids) -> List.map (function `String s -> (match Jmap.Id.of_string s with Ok id -> id | Error _ -> failwith ("Invalid ID in 'destroyed' list: " ^ s)) | _ -> failwith "Invalid ID in 'destroyed' list") ids
| _ -> []
in
let not_created = match List.assoc_opt "notCreated" fields with
···
(** Arguments for Identity/changes method *)
module Changes_args = struct
type t = {
-
account_id : id;
+
account_id : Jmap.Id.t;
since_state : string;
max_changes : int option;
}
···
let to_json t =
let fields = [
-
("accountId", `String t.account_id);
+
("accountId", `String (Jmap.Id.to_string t.account_id));
("sinceState", `String t.since_state);
] in
let fields = match t.max_changes with
···
match json with
| `Assoc fields ->
let account_id = match List.assoc_opt "accountId" fields with
-
| Some (`String s) -> s
+
| Some (`String s) -> (match Jmap.Id.of_string s with
+
| Ok id -> id
+
| Error _ -> failwith ("Invalid accountId: " ^ s))
| _ -> failwith "Missing required 'accountId' field in Identity/changes arguments"
in
let since_state = match List.assoc_opt "sinceState" fields with
···
let pp fmt t =
Format.fprintf fmt "Identity.Changes_args{account=%s;since=%s}"
-
t.account_id t.since_state
+
(Jmap.Id.to_string t.account_id) t.since_state
let pp_hum fmt t = pp fmt t
···
(** Response for Identity/changes method *)
module Changes_response = struct
type t = {
-
account_id : id;
+
account_id : Jmap.Id.t;
old_state : string;
new_state : string;
has_more_changes : bool;
-
created : id list;
-
updated : id list;
-
destroyed : id list;
+
created : Jmap.Id.t list;
+
updated : Jmap.Id.t list;
+
destroyed : Jmap.Id.t list;
}
let account_id t = t.account_id
···
let to_json t =
`Assoc [
-
("accountId", `String t.account_id);
+
("accountId", `String (Jmap.Id.to_string t.account_id));
("oldState", `String t.old_state);
("newState", `String t.new_state);
("hasMoreChanges", `Bool t.has_more_changes);
-
("created", `List (List.map (fun id -> `String id) t.created));
-
("updated", `List (List.map (fun id -> `String id) t.updated));
-
("destroyed", `List (List.map (fun id -> `String id) t.destroyed));
+
("created", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) t.created));
+
("updated", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) t.updated));
+
("destroyed", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) t.destroyed));
]
let of_json json =
···
match json with
| `Assoc fields ->
let account_id = match List.assoc_opt "accountId" fields with
-
| Some (`String s) -> s
+
| Some (`String s) -> (match Jmap.Id.of_string s with
+
| Ok id -> id
+
| Error _ -> failwith ("Invalid accountId: " ^ s))
| _ -> failwith "Missing required 'accountId' field in Identity/changes response"
in
let old_state = match List.assoc_opt "oldState" fields with
···
in
let get_id_list key =
match List.assoc_opt key fields with
-
| Some (`List ids) -> List.map (function `String s -> s | _ -> failwith ("Invalid ID in '" ^ key ^ "' list")) ids
+
| Some (`List ids) -> List.map (function `String s -> (match Jmap.Id.of_string s with Ok id -> id | Error _ -> failwith ("Invalid ID in '" ^ key ^ "' list: " ^ s)) | _ -> failwith ("Invalid ID in '" ^ key ^ "' list")) ids
| Some `Null | None -> []
| _ -> failwith ("Invalid '" ^ key ^ "' field in Identity/changes response")
in
···
module Get_response = struct
(* Use the outer module's type *)
type identity = {
-
id : id;
+
id : Jmap.Id.t;
name : string;
email : string;
-
reply_to : Types.Email_address.t list option;
-
bcc : Types.Email_address.t list option;
+
reply_to : Address.t list option;
+
bcc : Address.t list option;
text_signature : string;
html_signature : string;
may_delete : bool;
}
type t = {
-
account_id : id;
+
account_id : Jmap.Id.t;
state : string;
list : identity list;
-
not_found : id list;
+
not_found : Jmap.Id.t list;
}
let account_id t = t.account_id
···
let identity_to_json identity =
let fields = [
-
("id", `String identity.id);
+
("Id.t", `String (Jmap.Id.to_string identity.id));
("name", `String identity.name);
("email", `String identity.email);
("textSignature", `String identity.text_signature);
···
] in
let fields = match identity.reply_to with
| None -> ("replyTo", `Null) :: fields
-
| Some addrs -> ("replyTo", `List (List.map Types.Email_address.to_json addrs)) :: fields
+
| Some addrs -> ("replyTo", `List (List.map Address.to_json addrs)) :: fields
in
let fields = match identity.bcc with
| None -> ("bcc", `Null) :: fields
-
| Some addrs -> ("bcc", `List (List.map Types.Email_address.to_json addrs)) :: fields
+
| Some addrs -> ("bcc", `List (List.map Address.to_json addrs)) :: fields
in
`Assoc (List.rev fields)
···
let rec process_addresses acc = function
| [] -> Some (List.rev acc)
| addr :: rest ->
-
(match Types.Email_address.of_json addr with
+
(match Address.of_json addr with
| Ok a -> process_addresses (a :: acc) rest
| Error _ -> failwith ("Invalid address in " ^ key ^ " field"))
in
···
| Some `Null | None -> None
| _ -> failwith ("Invalid " ^ key ^ " field in Identity")
in
-
let id = get_string "id" "" in
-
if id = "" then failwith "Missing required 'id' field in Identity";
+
let id_str = get_string "Id.t" "" in
+
if id_str = "" then failwith "Missing required 'id' field in Identity";
+
let id = match Jmap.Id.of_string id_str with
+
| Ok id -> id
+
| Error _ -> failwith ("Invalid id: " ^ id_str) in
let email = get_string "email" "" in
if email = "" then failwith "Missing required 'email' field in Identity";
{
···
let to_json t =
`Assoc [
-
("accountId", `String t.account_id);
+
("accountId", `String (Jmap.Id.to_string t.account_id));
("state", `String t.state);
("list", `List (List.map identity_to_json t.list));
-
("notFound", `List (List.map (fun id -> `String id) t.not_found));
+
("notFound", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) t.not_found));
]
let of_json json =
···
match json with
| `Assoc fields ->
let account_id = match List.assoc_opt "accountId" fields with
-
| Some (`String s) -> s
+
| Some (`String s) -> (match Jmap.Id.of_string s with
+
| Ok id -> id
+
| Error _ -> failwith ("Invalid accountId: " ^ s))
| _ -> failwith "Missing required 'accountId' field in Identity/get response"
in
let state = match List.assoc_opt "state" fields with
···
| _ -> failwith "Missing required 'list' field in Identity/get response"
in
let not_found = match List.assoc_opt "notFound" fields with
-
| Some (`List ids) -> List.map (function `String s -> s | _ -> failwith "Invalid ID in 'notFound' list") ids
+
| Some (`List ids) -> List.filter_map (function
+
| `String s -> (match Jmap.Id.of_string s with
+
| Ok id -> Some id
+
| Error _ -> None)
+
| _ -> None) ids
| _ -> failwith "Missing required 'notFound' field in Identity/get response"
in
Ok { account_id; state; list; not_found }
···
]
let to_string = function
-
| `Id -> "id"
+
| `Id -> "Id.t"
| `Name -> "name"
| `Email -> "email"
| `ReplyTo -> "replyTo"
···
| `MayDelete -> "mayDelete"
let of_string = function
-
| "id" -> Some `Id
+
| "Id.t" -> Some `Id
| "name" -> Some `Name
| "email" -> Some `Email
| "replyTo" -> Some `ReplyTo
+63 -64
jmap/jmap-email/identity.mli
···
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-6> RFC 8621, Section 6: Identity
*)
-
open Jmap.Types
open Jmap.Error
(** Complete identity object representation.
···
include Jmap_sigs.PRINTABLE with type t := t
(** JMAP object interface for property selection and object creation *)
-
include Jmap_sigs.JMAP_OBJECT with type t := t and type id_type := id
+
include Jmap_sigs.JMAP_OBJECT with type t := t and type id_type := string
(** Get the server-assigned identity identifier.
@return Immutable unique ID (Some for all persisted identities, None only for unsaved objects) *)
-
val id : t -> id option
+
val id : t -> Jmap.Id.t option
(** Get the display name for this identity.
@return Human-readable name, empty string if not set *)
···
(** Get the default Reply-To addresses for this identity.
@return List of reply-to addresses, or None if not specified *)
-
val reply_to : t -> Types.Email_address.t list option
+
val reply_to : t -> Address.t list option
(** Get the default Bcc addresses for this identity.
@return List of addresses to always Bcc, or None if not specified *)
-
val bcc : t -> Types.Email_address.t list option
+
val bcc : t -> Address.t list option
(** Get the plain text email signature.
@return Text signature to append to plain text messages *)
···
val may_delete : t -> bool
(** Create a new identity object.
-
@param id Server-assigned identity identifier
+
@param Jmap.Id.t Server-assigned identity identifier
@param name Optional display name (defaults to empty string)
@param email Required email address for sending
@param reply_to Optional default Reply-To addresses
···
@param may_delete Server permission for deletion
@return New identity object *)
val v :
-
id:id ->
+
id:Jmap.Id.t ->
?name:string ->
email:string ->
-
?reply_to:Types.Email_address.t list ->
-
?bcc:Types.Email_address.t list ->
+
?reply_to:Address.t list ->
+
?bcc:Address.t list ->
?text_signature:string ->
?html_signature:string ->
may_delete:bool ->
···
(** Get the Reply-To addresses for creation.
@return Optional list of reply-to addresses *)
-
val reply_to : t -> Types.Email_address.t list option
+
val reply_to : t -> Address.t list option
(** Get the Bcc addresses for creation.
@return Optional list of default Bcc addresses *)
-
val bcc : t -> Types.Email_address.t list option
+
val bcc : t -> Address.t list option
(** Get the plain text signature for creation.
@return Optional text signature *)
···
val v :
?name:string ->
email:string ->
-
?reply_to:Types.Email_address.t list ->
-
?bcc:Types.Email_address.t list ->
+
?reply_to:Address.t list ->
+
?bcc:Address.t list ->
?text_signature:string ->
?html_signature:string ->
unit -> t
···
(** Get the server-assigned ID for the created identity.
@return Unique identifier assigned by the server *)
-
val id : t -> id
+
val id : t -> Jmap.Id.t
(** Check if the created identity may be deleted.
@return Server-computed permission for future deletion *)
val may_delete : t -> bool
(** Create an identity creation response.
-
@param id Server-assigned identity ID
+
@param Jmap.Id.t Server-assigned identity ID
@param may_delete Whether the identity can be deleted
@return Creation response object *)
val v :
-
id:id ->
+
id:Jmap.Id.t ->
may_delete:bool ->
unit -> t
end
···
(** Create an update that sets the Reply-To addresses.
@param reply_to New Reply-To addresses (None to clear)
@return Update patch object *)
-
val set_reply_to : Types.Email_address.t list option -> t
+
val set_reply_to : Address.t list option -> t
(** Create an update that sets the Bcc addresses.
@param bcc New default Bcc addresses (None to clear)
@return Update patch object *)
-
val set_bcc : Types.Email_address.t list option -> t
+
val set_bcc : Address.t list option -> t
(** Create an update that sets the plain text signature.
@param text_signature New text signature (empty string to clear)
···
include Jmap_sigs.JSONABLE with type t := t
(** JMAP method arguments interface *)
-
include Jmap_sigs.METHOD_ARGS with type t := t and type account_id := id
+
include Jmap_sigs.METHOD_ARGS with type t := t and type account_id := string
(** Get the account ID for the operation.
@return Account identifier where identities will be retrieved *)
-
val account_id : t -> id
+
val account_id : t -> Jmap.Id.t
(** Validate get arguments according to JMAP method constraints.
@param t Get arguments to validate
···
(** Get the specific identity IDs to retrieve.
@return List of identity IDs, or None to retrieve all identities *)
-
val ids : t -> id list option
+
val ids : t -> Jmap.Id.t list option
(** Get the properties to include in the response.
@return List of property names, or None for all properties *)
···
@param properties Optional list of properties to include
@return Identity/get arguments object *)
val v :
-
account_id:id ->
-
?ids:id list ->
+
account_id:Jmap.Id.t ->
+
?ids:Jmap.Id.t list ->
?properties:string list ->
unit -> t
end
···
module Get_response : sig
(** Identity type for response lists *)
type identity = {
-
id : id;
+
id : Jmap.Id.t;
name : string;
email : string;
-
reply_to : Types.Email_address.t list option;
-
bcc : Types.Email_address.t list option;
+
reply_to : Address.t list option;
+
bcc : Address.t list option;
text_signature : string;
html_signature : string;
may_delete : bool;
···
(** Get the account ID from the response.
@return Account identifier where identities were retrieved *)
-
val account_id : t -> id
+
val account_id : t -> Jmap.Id.t
(** Get the current state string for change tracking.
@return State string for use in Identity/changes *)
···
(** Get the list of identity IDs that were not found.
@return List of requested IDs that don't exist *)
-
val not_found : t -> id list
+
val not_found : t -> Jmap.Id.t list
(** Create Identity/get response.
@param account_id Account where identities were retrieved
···
@param not_found IDs that were not found
@return Identity/get response object *)
val v :
-
account_id:id ->
+
account_id:Jmap.Id.t ->
state:string ->
list:identity list ->
-
not_found:id list ->
+
not_found:Jmap.Id.t list ->
unit -> t
end
···
include Jmap_sigs.JSONABLE with type t := t
(** JMAP method arguments interface *)
-
include Jmap_sigs.METHOD_ARGS with type t := t and type account_id := id
+
include Jmap_sigs.METHOD_ARGS with type t := t and type account_id := string
(** Get the account ID for the operation.
@return Account identifier where identities will be modified *)
-
val account_id : t -> id
+
val account_id : t -> Jmap.Id.t
(** Validate set arguments according to JMAP method constraints.
@param t Set arguments to validate
···
(** Get the identities to create.
@return Map of creation IDs to creation objects *)
-
val create : t -> Create.t id_map option
+
val create : t -> (string, Create.t) Hashtbl.t option
(** Get the identities to update.
@return Map of identity IDs to update patch objects *)
-
val update : t -> Update.t id_map option
+
val update : t -> (string, Update.t) Hashtbl.t option
(** Get the identity IDs to destroy.
@return List of identity IDs to delete *)
-
val destroy : t -> id list option
+
val destroy : t -> Jmap.Id.t list option
(** Create Identity/set arguments.
@param account_id Account where identities will be modified
···
@param destroy Optional list of identity IDs to delete
@return Identity/set arguments object *)
val v :
-
account_id:id ->
+
account_id:Jmap.Id.t ->
?if_in_state:string ->
-
?create:Create.t id_map ->
-
?update:Update.t id_map ->
-
?destroy:id list ->
+
?create:(string, Create.t) Hashtbl.t ->
+
?update:(string, Update.t) Hashtbl.t ->
+
?destroy:Jmap.Id.t list ->
unit -> t
end
···
(** Get the account ID from the response.
@return Account identifier where identities were modified *)
-
val account_id : t -> id
+
val account_id : t -> Jmap.Id.t
(** Get the old state string.
@return State string before the operations were applied *)
···
(** Get the successfully created identities.
@return Map of creation IDs to creation response objects *)
-
val created : t -> Create.Response.t id_map
+
val created : t -> (string, Create.Response.t) Hashtbl.t
(** Get the successfully updated identities.
@return Map of identity IDs to update response objects *)
-
val updated : t -> Update.Response.t id_map
+
val updated : t -> (string, Update.Response.t) Hashtbl.t
(** Get the successfully destroyed identity IDs.
@return List of identity IDs that were successfully deleted *)
-
val destroyed : t -> id list
+
val destroyed : t -> Jmap.Id.t list
(** Get the identities that could not be created.
@return Map of creation IDs to error objects *)
-
val not_created : t -> Set_error.t id_map
+
val not_created : t -> (string, Set_error.t) Hashtbl.t
(** Get the identities that could not be updated.
@return Map of identity IDs to error objects *)
-
val not_updated : t -> Set_error.t id_map
+
val not_updated : t -> (string, Set_error.t) Hashtbl.t
(** Get the identities that could not be destroyed.
@return Map of identity IDs to error objects *)
-
val not_destroyed : t -> Set_error.t id_map
+
val not_destroyed : t -> (string, Set_error.t) Hashtbl.t
(** Create Identity/set response.
@param account_id Account where identities were modified
···
@param not_destroyed Identities that could not be destroyed
@return Identity/set response object *)
val v :
-
account_id:id ->
+
account_id:Jmap.Id.t ->
old_state:string ->
new_state:string ->
-
?created:Create.Response.t id_map ->
-
?updated:Update.Response.t id_map ->
-
?destroyed:id list ->
-
?not_created:Set_error.t id_map ->
-
?not_updated:Set_error.t id_map ->
-
?not_destroyed:Set_error.t id_map ->
+
?created:(string, Create.Response.t) Hashtbl.t ->
+
?updated:(string, Update.Response.t) Hashtbl.t ->
+
?destroyed:Jmap.Id.t list ->
+
?not_created:(string, Set_error.t) Hashtbl.t ->
+
?not_updated:(string, Set_error.t) Hashtbl.t ->
+
?not_destroyed:(string, Set_error.t) Hashtbl.t ->
unit -> t
end
···
include Jmap_sigs.JSONABLE with type t := t
(** JMAP method arguments interface *)
-
include Jmap_sigs.METHOD_ARGS with type t := t and type account_id := id
+
include Jmap_sigs.METHOD_ARGS with type t := t and type account_id := string
(** Get the account ID for the operation.
@return Account identifier where changes will be retrieved *)
-
val account_id : t -> id
+
val account_id : t -> Jmap.Id.t
(** Validate changes arguments according to JMAP method constraints.
@param t Changes arguments to validate
···
@param max_changes Optional limit on number of changes
@return Identity/changes arguments object *)
val v :
-
account_id:id ->
+
account_id:Jmap.Id.t ->
since_state:string ->
?max_changes:int ->
unit -> t
···
(** Get the account ID from the response.
@return Account identifier where changes were retrieved *)
-
val account_id : t -> id
+
val account_id : t -> Jmap.Id.t
(** Get the old state string.
@return State string that was passed in since_state *)
···
(** Get the list of created or updated identity IDs.
@return List of identity IDs that have been created or updated *)
-
val created : t -> id list
+
val created : t -> Jmap.Id.t list
(** Get the list of updated identity IDs.
@return List of identity IDs that have been updated *)
-
val updated : t -> id list
+
val updated : t -> Jmap.Id.t list
(** Get the list of destroyed identity IDs.
@return List of identity IDs that have been destroyed *)
-
val destroyed : t -> id list
+
val destroyed : t -> Jmap.Id.t list
(** Create Identity/changes response.
@param account_id Account where changes were retrieved
···
@param destroyed List of destroyed identity IDs
@return Identity/changes response object *)
val v :
-
account_id:id ->
+
account_id:Jmap.Id.t ->
old_state:string ->
new_state:string ->
has_more_changes:bool ->
-
?created:id list ->
-
?updated:id list ->
-
?destroyed:id list ->
+
?created:Jmap.Id.t list ->
+
?updated:Jmap.Id.t list ->
+
?destroyed:Jmap.Id.t list ->
unit -> t
end
+365 -191
jmap/jmap-email/mailbox.ml
···
[@@@warning "-32"] (* Suppress unused value warnings for interface-required functions *)
-
open Jmap.Types
open Jmap.Method_names
open Jmap.Methods
···
(* Main mailbox type with all properties *)
type t = {
-
mailbox_id : id;
+
mailbox_id : Jmap.Id.t;
name : string;
-
parent_id : id option;
+
parent_id : Jmap.Id.t option;
role : role option;
-
sort_order : uint;
-
total_emails : uint;
-
unread_emails : uint;
-
total_threads : uint;
-
unread_threads : uint;
+
sort_order : Jmap.UInt.t;
+
total_emails : Jmap.UInt.t;
+
unread_emails : Jmap.UInt.t;
+
total_threads : Jmap.UInt.t;
+
unread_threads : Jmap.UInt.t;
my_rights : rights;
is_subscribed : bool;
}
···
may_set_seen = false; may_set_keywords = false; may_create_child = false;
may_rename = false; may_delete = false; may_submit = false;
} in
+
let id_result = match Jmap.Id.of_string id with
+
| Ok id -> id
+
| Error e -> failwith ("Invalid mailbox ID: " ^ e) in
+
let sort_order = match Jmap.UInt.of_int 0 with
+
| Ok n -> n
+
| Error e -> failwith ("Invalid sort_order: " ^ e) in
+
let total_emails = match Jmap.UInt.of_int 0 with
+
| Ok n -> n
+
| Error e -> failwith ("Invalid total_emails: " ^ e) in
+
let unread_emails = match Jmap.UInt.of_int 0 with
+
| Ok n -> n
+
| Error e -> failwith ("Invalid unread_emails: " ^ e) in
{
-
mailbox_id = id;
+
mailbox_id = id_result;
name = "Untitled";
parent_id = None;
role = None;
-
sort_order = 0;
-
total_emails = 0;
-
unread_emails = 0;
-
total_threads = 0;
-
unread_threads = 0;
+
sort_order;
+
total_emails;
+
unread_emails;
+
total_threads = (match Jmap.UInt.of_int 0 with Ok n -> n | Error e -> failwith ("Invalid total_threads: " ^ e));
+
unread_threads = (match Jmap.UInt.of_int 0 with Ok n -> n | Error e -> failwith ("Invalid unread_threads: " ^ e));
my_rights = default_rights;
is_subscribed = true;
}
(* Get list of all valid property names for Mailbox objects *)
let valid_properties () = [
-
"id"; "name"; "parentId"; "role"; "sortOrder";
+
"Jmap.Id.t"; "name"; "parentId"; "role"; "sortOrder";
"totalEmails"; "unreadEmails"; "totalThreads"; "unreadThreads";
"myRights"; "isSubscribed"
]
(* Extended constructor with validation - renamed from create *)
-
let create_full ~id ~name ?parent_id ?role ?(sort_order=0) ~total_emails ~unread_emails
+
let create_full ~id ~name ?parent_id ?role ?(sort_order=(match Jmap.UInt.of_int 0 with Ok u -> u | Error _ -> failwith "Invalid default sort_order")) ~total_emails ~unread_emails
~total_threads ~unread_threads ~my_rights ~is_subscribed () =
if String.length name = 0 then
Error "Mailbox name cannot be empty"
-
else if total_emails < unread_emails then
+
else if Jmap.UInt.to_int total_emails < Jmap.UInt.to_int unread_emails then
Error "Unread emails cannot exceed total emails"
-
else if total_threads < unread_threads then
+
else if Jmap.UInt.to_int total_threads < Jmap.UInt.to_int unread_threads then
Error "Unread threads cannot exceed total threads"
else
+
let sort_order_uint = sort_order in
Ok {
mailbox_id = id;
name;
parent_id;
role;
-
sort_order;
+
sort_order = sort_order_uint;
total_emails;
unread_emails;
total_threads;
···
| Some r -> Role.to_string r
| None -> "none"
in
-
Format.fprintf ppf "Mailbox{id=%s; name=%s; role=%s}" t.mailbox_id t.name role_str
+
Format.fprintf ppf "Mailbox{id=%s; name=%s; role=%s}" (Jmap.Id.to_string t.mailbox_id) t.name role_str
let pp_hum = pp
···
("maySubmit", `Bool rights.may_submit);
] in
let all_fields = [
-
("id", `String t.mailbox_id);
+
("id", `String (Jmap.Id.to_string t.mailbox_id));
("name", `String t.name);
-
("parentId", (match t.parent_id with Some p -> `String p | None -> `Null));
+
("parentId", (match t.parent_id with Some p -> `String (Jmap.Id.to_string p) | None -> `Null));
("role", role_to_json t.role);
-
("sortOrder", `Int t.sort_order);
-
("totalEmails", `Int t.total_emails);
-
("unreadEmails", `Int t.unread_emails);
-
("totalThreads", `Int t.total_threads);
-
("unreadThreads", `Int t.unread_threads);
+
("sortOrder", `Int (Jmap.UInt.to_int t.sort_order));
+
("totalEmails", `Int (Jmap.UInt.to_int t.total_emails));
+
("unreadEmails", `Int (Jmap.UInt.to_int t.unread_emails));
+
("totalThreads", `Int (Jmap.UInt.to_int t.total_threads));
+
("unreadThreads", `Int (Jmap.UInt.to_int t.unread_threads));
("myRights", rights_to_json t.my_rights);
("isSubscribed", `Bool t.is_subscribed);
] in
···
let other s = Other s
let to_string = function
-
| Id -> "id"
+
| Id -> "Jmap.Id.t"
| Name -> "name"
| ParentId -> "parentId"
| Role -> "role"
···
| Other s -> s
let of_string = function
-
| "id" -> Ok Id
+
| "Jmap.Id.t" -> Ok Id
| "name" -> Ok Name
| "parentId" -> Ok ParentId
| "role" -> Ok Role
···
module Create = struct
type t = {
create_name : string;
-
create_parent_id : id option;
+
create_parent_id : Jmap.Id.t option;
create_role : role option;
-
create_sort_order : uint option;
+
create_sort_order : Jmap.UInt.t option;
create_is_subscribed : bool option;
}
···
("name", `String create_req.create_name);
] in
let base = match create_req.create_parent_id with
-
| Some pid -> ("parentId", `String pid) :: base
+
| Some pid -> ("parentId", `String (Jmap.Id.to_string pid)) :: base
| None -> base
in
let base = match create_req.create_role with
···
| None -> base
in
let base = match create_req.create_sort_order with
-
| Some so -> ("sortOrder", `Int so) :: base
+
| Some so -> ("sortOrder", `Int (Jmap.UInt.to_int so)) :: base
| None -> base
in
let base = match create_req.create_is_subscribed with
···
try
let open Yojson.Safe.Util in
let name = json |> member "name" |> to_string in
-
let parent_id = json |> member "parentId" |> to_string_option in
+
let parent_id = match json |> member "parentId" |> to_string_option with
+
| None -> None
+
| Some s -> Some (match Jmap.Id.of_string s with
+
| Ok id -> id
+
| Error err -> failwith ("Invalid parentId: " ^ err)) in
let role_opt : (role option, string) result = match json |> member "role" with
| `Null -> Ok None
| role_json ->
···
| Ok r -> Ok (Some r)
| Error e -> Error e
in
-
let sort_order = json |> member "sortOrder" |> to_int_option in
+
let sort_order = match json |> member "sortOrder" |> to_int_option with
+
| None -> None
+
| Some i -> Some (match Jmap.UInt.of_int i with
+
| Ok uint -> uint
+
| Error err -> failwith ("Invalid sortOrder: " ^ err)) in
let is_subscribed = json |> member "isSubscribed" |> to_bool_option in
match role_opt with
| Ok role ->
···
module Response = struct
type t = {
-
response_id : id;
+
response_id : Jmap.Id.t;
response_role : role option;
-
response_sort_order : uint;
-
response_total_emails : uint;
-
response_unread_emails : uint;
-
response_total_threads : uint;
-
response_unread_threads : uint;
+
response_sort_order : Jmap.UInt.t;
+
response_total_emails : Jmap.UInt.t;
+
response_unread_emails : Jmap.UInt.t;
+
response_total_threads : Jmap.UInt.t;
+
response_unread_threads : Jmap.UInt.t;
response_my_rights : rights;
response_is_subscribed : bool;
}
···
(* JSON serialization *)
let to_json response =
let base = [
-
("id", `String response.response_id);
-
("sortOrder", `Int response.response_sort_order);
-
("totalEmails", `Int response.response_total_emails);
-
("unreadEmails", `Int response.response_unread_emails);
-
("totalThreads", `Int response.response_total_threads);
-
("unreadThreads", `Int response.response_unread_threads);
+
("Jmap.Id.t", `String (Jmap.Id.to_string response.response_id));
+
("sortOrder", `Int (Jmap.UInt.to_int response.response_sort_order));
+
("totalEmails", `Int (Jmap.UInt.to_int response.response_total_emails));
+
("unreadEmails", `Int (Jmap.UInt.to_int response.response_unread_emails));
+
("totalThreads", `Int (Jmap.UInt.to_int response.response_total_threads));
+
("unreadThreads", `Int (Jmap.UInt.to_int response.response_unread_threads));
("myRights", Rights.to_json response.response_my_rights);
("isSubscribed", `Bool response.response_is_subscribed);
] in
···
let of_json json =
try
let open Yojson.Safe.Util in
-
let id = json |> member "id" |> to_string in
+
let id_str = json |> member "id" |> to_string in
+
let id = match Jmap.Id.of_string id_str with
+
| Ok id_val -> id_val
+
| Error e -> failwith ("Invalid mailbox ID: " ^ id_str ^ " - " ^ e)
+
in
let role_opt : (role option, string) result = match json |> member "role" with
| `Null -> Ok None
| role_json ->
···
| Ok r -> Ok (Some r)
| Error e -> Error e
in
-
let sort_order = json |> member "sortOrder" |> to_int in
-
let total_emails = json |> member "totalEmails" |> to_int in
-
let unread_emails = json |> member "unreadEmails" |> to_int in
-
let total_threads = json |> member "totalThreads" |> to_int in
-
let unread_threads = json |> member "unreadThreads" |> to_int in
+
let sort_order_int = json |> member "sortOrder" |> to_int in
+
let sort_order = match Jmap.UInt.of_int sort_order_int with
+
| Ok uint -> uint
+
| Error _ -> failwith ("Invalid sortOrder: " ^ string_of_int sort_order_int) in
+
let total_emails_int = json |> member "totalEmails" |> to_int in
+
let total_emails = match Jmap.UInt.of_int total_emails_int with
+
| Ok uint -> uint
+
| Error _ -> failwith ("Invalid totalEmails: " ^ string_of_int total_emails_int) in
+
let unread_emails_int = json |> member "unreadEmails" |> to_int in
+
let unread_emails = match Jmap.UInt.of_int unread_emails_int with
+
| Ok uint -> uint
+
| Error _ -> failwith ("Invalid unreadEmails: " ^ string_of_int unread_emails_int) in
+
let total_threads_int = json |> member "totalThreads" |> to_int in
+
let total_threads = match Jmap.UInt.of_int total_threads_int with
+
| Ok uint -> uint
+
| Error _ -> failwith ("Invalid totalThreads: " ^ string_of_int total_threads_int) in
+
let unread_threads_int = json |> member "unreadThreads" |> to_int in
+
let unread_threads = match Jmap.UInt.of_int unread_threads_int with
+
| Ok uint -> uint
+
| Error _ -> failwith ("Invalid unreadThreads: " ^ string_of_int unread_threads_int) in
let my_rights_result = json |> member "myRights" |> Rights.of_json in
let is_subscribed = json |> member "isSubscribed" |> to_bool in
match role_opt, my_rights_result with
···
end
module Update = struct
-
type t = patch_object
+
type t = Jmap.Methods.patch_object
let create ?name ?parent_id ?role ?sort_order ?is_subscribed () =
let patches = [] in
···
| None -> patches
in
let patches = match parent_id with
-
| Some (Some id) -> ("/parentId", `String id) :: patches
+
| Some (Some id) -> ("/parentId", `String (Jmap.Id.to_string id)) :: patches
| Some None -> ("/parentId", `Null) :: patches
| None -> patches
in
···
| None -> patches
in
let patches = match sort_order with
-
| Some n -> ("/sortOrder", `Int n) :: patches
+
| Some n -> ("/sortOrder", `Int (Jmap.UInt.to_int n)) :: patches
| None -> patches
in
let patches = match is_subscribed with
···
| Some mailbox ->
(* Create complete JSON representation inline *)
let base = [
-
("id", `String mailbox.mailbox_id);
+
("Jmap.Id.t", `String (Jmap.Id.to_string mailbox.mailbox_id));
("name", `String mailbox.name);
-
("sortOrder", `Int mailbox.sort_order);
-
("totalEmails", `Int mailbox.total_emails);
-
("unreadEmails", `Int mailbox.unread_emails);
-
("totalThreads", `Int mailbox.total_threads);
-
("unreadThreads", `Int mailbox.unread_threads);
+
("sortOrder", `Int (Jmap.UInt.to_int mailbox.sort_order));
+
("totalEmails", `Int (Jmap.UInt.to_int mailbox.total_emails));
+
("unreadEmails", `Int (Jmap.UInt.to_int mailbox.unread_emails));
+
("totalThreads", `Int (Jmap.UInt.to_int mailbox.total_threads));
+
("unreadThreads", `Int (Jmap.UInt.to_int mailbox.unread_threads));
("myRights", Rights.to_json mailbox.my_rights);
("isSubscribed", `Bool mailbox.is_subscribed);
] in
let base = match mailbox.parent_id with
-
| Some pid -> ("parentId", `String pid) :: base
+
| Some pid -> ("parentId", `String (Jmap.Id.to_string pid)) :: base
| None -> base
in
let base = match mailbox.role with
···
(* Stub implementations for method modules - these would be implemented based on actual JMAP method signatures *)
module Query_args = struct
type t = {
-
account_id : id;
+
account_id : Jmap.Id.t;
filter : Filter.t option;
sort : Comparator.t list option;
-
position : uint option;
-
limit : uint option;
+
position : Jmap.UInt.t option;
+
limit : Jmap.UInt.t option;
calculate_total : bool option;
}
···
let calculate_total args = args.calculate_total
let to_json args =
-
let fields = [("accountId", `String args.account_id)] in
+
let fields = [("accountId", `String (Jmap.Id.to_string args.account_id))] in
let fields = match args.filter with
| None -> fields
-
| Some filter -> ("filter", Filter.to_json filter) :: fields
+
| Some _filter -> ("filter", `Null) :: fields (* Filter serialization needs implementation *)
in
let fields = match args.sort with
| None -> fields
···
in
let fields = match args.position with
| None -> fields
-
| Some pos -> ("position", `Int pos) :: fields
+
| Some pos -> ("position", `Int (Jmap.UInt.to_int pos)) :: fields
in
let fields = match args.limit with
| None -> fields
-
| Some lim -> ("limit", `Int lim) :: fields
+
| Some lim -> ("limit", `Int (Jmap.UInt.to_int lim)) :: fields
in
let fields = match args.calculate_total with
| None -> fields
···
match json with
| `Assoc fields ->
let account_id = match List.assoc "accountId" fields with
-
| `String s -> s
+
| `String s -> (match Jmap.Id.of_string s with
+
| Ok id -> id
+
| Error _ -> failwith ("Invalid accountId: " ^ s))
| _ -> failwith "Expected string for accountId"
in
let filter : Filter.t option = match List.assoc_opt "filter" fields with
···
) sort_list)
| Some _ -> failwith "Expected list for sort"
in
-
let position : uint option = match List.assoc_opt "position" fields with
+
let position : Jmap.UInt.t option = match List.assoc_opt "position" fields with
| None -> None
-
| Some (`Int i) when i >= 0 -> Some i
+
| Some (`Int i) when i >= 0 -> (match Jmap.UInt.of_int i with
+
| Ok uint -> Some uint
+
| Error _ -> failwith ("Invalid position: " ^ string_of_int i))
| Some (`Int _) -> failwith "Position must be non-negative"
| Some _ -> failwith "Expected int for position"
in
-
let limit : uint option = match List.assoc_opt "limit" fields with
+
let limit : Jmap.UInt.t option = match List.assoc_opt "limit" fields with
| None -> None
-
| Some (`Int i) when i >= 0 -> Some i
+
| Some (`Int i) when i >= 0 -> (match Jmap.UInt.of_int i with
+
| Ok uint -> Some uint
+
| Error _ -> failwith ("Invalid limit: " ^ string_of_int i))
| Some (`Int _) -> failwith "Limit must be non-negative"
| Some _ -> failwith "Expected int for limit"
in
···
| exn -> Error ("Query_args JSON parsing exception: " ^ Printexc.to_string exn)
let pp fmt t =
-
Format.fprintf fmt "Mailbox.Query_args{account=%s}" t.account_id
+
Format.fprintf fmt "Mailbox.Query_args{account=%s}" (Jmap.Id.to_string t.account_id)
let pp_hum fmt t = pp fmt t
···
module Query_response = struct
type t = {
-
account_id : id;
+
account_id : Jmap.Id.t;
query_state : string;
can_calculate_changes : bool;
-
position : uint;
-
total : uint option;
-
ids : id list;
+
position : Jmap.UInt.t;
+
total : Jmap.UInt.t option;
+
ids : Jmap.Id.t list;
}
let account_id resp = resp.account_id
···
@return JSON object with accountId, queryState, canCalculateChanges, position, ids, and optional total *)
let to_json resp =
let base = [
-
("accountId", `String resp.account_id);
+
("accountId", `String (Jmap.Id.to_string resp.account_id));
("queryState", `String resp.query_state);
("canCalculateChanges", `Bool resp.can_calculate_changes);
-
("position", `Int resp.position);
-
("ids", `List (List.map (fun id -> `String id) resp.ids));
+
("position", `Int (Jmap.UInt.to_int resp.position));
+
("ids", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) resp.ids));
] in
let base = match resp.total with
-
| Some total -> ("total", `Int total) :: base
+
| Some total -> ("total", `Int (Jmap.UInt.to_int total)) :: base
| None -> base
in
`Assoc base
···
let of_json json =
try
let open Yojson.Safe.Util in
-
let account_id = json |> member "accountId" |> to_string in
+
let account_id_str = json |> member "accountId" |> to_string in
+
let account_id = match Jmap.Id.of_string account_id_str with
+
| Ok id -> id
+
| Error _ -> failwith ("Invalid accountId: " ^ account_id_str) in
let query_state = json |> member "queryState" |> to_string in
let can_calculate_changes = json |> member "canCalculateChanges" |> to_bool in
-
let position = json |> member "position" |> to_int in
-
let ids = json |> member "ids" |> to_list |> List.map to_string in
-
let total = json |> member "total" |> to_int_option in
+
let position_int = json |> member "position" |> to_int in
+
let position = match Jmap.UInt.of_int position_int with
+
| Ok uint -> uint
+
| Error _ -> failwith ("Invalid position: " ^ string_of_int position_int) in
+
let ids_strings = json |> member "ids" |> to_list |> List.map to_string in
+
let ids = List.filter_map (fun s -> match Jmap.Id.of_string s with
+
| Ok id -> Some id
+
| Error _ -> None) ids_strings in
+
let total_opt = json |> member "total" |> to_int_option in
+
let total = match total_opt with
+
| None -> None
+
| Some total_int -> (match Jmap.UInt.of_int total_int with
+
| Ok uint -> Some uint
+
| Error _ -> None) in
Ok {
account_id;
query_state;
···
let pp fmt t =
Format.fprintf fmt "Mailbox.Query_response{account=%s;total=%s}"
-
t.account_id
-
(match t.total with Some n -> string_of_int n | None -> "unknown")
+
(Jmap.Id.to_string t.account_id)
+
(match t.total with Some n -> string_of_int (Jmap.UInt.to_int n) | None -> "unknown")
let pp_hum fmt t = pp fmt t
···
module Get_args = struct
type t = {
-
account_id : id;
-
ids : id list option;
+
account_id : Jmap.Id.t;
+
ids : Jmap.Id.t list option;
properties : Property.t list option;
}
···
@param args The get arguments to serialize
@return JSON object with accountId, and optional ids and properties *)
let to_json args =
-
let base = [("accountId", `String args.account_id)] in
+
let base = [("accountId", `String (Jmap.Id.to_string args.account_id))] in
let base = match args.ids with
| None -> base
-
| Some ids -> ("ids", `List (List.map (fun id -> `String id) ids)) :: base
+
| Some ids -> ("ids", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) ids)) :: base
in
let base = match args.properties with
| None -> base
| Some props ->
let prop_strings = List.map Property.to_string props in
-
("properties", `List (List.map (fun s -> `String s) prop_strings)) :: base
+
("properties", (`List (List.map (fun s -> `String s) prop_strings) : Yojson.Safe.t)) :: base
in
`Assoc base
···
@return Result with parsed get arguments or error message *)
let of_json json =
try
-
let account_id = Yojson.Safe.Util.(json |> member "accountId" |> to_string) in
+
let account_id = match Jmap.Id.of_string (Yojson.Safe.Util.(json |> member "accountId" |> to_string)) with
+
| Ok id -> id
+
| Error _ -> failwith "Invalid accountId in Get_args JSON" in
let ids = match Yojson.Safe.Util.(json |> member "ids") with
| `Null -> None
-
| `List id_list -> Some (List.map Yojson.Safe.Util.to_string id_list)
+
| `List id_list -> Some (List.map (fun id_json ->
+
match Jmap.Id.of_string (Yojson.Safe.Util.to_string id_json) with
+
| Ok id -> id
+
| Error _ -> failwith ("Invalid id in Get_args ids list: " ^ Yojson.Safe.Util.to_string id_json)
+
) id_list)
| _ -> failwith "Expected array or null for ids"
in
let properties = match Yojson.Safe.Util.(json |> member "properties") with
···
| exn -> Error ("Get_args JSON parse error: " ^ Printexc.to_string exn)
let pp fmt t =
-
Format.fprintf fmt "Mailbox.Get_args{account=%s}" t.account_id
+
Format.fprintf fmt "Mailbox.Get_args{account=%s}" (Jmap.Id.to_string t.account_id)
let pp_hum fmt t = pp fmt t
···
module Get_response = struct
type t = {
-
account_id : id;
+
account_id : Jmap.Id.t;
state : string;
list : mailbox_t list;
-
not_found : id list;
+
not_found : Jmap.Id.t list;
}
let account_id resp = resp.account_id
···
let to_json resp =
(* Helper to serialize a single mailbox - duplicated locally to avoid forward reference *)
let mailbox_to_json mailbox =
-
let base = [
-
("id", `String mailbox.mailbox_id);
+
let base : (string * Yojson.Safe.t) list = [
+
("Jmap.Id.t", `String (Jmap.Id.to_string mailbox.mailbox_id));
("name", `String mailbox.name);
-
("sortOrder", `Int mailbox.sort_order);
-
("totalEmails", `Int mailbox.total_emails);
-
("unreadEmails", `Int mailbox.unread_emails);
-
("totalThreads", `Int mailbox.total_threads);
-
("unreadThreads", `Int mailbox.unread_threads);
+
("sortOrder", `Int (Jmap.UInt.to_int mailbox.sort_order));
+
("totalEmails", `Int (Jmap.UInt.to_int mailbox.total_emails));
+
("unreadEmails", `Int (Jmap.UInt.to_int mailbox.unread_emails));
+
("totalThreads", `Int (Jmap.UInt.to_int mailbox.total_threads));
+
("unreadThreads", `Int (Jmap.UInt.to_int mailbox.unread_threads));
("myRights", Rights.to_json mailbox.my_rights);
("isSubscribed", `Bool mailbox.is_subscribed);
] in
let base = match mailbox.parent_id with
-
| Some pid -> ("parentId", `String pid) :: base
+
| Some pid -> ("parentId", `String (Jmap.Id.to_string pid)) :: base
| None -> base
in
let base = match mailbox.role with
···
`Assoc base
in
`Assoc [
-
("accountId", `String resp.account_id);
+
("accountId", `String (Jmap.Id.to_string resp.account_id));
("state", `String resp.state);
("list", `List (List.map mailbox_to_json resp.list));
-
("notFound", `List (List.map (fun id -> `String id) resp.not_found));
+
("notFound", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) resp.not_found));
]
(** Parse Mailbox/get response from JSON.
···
let of_json json =
try
let open Yojson.Safe.Util in
-
let account_id = json |> member "accountId" |> to_string in
+
let account_id_str = json |> member "accountId" |> to_string in
+
let account_id = match Jmap.Id.of_string account_id_str with Ok id -> id | Error _ -> failwith ("Invalid account_id: " ^ account_id_str) in
let state = json |> member "state" |> to_string in
let list_json = json |> member "list" |> to_list in
(* Helper to parse a single mailbox - duplicated locally to avoid forward reference *)
let mailbox_of_json json =
-
let id = json |> member "id" |> to_string in
+
let id_str = json |> member "Jmap.Id.t" |> to_string in
+
let id = match Jmap.Id.of_string id_str with Ok id -> id | Error _ -> failwith ("Invalid id: " ^ id_str) in
let name = json |> member "name" |> to_string in
-
let parent_id = json |> member "parentId" |> to_string_option in
+
let parent_id = match json |> member "parentId" |> to_string_option with
+
| Some s -> (match Jmap.Id.of_string s with Ok id -> Some id | Error _ -> failwith ("Invalid parent_id: " ^ s))
+
| None -> None in
let role_opt : (role option, string) result = match json |> member "role" with
| `Null -> Ok None
| role_json ->
···
| Ok r -> Ok (Some r)
| Error e -> Error e
in
-
let sort_order = json |> member "sortOrder" |> to_int in
-
let total_emails = json |> member "totalEmails" |> to_int in
-
let unread_emails = json |> member "unreadEmails" |> to_int in
-
let total_threads = json |> member "totalThreads" |> to_int in
-
let unread_threads = json |> member "unreadThreads" |> to_int in
+
let sort_order_int = json |> member "sortOrder" |> to_int in
+
let sort_order = match Jmap.UInt.of_int sort_order_int with
+
| Ok uint -> uint
+
| Error _ -> failwith ("Invalid sortOrder: " ^ string_of_int sort_order_int) in
+
let total_emails_int = json |> member "totalEmails" |> to_int in
+
let total_emails = match Jmap.UInt.of_int total_emails_int with
+
| Ok uint -> uint
+
| Error _ -> failwith ("Invalid totalEmails: " ^ string_of_int total_emails_int) in
+
let unread_emails_int = json |> member "unreadEmails" |> to_int in
+
let unread_emails = match Jmap.UInt.of_int unread_emails_int with
+
| Ok uint -> uint
+
| Error _ -> failwith ("Invalid unreadEmails: " ^ string_of_int unread_emails_int) in
+
let total_threads_int = json |> member "totalThreads" |> to_int in
+
let total_threads = match Jmap.UInt.of_int total_threads_int with
+
| Ok uint -> uint
+
| Error _ -> failwith ("Invalid totalThreads: " ^ string_of_int total_threads_int) in
+
let unread_threads_int = json |> member "unreadThreads" |> to_int in
+
let unread_threads = match Jmap.UInt.of_int unread_threads_int with
+
| Ok uint -> uint
+
| Error _ -> failwith ("Invalid unreadThreads: " ^ string_of_int unread_threads_int) in
let my_rights_result = json |> member "myRights" |> Rights.of_json in
let is_subscribed = json |> member "isSubscribed" |> to_bool in
match role_opt, my_rights_result with
| Ok role, Ok my_rights ->
-
create_full ~id ~name ?parent_id ?role ~sort_order ~total_emails
-
~unread_emails ~total_threads ~unread_threads ~my_rights ~is_subscribed ()
+
create_full ~id ~name ?parent_id ?role
+
~sort_order
+
~total_emails ~unread_emails ~total_threads ~unread_threads
+
~my_rights ~is_subscribed ()
| Error e, _ -> Error e
| _, Error e -> Error e
in
···
| Ok mailbox -> Ok (mailbox :: mailboxes)
| Error e -> Error e
) (Ok []) list_json in
-
let not_found = json |> member "notFound" |> to_list |> List.map to_string in
+
let not_found = json |> member "notFound" |> to_list |> List.map (fun id_json ->
+
let id_str = to_string id_json in
+
match Jmap.Id.of_string id_str with Ok id -> id | Error _ -> failwith ("Invalid not_found id: " ^ id_str)) in
match list_result with
| Ok list ->
Ok {
···
let pp fmt t =
Format.fprintf fmt "Mailbox.Get_response{account=%s;mailboxes=%d}"
-
t.account_id (List.length t.list)
+
(Jmap.Id.to_string t.account_id) (List.length t.list)
let pp_hum fmt t = pp fmt t
···
module Set_args = struct
type t = {
-
account_id : id;
+
account_id : Jmap.Id.t;
if_in_state : string option;
create : (string * Create.t) list;
-
update : (id * Update.t) list;
-
destroy : id list;
+
update : (Jmap.Id.t * Update.t) list;
+
destroy : Jmap.Id.t list;
let account_id args = args.account_id
···
@param args The set arguments to serialize
@return JSON object with accountId, ifInState, create, update, destroy *)
let to_json args =
-
let base = [("accountId", `String args.account_id)] in
+
let base = [("accountId", `String (Jmap.Id.to_string args.account_id))] in
let base = match args.if_in_state with
| None -> base
| Some state -> ("ifInState", `String state) :: base
···
if List.length args.update = 0 then base
else
let update_map = List.map (fun (id, update_obj) ->
-
(id, Update.to_json update_obj)
+
(Jmap.Id.to_string id, Update.to_json update_obj)
) args.update in
("update", `Assoc update_map) :: base
in
let base =
if List.length args.destroy = 0 then base
else
-
("destroy", `List (List.map (fun id -> `String id) args.destroy)) :: base
+
("destroy", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) args.destroy)) :: base
in
`Assoc base
···
let of_json json =
try
let open Yojson.Safe.Util in
-
let account_id = json |> member "accountId" |> to_string in
+
let account_id_str = json |> member "accountId" |> to_string in
+
let account_id = match Jmap.Id.of_string account_id_str with
+
| Ok id -> id
+
| Error e -> failwith ("Invalid account ID: " ^ e)
+
in
let if_in_state = json |> member "ifInState" |> to_string_option in
let create = match json |> member "create" with
| `Null -> []
···
| `Assoc update_assoc ->
List.fold_left (fun acc (id, update_json) ->
match Update.of_json update_json with
-
| Ok update_obj -> (id, update_obj) :: acc
+
| Ok update_obj ->
+
let id_t = match Jmap.Id.of_string id with
+
| Ok id_val -> id_val
+
| Error e -> failwith ("Invalid update ID: " ^ id ^ " - " ^ e)
+
in
+
(id_t, update_obj) :: acc
| Error _ -> failwith ("Invalid update object for: " ^ id)
) [] update_assoc
| _ -> failwith "Expected object or null for update"
in
let destroy = match json |> member "destroy" with
| `Null -> []
-
| `List destroy_list -> List.map to_string destroy_list
+
| `List destroy_list -> List.map (fun id_json ->
+
let id_str = to_string id_json in
+
match Jmap.Id.of_string id_str with
+
| Ok id -> id
+
| Error e -> failwith ("Invalid destroy ID: " ^ id_str ^ " - " ^ e)
+
) destroy_list
| _ -> failwith "Expected array or null for destroy"
in
Ok {
···
| exn -> Error ("Set_args JSON parse error: " ^ Printexc.to_string exn)
let pp fmt t =
-
Format.fprintf fmt "Mailbox.Set_args{account=%s}" t.account_id
+
Format.fprintf fmt "Mailbox.Set_args{account=%s}" (Jmap.Id.to_string t.account_id)
let pp_hum fmt t = pp fmt t
···
module Set_response = struct
type t = {
-
account_id : id;
+
account_id : Jmap.Id.t;
old_state : string option;
new_state : string;
created : (string * Create.Response.t) list;
-
updated : (id * Update.Response.t) list;
-
destroyed : id list;
+
updated : (Jmap.Id.t * Update.Response.t) list;
+
destroyed : Jmap.Id.t list;
not_created : (string * Jmap.Error.Set_error.t) list;
-
not_updated : (id * Jmap.Error.Set_error.t) list;
-
not_destroyed : (id * Jmap.Error.Set_error.t) list;
+
not_updated : (Jmap.Id.t * Jmap.Error.Set_error.t) list;
+
not_destroyed : (Jmap.Id.t * Jmap.Error.Set_error.t) list;
let account_id resp = resp.account_id
···
@return JSON object with accountId, states, created, updated, destroyed, and error maps *)
let to_json resp =
let base = [
-
("accountId", `String resp.account_id);
+
("accountId", `String (Jmap.Id.to_string resp.account_id));
("newState", `String resp.new_state);
] in
let base = match resp.old_state with
···
if List.length resp.updated = 0 then base
else
let updated_map = List.map (fun (id, update_resp) ->
-
(id, Update.Response.to_json update_resp)
+
(Jmap.Id.to_string id, Update.Response.to_json update_resp)
) resp.updated in
("updated", `Assoc updated_map) :: base
in
let base =
if List.length resp.destroyed = 0 then base
else
-
("destroyed", `List (List.map (fun id -> `String id) resp.destroyed)) :: base
+
("destroyed", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) resp.destroyed)) :: base
in
let base =
if List.length resp.not_created = 0 then base
···
if List.length resp.not_updated = 0 then base
else
let not_updated_map = List.map (fun (id, error) ->
-
(id, Jmap.Error.Set_error.to_json error)
+
(Jmap.Id.to_string id, Jmap.Error.Set_error.to_json error)
) resp.not_updated in
("notUpdated", `Assoc not_updated_map) :: base
in
···
if List.length resp.not_destroyed = 0 then base
else
let not_destroyed_map = List.map (fun (id, error) ->
-
(id, Jmap.Error.Set_error.to_json error)
+
(Jmap.Id.to_string id, Jmap.Error.Set_error.to_json error)
) resp.not_destroyed in
("notDestroyed", `Assoc not_destroyed_map) :: base
in
···
let of_json json =
try
let open Yojson.Safe.Util in
-
let account_id = json |> member "accountId" |> to_string in
+
let account_id_str = json |> member "accountId" |> to_string in
+
let account_id = match Jmap.Id.of_string account_id_str with
+
| Ok id -> id
+
| Error e -> failwith ("Invalid account ID: " ^ e)
+
in
let old_state = json |> member "oldState" |> to_string_option in
let new_state = json |> member "newState" |> to_string in
let created = match json |> member "created" with
···
| `Assoc updated_assoc ->
List.fold_left (fun acc (id, resp_json) ->
match Update.Response.of_json resp_json with
-
| Ok resp -> (id, resp) :: acc
+
| Ok resp ->
+
let id_t = match Jmap.Id.of_string id with
+
| Ok id_val -> id_val
+
| Error e -> failwith ("Invalid updated ID: " ^ id ^ " - " ^ e)
+
in
+
(id_t, resp) :: acc
| Error _ -> failwith ("Invalid updated response for: " ^ id)
) [] updated_assoc
| _ -> failwith "Expected object or null for updated"
in
let destroyed = match json |> member "destroyed" with
| `Null -> []
-
| `List destroyed_list -> List.map to_string destroyed_list
+
| `List destroyed_list -> List.map (fun id_json ->
+
let id_str = to_string id_json in
+
match Jmap.Id.of_string id_str with
+
| Ok id -> id
+
| Error e -> failwith ("Invalid destroyed ID: " ^ id_str ^ " - " ^ e)
+
) destroyed_list
| _ -> failwith "Expected array or null for destroyed"
in
let not_created = match json |> member "notCreated" with
···
| `Assoc not_updated_assoc ->
List.fold_left (fun acc (id, error_json) ->
match Jmap.Error.Set_error.of_json error_json with
-
| Ok error -> (id, error) :: acc
+
| Ok error ->
+
let id_t = match Jmap.Id.of_string id with
+
| Ok id_val -> id_val
+
| Error e -> failwith ("Invalid notUpdated ID: " ^ id ^ " - " ^ e)
+
in
+
(id_t, error) :: acc
| Error _ -> failwith ("Invalid notUpdated error for: " ^ id)
) [] not_updated_assoc
| _ -> failwith "Expected object or null for notUpdated"
···
| `Assoc not_destroyed_assoc ->
List.fold_left (fun acc (id, error_json) ->
match Jmap.Error.Set_error.of_json error_json with
-
| Ok error -> (id, error) :: acc
+
| Ok error ->
+
let id_t = match Jmap.Id.of_string id with
+
| Ok id_val -> id_val
+
| Error e -> failwith ("Invalid notDestroyed ID: " ^ id ^ " - " ^ e)
+
in
+
(id_t, error) :: acc
| Error _ -> failwith ("Invalid notDestroyed error for: " ^ id)
) [] not_destroyed_assoc
| _ -> failwith "Expected object or null for notDestroyed"
···
| exn -> Error ("Set_response JSON parse error: " ^ Printexc.to_string exn)
let pp fmt t =
-
Format.fprintf fmt "Mailbox.Set_response{account=%s}" t.account_id
+
Format.fprintf fmt "Mailbox.Set_response{account=%s}" (Jmap.Id.to_string t.account_id)
let pp_hum fmt t = pp fmt t
···
module Changes_args = struct
type t = {
-
account_id : id;
+
account_id : Jmap.Id.t;
since_state : string;
-
max_changes : uint option;
+
max_changes : Jmap.UInt.t option;
let create ~account_id ~since_state ?max_changes () =
···
@return JSON object with accountId, sinceState, and optional maxChanges *)
let to_json args =
let base = [
-
("accountId", `String args.account_id);
+
("accountId", `String (Jmap.Id.to_string args.account_id));
("sinceState", `String args.since_state);
] in
let base = match args.max_changes with
| None -> base
-
| Some max_changes -> ("maxChanges", `Int max_changes) :: base
+
| Some max_changes -> ("maxChanges", `Int (Jmap.UInt.to_int max_changes)) :: base
in
`Assoc base
···
let of_json json =
try
let open Yojson.Safe.Util in
-
let account_id = json |> member "accountId" |> to_string in
+
let account_id_str = json |> member "accountId" |> to_string in
+
let account_id = match Jmap.Id.of_string account_id_str with
+
| Ok id -> id
+
| Error e -> failwith ("Invalid account ID: " ^ e)
+
in
let since_state = json |> member "sinceState" |> to_string in
-
let max_changes = json |> member "maxChanges" |> to_int_option in
+
let max_changes = json |> member "maxChanges" |> to_int_option |>
+
Option.map (fun i -> match Jmap.UInt.of_int i with
+
| Ok u -> u
+
| Error e -> failwith ("Invalid maxChanges: " ^ e)) in
Ok { account_id; since_state; max_changes }
with
| Yojson.Safe.Util.Type_error (msg, _) -> Error ("Changes_args JSON parse error: " ^ msg)
| exn -> Error ("Changes_args JSON parse error: " ^ Printexc.to_string exn)
let pp fmt t =
-
Format.fprintf fmt "Mailbox.Changes_args{account=%s}" t.account_id
+
Format.fprintf fmt "Mailbox.Changes_args{account=%s}" (Jmap.Id.to_string t.account_id)
let pp_hum fmt t = pp fmt t
···
module Changes_response = struct
type t = {
-
account_id : id;
+
account_id : Jmap.Id.t;
old_state : string;
new_state : string;
has_more_changes : bool;
-
created : id list;
-
updated : id list;
-
destroyed : id list;
+
created : Jmap.Id.t list;
+
updated : Jmap.Id.t list;
+
destroyed : Jmap.Id.t list;
let account_id resp = resp.account_id
···
@return JSON object with accountId, states, hasMoreChanges, and change arrays *)
let to_json resp =
`Assoc [
-
("accountId", `String resp.account_id);
+
("accountId", `String (Jmap.Id.to_string resp.account_id));
("oldState", `String resp.old_state);
("newState", `String resp.new_state);
("hasMoreChanges", `Bool resp.has_more_changes);
-
("created", `List (List.map (fun id -> `String id) resp.created));
-
("updated", `List (List.map (fun id -> `String id) resp.updated));
-
("destroyed", `List (List.map (fun id -> `String id) resp.destroyed));
+
("created", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) resp.created));
+
("updated", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) resp.updated));
+
("destroyed", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) resp.destroyed));
(** Parse Mailbox/changes response from JSON.
···
let of_json json =
try
let open Yojson.Safe.Util in
-
let account_id = json |> member "accountId" |> to_string in
+
let account_id_str = json |> member "accountId" |> to_string in
+
let account_id = match Jmap.Id.of_string account_id_str with
+
| Ok id -> id
+
| Error e -> failwith ("Invalid account ID: " ^ e)
+
in
let old_state = json |> member "oldState" |> to_string in
let new_state = json |> member "newState" |> to_string in
let has_more_changes = json |> member "hasMoreChanges" |> to_bool in
-
let created = json |> member "created" |> to_list |> List.map to_string in
-
let updated = json |> member "updated" |> to_list |> List.map to_string in
-
let destroyed = json |> member "destroyed" |> to_list |> List.map to_string in
+
let created = json |> member "created" |> to_list |> List.map (fun id_json ->
+
let id_str = to_string id_json in
+
match Jmap.Id.of_string id_str with
+
| Ok id -> id
+
| Error e -> failwith ("Invalid created ID: " ^ id_str ^ " - " ^ e)
+
) in
+
let updated = json |> member "updated" |> to_list |> List.map (fun id_json ->
+
let id_str = to_string id_json in
+
match Jmap.Id.of_string id_str with
+
| Ok id -> id
+
| Error e -> failwith ("Invalid updated ID: " ^ id_str ^ " - " ^ e)
+
) in
+
let destroyed = json |> member "destroyed" |> to_list |> List.map (fun id_json ->
+
let id_str = to_string id_json in
+
match Jmap.Id.of_string id_str with
+
| Ok id -> id
+
| Error e -> failwith ("Invalid destroyed ID: " ^ id_str ^ " - " ^ e)
+
) in
Ok {
account_id;
old_state;
···
| exn -> Error ("Changes_response JSON parse error: " ^ Printexc.to_string exn)
let pp fmt t =
-
Format.fprintf fmt "Mailbox.Changes_response{account=%s}" t.account_id
+
Format.fprintf fmt "Mailbox.Changes_response{account=%s}" (Jmap.Id.to_string t.account_id)
let pp_hum fmt t = pp fmt t
···
(* JSON serialization for main mailbox type *)
let to_json mailbox =
let base = [
-
("id", `String mailbox.mailbox_id);
+
("id", `String (Jmap.Id.to_string mailbox.mailbox_id));
("name", `String mailbox.name);
-
("sortOrder", `Int mailbox.sort_order);
-
("totalEmails", `Int mailbox.total_emails);
-
("unreadEmails", `Int mailbox.unread_emails);
-
("totalThreads", `Int mailbox.total_threads);
-
("unreadThreads", `Int mailbox.unread_threads);
+
("sortOrder", `Int (Jmap.UInt.to_int mailbox.sort_order));
+
("totalEmails", `Int (Jmap.UInt.to_int mailbox.total_emails));
+
("unreadEmails", `Int (Jmap.UInt.to_int mailbox.unread_emails));
+
("totalThreads", `Int (Jmap.UInt.to_int mailbox.total_threads));
+
("unreadThreads", `Int (Jmap.UInt.to_int mailbox.unread_threads));
("myRights", Rights.to_json mailbox.my_rights);
("isSubscribed", `Bool mailbox.is_subscribed);
] in
let base = match mailbox.parent_id with
-
| Some pid -> ("parentId", `String pid) :: base
+
| Some pid -> ("parentId", `String (Jmap.Id.to_string pid)) :: base
| None -> base
in
let base = match mailbox.role with
···
let of_json json =
try
let open Yojson.Safe.Util in
-
let id = json |> member "id" |> to_string in
+
let id_str = json |> member "id" |> to_string in
+
let id = match Jmap.Id.of_string id_str with
+
| Ok id_val -> id_val
+
| Error e -> failwith ("Invalid mailbox ID: " ^ id_str ^ " - " ^ e)
+
in
let name = json |> member "name" |> to_string in
-
let parent_id = json |> member "parentId" |> to_string_option in
+
let parent_id = json |> member "parentId" |> to_string_option |>
+
Option.map (fun pid_str -> match Jmap.Id.of_string pid_str with
+
| Ok pid -> pid
+
| Error e -> failwith ("Invalid parentId: " ^ pid_str ^ " - " ^ e)) in
let role_opt : (role option, string) result = match json |> member "role" with
| `Null -> Ok None
| role_json ->
···
| Ok r -> Ok (Some r)
| Error e -> Error e
in
-
let sort_order = json |> member "sortOrder" |> to_int in
-
let total_emails = json |> member "totalEmails" |> to_int in
-
let unread_emails = json |> member "unreadEmails" |> to_int in
-
let total_threads = json |> member "totalThreads" |> to_int in
-
let unread_threads = json |> member "unreadThreads" |> to_int in
+
let sort_order = json |> member "sortOrder" |> to_int |> (fun i ->
+
match Jmap.UInt.of_int i with
+
| Ok u -> u
+
| Error e -> failwith ("Invalid sortOrder: " ^ e)) in
+
let total_emails = json |> member "totalEmails" |> to_int |> (fun i ->
+
match Jmap.UInt.of_int i with
+
| Ok u -> u
+
| Error e -> failwith ("Invalid totalEmails: " ^ e)) in
+
let unread_emails = json |> member "unreadEmails" |> to_int |> (fun i ->
+
match Jmap.UInt.of_int i with
+
| Ok u -> u
+
| Error e -> failwith ("Invalid unreadEmails: " ^ e)) in
+
let total_threads = json |> member "totalThreads" |> to_int |> (fun i ->
+
match Jmap.UInt.of_int i with
+
| Ok u -> u
+
| Error e -> failwith ("Invalid totalThreads: " ^ e)) in
+
let unread_threads = json |> member "unreadThreads" |> to_int |> (fun i ->
+
match Jmap.UInt.of_int i with
+
| Ok u -> u
+
| Error e -> failwith ("Invalid unreadThreads: " ^ e)) in
let my_rights_result = json |> member "myRights" |> Rights.of_json in
let is_subscribed = json |> member "isSubscribed" |> to_bool in
match role_opt, my_rights_result with
···
| Some r -> Role.to_string r
| None -> "none"
in
-
Format.fprintf fmt "Mailbox{id=%s; name=%s; role=%s; total=%d}"
-
mailbox.mailbox_id
+
Format.fprintf fmt "Mailbox{Jmap.Id.t=%s; name=%s; role=%s; total=%d}"
+
(Jmap.Id.to_string mailbox.mailbox_id)
mailbox.name
role_str
-
mailbox.total_emails
+
(Jmap.UInt.to_int mailbox.total_emails)
let pp_hum fmt mailbox =
let role_str = match mailbox.role with
···
| None -> "none"
in
let parent_str = match mailbox.parent_id with
-
| Some pid -> Printf.sprintf " (parent: %s)" pid
+
| Some pid -> Printf.sprintf " (parent: %s)" (Jmap.Id.to_string pid)
| None -> ""
in
Format.fprintf fmt "Mailbox \"%s\" [%s]: %d emails (%d unread), %d threads (%d unread)%s"
mailbox.name
role_str
-
mailbox.total_emails
-
mailbox.unread_emails
-
mailbox.total_threads
-
mailbox.unread_threads
+
(Jmap.UInt.to_int mailbox.total_emails)
+
(Jmap.UInt.to_int mailbox.unread_emails)
+
(Jmap.UInt.to_int mailbox.total_threads)
+
(Jmap.UInt.to_int mailbox.unread_threads)
parent_str
(* Filter construction helpers *)
···
Filter.property_equals "role" `Null
let filter_has_parent parent_id =
-
Filter.property_equals "parentId" (`String parent_id)
+
Filter.property_equals "parentId" (`String (Jmap.Id.to_string parent_id))
let filter_is_root () =
Filter.property_equals "parentId" `Null
+70 -71
jmap/jmap-email/mailbox.mli
···
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2> RFC 8621, Section 2: Mailboxes
*)
-
open Jmap.Types
open Jmap.Methods
(** Mailbox role identifiers.
···
include Jmap_sigs.PRINTABLE with type t := t
(** JMAP object interface with property selection support *)
-
include Jmap_sigs.JMAP_OBJECT with type t := t and type id_type := id
+
include Jmap_sigs.JMAP_OBJECT with type t := t and type id_type := string
(** {1 Property Accessors} *)
(** Get the server-assigned mailbox identifier.
@param mailbox The mailbox object
@return Immutable server-assigned identifier (always Some for valid mailboxes) *)
-
val id : t -> id option
+
val id : t -> Jmap.Id.t option
(** Get the server-assigned mailbox identifier directly.
@param mailbox The mailbox object
@return Immutable server-assigned identifier (guaranteed present) *)
-
val mailbox_id : t -> id
+
val mailbox_id : t -> Jmap.Id.t
(** Get the display name for the mailbox.
@param mailbox The mailbox object
···
(** Get the parent mailbox ID for hierarchical organization.
@param mailbox The mailbox object
@return Parent mailbox ID (None for root level) *)
-
val parent_id : t -> id option
+
val parent_id : t -> Jmap.Id.t option
(** Get the functional role identifier for the mailbox.
@param mailbox The mailbox object
···
(** Get the numeric sort order for display positioning.
@param mailbox The mailbox object
@return Display order hint (default: 0) *)
-
val sort_order : t -> uint
+
val sort_order : t -> Jmap.UInt.t
(** Get the total email count (server-computed).
@param mailbox The mailbox object
@return Total email count *)
-
val total_emails : t -> uint
+
val total_emails : t -> Jmap.UInt.t
(** Get the unread email count (server-computed).
@param mailbox The mailbox object
@return Unread email count *)
-
val unread_emails : t -> uint
+
val unread_emails : t -> Jmap.UInt.t
(** Get the total thread count (server-computed).
@param mailbox The mailbox object
@return Total thread count *)
-
val total_threads : t -> uint
+
val total_threads : t -> Jmap.UInt.t
(** Get the unread thread count (server-computed).
@param mailbox The mailbox object
@return Unread thread count *)
-
val unread_threads : t -> uint
+
val unread_threads : t -> Jmap.UInt.t
(** Get the user's access permissions (server-set).
@param mailbox The mailbox object
···
setting all mailbox properties including server-computed values. Used for
constructing complete Mailbox objects from server responses.
-
@param id Server-assigned identifier
+
@param Jmap.Id.t Server-assigned identifier
@param name Display name
@param parent_id Optional parent mailbox
@param role Optional functional role
···
@param is_subscribed Subscription status
@return Ok with mailbox object, or Error with validation message *)
val create_full :
-
id:id ->
+
id:Jmap.Id.t ->
name:string ->
-
?parent_id:id ->
+
?parent_id:Jmap.Id.t ->
?role:role ->
-
?sort_order:uint ->
-
total_emails:uint ->
-
unread_emails:uint ->
-
total_threads:uint ->
-
unread_threads:uint ->
+
?sort_order:Jmap.UInt.t ->
+
total_emails:Jmap.UInt.t ->
+
unread_emails:Jmap.UInt.t ->
+
total_threads:Jmap.UInt.t ->
+
unread_threads:Jmap.UInt.t ->
my_rights:rights ->
is_subscribed:bool ->
unit -> (t, string) result
···
@return Ok with creation object, or Error with validation message *)
val create :
name:string ->
-
?parent_id:id ->
+
?parent_id:Jmap.Id.t ->
?role:role ->
-
?sort_order:uint ->
+
?sort_order:Jmap.UInt.t ->
?is_subscribed:bool ->
unit -> (t, string) result
···
(** Get the parent mailbox ID.
@param create_req The creation request
@return Optional parent mailbox *)
-
val parent_id : t -> id option
+
val parent_id : t -> Jmap.Id.t option
(** Get the role assignment.
@param create_req The creation request
···
(** Get the sort order.
@param create_req The creation request
@return Optional sort order (None means server default) *)
-
val sort_order : t -> uint option
+
val sort_order : t -> Jmap.UInt.t option
(** Get the subscription status.
@param create_req The creation request
···
(** Get the server-assigned mailbox ID.
@param response The creation response
@return Server-assigned mailbox ID *)
-
val id : t -> id
+
val id : t -> Jmap.Id.t
(** Get the role if default was applied.
@param response The creation response
···
(** Get the sort order if default was applied.
@param response The creation response
@return Sort order if default was applied *)
-
val sort_order : t -> uint
+
val sort_order : t -> Jmap.UInt.t
(** Get the initial email count (typically 0).
@param response The creation response
@return Initial email count *)
-
val total_emails : t -> uint
+
val total_emails : t -> Jmap.UInt.t
(** Get the initial unread count (typically 0).
@param response The creation response
@return Initial unread count *)
-
val unread_emails : t -> uint
+
val unread_emails : t -> Jmap.UInt.t
(** Get the initial thread count (typically 0).
@param response The creation response
@return Initial thread count *)
-
val total_threads : t -> uint
+
val total_threads : t -> Jmap.UInt.t
(** Get the initial unread thread count (typically 0).
@param response The creation response
@return Initial unread thread count *)
-
val unread_threads : t -> uint
+
val unread_threads : t -> Jmap.UInt.t
(** Get the computed access rights for the user.
@param response The creation response
···
@return JSON Patch operations for Mailbox/set *)
val create :
?name:string ->
-
?parent_id:id option ->
+
?parent_id:Jmap.Id.t option ->
?role:role option ->
-
?sort_order:uint ->
+
?sort_order:Jmap.UInt.t ->
?is_subscribed:bool ->
unit -> (t, string) result
···
include Jmap_sigs.JSONABLE with type t := t
(** JMAP method arguments interface *)
-
include Jmap_sigs.METHOD_ARGS with type t := t and type account_id := id
+
include Jmap_sigs.METHOD_ARGS with type t := t and type account_id := string
(** Create query arguments for mailboxes.
@param account_id Account to query in
···
@param calculate_total Whether to calculate total count
@return Ok with query arguments, or Error with validation message *)
val create :
-
account_id:id ->
+
account_id:Jmap.Id.t ->
?filter:Filter.t ->
?sort:Comparator.t list ->
-
?position:uint ->
-
?limit:uint ->
+
?position:Jmap.UInt.t ->
+
?limit:Jmap.UInt.t ->
?calculate_total:bool ->
unit -> (t, string) result
(** Get the account ID.
@param args Query arguments
@return Account identifier where mailboxes will be queried *)
-
val account_id : t -> id
+
val account_id : t -> Jmap.Id.t
(** Validate query arguments according to JMAP method constraints.
@param t Query arguments to validate
···
(** Get the starting position.
@param args Query arguments
@return Starting position (0-based) *)
-
val position : t -> uint option
+
val position : t -> Jmap.UInt.t option
(** Get the result limit.
@param args Query arguments
@return Maximum results to return *)
-
val limit : t -> uint option
+
val limit : t -> Jmap.UInt.t option
(** Check if total count should be calculated.
@param args Query arguments
···
include Jmap_sigs.JSONABLE with type t := t
(** JMAP method response interface *)
-
include Jmap_sigs.METHOD_RESPONSE with type t := t and type account_id := id and type state := string
+
include Jmap_sigs.METHOD_RESPONSE with type t := t and type account_id := string and type state := string
(** Get the account ID from the response.
@param response Query response
@return Account identifier where mailboxes were queried *)
-
val account_id : t -> id
+
val account_id : t -> Jmap.Id.t
(** Get the query state for change tracking.
@param response Query response
···
(** Get the starting position of results.
@param response Query response
@return 0-based position of the first returned result *)
-
val position : t -> uint
+
val position : t -> Jmap.UInt.t
(** Get the total count if requested.
@param response Query response
@return Total matching results if calculateTotal was true *)
-
val total : t -> uint option
+
val total : t -> Jmap.UInt.t option
(** Get the matched mailbox IDs.
@param response Query response
@return List of mailbox IDs that matched the query *)
-
val ids : t -> id list
+
val ids : t -> Jmap.Id.t list
end
module Get_args : sig
···
include Jmap_sigs.JSONABLE with type t := t
(** JMAP method arguments interface *)
-
include Jmap_sigs.METHOD_ARGS with type t := t and type account_id := id
+
include Jmap_sigs.METHOD_ARGS with type t := t and type account_id := string
(** Create get arguments for mailboxes.
@param account_id Account to get from
···
@param properties Optional properties to return (None = all properties)
@return Ok with get arguments, or Error with validation message *)
val create :
-
account_id:id ->
-
?ids:id list ->
+
account_id:Jmap.Id.t ->
+
?ids:Jmap.Id.t list ->
?properties:Property.t list ->
unit -> (t, string) result
(** Get the account ID.
@param args Get arguments
@return Account identifier where mailboxes will be retrieved from *)
-
val account_id : t -> id
+
val account_id : t -> Jmap.Id.t
(** Validate get arguments according to JMAP method constraints.
@param t Get arguments to validate
···
(** Get the specific IDs to retrieve.
@param args Get arguments
@return Optional list of mailbox IDs (None = all mailboxes) *)
-
val ids : t -> id list option
+
val ids : t -> Jmap.Id.t list option
(** Get the properties to return.
@param args Get arguments
···
include Jmap_sigs.JSONABLE with type t := t
(** JMAP method response interface *)
-
include Jmap_sigs.METHOD_RESPONSE with type t := t and type account_id := id and type state := string
+
include Jmap_sigs.METHOD_RESPONSE with type t := t and type account_id := string and type state := string
(** Get the account ID from the response.
@param response Get response
@return Account identifier where mailboxes were retrieved from *)
-
val account_id : t -> id
+
val account_id : t -> Jmap.Id.t
(** Get the state for change tracking.
@param response Get response
···
(** Get the IDs that were not found.
@param response Get response
@return List of requested IDs that were not found *)
-
val not_found : t -> id list
+
val not_found : t -> Jmap.Id.t list
end
module Set_args : sig
···
include Jmap_sigs.JSONABLE with type t := t
(** JMAP method arguments interface *)
-
include Jmap_sigs.METHOD_ARGS with type t := t and type account_id := id
+
include Jmap_sigs.METHOD_ARGS with type t := t and type account_id := string
(** Create set arguments for mailboxes.
@param account_id Account to modify
···
(** Get the account ID.
@param args Set arguments
@return Account identifier where mailboxes will be modified *)
-
val account_id : t -> id
+
val account_id : t -> Jmap.Id.t
(** Validate set arguments according to JMAP method constraints.
@param t Set arguments to validate
···
(** Get the mailboxes to update.
@param args Set arguments
@return Map of mailbox IDs to update objects *)
-
val update : t -> (id * Update.t) list
+
val update : t -> (Jmap.Id.t * Update.t) list
(** Get the mailboxes to destroy.
@param args Set arguments
@return List of mailbox IDs to destroy *)
-
val destroy : t -> id list
+
val destroy : t -> Jmap.Id.t list
end
module Set_response : sig
···
include Jmap_sigs.JSONABLE with type t := t
(** JMAP method response interface *)
-
include Jmap_sigs.METHOD_RESPONSE with type t := t and type account_id := id and type state := string
+
include Jmap_sigs.METHOD_RESPONSE with type t := t and type account_id := string and type state := string
(** Get the account ID from the response.
@param response Set response
@return Account identifier where mailboxes were modified *)
-
val account_id : t -> id
+
val account_id : t -> Jmap.Id.t
(** Get the old state before modifications.
@param response Set response
···
(** Get the successfully updated mailboxes.
@param response Set response
@return Map of mailbox IDs to update response objects *)
-
val updated : t -> (id * Update.Response.t) list
+
val updated : t -> (Jmap.Id.t * Update.Response.t) list
(** Get the successfully destroyed mailbox IDs.
@param response Set response
@return List of mailbox IDs that were destroyed *)
-
val destroyed : t -> id list
+
val destroyed : t -> Jmap.Id.t list
(** Get the creation failures.
@param response Set response
···
(** Get the update failures.
@param response Set response
@return Map of mailbox IDs to error objects *)
-
val not_updated : t -> (id * Jmap.Error.Set_error.t) list
+
val not_updated : t -> (Jmap.Id.t * Jmap.Error.Set_error.t) list
(** Get the destruction failures.
@param response Set response
@return Map of mailbox IDs to error objects *)
-
val not_destroyed : t -> (id * Jmap.Error.Set_error.t) list
+
val not_destroyed : t -> (Jmap.Id.t * Jmap.Error.Set_error.t) list
end
module Changes_args : sig
···
include Jmap_sigs.JSONABLE with type t := t
(** JMAP method arguments interface *)
-
include Jmap_sigs.METHOD_ARGS with type t := t and type account_id := id
+
include Jmap_sigs.METHOD_ARGS with type t := t and type account_id := string
(** Create changes arguments for mailboxes.
@param account_id Account to check for changes
···
@param max_changes Maximum number of changed IDs to return
@return Ok with changes arguments, or Error with validation message *)
val create :
-
account_id:id ->
+
account_id:Jmap.Id.t ->
since_state:string ->
-
?max_changes:uint ->
+
?max_changes:Jmap.UInt.t ->
unit -> (t, string) result
(** Get the account ID.
@param args Changes arguments
@return Account identifier to check for changes *)
-
val account_id : t -> id
+
val account_id : t -> Jmap.Id.t
(** Validate changes arguments according to JMAP method constraints.
@param t Changes arguments to validate
···
(** Get the maximum changes limit.
@param args Changes arguments
@return Maximum number of changed IDs to return *)
-
val max_changes : t -> uint option
+
val max_changes : t -> Jmap.UInt.t option
end
module Changes_response : sig
···
include Jmap_sigs.JSONABLE with type t := t
(** JMAP method response interface *)
-
include Jmap_sigs.METHOD_RESPONSE with type t := t and type account_id := id and type state := string
+
include Jmap_sigs.METHOD_RESPONSE with type t := t and type account_id := string and type state := string
(** Get the account ID from the response.
@param response Changes response
@return Account identifier where changes were checked *)
-
val account_id : t -> id
+
val account_id : t -> Jmap.Id.t
(** Get the old state.
@param response Changes response
···
(** Get the created mailbox IDs.
@param response Changes response
@return List of mailbox IDs that were created *)
-
val created : t -> id list
+
val created : t -> Jmap.Id.t list
(** Get the updated mailbox IDs.
@param response Changes response
@return List of mailbox IDs that were updated *)
-
val updated : t -> id list
+
val updated : t -> Jmap.Id.t list
(** Get the destroyed mailbox IDs.
@param response Changes response
@return List of mailbox IDs that were destroyed *)
-
val destroyed : t -> id list
+
val destroyed : t -> Jmap.Id.t list
end
(** {1 Filter Construction}
···
(** Create a filter to match child mailboxes of a specific parent.
@param parent_id The parent mailbox ID to match
@return Filter condition for mailboxes with the specified parent *)
-
val filter_has_parent : id -> Filter.t
+
val filter_has_parent : Jmap.Id.t -> Filter.t
(** Create a filter to match root-level mailboxes.
@return Filter condition matching mailboxes where parentId is null *)
+11 -9
jmap/jmap-email/query.ml
···
open Jmap.Methods.Filter
(* Email-specific filter constructors using core utilities *)
-
let in_mailbox (mailbox_id : Jmap.Types.id) =
-
condition (`Assoc [("inMailbox", `String mailbox_id)])
+
let in_mailbox (mailbox_id : Jmap.Id.t) =
+
condition (`Assoc [("inMailbox", `String (Jmap.Id.to_string mailbox_id))])
let in_mailbox_role role =
condition (`Assoc [("inMailboxOtherThan", `List [`String role])])
···
end
type query_builder = {
-
account_id : Jmap.Types.id option;
+
account_id : string option;
filter : Filter.t option;
sort : Sort.t list;
-
limit_count : Jmap.Types.uint option;
-
position : Jmap.Types.jint option;
+
limit_count : Jmap.UInt.t option;
+
position : int option;
properties : property list;
collapse_threads : bool;
calculate_total : bool;
···
}
let with_account account_id builder =
-
{ builder with account_id = Some account_id }
+
{ builder with account_id = Some (Jmap.Id.to_string account_id) }
let where filter builder =
{ builder with filter = Some filter }
···
{ builder with sort = [sort] }
let limit n builder =
-
{ builder with limit_count = Some n }
+
match Jmap.UInt.of_int n with
+
| Ok uint -> { builder with limit_count = Some uint }
+
| Error _ -> failwith ("Invalid limit value: " ^ string_of_int n)
let offset n builder =
{ builder with position = Some n }
···
?filter:builder.filter
~sort:builder.sort
?position:builder.position
-
?limit:builder.limit_count
+
?limit:(Option.map Jmap.UInt.to_int builder.limit_count)
?calculate_total:(Some builder.calculate_total)
?collapse_threads:(Some builder.collapse_threads)
()
···
let build_email_get_with_ref ~account_id ~properties ~result_of =
let property_strings = Property.to_string_list properties in
`Assoc [
-
("accountId", `String account_id);
+
("accountId", `String (Jmap.Id.to_string account_id));
("properties", `List (List.map (fun s -> `String s) property_strings));
("#ids", `Assoc [
("resultOf", `String result_of);
+3 -3
jmap/jmap-email/query.mli
···
type t = Jmap.Methods.Filter.t
(** Filter by mailbox *)
-
val in_mailbox : Jmap.Types.id -> t
+
val in_mailbox : Jmap.Id.t -> t
(** Filter by mailbox role (e.g., "inbox", "sent", "drafts") *)
val in_mailbox_role : string -> t
···
val query : unit -> query_builder
(** Set the account ID (uses primary mail account if not set) *)
-
val with_account : Jmap.Types.id -> query_builder -> query_builder
+
val with_account : Jmap.Id.t -> query_builder -> query_builder
(** Add a filter condition *)
val where : Filter.t -> query_builder -> query_builder
···
@param result_of Method call ID to reference (e.g., "q1")
@return JSON object for Email/get method arguments *)
val build_email_get_with_ref :
-
account_id:Jmap.Types.id ->
+
account_id:Jmap.Id.t ->
properties:property list ->
result_of:string ->
Yojson.Safe.t
+4 -4
jmap/jmap-email/response.ml
···
(** Extract IDs from a Query_response *)
let ids_from_query_response response =
-
Query_response.ids response
+
List.map (fun s -> match Jmap.Id.of_string s with Ok id -> id | Error e -> failwith e) (Query_response.ids response)
(** Check if there are more changes in a Changes_response *)
let has_more_changes response =
···
(** Get created IDs from a Changes_response *)
let created_ids response =
-
Changes_response.created response
+
List.map (fun s -> match Jmap.Id.of_string s with Ok id -> id | Error e -> failwith e) (Changes_response.created response)
(** Get updated IDs from a Changes_response *)
let updated_ids response =
-
Changes_response.updated response
+
List.map (fun s -> match Jmap.Id.of_string s with Ok id -> id | Error e -> failwith e) (Changes_response.updated response)
(** Get destroyed IDs from a Changes_response *)
let destroyed_ids response =
-
Changes_response.destroyed response
+
List.map (fun s -> match Jmap.Id.of_string s with Ok id -> id | Error e -> failwith e) (Changes_response.destroyed response)
(** Response builder for batched requests *)
module Batch = struct
+4 -5
jmap/jmap-email/response.mli
···
@see <https://www.rfc-editor.org/rfc/rfc8621.html> RFC 8621 *)
-
open Jmap.Types
open Jmap.Methods
(** {1 Response Parsers} *)
···
(** Extract IDs from a Query_response.
@param response The parsed Query_response
@return List of Email IDs *)
-
val ids_from_query_response : Query_response.t -> id list
+
val ids_from_query_response : Query_response.t -> Jmap.Id.t list
(** Check if there are more changes in a Changes_response.
@param response The parsed Changes_response
···
(** Get created IDs from a Changes_response.
@param response The parsed Changes_response
@return List of newly created Email IDs *)
-
val created_ids : Changes_response.t -> id list
+
val created_ids : Changes_response.t -> Jmap.Id.t list
(** Get updated IDs from a Changes_response.
@param response The parsed Changes_response
@return List of updated Email IDs *)
-
val updated_ids : Changes_response.t -> id list
+
val updated_ids : Changes_response.t -> Jmap.Id.t list
(** Get destroyed IDs from a Changes_response.
@param response The parsed Changes_response
@return List of destroyed Email IDs *)
-
val destroyed_ids : Changes_response.t -> id list
+
val destroyed_ids : Changes_response.t -> Jmap.Id.t list
(** {1 Batch Response Handling} *)
+31 -21
jmap/jmap-email/search.ml
···
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-5> RFC 8621, Section 5: SearchSnippet
*)
-
open Jmap.Types
open Jmap.Methods
(** SearchSnippet object *)
module SearchSnippet = struct
type t = {
-
email_id : id;
+
email_id : Jmap.Id.t;
subject : string option;
preview : string option;
}
···
let to_json t =
let fields = [
-
("emailId", `String t.email_id);
+
("emailId", `String (Jmap.Id.to_string t.email_id));
] in
let fields = match t.subject with
| Some s -> ("subject", `String s) :: fields
···
let of_json = function
| `Assoc fields ->
(match List.assoc_opt "emailId" fields with
-
| Some (`String email_id) ->
+
| Some (`String email_id_str) ->
+
let email_id = match Jmap.Id.of_string email_id_str with
+
| Ok id -> id
+
| Error _ -> failwith ("Invalid email ID: " ^ email_id_str) in
let subject = match List.assoc_opt "subject" fields with
| Some (`String s) -> Some s
| Some `Null | None -> None
···
let pp ppf t =
Format.fprintf ppf "SearchSnippet{emailId=%s; subject=%s; preview=%s}"
-
t.email_id
+
(Jmap.Id.to_string t.email_id)
(match t.subject with Some s -> "\"" ^ s ^ "\"" | None -> "None")
-
(match t.preview with Some p -> "\"" ^ String.sub p 0 (min 50 (String.length p)) ^ "...\"" | None -> "None")
+
(match t.preview with Some p -> "\"" ^ String.sub p 0 (Int.min 50 (String.length p)) ^ "...\"" | None -> "None")
let pp_hum = pp
end
···
(** Arguments for SearchSnippet/get *)
module Get_args = struct
type t = {
-
account_id : id;
+
account_id : Jmap.Id.t;
filter : Filter.t;
-
email_ids : id list option;
+
email_ids : Jmap.Id.t list option;
}
let account_id t = t.account_id
···
let to_json t =
let fields = [
-
("accountId", `String t.account_id);
+
("accountId", `String (Jmap.Id.to_string t.account_id));
("filter", Filter.to_json t.filter);
] in
let fields = match t.email_ids with
-
| Some ids -> ("emailIds", `List (List.map (fun id -> `String id) ids)) :: fields
+
| Some ids -> ("emailIds", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) ids)) :: fields
| None -> fields
in
`Assoc fields
···
match json with
| `Assoc fields ->
let account_id = match List.assoc_opt "accountId" fields with
-
| Some (`String id) -> id
+
| Some (`String id) -> (match Jmap.Id.of_string id with
+
| Ok id -> id
+
| Error err -> failwith ("Invalid accountId: " ^ err))
| _ -> failwith "Missing or invalid accountId"
in
let filter = match List.assoc_opt "filter" fields with
···
| _ -> failwith "Missing or invalid filter"
in
let email_ids = match List.assoc_opt "emailIds" fields with
-
| Some (`List ids) -> Some (List.map (function `String id -> id | _ -> failwith "Invalid email ID") ids)
+
| Some (`List ids) -> Some (List.map (function `String id -> (match Jmap.Id.of_string id with Ok id -> id | Error err -> failwith ("Invalid email ID: " ^ err)) | _ -> failwith "Invalid email ID") ids)
| Some `Null | None -> None
| _ -> failwith "Invalid emailIds field"
in
···
let pp fmt t =
Format.fprintf fmt "SearchSnippet.Get_args{account=%s;emails=%s}"
-
t.account_id
+
(Jmap.Id.to_string t.account_id)
(match t.email_ids with Some ids -> string_of_int (List.length ids) | None -> "all")
let pp_hum fmt t = pp fmt t
···
(** Response for SearchSnippet/get *)
module Get_response = struct
type t = {
-
account_id : id;
-
list : SearchSnippet.t id_map;
-
not_found : id list;
+
account_id : Jmap.Id.t;
+
list : (string, SearchSnippet.t) Hashtbl.t;
+
not_found : Jmap.Id.t list;
}
let account_id t = t.account_id
···
let to_json t =
`Assoc [
-
("accountId", `String t.account_id);
+
("accountId", `String (Jmap.Id.to_string t.account_id));
("list", `Assoc (Hashtbl.fold (fun k v acc -> (k, SearchSnippet.to_json v) :: acc) t.list []));
-
("notFound", `List (List.map (fun id -> `String id) t.not_found));
+
("notFound", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) t.not_found));
]
let of_json json =
···
match json with
| `Assoc fields ->
let account_id = match List.assoc_opt "accountId" fields with
-
| Some (`String id) -> id
+
| Some (`String id_str) -> (match Jmap.Id.of_string id_str with
+
| Ok id -> id
+
| Error _ -> failwith ("Invalid account ID: " ^ id_str))
| _ -> failwith "Missing or invalid accountId"
in
let list = Hashtbl.create 16 in
let not_found = match List.assoc_opt "notFound" fields with
-
| Some (`List ids) -> List.map (function `String id -> id | _ -> failwith "Invalid not found ID") ids
+
| Some (`List ids) -> List.map (function
+
| `String id_str -> (match Jmap.Id.of_string id_str with
+
| Ok id -> id
+
| Error _ -> failwith ("Invalid ID: " ^ id_str))
+
| _ -> failwith "Invalid not found ID") ids
| Some `Null | None -> []
| _ -> failwith "Invalid notFound field"
in
···
let pp fmt t =
Format.fprintf fmt "SearchSnippet.Get_response{account=%s;found=%d;not_found=%d}"
-
t.account_id
+
(Jmap.Id.to_string t.account_id)
(Hashtbl.length t.list)
(List.length t.not_found)
+12 -13
jmap/jmap-email/search.mli
···
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-5> RFC 8621, Section 5: SearchSnippet
*)
-
open Jmap.Types
open Jmap.Methods
(** SearchSnippet object representation.
···
(** Get the email ID this snippet corresponds to.
@return ID of the email that contains the matching content *)
-
val email_id : t -> id
+
val email_id : t -> Jmap.Id.t
(** Get the highlighted subject snippet.
@return Optional highlighted subject text with search matches marked *)
···
@param preview Optional highlighted body/preview text
@return New SearchSnippet object *)
val v :
-
email_id:id ->
+
email_id:Jmap.Id.t ->
?subject:string ->
?preview:string ->
unit -> t
···
(** Get the account ID for the search operation.
@return Account where emails will be searched for snippets *)
-
val account_id : t -> id
+
val account_id : t -> Jmap.Id.t
(** Get the search filter defining what to search for.
@return Filter condition that will generate the highlighted snippets *)
···
(** Get the specific email IDs to generate snippets for.
@return Optional list of email IDs, or None to include all matching emails *)
-
val email_ids : t -> id list option
+
val email_ids : t -> Jmap.Id.t list option
(** Create SearchSnippet/get arguments.
@param account_id Account to search within
···
@param email_ids Optional specific email IDs to generate snippets for
@return SearchSnippet/get arguments *)
val v :
-
account_id:id ->
+
account_id:Jmap.Id.t ->
filter:Filter.t ->
-
?email_ids:id list ->
+
?email_ids:Jmap.Id.t list ->
unit -> t
end
···
(** Get the account ID from the response.
@return Account where snippets were generated *)
-
val account_id : t -> id
+
val account_id : t -> Jmap.Id.t
(** Get the map of email IDs to their search snippets.
@return Map containing SearchSnippet objects keyed by email ID *)
-
val list : t -> SearchSnippet.t id_map
+
val list : t -> (string, SearchSnippet.t) Hashtbl.t
(** Get the list of email IDs that were not found.
@return List of requested email IDs that don't exist or don't match the filter *)
-
val not_found : t -> id list
+
val not_found : t -> Jmap.Id.t list
(** Create SearchSnippet/get response.
@param account_id Account where snippets were generated
···
@param not_found List of email IDs that were not found
@return SearchSnippet/get response *)
val v :
-
account_id:id ->
-
list:SearchSnippet.t id_map ->
-
not_found:id list ->
+
account_id:Jmap.Id.t ->
+
list:(string, SearchSnippet.t) Hashtbl.t ->
+
not_found:Jmap.Id.t list ->
unit -> t
end
+29 -23
jmap/jmap-email/set.ml
···
(** Email set operations using core JMAP Set_args *)
-
open Jmap.Types
open Jmap.Methods
(** Email creation arguments *)
module Create = struct
type t = {
-
mailbox_ids : (id * bool) list;
+
mailbox_ids : (Jmap.Id.t * bool) list;
keywords : (Keywords.keyword * bool) list;
-
received_at : Jmap.Types.utc_date option;
+
received_at : Jmap.Date.t option;
(* Additional fields as needed *)
}
···
let to_json t : Yojson.Safe.t =
let fields = [
-
("mailboxIds", (`Assoc (List.map (fun (id, v) -> (id, `Bool v)) t.mailbox_ids) : Yojson.Safe.t));
+
("mailboxIds", (`Assoc (List.map (fun (id, v) -> (Jmap.Id.to_string id, `Bool v)) t.mailbox_ids) : Yojson.Safe.t));
("keywords", (`Assoc (List.map (fun (kw, v) -> (Keywords.keyword_to_string kw, `Bool v)) t.keywords) : Yojson.Safe.t));
] in
let fields = match t.received_at with
-
| Some timestamp -> ("receivedAt", (`String (Jmap.Date.of_timestamp timestamp |> Jmap.Date.to_rfc3339) : Yojson.Safe.t)) :: fields
+
| Some timestamp -> ("receivedAt", (Jmap.Date.to_json timestamp : Yojson.Safe.t)) :: fields
| None -> fields
in
(`Assoc fields : Yojson.Safe.t)
···
let move_to_mailbox mailbox_id patch =
(* Clear all existing mailboxes and set new one *)
+
let mailbox_id_str = Jmap.Id.to_string mailbox_id in
let clear_mailboxes = ("mailboxIds", `Null) :: patch in
-
("mailboxIds/" ^ mailbox_id, `Bool true) :: clear_mailboxes
+
("mailboxIds/" ^ mailbox_id_str, `Bool true) :: clear_mailboxes
let add_to_mailbox mailbox_id patch =
-
("mailboxIds/" ^ mailbox_id, `Bool true) :: patch
+
let mailbox_id_str = Jmap.Id.to_string mailbox_id in
+
("mailboxIds/" ^ mailbox_id_str, `Bool true) :: patch
let remove_from_mailbox mailbox_id patch =
-
("mailboxIds/" ^ mailbox_id, `Null) :: patch
+
let mailbox_id_str = Jmap.Id.to_string mailbox_id in
+
("mailboxIds/" ^ mailbox_id_str, `Null) :: patch
let to_patch_object patch : patch_object = patch
end
(** Build Email/set arguments *)
let build_set_args ~account_id ?if_in_state ?create ?update ?destroy () =
+
let account_id_str = Jmap.Id.to_string account_id in
+
let destroy_str_list = match destroy with
+
| Some id_list -> Some (List.map Jmap.Id.to_string id_list)
+
| None -> None in
Set_args.v
-
~account_id
+
~account_id:account_id_str
?if_in_state
?create
?update
-
?destroy
+
?destroy:destroy_str_list
()
(** Convert Email/set arguments to JSON *)
···
(** Mark emails as read *)
let mark_as_read ~account_id email_ids =
-
let update_map : patch_object id_map = Hashtbl.create (List.length email_ids) in
+
let update_map : (string, patch_object) Hashtbl.t = Hashtbl.create (List.length email_ids) in
List.iter (fun id ->
-
Hashtbl.add update_map id (Update.add_keyword Keywords.Seen [])
+
Hashtbl.add update_map (Jmap.Id.to_string id) (Update.add_keyword Keywords.Seen [])
) email_ids;
build_set_args ~account_id ~update:update_map ()
(** Mark emails as unread *)
let mark_as_unread ~account_id email_ids =
-
let update_map : patch_object id_map = Hashtbl.create (List.length email_ids) in
+
let update_map : (string, patch_object) Hashtbl.t = Hashtbl.create (List.length email_ids) in
List.iter (fun id ->
-
Hashtbl.add update_map id (Update.remove_keyword Keywords.Seen [])
+
Hashtbl.add update_map (Jmap.Id.to_string id) (Update.remove_keyword Keywords.Seen [])
) email_ids;
build_set_args ~account_id ~update:update_map ()
(** Flag/star emails *)
let flag_emails ~account_id email_ids =
-
let update_map : patch_object id_map = Hashtbl.create (List.length email_ids) in
+
let update_map : (string, patch_object) Hashtbl.t = Hashtbl.create (List.length email_ids) in
List.iter (fun id ->
-
Hashtbl.add update_map id (Update.add_keyword Keywords.Flagged [])
+
Hashtbl.add update_map (Jmap.Id.to_string id) (Update.add_keyword Keywords.Flagged [])
) email_ids;
build_set_args ~account_id ~update:update_map ()
(** Unflag/unstar emails *)
let unflag_emails ~account_id email_ids =
-
let update_map : patch_object id_map = Hashtbl.create (List.length email_ids) in
+
let update_map : (string, patch_object) Hashtbl.t = Hashtbl.create (List.length email_ids) in
List.iter (fun id ->
-
Hashtbl.add update_map id (Update.remove_keyword Keywords.Flagged [])
+
Hashtbl.add update_map (Jmap.Id.to_string id) (Update.remove_keyword Keywords.Flagged [])
) email_ids;
build_set_args ~account_id ~update:update_map ()
(** Move emails to a mailbox *)
let move_to_mailbox ~account_id ~mailbox_id email_ids =
-
let update_map : patch_object id_map = Hashtbl.create (List.length email_ids) in
+
let update_map : (string, patch_object) Hashtbl.t = Hashtbl.create (List.length email_ids) in
List.iter (fun id ->
-
Hashtbl.add update_map id (Update.move_to_mailbox mailbox_id [])
+
Hashtbl.add update_map (Jmap.Id.to_string id) (Update.move_to_mailbox mailbox_id [])
) email_ids;
build_set_args ~account_id ~update:update_map ()
···
(** Batch update multiple properties *)
let batch_update ~account_id updates =
-
let update_map : patch_object id_map = Hashtbl.create (List.length updates) in
+
let update_map : (string, patch_object) Hashtbl.t = Hashtbl.create (List.length updates) in
List.iter (fun (id, patch) ->
-
Hashtbl.add update_map id patch
+
Hashtbl.add update_map (Jmap.Id.to_string id) patch
) updates;
build_set_args ~account_id ~update:update_map ()
···
(* Note: subject, from, to_, cc, bcc, text_body, html_body would need proper implementation
with full email creation support. For now, just creating basic structure. *)
let creation = Create.make ~mailbox_ids ?keywords () in
-
let create_map : Create.t id_map = Hashtbl.create 1 in
+
let create_map : (string, Create.t) Hashtbl.t = Hashtbl.create 1 in
Hashtbl.add create_map "draft-1" creation;
build_set_args ~account_id ~create:create_map ()
+26 -27
jmap/jmap-email/set.mli
···
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.5> RFC 8621 Section 4.5 *)
-
open Jmap.Types
open Jmap.Methods
(** {1 Email Creation} *)
···
@param ?received_at Optional received timestamp
@return Email creation arguments *)
val make :
-
mailbox_ids:(id * bool) list ->
+
mailbox_ids:(Jmap.Id.t * bool) list ->
?keywords:(Keywords.keyword * bool) list ->
-
?received_at:Jmap.Types.utc_date ->
+
?received_at:Jmap.Date.t ->
unit -> t
(** Convert creation arguments to JSON *)
···
val remove_keyword : Keywords.keyword -> patch_object -> patch_object
(** Move to a single mailbox (removes from all others) *)
-
val move_to_mailbox : id -> patch_object -> patch_object
+
val move_to_mailbox : Jmap.Id.t -> patch_object -> patch_object
(** Add to a mailbox (keeps existing) *)
-
val add_to_mailbox : id -> patch_object -> patch_object
+
val add_to_mailbox : Jmap.Id.t -> patch_object -> patch_object
(** Remove from a mailbox *)
-
val remove_from_mailbox : id -> patch_object -> patch_object
+
val remove_from_mailbox : Jmap.Id.t -> patch_object -> patch_object
(** Convert to patch object for Set_args *)
val to_patch_object : patch_object -> patch_object
···
@param ?destroy Optional list of email IDs to destroy
@return Set_args for Email/set method *)
val build_set_args :
-
account_id:id ->
+
account_id:Jmap.Id.t ->
?if_in_state:string ->
-
?create:Create.t id_map ->
-
?update:patch_object id_map ->
-
?destroy:id list ->
+
?create:(string, Create.t) Hashtbl.t ->
+
?update:(string, patch_object) Hashtbl.t ->
+
?destroy:Jmap.Id.t list ->
unit ->
(Create.t, patch_object) Set_args.t
···
@param email_ids List of email IDs to mark as read
@return Set_args for marking emails as read *)
val mark_as_read :
-
account_id:id ->
-
id list ->
+
account_id:Jmap.Id.t ->
+
Jmap.Id.t list ->
(Create.t, patch_object) Set_args.t
(** Mark emails as unread by removing $seen keyword.
···
@param email_ids List of email IDs to mark as unread
@return Set_args for marking emails as unread *)
val mark_as_unread :
-
account_id:id ->
-
id list ->
+
account_id:Jmap.Id.t ->
+
Jmap.Id.t list ->
(Create.t, patch_object) Set_args.t
(** Flag/star emails by adding $flagged keyword.
···
@param email_ids List of email IDs to flag
@return Set_args for flagging emails *)
val flag_emails :
-
account_id:id ->
-
id list ->
+
account_id:Jmap.Id.t ->
+
Jmap.Id.t list ->
(Create.t, patch_object) Set_args.t
(** Unflag/unstar emails by removing $flagged keyword.
···
@param email_ids List of email IDs to unflag
@return Set_args for unflagging emails *)
val unflag_emails :
-
account_id:id ->
-
id list ->
+
account_id:Jmap.Id.t ->
+
Jmap.Id.t list ->
(Create.t, patch_object) Set_args.t
(** Move emails to a specific mailbox.
···
@param email_ids List of email IDs to move
@return Set_args for moving emails *)
val move_to_mailbox :
-
account_id:id ->
-
mailbox_id:id ->
-
id list ->
+
account_id:Jmap.Id.t ->
+
mailbox_id:Jmap.Id.t ->
+
Jmap.Id.t list ->
(Create.t, patch_object) Set_args.t
(** Delete emails (destroy or move to trash).
···
@param email_ids List of email IDs to delete
@return Set_args for deleting emails *)
val delete_emails :
-
account_id:id ->
+
account_id:Jmap.Id.t ->
?destroy:bool ->
-
id list ->
+
Jmap.Id.t list ->
(Create.t, patch_object) Set_args.t
(** Batch update multiple emails with different patches.
···
@param updates List of (email_id, patch_object) pairs
@return Set_args for batch updates *)
val batch_update :
-
account_id:id ->
-
(id * patch_object) list ->
+
account_id:Jmap.Id.t ->
+
(Jmap.Id.t * patch_object) list ->
(Create.t, patch_object) Set_args.t
(** Create a draft email.
···
@param ?html_body Optional HTML body
@return Set_args for creating a draft *)
val create_draft :
-
account_id:id ->
-
mailbox_ids:(id * bool) list ->
+
account_id:Jmap.Id.t ->
+
mailbox_ids:(Jmap.Id.t * bool) list ->
?keywords:(Keywords.keyword * bool) list ->
?subject:string ->
?from:string ->
+104 -85
jmap/jmap-email/submission.ml
···
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7> RFC 8621, Section 7: EmailSubmission
*)
-
open Jmap.Types
(** {1 Internal Type Representations} *)
(** Internal EmailSubmission representation *)
type submission_data = {
-
id : id;
-
identity_id : id;
-
email_id : id;
-
thread_id : id;
+
id : Jmap.Id.t;
+
identity_id : Jmap.Id.t;
+
email_id : Jmap.Id.t;
+
thread_id : Jmap.Id.t;
envelope : envelope_data option;
-
send_at : utc_date;
+
send_at : Jmap.Date.t;
undo_status : [`Pending | `Final | `Canceled];
-
delivery_status : delivery_status_data string_map option;
-
dsn_blob_ids : id list;
-
mdn_blob_ids : id list;
+
delivery_status : (string, delivery_status_data) Hashtbl.t option;
+
dsn_blob_ids : Jmap.Id.t list;
+
mdn_blob_ids : Jmap.Id.t list;
}
(** Internal envelope representation *)
···
(** Internal envelope address representation *)
and envelope_address_data = {
email : string;
-
parameters : Yojson.Safe.t string_map option;
+
parameters : (string, Yojson.Safe.t) Hashtbl.t option;
}
(** Internal delivery status representation *)
···
(** Convert submission to JSON *)
let to_json submission =
let base = [
-
("id", `String submission.id);
-
("identityId", `String submission.identity_id);
-
("emailId", `String submission.email_id);
-
("threadId", `String submission.thread_id);
-
("sendAt", `Float submission.send_at);
+
("id", `String (Jmap.Id.to_string submission.id));
+
("identityId", `String (Jmap.Id.to_string submission.identity_id));
+
("emailId", `String (Jmap.Id.to_string submission.email_id));
+
("threadId", `String (Jmap.Id.to_string submission.thread_id));
+
("sendAt", `Float (Jmap.Date.to_timestamp submission.send_at));
("undoStatus", `String (undo_status_to_string submission.undo_status));
-
("dsnBlobIds", `List (List.map (fun id -> `String id) submission.dsn_blob_ids));
-
("mdnBlobIds", `List (List.map (fun id -> `String id) submission.mdn_blob_ids));
+
("dsnBlobIds", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) submission.dsn_blob_ids));
+
("mdnBlobIds", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) submission.mdn_blob_ids));
] in
let fields = match submission.envelope with
| Some _env -> ("envelope", `Null) :: base (* Envelope serialization not implemented *)
···
(** Format EmailSubmission for debugging *)
let pp ppf submission =
-
let send_at_str = Printf.sprintf "%.0f" submission.send_at in
+
let send_at_str = Printf.sprintf "%.0f" (Jmap.Date.to_timestamp submission.send_at) in
let undo_status_str = undo_status_to_string submission.undo_status in
-
Format.fprintf ppf "EmailSubmission{id=%s; email_id=%s; thread_id=%s; identity_id=%s; send_at=%s; undo_status=%s}"
-
submission.id
-
submission.email_id
-
submission.thread_id
-
submission.identity_id
+
Format.fprintf ppf "EmailSubmission{Id.t=%s; email_id=%s; thread_id=%s; identity_id=%s; send_at=%s; undo_status=%s}"
+
(Jmap.Id.to_string submission.id)
+
(Jmap.Id.to_string submission.email_id)
+
(Jmap.Id.to_string submission.thread_id)
+
(Jmap.Id.to_string submission.identity_id)
send_at_str
undo_status_str
(** Format EmailSubmission for human reading *)
let pp_hum ppf submission =
-
let send_at_str = Printf.sprintf "%.0f" submission.send_at in
+
let send_at_str = Printf.sprintf "%.0f" (Jmap.Date.to_timestamp submission.send_at) in
let undo_status_str = undo_status_to_string submission.undo_status in
let envelope_str = match submission.envelope with
| None -> "none"
···
| None -> "none"
| Some tbl -> Printf.sprintf "%d recipients" (Hashtbl.length tbl)
in
-
Format.fprintf ppf "EmailSubmission {\n id: %s\n email_id: %s\n thread_id: %s\n identity_id: %s\n send_at: %s\n undo_status: %s\n envelope: %s\n delivery_status: %s\n dsn_blob_ids: %d\n mdn_blob_ids: %d\n}"
-
submission.id
-
submission.email_id
-
submission.thread_id
-
submission.identity_id
+
Format.fprintf ppf "EmailSubmission {\n Id.t: %s\n email_id: %s\n thread_id: %s\n identity_id: %s\n send_at: %s\n undo_status: %s\n envelope: %s\n delivery_status: %s\n dsn_blob_ids: %d\n mdn_blob_ids: %d\n}"
+
(Jmap.Id.to_string submission.id)
+
(Jmap.Id.to_string submission.email_id)
+
(Jmap.Id.to_string submission.thread_id)
+
(Jmap.Id.to_string submission.identity_id)
send_at_str
undo_status_str
envelope_str
···
in
let get_optional_field name = try Some (get_field name) with Not_found -> None in
-
let id = get_string_field "id" in
-
let identity_id = get_string_field "identityId" in
-
let email_id = get_string_field "emailId" in
-
let thread_id = get_string_field "threadId" in
-
let send_at = get_float_field "sendAt" in
+
let id = match Jmap.Id.of_string (get_string_field "id") with
+
| Ok id -> id | Error err -> failwith ("Invalid id: " ^ err) in
+
let identity_id = match Jmap.Id.of_string (get_string_field "identityId") with
+
| Ok id -> id | Error err -> failwith ("Invalid identityId: " ^ err) in
+
let email_id = match Jmap.Id.of_string (get_string_field "emailId") with
+
| Ok id -> id | Error err -> failwith ("Invalid emailId: " ^ err) in
+
let thread_id = match Jmap.Id.of_string (get_string_field "threadId") with
+
| Ok id -> id | Error err -> failwith ("Invalid threadId: " ^ err) in
+
let send_at = Jmap.Date.of_timestamp (get_float_field "sendAt") in
let undo_status = undo_status_of_string (get_string_field "undoStatus") in
let dsn_blob_ids = List.map (function
-
| `String s -> s
+
| `String s -> (match Jmap.Id.of_string s with Ok id -> id | Error err -> failwith ("Invalid dsnBlobId: " ^ err))
| _ -> failwith "Expected string in dsnBlobIds"
) (get_list_field "dsnBlobIds") in
let mdn_blob_ids = List.map (function
-
| `String s -> s
+
| `String s -> (match Jmap.Id.of_string s with Ok id -> id | Error err -> failwith ("Invalid mdnBlobId: " ^ err))
| _ -> failwith "Expected string in mdnBlobIds"
) (get_list_field "mdnBlobIds") in
···
(** Serialize to JSON with only specified properties *)
let to_json_with_properties ~properties submission =
let all_fields = [
-
("id", `String submission.id);
-
("identityId", `String submission.identity_id);
-
("emailId", `String submission.email_id);
-
("threadId", `String submission.thread_id);
-
("sendAt", `Float submission.send_at);
+
("id", `String (Jmap.Id.to_string submission.id));
+
("identityId", `String (Jmap.Id.to_string submission.identity_id));
+
("emailId", `String (Jmap.Id.to_string submission.email_id));
+
("threadId", `String (Jmap.Id.to_string submission.thread_id));
+
("sendAt", `Float (Jmap.Date.to_timestamp submission.send_at));
("undoStatus", `String (undo_status_to_string submission.undo_status));
-
("dsnBlobIds", `List (List.map (fun id -> `String id) submission.dsn_blob_ids));
-
("mdnBlobIds", `List (List.map (fun id -> `String id) submission.mdn_blob_ids));
+
("dsnBlobIds", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) submission.dsn_blob_ids));
+
("mdnBlobIds", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) submission.mdn_blob_ids));
(* TODO: Add envelope and deliveryStatus when implemented *)
("envelope", match submission.envelope with Some _ -> `Null | None -> `Null);
("deliveryStatus", match submission.delivery_status with Some _ -> `Null | None -> `Null);
···
module Create = struct
type create_data = {
-
identity_id : id;
-
email_id : id;
+
identity_id : Jmap.Id.t;
+
email_id : Jmap.Id.t;
envelope : envelope_data option;
}
···
let to_json create =
let base = [
-
("identityId", `String create.identity_id);
-
("emailId", `String create.email_id);
+
("identityId", `String (Jmap.Id.to_string create.identity_id));
+
("emailId", `String (Jmap.Id.to_string create.email_id));
] in
let fields = match create.envelope with
| Some _env -> ("envelope", `Null) :: base (* Envelope serialization not implemented *)
···
let get_field name = List.assoc name fields in
let get_optional_field name = try Some (get_field name) with Not_found -> None in
let identity_id = match get_field "identityId" with
-
| `String s -> s
+
| `String s -> (match Jmap.Id.of_string s with
+
| Ok id -> id
+
| Error _ -> failwith ("Invalid identityId: " ^ s))
| _ -> failwith "Expected string for identityId"
in
let email_id = match get_field "emailId" with
-
| `String s -> s
+
| `String s -> (match Jmap.Id.of_string s with
+
| Ok id -> id
+
| Error _ -> failwith ("Invalid emailId: " ^ s))
| _ -> failwith "Expected string for emailId"
in
let envelope = match get_optional_field "envelope" with
···
module Response = struct
type response_data = {
-
id : id;
-
thread_id : id;
-
send_at : utc_date;
+
id : Jmap.Id.t;
+
thread_id : Jmap.Id.t;
+
send_at : Jmap.Date.t;
}
type t = response_data
let to_json response =
`Assoc [
-
("id", `String response.id);
-
("threadId", `String response.thread_id);
-
("sendAt", `Float response.send_at);
+
("id", `String (Jmap.Id.to_string response.id));
+
("threadId", `String (Jmap.Id.to_string response.thread_id));
+
("sendAt", `Float (Jmap.Date.to_timestamp response.send_at));
]
let of_json json =
···
| `Assoc fields ->
let get_field name = List.assoc name fields in
let id = match get_field "id" with
-
| `String s -> s
+
| `String s -> (match Jmap.Id.of_string s with
+
| Ok id -> id
+
| Error _ -> failwith ("Invalid id: " ^ s))
| _ -> failwith "Expected string for id"
in
let thread_id = match get_field "threadId" with
-
| `String s -> s
+
| `String s -> (match Jmap.Id.of_string s with
+
| Ok id -> id
+
| Error _ -> failwith ("Invalid threadId: " ^ s))
| _ -> failwith "Expected string for threadId"
in
let send_at = match get_field "sendAt" with
-
| `Float f -> f
+
| `Float f -> Jmap.Date.of_timestamp f
| _ -> failwith "Expected float for sendAt"
in
Ok { id; thread_id; send_at }
···
module Get_args = struct
type get_args_data = {
-
account_id : id;
-
ids : id list option;
+
account_id : Jmap.Id.t;
+
ids : Jmap.Id.t list option;
properties : string list option;
}
type t = get_args_data
let to_json args =
-
let base = [("accountId", `String args.account_id)] in
+
let base = [("accountId", `String (Jmap.Id.to_string args.account_id))] in
let fields = match args.ids with
-
| Some ids -> ("ids", `List (List.map (fun id -> `String id) ids)) :: base
+
| Some ids -> ("ids", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) ids)) :: base
| None -> base
in
let fields = match args.properties with
···
let get_field name = List.assoc name fields in
let get_optional_field name = try Some (get_field name) with Not_found -> None in
let account_id = match get_field "accountId" with
-
| `String s -> s
+
| `String s -> (match Jmap.Id.of_string s with
+
| Ok id -> id
+
| Error _ -> failwith ("Invalid accountId: " ^ s))
| _ -> failwith "Expected string for accountId"
in
let ids = match get_optional_field "ids" with
| Some (`List id_list) -> Some (List.map (function
-
| `String s -> s
+
| `String s -> (match Jmap.Id.of_string s with
+
| Ok id -> id
+
| Error _ -> failwith ("Invalid id: " ^ s))
| _ -> failwith "Expected string in ids"
) id_list)
| Some _ -> failwith "Expected list for ids"
···
module Get_response = struct
type get_response_data = {
-
account_id : id;
+
account_id : Jmap.Id.t;
state : string;
list : email_submission_t list;
-
not_found : id list;
+
not_found : Jmap.Id.t list;
}
type t = get_response_data
let to_json response =
`Assoc [
-
("accountId", `String response.account_id);
+
("accountId", `String (Jmap.Id.to_string response.account_id));
("state", `String response.state);
-
("list", `List (List.map to_json response.list));
-
("notFound", `List (List.map (fun id -> `String id) response.not_found));
+
("list", `List (List.map (fun submission -> to_json submission) response.list));
+
("notFound", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) response.not_found));
]
let of_json json =
···
| `Assoc fields ->
let get_field name = List.assoc name fields in
let account_id = match get_field "accountId" with
-
| `String s -> s
+
| `String s -> (match Jmap.Id.of_string s with
+
| Ok id -> id
+
| Error _ -> failwith ("Invalid accountId: " ^ s))
| _ -> failwith "Expected string for accountId"
in
let state = match get_field "state" with
···
let list = match get_field "list" with
| `List submission_list ->
List.filter_map (fun item ->
-
match of_json item with
+
match (of_json : Yojson.Safe.t -> (email_submission_t, string) result) item with
| Ok submission -> Some submission
| Error _ -> None (* Skip entries that fail to parse *)
) submission_list
| _ -> failwith "Expected list for list"
in
let not_found = match get_field "notFound" with
-
| `List id_list -> List.map (function
-
| `String s -> s
-
| _ -> failwith "Expected string in notFound"
+
| `List id_list -> List.filter_map (function
+
| `String s -> (match Jmap.Id.of_string s with
+
| Ok id -> Some id
+
| Error _ -> None)
+
| _ -> None
) id_list
| _ -> failwith "Expected list for notFound"
in
···
type t = unit (* Not implemented *)
let to_json _ = `Assoc []
let of_json _ = Ok ()
-
let account_id _ = ""
+
let account_id _ = match Jmap.Id.of_string "stub-account-id" with Ok id -> id | Error _ -> failwith "Invalid stub id"
let old_state _ = ""
let new_state _ = ""
let has_more_changes _ = false
···
type t = unit (* Not implemented *)
let to_json _ = `Assoc []
let of_json _ = Ok ()
-
let account_id _ = ""
+
let account_id _ = match Jmap.Id.of_string "stub-account-id" with Ok id -> id | Error _ -> failwith "Invalid stub id"
let query_state _ = ""
let can_calculate_changes _ = false
-
let position _ = 0
+
let position _ = match Jmap.UInt.of_int 0 with Ok v -> v | Error _ -> failwith "Invalid position"
let total _ = None
let ids _ = []
end
···
type t = unit (* Not implemented *)
let to_json _ = `Assoc []
let of_json _ = Ok ()
-
let account_id _ = ""
+
let account_id _ = match Jmap.Id.of_string "stub-set-response-account-id" with Ok id -> id | Error _ -> failwith "Invalid stub id"
let old_state _ = None
let new_state _ = ""
let created _ = Hashtbl.create 0
···
module Filter = struct
let identity_ids ids =
-
let id_values = List.map (fun id -> `String id) ids in
+
let id_values = List.map (fun id -> `String (Jmap.Id.to_string id)) ids in
Jmap.Methods.Filter.property_in "identityId" id_values
let email_ids ids =
-
let id_values = List.map (fun id -> `String id) ids in
+
let id_values = List.map (fun id -> `String (Jmap.Id.to_string id)) ids in
Jmap.Methods.Filter.property_in "emailId" id_values
let thread_ids ids =
-
let id_values = List.map (fun id -> `String id) ids in
+
let id_values = List.map (fun id -> `String (Jmap.Id.to_string id)) ids in
Jmap.Methods.Filter.property_in "threadId" id_values
let undo_status status =
···
Jmap.Methods.Filter.property_equals "undoStatus" status_value
let before date =
-
Jmap.Methods.Filter.property_lt "sendAt" (`Float date)
+
Jmap.Methods.Filter.property_lt "sendAt" (`Float (Jmap.Date.to_timestamp date))
let after date =
-
Jmap.Methods.Filter.property_gt "sendAt" (`Float date)
+
Jmap.Methods.Filter.property_gt "sendAt" (`Float (Jmap.Date.to_timestamp date))
let date_range ~after_date ~before_date =
Jmap.Methods.Filter.and_ [
···
]
let to_string = function
-
| `Id -> "id"
+
| `Id -> "Id.t"
| `IdentityId -> "identityId"
| `EmailId -> "emailId"
| `ThreadId -> "threadId"
···
| `MdnBlobIds -> "mdnBlobIds"
let of_string = function
-
| "id" -> Some `Id
+
| "Id.t" -> Some `Id
| "identityId" -> Some `IdentityId
| "emailId" -> Some `EmailId
| "threadId" -> Some `ThreadId
+76 -79
jmap/jmap-email/submission.mli
···
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7> RFC 8621, Section 7: EmailSubmission
*)
-
open Jmap.Types
-
-
(** {1 Supporting Types} *)
(** SMTP envelope address representation.
···
(** Get the optional SMTP parameters.
@param address The envelope address object
@return Optional SMTP parameters *)
-
val parameters : t -> Yojson.Safe.t string_map option
+
val parameters : t -> (string, Yojson.Safe.t) Hashtbl.t option
(** Create an envelope address.
@param email Email address for SMTP envelope
···
@return Ok with address object, or Error with validation message *)
val create :
email:string ->
-
?parameters:Yojson.Safe.t string_map ->
+
?parameters:(string, Yojson.Safe.t) Hashtbl.t ->
unit -> (t, string) result
end
···
include Jmap_sigs.PRINTABLE with type t := t
(** JMAP object interface for property-based operations *)
-
include Jmap_sigs.JMAP_OBJECT with type t := t and type id_type := id
+
include Jmap_sigs.JMAP_OBJECT with type t := t and type id_type := string
(** {1 Property Accessors} *)
(** Get the server-assigned submission identifier.
@param submission The email submission object
@return Immutable server-assigned submission ID *)
-
val id : t -> id option
+
val id : t -> Jmap.Id.t option
(** Get the identity used for sending this email.
@param submission The email submission object
@return Immutable identity ID used for sending *)
-
val identity_id : t -> id
+
val identity_id : t -> Jmap.Id.t
(** Get the email being submitted.
@param submission The email submission object
@return Immutable email ID being submitted *)
-
val email_id : t -> id
+
val email_id : t -> Jmap.Id.t
(** Get the thread this email belongs to.
@param submission The email submission object
@return Immutable thread ID (server-set) *)
-
val thread_id : t -> id
+
val thread_id : t -> Jmap.Id.t
(** Get the SMTP envelope override.
@param submission The email submission object
···
(** Get the scheduled send time.
@param submission The email submission object
@return Immutable scheduled send time (server-set) *)
-
val send_at : t -> utc_date
+
val send_at : t -> Jmap.Date.t
(** Get the current undo/cancellation status.
@param submission The email submission object
···
(** Get the per-recipient delivery status.
@param submission The email submission object
@return Per-recipient delivery status (server-set) *)
-
val delivery_status : t -> DeliveryStatus.t string_map option
+
val delivery_status : t -> (string, DeliveryStatus.t) Hashtbl.t option
(** Get the delivery status notification blob IDs.
@param submission The email submission object
@return Delivery status notification blobs (server-set) *)
-
val dsn_blob_ids : t -> id list
+
val dsn_blob_ids : t -> Jmap.Id.t list
(** Get the message disposition notification blob IDs.
@param submission The email submission object
@return Message disposition notification blobs (server-set) *)
-
val mdn_blob_ids : t -> id list
+
val mdn_blob_ids : t -> Jmap.Id.t list
(** {1 Smart Constructors} *)
(** Create an EmailSubmission object from all properties.
-
@param id Server-assigned submission ID
+
@param Jmap.Id.t Server-assigned submission ID
@param identity_id Identity used for sending
@param email_id Email being submitted
@param thread_id Thread ID (server-set)
···
@param mdn_blob_ids Message disposition notification blobs (server-set)
@return Ok with submission object, or Error with validation message *)
val create :
-
id:id ->
-
identity_id:id ->
-
email_id:id ->
-
thread_id:id ->
+
id:Jmap.Id.t ->
+
identity_id:Jmap.Id.t ->
+
email_id:Jmap.Id.t ->
+
thread_id:Jmap.Id.t ->
?envelope:Envelope.t ->
-
send_at:utc_date ->
+
send_at:Jmap.Date.t ->
undo_status:[`Pending | `Final | `Canceled] ->
-
?delivery_status:DeliveryStatus.t string_map ->
-
?dsn_blob_ids:id list ->
-
?mdn_blob_ids:id list ->
+
?delivery_status:(string, DeliveryStatus.t) Hashtbl.t ->
+
?dsn_blob_ids:Jmap.Id.t list ->
+
?mdn_blob_ids:Jmap.Id.t list ->
unit -> (t, string) result
(** {1 JMAP Method Operations} *)
···
(** Get the identity to use for sending.
@param create The creation object
@return Identity to use for sending *)
-
val identity_id : t -> id
+
val identity_id : t -> Jmap.Id.t
(** Get the email object to submit.
@param create The creation object
@return Email object to submit *)
-
val email_id : t -> id
+
val email_id : t -> Jmap.Id.t
(** Get the optional envelope override.
@param create The creation object
···
@param envelope Optional envelope override
@return Ok with creation object, or Error with validation message *)
val create :
-
identity_id:id ->
-
email_id:id ->
+
identity_id:Jmap.Id.t ->
+
email_id:Jmap.Id.t ->
?envelope:Envelope.t ->
unit -> (t, string) result
···
(** Get the server-assigned submission ID.
@param response The creation response object
@return Server-assigned submission ID *)
-
val id : t -> id
+
val id : t -> Jmap.Id.t
(** Get the thread ID the email belongs to.
@param response The creation response object
@return Thread ID the email belongs to *)
-
val thread_id : t -> id
+
val thread_id : t -> Jmap.Id.t
(** Get the actual/scheduled send timestamp.
@param response The creation response object
@return Actual/scheduled send timestamp *)
-
val send_at : t -> utc_date
+
val send_at : t -> Jmap.Date.t
(** Create a creation response.
-
@param id Server-assigned submission ID
+
@param Jmap.Id.t Server-assigned submission ID
@param thread_id Thread ID the email belongs to
@param send_at Actual/scheduled send timestamp
@return Ok with response object, or Error with validation message *)
val create :
-
id:id ->
-
thread_id:id ->
-
send_at:utc_date ->
+
id:Jmap.Id.t ->
+
thread_id:Jmap.Id.t ->
+
send_at:Jmap.Date.t ->
(t, string) result
end
end
···
@param properties Properties to include (None for all)
@return Ok with get arguments, or Error with validation message *)
val create :
-
account_id:id ->
-
?ids:id list ->
+
account_id:Jmap.Id.t ->
+
?ids:Jmap.Id.t list ->
?properties:string list ->
unit -> (t, string) result
end
···
(** Get the account ID.
@param response The get response object
@return Account ID *)
-
val account_id : t -> id
+
val account_id : t -> Jmap.Id.t
(** Get the current state string.
@param response The get response object
···
(** Get the list of submission IDs not found.
@param response The get response object
@return List of submission IDs not found *)
-
val not_found : t -> id list
+
val not_found : t -> Jmap.Id.t list
end
(** Arguments for EmailSubmission/changes method.
···
@param max_changes Maximum number of changes to return
@return Ok with changes arguments, or Error with validation message *)
val create :
-
account_id:id ->
+
account_id:Jmap.Id.t ->
since_state:string ->
-
?max_changes:uint ->
+
?max_changes:Jmap.UInt.t ->
unit -> (t, string) result
end
···
(** Get the account ID.
@param response The changes response object
@return Account ID *)
-
val account_id : t -> id
+
val account_id : t -> Jmap.Id.t
(** Get the old state string.
@param response The changes response object
···
(** Get the list of created submission IDs.
@param response The changes response object
@return List of created submission IDs *)
-
val created : t -> id list
+
val created : t -> Jmap.Id.t list
(** Get the list of updated submission IDs.
@param response The changes response object
@return List of updated submission IDs *)
-
val updated : t -> id list
+
val updated : t -> Jmap.Id.t list
(** Get the list of destroyed submission IDs.
@param response The changes response object
@return List of destroyed submission IDs *)
-
val destroyed : t -> id list
+
val destroyed : t -> Jmap.Id.t list
end
(** Arguments for EmailSubmission/query method.
···
@param calculate_total Whether to calculate total count
@return Ok with query arguments, or Error with validation message *)
val create :
-
account_id:id ->
+
account_id:Jmap.Id.t ->
?filter:Jmap.Methods.Filter.t ->
?sort:Jmap.Methods.Comparator.t list ->
-
?position:uint ->
-
?anchor:id ->
+
?position:Jmap.UInt.t ->
+
?anchor:Jmap.Id.t ->
?anchor_offset:int ->
-
?limit:uint ->
+
?limit:Jmap.UInt.t ->
?calculate_total:bool ->
unit -> (t, string) result
end
···
(** Get the account ID.
@param response The query response object
@return Account ID *)
-
val account_id : t -> id
+
val account_id : t -> Jmap.Id.t
(** Get the query state string.
@param response The query response object
···
(** Get the starting position of results.
@param response The query response object
@return Starting position of results *)
-
val position : t -> uint
+
val position : t -> Jmap.UInt.t
(** Get the total number of matching objects.
@param response The query response object
@return Total number of matching objects (if calculated) *)
-
val total : t -> uint option
+
val total : t -> Jmap.UInt.t option
(** Get the list of matching submission IDs.
@param response The query response object
@return List of matching submission IDs *)
-
val ids : t -> id list
+
val ids : t -> Jmap.Id.t list
end
(** Arguments for EmailSubmission/set method.
···
@param on_success_destroy_email Emails to destroy after successful submission
@return Ok with set arguments, or Error with validation message *)
val create :
-
account_id:id ->
+
account_id:Jmap.Id.t ->
?if_in_state:string ->
-
?create:(id * Create.t) list ->
-
?update:(id * Update.t) list ->
-
?destroy:id list ->
-
?on_success_destroy_email:id list ->
+
?create:(Jmap.Id.t * Create.t) list ->
+
?update:(Jmap.Id.t * Update.t) list ->
+
?destroy:Jmap.Id.t list ->
+
?on_success_destroy_email:Jmap.Id.t list ->
unit -> (t, string) result
end
···
(** Get the account ID.
@param response The set response object
@return Account ID *)
-
val account_id : t -> id
+
val account_id : t -> Jmap.Id.t
(** Get the old state string.
@param response The set response object
···
(** Get the created submissions with server-computed properties.
@param response The set response object
@return Created submissions with server-computed properties *)
-
val created : t -> Create.Response.t id_map
+
val created : t -> (string, Create.Response.t) Hashtbl.t
(** Get the updated submissions with server-computed properties.
@param response The set response object
@return Updated submissions with server-computed properties *)
-
val updated : t -> Update.Response.t id_map option
+
val updated : t -> (string, Update.Response.t) Hashtbl.t option
(** Get the destroyed submission IDs.
@param response The set response object
@return Destroyed submission IDs *)
-
val destroyed : t -> id list option
+
val destroyed : t -> Jmap.Id.t list option
(** Get the submission IDs that could not be created.
@param response The set response object
@return Submission IDs that could not be created *)
-
val not_created : t -> Jmap.Error.Set_error.t id_map option
+
val not_created : t -> (string, Jmap.Error.Set_error.t) Hashtbl.t option
(** Get the submission IDs that could not be updated.
@param response The set response object
@return Submission IDs that could not be updated *)
-
val not_updated : t -> Jmap.Error.Set_error.t id_map option
+
val not_updated : t -> (string, Jmap.Error.Set_error.t) Hashtbl.t option
(** Get the submission IDs that could not be destroyed.
@param response The set response object
@return Submission IDs that could not be destroyed *)
-
val not_destroyed : t -> Jmap.Error.Set_error.t id_map option
+
val not_destroyed : t -> (string, Jmap.Error.Set_error.t) Hashtbl.t option
end
(** {1 Filter Helper Functions} *)
···
(** Create filter for specific identity IDs.
@param ids List of identity IDs to match
@return Filter that matches submissions using any of these identities *)
-
val identity_ids : id list -> Jmap.Methods.Filter.t
+
val identity_ids : Jmap.Id.t list -> Jmap.Methods.Filter.t
(** Create filter for specific email IDs.
@param ids List of email IDs to match
@return Filter that matches submissions for any of these emails *)
-
val email_ids : id list -> Jmap.Methods.Filter.t
+
val email_ids : Jmap.Id.t list -> Jmap.Methods.Filter.t
(** Create filter for specific thread IDs.
@param ids List of thread IDs to match
@return Filter that matches submissions in any of these threads *)
-
val thread_ids : id list -> Jmap.Methods.Filter.t
+
val thread_ids : Jmap.Id.t list -> Jmap.Methods.Filter.t
(** Create filter for undo status.
@param status Undo status to match
@return Filter that matches submissions with this undo status *)
val undo_status : [`Pending | `Final | `Canceled] -> Jmap.Methods.Filter.t
-
(** Create filter for submissions sent before a specific date.
-
@param date UTC timestamp to compare against
-
@return Filter that matches submissions sent before this date *)
-
val before : utc_date -> Jmap.Methods.Filter.t
+
(** Create filter for submissions sent before a specific Date.t.
+
@param Date.t UTC timestamp to compare against
+
@return Filter that matches submissions sent before this Date.t *)
+
val before : Jmap.Date.t -> Jmap.Methods.Filter.t
-
(** Create filter for submissions sent after a specific date.
-
@param date UTC timestamp to compare against
-
@return Filter that matches submissions sent after this date *)
-
val after : utc_date -> Jmap.Methods.Filter.t
+
(** Create filter for submissions sent after a specific Date.t.
+
@param Date.t UTC timestamp to compare against
+
@return Filter that matches submissions sent after this Date.t *)
+
val after : Jmap.Date.t -> Jmap.Methods.Filter.t
-
(** Create filter for submissions sent within a date range.
-
@param after_date Start of date range
-
@param before_date End of date range
+
(** Create filter for submissions sent within a Date.t range.
+
@param after_date Start of Date.t range
+
@param before_date End of Date.t range
@return Filter that matches submissions sent within this range *)
-
val date_range : after_date:utc_date -> before_date:utc_date -> Jmap.Methods.Filter.t
+
val date_range : after_date:Jmap.Date.t -> before_date:Jmap.Date.t -> Jmap.Methods.Filter.t
end
(** {1 Sort Helper Functions} *)
+99 -67
jmap/jmap-email/thread.ml
···
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-3> RFC 8621, Section 3: Threads
*)
-
open Jmap.Types
open Jmap.Method_names
open Jmap.Methods
module Thread = struct
type t = {
-
id : id option;
-
email_ids : id list;
+
id : Jmap.Id.t option;
+
email_ids : Jmap.Id.t list;
}
let id t = t.id
···
(* JMAP_OBJECT implementation *)
let create ?id () =
-
{ id; email_ids = [] }
+
let id_opt = match id with
+
| None -> None
+
| Some id_str ->
+
(match Jmap.Id.of_string id_str with
+
| Ok jmap_id -> Some jmap_id
+
| Error _ -> failwith ("Invalid thread id: " ^ id_str)) in
+
{ id = id_opt; email_ids = [] }
let to_json_with_properties ~properties t =
let all_fields = [
-
("id", (match t.id with Some id -> `String id | None -> `Null));
-
("emailIds", `List (List.map (fun id -> `String id) t.email_ids));
+
("id", (match t.id with Some id -> `String (Jmap.Id.to_string id) | None -> `Null));
+
("emailIds", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) t.email_ids));
] in
let filtered_fields = List.filter (fun (name, _) ->
List.mem name properties
···
(* JSONABLE implementation *)
let to_json t =
`Assoc [
-
("id", (match t.id with Some id -> `String id | None -> `Null));
-
("emailIds", `List (List.map (fun id -> `String id) t.email_ids));
+
("id", (match t.id with Some id -> `String (Jmap.Id.to_string id) | None -> `Null));
+
("emailIds", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) t.email_ids));
]
let of_json json =
···
in
let id_str = get_string "id" "" in
let email_ids = get_string_list "emailIds" in
+
let id = if id_str = "" then None else (match Jmap.Id.of_string id_str with Ok id -> Some id | Error e -> failwith e) in
+
let email_ids = List.map (fun s -> match Jmap.Id.of_string s with Ok id -> id | Error e -> failwith e) email_ids in
Ok {
-
id = (if id_str = "" then None else Some id_str);
+
id;
email_ids;
}
| _ -> Error "Thread must be a JSON object"
···
let email_ids_str = match t.email_ids with
| [] -> "[]"
| ids when List.length ids <= 3 ->
-
"[" ^ String.concat "; " ids ^ "]"
+
"[" ^ String.concat "; " (List.map Jmap.Id.to_string ids) ^ "]"
| a :: b :: c :: _ ->
-
"[" ^ String.concat "; " [a; b; c] ^ "; ...]"
+
"[" ^ String.concat "; " (List.map Jmap.Id.to_string [a; b; c]) ^ "; ...]"
| ids ->
-
"[" ^ String.concat "; " ids ^ "]"
+
"[" ^ String.concat "; " (List.map Jmap.Id.to_string ids) ^ "]"
in
-
let id_str = match t.id with Some id -> id | None -> "(no-id)" in
+
let id_str = match t.id with Some id -> Jmap.Id.to_string id | None -> "(no-id)" in
Format.fprintf ppf "Thread{id=%s; emails=%d; email_ids=%s}"
id_str email_count email_ids_str
···
]
let to_string = function
-
| `Id -> "id"
+
| `Id -> "Jmap.Id.t"
| `EmailIds -> "emailIds"
let of_string = function
-
| "id" -> Some `Id
+
| "Jmap.Id.t" -> Some `Id
| "emailIds" -> Some `EmailIds
| _ -> None
···
module Query_args = struct
type t = {
-
account_id : id;
+
account_id : Jmap.Id.t;
filter : Filter.t option;
sort : Comparator.t list option;
position : int option;
-
anchor : id option;
+
anchor : Jmap.Id.t option;
anchor_offset : int option;
-
limit : uint option;
+
limit : Jmap.UInt.t option;
calculate_total : bool option;
}
···
let to_json t =
let json_fields = [
-
("accountId", `String t.account_id);
+
("accountId", `String (Jmap.Id.to_string t.account_id));
] in
let json_fields = match t.filter with
| None -> json_fields
···
in
let json_fields = match t.anchor with
| None -> json_fields
-
| Some anchor -> ("anchor", `String anchor) :: json_fields
+
| Some anchor -> ("anchor", `String (Jmap.Id.to_string anchor)) :: json_fields
in
let json_fields = match t.anchor_offset with
| None -> json_fields
···
in
let json_fields = match t.limit with
| None -> json_fields
-
| Some limit -> ("limit", `Int limit) :: json_fields
+
| Some limit -> ("limit", `Int (Jmap.UInt.to_int limit)) :: json_fields
in
let json_fields = match t.calculate_total with
| None -> json_fields
···
match json with
| `Assoc fields ->
let account_id = match List.assoc_opt "accountId" fields with
-
| Some (`String id) -> id
+
| Some (`String id) -> (match Jmap.Id.of_string id with
+
| Ok id -> id
+
| Error err -> failwith ("Invalid accountId: " ^ err))
| _ -> failwith "Missing or invalid accountId"
in
let filter = match List.assoc_opt "filter" fields with
···
| exn -> Error (Printexc.to_string exn)
let pp fmt t =
-
Format.fprintf fmt "Thread.Query_args{account=%s}" t.account_id
+
Format.fprintf fmt "Thread.Query_args{account=%s}" (Jmap.Id.to_string t.account_id)
let pp_hum fmt t = pp fmt t
···
module Query_response = struct
type t = {
-
account_id : id;
+
account_id : Jmap.Id.t;
query_state : string;
can_calculate_changes : bool;
position : int;
-
ids : id list;
-
total : uint option;
-
limit : uint option;
+
ids : Jmap.Id.t list;
+
total : Jmap.UInt.t option;
+
limit : Jmap.UInt.t option;
}
let account_id t = t.account_id
···
let to_json t =
let fields = [
-
("accountId", `String t.account_id);
+
("accountId", `String (Jmap.Id.to_string t.account_id));
("queryState", `String t.query_state);
("canCalculateChanges", `Bool t.can_calculate_changes);
("position", `Int t.position);
-
("ids", `List (List.map (fun id -> `String id) t.ids));
+
("ids", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) t.ids));
] in
let fields = match t.total with
-
| Some total -> ("total", `Int total) :: fields
+
| Some total -> ("total", `Int (Jmap.UInt.to_int total)) :: fields
| None -> fields
in
let fields = match t.limit with
-
| Some limit -> ("limit", `Int limit) :: fields
+
| Some limit -> ("limit", `Int (Jmap.UInt.to_int limit)) :: fields
| None -> fields
in
`Assoc fields
···
match json with
| `Assoc fields ->
let account_id = match List.assoc_opt "accountId" fields with
-
| Some (`String id) -> id
+
| Some (`String id_str) -> (match Jmap.Id.of_string id_str with
+
| Ok id -> id
+
| Error _ -> failwith ("Invalid accountId: " ^ id_str))
| _ -> failwith "Missing or invalid accountId"
in
Ok { account_id; query_state = ""; can_calculate_changes = false;
···
let pp fmt t =
Format.fprintf fmt "Thread.Query_response{account=%s;ids=%d}"
-
t.account_id (List.length t.ids)
+
(Jmap.Id.to_string t.account_id) (List.length t.ids)
let pp_hum fmt t = pp fmt t
···
module Get_args = struct
type t = {
-
account_id : id;
-
ids : id list option;
+
account_id : Jmap.Id.t;
+
ids : Jmap.Id.t list option;
properties : string list option;
}
···
let to_json t =
let json_fields = [
-
("accountId", `String t.account_id);
+
("accountId", `String (Jmap.Id.to_string t.account_id));
] in
let json_fields = match t.ids with
| None -> json_fields
-
| Some ids -> ("ids", `List (List.map (fun id -> `String id) ids)) :: json_fields
+
| Some ids -> ("ids", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) ids)) :: json_fields
in
let json_fields = match t.properties with
| None -> json_fields
···
match json with
| `Assoc fields ->
let account_id = match List.assoc_opt "accountId" fields with
-
| Some (`String id) -> id
+
| Some (`String id_str) -> (match Jmap.Id.of_string id_str with
+
| Ok id -> id
+
| Error _ -> failwith ("Invalid accountId: " ^ id_str))
| _ -> failwith "Missing or invalid accountId"
in
Ok { account_id; ids = None; properties = None }
···
| exn -> Error (Printexc.to_string exn)
let pp fmt t =
-
Format.fprintf fmt "Thread.Get_args{account=%s}" t.account_id
+
Format.fprintf fmt "Thread.Get_args{account=%s}" (Jmap.Id.to_string t.account_id)
let pp_hum fmt t = pp fmt t
···
module Get_response = struct
type t = {
-
account_id : id;
+
account_id : Jmap.Id.t;
state : string;
list : Thread.t list;
-
not_found : id list;
+
not_found : Jmap.Id.t list;
}
let account_id t = t.account_id
···
let to_json t =
`Assoc [
-
("accountId", `String t.account_id);
+
("accountId", `String (Jmap.Id.to_string t.account_id));
("state", `String t.state);
("list", `List (List.map Thread.to_json t.list));
-
("notFound", `List (List.map (fun id -> `String id) t.not_found));
+
("notFound", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) t.not_found));
]
let of_json json =
···
match json with
| `Assoc fields ->
let account_id = match List.assoc_opt "accountId" fields with
-
| Some (`String id) -> id
+
| Some (`String id_str) -> (match Jmap.Id.of_string id_str with
+
| Ok id -> id
+
| Error _ -> failwith ("Invalid accountId: " ^ id_str))
| _ -> failwith "Missing or invalid accountId"
in
Ok { account_id; state = ""; list = []; not_found = [] }
···
let pp fmt t =
Format.fprintf fmt "Thread.Get_response{account=%s;threads=%d}"
-
t.account_id (List.length t.list)
+
(Jmap.Id.to_string t.account_id) (List.length t.list)
let pp_hum fmt t = pp fmt t
···
module Changes_args = struct
type t = {
-
account_id : id;
+
account_id : Jmap.Id.t;
since_state : string;
-
max_changes : uint option;
+
max_changes : Jmap.UInt.t option;
}
let account_id t = t.account_id
···
{ account_id; since_state; max_changes }
let to_json t =
-
let fields = [("accountId", `String t.account_id); ("sinceState", `String t.since_state)] in
+
let fields = [("accountId", `String (Jmap.Id.to_string t.account_id)); ("sinceState", `String t.since_state)] in
let fields = match t.max_changes with
| None -> fields
-
| Some n -> ("maxChanges", `Int n) :: fields
+
| Some n -> ("maxChanges", `Int (Jmap.UInt.to_int n)) :: fields
in
`Assoc fields
···
match json with
| `Assoc fields ->
let account_id = match List.assoc_opt "accountId" fields with
-
| Some (`String id) -> id
+
| Some (`String id_str) -> (match Jmap.Id.of_string id_str with
+
| Ok id -> id
+
| Error _ -> failwith ("Invalid accountId: " ^ id_str))
| _ -> failwith "Missing or invalid accountId"
in
Ok { account_id; since_state = ""; max_changes = None }
···
let pp fmt t =
Format.fprintf fmt "Thread.Changes_args{account=%s;since=%s}"
-
t.account_id t.since_state
+
(Jmap.Id.to_string t.account_id) t.since_state
let pp_hum fmt t = pp fmt t
···
module Changes_response = struct
type t = {
-
account_id : id;
+
account_id : Jmap.Id.t;
old_state : string;
new_state : string;
has_more_changes : bool;
-
created : id list;
-
updated : id list;
-
destroyed : id list;
+
created : Jmap.Id.t list;
+
updated : Jmap.Id.t list;
+
destroyed : Jmap.Id.t list;
}
let account_id t = t.account_id
···
@return JSON object with accountId, states, hasMoreChanges, and change arrays *)
let to_json t =
`Assoc [
-
("accountId", `String t.account_id);
+
("accountId", `String (Jmap.Id.to_string t.account_id));
("oldState", `String t.old_state);
("newState", `String t.new_state);
("hasMoreChanges", `Bool t.has_more_changes);
-
("created", `List (List.map (fun id -> `String id) t.created));
-
("updated", `List (List.map (fun id -> `String id) t.updated));
-
("destroyed", `List (List.map (fun id -> `String id) t.destroyed));
+
("created", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) t.created));
+
("updated", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) t.updated));
+
("destroyed", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) t.destroyed));
]
(** Parse Thread/changes response from JSON.
···
let of_json json =
try
let open Yojson.Safe.Util in
-
let account_id = json |> member "accountId" |> to_string in
+
let account_id_str = json |> member "accountId" |> to_string in
+
let account_id = match Jmap.Id.of_string account_id_str with
+
| Ok id -> id
+
| Error _ -> failwith ("Invalid accountId: " ^ account_id_str) in
let old_state = json |> member "oldState" |> to_string in
let new_state = json |> member "newState" |> to_string in
let has_more_changes = json |> member "hasMoreChanges" |> to_bool in
-
let created = json |> member "created" |> to_list |> List.map to_string in
-
let updated = json |> member "updated" |> to_list |> List.map to_string in
-
let destroyed = json |> member "destroyed" |> to_list |> List.map to_string in
+
let created = json |> member "created" |> to_list |> List.map (fun item ->
+
let id_str = to_string item in
+
match Jmap.Id.of_string id_str with
+
| Ok id -> id
+
| Error _ -> failwith ("Invalid created id: " ^ id_str)) in
+
let updated = json |> member "updated" |> to_list |> List.map (fun item ->
+
let id_str = to_string item in
+
match Jmap.Id.of_string id_str with
+
| Ok id -> id
+
| Error _ -> failwith ("Invalid updated id: " ^ id_str)) in
+
let destroyed = json |> member "destroyed" |> to_list |> List.map (fun item ->
+
let id_str = to_string item in
+
match Jmap.Id.of_string id_str with
+
| Ok id -> id
+
| Error _ -> failwith ("Invalid destroyed id: " ^ id_str)) in
Ok {
account_id;
old_state;
···
| exn -> Error ("Thread Changes_response JSON parse error: " ^ Printexc.to_string exn)
let pp fmt t =
-
Format.fprintf fmt "Thread.Changes_response{account=%s}" t.account_id
+
Format.fprintf fmt "Thread.Changes_response{account=%s}" (Jmap.Id.to_string t.account_id)
let pp_hum fmt t = pp fmt t
···
end
let filter_has_email email_id =
-
Filter.property_equals "emailIds" (`String email_id)
+
Filter.property_equals "emailIds" (`String (Jmap.Id.to_string email_id))
let filter_from sender =
Filter.text_contains "from" sender
···
Filter.text_contains "subject" subject
let filter_before date =
-
Filter.property_lt "receivedAt" (`Float date)
+
Filter.property_lt "receivedAt" (`Float (Jmap.Date.to_timestamp date))
let filter_after date =
-
Filter.property_gt "receivedAt" (`Float date)
+
Filter.property_gt "receivedAt" (`Float (Jmap.Date.to_timestamp date))
+54 -55
jmap/jmap-email/thread.mli
···
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-3> RFC 8621, Section 3: Threads
*)
-
open Jmap.Types
open Jmap.Methods
(** Thread object representation.
···
include Jmap_sigs.PRINTABLE with type t := t
(** JMAP object interface for property selection and object creation *)
-
include Jmap_sigs.JMAP_OBJECT with type t := t and type id_type := id
+
include Jmap_sigs.JMAP_OBJECT with type t := t and type id_type := string
(** Get the server-assigned thread identifier.
@return Unique thread ID (Some for all persisted threads, None only for unsaved objects) *)
-
val id : t -> id option
+
val id : t -> Jmap.Id.t option
(** Get the list of email IDs belonging to this thread.
@return List of email IDs in conversation order *)
-
val email_ids : t -> id list
+
val email_ids : t -> Jmap.Id.t list
(** Create a new Thread object.
-
@param id Server-assigned thread identifier
+
@param Jmap.Id.t Server-assigned thread identifier
@param email_ids List of email IDs in the thread
@return New thread object *)
-
val v : id:id -> email_ids:id list -> t
+
val v : id:Jmap.Id.t -> email_ids:Jmap.Id.t list -> t
end
···
include Jmap_sigs.JSONABLE with type t := t
(** JMAP method arguments interface *)
-
include Jmap_sigs.METHOD_ARGS with type t := t and type account_id := id
+
include Jmap_sigs.METHOD_ARGS with type t := t and type account_id := string
(** Get the account ID for the operation.
@return Account identifier where threads will be queried *)
-
val account_id : t -> id
+
val account_id : t -> Jmap.Id.t
(** Validate query arguments according to JMAP method constraints.
@param t Query arguments to validate
···
(** Get the anchor thread ID for relative positioning.
@return Thread ID to anchor results from, or None *)
-
val anchor : t -> id option
+
val anchor : t -> Jmap.Id.t option
(** Get the offset from the anchor position.
@return Number of positions to offset from anchor *)
···
(** Get the maximum number of results to return.
@return Result limit, or None for server default *)
-
val limit : t -> uint option
+
val limit : t -> Jmap.UInt.t option
(** Check if total count should be calculated.
@return true to calculate total result count *)
···
@param calculate_total Optional flag to calculate totals
@return Thread/query arguments object *)
val v :
-
account_id:id ->
+
account_id:Jmap.Id.t ->
?filter:Filter.t ->
?sort:Comparator.t list ->
?position:int ->
-
?anchor:id ->
+
?anchor:Jmap.Id.t ->
?anchor_offset:int ->
-
?limit:uint ->
+
?limit:Jmap.UInt.t ->
?calculate_total:bool ->
unit -> t
···
include Jmap_sigs.JSONABLE with type t := t
(** JMAP method response interface *)
-
include Jmap_sigs.METHOD_RESPONSE with type t := t and type account_id := id and type state := string
+
include Jmap_sigs.METHOD_RESPONSE with type t := t and type account_id := string and type state := string
(** Get the account ID from the response.
@return Account identifier where threads were queried *)
-
val account_id : t -> id
+
val account_id : t -> Jmap.Id.t
(** Get the query state string for change tracking.
@return State string for use in queryChanges *)
···
(** Get the list of matching thread IDs.
@return Ordered list of thread IDs matching the query *)
-
val ids : t -> id list
+
val ids : t -> Jmap.Id.t list
(** Get the total number of matching threads.
@return Total result count if calculateTotal was requested *)
-
val total : t -> uint option
+
val total : t -> Jmap.UInt.t option
(** Get the limit that was applied to the results.
@return Number of results returned, or None if no limit *)
-
val limit : t -> uint option
+
val limit : t -> Jmap.UInt.t option
(** Create Thread/query response.
@param account_id Account where threads were queried
···
@param limit Optional result limit applied
@return Thread/query response object *)
val v :
-
account_id:id ->
+
account_id:Jmap.Id.t ->
query_state:string ->
can_calculate_changes:bool ->
position:int ->
-
ids:id list ->
-
?total:uint ->
-
?limit:uint ->
+
ids:Jmap.Id.t list ->
+
?total:Jmap.UInt.t ->
+
?limit:Jmap.UInt.t ->
unit -> t
end
···
include Jmap_sigs.JSONABLE with type t := t
(** JMAP method arguments interface *)
-
include Jmap_sigs.METHOD_ARGS with type t := t and type account_id := id
+
include Jmap_sigs.METHOD_ARGS with type t := t and type account_id := string
(** Get the account ID for the operation.
@return Account identifier where threads will be retrieved *)
-
val account_id : t -> id
+
val account_id : t -> Jmap.Id.t
(** Validate get arguments according to JMAP method constraints.
@param t Get arguments to validate
···
(** Get the specific thread IDs to retrieve.
@return List of thread IDs, or None to retrieve all threads *)
-
val ids : t -> id list option
+
val ids : t -> Jmap.Id.t list option
(** Get the properties to include in the response.
@return List of property names, or None for all properties *)
···
@param properties Optional list of properties to include
@return Thread/get arguments object *)
val v :
-
account_id:id ->
-
?ids:id list ->
+
account_id:Jmap.Id.t ->
+
?ids:Jmap.Id.t list ->
?properties:string list ->
unit -> t
···
include Jmap_sigs.JSONABLE with type t := t
(** JMAP method response interface *)
-
include Jmap_sigs.METHOD_RESPONSE with type t := t and type account_id := id and type state := string
+
include Jmap_sigs.METHOD_RESPONSE with type t := t and type account_id := string and type state := string
(** Get the account ID from the response.
@return Account identifier where threads were retrieved *)
-
val account_id : t -> id
+
val account_id : t -> Jmap.Id.t
(** Get the current state string for change tracking.
@return State string for use in Thread/changes *)
···
(** Get the list of thread IDs that were not found.
@return List of requested IDs that don't exist *)
-
val not_found : t -> id list
+
val not_found : t -> Jmap.Id.t list
(** Create Thread/get response.
@param account_id Account where threads were retrieved
···
@param not_found IDs that were not found
@return Thread/get response object *)
val v :
-
account_id:id ->
+
account_id:Jmap.Id.t ->
state:string ->
list:Thread.t list ->
-
not_found:id list ->
+
not_found:Jmap.Id.t list ->
unit -> t
end
···
include Jmap_sigs.JSONABLE with type t := t
(** JMAP method arguments interface *)
-
include Jmap_sigs.METHOD_ARGS with type t := t and type account_id := id
+
include Jmap_sigs.METHOD_ARGS with type t := t and type account_id := string
(** Get the account ID for the operation.
@return Account identifier where thread changes are tracked *)
-
val account_id : t -> id
+
val account_id : t -> Jmap.Id.t
(** Validate changes arguments according to JMAP method constraints.
@param t Changes arguments to validate
···
(** Get the maximum number of changes to return.
@return Change limit, or None for server default *)
-
val max_changes : t -> uint option
+
val max_changes : t -> Jmap.UInt.t option
(** Create Thread/changes arguments.
@param account_id Account where thread changes are tracked
···
@param max_changes Optional limit on number of changes returned
@return Thread/changes arguments object *)
val v :
-
account_id:id ->
+
account_id:Jmap.Id.t ->
since_state:string ->
-
?max_changes:uint ->
+
?max_changes:Jmap.UInt.t ->
unit -> t
end
···
include Jmap_sigs.JSONABLE with type t := t
(** JMAP method response interface *)
-
include Jmap_sigs.METHOD_RESPONSE with type t := t and type account_id := id and type state := string
+
include Jmap_sigs.METHOD_RESPONSE with type t := t and type account_id := string and type state := string
(** Get the account ID from the response.
@return Account identifier where changes occurred *)
-
val account_id : t -> id
+
val account_id : t -> Jmap.Id.t
(** Get the old state string that was compared against.
@return The since_state parameter from the request *)
···
(** Get the list of newly created thread IDs.
@return Thread IDs that were created since the old state *)
-
val created : t -> id list
+
val created : t -> Jmap.Id.t list
(** Get the list of updated thread IDs.
@return Thread IDs whose email lists changed since the old state *)
-
val updated : t -> id list
+
val updated : t -> Jmap.Id.t list
(** Get the list of destroyed thread IDs.
@return Thread IDs that were deleted since the old state *)
-
val destroyed : t -> id list
+
val destroyed : t -> Jmap.Id.t list
(** Create Thread/changes response.
@param account_id Account where changes occurred
···
@param destroyed List of destroyed thread IDs
@return Thread/changes response object *)
val v :
-
account_id:id ->
+
account_id:Jmap.Id.t ->
old_state:string ->
new_state:string ->
has_more_changes:bool ->
-
created:id list ->
-
updated:id list ->
-
destroyed:id list ->
+
created:Jmap.Id.t list ->
+
updated:Jmap.Id.t list ->
+
destroyed:Jmap.Id.t list ->
unit -> t
end
···
(** Create a filter to find threads containing a specific email.
@param email_id The email ID to search for in threads
@return Filter condition for Email/query to find related emails *)
-
val filter_has_email : id -> Filter.t
+
val filter_has_email : Jmap.Id.t -> Filter.t
(** Create a filter to find threads containing emails from a sender.
@param sender Email address or name to search for in From fields
···
@return Filter condition for finding threads containing the subject text *)
val filter_subject : string -> Filter.t
-
(** Create a filter to find threads with emails received before a date.
-
@param date Cutoff date for filtering
-
@return Filter condition for threads with emails before the date *)
-
val filter_before : date -> Filter.t
+
(** Create a filter to find threads with emails received before a Date.t.
+
@param Date.t Cutoff Date.t for filtering
+
@return Filter condition for threads with emails before the Date.t *)
+
val filter_before : Jmap.Date.t -> Filter.t
-
(** Create a filter to find threads with emails received after a date.
-
@param date Start date for filtering
-
@return Filter condition for threads with emails after the date *)
-
val filter_after : date -> Filter.t
+
(** Create a filter to find threads with emails received after a Date.t.
+
@param Date.t Start Date.t for filtering
+
@return Filter condition for threads with emails after the Date.t *)
+
val filter_after : Jmap.Date.t -> Filter.t
(** {1 Property System} *)
-807
jmap/jmap-email/types.ml
···
-
(** JMAP Mail Types Implementation.
-
-
This module implements the common types for JMAP Mail as specified in RFC 8621.
-
It provides concrete implementations of email addresses, body parts, keywords,
-
and email objects with their associated operations.
-
-
@see <https://www.rfc-editor.org/rfc/rfc8621.html> RFC 8621: JMAP for Mail
-
*)
-
-
open Jmap.Types
-
-
module Email_address = struct
-
type t = {
-
name : string option;
-
email : string;
-
}
-
-
let name t = t.name
-
let email t = t.email
-
-
let v ?name ~email () = { name; email }
-
-
let to_json t =
-
let fields = [("email", `String t.email)] in
-
let fields = match t.name with
-
| Some name -> ("name", `String name) :: fields
-
| None -> fields
-
in
-
`Assoc fields
-
-
let of_json json =
-
try
-
match json with
-
| `Assoc fields ->
-
let email = match List.assoc_opt "email" fields with
-
| Some (`String email) -> email
-
| _ -> failwith "Email_address.of_json: missing or invalid email field"
-
in
-
let name = match List.assoc_opt "name" fields with
-
| Some (`String name) -> Some name
-
| Some `Null | None -> None
-
| _ -> failwith "Email_address.of_json: invalid name field"
-
in
-
Ok { name; email }
-
| _ -> failwith "Email_address.of_json: expected JSON object"
-
with
-
| Failure msg -> Error msg
-
| exn -> Error (Printexc.to_string exn)
-
-
let pp fmt t =
-
match t.name with
-
| Some name -> Format.fprintf fmt "%s <%s>" name t.email
-
| None -> Format.fprintf fmt "%s" t.email
-
-
let pp_hum fmt t = pp fmt t
-
end
-
-
module Email_address_group = struct
-
type t = {
-
name : string option;
-
addresses : Email_address.t list;
-
}
-
-
let name t = t.name
-
let addresses t = t.addresses
-
-
let v ?name ~addresses () = { name; addresses }
-
end
-
-
module Email_header = struct
-
type t = {
-
name : string;
-
value : string;
-
}
-
-
let name t = t.name
-
let value t = t.value
-
-
let v ~name ~value () = { name; value }
-
-
let to_json t =
-
`Assoc [
-
("name", `String t.name);
-
("value", `String t.value);
-
]
-
-
let of_json = function
-
| `Assoc fields ->
-
let name = match List.assoc_opt "name" fields with
-
| Some (`String name) -> name
-
| _ -> failwith "Email_header.of_json: missing or invalid name field"
-
in
-
let value = match List.assoc_opt "value" fields with
-
| Some (`String value) -> value
-
| _ -> failwith "Email_header.of_json: missing or invalid value field"
-
in
-
{ name; value }
-
| _ -> failwith "Email_header.of_json: expected JSON object"
-
end
-
-
module Email_body_part = struct
-
type t = {
-
id : string option;
-
blob_id : id option;
-
size : uint;
-
headers : Email_header.t list;
-
name : string option;
-
mime_type : string;
-
charset : string option;
-
disposition : string option;
-
cid : string option;
-
language : string list option;
-
location : string option;
-
sub_parts : t list option;
-
other_headers : Yojson.Safe.t string_map;
-
}
-
-
let id t = t.id
-
let blob_id t = t.blob_id
-
let size t = t.size
-
let headers t = t.headers
-
let name t = t.name
-
let mime_type t = t.mime_type
-
let charset t = t.charset
-
let disposition t = t.disposition
-
let cid t = t.cid
-
let language t = t.language
-
let location t = t.location
-
let sub_parts t = t.sub_parts
-
let other_headers t = t.other_headers
-
-
let v ?id ?blob_id ~size ~headers ?name ~mime_type ?charset
-
?disposition ?cid ?language ?location ?sub_parts
-
?(other_headers = Hashtbl.create 0) () =
-
{ id; blob_id; size; headers; name; mime_type; charset;
-
disposition; cid; language; location; sub_parts; other_headers }
-
-
let rec to_json t =
-
let fields = [
-
("size", `Int t.size);
-
("headers", `List (List.map Email_header.to_json t.headers));
-
("type", `String t.mime_type);
-
] in
-
let fields = match t.id with
-
| Some id -> ("partId", `String id) :: fields
-
| None -> fields
-
in
-
let fields = match t.blob_id with
-
| Some blob_id -> ("blobId", `String blob_id) :: fields
-
| None -> fields
-
in
-
let fields = match t.name with
-
| Some name -> ("name", `String name) :: fields
-
| None -> fields
-
in
-
let fields = match t.charset with
-
| Some charset -> ("charset", `String charset) :: fields
-
| None -> fields
-
in
-
let fields = match t.disposition with
-
| Some disposition -> ("disposition", `String disposition) :: fields
-
| None -> fields
-
in
-
let fields = match t.cid with
-
| Some cid -> ("cid", `String cid) :: fields
-
| None -> fields
-
in
-
let fields = match t.language with
-
| Some langs -> ("language", `List (List.map (fun l -> `String l) langs)) :: fields
-
| None -> fields
-
in
-
let fields = match t.location with
-
| Some location -> ("location", `String location) :: fields
-
| None -> fields
-
in
-
let fields = match t.sub_parts with
-
| Some sub_parts -> ("subParts", `List (List.map to_json sub_parts)) :: fields
-
| None -> fields
-
in
-
let fields = Hashtbl.fold (fun k v acc -> (k, v) :: acc) t.other_headers fields in
-
`Assoc fields
-
-
let rec of_json json =
-
match json with
-
| `Assoc fields ->
-
let size = match List.assoc_opt "size" fields with
-
| Some (`Int size) -> size
-
| _ -> failwith "Email_body_part.of_json: missing or invalid size field"
-
in
-
let mime_type = match List.assoc_opt "type" fields with
-
| Some (`String mime_type) -> mime_type
-
| _ -> failwith "Email_body_part.of_json: missing or invalid type field"
-
in
-
let headers = match List.assoc_opt "headers" fields with
-
| Some (`List header_list) -> List.map Email_header.of_json header_list
-
| _ -> failwith "Email_body_part.of_json: missing or invalid headers field"
-
in
-
let id = match List.assoc_opt "partId" fields with
-
| Some (`String id) -> Some id
-
| Some `Null | None -> None
-
| _ -> failwith "Email_body_part.of_json: invalid partId field"
-
in
-
let blob_id = match List.assoc_opt "blobId" fields with
-
| Some (`String blob_id) -> Some blob_id
-
| Some `Null | None -> None
-
| _ -> failwith "Email_body_part.of_json: invalid blobId field"
-
in
-
let name = match List.assoc_opt "name" fields with
-
| Some (`String name) -> Some name
-
| Some `Null | None -> None
-
| _ -> failwith "Email_body_part.of_json: invalid name field"
-
in
-
let charset = match List.assoc_opt "charset" fields with
-
| Some (`String charset) -> Some charset
-
| Some `Null | None -> None
-
| _ -> failwith "Email_body_part.of_json: invalid charset field"
-
in
-
let disposition = match List.assoc_opt "disposition" fields with
-
| Some (`String disposition) -> Some disposition
-
| Some `Null | None -> None
-
| _ -> failwith "Email_body_part.of_json: invalid disposition field"
-
in
-
let cid = match List.assoc_opt "cid" fields with
-
| Some (`String cid) -> Some cid
-
| Some `Null | None -> None
-
| _ -> failwith "Email_body_part.of_json: invalid cid field"
-
in
-
let language = match List.assoc_opt "language" fields with
-
| Some (`List lang_list) ->
-
Some (List.map (function
-
| `String l -> l
-
| _ -> failwith "Email_body_part.of_json: invalid language list item"
-
) lang_list)
-
| Some `Null | None -> None
-
| _ -> failwith "Email_body_part.of_json: invalid language field"
-
in
-
let location = match List.assoc_opt "location" fields with
-
| Some (`String location) -> Some location
-
| Some `Null | None -> None
-
| _ -> failwith "Email_body_part.of_json: invalid location field"
-
in
-
let sub_parts = match List.assoc_opt "subParts" fields with
-
| Some (`List sub_part_list) -> Some (List.map of_json sub_part_list)
-
| Some `Null | None -> None
-
| _ -> failwith "Email_body_part.of_json: invalid subParts field"
-
in
-
let other_headers = Hashtbl.create 0 in
-
let standard_fields = [
-
"partId"; "blobId"; "size"; "headers"; "name"; "type";
-
"charset"; "disposition"; "cid"; "language"; "location"; "subParts"
-
] in
-
List.iter (fun (k, v) ->
-
if not (List.mem k standard_fields) then
-
Hashtbl.add other_headers k v
-
) fields;
-
{ id; blob_id; size; headers; name; mime_type; charset;
-
disposition; cid; language; location; sub_parts; other_headers }
-
| _ -> failwith "Email_body_part.of_json: expected JSON object"
-
end
-
-
module Email_body_value = struct
-
type t = {
-
value : string;
-
has_encoding_problem : bool;
-
is_truncated : bool;
-
}
-
-
let value t = t.value
-
let has_encoding_problem t = t.has_encoding_problem
-
let is_truncated t = t.is_truncated
-
-
let v ~value ?(encoding_problem = false) ?(truncated = false) () =
-
{ value; has_encoding_problem = encoding_problem; is_truncated = truncated }
-
end
-
-
module Keywords = struct
-
type keyword =
-
| Draft
-
| Seen
-
| Flagged
-
| Answered
-
| Forwarded
-
| Phishing
-
| Junk
-
| NotJunk
-
| Notify
-
| Muted
-
| Followed
-
| Memo
-
| HasMemo
-
| Autosent
-
| Unsubscribed
-
| CanUnsubscribe
-
| Imported
-
| IsTrusted
-
| MaskedEmail
-
| New
-
| MailFlagBit0
-
| MailFlagBit1
-
| MailFlagBit2
-
| Custom of string
-
-
type t = keyword list
-
-
let is_draft t = List.mem Draft t
-
let is_seen t = List.mem Seen t
-
let is_unread t = not (is_seen t) && not (is_draft t)
-
let is_flagged t = List.mem Flagged t
-
let is_answered t = List.mem Answered t
-
let is_forwarded t = List.mem Forwarded t
-
let is_phishing t = List.mem Phishing t
-
let is_junk t = List.mem Junk t
-
let is_not_junk t = List.mem NotJunk t
-
-
let has_keyword t kw =
-
List.exists (function Custom k -> k = kw | _ -> false) t
-
-
let custom_keywords t =
-
List.filter_map (function Custom k -> Some k | _ -> None) t
-
-
let add t kw =
-
if List.mem kw t then t else kw :: t
-
-
let remove t kw =
-
List.filter (fun k -> k <> kw) t
-
-
let empty () = []
-
-
let of_list kws = kws
-
-
let to_string = function
-
| Draft -> "$draft"
-
| Seen -> "$seen"
-
| Flagged -> "$flagged"
-
| Answered -> "$answered"
-
| Forwarded -> "$forwarded"
-
| Phishing -> "$phishing"
-
| Junk -> "$junk"
-
| NotJunk -> "$notjunk"
-
| Notify -> "$notify"
-
| Muted -> "$muted"
-
| Followed -> "$followed"
-
| Memo -> "$memo"
-
| HasMemo -> "$hasmemo"
-
| Autosent -> "$autosent"
-
| Unsubscribed -> "$unsubscribed"
-
| CanUnsubscribe -> "$canunsubscribe"
-
| Imported -> "$imported"
-
| IsTrusted -> "$istrusted"
-
| MaskedEmail -> "$maskedemail"
-
| New -> "$new"
-
| MailFlagBit0 -> "$MailFlagBit0"
-
| MailFlagBit1 -> "$MailFlagBit1"
-
| MailFlagBit2 -> "$MailFlagBit2"
-
| Custom s -> s
-
-
let of_string = function
-
| "$draft" -> Draft
-
| "$seen" -> Seen
-
| "$flagged" -> Flagged
-
| "$answered" -> Answered
-
| "$forwarded" -> Forwarded
-
| "$phishing" -> Phishing
-
| "$junk" -> Junk
-
| "$notjunk" -> NotJunk
-
| "$notify" -> Notify
-
| "$muted" -> Muted
-
| "$followed" -> Followed
-
| "$memo" -> Memo
-
| "$hasmemo" -> HasMemo
-
| "$autosent" -> Autosent
-
| "$unsubscribed" -> Unsubscribed
-
| "$canunsubscribe" -> CanUnsubscribe
-
| "$imported" -> Imported
-
| "$istrusted" -> IsTrusted
-
| "$maskedemail" -> MaskedEmail
-
| "$new" -> New
-
| "$MailFlagBit0" -> MailFlagBit0
-
| "$MailFlagBit1" -> MailFlagBit1
-
| "$MailFlagBit2" -> MailFlagBit2
-
| s -> Custom s
-
-
let to_map t =
-
let map = Hashtbl.create (List.length t) in
-
List.iter (fun kw -> Hashtbl.add map (to_string kw) true) t;
-
map
-
-
let to_json t =
-
let map_json = to_map t in
-
let assoc_list = Hashtbl.fold (fun k v acc -> (k, `Bool v) :: acc) map_json [] in
-
`Assoc assoc_list
-
-
let of_json = function
-
| `Assoc fields ->
-
List.fold_left (fun acc (key, value) ->
-
match value with
-
| `Bool true -> (of_string key) :: acc
-
| `Bool false -> acc (* Keywords with false value are not present *)
-
| _ -> failwith ("Keywords.of_json: invalid keyword value for " ^ key)
-
) [] fields
-
| _ -> failwith "Keywords.of_json: expected JSON object"
-
end
-
-
-
module Email = struct
-
type t = {
-
id : id option;
-
blob_id : id option;
-
thread_id : id option;
-
mailbox_ids : bool id_map option;
-
keywords : Keywords.t option;
-
size : uint option;
-
received_at : date option;
-
subject : string option;
-
preview : string option;
-
from : Email_address.t list option;
-
to_ : Email_address.t list option;
-
cc : Email_address.t list option;
-
message_id : string list option;
-
has_attachment : bool option;
-
text_body : Email_body_part.t list option;
-
html_body : Email_body_part.t list option;
-
attachments : Email_body_part.t list option;
-
}
-
-
let id t = t.id
-
let blob_id t = t.blob_id
-
let thread_id t = t.thread_id
-
let mailbox_ids t = t.mailbox_ids
-
let keywords t = t.keywords
-
let size t = t.size
-
let received_at t = t.received_at
-
let subject t = t.subject
-
let preview t = t.preview
-
let from t = t.from
-
let to_ t = t.to_
-
let cc t = t.cc
-
let message_id t = t.message_id
-
let has_attachment t = t.has_attachment
-
let text_body t = t.text_body
-
let html_body t = t.html_body
-
let attachments t = t.attachments
-
-
let create ?id ?blob_id ?thread_id ?mailbox_ids ?keywords ?size
-
?received_at ?subject ?preview ?from ?to_ ?cc ?message_id
-
?has_attachment ?text_body ?html_body ?attachments () =
-
{ id; blob_id; thread_id; mailbox_ids; keywords; size;
-
received_at; subject; preview; from; to_; cc; message_id;
-
has_attachment; text_body; html_body; attachments }
-
-
let make_patch ?add_keywords ?remove_keywords ?add_mailboxes ?remove_mailboxes () =
-
let patches = [] in
-
let patches = match add_keywords with
-
| Some kws ->
-
List.fold_left (fun acc kw ->
-
("/keywords/" ^ Keywords.to_string kw, `Bool true) :: acc
-
) patches kws
-
| None -> patches
-
in
-
let patches = match remove_keywords with
-
| Some kws ->
-
List.fold_left (fun acc kw ->
-
("/keywords/" ^ Keywords.to_string kw, `Null) :: acc
-
) patches kws
-
| None -> patches
-
in
-
let patches = match add_mailboxes with
-
| Some ids ->
-
List.fold_left (fun acc id ->
-
("/mailboxIds/" ^ id, `Bool true) :: acc
-
) patches ids
-
| None -> patches
-
in
-
let patches = match remove_mailboxes with
-
| Some ids ->
-
List.fold_left (fun acc id ->
-
("/mailboxIds/" ^ id, `Null) :: acc
-
) patches ids
-
| None -> patches
-
in
-
patches
-
-
let get_id t =
-
match t.id with
-
| Some id -> Ok id
-
| None -> Error "Email has no ID"
-
-
let take_id t =
-
match t.id with
-
| Some id -> id
-
| None -> failwith "Email has no ID"
-
-
(* Helper function to convert mailbox ID map to JSON *)
-
let mailbox_ids_to_json mailbox_ids =
-
let assoc_list = Hashtbl.fold (fun k v acc -> (k, `Bool v) :: acc) mailbox_ids [] in
-
`Assoc assoc_list
-
-
(* Helper function to parse mailbox ID map from JSON *)
-
let mailbox_ids_of_json = function
-
| `Assoc fields ->
-
let map = Hashtbl.create (List.length fields) in
-
List.iter (fun (k, v) ->
-
match v with
-
| `Bool b -> Hashtbl.add map k b
-
| _ -> failwith ("Email.mailbox_ids_of_json: invalid mailbox ID value for " ^ k)
-
) fields;
-
map
-
| _ -> failwith "Email.mailbox_ids_of_json: expected JSON object"
-
-
let to_json t =
-
let fields = [] in
-
let fields = match t.id with
-
| Some id -> ("id", `String id) :: fields
-
| None -> fields
-
in
-
let fields = match t.blob_id with
-
| Some blob_id -> ("blobId", `String blob_id) :: fields
-
| None -> fields
-
in
-
let fields = match t.thread_id with
-
| Some thread_id -> ("threadId", `String thread_id) :: fields
-
| None -> fields
-
in
-
let fields = match t.mailbox_ids with
-
| Some mailbox_ids -> ("mailboxIds", mailbox_ids_to_json mailbox_ids) :: fields
-
| None -> fields
-
in
-
let fields = match t.keywords with
-
| Some keywords -> ("keywords", Keywords.to_json keywords) :: fields
-
| None -> fields
-
in
-
let fields = match t.size with
-
| Some size -> ("size", `Int size) :: fields
-
| None -> fields
-
in
-
let fields = match t.received_at with
-
| Some date -> ("receivedAt", `Float date) :: fields
-
| None -> fields
-
in
-
let fields = match t.subject with
-
| Some subject -> ("subject", `String subject) :: fields
-
| None -> fields
-
in
-
let fields = match t.preview with
-
| Some preview -> ("preview", `String preview) :: fields
-
| None -> fields
-
in
-
let fields = match t.from with
-
| Some from -> ("from", `List (List.map Email_address.to_json from)) :: fields
-
| None -> fields
-
in
-
let fields = match t.to_ with
-
| Some to_ -> ("to", `List (List.map Email_address.to_json to_)) :: fields
-
| None -> fields
-
in
-
let fields = match t.cc with
-
| Some cc -> ("cc", `List (List.map Email_address.to_json cc)) :: fields
-
| None -> fields
-
in
-
let fields = match t.message_id with
-
| Some message_ids -> ("messageId", `List (List.map (fun s -> `String s) message_ids)) :: fields
-
| None -> fields
-
in
-
let fields = match t.has_attachment with
-
| Some has_attachment -> ("hasAttachment", `Bool has_attachment) :: fields
-
| None -> fields
-
in
-
let fields = match t.text_body with
-
| Some text_body -> ("textBody", `List (List.map Email_body_part.to_json text_body)) :: fields
-
| None -> fields
-
in
-
let fields = match t.html_body with
-
| Some html_body -> ("htmlBody", `List (List.map Email_body_part.to_json html_body)) :: fields
-
| None -> fields
-
in
-
let fields = match t.attachments with
-
| Some attachments -> ("attachments", `List (List.map Email_body_part.to_json attachments)) :: fields
-
| None -> fields
-
in
-
`Assoc fields
-
-
let of_json json =
-
match json with
-
| `Assoc fields ->
-
let id = match List.assoc_opt "id" fields with
-
| Some (`String id) -> Some id
-
| Some `Null | None -> None
-
| _ -> failwith "Email.of_json: invalid id field"
-
in
-
let blob_id = match List.assoc_opt "blobId" fields with
-
| Some (`String blob_id) -> Some blob_id
-
| Some `Null | None -> None
-
| _ -> failwith "Email.of_json: invalid blobId field"
-
in
-
let thread_id = match List.assoc_opt "threadId" fields with
-
| Some (`String thread_id) -> Some thread_id
-
| Some `Null | None -> None
-
| _ -> failwith "Email.of_json: invalid threadId field"
-
in
-
let mailbox_ids = match List.assoc_opt "mailboxIds" fields with
-
| Some json_obj -> Some (mailbox_ids_of_json json_obj)
-
| None -> None
-
in
-
let keywords = match List.assoc_opt "keywords" fields with
-
| Some json_obj -> Some (Keywords.of_json json_obj)
-
| None -> None
-
in
-
let size = match List.assoc_opt "size" fields with
-
| Some (`Int size) -> Some size
-
| Some `Null | None -> None
-
| _ -> failwith "Email.of_json: invalid size field"
-
in
-
let received_at = match List.assoc_opt "receivedAt" fields with
-
| Some (`Float date) -> Some date
-
| Some (`String date_str) ->
-
(* Parse ISO 8601 date string to Unix timestamp *)
-
(try
-
(* Simple ISO 8601 parser for "YYYY-MM-DDTHH:MM:SSZ" format *)
-
let parse_iso8601 s =
-
if String.length s >= 19 && s.[10] = 'T' then
-
let year = int_of_string (String.sub s 0 4) in
-
let month = int_of_string (String.sub s 5 2) in
-
let day = int_of_string (String.sub s 8 2) in
-
let hour = int_of_string (String.sub s 11 2) in
-
let minute = int_of_string (String.sub s 14 2) in
-
let second = int_of_string (String.sub s 17 2) in
-
(* Convert to Unix timestamp - approximate conversion *)
-
let days_since_epoch =
-
(year - 1970) * 365 + (year - 1969) / 4 - (year - 1901) / 100 + (year - 1601) / 400 +
-
[|0; 31; 59; 90; 120; 151; 181; 212; 243; 273; 304; 334|].(month - 1) + day - 1 in
-
let seconds_in_day = hour * 3600 + minute * 60 + second in
-
float_of_int (days_since_epoch * 86400 + seconds_in_day)
-
else
-
failwith "Invalid ISO 8601 format"
-
in
-
Some (parse_iso8601 date_str)
-
with _ -> failwith "Email.of_json: invalid receivedAt date format")
-
| Some `Null | None -> None
-
| _ -> failwith "Email.of_json: invalid receivedAt field"
-
in
-
let subject = match List.assoc_opt "subject" fields with
-
| Some (`String subject) -> Some subject
-
| Some `Null | None -> None
-
| _ -> failwith "Email.of_json: invalid subject field"
-
in
-
let preview = match List.assoc_opt "preview" fields with
-
| Some (`String preview) -> Some preview
-
| Some `Null | None -> None
-
| _ -> failwith "Email.of_json: invalid preview field"
-
in
-
let from = match List.assoc_opt "from" fields with
-
| Some (`List from_list) ->
-
let rec process_addresses acc = function
-
| [] -> Some (List.rev acc)
-
| addr :: rest ->
-
(match Email_address.of_json addr with
-
| Ok a -> process_addresses (a :: acc) rest
-
| Error _ -> failwith "Email.of_json: invalid address in from field")
-
in
-
process_addresses [] from_list
-
| Some `Null | None -> None
-
| _ -> failwith "Email.of_json: invalid from field"
-
in
-
let to_ = match List.assoc_opt "to" fields with
-
| Some (`List to_list) ->
-
let rec process_addresses acc = function
-
| [] -> Some (List.rev acc)
-
| addr :: rest ->
-
(match Email_address.of_json addr with
-
| Ok a -> process_addresses (a :: acc) rest
-
| Error _ -> failwith "Email.of_json: invalid address in to field")
-
in
-
process_addresses [] to_list
-
| Some `Null | None -> None
-
| _ -> failwith "Email.of_json: invalid to field"
-
in
-
let cc = match List.assoc_opt "cc" fields with
-
| Some (`List cc_list) ->
-
let rec process_addresses acc = function
-
| [] -> Some (List.rev acc)
-
| addr :: rest ->
-
(match Email_address.of_json addr with
-
| Ok a -> process_addresses (a :: acc) rest
-
| Error _ -> failwith "Email.of_json: invalid address in cc field")
-
in
-
process_addresses [] cc_list
-
| Some `Null | None -> None
-
| _ -> failwith "Email.of_json: invalid cc field"
-
in
-
let message_id = match List.assoc_opt "messageId" fields with
-
| Some (`List msg_id_list) ->
-
Some (List.map (function
-
| `String s -> s
-
| _ -> failwith "Email.of_json: invalid messageId list item"
-
) msg_id_list)
-
| Some `Null | None -> None
-
| _ -> failwith "Email.of_json: invalid messageId field"
-
in
-
let has_attachment = match List.assoc_opt "hasAttachment" fields with
-
| Some (`Bool has_attachment) -> Some has_attachment
-
| Some `Null | None -> None
-
| _ -> failwith "Email.of_json: invalid hasAttachment field"
-
in
-
let text_body = match List.assoc_opt "textBody" fields with
-
| Some (`List body_list) -> Some (List.map Email_body_part.of_json body_list)
-
| Some `Null | None -> None
-
| _ -> failwith "Email.of_json: invalid textBody field"
-
in
-
let html_body = match List.assoc_opt "htmlBody" fields with
-
| Some (`List body_list) -> Some (List.map Email_body_part.of_json body_list)
-
| Some `Null | None -> None
-
| _ -> failwith "Email.of_json: invalid htmlBody field"
-
in
-
let attachments = match List.assoc_opt "attachments" fields with
-
| Some (`List att_list) -> Some (List.map Email_body_part.of_json att_list)
-
| Some `Null | None -> None
-
| _ -> failwith "Email.of_json: invalid attachments field"
-
in
-
{ id; blob_id; thread_id; mailbox_ids; keywords; size;
-
received_at; subject; preview; from; to_; cc; message_id;
-
has_attachment; text_body; html_body; attachments }
-
| _ -> failwith "Email.of_json: expected JSON object"
-
end
-
-
module Import = struct
-
type args = {
-
account_id : id;
-
blob_ids : id list;
-
mailbox_ids : id id_map;
-
keywords : Keywords.t option;
-
received_at : date option;
-
}
-
-
let create_args ~account_id ~blob_ids ~mailbox_ids ?keywords ?received_at () =
-
{ account_id; blob_ids; mailbox_ids; keywords; received_at }
-
-
type email_import_result = {
-
blob_id : id;
-
email : Email.t;
-
}
-
-
let create_result ~blob_id ~email () = { blob_id; email }
-
-
type response = {
-
account_id : id;
-
created : email_import_result id_map;
-
not_created : Jmap.Error.Set_error.t id_map;
-
}
-
-
let create_response ~account_id ~created ~not_created () =
-
{ account_id; created; not_created }
-
end
-
-
module Parse = struct
-
type args = {
-
account_id : id;
-
blob_ids : id list;
-
properties : string list option;
-
}
-
-
let create_args ~account_id ~blob_ids ?properties () =
-
{ account_id; blob_ids; properties }
-
-
type email_parse_result = {
-
blob_id : id;
-
parsed : Email.t;
-
}
-
-
let create_result ~blob_id ~parsed () = { blob_id; parsed }
-
-
type response = {
-
account_id : id;
-
parsed : email_parse_result id_map;
-
not_parsed : string id_map;
-
}
-
-
let create_response ~account_id ~parsed ~not_parsed () =
-
{ account_id; parsed; not_parsed }
-
end
-
-
-
module Copy = struct
-
type args = {
-
from_account_id : id;
-
account_id : id;
-
create : (id * id id_map) id_map;
-
on_success_destroy_original : bool option;
-
destroy_from_if_in_state : string option;
-
}
-
-
let create_args ~from_account_id ~account_id ~create
-
?on_success_destroy_original ?destroy_from_if_in_state () =
-
{ from_account_id; account_id; create;
-
on_success_destroy_original; destroy_from_if_in_state }
-
-
type response = {
-
from_account_id : id;
-
account_id : id;
-
created : Email.t id_map option;
-
not_created : Jmap.Error.Set_error.t id_map option;
-
}
-
-
let create_response ~from_account_id ~account_id ?created ?not_created () =
-
{ from_account_id; account_id; created; not_created }
-
end
-
-
-764
jmap/jmap-email/types.mli
···
-
(** Common types for JMAP Mail (RFC 8621).
-
-
This module defines the core data types and structures used throughout the JMAP Mail
-
specification. These types represent email objects, addresses, body parts, keywords,
-
and methods for importing, parsing, and copying email messages.
-
-
All types follow the JMAP specification for immutable, server-synchronized objects
-
with appropriate property access patterns.
-
-
@see <https://www.rfc-editor.org/rfc/rfc8621.html> RFC 8621: The JSON Meta Application Protocol (JMAP) for Mail
-
*)
-
-
open Jmap.Types
-
-
(** Email address representation.
-
-
Represents an email address as specified in RFC 8621 Section 4.1.2.3.
-
An email address consists of an email field (required) and an optional
-
name field for display purposes. This follows the standard format used
-
in email headers like "From", "To", "Cc", etc.
-
-
The email field MUST be a valid RFC 5322 addr-spec and the name field,
-
if present, provides a human-readable display name.
-
-
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.2.3> RFC 8621, Section 4.1.2.3
-
*)
-
module Email_address : sig
-
type t
-
-
(** JSON serialization interface *)
-
include Jmap_sigs.JSONABLE with type t := t
-
-
(** Pretty-printing interface *)
-
include Jmap_sigs.PRINTABLE with type t := t
-
-
(** Get the display name for the address.
-
@return The human-readable display name, or None if not set *)
-
val name : t -> string option
-
-
(** Get the actual email address.
-
@return The RFC 5322 addr-spec email address *)
-
val email : t -> string
-
-
(** Create a new email address object.
-
@param name Optional human-readable display name
-
@param email Required RFC 5322 addr-spec email address
-
@return New email address object *)
-
val v :
-
?name:string ->
-
email:string ->
-
unit -> t
-
-
end
-
-
(** Email address group representation.
-
-
Represents a named group of email addresses as specified in RFC 8621 Section 4.1.2.4.
-
This corresponds to RFC 5322 group syntax in email headers, allowing multiple
-
addresses to be grouped under a common name.
-
-
Groups are used in headers like "To", "Cc", and "Bcc" when addresses need to be
-
organized or when mailing list functionality is involved.
-
-
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.2.4> RFC 8621, Section 4.1.2.4
-
*)
-
module Email_address_group : sig
-
type t
-
-
(** Get the name of the address group.
-
@return The group name, or None if not set *)
-
val name : t -> string option
-
-
(** Get the list of email addresses in the group.
-
@return List of email addresses belonging to this group *)
-
val addresses : t -> Email_address.t list
-
-
(** Create a new email address group.
-
@param name Optional group name
-
@param addresses List of email addresses in the group
-
@return New address group object *)
-
val v :
-
?name:string ->
-
addresses:Email_address.t list ->
-
unit -> t
-
end
-
-
(** Email header field representation.
-
-
Represents a single email header field as specified in RFC 8621 Section 4.1.3.
-
Each header consists of a field name and its raw, unprocessed value as it
-
appears in the original email message.
-
-
Header fields follow RFC 5322 syntax and are used to provide access to
-
both standard headers (Subject, From, To, etc.) and custom headers that
-
may not be parsed into specific Email object properties.
-
-
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.3> RFC 8621, Section 4.1.3
-
*)
-
module Email_header : sig
-
type t
-
-
(** Get the header field name.
-
@return The header field name (e.g., "Subject", "X-Custom-Header") *)
-
val name : t -> string
-
-
(** Get the raw header field value.
-
@return The unprocessed header value as it appears in the message *)
-
val value : t -> string
-
-
(** Create a new header field.
-
@param name The header field name
-
@param value The raw header field value
-
@return New header field object *)
-
val v :
-
name:string ->
-
value:string ->
-
unit -> t
-
-
(** Convert header field to JSON representation.
-
@param t The header field to convert
-
@return JSON object with 'name' and 'value' fields *)
-
val to_json : t -> Yojson.Safe.t
-
-
(** Parse header field from JSON representation.
-
@param json JSON object with 'name' and 'value' fields
-
@return Parsed header field object
-
@raise Failure if JSON structure is invalid *)
-
val of_json : Yojson.Safe.t -> t
-
end
-
-
(** Email body part representation.
-
-
Represents a single part within an email's MIME structure as specified in
-
RFC 8621 Section 4.1.4. Each body part can be either a leaf part containing
-
actual content or a multipart container holding sub-parts.
-
-
Body parts include information about MIME type, encoding, disposition,
-
size, and other RFC 2045-2047 MIME attributes. For multipart types,
-
the sub_parts field contains nested body parts.
-
-
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.4> RFC 8621, Section 4.1.4
-
*)
-
module Email_body_part : sig
-
type t
-
-
(** Get the part ID for referencing this specific part.
-
@return Part identifier, or None for multipart container types *)
-
val id : t -> string option
-
-
(** Get the blob ID for downloading the part content.
-
@return Blob identifier for content access, or None for multipart types *)
-
val blob_id : t -> id option
-
-
(** Get the size of the part in bytes.
-
@return Size in bytes of the decoded content *)
-
val size : t -> uint
-
-
(** Get the list of MIME headers for this part.
-
@return List of header fields specific to this body part *)
-
val headers : t -> Email_header.t list
-
-
(** Get the filename parameter from Content-Disposition or Content-Type.
-
@return Filename if present, None otherwise *)
-
val name : t -> string option
-
-
(** Get the MIME content type.
-
@return MIME type (e.g., "text/plain", "image/jpeg") *)
-
val mime_type : t -> string
-
-
(** Get the character set parameter.
-
@return Character encoding (e.g., "utf-8", "iso-8859-1"), None if not specified *)
-
val charset : t -> string option
-
-
(** Get the Content-Disposition header value.
-
@return Disposition type (e.g., "attachment", "inline"), None if not specified *)
-
val disposition : t -> string option
-
-
(** Get the Content-ID header value for referencing within HTML content.
-
@return Content identifier for inline references, None if not specified *)
-
val cid : t -> string option
-
-
(** Get the Content-Language header values.
-
@return List of language codes (e.g., ["en"; "fr"]), None if not specified *)
-
val language : t -> string list option
-
-
(** Get the Content-Location header value.
-
@return URI reference for content location, None if not specified *)
-
val location : t -> string option
-
-
(** Get nested parts for multipart content types.
-
@return List of sub-parts for multipart types, None for leaf parts *)
-
val sub_parts : t -> t list option
-
-
(** Get additional headers requested via header properties.
-
@return Map of header names to their JSON values for extended header access *)
-
val other_headers : t -> Yojson.Safe.t string_map
-
-
(** Create a new body part object.*)
-
val v :
-
?id:string ->
-
?blob_id:id ->
-
size:uint ->
-
headers:Email_header.t list ->
-
?name:string ->
-
mime_type:string ->
-
?charset:string ->
-
?disposition:string ->
-
?cid:string ->
-
?language:string list ->
-
?location:string ->
-
?sub_parts:t list ->
-
?other_headers:Yojson.Safe.t string_map ->
-
unit -> t
-
-
(** Convert body part to JSON representation.
-
@param t The body part to convert
-
@return JSON object with all body part fields *)
-
val to_json : t -> Yojson.Safe.t
-
-
(** Parse body part from JSON representation.
-
@param json JSON object representing a body part
-
@return Parsed body part object
-
@raise Failure if JSON structure is invalid *)
-
val of_json : Yojson.Safe.t -> t
-
end
-
-
(** Decoded email body content.
-
-
Represents the decoded text content of a body part as specified in RFC 8621
-
Section 4.1.4. This provides access to the actual text content after MIME
-
decoding, along with metadata about potential encoding issues or truncation.
-
-
Used primarily for text/plain and text/html parts where the decoded content
-
is needed for display or processing.
-
-
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.4> RFC 8621, Section 4.1.4
-
*)
-
module Email_body_value : sig
-
type t
-
-
(** Get the decoded text content.
-
@return The decoded text content of the body part *)
-
val value : t -> string
-
-
(** Check if there was an encoding problem during decoding.
-
@return true if encoding issues were encountered during decoding *)
-
val has_encoding_problem : t -> bool
-
-
(** Check if the content was truncated by the server.
-
@return true if the content was truncated to fit size limits *)
-
val is_truncated : t -> bool
-
-
(** Create a new body value object.
-
@param value The decoded text content
-
@param encoding_problem Whether encoding problems were encountered (default: false)
-
@param truncated Whether the content was truncated (default: false)
-
@return New body value object *)
-
val v :
-
value:string ->
-
?encoding_problem:bool ->
-
?truncated:bool ->
-
unit -> t
-
end
-
-
(** Email keywords and flags system.
-
-
Represents the JMAP email keywords system as specified in RFC 8621 Section 4.1.1.
-
Keywords are used to store message flags and labels, providing compatibility with
-
IMAP flags while extending functionality for modern email clients.
-
-
The system supports standard IMAP system flags ($seen, $draft, etc.) as well as
-
vendor extensions (particularly Apple Mail extensions) and custom user-defined
-
keywords. Keywords are stored as a set and provide both boolean checks and
-
conversion functions for protocol serialization.
-
-
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.1> RFC 8621, Section 4.1.1
-
@see <https://datatracker.ietf.org/doc/draft-ietf-mailmaint-messageflag-mailboxattribute/> Draft for vendor extensions
-
*)
-
module Keywords : sig
-
(** Keyword type representing various email flags and labels.
-
-
Covers standard IMAP system flags, common extensions, vendor-specific
-
flags (particularly Apple Mail), and custom user-defined keywords.
-
*)
-
type keyword =
-
| Draft (** "$draft": Email is a draft being composed by the user *)
-
| Seen (** "$seen": Email has been read/viewed by the user *)
-
| Flagged (** "$flagged": Email has been flagged for urgent or special attention *)
-
| Answered (** "$answered": Email has been replied to *)
-
-
(* Common extension keywords from RFC 5788 and others *)
-
| Forwarded (** "$forwarded": Email has been forwarded to others *)
-
| Phishing (** "$phishing": Email is flagged as potential phishing attempt *)
-
| Junk (** "$junk": Email is classified as spam/junk mail *)
-
| NotJunk (** "$notjunk": Email is explicitly marked as legitimate (not spam) *)
-
-
(* Apple Mail and other vendor extension keywords *)
-
| Notify (** "$notify": User requests notification when email receives replies *)
-
| Muted (** "$muted": Email thread is muted (notifications disabled) *)
-
| Followed (** "$followed": Email thread is followed for special notifications *)
-
| Memo (** "$memo": Email has an associated memo or note *)
-
| HasMemo (** "$hasmemo": Email contains memo, annotation or note properties *)
-
| Autosent (** "$autosent": Email was automatically generated or sent *)
-
| Unsubscribed (** "$unsubscribed": User has unsubscribed from this sender *)
-
| CanUnsubscribe (** "$canunsubscribe": Email contains unsubscribe links/information *)
-
| Imported (** "$imported": Email was imported from another email system *)
-
| IsTrusted (** "$istrusted": Email sender is verified/trusted *)
-
| MaskedEmail (** "$maskedemail": Email uses masked/anonymous addressing *)
-
| New (** "$new": Email was recently delivered to the mailbox *)
-
-
(* Apple Mail color flag bit system for visual categorization *)
-
| MailFlagBit0 (** "$MailFlagBit0": First color flag bit (used for red) *)
-
| MailFlagBit1 (** "$MailFlagBit1": Second color flag bit (used for orange) *)
-
| MailFlagBit2 (** "$MailFlagBit2": Third color flag bit (used for yellow) *)
-
| Custom of string (** Custom user-defined keyword with arbitrary name *)
-
-
(** A set of keywords applied to an email.
-
-
Represents the collection of all flags and labels associated with a specific
-
email message. Keywords are stored as a list but logically represent a set
-
(duplicates are handled appropriately by the manipulation functions).
-
*)
-
type t = keyword list
-
-
(** Check if email is marked as a draft.
-
@return true if the Draft keyword is present *)
-
val is_draft : t -> bool
-
-
(** Check if email has been read.
-
@return true if the Seen keyword is present *)
-
val is_seen : t -> bool
-
-
(** Check if email is unread (not seen and not a draft).
-
@return true if email is neither seen nor a draft *)
-
val is_unread : t -> bool
-
-
(** Check if email is flagged for attention.
-
@return true if the Flagged keyword is present *)
-
val is_flagged : t -> bool
-
-
(** Check if email has been replied to.
-
@return true if the Answered keyword is present *)
-
val is_answered : t -> bool
-
-
(** Check if email has been forwarded.
-
@return true if the Forwarded keyword is present *)
-
val is_forwarded : t -> bool
-
-
(** Check if email is flagged as potential phishing.
-
@return true if the Phishing keyword is present *)
-
val is_phishing : t -> bool
-
-
(** Check if email is classified as junk/spam.
-
@return true if the Junk keyword is present *)
-
val is_junk : t -> bool
-
-
(** Check if email is explicitly marked as legitimate.
-
@return true if the NotJunk keyword is present *)
-
val is_not_junk : t -> bool
-
-
(** Check if a specific custom keyword is present.
-
@param keywords The keyword set to check
-
@param keyword The custom keyword string to look for
-
@return true if the custom keyword is present *)
-
val has_keyword : t -> string -> bool
-
-
(** Get all custom keywords, excluding standard system keywords.
-
@return List of custom keyword strings *)
-
val custom_keywords : t -> string list
-
-
(** Add a keyword to the set (avoiding duplicates).
-
@param keywords The current keyword set
-
@param keyword The keyword to add
-
@return New keyword set with the keyword added *)
-
val add : t -> keyword -> t
-
-
(** Remove a keyword from the set.
-
@param keywords The current keyword set
-
@param keyword The keyword to remove
-
@return New keyword set with the keyword removed *)
-
val remove : t -> keyword -> t
-
-
(** Create an empty keyword set.
-
@return Empty keyword set *)
-
val empty : unit -> t
-
-
(** Create a keyword set from a list of keywords.
-
@param keywords List of keywords to include
-
@return New keyword set containing the specified keywords *)
-
val of_list : keyword list -> t
-
-
(** Convert a keyword to its JMAP protocol string representation.
-
@param keyword The keyword to convert
-
@return JMAP protocol string (e.g., "$seen", "$draft") *)
-
val to_string : keyword -> string
-
-
(** Parse a JMAP protocol string into a keyword.
-
@param str The protocol string to parse
-
@return Corresponding keyword variant *)
-
val of_string : string -> keyword
-
-
(** Convert keyword set to JMAP wire format (string -> bool map).
-
@param keywords The keyword set to convert
-
@return Hash table mapping keyword strings to true values *)
-
val to_map : t -> bool string_map
-
-
(** Convert keyword set to JSON representation.
-
@param t The keyword set to convert
-
@return JSON object mapping keyword strings to boolean values *)
-
val to_json : t -> Yojson.Safe.t
-
-
(** Parse keyword set from JSON representation.
-
@param json JSON object mapping keyword strings to boolean values
-
@return Parsed keyword set
-
@raise Failure if JSON structure is invalid *)
-
val of_json : Yojson.Safe.t -> t
-
end
-
-
-
(** Email object representation and operations.
-
-
The Email object represents a single email message as defined in RFC 8621
-
Section 4.1. It provides access to message metadata, headers, body structure,
-
and content through a property-based API that supports partial object loading.
-
-
Email objects are immutable and server-controlled. All modifications must
-
be performed through the Email/set method using patch objects.
-
-
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1> RFC 8621, Section 4.1
-
*)
-
module Email : sig
-
(** Immutable email object type *)
-
type t
-
-
(** Get the server-assigned email identifier.
-
@return Email ID if present in the object *)
-
val id : t -> id option
-
-
(** Get the blob ID for downloading the complete raw message.
-
@return Blob identifier for RFC 5322 message access *)
-
val blob_id : t -> id option
-
-
(** Get the thread identifier linking related messages.
-
@return Thread ID for conversation grouping *)
-
val thread_id : t -> id option
-
-
(** Get the set of mailboxes containing this email.
-
@return Map of mailbox IDs to boolean values (always true when present) *)
-
val mailbox_ids : t -> bool id_map option
-
-
(** Get the keywords/flags applied to this email.
-
@return Set of keywords if included in the retrieved properties *)
-
val keywords : t -> Keywords.t option
-
-
(** Get the total size of the raw message.
-
@return Message size in octets *)
-
val size : t -> uint option
-
-
(** Get the server timestamp when the message was received.
-
@return Reception timestamp *)
-
val received_at : t -> date option
-
-
(** Get the email subject line.
-
@return Subject text if the Subject property was requested *)
-
val subject : t -> string option
-
-
(** Get the server-generated preview text for display.
-
@return Preview text if the Preview property was requested *)
-
val preview : t -> string option
-
-
(** Get the From header addresses.
-
@return List of sender addresses if the From property was requested *)
-
val from : t -> Email_address.t list option
-
-
(** Get the To header addresses.
-
@return List of primary recipient addresses if the To property was requested *)
-
val to_ : t -> Email_address.t list option
-
-
(** Get the Cc header addresses.
-
@return List of carbon copy addresses if the Cc property was requested *)
-
val cc : t -> Email_address.t list option
-
-
(** Get the Message-ID header values.
-
@return List of message identifiers if the MessageId property was requested *)
-
val message_id : t -> string list option
-
-
(** Check if the email has non-inline attachments.
-
@return true if attachments are present, if the HasAttachment property was requested *)
-
val has_attachment : t -> bool option
-
-
(** Get text/plain body parts suitable for display.
-
@return List of text body parts if the TextBody property was requested *)
-
val text_body : t -> Email_body_part.t list option
-
-
(** Get text/html body parts suitable for display.
-
@return List of HTML body parts if the HtmlBody property was requested *)
-
val html_body : t -> Email_body_part.t list option
-
-
(** Get attachment body parts.
-
@return List of attachment parts if the Attachments property was requested *)
-
val attachments : t -> Email_body_part.t list option
-
-
(** Create a new Email object.
-
-
Used primarily for constructing Email objects from server responses or
-
for testing purposes. In normal operation, Email objects are returned
-
by Email/get and related methods.
-
*)
-
val create :
-
?id:id ->
-
?blob_id:id ->
-
?thread_id:id ->
-
?mailbox_ids:bool id_map ->
-
?keywords:Keywords.t ->
-
?size:uint ->
-
?received_at:date ->
-
?subject:string ->
-
?preview:string ->
-
?from:Email_address.t list ->
-
?to_:Email_address.t list ->
-
?cc:Email_address.t list ->
-
?message_id:string list ->
-
?has_attachment:bool ->
-
?text_body:Email_body_part.t list ->
-
?html_body:Email_body_part.t list ->
-
?attachments:Email_body_part.t list ->
-
unit -> t
-
-
(** Create a patch object for Email/set operations.
-
-
Generates JSON Patch operations for modifying email properties.
-
Only keywords and mailbox membership can be modified after creation.
-
-
@param add_keywords Keywords to add to the email
-
@param remove_keywords Keywords to remove from the email
-
@param add_mailboxes Mailboxes to add the email to
-
@param remove_mailboxes Mailboxes to remove the email from
-
@return JSON Patch operations for Email/set
-
*)
-
val make_patch :
-
?add_keywords:Keywords.t ->
-
?remove_keywords:Keywords.t ->
-
?add_mailboxes:id list ->
-
?remove_mailboxes:id list ->
-
unit -> Jmap.Methods.patch_object
-
-
(** Safely extract the email ID.
-
@return Ok with the ID, or Error with message if not present *)
-
val get_id : t -> (id, string) result
-
-
(** Extract the email ID, raising an exception if not present.
-
@return The email ID
-
@raise Failure if the email has no ID *)
-
val take_id : t -> id
-
-
(** Convert email to JSON representation.
-
@param t The email to convert
-
@return JSON object with all email fields that are present *)
-
val to_json : t -> Yojson.Safe.t
-
-
(** Parse email from JSON representation.
-
@param json JSON object representing an email
-
@return Parsed email object
-
@raise Failure if JSON structure is invalid *)
-
val of_json : Yojson.Safe.t -> t
-
end
-
-
(** Email import functionality.
-
-
Provides types and operations for the Email/import method as specified in
-
RFC 8621 Section 4.8. This method allows importing email messages from
-
blob storage (typically uploaded via the Blob/upload method) into mailboxes
-
as Email objects.
-
-
The import process converts raw RFC 5322 message data into structured
-
Email objects with appropriate metadata and places them in specified mailboxes.
-
-
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.8> RFC 8621, Section 4.8
-
*)
-
module Import : sig
-
(** Arguments for Email/import method. *)
-
type args = {
-
account_id : id; (** Account where emails will be imported *)
-
blob_ids : id list; (** List of blob IDs containing RFC 5322 messages *)
-
mailbox_ids : id id_map; (** Map specifying target mailboxes for each blob *)
-
keywords : Keywords.t option; (** Default keywords to apply to imported emails *)
-
received_at : date option; (** Override timestamp for import (default: current time) *)
-
}
-
-
(** Create Email/import arguments.
-
@param account_id Target account for the import
-
@param blob_ids List of blob IDs containing message data
-
@param mailbox_ids Mapping of blob IDs to target mailbox sets
-
@param keywords Optional default keywords to apply
-
@param received_at Optional timestamp override
-
@return Import arguments object *)
-
val create_args :
-
account_id:id ->
-
blob_ids:id list ->
-
mailbox_ids:id id_map ->
-
?keywords:Keywords.t ->
-
?received_at:date ->
-
unit -> args
-
-
(** Result for a single successfully imported email. *)
-
type email_import_result = {
-
blob_id : id; (** Original blob ID that was imported *)
-
email : Email.t; (** Created Email object with server-assigned properties *)
-
}
-
-
(** Create an import result object.
-
@param blob_id The blob ID that was successfully imported
-
@param email The created Email object
-
@return Import result object *)
-
val create_result :
-
blob_id:id ->
-
email:Email.t ->
-
unit -> email_import_result
-
-
(** Complete response for Email/import method. *)
-
type response = {
-
account_id : id; (** Account where import was attempted *)
-
created : email_import_result id_map; (** Successfully imported emails by blob ID *)
-
not_created : Jmap.Error.Set_error.t id_map; (** Failed imports with error details *)
-
}
-
-
(** Create an import response object.
-
@param account_id Account where import was performed
-
@param created Map of successfully imported results
-
@param not_created Map of failed imports with errors
-
@return Import response object *)
-
val create_response :
-
account_id:id ->
-
created:email_import_result id_map ->
-
not_created:Jmap.Error.Set_error.t id_map ->
-
unit -> response
-
end
-
-
(** Email parsing functionality.
-
-
Provides types and operations for the Email/parse method as specified in
-
RFC 8621 Section 4.9. This method parses RFC 5322 message data from
-
blob storage into Email objects without importing them into mailboxes.
-
-
Parsing allows inspection of message structure and properties before
-
deciding whether to import messages, and provides access to Email object
-
properties for messages that may not be stored in the account.
-
-
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.9> RFC 8621, Section 4.9
-
*)
-
module Parse : sig
-
(** Arguments for Email/parse method. *)
-
type args = {
-
account_id : id; (** Account context for parsing *)
-
blob_ids : id list; (** List of blob IDs to parse *)
-
properties : string list option; (** Email properties to include in results *)
-
}
-
-
(** Create Email/parse arguments.
-
@param account_id Account context for the parsing operation
-
@param blob_ids List of blob IDs containing RFC 5322 messages
-
@param properties Optional list of Email properties to include
-
@return Parse arguments object *)
-
val create_args :
-
account_id:id ->
-
blob_ids:id list ->
-
?properties:string list ->
-
unit -> args
-
-
(** Result for a single successfully parsed email. *)
-
type email_parse_result = {
-
blob_id : id; (** Original blob ID that was parsed *)
-
parsed : Email.t; (** Parsed Email object (not stored in any mailbox) *)
-
}
-
-
(** Create a parse result object.
-
@param blob_id The blob ID that was successfully parsed
-
@param parsed The parsed Email object
-
@return Parse result object *)
-
val create_result :
-
blob_id:id ->
-
parsed:Email.t ->
-
unit -> email_parse_result
-
-
(** Complete response for Email/parse method. *)
-
type response = {
-
account_id : id; (** Account where parsing was performed *)
-
parsed : email_parse_result id_map; (** Successfully parsed emails by blob ID *)
-
not_parsed : string id_map; (** Failed parses with error messages *)
-
}
-
-
(** Create a parse response object.
-
@param account_id Account where parsing was performed
-
@param parsed Map of successfully parsed results
-
@param not_parsed Map of failed parses with error messages
-
@return Parse response object *)
-
val create_response :
-
account_id:id ->
-
parsed:email_parse_result id_map ->
-
not_parsed:string id_map ->
-
unit -> response
-
end
-
-
-
(** Email copying functionality.
-
-
Provides types and operations for the Email/copy method as specified in
-
RFC 8621 Section 4.7. This method allows copying existing Email objects
-
from one account to another, with optional mailbox placement and the
-
ability to destroy originals on success (for move operations).
-
-
Cross-account copying maintains email content and properties while
-
assigning new IDs in the target account.
-
-
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.7> RFC 8621, Section 4.7
-
*)
-
module Copy : sig
-
(** Arguments for Email/copy method. *)
-
type args = {
-
from_account_id : id; (** Source account containing emails to copy *)
-
account_id : id; (** Destination account for copied emails *)
-
create : (id * id id_map) id_map; (** Map of creation IDs to (email ID, mailbox set) pairs *)
-
on_success_destroy_original : bool option; (** Whether to destroy originals after successful copy *)
-
destroy_from_if_in_state : string option; (** Only destroy if source account is in this state *)
-
}
-
-
(** Create Email/copy arguments.
-
@param from_account_id Source account ID
-
@param account_id Destination account ID
-
@param create Map of creation IDs to (source email ID, target mailboxes)
-
@param on_success_destroy_original Whether to destroy originals (move operation)
-
@param destroy_from_if_in_state Only destroy if source state matches
-
@return Copy arguments object *)
-
val create_args :
-
from_account_id:id ->
-
account_id:id ->
-
create:(id * id id_map) id_map ->
-
?on_success_destroy_original:bool ->
-
?destroy_from_if_in_state:string ->
-
unit -> args
-
-
(** Complete response for Email/copy method. *)
-
type response = {
-
from_account_id : id; (** Source account ID *)
-
account_id : id; (** Destination account ID *)
-
created : Email.t id_map option; (** Successfully created emails by creation ID *)
-
not_created : Jmap.Error.Set_error.t id_map option; (** Failed copies with error details *)
-
}
-
-
(** Create a copy response object.
-
@param from_account_id Source account ID
-
@param account_id Destination account ID
-
@param created Optional map of successfully copied emails
-
@param not_created Optional map of failed copies with errors
-
@return Copy response object *)
-
val create_response :
-
from_account_id:id ->
-
account_id:id ->
-
?created:Email.t id_map ->
-
?not_created:Jmap.Error.Set_error.t id_map ->
-
unit -> response
-
end
-
-
+87 -62
jmap/jmap-email/vacation.ml
···
(** JMAP Vacation Response Implementation.
This module implements the JMAP VacationResponse singleton data type
-
for managing automatic out-of-office email replies with date ranges,
+
for managing automatic out-of-office email replies with Date.t ranges,
custom messages, and enable/disable functionality.
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-8> RFC 8621, Section 8: VacationResponse
*)
-
open Jmap.Types
open Jmap.Error
open Yojson.Safe.Util
···
(** VacationResponse object *)
type t = {
-
id : id;
+
id : Jmap.Id.t;
is_enabled : bool;
-
from_date : utc_date option;
-
to_date : utc_date option;
+
from_date : Jmap.Date.t option;
+
to_date : Jmap.Date.t option;
subject : string option;
text_body : string option;
html_body : string option;
···
(** Create a minimal VacationResponse object.
VacationResponse always has ID "singleton" per JMAP spec *)
let create ?id () =
-
let actual_id = match id with Some id -> id | None -> Jmap.Types.Constants.vacation_response_id in
+
let actual_id = match id with Some id -> id | None -> "singleton" in
+
let id_result = match Jmap.Id.of_string actual_id with
+
| Ok id -> id
+
| Error e -> failwith ("Invalid vacation response ID: " ^ e) in
{
-
id = actual_id;
+
id = id_result;
is_enabled = false;
from_date = None;
to_date = None;
···
(** Serialize to JSON with only specified properties *)
let to_json_with_properties ~properties t =
let all_fields = [
-
("id", `String t.id);
+
("id", `String (Jmap.Id.to_string t.id));
("isEnabled", `Bool t.is_enabled);
-
("fromDate", match t.from_date with Some date -> `Float date | None -> `Null);
-
("toDate", match t.to_date with Some date -> `Float date | None -> `Null);
+
("fromDate", match t.from_date with Some date -> Jmap.Date.to_json date | None -> `Null);
+
("toDate", match t.to_date with Some date -> Jmap.Date.to_json date | None -> `Null);
("subject", match t.subject with Some subj -> `String subj | None -> `Null);
("textBody", match t.text_body with Some text -> `String text | None -> `Null);
("htmlBody", match t.html_body with Some html -> `String html | None -> `Null);
···
(** Get list of all valid property names *)
let valid_properties () = [
-
"id"; "isEnabled"; "fromDate"; "toDate"; "subject"; "textBody"; "htmlBody"
+
"Id.t"; "isEnabled"; "fromDate"; "toDate"; "subject"; "textBody"; "htmlBody"
] (* TODO: Use Property.to_string_list Property.all_properties when module ordering is fixed *)
(** {1 Property Accessors} *)
···
(* JSON serialization for VacationResponse *)
let to_json t =
let json_fields = [
-
("id", `String t.id);
+
("id", `String (Jmap.Id.to_string t.id));
("isEnabled", `Bool t.is_enabled);
] in
let json_fields = match t.from_date with
| None -> json_fields
-
| Some date -> ("fromDate", `Float date) :: json_fields
+
| Some date -> ("fromDate", `Float (Jmap.Date.to_timestamp date)) :: json_fields
in
let json_fields = match t.to_date with
| None -> json_fields
-
| Some date -> ("toDate", `Float date) :: json_fields
+
| Some date -> ("toDate", `Float (Jmap.Date.to_timestamp date)) :: json_fields
in
let json_fields = match t.subject with
| None -> json_fields
···
let enabled_str = string_of_bool vacation.is_enabled in
let from_date_str = match vacation.from_date with
| None -> "none"
-
| Some date -> Printf.sprintf "%.0f" date
+
| Some date -> Printf.sprintf "%.0f" (Jmap.Date.to_timestamp date)
in
let to_date_str = match vacation.to_date with
| None -> "none"
-
| Some date -> Printf.sprintf "%.0f" date
+
| Some date -> Printf.sprintf "%.0f" (Jmap.Date.to_timestamp date)
in
let subject_str = match vacation.subject with
| None -> "default"
| Some subj -> Printf.sprintf "\"%s\"" (String.sub subj 0 (min 20 (String.length subj)))
in
Format.fprintf ppf "VacationResponse{id=%s; is_enabled=%s; from_date=%s; to_date=%s; subject=%s}"
-
vacation.id
+
(Jmap.Id.to_string vacation.id)
enabled_str
from_date_str
to_date_str
···
let enabled_str = string_of_bool vacation.is_enabled in
let from_date_str = match vacation.from_date with
| None -> "none"
-
| Some date -> Printf.sprintf "%.0f" date
+
| Some date -> Printf.sprintf "%.0f" (Jmap.Date.to_timestamp date)
in
let to_date_str = match vacation.to_date with
| None -> "none"
-
| Some date -> Printf.sprintf "%.0f" date
+
| Some date -> Printf.sprintf "%.0f" (Jmap.Date.to_timestamp date)
in
let subject_str = match vacation.subject with
| None -> "default subject"
···
| Some html -> Printf.sprintf "%d chars" (String.length html)
in
Format.fprintf ppf "VacationResponse {\n id: %s\n is_enabled: %s\n from_date: %s\n to_date: %s\n subject: %s\n text_body: %s\n html_body: %s\n}"
-
vacation.id
+
(Jmap.Id.to_string vacation.id)
enabled_str
from_date_str
to_date_str
···
(* JSON deserialization for VacationResponse *)
let of_json json =
try
-
let id = json |> member "id" |> to_string in
+
let id = match Jmap.Id.of_string (json |> member "id" |> to_string) with
+
| Ok id -> id
+
| Error err -> failwith ("Invalid ID: " ^ err) in
let is_enabled = json |> member "isEnabled" |> to_bool in
let from_date =
match json |> member "fromDate" with
-
| `Float date -> Some date
+
| `Float date -> Some (Jmap.Date.of_timestamp date)
| `String date_str ->
-
(* Parse ISO 8601 date string to Unix timestamp - simplified *)
-
(try Some (float_of_string date_str)
+
(* Parse ISO 8601 Date.t string to Unix timestamp - simplified *)
+
(try Some (Jmap.Date.of_timestamp (float_of_string date_str))
with _ -> None)
| `Null | _ -> None
in
let to_date =
match json |> member "toDate" with
-
| `Float date -> Some date
+
| `Float date -> Some (Jmap.Date.of_timestamp date)
| `String date_str ->
-
(* Parse ISO 8601 date string to Unix timestamp - simplified *)
-
(try Some (float_of_string date_str)
+
(* Parse ISO 8601 Date.t string to Unix timestamp - simplified *)
+
(try Some (Jmap.Date.of_timestamp (float_of_string date_str))
with _ -> None)
| `Null | _ -> None
in
···
module Update = struct
type t = {
is_enabled : bool option;
-
from_date : utc_date option option;
-
to_date : utc_date option option;
+
from_date : Jmap.Date.t option option;
+
to_date : Jmap.Date.t option option;
subject : string option option;
text_body : string option option;
html_body : string option option;
···
let json_fields = match t.from_date with
| None -> json_fields
| Some None -> ("fromDate", `Null) :: json_fields
-
| Some (Some date) -> ("fromDate", `Float date) :: json_fields
+
| Some (Some date) -> ("fromDate", `Float (Jmap.Date.to_timestamp date)) :: json_fields
in
let json_fields = match t.to_date with
| None -> json_fields
| Some None -> ("toDate", `Null) :: json_fields
-
| Some (Some date) -> ("toDate", `Float date) :: json_fields
+
| Some (Some date) -> ("toDate", `Float (Jmap.Date.to_timestamp date)) :: json_fields
in
let json_fields = match t.subject with
| None -> json_fields
···
let from_date =
match json |> member "fromDate" with
| `Null -> Some None
-
| `Float date -> Some (Some date)
-
| `String date_str -> Some (Some (try float_of_string date_str with _ -> 0.0))
+
| `Float date -> Some (Some (Jmap.Date.of_timestamp date))
+
| `String date_str -> Some (Some (try Jmap.Date.of_timestamp (float_of_string date_str) with _ -> Jmap.Date.of_timestamp 0.0))
| _ -> None
in
let to_date =
match json |> member "toDate" with
| `Null -> Some None
-
| `Float date -> Some (Some date)
-
| `String date_str -> Some (Some (try float_of_string date_str with _ -> 0.0))
+
| `Float date -> Some (Some (Jmap.Date.of_timestamp date))
+
| `String date_str -> Some (Some (try Jmap.Date.of_timestamp (float_of_string date_str) with _ -> Jmap.Date.of_timestamp 0.0))
| _ -> None
in
let subject =
···
(** Arguments for VacationResponse/get method *)
module Get_args = struct
type t = {
-
account_id : id;
-
ids : id list option;
+
account_id : Jmap.Id.t;
+
ids : Jmap.Id.t list option;
properties : string list option;
}
···
{ account_id; ids; properties }
let singleton ~account_id ?properties () =
-
{ account_id; ids = Some [Jmap.Types.Constants.vacation_response_id]; properties }
+
{ account_id; ids = Some [Jmap.Id.of_string "singleton" |> Result.get_ok]; properties }
let to_json t =
let json_fields = [
-
("accountId", `String t.account_id);
+
("accountId", `String (Jmap.Id.to_string t.account_id));
] in
let json_fields = match t.ids with
| None -> json_fields
-
| Some ids -> ("ids", `List (List.map (fun id -> `String id) ids)) :: json_fields
+
| Some ids -> ("ids", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) ids)) :: json_fields
in
let json_fields = match t.properties with
| None -> json_fields
···
let of_json json =
try
-
let account_id = json |> member "accountId" |> to_string in
+
let account_id_str = json |> member "accountId" |> to_string in
+
let account_id = match Jmap.Id.of_string account_id_str with
+
| Ok id -> id
+
| Error _ -> failwith ("Invalid accountId: " ^ account_id_str) in
let ids =
match json |> member "ids" with
-
| `List items -> Some (List.map (fun item -> to_string item) items)
+
| `List items ->
+
Some (List.map (fun item ->
+
let id_str = to_string item in
+
match Jmap.Id.of_string id_str with
+
| Ok id -> id
+
| Error _ -> failwith ("Invalid id: " ^ id_str)) items)
| _ -> None
in
let properties =
···
type vacation_response = t
type t = {
-
account_id : id;
+
account_id : Jmap.Id.t;
state : string;
list : vacation_response list;
-
not_found : id list;
+
not_found : Jmap.Id.t list;
}
let account_id t = t.account_id
···
let to_json t =
`Assoc [
-
("accountId", `String t.account_id);
+
("accountId", `String (Jmap.Id.to_string t.account_id));
("state", `String t.state);
("list", `List (List.map (fun item -> (to_json item : Yojson.Safe.t)) t.list));
-
("notFound", `List (List.map (fun id -> `String id) t.not_found));
+
("notFound", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) t.not_found));
]
let of_json json =
try
-
let account_id = json |> member "accountId" |> to_string in
+
let account_id_str = json |> member "accountId" |> to_string in
+
let account_id = match Jmap.Id.of_string account_id_str with
+
| Ok id -> id
+
| Error _ -> failwith ("Invalid accountId: " ^ account_id_str) in
let state = json |> member "state" |> to_string in
let list_json = json |> member "list" |> to_list in
let list =
···
| Error _ -> acc (* Skip invalid items *)
) [] list_json |> List.rev
in
-
let not_found = json |> member "notFound" |> to_list |> List.map to_string in
+
let not_found = json |> member "notFound" |> to_list |> List.filter_map (fun item ->
+
let str = to_string item in
+
match Jmap.Id.of_string str with
+
| Ok id -> Some id
+
| Error _ -> None) in
Ok { account_id; state; list; not_found }
with
| Type_error (msg, _) -> Error ("Invalid VacationResponse/get response JSON: " ^ msg)
···
(** VacationResponse/set: Args type *)
module Set_args = struct
type t = {
-
account_id : id;
+
account_id : Jmap.Id.t;
if_in_state : string option;
-
update : Update.t id_map option;
+
update : (string, Update.t) Hashtbl.t option;
}
let account_id t = t.account_id
···
let singleton ~account_id ?if_in_state ~update () = {
account_id;
if_in_state;
-
update = Some (Hashtbl.create 1 |> fun tbl -> Hashtbl.add tbl Jmap.Types.Constants.vacation_response_id update; tbl);
+
update = Some (Hashtbl.create 1 |> fun tbl -> Hashtbl.add tbl "singleton" update; tbl);
}
let to_json t =
let json_fields = [
-
("accountId", `String t.account_id);
+
("accountId", `String (Jmap.Id.to_string t.account_id));
] in
let json_fields = match t.if_in_state with
| None -> json_fields
···
let of_json json =
try
-
let account_id = json |> member "accountId" |> to_string in
+
let account_id_str = json |> member "accountId" |> to_string in
+
let account_id = match Jmap.Id.of_string account_id_str with
+
| Ok id -> id
+
| Error _ -> failwith ("Invalid accountId: " ^ account_id_str) in
let if_in_state = json |> member "ifInState" |> to_string_option in
let update =
match json |> member "update" with
···
type vacation_response = t
type t = {
-
account_id : id;
+
account_id : Jmap.Id.t;
old_state : string option;
new_state : string;
-
updated : vacation_response option id_map option;
-
not_updated : Set_error.t id_map option;
+
updated : (string, vacation_response option) Hashtbl.t option;
+
not_updated : (string, Set_error.t) Hashtbl.t option;
}
let account_id t = t.account_id
···
match t.updated with
| None -> None
| Some updated_map ->
-
try Hashtbl.find updated_map Jmap.Types.Constants.vacation_response_id
+
try Hashtbl.find updated_map "singleton"
with Not_found -> None
let singleton_error t =
match t.not_updated with
| None -> None
| Some error_map ->
-
try Some (Hashtbl.find error_map Jmap.Types.Constants.vacation_response_id)
+
try Some (Hashtbl.find error_map "singleton")
with Not_found -> None
let v ~account_id ?old_state ~new_state ?updated ?not_updated () = {
···
let to_json t =
let json_fields = [
-
("accountId", `String t.account_id);
+
("accountId", `String (Jmap.Id.to_string t.account_id));
("newState", `String t.new_state);
] in
let json_fields = match t.old_state with
···
let of_json json =
try
-
let account_id = json |> member "accountId" |> to_string in
+
let account_id_str = json |> member "accountId" |> to_string in
+
let account_id = match Jmap.Id.of_string account_id_str with
+
| Ok id -> id
+
| Error _ -> failwith ("Invalid accountId: " ^ account_id_str) in
let old_state = json |> member "oldState" |> to_string_option in
let new_state = json |> member "newState" |> to_string in
let updated =
···
]
let to_string = function
-
| `Id -> "id"
+
| `Id -> "Id.t"
| `IsEnabled -> "isEnabled"
| `FromDate -> "fromDate"
| `ToDate -> "toDate"
···
| `HtmlBody -> "htmlBody"
let of_string = function
-
| "id" -> Some `Id
+
| "Id.t" -> Some `Id
| "isEnabled" -> Some `IsEnabled
| "fromDate" -> Some `FromDate
| "toDate" -> Some `ToDate
+51 -52
jmap/jmap-email/vacation.mli
···
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-8> RFC 8621, Section 8: VacationResponse
*)
-
open Jmap.Types
open Jmap.Error
(** Complete VacationResponse object representation.
···
exactly one VacationResponse per account.
The vacation response can be enabled/disabled and configured with
-
date ranges, custom subject, and message content in both text and HTML.
+
Date.t ranges, custom subject, and message content in both text and HTML.
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-8> RFC 8621, Section 8
*)
···
include Jmap_sigs.PRINTABLE with type t := t
(** JMAP object interface for property-based operations *)
-
include Jmap_sigs.JMAP_OBJECT with type t := t and type id_type := id
+
include Jmap_sigs.JMAP_OBJECT with type t := t and type id_type := string
(** Get the vacation response ID.
@return Always returns "singleton" for VacationResponse objects *)
-
val id : t -> id option
+
val id : t -> Jmap.Id.t option
(** Check if the vacation response is currently enabled.
@return true if auto-replies are active *)
val is_enabled : t -> bool
-
(** Get the start date for the vacation period.
-
@return Optional start date, None means no start constraint *)
-
val from_date : t -> utc_date option
+
(** Get the start Date.t for the vacation period.
+
@return Optional start Date.t, None means no start constraint *)
+
val from_date : t -> Jmap.Date.t option
-
(** Get the end date for the vacation period.
-
@return Optional end date, None means no end constraint *)
-
val to_date : t -> utc_date option
+
(** Get the end Date.t for the vacation period.
+
@return Optional end Date.t, None means no end constraint *)
+
val to_date : t -> Jmap.Date.t option
(** Get the custom subject line for vacation replies.
@return Optional subject override, None uses default subject *)
···
val html_body : t -> string option
(** Create a VacationResponse object.
-
@param id Must be "singleton" for VacationResponse objects
+
@param Jmap.Id.t Must be "singleton" for VacationResponse objects
@param is_enabled Whether vacation replies are active
-
@param from_date Optional start date for vacation period
-
@param to_date Optional end date for vacation period
+
@param from_date Optional start Date.t for vacation period
+
@param to_date Optional end Date.t for vacation period
@param subject Optional custom subject line
@param text_body Optional plain text message content
@param html_body Optional HTML message content
@return New VacationResponse object *)
val v :
-
id:id ->
+
id:Jmap.Id.t ->
is_enabled:bool ->
-
?from_date:utc_date ->
-
?to_date:utc_date ->
+
?from_date:Jmap.Date.t ->
+
?to_date:Jmap.Date.t ->
?subject:string ->
?text_body:string ->
?html_body:string ->
···
@return Optional enabled flag for update *)
val is_enabled : t -> bool option
-
(** Get the start date update.
-
@return Optional start date change *)
-
val from_date : t -> utc_date option option
+
(** Get the start Date.t update.
+
@return Optional start Date.t change *)
+
val from_date : t -> Jmap.Date.t option option
-
(** Get the end date update.
-
@return Optional end date change *)
-
val to_date : t -> utc_date option option
+
(** Get the end Date.t update.
+
@return Optional end Date.t change *)
+
val to_date : t -> Jmap.Date.t option option
(** Get the subject line update.
@return Optional subject change *)
···
(** Create VacationResponse update parameters.
@param is_enabled Optional enabled flag update
-
@param from_date Optional start date update
-
@param to_date Optional end date update
+
@param from_date Optional start Date.t update
+
@param to_date Optional end Date.t update
@param subject Optional subject update
@param text_body Optional text body update
@param html_body Optional HTML body update
@return Update parameters *)
val v :
?is_enabled:bool ->
-
?from_date:utc_date option ->
-
?to_date:utc_date option ->
+
?from_date:Jmap.Date.t option ->
+
?to_date:Jmap.Date.t option ->
?subject:string option ->
?text_body:string option ->
?html_body:string option ->
unit -> t
(** Create an update to enable vacation responses.
-
@param from_date Optional start date for vacation period
-
@param to_date Optional end date for vacation period
+
@param from_date Optional start Date.t for vacation period
+
@param to_date Optional end Date.t for vacation period
@param subject Optional custom subject line
@param text_body Optional text message content
@param html_body Optional HTML message content
@return Update to enable vacation with specified settings *)
val enable :
-
?from_date:utc_date ->
-
?to_date:utc_date ->
+
?from_date:Jmap.Date.t ->
+
?to_date:Jmap.Date.t ->
?subject:string ->
?text_body:string ->
?html_body:string ->
···
(** Get the account ID for the operation.
@return Account identifier where vacation response will be retrieved *)
-
val account_id : t -> id
+
val account_id : t -> Jmap.Id.t
(** Get the specific vacation response IDs to retrieve.
@return List should be ["singleton"] or None for the singleton object *)
-
val ids : t -> id list option
+
val ids : t -> Jmap.Id.t list option
(** Get the properties to include in the response.
@return List of property names, or None for all properties *)
···
@param properties Optional list of properties to retrieve
@return VacationResponse/get arguments *)
val v :
-
account_id:id ->
-
?ids:id list ->
+
account_id:Jmap.Id.t ->
+
?ids:Jmap.Id.t list ->
?properties:string list ->
unit -> t
···
@param properties Optional list of properties to retrieve
@return Arguments configured for singleton retrieval *)
val singleton :
-
account_id:id ->
+
account_id:Jmap.Id.t ->
?properties:string list ->
unit -> t
end
···
(** Get the account ID from the response.
@return Account identifier where vacation response was retrieved *)
-
val account_id : t -> id
+
val account_id : t -> Jmap.Id.t
(** Get the current state string for change tracking.
@return State string for use in VacationResponse/set *)
···
(** Get the list of vacation response IDs that were not found.
@return List of requested IDs that don't exist *)
-
val not_found : t -> id list
+
val not_found : t -> Jmap.Id.t list
(** Create VacationResponse/get response.
@param account_id Account where vacation response was retrieved
···
@param not_found List of requested IDs that were not found
@return VacationResponse/get response *)
val v :
-
account_id:id ->
+
account_id:Jmap.Id.t ->
state:string ->
list:vacation_response list ->
-
not_found:id list ->
+
not_found:Jmap.Id.t list ->
unit -> t
(** Get the singleton vacation response if present.
···
(** Get the account ID for the set operation.
@return Account where vacation response will be updated *)
-
val account_id : t -> id
+
val account_id : t -> Jmap.Id.t
(** Get the conditional state for the update.
@return Optional state string for conditional updates *)
···
(** Get the update operations to perform.
@return Map of "singleton" to update patch object *)
-
val update : t -> Update.t id_map option
+
val update : t -> (string, Update.t) Hashtbl.t option
(** Create VacationResponse/set arguments.
@param account_id Account where vacation response will be updated
···
@param update Map containing "singleton" -> update object
@return VacationResponse/set arguments *)
val v :
-
account_id:id ->
+
account_id:Jmap.Id.t ->
?if_in_state:string ->
-
?update:Update.t id_map ->
+
?update:(string, Update.t) Hashtbl.t ->
unit ->
t
···
@param update Update parameters for the singleton
@return Arguments configured for singleton update *)
val singleton :
-
account_id:id ->
+
account_id:Jmap.Id.t ->
?if_in_state:string ->
update:Update.t ->
unit -> t
···
(** Get the account ID from the response.
@return Account where vacation response was updated *)
-
val account_id : t -> id
+
val account_id : t -> Jmap.Id.t
(** Get the old state string.
@return Previous state if available *)
···
(** Get the successfully updated VacationResponse objects.
@return Map of "singleton" to updated VacationResponse (if successful) *)
-
val updated : t -> vacation_response option id_map option
+
val updated : t -> (string, vacation_response option) Hashtbl.t option
(** Get the vacation responses that failed to update.
@return Map of IDs to error information for failed updates *)
-
val not_updated : t -> Set_error.t id_map option
+
val not_updated : t -> (string, Set_error.t) Hashtbl.t option
(** Create VacationResponse/set response.
@param account_id Account where vacation response was updated
···
@param not_updated Map of failed updates with errors
@return VacationResponse/set response *)
val v :
-
account_id:id ->
+
account_id:Jmap.Id.t ->
?old_state:string ->
new_state:string ->
-
?updated:vacation_response option id_map ->
-
?not_updated:Set_error.t id_map ->
+
?updated:(string, vacation_response option) Hashtbl.t ->
+
?not_updated:(string, Set_error.t) Hashtbl.t ->
unit ->
t
···
type t = [
| `Id (** Server-assigned unique identifier (always "singleton") (immutable, server-set) *)
| `IsEnabled (** Whether vacation response is currently active *)
-
| `FromDate (** Start date for vacation response activation *)
-
| `ToDate (** End date for vacation response activation *)
+
| `FromDate (** Start Date.t for vacation response activation *)
+
| `ToDate (** End Date.t for vacation response activation *)
| `Subject (** Subject line for vacation response messages *)
| `TextBody (** Plain text body for vacation responses *)
| `HtmlBody (** HTML body for vacation responses *)
+11 -11
jmap/jmap-unix/client.mli
···
val get_emails :
t ->
?account_id:string ->
-
Jmap.Types.id list ->
+
string list ->
?properties:Jmap_email.Property.t list ->
unit ->
(Jmap_email.Email.t list, Jmap.Error.error) result
···
t ->
account_id:string ->
raw_message:bytes ->
-
mailbox_ids:Jmap.Types.id list ->
+
mailbox_ids:string list ->
?keywords:string list ->
?received_at:Jmap.Types.date ->
unit ->
···
val destroy_email :
t ->
account_id:string ->
-
email_id:Jmap.Types.id ->
+
email_id:string ->
(unit, Jmap.Error.error) result
(** Set email keywords (flags) - replaces all existing keywords.
···
val set_email_keywords :
t ->
account_id:string ->
-
email_id:Jmap.Types.id ->
+
email_id:string ->
keywords:string list ->
(unit, Jmap.Error.error) result
···
val set_email_mailboxes :
t ->
account_id:string ->
-
email_id:Jmap.Types.id ->
-
mailbox_ids:Jmap.Types.id list ->
+
email_id:string ->
+
mailbox_ids:string list ->
(unit, Jmap.Error.error) result
(** {1 Mailbox Operations} *)
···
t ->
account_id:string ->
name:string ->
-
?parent_id:Jmap.Types.id ->
+
?parent_id:string ->
?role:Jmap_email.Mailbox.Role.t ->
unit ->
-
(Jmap.Types.id, Jmap.Error.error) result
+
(string, Jmap.Error.error) result
(** Destroy mailbox.
···
val destroy_mailbox :
t ->
account_id:string ->
-
mailbox_id:Jmap.Types.id ->
+
mailbox_id:string ->
?on_destroy_remove_emails:bool ->
unit ->
(unit, Jmap.Error.error) result
···
?sort:Jmap_email.Query.Sort.t list ->
?limit:int ->
unit ->
-
Jmap.Types.id list batch_operation
+
string list batch_operation
(** Add email get operation using result reference from query *)
val get_emails_ref :
batch_builder ->
-
Jmap.Types.id list batch_operation ->
+
string list batch_operation ->
?properties:Jmap_email.Property.t list ->
unit ->
Jmap_email.Email.t list batch_operation
+32 -22
jmap/jmap-unix/jmap_unix.ml
···
let all_headers =
let base_headers = [
("Host", host);
-
("User-Agent", Option.value ctx.config.user_agent ~default:Jmap.Types.Constants.User_agent.eio_client);
-
("Accept", Jmap.Types.Constants.Content_type.json);
-
("Content-Type", Jmap.Types.Constants.Content_type.json);
+
("User-Agent", Option.value ctx.config.user_agent ~default:"jmap-eio-client/1.0");
+
("Accept", "application/json");
+
("Content-Type", "application/json");
] in
let auth_hdrs = auth_headers ctx.auth in
List.rev_append auth_hdrs (List.rev_append headers base_headers)
···
| Ok _response_body ->
(* Simple response construction - in a real implementation would parse JSON *)
let response = Jmap.Binary.Upload_response.v
-
~account_id
-
~blob_id:("blob-" ^ account_id ^ "-" ^ string_of_int (Random.int 1000000))
+
~account_string:account_id
+
~blob_string:("blob-" ^ account_id ^ "-" ^ string_of_int (Random.int 1000000))
~type_:content_type
~size:1000
()
···
let copied = Hashtbl.create (List.length blob_ids) in
List.iter (fun id -> Hashtbl.add copied id id) blob_ids;
let copy_response = Jmap.Binary.Blob_copy_response.v
-
~from_account_id
-
~account_id
+
~from_account_string:from_account_id
+
~account_string:account_id
~copied
()
in
Ok copy_response
| Error e -> Error e)
-
let connect_event_source env ctx ?(types=[]) ?(close_after=`No) ?(ping=30) () =
+
let connect_event_source env ctx ?(types=[]) ?(close_after=`No) ?(ping=(match Jmap.UInt.of_int 30 with Ok v -> v | Error _ -> failwith "Invalid default ping")) () =
let _ = ignore env in
let _ = ignore ctx in
let _ = ignore types in
···
(* Bridge to jmap-email query functionality *)
module Query_args = struct
type t = {
-
account_id : Jmap.Types.id;
+
account_id : string;
filter : Jmap.Methods.Filter.t option;
sort : Jmap.Methods.Comparator.t list option;
position : int option;
-
limit : Jmap.Types.uint option;
+
limit : Jmap.UInt.t option;
calculate_total : bool option;
collapse_threads : bool option;
}
···
| None -> args
in
let args = match t.limit with
-
| Some lim -> ("limit", `Int lim) :: args
+
| Some lim -> ("limit", `Int (Jmap.UInt.to_int lim)) :: args
| None -> args
in
let args = match t.calculate_total with
···
module Get_args = struct
type ids_source =
-
| Specific_ids of Jmap.Types.id list
+
| Specific_ids of string list
| Result_reference of {
result_of : string;
name : string;
···
}
type t = {
-
account_id : Jmap.Types.id;
+
account_id : string;
ids_source : ids_source;
properties : string list option;
}
···
| None -> `Bool false);
]) s)
| None -> `Null);
-
("limit", match limit with Some l -> `Int l | None -> `Null);
+
("limit", match limit with Some l -> `Int (Jmap.UInt.to_int l) | None -> `Null);
("position", match position with Some p -> `Int p | None -> `Null);
] in
let builder = build ctx
···
| Error e -> Error e
let move_emails env ctx ~account_id ~email_ids ~mailbox_id ?remove_from_mailboxes () =
+
(* Convert string IDs to Jmap.Id.t *)
+
let mailbox_id_t = match Jmap.Id.of_string mailbox_id with Ok id -> id | Error _ -> failwith ("Invalid mailbox_id: " ^ mailbox_id) in
+
let remove_from_mailboxes_t = match remove_from_mailboxes with
+
| Some mailbox_ids -> Some (List.map (fun id_str -> match Jmap.Id.of_string id_str with Ok id -> id | Error _ -> failwith ("Invalid remove_from_mailboxes id: " ^ id_str)) mailbox_ids)
+
| None -> None
+
in
(* Create Email/set request with mailbox patches *)
-
let patch = match remove_from_mailboxes with
+
let patch = match remove_from_mailboxes_t with
| Some mailbox_ids_to_remove ->
(* Move to new mailbox and remove from specified ones *)
JmapEmail.Email.Patch.create
-
~add_mailboxes:[mailbox_id]
+
~add_mailboxes:[mailbox_id_t]
~remove_mailboxes:mailbox_ids_to_remove
()
| None ->
(* Move to single mailbox (replace all existing) *)
-
JmapEmail.Email.Patch.move_to_mailboxes [mailbox_id]
+
JmapEmail.Email.Patch.move_to_mailboxes [mailbox_id_t]
in
let updates = List.fold_left (fun acc email_id ->
(email_id, patch) :: acc
···
| Error e -> Error e
let import_email env ctx ~account_id ~rfc822 ~mailbox_ids ?keywords ?received_at () =
-
let _ = ignore rfc822 in
+
let _rfc822_content = (rfc822 : string) in
let blob_id = "blob-" ^ account_id ^ "-" ^ string_of_int (Random.int 1000000) in
(* Note: Email/import uses different argument structure, keeping manual for now *)
let args = `Assoc [
···
("blobIds", `List [`String blob_id]);
("mailboxIds", `Assoc (List.map (fun id -> (id, `String id)) mailbox_ids));
("keywords", match keywords with
-
| Some _kws -> `Assoc [] (* Simplified for now *)
+
| Some kws -> Jmap_email.Keywords.to_json kws
| None -> `Null);
("receivedAt", match received_at with
-
| Some d -> `Float d
+
| Some d -> `Float (Jmap.Date.to_timestamp d)
| None -> `Null);
] in
let builder = build ctx
···
| None -> args
in
let args = match limit with
-
| Some l -> ("limit", `Int l) :: args
+
| Some l -> ("limit", `Int (Jmap.UInt.to_int l)) :: args
| None -> args
in
let args = match position with
···
end
let email_query ?account_id ?filter ?sort ?limit ?position builder =
-
let args = EmailQuery.build_args ?account_id ?filter ?sort ?limit ?position () in
+
let limit_uint = match limit with
+
| Some i -> Some (match Jmap.UInt.of_int i with Ok u -> u | Error _ -> failwith ("Invalid limit: " ^ string_of_int i))
+
| None -> None
+
in
+
let args = EmailQuery.build_args ?account_id ?filter ?sort ?limit:limit_uint ?position () in
let call_id = "email-query-" ^ string_of_int (Random.int 10000) in
{ builder with methods = (Jmap.Method_names.method_to_string `Email_query, args, call_id) :: builder.methods }
+54 -54
jmap/jmap-unix/jmap_unix.mli
···
val upload :
< net : 'a Eio.Net.t ; .. > ->
context ->
-
account_id:Jmap.Types.id ->
+
account_id:string ->
content_type:string ->
data_stream:string Seq.t ->
Jmap.Binary.Upload_response.t Jmap.Error.result
···
val download :
< net : 'a Eio.Net.t ; .. > ->
context ->
-
account_id:Jmap.Types.id ->
-
blob_id:Jmap.Types.id ->
+
account_id:string ->
+
blob_id:string ->
?content_type:string ->
?name:string ->
unit ->
···
val copy_blobs :
< net : 'a Eio.Net.t ; .. > ->
context ->
-
from_account_id:Jmap.Types.id ->
-
account_id:Jmap.Types.id ->
-
blob_ids:Jmap.Types.id list ->
+
from_account_id:string ->
+
account_id:string ->
+
blob_ids:string list ->
Jmap.Binary.Blob_copy_response.t Jmap.Error.result
(** Connect to the EventSource for push notifications.
···
context ->
?types:string list ->
?close_after:[`State | `No] ->
-
?ping:Jmap.Types.uint ->
+
?ping:Jmap.UInt.t ->
unit ->
(event_source_connection *
([`State of Jmap.Push.State_change.t | `Ping of Jmap.Push.Event_source_ping_data.t ] Seq.t)) Jmap.Error.result
···
< net : 'a Eio.Net.t ; .. > ->
context ->
method_name:Jmap.Method_names.jmap_method ->
-
account_id:Jmap.Types.id ->
-
object_id:Jmap.Types.id ->
+
account_id:string ->
+
object_id:string ->
?properties:string list ->
unit ->
Yojson.Safe.t Jmap.Error.result
···
val add_get_with_reference :
t ->
method_name:Jmap.Method_names.jmap_method ->
-
account_id:Jmap.Types.id ->
+
account_id:string ->
result_reference:Jmap.Wire.Result_reference.t ->
?properties:string list ->
method_call_id:string ->
···
@param ?collapse_threads Whether to collapse threads (None = false)
@return Email query arguments object *)
val create :
-
account_id:Jmap.Types.id ->
+
account_id:string ->
?filter:Jmap.Methods.Filter.t ->
?sort:Jmap.Methods.Comparator.t list ->
?position:int ->
-
?limit:Jmap.Types.uint ->
+
?limit:Jmap.UInt.t ->
?calculate_total:bool ->
?collapse_threads:bool ->
unit ->
···
@param ?properties Optional list of properties to return (None = all properties)
@return Email get arguments object *)
val create :
-
account_id:Jmap.Types.id ->
-
ids:Jmap.Types.id list ->
+
account_id:string ->
+
ids:string list ->
?properties:string list ->
unit ->
t
···
@param ?properties Optional list of properties to return (None = all properties)
@return Email get arguments object *)
val create_with_reference :
-
account_id:Jmap.Types.id ->
+
account_id:string ->
result_of:string ->
name:string ->
path:string ->
···
val get_email :
< net : 'a Eio.Net.t ; .. > ->
context ->
-
account_id:Jmap.Types.id ->
-
email_id:Jmap.Types.id ->
+
account_id:string ->
+
email_id:string ->
?properties:string list ->
unit ->
Jmap_email.Email.t Jmap.Error.result
···
val search_emails :
< net : 'a Eio.Net.t ; .. > ->
context ->
-
account_id:Jmap.Types.id ->
+
account_id:string ->
filter:Jmap.Methods.Filter.t ->
?sort:Jmap.Methods.Comparator.t list ->
-
?limit:Jmap.Types.uint ->
+
?limit:Jmap.UInt.t ->
?position:int ->
?properties:string list ->
unit ->
-
(Jmap.Types.id list * Jmap_email.Email.t list option) Jmap.Error.result
+
(string list * Jmap_email.Email.t list option) Jmap.Error.result
(** Mark multiple emails with a keyword
@param env The Eio environment for network operations
···
val mark_emails :
< net : 'a Eio.Net.t ; .. > ->
context ->
-
account_id:Jmap.Types.id ->
-
email_ids:Jmap.Types.id list ->
+
account_id:string ->
+
email_ids:string list ->
keyword:Jmap_email.Keywords.keyword ->
unit ->
unit Jmap.Error.result
···
val mark_as_seen :
< net : 'a Eio.Net.t ; .. > ->
context ->
-
account_id:Jmap.Types.id ->
-
email_ids:Jmap.Types.id list ->
+
account_id:string ->
+
email_ids:string list ->
unit ->
unit Jmap.Error.result
···
val mark_as_unseen :
< net : 'a Eio.Net.t ; .. > ->
context ->
-
account_id:Jmap.Types.id ->
-
email_ids:Jmap.Types.id list ->
+
account_id:string ->
+
email_ids:string list ->
unit ->
unit Jmap.Error.result
···
val move_emails :
< net : 'a Eio.Net.t ; .. > ->
context ->
-
account_id:Jmap.Types.id ->
-
email_ids:Jmap.Types.id list ->
-
mailbox_id:Jmap.Types.id ->
-
?remove_from_mailboxes:Jmap.Types.id list ->
+
account_id:string ->
+
email_ids:string list ->
+
mailbox_id:string ->
+
?remove_from_mailboxes:string list ->
unit ->
unit Jmap.Error.result
···
val import_email :
< net : 'a Eio.Net.t ; .. > ->
context ->
-
account_id:Jmap.Types.id ->
+
account_id:string ->
rfc822:string ->
-
mailbox_ids:Jmap.Types.id list ->
+
mailbox_ids:string list ->
?keywords:Jmap_email.Keywords.t ->
-
?received_at:Jmap.Types.date ->
+
?received_at:Jmap.Date.t ->
unit ->
-
Jmap.Types.id Jmap.Error.result
+
string Jmap.Error.result
(** {2 JSON Parsing Functions} *)
···
Falls back to the first available account if no primary mail account is found.
@param session The JMAP session
@return The account ID to use for mail operations *)
-
val get_primary_mail_account : Jmap.Session.Session.t -> Jmap.Types.id
+
val get_primary_mail_account : Jmap.Session.Session.t -> string
end
(** Response utilities for extracting data from JMAP responses *)
···
(** Add Email/query method *)
val email_query :
-
?account_id:Jmap.Types.id ->
+
?account_id:string ->
?filter:Yojson.Safe.t ->
?sort:Jmap.Methods.Comparator.t list ->
?limit:int ->
···
(** Add Email/get method with automatic result reference *)
val email_get :
-
?account_id:Jmap.Types.id ->
-
?ids:Jmap.Types.Id.t list ->
+
?account_id:string ->
+
?ids:Jmap.Id.t list ->
?properties:string list ->
?reference_from:string -> (* Call ID to reference *)
t -> t
(** Add Email/set method *)
val email_set :
-
?account_id:Jmap.Types.id ->
+
?account_id:string ->
?create:(string * Yojson.Safe.t) list ->
-
?update:(Jmap.Types.Id.t * Jmap.Types.Patch.t) list ->
-
?destroy:Jmap.Types.Id.t list ->
+
?update:(Jmap.Id.t * Jmap.Patch.t) list ->
+
?destroy:Jmap.Id.t list ->
t -> t
(** Add Thread/get method *)
val thread_get :
-
?account_id:Jmap.Types.id ->
-
?ids:Jmap.Types.Id.t list ->
+
?account_id:string ->
+
?ids:Jmap.Id.t list ->
t -> t
(** Add Mailbox/query method *)
val mailbox_query :
-
?account_id:Jmap.Types.id ->
+
?account_id:string ->
?filter:Yojson.Safe.t ->
?sort:Jmap.Methods.Comparator.t list ->
t -> t
(** Add Mailbox/get method *)
val mailbox_get :
-
?account_id:Jmap.Types.id ->
-
?ids:Jmap.Types.Id.t list ->
+
?account_id:string ->
+
?ids:Jmap.Id.t list ->
t -> t
(** Execute the built request *)
···
< net : 'a Eio.Net.t ; .. > ->
ctx:context ->
session:Jmap.Session.Session.t ->
-
?account_id:Jmap.Types.id ->
+
?account_id:string ->
?filter:Yojson.Safe.t ->
?sort:Jmap.Methods.Comparator.t list ->
?limit:int ->
···
< net : 'a Eio.Net.t ; .. > ->
ctx:context ->
session:Jmap.Session.Session.t ->
-
?account_id:Jmap.Types.id ->
+
?account_id:string ->
?properties:string list ->
-
Jmap.Types.Id.t list ->
+
Jmap.Id.t list ->
(Yojson.Safe.t list, Jmap.Error.error) result
(** Get all mailboxes *)
···
< net : 'a Eio.Net.t ; .. > ->
ctx:context ->
session:Jmap.Session.Session.t ->
-
?account_id:Jmap.Types.id ->
+
?account_id:string ->
unit ->
(Yojson.Safe.t list, Jmap.Error.error) result
···
< net : 'a Eio.Net.t ; .. > ->
ctx:context ->
session:Jmap.Session.Session.t ->
-
?account_id:Jmap.Types.id ->
+
?account_id:string ->
string ->
(Yojson.Safe.t option, Jmap.Error.error) result
end
···
< net : 'a Eio.Net.t ; .. > ->
ctx:context ->
session:Jmap.Session.Session.t ->
-
?account_id:Jmap.Types.id ->
+
?account_id:string ->
Yojson.Safe.t ->
(Yojson.Safe.t, Jmap.Error.error) result
···
< net : 'a Eio.Net.t ; .. > ->
ctx:context ->
session:Jmap.Session.Session.t ->
-
email_ids:Jmap.Types.Id.t list ->
+
email_ids:Jmap.Id.t list ->
(Yojson.Safe.t, Jmap.Error.error) result
(** Bulk delete spam/trash emails older than N days *)
···
< net : 'a Eio.Net.t ; .. > ->
ctx:context ->
session:Jmap.Session.Session.t ->
-
?account_id:Jmap.Types.id ->
+
?account_id:string ->
progress_fn:(progress -> unit) ->
Yojson.Safe.t ->
(Yojson.Safe.t, Jmap.Error.error) result
+122
jmap/jmap/date.ml
···
+
(** JMAP Date Implementation *)
+
+
type t = float (* Unix timestamp *)
+
+
(* Basic RFC 3339 parsing - simplified for JMAP usage *)
+
let parse_rfc3339 str =
+
try
+
(* Use Unix.strptime if available, otherwise simplified parsing *)
+
let len = String.length str in
+
if len < 19 then failwith "Too short for RFC 3339";
+
+
(* Extract year, month, day, hour, minute, second *)
+
let year = int_of_string (String.sub str 0 4) in
+
let month = int_of_string (String.sub str 5 2) in
+
let day = int_of_string (String.sub str 8 2) in
+
let hour = int_of_string (String.sub str 11 2) in
+
let minute = int_of_string (String.sub str 14 2) in
+
let second = int_of_string (String.sub str 17 2) in
+
+
(* Basic validation *)
+
if year < 1970 || year > 9999 then failwith "Invalid year";
+
if month < 1 || month > 12 then failwith "Invalid month";
+
if day < 1 || day > 31 then failwith "Invalid day";
+
if hour < 0 || hour > 23 then failwith "Invalid hour";
+
if minute < 0 || minute > 59 then failwith "Invalid minute";
+
if second < 0 || second > 59 then failwith "Invalid second";
+
+
(* Convert to Unix timestamp using built-in functions *)
+
let tm = {
+
Unix.tm_year = year - 1900;
+
tm_mon = month - 1;
+
tm_mday = day;
+
tm_hour = hour;
+
tm_min = minute;
+
tm_sec = second;
+
tm_wday = 0;
+
tm_yday = 0;
+
tm_isdst = false;
+
} in
+
+
(* Handle timezone - simplified to assume UTC for 'Z' suffix *)
+
let timestamp =
+
if len >= 20 && str.[len-1] = 'Z' then
+
(* UTC time - convert to UTC timestamp *)
+
let local_time = fst (Unix.mktime tm) in
+
let gm_tm = Unix.gmtime local_time in
+
let utc_time = fst (Unix.mktime gm_tm) in
+
utc_time
+
else if len >= 25 && (str.[len-6] = '+' || str.[len-6] = '-') then
+
(* Timezone offset specified *)
+
let sign = if str.[len-6] = '+' then -1.0 else 1.0 in
+
let tz_hours = int_of_string (String.sub str (len-5) 2) in
+
let tz_minutes = int_of_string (String.sub str (len-2) 2) in
+
let offset = sign *. (float_of_int tz_hours *. 3600.0 +. float_of_int tz_minutes *. 60.0) in
+
fst (Unix.mktime tm) +. offset
+
else
+
(* No timezone - assume local time *)
+
fst (Unix.mktime tm)
+
in
+
Ok timestamp
+
with
+
| Failure msg -> Error ("Invalid RFC 3339 format: " ^ msg)
+
| Invalid_argument _ -> Error "Invalid RFC 3339 format: parsing error"
+
| _ -> Error "Invalid RFC 3339 format"
+
+
let format_rfc3339 timestamp =
+
let tm = Unix.gmtime timestamp in
+
Printf.sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ"
+
(tm.tm_year + 1900)
+
(tm.tm_mon + 1)
+
tm.tm_mday
+
tm.tm_hour
+
tm.tm_min
+
tm.tm_sec
+
+
let of_timestamp timestamp = timestamp
+
+
let to_timestamp date = date
+
+
let of_rfc3339 str = parse_rfc3339 str
+
+
let to_rfc3339 date = format_rfc3339 date
+
+
let now () = Unix.time ()
+
+
let validate date =
+
if date >= 0.0 && date <= 253402300799.0 (* 9999-12-31T23:59:59Z *) then
+
Ok ()
+
else
+
Error "Date timestamp out of valid range"
+
+
let equal date1 date2 =
+
(* Equal within 1 second precision *)
+
abs_float (date1 -. date2) < 1.0
+
+
let compare date1 date2 =
+
if date1 < date2 then -1
+
else if date1 > date2 then 1
+
else 0
+
+
let is_before date1 date2 = date1 < date2
+
+
let is_after date1 date2 = date1 > date2
+
+
let pp ppf date = Format.fprintf ppf "%s" (to_rfc3339 date)
+
+
let pp_hum ppf date = Format.fprintf ppf "Date(%s)" (to_rfc3339 date)
+
+
let pp_debug ppf date =
+
Format.fprintf ppf "Date(%s)" (to_rfc3339 date)
+
+
let to_string_debug date =
+
Printf.sprintf "Date(%s)" (to_rfc3339 date)
+
+
(* JSON serialization *)
+
let to_json date = `String (to_rfc3339 date)
+
+
let of_json = function
+
| `String str -> of_rfc3339 str
+
| json ->
+
let json_str = Yojson.Safe.to_string json in
+
Error (Printf.sprintf "Expected JSON string for Date, got: %s" json_str)
+98
jmap/jmap/date.mli
···
+
(** JMAP Date data type with RFC 3339 support and JSON serialization.
+
+
The Date data type is a string in RFC 3339 "date-time" format, optionally
+
with timezone information. For example: "2014-10-30T14:12:00+08:00" or
+
"2014-10-30T06:12:00Z".
+
+
In this OCaml implementation, dates are internally represented as Unix
+
timestamps (float) for efficient computation, with conversion to/from
+
RFC 3339 string format handled by the serialization functions.
+
+
{b Note}: When represented as a float, precision may be lost for sub-second
+
values. The implementation preserves second-level precision.
+
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.4> RFC 8620, Section 1.4
+
@see <https://www.rfc-editor.org/rfc/rfc3339.html> RFC 3339 *)
+
+
(** Abstract type representing a JMAP Date. *)
+
type t
+
+
(** JSON serialization interface *)
+
include Jmap_sigs.JSONABLE with type t := t
+
+
(** Pretty-printing interface *)
+
include Jmap_sigs.PRINTABLE with type t := t
+
+
(** {2 Construction and Access} *)
+
+
(** Create a Date from a Unix timestamp.
+
@param timestamp The Unix timestamp (seconds since epoch).
+
@return A Date representing the timestamp. *)
+
val of_timestamp : float -> t
+
+
(** Convert a Date to a Unix timestamp.
+
@param date The Date to convert.
+
@return The Unix timestamp (seconds since epoch). *)
+
val to_timestamp : t -> float
+
+
(** Create a Date from an RFC 3339 string.
+
@param str The RFC 3339 formatted string.
+
@return Ok with the parsed Date, or Error if the string is not valid RFC 3339. *)
+
val of_rfc3339 : string -> (t, string) result
+
+
(** Convert a Date to an RFC 3339 string.
+
@param date The Date to convert.
+
@return The RFC 3339 formatted string. *)
+
val to_rfc3339 : t -> string
+
+
(** Create a Date representing the current time.
+
@return A Date set to the current time. *)
+
val now : unit -> t
+
+
(** {2 Validation} *)
+
+
(** Validate a Date according to JMAP constraints.
+
@param date The Date to validate.
+
@return Ok () if valid, Error with description if invalid. *)
+
val validate : t -> (unit, string) result
+
+
(** {2 Comparison and Utilities} *)
+
+
(** Compare two Dates for equality.
+
@param date1 First Date.
+
@param date2 Second Date.
+
@return True if equal (within 1 second precision), false otherwise. *)
+
val equal : t -> t -> bool
+
+
(** Compare two Dates chronologically.
+
@param date1 First Date.
+
@param date2 Second Date.
+
@return Negative if date1 < date2, zero if equal, positive if date1 > date2. *)
+
val compare : t -> t -> int
+
+
(** Check if first Date is before second Date.
+
@param date1 First Date.
+
@param date2 Second Date.
+
@return True if date1 is before date2. *)
+
val is_before : t -> t -> bool
+
+
(** Check if first Date is after second Date.
+
@param date1 First Date.
+
@param date2 Second Date.
+
@return True if date1 is after date2. *)
+
val is_after : t -> t -> bool
+
+
(** Pretty-print a Date in RFC3339 format.
+
@param ppf The formatter.
+
@param date The Date to print. *)
+
val pp : Format.formatter -> t -> unit
+
+
(** Pretty-print a Date for debugging.
+
@param ppf The formatter.
+
@param date The Date to format. *)
+
val pp_debug : Format.formatter -> t -> unit
+
+
(** Convert a Date to a human-readable string for debugging.
+
@param date The Date to format.
+
@return A debug string representation. *)
+
val to_string_debug : t -> string
+4 -1
jmap/jmap/dune
···
(libraries yojson uri unix base64 jmap-sigs)
(modules
jmap
-
types
+
id
+
date
+
uint
+
patch
wire
session
error
+7 -7
jmap/jmap/error.ml
···
-
open Types
+
(* Use underlying types directly to avoid circular dependency with Jmap module *)
open Yojson.Safe.Util
type method_error_type = [
···
| `Network_error of network_error_kind * string * bool (** kind * message * retryable *)
| `Parse_error of parse_error_kind * string (** kind * context *)
| `Method_error of string * string * method_error_type * string option (** method_name * call_id * type * description *)
-
| `Set_error of string * id * set_error_type * string option (** method_name * object_id * type * description *)
+
| `Set_error of string * string * set_error_type * string option (** method_name * object_id * type * description *)
| `Auth_error of auth_error_kind * string (** kind * message *)
| `Server_error of server_error_kind * string (** kind * message *)
| `Timeout_error of timeout_context * string (** context * message *)
···
status : int option;
detail : string option;
limit : string option;
-
other_fields : Yojson.Safe.t string_map;
+
other_fields : (string, Yojson.Safe.t) Hashtbl.t;
}
let problem_type t = t.problem_type
···
type_ : set_error_type;
description : string option;
properties : string list option;
-
existing_id : id option;
-
max_recipients : uint option;
+
existing_id : string option;
+
max_recipients : int option;
invalid_recipients : string list option;
-
max_size : uint option;
-
not_found_blob_ids : id list option;
+
max_size : int option;
+
not_found_blob_ids : string list option;
}
let type_ t = t.type_
+14 -14
jmap/jmap/error.mli
···
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.6> RFC 8620, Section 3.6 *)
-
open Types
+
(* Use underlying types directly to avoid circular dependency with Jmap module *)
(** {1 Method-Level Error Types} *)
···
| `Network_error of network_error_kind * string * bool (** kind * message * retryable *)
| `Parse_error of parse_error_kind * string (** kind * context *)
| `Method_error of string * string * method_error_type * string option (** method_name * call_id * type * description *)
-
| `Set_error of string * id * set_error_type * string option (** method_name * object_id * type * description *)
+
| `Set_error of string * string * set_error_type * string option (** method_name * object_id * type * description *)
| `Auth_error of auth_error_kind * string (** kind * message *)
| `Server_error of server_error_kind * string (** kind * message *)
| `Timeout_error of timeout_context * string (** context * message *)
···
val status : t -> int option
val detail : t -> string option
val limit : t -> string option
-
val other_fields : t -> Yojson.Safe.t string_map
+
val other_fields : t -> (string, Yojson.Safe.t) Hashtbl.t
val v :
?status:int ->
?detail:string ->
?limit:string ->
-
?other_fields:Yojson.Safe.t string_map ->
+
?other_fields:(string, Yojson.Safe.t) Hashtbl.t ->
string ->
t
end
···
val type_ : t -> set_error_type
val description : t -> string option
val properties : t -> string list option
-
val existing_id : t -> id option
-
val max_recipients : t -> uint option
+
val existing_id : t -> string option
+
val max_recipients : t -> int option
val invalid_recipients : t -> string list option
-
val max_size : t -> uint option
-
val not_found_blob_ids : t -> id list option
+
val max_size : t -> int option
+
val not_found_blob_ids : t -> string list option
val v :
?description:string ->
?properties:string list ->
-
?existing_id:id ->
-
?max_recipients:uint ->
+
?existing_id:string ->
+
?max_recipients:int ->
?invalid_recipients:string list ->
-
?max_size:uint ->
-
?not_found_blob_ids:id list ->
+
?max_size:int ->
+
?not_found_blob_ids:string list ->
set_error_type ->
t
···
val method_error : ?description:string -> method_error_type -> error
(** Create a SetItem error *)
-
val set_item_error : id -> ?description:string -> set_error_type -> error
+
val set_item_error : string -> ?description:string -> set_error_type -> error
(** Create an auth error *)
val auth_error : string -> error
···
val of_method_error : Method_error.t -> error
(** Convert a Set_error.t to error for a specific ID *)
-
val of_set_error : id -> Set_error.t -> error
+
val of_set_error : string -> Set_error.t -> error
(** Create a parse error (alias) *)
val parse : string -> error
+55
jmap/jmap/id.ml
···
+
(** JMAP Id Implementation *)
+
+
type t = string
+
type id = t
+
+
let is_base64url_char c =
+
(c >= 'A' && c <= 'Z') ||
+
(c >= 'a' && c <= 'z') ||
+
(c >= '0' && c <= '9') ||
+
c = '-' || c = '_'
+
+
let is_valid_string str =
+
let len = String.length str in
+
len > 0 && len <= 255 &&
+
let rec check i =
+
if i >= len then true
+
else if is_base64url_char str.[i] then check (i + 1)
+
else false
+
in
+
check 0
+
+
let of_string str =
+
if is_valid_string str then Ok str
+
else
+
let len = String.length str in
+
if len = 0 then Error "Id cannot be empty"
+
else if len > 255 then Error "Id cannot be longer than 255 octets"
+
else Error "Id contains invalid characters (must be base64url alphabet only)"
+
+
let to_string id = id
+
+
let pp ppf id = Format.fprintf ppf "%s" id
+
+
let pp_hum ppf id = Format.fprintf ppf "Id(%s)" id
+
+
let validate id =
+
if is_valid_string id then Ok ()
+
else Error "Invalid Id format"
+
+
let equal = String.equal
+
+
let compare = String.compare
+
+
let pp_debug ppf id = Format.fprintf ppf "Id(%s)" id
+
+
let to_string_debug id = Printf.sprintf "Id(%s)" id
+
+
(* JSON serialization *)
+
let to_json id = `String id
+
+
let of_json = function
+
| `String str -> of_string str
+
| json ->
+
let json_str = Yojson.Safe.to_string json in
+
Error (Printf.sprintf "Expected JSON string for Id, got: %s" json_str)
+75
jmap/jmap/id.mli
···
+
(** JMAP Id data type with validation and JSON serialization.
+
+
The Id data type is a string of 1 to 255 octets in length and MUST consist
+
only of characters from the base64url alphabet, as defined in Section 5 of
+
RFC 4648. This includes ASCII alphanumeric characters, plus the characters
+
'-' and '_'.
+
+
Ids are used to identify JMAP objects within an account. They are assigned
+
by the server and are immutable once assigned. The same id MUST refer to
+
the same object throughout the lifetime of the object.
+
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.2> RFC 8620, Section 1.2 *)
+
+
(** Abstract type representing a JMAP Id. *)
+
type t
+
type id = t
+
+
(** JSON serialization interface *)
+
include Jmap_sigs.JSONABLE with type t := t
+
+
(** Pretty-printing interface *)
+
include Jmap_sigs.PRINTABLE with type t := t
+
+
(** {2 Construction and Access} *)
+
+
(** Create a new Id from a string.
+
@param str The string representation.
+
@return Ok with the created Id, or Error if the string violates Id constraints. *)
+
val of_string : string -> (t, string) result
+
+
(** Convert an Id to its string representation.
+
@param id The Id to convert.
+
@return The string representation. *)
+
val to_string : t -> string
+
+
(** Pretty-print an Id.
+
@param ppf The formatter.
+
@param id The Id to print. *)
+
val pp : Format.formatter -> t -> unit
+
+
(** {2 Validation} *)
+
+
(** Check if a string is a valid JMAP Id.
+
@param str The string to validate.
+
@return True if the string meets Id requirements, false otherwise. *)
+
val is_valid_string : string -> bool
+
+
(** Validate an Id according to JMAP constraints.
+
@param id The Id to validate.
+
@return Ok () if valid, Error with description if invalid. *)
+
val validate : t -> (unit, string) result
+
+
(** {2 Comparison and Utilities} *)
+
+
(** Compare two Ids for equality.
+
@param id1 First Id.
+
@param id2 Second Id.
+
@return True if equal, false otherwise. *)
+
val equal : t -> t -> bool
+
+
(** Compare two Ids lexicographically.
+
@param id1 First Id.
+
@param id2 Second Id.
+
@return Negative if id1 < id2, zero if equal, positive if id1 > id2. *)
+
val compare : t -> t -> int
+
+
(** Pretty-print an Id for debugging.
+
@param ppf The formatter.
+
@param id The Id to format. *)
+
val pp_debug : Format.formatter -> t -> unit
+
+
(** Convert an Id to a human-readable string for debugging.
+
@param id The Id to format.
+
@return A debug string representation. *)
+
val to_string_debug : t -> string
+5 -7
jmap/jmap/jmap.ml
···
-
module Types = Types
-
-
(* Backwards compatibility aliases *)
-
module Id = Types.Id
-
module Date = Types.Date
-
module UInt = Types.UInt
-
module Patch = Types.Patch
+
(* Core type modules *)
+
module Id = Id
+
module Date = Date
+
module UInt = Uint
+
module Patch = Patch
module Capability = Jmap_capability
+10 -19
jmap/jmap/jmap.mli
···
(** {1 Core Types and Methods} *)
-
(** JMAP core types with unified interface
-
-
This module consolidates all fundamental JMAP data types including Id, Date,
-
UInt, Patch, and collection types. It provides both modern structured modules
-
and legacy type aliases for compatibility.
-
-
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1> RFC 8620, Section 1 *)
-
module Types = Types
+
(** {2 Core Type Modules} *)
-
(** {2 Backwards Compatibility Aliases} *)
-
-
(** JMAP Id data type (alias to Types.Id)
+
(** JMAP Id data type with validation and JSON serialization
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.2> RFC 8620, Section 1.2 *)
-
module Id = Types.Id
+
module Id = Id
-
(** JMAP Date data type (alias to Types.Date)
+
(** JMAP Date data type with RFC 3339 support and JSON serialization
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.4> RFC 8620, Section 1.4 *)
-
module Date = Types.Date
+
module Date = Date
-
(** JMAP UnsignedInt data type (alias to Types.UInt)
+
(** JMAP UnsignedInt data type with range validation and JSON serialization
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.3> RFC 8620, Section 1.3 *)
-
module UInt = Types.UInt
+
module UInt = Uint
-
(** JMAP Patch Object (alias to Types.Patch)
+
(** JMAP Patch Object for property updates with JSON serialization
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.3> RFC 8620, Section 5.3 *)
-
module Patch = Types.Patch
+
module Patch = Patch
(** JMAP Capability management (alias to Jmap_capability)
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-2> RFC 8620, Section 2 *)
···
{[
(* OCaml 5.1 required for Eio *)
open Jmap
-
open Jmap.Types
+
open Jmap.Id
open Jmap.Wire
open Jmap.Methods
+24 -24
jmap/jmap/jmap_binary.ml
···
-
open Types
+
(* Use underlying types directly to avostring circular dependency with Jmap module *)
module Upload_response = struct
type t = {
-
account_id : id;
-
blob_id : id;
+
account_string : string;
+
blob_string : string;
type_ : string;
-
size : uint;
+
size : int;
}
-
let account_id t = t.account_id
-
let blob_id t = t.blob_id
+
let account_string t = t.account_string
+
let blob_string t = t.blob_string
let type_ t = t.type_
let size t = t.size
-
let v ~account_id ~blob_id ~type_ ~size () =
-
{ account_id; blob_id; type_; size }
+
let v ~account_string ~blob_string ~type_ ~size () =
+
{ account_string; blob_string; type_; size }
end
module Blob_copy_args = struct
type t = {
-
from_account_id : id;
-
account_id : id;
-
blob_ids : id list;
+
from_account_string : string;
+
account_string : string;
+
blob_strings : string list;
}
-
let from_account_id t = t.from_account_id
-
let account_id t = t.account_id
-
let blob_ids t = t.blob_ids
+
let from_account_string t = t.from_account_string
+
let account_string t = t.account_string
+
let blob_strings t = t.blob_strings
-
let v ~from_account_id ~account_id ~blob_ids () =
-
{ from_account_id; account_id; blob_ids }
+
let v ~from_account_string ~account_string ~blob_strings () =
+
{ from_account_string; account_string; blob_strings }
end
module Blob_copy_response = struct
type t = {
-
from_account_id : id;
-
account_id : id;
-
copied : id id_map option;
-
not_copied : Error.Set_error.t id_map option;
+
from_account_string : string;
+
account_string : string;
+
copied : (string, string) Hashtbl.t option;
+
not_copied : (string, Error.Set_error.t) Hashtbl.t option;
}
-
let from_account_id t = t.from_account_id
-
let account_id t = t.account_id
+
let from_account_string t = t.from_account_string
+
let account_string t = t.account_string
let copied t = t.copied
let not_copied t = t.not_copied
-
let v ~from_account_id ~account_id ?copied ?not_copied () =
-
{ from_account_id; account_id; copied; not_copied }
+
let v ~from_account_string ~account_string ?copied ?not_copied () =
+
{ from_account_string; account_string; copied; not_copied }
end
+22 -22
jmap/jmap/jmap_binary.mli
···
(** JMAP Binary Data Handling.
-
This module provides types for handling binary data (blobs) in JMAP.
+
This module provstringes types for handling binary data (blobs) in JMAP.
Binary data is uploaded and downloaded separately from regular JMAP
method calls, using dedicated HTTP endpoints.
···
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-6> RFC 8620, Section 6 *)
-
open Types
+
(* Use underlying types directly to avostring circular dependency with Jmap module *)
(** Response from uploading binary data.
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-6.1> RFC 8620, Section 6.1 *)
module Upload_response : sig
type t
-
val account_id : t -> id
-
val blob_id : t -> id
+
val account_string : t -> string
+
val blob_string : t -> string
val type_ : t -> string
-
val size : t -> uint
+
val size : t -> int
val v :
-
account_id:id ->
-
blob_id:id ->
+
account_string:string ->
+
blob_string:string ->
type_:string ->
-
size:uint ->
+
size:int ->
unit ->
t
end
···
module Blob_copy_args : sig
type t
-
val from_account_id : t -> id
-
val account_id : t -> id
-
val blob_ids : t -> id list
+
val from_account_string : t -> string
+
val account_string : t -> string
+
val blob_strings : t -> string list
val v :
-
from_account_id:id ->
-
account_id:id ->
-
blob_ids:id list ->
+
from_account_string:string ->
+
account_string:string ->
+
blob_strings:string list ->
unit ->
t
end
···
module Blob_copy_response : sig
type t
-
val from_account_id : t -> id
-
val account_id : t -> id
-
val copied : t -> id id_map option
-
val not_copied : t -> Error.Set_error.t id_map option
+
val from_account_string : t -> string
+
val account_string : t -> string
+
val copied : t -> (string, string) Hashtbl.t option
+
val not_copied : t -> (string, Error.Set_error.t) Hashtbl.t option
val v :
-
from_account_id:id ->
-
account_id:id ->
-
?copied:id id_map ->
-
?not_copied:Error.Set_error.t id_map ->
+
from_account_string:string ->
+
account_string:string ->
+
?copied:(string, string) Hashtbl.t ->
+
?not_copied:(string, Error.Set_error.t) Hashtbl.t ->
unit ->
t
end
+8 -8
jmap/jmap/jmap_client.mli
···
@see <https://www.rfc-editor.org/rfc/rfc8620.html> RFC 8620: Core JMAP *)
-
open Types
+
(* Use underlying types directly to avoid circular dependency with Jmap module *)
open Jmap_protocol
(** {1 Client Type} *)
···
@return The blob ID or an error. *)
val upload_blob :
t ->
-
account_id:id ->
+
account_id:string ->
data:string ->
?content_type:string ->
unit ->
-
(id, error) result
+
(string, error) result
(** Download binary data from the server.
@param t The client instance.
···
@return The binary data or an error. *)
val download_blob :
t ->
-
account_id:id ->
-
blob_id:id ->
+
account_id:string ->
+
blob_id:string ->
?name:string ->
unit ->
(string, error) result
···
@return The download URL. *)
val get_download_url :
t ->
-
account_id:id ->
-
blob_id:id ->
+
account_id:string ->
+
blob_id:string ->
?name:string ->
?content_type:string ->
unit ->
···
@param t The client instance.
@param account_id The account ID.
@return The upload URL. *)
-
val get_upload_url : t -> account_id:id -> Uri.t
+
val get_upload_url : t -> account_id:string -> Uri.t
(** {1 Utilities} *)
+53 -53
jmap/jmap/jmap_methods.ml
···
-
open Types
+
(* Use underlying types directly to avoid circular dependency with Jmap module *)
open Jmap_method_names
type generic_record
module Get_args = struct
type 'record t = {
-
account_id : id;
-
ids : id list option;
+
account_id : string;
+
ids : string list option;
properties : string list option;
}
···
| Some ref_json -> ("#ids", ref_json) :: base_fields
| None ->
match t.ids with
-
| Some id_list -> ("ids", (`List (List.map (fun id -> `String id) id_list) : Yojson.Safe.t)) :: base_fields
+
| Some id_list -> ("ids", (`List (List.map (fun string -> `String string) id_list) : Yojson.Safe.t)) :: base_fields
| None -> base_fields
in
let fields = match t.properties with
···
module Get_response = struct
type 'record t = {
-
account_id : id;
+
account_id : string;
state : string;
list : 'record list;
-
not_found : id list;
+
not_found : string list;
}
let account_id t = t.account_id
···
module Changes_args = struct
type t = {
-
account_id : id;
+
account_id : string;
since_state : string;
-
max_changes : uint option;
+
max_changes : int option;
}
let account_id t = t.account_id
···
module Changes_response = struct
type t = {
-
account_id : id;
+
account_id : string;
old_state : string;
new_state : string;
has_more_changes : bool;
-
created : id list;
-
updated : id list;
-
destroyed : id list;
+
created : string list;
+
updated : string list;
+
destroyed : string list;
updated_properties : string list option;
}
···
| exn -> Error (Error.parse_error ("Changes_response parse error: " ^ Printexc.to_string exn))
end
-
type patch_object = (json_pointer * Yojson.Safe.t) list
+
type patch_object = (string * Yojson.Safe.t) list
module Set_args = struct
type ('create_record, 'update_record) t = {
-
account_id : id;
+
account_id : string;
if_in_state : string option;
-
create : 'create_record id_map option;
-
update : 'update_record id_map option;
-
destroy : id list option;
+
create : (string, 'create_record) Hashtbl.t option;
+
update : (string, 'update_record) Hashtbl.t option;
+
destroy : string list option;
on_success_destroy_original : bool option;
destroy_from_if_in_state : string option;
on_destroy_remove_emails : bool option;
···
| None -> fields
in
let fields = match t.destroy with
-
| Some destroy_list -> ("destroy", (`List (List.map (fun id -> `String id) destroy_list) : Yojson.Safe.t)) :: fields
+
| Some destroy_list -> ("destroy", (`List (List.map (fun string -> `String string) destroy_list) : Yojson.Safe.t)) :: fields
| None -> fields
in
let fields = match t.on_success_destroy_original with
···
module Set_response = struct
type ('created_record_info, 'updated_record_info) t = {
-
account_id : id;
+
account_id : string;
old_state : string option;
new_state : string;
-
created : 'created_record_info id_map option;
-
updated : 'updated_record_info option id_map option;
-
destroyed : id list option;
-
not_created : Error.Set_error.t id_map option;
-
not_updated : Error.Set_error.t id_map option;
-
not_destroyed : Error.Set_error.t id_map option;
+
created : (string, 'created_record_info) Hashtbl.t option;
+
updated : (string, 'updated_record_info option) Hashtbl.t option;
+
destroyed : string list option;
+
not_created : (string, Error.Set_error.t) Hashtbl.t option;
+
not_updated : (string, Error.Set_error.t) Hashtbl.t option;
+
not_destroyed : (string, Error.Set_error.t) Hashtbl.t option;
}
let account_id t = t.account_id
···
module Copy_args = struct
type 'copy_record_override t = {
-
from_account_id : id;
+
from_account_id : string;
if_from_in_state : string option;
-
account_id : id;
+
account_id : string;
if_in_state : string option;
-
create : 'copy_record_override id_map;
+
create : (string, 'copy_record_override) Hashtbl.t;
on_success_destroy_original : bool;
destroy_from_if_in_state : string option;
}
···
module Copy_response = struct
type 'created_record_info t = {
-
from_account_id : id;
-
account_id : id;
+
from_account_id : string;
+
account_id : string;
old_state : string option;
new_state : string;
-
created : 'created_record_info id_map option;
-
not_created : Error.Set_error.t id_map option;
+
created : (string, 'created_record_info) Hashtbl.t option;
+
not_created : (string, Error.Set_error.t) Hashtbl.t option;
}
let from_account_id t = t.from_account_id
···
is_ascending : bool option;
collation : string option;
keyword : string option;
-
other_fields : Yojson.Safe.t string_map;
+
other_fields : (string, Yojson.Safe.t) Hashtbl.t;
}
let property t = t.property
···
module Query_args = struct
type t = {
-
account_id : id;
+
account_id : string;
filter : Filter.t option;
sort : Comparator.t list option;
-
position : jint option;
-
anchor : id option;
-
anchor_offset : jint option;
-
limit : uint option;
+
position : int option;
+
anchor : string option;
+
anchor_offset : int option;
+
limit : int option;
calculate_total : bool option;
collapse_threads : bool option;
sort_as_tree : bool option;
···
module Query_response = struct
type t = {
-
account_id : id;
+
account_id : string;
query_state : string;
can_calculate_changes : bool;
-
position : uint;
-
ids : id list;
-
total : uint option;
-
limit : uint option;
+
position : int;
+
ids : string list;
+
total : int option;
+
limit : int option;
}
let account_id t = t.account_id
···
module Added_item = struct
type t = {
-
id : id;
-
index : uint;
+
string : string;
+
index : int;
}
-
let id t = t.id
+
let string t = t.string
let index t = t.index
-
let v ~id ~index () = { id; index }
+
let v ~string ~index () = { string; index }
end
module Query_changes_args = struct
type t = {
-
account_id : id;
+
account_id : string;
filter : Filter.t option;
sort : Comparator.t list option;
since_query_state : string;
-
max_changes : uint option;
-
up_to_id : id option;
+
max_changes : int option;
+
up_to_id : string option;
calculate_total : bool option;
collapse_threads : bool option;
}
···
module Query_changes_response = struct
type t = {
-
account_id : id;
+
account_id : string;
old_query_state : string;
new_query_state : string;
-
total : uint option;
-
removed : id list;
+
total : int option;
+
removed : string list;
added : Added_item.t list;
}
+102 -102
jmap/jmap/jmap_methods.mli
···
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-4> RFC 8620, Section 4 (Core/echo)
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5> RFC 8620, Section 5 (Standard Methods) *)
-
open Types
+
(* Use underlying types directly to avoid circular dependency with Jmap module *)
(** {1 Generic Types} *)
···
(** Get the account ID for this request.
@return The account ID to retrieve objects from *)
-
val account_id : 'record t -> id
+
val account_id : 'record t -> string
(** Get the list of object IDs to retrieve.
@return Specific IDs to fetch, or None for all objects *)
-
val ids : 'record t -> id list option
+
val ids : 'record t -> string list option
(** Get the list of properties to return.
@return Specific properties to include, or None for all properties *)
···
@param ?properties Optional list of properties to return (None = all properties)
@return New get arguments object *)
val v :
-
account_id:id ->
-
?ids:id list ->
+
account_id:string ->
+
?ids:string list ->
?properties:string list ->
unit ->
'record t
···
(** Response for /get methods.
The /get method response contains the retrieved objects along with
-
metadata about the current state and any objects that weren't found.
+
metadata about the current state and any objects that werent found.
The response includes:
- Retrieved objects in the same order as requested (or arbitrary order if all objects)
- Current state string for change tracking
-
- List of IDs that weren't found
+
- List of IDs that werent found
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.1> RFC 8620, Section 5.1 *)
module Get_response : sig
···
(** Get the account ID for this response.
@return The account ID the objects were retrieved from *)
-
val account_id : 'record t -> id
+
val account_id : 'record t -> string
(** Get the current state string for the object type.
@return State string for change tracking *)
···
@return List of objects in requested order (or arbitrary order if all) *)
val list : 'record t -> 'record list
-
(** Get the list of IDs that weren't found.
-
@return IDs that don't exist or are not accessible *)
-
val not_found : 'record t -> id list
+
(** Get the list of IDs that werent found.
+
@return IDs that dont exist or are not accessible *)
+
val not_found : 'record t -> string list
(** Create a new get response.
@param account_id The account ID
@param state Current state string
@param list Retrieved objects
-
@param not_found IDs that weren't found
+
@param not_found IDs that werent found
@return New get response object *)
val v :
-
account_id:id ->
+
account_id:string ->
state:string ->
list:'record list ->
-
not_found:id list ->
+
not_found:string list ->
unit ->
'record t
···
module Changes_args : sig
type t
-
val account_id : t -> id
+
val account_id : t -> string
val since_state : t -> string
-
val max_changes : t -> uint option
+
val max_changes : t -> int option
val v :
-
account_id:id ->
+
account_id:string ->
since_state:string ->
-
?max_changes:uint ->
+
?max_changes:int ->
unit ->
t
···
module Changes_response : sig
type t
-
val account_id : t -> id
+
val account_id : t -> string
val old_state : t -> string
val new_state : t -> string
val has_more_changes : t -> bool
-
val created : t -> id list
-
val updated : t -> id list
-
val destroyed : t -> id list
+
val created : t -> string list
+
val updated : t -> string list
+
val destroyed : t -> string list
val updated_properties : t -> string list option
val v :
-
account_id:id ->
+
account_id:string ->
old_state:string ->
new_state:string ->
has_more_changes:bool ->
-
created:id list ->
-
updated:id list ->
-
destroyed:id list ->
+
created:string list ->
+
updated:string list ->
+
destroyed:string list ->
?updated_properties:string list ->
unit ->
t
···
(** Patch object for /set update.
A list of (JSON Pointer path, value) pairs.
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.3> RFC 8620, Section 5.3 *)
-
type patch_object = (json_pointer * Yojson.Safe.t) list
+
type patch_object = (string * Yojson.Safe.t) list
(** Arguments for /set methods.
['create_record] is the record type without server-set/immutable fields.
···
module Set_args : sig
type ('create_record, 'update_record) t
-
val account_id : ('a, 'b) t -> id
+
val account_id : ('a, 'b) t -> string
val if_in_state : ('a, 'b) t -> string option
-
val create : ('a, 'b) t -> 'a id_map option
-
val update : ('a, 'b) t -> 'b id_map option
-
val destroy : ('a, 'b) t -> id list option
+
val create : ('a, 'b) t -> (string, 'a) Hashtbl.t option
+
val update : ('a, 'b) t -> (string, 'b) Hashtbl.t option
+
val destroy : ('a, 'b) t -> string list option
val on_success_destroy_original : ('a, 'b) t -> bool option
val destroy_from_if_in_state : ('a, 'b) t -> string option
val on_destroy_remove_emails : ('a, 'b) t -> bool option
val v :
-
account_id:id ->
+
account_id:string ->
?if_in_state:string ->
-
?create:'a id_map ->
-
?update:'b id_map ->
-
?destroy:id list ->
+
?create:(string, 'a) Hashtbl.t ->
+
?update:(string, 'b) Hashtbl.t ->
+
?destroy:string list ->
?on_success_destroy_original:bool ->
?destroy_from_if_in_state:string ->
?on_destroy_remove_emails:bool ->
···
module Set_response : sig
type ('created_record_info, 'updated_record_info) t
-
val account_id : ('a, 'b) t -> id
+
val account_id : ('a, 'b) t -> string
val old_state : ('a, 'b) t -> string option
val new_state : ('a, 'b) t -> string
-
val created : ('a, 'b) t -> 'a id_map option
-
val updated : ('a, 'b) t -> 'b option id_map option
-
val destroyed : ('a, 'b) t -> id list option
-
val not_created : ('a, 'b) t -> Error.Set_error.t id_map option
-
val not_updated : ('a, 'b) t -> Error.Set_error.t id_map option
-
val not_destroyed : ('a, 'b) t -> Error.Set_error.t id_map option
+
val created : ('a, 'b) t -> (string, 'a) Hashtbl.t option
+
val updated : ('a, 'b) t -> (string, 'b option) Hashtbl.t option
+
val destroyed : ('a, 'b) t -> string list option
+
val not_created : ('a, 'b) t -> (string, Error.Set_error.t) Hashtbl.t option
+
val not_updated : ('a, 'b) t -> (string, Error.Set_error.t) Hashtbl.t option
+
val not_destroyed : ('a, 'b) t -> (string, Error.Set_error.t) Hashtbl.t option
val v :
-
account_id:id ->
+
account_id:string ->
?old_state:string ->
new_state:string ->
-
?created:'a id_map ->
-
?updated:'b option id_map ->
-
?destroyed:id list ->
-
?not_created:Error.Set_error.t id_map ->
-
?not_updated:Error.Set_error.t id_map ->
-
?not_destroyed:Error.Set_error.t id_map ->
+
?created:(string, 'a) Hashtbl.t ->
+
?updated:(string, 'b option) Hashtbl.t ->
+
?destroyed:string list ->
+
?not_created:(string, Error.Set_error.t) Hashtbl.t ->
+
?not_updated:(string, Error.Set_error.t) Hashtbl.t ->
+
?not_destroyed:(string, Error.Set_error.t) Hashtbl.t ->
unit ->
('a, 'b) t
···
end
(** Arguments for /copy methods.
-
['copy_record_override] contains the record id and override properties.
+
['copy_record_override] contains the record string and override properties.
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.4> RFC 8620, Section 5.4 *)
module Copy_args : sig
type 'copy_record_override t
-
val from_account_id : 'a t -> id
+
val from_account_id : 'a t -> string
val if_from_in_state : 'a t -> string option
-
val account_id : 'a t -> id
+
val account_id : 'a t -> string
val if_in_state : 'a t -> string option
-
val create : 'a t -> 'a id_map
+
val create : 'a t -> (string, 'a) Hashtbl.t
val on_success_destroy_original : 'a t -> bool
val destroy_from_if_in_state : 'a t -> string option
val v :
-
from_account_id:id ->
+
from_account_id:string ->
?if_from_in_state:string ->
-
account_id:id ->
+
account_id:string ->
?if_in_state:string ->
-
create:'a id_map ->
+
create:(string, 'a) Hashtbl.t ->
?on_success_destroy_original:bool ->
?destroy_from_if_in_state:string ->
unit ->
···
module Copy_response : sig
type 'created_record_info t
-
val from_account_id : 'a t -> id
-
val account_id : 'a t -> id
+
val from_account_id : 'a t -> string
+
val account_id : 'a t -> string
val old_state : 'a t -> string option
val new_state : 'a t -> string
-
val created : 'a t -> 'a id_map option
-
val not_created : 'a t -> Error.Set_error.t id_map option
+
val created : 'a t -> (string, 'a) Hashtbl.t option
+
val not_created : 'a t -> (string, Error.Set_error.t) Hashtbl.t option
val v :
-
from_account_id:id ->
-
account_id:id ->
+
from_account_id:string ->
+
account_id:string ->
?old_state:string ->
new_state:string ->
-
?created:'a id_map ->
-
?not_created:Error.Set_error.t id_map ->
+
?created:(string, 'a) Hashtbl.t ->
+
?not_created:(string, Error.Set_error.t) Hashtbl.t ->
unit ->
'a t
end
···
val is_ascending : t -> bool option
val collation : t -> string option
val keyword : t -> string option
-
val other_fields : t -> Yojson.Safe.t string_map
+
val other_fields : t -> (string, Yojson.Safe.t) Hashtbl.t
val v :
property:string ->
?is_ascending:bool ->
?collation:string ->
?keyword:string ->
-
?other_fields:Yojson.Safe.t string_map ->
+
?other_fields:(string, Yojson.Safe.t) Hashtbl.t ->
unit ->
t
···
module Query_args : sig
type t
-
val account_id : t -> id
+
val account_id : t -> string
val filter : t -> Filter.t option
val sort : t -> Comparator.t list option
-
val position : t -> jint option
-
val anchor : t -> id option
-
val anchor_offset : t -> jint option
-
val limit : t -> uint option
+
val position : t -> int option
+
val anchor : t -> string option
+
val anchor_offset : t -> int option
+
val limit : t -> int option
val calculate_total : t -> bool option
val collapse_threads : t -> bool option
val sort_as_tree : t -> bool option
val filter_as_tree : t -> bool option
val v :
-
account_id:id ->
+
account_id:string ->
?filter:Filter.t ->
?sort:Comparator.t list ->
-
?position:jint ->
-
?anchor:id ->
-
?anchor_offset:jint ->
-
?limit:uint ->
+
?position:int ->
+
?anchor:string ->
+
?anchor_offset:int ->
+
?limit:int ->
?calculate_total:bool ->
?collapse_threads:bool ->
?sort_as_tree:bool ->
···
module Query_response : sig
type t
-
val account_id : t -> id
+
val account_id : t -> string
val query_state : t -> string
val can_calculate_changes : t -> bool
-
val position : t -> uint
-
val ids : t -> id list
-
val total : t -> uint option
-
val limit : t -> uint option
+
val position : t -> int
+
val ids : t -> string list
+
val total : t -> int option
+
val limit : t -> int option
val v :
-
account_id:id ->
+
account_id:string ->
query_state:string ->
can_calculate_changes:bool ->
-
position:uint ->
-
ids:id list ->
-
?total:uint ->
-
?limit:uint ->
+
position:int ->
+
ids:string list ->
+
?total:int ->
+
?limit:int ->
unit ->
t
···
module Added_item : sig
type t
-
val id : t -> id
-
val index : t -> uint
+
val string : t -> string
+
val index : t -> int
val v :
-
id:id ->
-
index:uint ->
+
string:string ->
+
index:int ->
unit ->
t
end
···
module Query_changes_args : sig
type t
-
val account_id : t -> id
+
val account_id : t -> string
val filter : t -> Filter.t option
val sort : t -> Comparator.t list option
val since_query_state : t -> string
-
val max_changes : t -> uint option
-
val up_to_id : t -> id option
+
val max_changes : t -> int option
+
val up_to_id : t -> string option
val calculate_total : t -> bool option
val collapse_threads : t -> bool option
val v :
-
account_id:id ->
+
account_id:string ->
?filter:Filter.t ->
?sort:Comparator.t list ->
since_query_state:string ->
-
?max_changes:uint ->
-
?up_to_id:id ->
+
?max_changes:int ->
+
?up_to_id:string ->
?calculate_total:bool ->
?collapse_threads:bool ->
unit ->
···
module Query_changes_response : sig
type t
-
val account_id : t -> id
+
val account_id : t -> string
val old_query_state : t -> string
val new_query_state : t -> string
-
val total : t -> uint option
-
val removed : t -> id list
+
val total : t -> int option
+
val removed : t -> string list
val added : t -> Added_item.t list
val v :
-
account_id:id ->
+
account_id:string ->
old_query_state:string ->
new_query_state:string ->
-
?total:uint ->
-
removed:id list ->
+
?total:int ->
+
removed:string list ->
added:Added_item.t list ->
unit ->
t
+1 -1
jmap/jmap/jmap_protocol.mli
···
@param session The session object.
@param capability The capability.
@return The account ID or an error if not found. *)
-
val get_primary_account : session -> Jmap_capability.t -> (Types.id, error) result
+
val get_primary_account : session -> Jmap_capability.t -> (string, error) result
(** Find a method response by its call ID.
@param response The response object.
+27 -27
jmap/jmap/jmap_push.ml
···
-
open Types
+
(* Use underlying types directly to avoid circular dependency with Jmap module *)
open Jmap_methods
-
type type_state = string string_map
+
type type_state = (string, string) Hashtbl.t
module State_change = struct
type t = {
-
changed : type_state id_map;
+
changed : (string, type_state) Hashtbl.t;
}
let changed t = t.changed
···
module Push_subscription = struct
type t = {
-
id : id;
+
string : string;
device_client_id : string;
url : Uri.t;
keys : Push_encryption_keys.t option;
verification_code : string option;
-
expires : utc_date option;
+
expires : string option;
types : string list option;
}
-
let id t = t.id
+
let string t = t.string
let device_client_id t = t.device_client_id
let url t = t.url
let keys t = t.keys
···
let expires t = t.expires
let types t = t.types
-
let v ~id ~device_client_id ~url ?keys ?verification_code ?expires ?types () =
-
{ id; device_client_id; url; keys; verification_code; expires; types }
+
let v ~string ~device_client_id ~url ?keys ?verification_code ?expires ?types () =
+
{ string; device_client_id; url; keys; verification_code; expires; types }
end
module Push_subscription_create = struct
···
device_client_id : string;
url : Uri.t;
keys : Push_encryption_keys.t option;
-
expires : utc_date option;
+
expires : string option;
types : string list option;
}
···
module Push_subscription_get_args = struct
type t = {
-
ids : id list option;
+
ids : string list option;
properties : string list option;
}
···
module Push_subscription_get_response = struct
type t = {
list : Push_subscription.t list;
-
not_found : id list;
+
not_found : string list;
}
let list t = t.list
···
module Push_subscription_set_args = struct
type t = {
-
create : Push_subscription_create.t id_map option;
-
update : push_subscription_update id_map option;
-
destroy : id list option;
+
create : (string, Push_subscription_create.t) Hashtbl.t option;
+
update : (string, push_subscription_update) Hashtbl.t option;
+
destroy : string list option;
}
let create t = t.create
···
module Push_subscription_created_info = struct
type t = {
-
id : id;
-
expires : utc_date option;
+
string : string;
+
expires : string option;
}
-
let id t = t.id
+
let string t = t.string
let expires t = t.expires
-
let v ~id ?expires () = { id; expires }
+
let v ~string ?expires () = { string; expires }
end
module Push_subscription_updated_info = struct
type t = {
-
expires : utc_date option;
+
expires : string option;
}
let expires t = t.expires
···
module Push_subscription_set_response = struct
type t = {
-
created : Push_subscription_created_info.t id_map option;
-
updated : Push_subscription_updated_info.t option id_map option;
-
destroyed : id list option;
-
not_created : Error.Set_error.t id_map option;
-
not_updated : Error.Set_error.t id_map option;
-
not_destroyed : Error.Set_error.t id_map option;
+
created : (string, Push_subscription_created_info.t) Hashtbl.t option;
+
updated : (string, Push_subscription_updated_info.t option) Hashtbl.t option;
+
destroyed : string list option;
+
not_created : (string, Error.Set_error.t) Hashtbl.t option;
+
not_updated : (string, Error.Set_error.t) Hashtbl.t option;
+
not_destroyed : (string, Error.Set_error.t) Hashtbl.t option;
}
let created t = t.created
···
module Push_verification = struct
type t = {
-
push_subscription_id : id;
+
push_subscription_id : string;
verification_code : string;
}
···
module Event_source_ping_data = struct
type t = {
-
interval : uint;
+
interval : int;
}
let interval t = t.interval
+43 -43
jmap/jmap/jmap_push.mli
···
(** JMAP Push Notifications.
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7> RFC 8620, Section 7 *)
-
open Types
+
(* Use underlying types directly to avoid circular dependency with Jmap module *)
open Jmap_methods
(** TypeState object map (TypeName -> StateString).
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.1> RFC 8620, Section 7.1 *)
-
type type_state = string string_map
+
type type_state = (string, string) Hashtbl.t
(** StateChange object.
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.1> RFC 8620, Section 7.1 *)
module State_change : sig
type t
-
val changed : t -> type_state id_map
+
val changed : t -> (string, type_state) Hashtbl.t
val v :
-
changed:type_state id_map ->
+
changed:(string, type_state) Hashtbl.t ->
unit ->
t
end
···
type t
(** Id of the subscription (server-set, immutable) *)
-
val id : t -> id
+
val string : t -> string
-
(** Device client id (immutable) *)
+
(** Device client string (immutable) *)
val device_client_id : t -> string
(** Notification URL (immutable) *)
···
(** Encryption keys (immutable) *)
val keys : t -> Push_encryption_keys.t option
val verification_code : t -> string option
-
val expires : t -> utc_date option
+
val expires : t -> string option
val types : t -> string list option
val v :
-
id:id ->
+
string:string ->
device_client_id:string ->
url:Uri.t ->
?keys:Push_encryption_keys.t ->
?verification_code:string ->
-
?expires:utc_date ->
+
?expires:string ->
?types:string list ->
unit ->
t
···
val device_client_id : t -> string
val url : t -> Uri.t
val keys : t -> Push_encryption_keys.t option
-
val expires : t -> utc_date option
+
val expires : t -> string option
val types : t -> string list option
val v :
device_client_id:string ->
url:Uri.t ->
?keys:Push_encryption_keys.t ->
-
?expires:utc_date ->
+
?expires:string ->
?types:string list ->
unit ->
t
···
module Push_subscription_get_args : sig
type t
-
val ids : t -> id list option
+
val ids : t -> string list option
val properties : t -> string list option
val v :
-
?ids:id list ->
+
?ids:string list ->
?properties:string list ->
unit ->
t
···
type t
val list : t -> Push_subscription.t list
-
val not_found : t -> id list
+
val not_found : t -> string list
val v :
list:Push_subscription.t list ->
-
not_found:id list ->
+
not_found:string list ->
unit ->
t
end
···
module Push_subscription_set_args : sig
type t
-
val create : t -> Push_subscription_create.t id_map option
-
val update : t -> push_subscription_update id_map option
-
val destroy : t -> id list option
+
val create : t -> (string, Push_subscription_create.t) Hashtbl.t option
+
val update : t -> (string, push_subscription_update) Hashtbl.t option
+
val destroy : t -> string list option
val v :
-
?create:Push_subscription_create.t id_map ->
-
?update:push_subscription_update id_map ->
-
?destroy:id list ->
+
?create:(string, Push_subscription_create.t) Hashtbl.t ->
+
?update:(string, push_subscription_update) Hashtbl.t ->
+
?destroy:string list ->
unit ->
t
end
···
module Push_subscription_created_info : sig
type t
-
val id : t -> id
-
val expires : t -> utc_date option
+
val string : t -> string
+
val expires : t -> string option
val v :
-
id:id ->
-
?expires:utc_date ->
+
string:string ->
+
?expires:string ->
unit ->
t
end
···
module Push_subscription_updated_info : sig
type t
-
val expires : t -> utc_date option
+
val expires : t -> string option
val v :
-
?expires:utc_date ->
+
?expires:string ->
unit ->
t
end
···
module Push_subscription_set_response : sig
type t
-
val created : t -> Push_subscription_created_info.t id_map option
-
val updated : t -> Push_subscription_updated_info.t option id_map option
-
val destroyed : t -> id list option
-
val not_created : t -> Error.Set_error.t id_map option
-
val not_updated : t -> Error.Set_error.t id_map option
-
val not_destroyed : t -> Error.Set_error.t id_map option
+
val created : t -> (string, Push_subscription_created_info.t) Hashtbl.t option
+
val updated : t -> (string, Push_subscription_updated_info.t option) Hashtbl.t option
+
val destroyed : t -> string list option
+
val not_created : t -> (string, Error.Set_error.t) Hashtbl.t option
+
val not_updated : t -> (string, Error.Set_error.t) Hashtbl.t option
+
val not_destroyed : t -> (string, Error.Set_error.t) Hashtbl.t option
val v :
-
?created:Push_subscription_created_info.t id_map ->
-
?updated:Push_subscription_updated_info.t option id_map ->
-
?destroyed:id list ->
-
?not_created:Error.Set_error.t id_map ->
-
?not_updated:Error.Set_error.t id_map ->
-
?not_destroyed:Error.Set_error.t id_map ->
+
?created:(string, Push_subscription_created_info.t) Hashtbl.t ->
+
?updated:(string, Push_subscription_updated_info.t option) Hashtbl.t ->
+
?destroyed:string list ->
+
?not_created:(string, Error.Set_error.t) Hashtbl.t ->
+
?not_updated:(string, Error.Set_error.t) Hashtbl.t ->
+
?not_destroyed:(string, Error.Set_error.t) Hashtbl.t ->
unit ->
t
end
···
module Push_verification : sig
type t
-
val push_subscription_id : t -> id
+
val push_subscription_id : t -> string
val verification_code : t -> string
val v :
-
push_subscription_id:id ->
+
push_subscription_id:string ->
verification_code:string ->
unit ->
t
···
module Event_source_ping_data : sig
type t
-
val interval : t -> uint
+
val interval : t -> int
val v :
-
interval:uint ->
+
interval:int ->
unit ->
t
end
+6 -6
jmap/jmap/jmap_request.ml
···
(** Implementation of type-safe JMAP request building and management. *)
-
open Types
+
(* Use underlying types directly to avoid circular dependency with Jmap module *)
(** Internal representation of a JMAP request under construction *)
type t = {
using: string list;
methods: (Jmap_method.t * string) list; (* (method, call_id) pairs *)
-
created_ids: (string) id_map option;
+
created_ids: (string, string) Hashtbl.t option;
call_id_counter: int;
}
···
let rec find_index methods index =
match methods with
| [] -> None
-
| (_, id) :: _ when id = call_id -> Some index
+
| (_, string) :: _ when string = call_id -> Some index
| _ :: rest -> find_index rest (index + 1)
in
find_index (List.rev t.methods) 0 (* Reverse to maintain insertion order *)
···
let add_method t method_call =
let call_id = match Jmap_method.call_id method_call with
-
| Some id -> id
+
| Some string -> string
| None ->
-
let (id, _) = generate_call_id t in
-
id
+
let (string, _) = generate_call_id t in
+
string
in
let method_with_id = Jmap_method.with_call_id method_call call_id in
let (final_call_id, updated_t) = if Jmap_method.call_id method_with_id = Some call_id then
+3 -3
jmap/jmap/jmap_request.mli
···
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.3> RFC 8620, Section 3.3 (Request Object)
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.7> RFC 8620, Section 3.7 (Result References) *)
-
open Types
+
(* Use underlying types directly to avoid circular dependency with Jmap module *)
(** {1 Request Types} *)
···
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.3> RFC 8620, Section 3.3 *)
val create :
using:string list ->
-
?created_ids:(string) id_map ->
+
?created_ids:(string, string) Hashtbl.t ->
unit ->
t
···
@return A new request with standard capabilities *)
val create_with_standard_capabilities :
?additional_capabilities:string list ->
-
?created_ids:(string) id_map ->
+
?created_ids:(string, string) Hashtbl.t ->
unit ->
t
+13 -13
jmap/jmap/jmap_response.mli
···
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.4> RFC 8620, Section 3.4 (Method Responses)
@see <https://www.rfc-editor.org/rfc/rfc8621.html> RFC 8621 (Email Extensions) *)
-
open Types
+
(* Use underlying types directly to avoid circular dependency with Jmap module *)
(** {1 Response Types} *)
···
val query_state : t -> string
(** Extract total count from response *)
-
val total : t -> uint option
+
val total : t -> int option
(** Extract current position from response *)
-
val position : t -> uint
+
val position : t -> int
end
(** Email/get response - implements METHOD_RESPONSE for get operations *)
···
include Jmap_sigs.METHOD_RESPONSE with type t = (Yojson.Safe.t, Yojson.Safe.t) Jmap_methods.Set_response.t
(** Extract created emails from response *)
-
val created : t -> Yojson.Safe.t id_map option
+
val created : t -> (string, Yojson.Safe.t) Hashtbl.t option
(** Extract updated emails from response *)
-
val updated : t -> Yojson.Safe.t option id_map option
+
val updated : t -> (string, Yojson.Safe.t option) Hashtbl.t option
(** Extract destroyed email IDs from response *)
val destroyed : t -> string list option
···
include Jmap_sigs.METHOD_RESPONSE with type t = (Yojson.Safe.t, Yojson.Safe.t) Jmap_methods.Set_response.t
(** Extract created mailboxes from response *)
-
val created : t -> Yojson.Safe.t id_map option
+
val created : t -> (string, Yojson.Safe.t) Hashtbl.t option
(** Extract updated mailboxes from response *)
-
val updated : t -> Yojson.Safe.t option id_map option
+
val updated : t -> (string, Yojson.Safe.t option) Hashtbl.t option
(** Extract destroyed mailbox IDs from response *)
val destroyed : t -> string list option
···
include Jmap_sigs.METHOD_RESPONSE with type t = (Yojson.Safe.t, Yojson.Safe.t) Jmap_methods.Set_response.t
(** Extract created identities from response *)
-
val created : t -> Yojson.Safe.t id_map option
+
val created : t -> (string, Yojson.Safe.t) Hashtbl.t option
(** Extract updated identities from response *)
-
val updated : t -> Yojson.Safe.t option id_map option
+
val updated : t -> (string, Yojson.Safe.t option) Hashtbl.t option
(** Extract destroyed identity IDs from response *)
val destroyed : t -> string list option
···
include Jmap_sigs.METHOD_RESPONSE with type t = (Yojson.Safe.t, Yojson.Safe.t) Jmap_methods.Set_response.t
(** Extract created email submissions from response *)
-
val created : t -> Yojson.Safe.t id_map option
+
val created : t -> (string, Yojson.Safe.t) Hashtbl.t option
(** Extract updated email submissions from response *)
-
val updated : t -> Yojson.Safe.t option id_map option
+
val updated : t -> (string, Yojson.Safe.t option) Hashtbl.t option
(** Extract destroyed email submission IDs from response *)
val destroyed : t -> string list option
···
include Jmap_sigs.METHOD_RESPONSE with type t = (Yojson.Safe.t, Yojson.Safe.t) Jmap_methods.Set_response.t
(** Extract created vacation responses from response *)
-
val created : t -> Yojson.Safe.t id_map option
+
val created : t -> (string, Yojson.Safe.t) Hashtbl.t option
(** Extract updated vacation responses from response *)
-
val updated : t -> Yojson.Safe.t option id_map option
+
val updated : t -> (string, Yojson.Safe.t option) Hashtbl.t option
(** Extract destroyed vacation response IDs from response *)
val destroyed : t -> string list option
+132
jmap/jmap/patch.ml
···
+
(* Internal representation as a hash table for efficient operations *)
+
type t = (string, Yojson.Safe.t) Hashtbl.t
+
+
(* JSON Pointer validation - simplified but covers common cases *)
+
let is_valid_property_path path =
+
let len = String.length path in
+
if len = 0 then true (* empty path is valid root *)
+
else if path.[0] <> '/' then true (* simple property names are valid *)
+
else
+
(* Check for valid JSON Pointer format *)
+
let rec check_escaping i =
+
if i >= len then true
+
else match path.[i] with
+
| '~' when i + 1 < len ->
+
(match path.[i + 1] with
+
| '0' | '1' -> check_escaping (i + 2)
+
| _ -> false)
+
| '/' -> check_escaping (i + 1)
+
| _ -> check_escaping (i + 1)
+
in
+
check_escaping 0
+
+
let empty = Hashtbl.create 8
+
+
let of_operations operations =
+
let patch = Hashtbl.create (List.length operations) in
+
let rec process = function
+
| [] -> Ok patch
+
| (property, value) :: rest ->
+
if is_valid_property_path property then (
+
Hashtbl.replace patch property value;
+
process rest
+
) else
+
Error ("Invalid property path: " ^ property)
+
in
+
process operations
+
+
let to_operations patch =
+
Hashtbl.fold (fun property value acc ->
+
(property, value) :: acc
+
) patch []
+
+
let of_json_object = function
+
| `Assoc pairs -> of_operations pairs
+
| json ->
+
let json_str = Yojson.Safe.to_string json in
+
Error (Printf.sprintf "Expected JSON object for Patch, got: %s" json_str)
+
+
let to_json_object patch =
+
let pairs = to_operations patch in
+
`Assoc pairs
+
+
let set_property patch property value =
+
if is_valid_property_path property then (
+
let new_patch = Hashtbl.copy patch in
+
Hashtbl.replace new_patch property value;
+
Ok new_patch
+
) else
+
Error ("Invalid property path: " ^ property)
+
+
let remove_property patch property =
+
set_property patch property `Null
+
+
let has_property patch property =
+
Hashtbl.mem patch property
+
+
let get_property patch property =
+
try Some (Hashtbl.find patch property)
+
with Not_found -> None
+
+
let merge patch1 patch2 =
+
let result = Hashtbl.copy patch1 in
+
Hashtbl.iter (fun property value ->
+
Hashtbl.replace result property value
+
) patch2;
+
result
+
+
let is_empty patch =
+
Hashtbl.length patch = 0
+
+
let size patch =
+
Hashtbl.length patch
+
+
let validate patch =
+
(* Validate all property paths *)
+
try
+
Hashtbl.iter (fun property _value ->
+
if not (is_valid_property_path property) then
+
failwith ("Invalid property path: " ^ property)
+
) patch;
+
Ok ()
+
with
+
| Failure msg -> Error msg
+
+
let equal patch1 patch2 =
+
if Hashtbl.length patch1 <> Hashtbl.length patch2 then false
+
else
+
try
+
Hashtbl.iter (fun property value1 ->
+
match get_property patch2 property with
+
| None -> failwith "Property not found"
+
| Some value2 when Yojson.Safe.equal value1 value2 -> ()
+
| Some _ -> failwith "Property values differ"
+
) patch1;
+
true
+
with
+
| Failure _ -> false
+
+
let pp ppf patch =
+
Format.fprintf ppf "%s" (Yojson.Safe.to_string (to_json_object patch))
+
+
let pp_hum ppf patch =
+
let operations = to_operations patch in
+
let op_count = List.length operations in
+
let key_list = List.map fst operations in
+
let key_str = match key_list with
+
| [] -> "none"
+
| keys -> String.concat ", " keys
+
in
+
Format.fprintf ppf "Patch{operations=%d; keys=[%s]}" op_count key_str
+
+
let to_string_debug patch =
+
let operations = to_operations patch in
+
let op_strings = List.map (fun (prop, value) ->
+
Printf.sprintf "%s: %s" prop (Yojson.Safe.to_string value)
+
) operations in
+
Printf.sprintf "Patch({%s})" (String.concat "; " op_strings)
+
+
(* JSON serialization *)
+
let to_json patch = to_json_object patch
+
+
let of_json json = of_json_object json
+122
jmap/jmap/patch.mli
···
+
(** JMAP Patch Object for property updates with JSON serialization.
+
+
A patch object is used to update properties of JMAP objects. It represents
+
a JSON object where each key is a property path (using JSON Pointer syntax)
+
and each value is the new value to set for that property, or null to remove
+
the property.
+
+
Patch objects are commonly used in /set method calls to update existing
+
objects without having to send the complete object representation.
+
+
Examples of patch operations:
+
- Setting a property: [{"name": "New Name"}]
+
- Removing a property: [{"oldProperty": null}]
+
- Setting nested properties: [{"address/street": "123 Main St"}]
+
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.3> RFC 8620, Section 5.3
+
@see <https://www.rfc-editor.org/rfc/rfc6901.html> RFC 6901 (JSON Pointer) *)
+
+
(** Abstract type representing a JMAP Patch Object. *)
+
type t
+
+
(** JSON serialization interface *)
+
include Jmap_sigs.JSONABLE with type t := t
+
+
(** Pretty-printing interface *)
+
include Jmap_sigs.PRINTABLE with type t := t
+
+
(** {2 Construction and Access} *)
+
+
(** Create an empty patch object.
+
@return An empty patch with no operations. *)
+
val empty : t
+
+
(** Create a patch from a list of property-value pairs.
+
@param operations List of (property_path, value) pairs.
+
@return Ok with the patch, or Error if any property path is invalid. *)
+
val of_operations : (string * Yojson.Safe.t) list -> (t, string) result
+
+
(** Convert a patch to a list of property-value pairs.
+
@param patch The patch to convert.
+
@return List of (property_path, value) pairs. *)
+
val to_operations : t -> (string * Yojson.Safe.t) list
+
+
(** Create a patch from a Yojson.Safe.t object directly.
+
@param json The JSON object.
+
@return Ok with the patch, or Error if the JSON is not a valid object. *)
+
val of_json_object : Yojson.Safe.t -> (t, string) result
+
+
(** Convert a patch to a Yojson.Safe.t object directly.
+
@param patch The patch to convert.
+
@return The JSON object representation. *)
+
val to_json_object : t -> Yojson.Safe.t
+
+
(** {2 Patch Operations} *)
+
+
(** Set a property in the patch.
+
@param patch The patch to modify.
+
@param property The property path (JSON Pointer format).
+
@param value The value to set.
+
@return Ok with the updated patch, or Error if the property path is invalid. *)
+
val set_property : t -> string -> Yojson.Safe.t -> (t, string) result
+
+
(** Remove a property in the patch (set to null).
+
@param patch The patch to modify.
+
@param property The property path to remove.
+
@return Ok with the updated patch, or Error if the property path is invalid. *)
+
val remove_property : t -> string -> (t, string) result
+
+
(** Check if a property is set in the patch.
+
@param patch The patch to check.
+
@param property The property path to check.
+
@return True if the property is explicitly set in the patch. *)
+
val has_property : t -> string -> bool
+
+
(** Get a property value from the patch.
+
@param patch The patch to query.
+
@param property The property path to get.
+
@return Some value if the property is set, None if not present. *)
+
val get_property : t -> string -> Yojson.Safe.t option
+
+
(** {2 Patch Composition} *)
+
+
(** Merge two patches, with the second patch taking precedence.
+
@param patch1 The first patch.
+
@param patch2 The second patch (higher precedence).
+
@return The merged patch. *)
+
val merge : t -> t -> t
+
+
(** Check if a patch is empty (no operations).
+
@param patch The patch to check.
+
@return True if the patch has no operations. *)
+
val is_empty : t -> bool
+
+
(** Get the number of operations in a patch.
+
@param patch The patch to count.
+
@return The number of property operations. *)
+
val size : t -> int
+
+
(** {2 Validation} *)
+
+
(** Validate a patch according to JMAP constraints.
+
@param patch The patch to validate.
+
@return Ok () if valid, Error with description if invalid. *)
+
val validate : t -> (unit, string) result
+
+
(** Validate a JSON Pointer path.
+
@param path The property path to validate.
+
@return True if the path is a valid JSON Pointer, false otherwise. *)
+
val is_valid_property_path : string -> bool
+
+
(** {2 Comparison and Utilities} *)
+
+
(** Compare two patches for equality.
+
@param patch1 First patch.
+
@param patch2 Second patch.
+
@return True if patches have identical operations, false otherwise. *)
+
val equal : t -> t -> bool
+
+
(** Convert a patch to a human-readable string for debugging.
+
@param patch The patch to format.
+
@return A debug string representation. *)
+
val to_string_debug : t -> string
+13 -13
jmap/jmap/session.ml
···
-
open Types
+
(* Use underlying types directly to avoid circular dependency with Jmap module *)
type account_capability_value = Yojson.Safe.t
···
module Core_capability = struct
type t = {
-
max_size_upload : uint;
-
max_concurrent_upload : uint;
-
max_size_request : uint;
-
max_concurrent_requests : uint;
-
max_calls_in_request : uint;
-
max_objects_in_get : uint;
-
max_objects_in_set : uint;
+
max_size_upload : int;
+
max_concurrent_upload : int;
+
max_size_request : int;
+
max_concurrent_requests : int;
+
max_calls_in_request : int;
+
max_objects_in_get : int;
+
max_objects_in_set : int;
collation_algorithms : string list;
}
···
name : string;
is_personal : bool;
is_read_only : bool;
-
account_capabilities : account_capability_value string_map;
+
account_capabilities : (string, account_capability_value) Hashtbl.t;
}
let name t = t.name
···
module Session = struct
type t = {
-
capabilities : server_capability_value string_map;
-
accounts : Account.t id_map;
-
primary_accounts : id string_map;
+
capabilities : (string, server_capability_value) Hashtbl.t;
+
accounts : (string, Account.t) Hashtbl.t;
+
primary_accounts : (string, string) Hashtbl.t;
username : string;
api_url : Uri.t;
download_url : Uri.t;
···
| No_auth -> []
let make_request ~url ~auth =
-
let headers = ("Accept", Types.Constants.Content_type.json) :: ("User-Agent", Types.Constants.User_agent.ocaml_jmap) :: (auth_headers auth) in
+
let headers = ("Accept", "application/json") :: ("User-Agent", "ocaml-jmap/1.0") :: (auth_headers auth) in
try
let response_json = `Assoc [
("capabilities", `Assoc [
+27 -27
jmap/jmap/session.mli
···
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-2> RFC 8620, Section 2 *)
-
open Types
+
(* Use underlying types directly to avoid circular dependency with Jmap module *)
(** {1 Capability Types} *)
···
(** Maximum size in bytes for a single blob upload.
@return Maximum upload size (typically 50MB or similar) *)
-
val max_size_upload : t -> uint
+
val max_size_upload : t -> int
(** Maximum number of concurrent blob uploads allowed.
@return Maximum concurrent uploads (typically 4-10) *)
-
val max_concurrent_upload : t -> uint
+
val max_concurrent_upload : t -> int
(** Maximum size in bytes for a single JMAP request.
@return Maximum request size (typically 10MB or similar) *)
-
val max_size_request : t -> uint
+
val max_size_request : t -> int
(** Maximum number of concurrent JMAP requests allowed.
@return Maximum concurrent requests (typically 4-10) *)
-
val max_concurrent_requests : t -> uint
+
val max_concurrent_requests : t -> int
(** Maximum number of method calls allowed in a single request.
@return Maximum method calls per request (typically 16-64) *)
-
val max_calls_in_request : t -> uint
+
val max_calls_in_request : t -> int
(** Maximum number of objects that can be requested in a single /get call.
@return Maximum objects per /get (typically 500-1000) *)
-
val max_objects_in_get : t -> uint
+
val max_objects_in_get : t -> int
(** Maximum number of objects that can be processed in a single /set call.
@return Maximum objects per /set (typically 500-1000) *)
-
val max_objects_in_set : t -> uint
+
val max_objects_in_set : t -> int
(** List of supported collation algorithms for sorting.
@return List of collation algorithm names (e.g., ["i;ascii-casemap", "i;unicode-casemap"]) *)
···
@param collation_algorithms Supported collation algorithms
@return A new core capability object *)
val v :
-
max_size_upload:uint ->
-
max_concurrent_upload:uint ->
-
max_size_request:uint ->
-
max_concurrent_requests:uint ->
-
max_calls_in_request:uint ->
-
max_objects_in_get:uint ->
-
max_objects_in_set:uint ->
+
max_size_upload:int ->
+
max_concurrent_upload:int ->
+
max_size_request:int ->
+
max_concurrent_requests:int ->
+
max_calls_in_request:int ->
+
max_objects_in_get:int ->
+
max_objects_in_set:int ->
collation_algorithms:string list ->
unit ->
t
···
(** Get the account-specific capability information.
@return Map of capability URIs to their account-specific metadata *)
-
val account_capabilities : t -> account_capability_value string_map
+
val account_capabilities : t -> (string, account_capability_value) Hashtbl.t
(** Create a new account object.
@param name Human-readable account name
···
name:string ->
?is_personal:bool ->
?is_read_only:bool ->
-
?account_capabilities:account_capability_value string_map ->
+
?account_capabilities:(string, account_capability_value) Hashtbl.t ->
unit ->
t
···
(** Get the server capabilities.
@return Map of capability URIs to server-specific capability metadata *)
-
val capabilities : t -> server_capability_value string_map
+
val capabilities : t -> (string, server_capability_value) Hashtbl.t
(** Get all accounts accessible to the authenticated user.
@return Map of account IDs to account objects *)
-
val accounts : t -> Account.t id_map
+
val accounts : t -> (string, Account.t) Hashtbl.t
(** Get the primary account ID for each capability.
@return Map from capability URI to primary account ID for that capability *)
-
val primary_accounts : t -> id string_map
+
val primary_accounts : t -> (string, string) Hashtbl.t
(** Get the authenticated username.
@return Username or email address of the authenticated user *)
···
@param state Current session state string
@return A new session object *)
val v :
-
capabilities:server_capability_value string_map ->
-
accounts:Account.t id_map ->
-
primary_accounts:id string_map ->
+
capabilities:(string, server_capability_value) Hashtbl.t ->
+
accounts:(string, Account.t) Hashtbl.t ->
+
primary_accounts:(string, string) Hashtbl.t ->
username:string ->
api_url:Uri.t ->
download_url:Uri.t ->
···
(** Get the primary account ID for a given capability.
@param capability The capability
@return Primary account ID if found, None otherwise *)
-
val get_primary_account : t -> Jmap_capability.t -> id option
+
val get_primary_account : t -> Jmap_capability.t -> string option
(** Get account information by account ID.
@param account_id The account ID to look up
@return Account object if found, None otherwise *)
-
val get_account : t -> id -> Account.t option
+
val get_account : t -> string -> Account.t option
(** Get all personal accounts for the authenticated user.
@return List of (account_id, account) pairs for personal accounts *)
-
val get_personal_accounts : t -> (id * Account.t) list
+
val get_personal_accounts : t -> (string * Account.t) list
(** Get all accounts that support a given capability.
@param capability The capability
@return List of (account_id, account) pairs that support the capability *)
-
val get_capability_accounts : t -> Jmap_capability.t -> (id * Account.t) list
+
val get_capability_accounts : t -> Jmap_capability.t -> (string * Account.t) list
end
(** {1 Session Discovery and Retrieval} *)
-432
jmap/jmap/types.ml
···
-
(** JMAP Core Types Implementation *)
-
-
(* Id module implementation *)
-
module Id = struct
-
type t = string
-
-
let is_base64url_char c =
-
(c >= 'A' && c <= 'Z') ||
-
(c >= 'a' && c <= 'z') ||
-
(c >= '0' && c <= '9') ||
-
c = '-' || c = '_'
-
-
let is_valid_string str =
-
let len = String.length str in
-
len > 0 && len <= 255 &&
-
let rec check i =
-
if i >= len then true
-
else if is_base64url_char str.[i] then check (i + 1)
-
else false
-
in
-
check 0
-
-
let of_string str =
-
if is_valid_string str then Ok str
-
else
-
let len = String.length str in
-
if len = 0 then Error "Id cannot be empty"
-
else if len > 255 then Error "Id cannot be longer than 255 octets"
-
else Error "Id contains invalid characters (must be base64url alphabet only)"
-
-
let to_string id = id
-
-
let pp ppf id = Format.fprintf ppf "%s" id
-
-
let pp_hum ppf id = Format.fprintf ppf "Id(%s)" id
-
-
let validate id =
-
if is_valid_string id then Ok ()
-
else Error "Invalid Id format"
-
-
let equal = String.equal
-
-
let compare = String.compare
-
-
let pp_debug ppf id = Format.fprintf ppf "Id(%s)" id
-
-
let to_string_debug id = Printf.sprintf "Id(%s)" id
-
-
(* JSON serialization *)
-
let to_json id = `String id
-
-
let of_json = function
-
| `String str -> of_string str
-
| json ->
-
let json_str = Yojson.Safe.to_string json in
-
Error (Printf.sprintf "Expected JSON string for Id, got: %s" json_str)
-
end
-
-
(* Date module implementation *)
-
module Date = struct
-
type t = float (* Unix timestamp *)
-
-
(* Basic RFC 3339 parsing - simplified for JMAP usage *)
-
let parse_rfc3339 str =
-
try
-
(* Use Unix.strptime if available, otherwise simplified parsing *)
-
let len = String.length str in
-
if len < 19 then failwith "Too short for RFC 3339";
-
-
(* Extract year, month, day, hour, minute, second *)
-
let year = int_of_string (String.sub str 0 4) in
-
let month = int_of_string (String.sub str 5 2) in
-
let day = int_of_string (String.sub str 8 2) in
-
let hour = int_of_string (String.sub str 11 2) in
-
let minute = int_of_string (String.sub str 14 2) in
-
let second = int_of_string (String.sub str 17 2) in
-
-
(* Basic validation *)
-
if year < 1970 || year > 9999 then failwith "Invalid year";
-
if month < 1 || month > 12 then failwith "Invalid month";
-
if day < 1 || day > 31 then failwith "Invalid day";
-
if hour < 0 || hour > 23 then failwith "Invalid hour";
-
if minute < 0 || minute > 59 then failwith "Invalid minute";
-
if second < 0 || second > 59 then failwith "Invalid second";
-
-
(* Convert to Unix timestamp using built-in functions *)
-
let tm = {
-
Unix.tm_year = year - 1900;
-
tm_mon = month - 1;
-
tm_mday = day;
-
tm_hour = hour;
-
tm_min = minute;
-
tm_sec = second;
-
tm_wday = 0;
-
tm_yday = 0;
-
tm_isdst = false;
-
} in
-
-
(* Handle timezone - simplified to assume UTC for 'Z' suffix *)
-
let timestamp =
-
if len >= 20 && str.[len-1] = 'Z' then
-
(* UTC time - convert to UTC timestamp *)
-
let local_time = fst (Unix.mktime tm) in
-
let gm_tm = Unix.gmtime local_time in
-
let utc_time = fst (Unix.mktime gm_tm) in
-
utc_time
-
else if len >= 25 && (str.[len-6] = '+' || str.[len-6] = '-') then
-
(* Timezone offset specified *)
-
let sign = if str.[len-6] = '+' then -1.0 else 1.0 in
-
let tz_hours = int_of_string (String.sub str (len-5) 2) in
-
let tz_minutes = int_of_string (String.sub str (len-2) 2) in
-
let offset = sign *. (float_of_int tz_hours *. 3600.0 +. float_of_int tz_minutes *. 60.0) in
-
fst (Unix.mktime tm) +. offset
-
else
-
(* No timezone - assume local time *)
-
fst (Unix.mktime tm)
-
in
-
Ok timestamp
-
with
-
| Failure msg -> Error ("Invalid RFC 3339 format: " ^ msg)
-
| Invalid_argument _ -> Error "Invalid RFC 3339 format: parsing error"
-
| _ -> Error "Invalid RFC 3339 format"
-
-
let format_rfc3339 timestamp =
-
let tm = Unix.gmtime timestamp in
-
Printf.sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ"
-
(tm.tm_year + 1900)
-
(tm.tm_mon + 1)
-
tm.tm_mday
-
tm.tm_hour
-
tm.tm_min
-
tm.tm_sec
-
-
let of_timestamp timestamp = timestamp
-
-
let to_timestamp date = date
-
-
let of_rfc3339 str = parse_rfc3339 str
-
-
let to_rfc3339 date = format_rfc3339 date
-
-
let now () = Unix.time ()
-
-
let validate date =
-
if date >= 0.0 && date <= 253402300799.0 (* 9999-12-31T23:59:59Z *) then
-
Ok ()
-
else
-
Error "Date timestamp out of valid range"
-
-
let equal date1 date2 =
-
(* Equal within 1 second precision *)
-
abs_float (date1 -. date2) < 1.0
-
-
let compare date1 date2 =
-
if date1 < date2 then -1
-
else if date1 > date2 then 1
-
else 0
-
-
let is_before date1 date2 = date1 < date2
-
-
let is_after date1 date2 = date1 > date2
-
-
let pp ppf date = Format.fprintf ppf "%s" (to_rfc3339 date)
-
-
let pp_hum ppf date = Format.fprintf ppf "Date(%s)" (to_rfc3339 date)
-
-
let pp_debug ppf date =
-
Format.fprintf ppf "Date(%s)" (to_rfc3339 date)
-
-
let to_string_debug date =
-
Printf.sprintf "Date(%s)" (to_rfc3339 date)
-
-
(* JSON serialization *)
-
let to_json date = `String (to_rfc3339 date)
-
-
let of_json = function
-
| `String str -> of_rfc3339 str
-
| json ->
-
let json_str = Yojson.Safe.to_string json in
-
Error (Printf.sprintf "Expected JSON string for Date, got: %s" json_str)
-
end
-
-
(* UInt module implementation *)
-
module UInt = struct
-
type t = int
-
-
(* Maximum safe integer value for JavaScript: 2^53 - 1 *)
-
let max_safe_value = 9007199254740991
-
-
let is_valid_int i = i >= 0 && i <= max_safe_value
-
-
let of_int i =
-
if is_valid_int i then Ok i
-
else if i < 0 then Error "UnsignedInt cannot be negative"
-
else Error "UnsignedInt cannot exceed 2^53-1"
-
-
let to_int uint = uint
-
-
let of_string str =
-
try
-
let i = int_of_string str in
-
of_int i
-
with
-
| Failure _ -> Error "Invalid integer string format"
-
| Invalid_argument _ -> Error "Invalid integer string format"
-
-
let to_string uint = string_of_int uint
-
-
let pp ppf uint = Format.fprintf ppf "%d" uint
-
-
let pp_hum ppf uint = Format.fprintf ppf "UInt(%d)" uint
-
-
(* Constants *)
-
let zero = 0
-
let one = 1
-
let max_safe = max_safe_value
-
-
let validate uint =
-
if is_valid_int uint then Ok ()
-
else Error "UnsignedInt value out of valid range"
-
-
(* Arithmetic operations with overflow checking *)
-
let add uint1 uint2 =
-
let result = uint1 + uint2 in
-
if result >= uint1 && result >= uint2 && is_valid_int result then
-
Ok result
-
else
-
Error "UnsignedInt addition overflow"
-
-
let sub uint1 uint2 =
-
if uint1 >= uint2 then Ok (uint1 - uint2)
-
else Error "UnsignedInt subtraction would result in negative value"
-
-
let mul uint1 uint2 =
-
if uint1 = 0 || uint2 = 0 then Ok 0
-
else if uint1 <= max_safe_value / uint2 then
-
Ok (uint1 * uint2)
-
else
-
Error "UnsignedInt multiplication overflow"
-
-
(* Comparison and utilities *)
-
let equal = (=)
-
-
let compare = compare
-
-
let min uint1 uint2 = if uint1 <= uint2 then uint1 else uint2
-
-
let max uint1 uint2 = if uint1 >= uint2 then uint1 else uint2
-
-
let pp_debug ppf uint = Format.fprintf ppf "UInt(%d)" uint
-
-
let to_string_debug uint = Printf.sprintf "UInt(%d)" uint
-
-
(* JSON serialization *)
-
let to_json uint = `Int uint
-
-
let of_json = function
-
| `Int i -> of_int i
-
| `Float f ->
-
(* Handle case where JSON parser represents integers as floats *)
-
if f >= 0.0 && f <= float_of_int max_safe_value && f = Float.round f then
-
of_int (int_of_float f)
-
else
-
Error "Float value is not a valid UnsignedInt"
-
| json ->
-
let json_str = Yojson.Safe.to_string json in
-
Error (Printf.sprintf "Expected JSON number for UnsignedInt, got: %s" json_str)
-
end
-
-
(* Patch module implementation *)
-
module Patch = struct
-
(* Internal representation as a hash table for efficient operations *)
-
type t = (string, Yojson.Safe.t) Hashtbl.t
-
-
(* JSON Pointer validation - simplified but covers common cases *)
-
let is_valid_property_path path =
-
let len = String.length path in
-
if len = 0 then true (* empty path is valid root *)
-
else if path.[0] <> '/' then true (* simple property names are valid *)
-
else
-
(* Check for valid JSON Pointer format *)
-
let rec check_escaping i =
-
if i >= len then true
-
else match path.[i] with
-
| '~' when i + 1 < len ->
-
(match path.[i + 1] with
-
| '0' | '1' -> check_escaping (i + 2)
-
| _ -> false)
-
| '/' -> check_escaping (i + 1)
-
| _ -> check_escaping (i + 1)
-
in
-
check_escaping 0
-
-
let empty = Hashtbl.create 8
-
-
let of_operations operations =
-
let patch = Hashtbl.create (List.length operations) in
-
let rec process = function
-
| [] -> Ok patch
-
| (property, value) :: rest ->
-
if is_valid_property_path property then (
-
Hashtbl.replace patch property value;
-
process rest
-
) else
-
Error ("Invalid property path: " ^ property)
-
in
-
process operations
-
-
let to_operations patch =
-
Hashtbl.fold (fun property value acc ->
-
(property, value) :: acc
-
) patch []
-
-
let of_json_object = function
-
| `Assoc pairs -> of_operations pairs
-
| json ->
-
let json_str = Yojson.Safe.to_string json in
-
Error (Printf.sprintf "Expected JSON object for Patch, got: %s" json_str)
-
-
let to_json_object patch =
-
let pairs = to_operations patch in
-
`Assoc pairs
-
-
let set_property patch property value =
-
if is_valid_property_path property then (
-
let new_patch = Hashtbl.copy patch in
-
Hashtbl.replace new_patch property value;
-
Ok new_patch
-
) else
-
Error ("Invalid property path: " ^ property)
-
-
let remove_property patch property =
-
set_property patch property `Null
-
-
let has_property patch property =
-
Hashtbl.mem patch property
-
-
let get_property patch property =
-
try Some (Hashtbl.find patch property)
-
with Not_found -> None
-
-
let merge patch1 patch2 =
-
let result = Hashtbl.copy patch1 in
-
Hashtbl.iter (fun property value ->
-
Hashtbl.replace result property value
-
) patch2;
-
result
-
-
let is_empty patch =
-
Hashtbl.length patch = 0
-
-
let size patch =
-
Hashtbl.length patch
-
-
let validate patch =
-
(* Validate all property paths *)
-
try
-
Hashtbl.iter (fun property _value ->
-
if not (is_valid_property_path property) then
-
failwith ("Invalid property path: " ^ property)
-
) patch;
-
Ok ()
-
with
-
| Failure msg -> Error msg
-
-
let equal patch1 patch2 =
-
if Hashtbl.length patch1 <> Hashtbl.length patch2 then false
-
else
-
try
-
Hashtbl.iter (fun property value1 ->
-
match get_property patch2 property with
-
| None -> failwith "Property not found"
-
| Some value2 when Yojson.Safe.equal value1 value2 -> ()
-
| Some _ -> failwith "Property values differ"
-
) patch1;
-
true
-
with
-
| Failure _ -> false
-
-
let pp ppf patch =
-
Format.fprintf ppf "%s" (Yojson.Safe.to_string (to_json_object patch))
-
-
let pp_hum ppf patch =
-
let operations = to_operations patch in
-
let op_count = List.length operations in
-
let key_list = List.map fst operations in
-
let key_str = match key_list with
-
| [] -> "none"
-
| keys -> String.concat ", " keys
-
in
-
Format.fprintf ppf "Patch{operations=%d; keys=[%s]}" op_count key_str
-
-
let to_string_debug patch =
-
let operations = to_operations patch in
-
let op_strings = List.map (fun (prop, value) ->
-
Printf.sprintf "%s: %s" prop (Yojson.Safe.to_string value)
-
) operations in
-
Printf.sprintf "Patch({%s})" (String.concat "; " op_strings)
-
-
(* JSON serialization *)
-
let to_json patch = to_json_object patch
-
-
let of_json json = of_json_object json
-
end
-
-
(* Legacy type aliases *)
-
type id = string
-
type jint = int
-
type uint = int
-
type date = float
-
type utc_date = float
-
-
(* Collection types *)
-
type 'v string_map = (string, 'v) Hashtbl.t
-
type 'v id_map = (id, 'v) Hashtbl.t
-
-
(* Protocol-specific types *)
-
type json_pointer = string
-
-
(* Constants module *)
-
module Constants = struct
-
let vacation_response_id = "singleton"
-
-
module Content_type = struct
-
let json = "application/json"
-
end
-
-
module User_agent = struct
-
let ocaml_jmap = "OCaml-JMAP/1.0"
-
let eio_client = "OCaml JMAP Client/Eio"
-
end
-
end
-592
jmap/jmap/types.mli
···
-
(** JMAP Core Types Library (RFC 8620)
-
-
This module provides all fundamental JMAP data types in a unified interface.
-
It consolidates the core primitives (Id, Date, UInt), data structures (Patch),
-
and collection types used throughout the JMAP protocol.
-
-
The module is organized into clear sections:
-
- {!Types.Id}: JMAP Id type with validation and JSON serialization
-
- {!Types.Date}: JMAP Date type with RFC 3339 support
-
- {!Types.UInt}: JMAP UnsignedInt type with range validation
-
- {!Types.Patch}: JMAP Patch objects for property updates
-
- Legacy type aliases for backwards compatibility
-
-
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1> RFC 8620, Section 1 *)
-
-
(** {1 Core JMAP Types} *)
-
-
(** JMAP Id data type with validation and JSON serialization.
-
-
The Id data type is a string of 1 to 255 octets in length and MUST consist
-
only of characters from the base64url alphabet, as defined in Section 5 of
-
RFC 4648. This includes ASCII alphanumeric characters, plus the characters
-
'-' and '_'.
-
-
Ids are used to identify JMAP objects within an account. They are assigned
-
by the server and are immutable once assigned. The same id MUST refer to
-
the same object throughout the lifetime of the object.
-
-
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.2> RFC 8620, Section 1.2 *)
-
module Id : sig
-
(** Abstract type representing a JMAP Id. *)
-
type t
-
-
(** JSON serialization interface *)
-
include Jmap_sigs.JSONABLE with type t := t
-
-
(** Pretty-printing interface *)
-
include Jmap_sigs.PRINTABLE with type t := t
-
-
(** {2 Construction and Access} *)
-
-
(** Create a new Id from a string.
-
@param str The string representation.
-
@return Ok with the created Id, or Error if the string violates Id constraints. *)
-
val of_string : string -> (t, string) result
-
-
(** Convert an Id to its string representation.
-
@param id The Id to convert.
-
@return The string representation. *)
-
val to_string : t -> string
-
-
(** Pretty-print an Id.
-
@param ppf The formatter.
-
@param id The Id to print. *)
-
val pp : Format.formatter -> t -> unit
-
-
(** {2 Validation} *)
-
-
(** Check if a string is a valid JMAP Id.
-
@param str The string to validate.
-
@return True if the string meets Id requirements, false otherwise. *)
-
val is_valid_string : string -> bool
-
-
(** Validate an Id according to JMAP constraints.
-
@param id The Id to validate.
-
@return Ok () if valid, Error with description if invalid. *)
-
val validate : t -> (unit, string) result
-
-
(** {2 Comparison and Utilities} *)
-
-
(** Compare two Ids for equality.
-
@param id1 First Id.
-
@param id2 Second Id.
-
@return True if equal, false otherwise. *)
-
val equal : t -> t -> bool
-
-
(** Compare two Ids lexicographically.
-
@param id1 First Id.
-
@param id2 Second Id.
-
@return Negative if id1 < id2, zero if equal, positive if id1 > id2. *)
-
val compare : t -> t -> int
-
-
(** Pretty-print an Id for debugging.
-
@param ppf The formatter.
-
@param id The Id to format. *)
-
val pp_debug : Format.formatter -> t -> unit
-
-
(** Convert an Id to a human-readable string for debugging.
-
@param id The Id to format.
-
@return A debug string representation. *)
-
val to_string_debug : t -> string
-
end
-
-
(** JMAP Date data type with RFC 3339 support and JSON serialization.
-
-
The Date data type is a string in RFC 3339 "date-time" format, optionally
-
with timezone information. For example: "2014-10-30T14:12:00+08:00" or
-
"2014-10-30T06:12:00Z".
-
-
In this OCaml implementation, dates are internally represented as Unix
-
timestamps (float) for efficient computation, with conversion to/from
-
RFC 3339 string format handled by the serialization functions.
-
-
{b Note}: When represented as a float, precision may be lost for sub-second
-
values. The implementation preserves second-level precision.
-
-
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.4> RFC 8620, Section 1.4
-
@see <https://www.rfc-editor.org/rfc/rfc3339.html> RFC 3339 *)
-
module Date : sig
-
(** Abstract type representing a JMAP Date. *)
-
type t
-
-
(** JSON serialization interface *)
-
include Jmap_sigs.JSONABLE with type t := t
-
-
(** Pretty-printing interface *)
-
include Jmap_sigs.PRINTABLE with type t := t
-
-
(** {2 Construction and Access} *)
-
-
(** Create a Date from a Unix timestamp.
-
@param timestamp The Unix timestamp (seconds since epoch).
-
@return A Date representing the timestamp. *)
-
val of_timestamp : float -> t
-
-
(** Convert a Date to a Unix timestamp.
-
@param date The Date to convert.
-
@return The Unix timestamp (seconds since epoch). *)
-
val to_timestamp : t -> float
-
-
(** Create a Date from an RFC 3339 string.
-
@param str The RFC 3339 formatted string.
-
@return Ok with the parsed Date, or Error if the string is not valid RFC 3339. *)
-
val of_rfc3339 : string -> (t, string) result
-
-
(** Convert a Date to an RFC 3339 string.
-
@param date The Date to convert.
-
@return The RFC 3339 formatted string. *)
-
val to_rfc3339 : t -> string
-
-
(** Create a Date representing the current time.
-
@return A Date set to the current time. *)
-
val now : unit -> t
-
-
(** {2 Validation} *)
-
-
(** Validate a Date according to JMAP constraints.
-
@param date The Date to validate.
-
@return Ok () if valid, Error with description if invalid. *)
-
val validate : t -> (unit, string) result
-
-
(** {2 Comparison and Utilities} *)
-
-
(** Compare two Dates for equality.
-
@param date1 First Date.
-
@param date2 Second Date.
-
@return True if equal (within 1 second precision), false otherwise. *)
-
val equal : t -> t -> bool
-
-
(** Compare two Dates chronologically.
-
@param date1 First Date.
-
@param date2 Second Date.
-
@return Negative if date1 < date2, zero if equal, positive if date1 > date2. *)
-
val compare : t -> t -> int
-
-
(** Check if first Date is before second Date.
-
@param date1 First Date.
-
@param date2 Second Date.
-
@return True if date1 is before date2. *)
-
val is_before : t -> t -> bool
-
-
(** Check if first Date is after second Date.
-
@param date1 First Date.
-
@param date2 Second Date.
-
@return True if date1 is after date2. *)
-
val is_after : t -> t -> bool
-
-
(** Pretty-print a Date in RFC3339 format.
-
@param ppf The formatter.
-
@param date The Date to print. *)
-
val pp : Format.formatter -> t -> unit
-
-
(** Pretty-print a Date for debugging.
-
@param ppf The formatter.
-
@param date The Date to format. *)
-
val pp_debug : Format.formatter -> t -> unit
-
-
(** Convert a Date to a human-readable string for debugging.
-
@param date The Date to format.
-
@return A debug string representation. *)
-
val to_string_debug : t -> string
-
end
-
-
(** JMAP UnsignedInt data type with range validation and JSON serialization.
-
-
The UnsignedInt data type is an unsigned integer in the range [0, 2^53-1].
-
This corresponds to the safe integer range for unsigned values in JavaScript
-
and JSON implementations.
-
-
In OCaml, this is represented as a regular [int]. Note that OCaml's [int]
-
on 64-bit platforms has a larger range, but JMAP protocol compliance
-
requires staying within the specified range and ensuring non-negative values.
-
-
Common uses include counts, limits, positions, and sizes within the protocol.
-
-
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.3> RFC 8620, Section 1.3 *)
-
module UInt : sig
-
(** Abstract type representing a JMAP UnsignedInt. *)
-
type t
-
-
(** JSON serialization interface *)
-
include Jmap_sigs.JSONABLE with type t := t
-
-
(** Pretty-printing interface *)
-
include Jmap_sigs.PRINTABLE with type t := t
-
-
(** {2 Construction and Access} *)
-
-
(** Create an UnsignedInt from an int.
-
@param i The int value.
-
@return Ok with the UnsignedInt, or Error if the value is negative or too large. *)
-
val of_int : int -> (t, string) result
-
-
(** Convert an UnsignedInt to an int.
-
@param uint The UnsignedInt to convert.
-
@return The int representation. *)
-
val to_int : t -> int
-
-
(** Create an UnsignedInt from a string.
-
@param str The string representation of a non-negative integer.
-
@return Ok with the UnsignedInt, or Error if parsing fails or value is invalid. *)
-
val of_string : string -> (t, string) result
-
-
(** Convert an UnsignedInt to a string.
-
@param uint The UnsignedInt to convert.
-
@return The string representation. *)
-
val to_string : t -> string
-
-
(** Pretty-print an UnsignedInt.
-
@param ppf The formatter.
-
@param uint The UnsignedInt to print. *)
-
val pp : Format.formatter -> t -> unit
-
-
(** {2 Constants} *)
-
-
(** Zero value. *)
-
val zero : t
-
-
(** One value. *)
-
val one : t
-
-
(** Maximum safe value (2^53 - 1). *)
-
val max_safe : t
-
-
(** {2 Validation} *)
-
-
(** Check if an int is a valid UnsignedInt value.
-
@param i The int to validate.
-
@return True if the value is in valid range, false otherwise. *)
-
val is_valid_int : int -> bool
-
-
(** Validate an UnsignedInt according to JMAP constraints.
-
@param uint The UnsignedInt to validate.
-
@return Ok () if valid, Error with description if invalid. *)
-
val validate : t -> (unit, string) result
-
-
(** {2 Arithmetic Operations} *)
-
-
(** Add two UnsignedInts.
-
@param uint1 First UnsignedInt.
-
@param uint2 Second UnsignedInt.
-
@return Ok with the sum, or Error if overflow would occur. *)
-
val add : t -> t -> (t, string) result
-
-
(** Subtract two UnsignedInts.
-
@param uint1 First UnsignedInt (minuend).
-
@param uint2 Second UnsignedInt (subtrahend).
-
@return Ok with the difference, or Error if result would be negative. *)
-
val sub : t -> t -> (t, string) result
-
-
(** Multiply two UnsignedInts.
-
@param uint1 First UnsignedInt.
-
@param uint2 Second UnsignedInt.
-
@return Ok with the product, or Error if overflow would occur. *)
-
val mul : t -> t -> (t, string) result
-
-
(** {2 Comparison and Utilities} *)
-
-
(** Compare two UnsignedInts for equality.
-
@param uint1 First UnsignedInt.
-
@param uint2 Second UnsignedInt.
-
@return True if equal, false otherwise. *)
-
val equal : t -> t -> bool
-
-
(** Compare two UnsignedInts numerically.
-
@param uint1 First UnsignedInt.
-
@param uint2 Second UnsignedInt.
-
@return Negative if uint1 < uint2, zero if equal, positive if uint1 > uint2. *)
-
val compare : t -> t -> int
-
-
(** Get the minimum of two UnsignedInts.
-
@param uint1 First UnsignedInt.
-
@param uint2 Second UnsignedInt.
-
@return The smaller value. *)
-
val min : t -> t -> t
-
-
(** Get the maximum of two UnsignedInts.
-
@param uint1 First UnsignedInt.
-
@param uint2 Second UnsignedInt.
-
@return The larger value. *)
-
val max : t -> t -> t
-
-
(** Pretty-print an UnsignedInt for debugging.
-
@param ppf The formatter.
-
@param uint The UnsignedInt to format. *)
-
val pp_debug : Format.formatter -> t -> unit
-
-
(** Convert an UnsignedInt to a human-readable string for debugging.
-
@param uint The UnsignedInt to format.
-
@return A debug string representation. *)
-
val to_string_debug : t -> string
-
end
-
-
(** JMAP Patch Object for property updates with JSON serialization.
-
-
A patch object is used to update properties of JMAP objects. It represents
-
a JSON object where each key is a property path (using JSON Pointer syntax)
-
and each value is the new value to set for that property, or null to remove
-
the property.
-
-
Patch objects are commonly used in /set method calls to update existing
-
objects without having to send the complete object representation.
-
-
Examples of patch operations:
-
- Setting a property: [{"name": "New Name"}]
-
- Removing a property: [{"oldProperty": null}]
-
- Setting nested properties: [{"address/street": "123 Main St"}]
-
-
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.3> RFC 8620, Section 5.3
-
@see <https://www.rfc-editor.org/rfc/rfc6901.html> RFC 6901 (JSON Pointer) *)
-
module Patch : sig
-
(** Abstract type representing a JMAP Patch Object. *)
-
type t
-
-
(** JSON serialization interface *)
-
include Jmap_sigs.JSONABLE with type t := t
-
-
(** Pretty-printing interface *)
-
include Jmap_sigs.PRINTABLE with type t := t
-
-
(** {2 Construction and Access} *)
-
-
(** Create an empty patch object.
-
@return An empty patch with no operations. *)
-
val empty : t
-
-
(** Create a patch from a list of property-value pairs.
-
@param operations List of (property_path, value) pairs.
-
@return Ok with the patch, or Error if any property path is invalid. *)
-
val of_operations : (string * Yojson.Safe.t) list -> (t, string) result
-
-
(** Convert a patch to a list of property-value pairs.
-
@param patch The patch to convert.
-
@return List of (property_path, value) pairs. *)
-
val to_operations : t -> (string * Yojson.Safe.t) list
-
-
(** Create a patch from a Yojson.Safe.t object directly.
-
@param json The JSON object.
-
@return Ok with the patch, or Error if the JSON is not a valid object. *)
-
val of_json_object : Yojson.Safe.t -> (t, string) result
-
-
(** Convert a patch to a Yojson.Safe.t object directly.
-
@param patch The patch to convert.
-
@return The JSON object representation. *)
-
val to_json_object : t -> Yojson.Safe.t
-
-
(** {2 Patch Operations} *)
-
-
(** Set a property in the patch.
-
@param patch The patch to modify.
-
@param property The property path (JSON Pointer format).
-
@param value The value to set.
-
@return Ok with the updated patch, or Error if the property path is invalid. *)
-
val set_property : t -> string -> Yojson.Safe.t -> (t, string) result
-
-
(** Remove a property in the patch (set to null).
-
@param patch The patch to modify.
-
@param property The property path to remove.
-
@return Ok with the updated patch, or Error if the property path is invalid. *)
-
val remove_property : t -> string -> (t, string) result
-
-
(** Check if a property is set in the patch.
-
@param patch The patch to check.
-
@param property The property path to check.
-
@return True if the property is explicitly set in the patch. *)
-
val has_property : t -> string -> bool
-
-
(** Get a property value from the patch.
-
@param patch The patch to query.
-
@param property The property path to get.
-
@return Some value if the property is set, None if not present. *)
-
val get_property : t -> string -> Yojson.Safe.t option
-
-
(** {2 Patch Composition} *)
-
-
(** Merge two patches, with the second patch taking precedence.
-
@param patch1 The first patch.
-
@param patch2 The second patch (higher precedence).
-
@return The merged patch. *)
-
val merge : t -> t -> t
-
-
(** Check if a patch is empty (no operations).
-
@param patch The patch to check.
-
@return True if the patch has no operations. *)
-
val is_empty : t -> bool
-
-
(** Get the number of operations in a patch.
-
@param patch The patch to count.
-
@return The number of property operations. *)
-
val size : t -> int
-
-
(** {2 Validation} *)
-
-
(** Validate a patch according to JMAP constraints.
-
@param patch The patch to validate.
-
@return Ok () if valid, Error with description if invalid. *)
-
val validate : t -> (unit, string) result
-
-
(** Validate a JSON Pointer path.
-
@param path The property path to validate.
-
@return True if the path is a valid JSON Pointer, false otherwise. *)
-
val is_valid_property_path : string -> bool
-
-
(** {2 Comparison and Utilities} *)
-
-
(** Compare two patches for equality.
-
@param patch1 First patch.
-
@param patch2 Second patch.
-
@return True if patches have identical operations, false otherwise. *)
-
val equal : t -> t -> bool
-
-
(** Convert a patch to a human-readable string for debugging.
-
@param patch The patch to format.
-
@return A debug string representation. *)
-
val to_string_debug : t -> string
-
end
-
-
(** {1 Legacy Types and Collections}
-
-
This section provides type aliases and collection types for compatibility
-
and common use cases throughout the JMAP protocol. These types maintain
-
backwards compatibility with existing code while the core types above
-
provide the preferred interface. *)
-
-
(** The Id data type (legacy alias - prefer {!Types.Id}).
-
-
A string of 1 to 255 octets in length and MUST consist only of characters
-
from the base64url alphabet, as defined in Section 5 of RFC 4648. This
-
includes ASCII alphanumeric characters, plus the characters '-' and '_'.
-
-
Ids are used to identify JMAP objects within an account. They are assigned
-
by the server and are immutable once assigned. The same id MUST refer to
-
the same object throughout the lifetime of the object.
-
-
{b Note}: In this OCaml implementation, ids are represented as regular strings.
-
Validation of id format is the responsibility of the client/server implementation.
-
-
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.2> RFC 8620, Section 1.2 *)
-
type id = string
-
-
(** The Int data type.
-
-
A signed 53-bit integer in the range [-2^53+1, 2^53-1]. This corresponds
-
to the safe integer range in JavaScript and JSON implementations.
-
-
In OCaml, this is represented as a regular [int]. Note that OCaml's [int]
-
on 64-bit platforms has a larger range, but JMAP protocol compliance
-
requires staying within the specified range.
-
-
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.3> RFC 8620, Section 1.3 *)
-
type jint = int
-
-
(** The UnsignedInt data type (legacy alias - prefer {!Types.UInt}).
-
-
An unsigned integer in the range [0, 2^53-1]. This is the same as [jint]
-
but restricted to non-negative values.
-
-
Common uses include counts, limits, positions, and sizes within the protocol.
-
-
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.3> RFC 8620, Section 1.3 *)
-
type uint = int
-
-
(** The Date data type (legacy alias - prefer {!Types.Date}).
-
-
A string in RFC 3339 "date-time" format, optionally with timezone information.
-
For example: "2014-10-30T14:12:00+08:00" or "2014-10-30T06:12:00Z".
-
-
In this OCaml implementation, dates are represented as Unix timestamps (float).
-
Conversion to/from RFC 3339 string format is handled by the wire protocol
-
serialization layer.
-
-
{b Note}: When represented as a float, precision may be lost for sub-second
-
values. Consider the precision requirements of your application.
-
-
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.4> RFC 8620, Section 1.4
-
@see <https://www.rfc-editor.org/rfc/rfc3339.html> RFC 3339 *)
-
type date = float
-
-
(** The UTCDate data type.
-
-
A string in RFC 3339 "date-time" format with timezone restricted to UTC
-
(i.e., ending with "Z"). For example: "2014-10-30T06:12:00Z".
-
-
This is a more restrictive version of the [date] type, used in contexts
-
where timezone normalization is required.
-
-
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.4> RFC 8620, Section 1.4 *)
-
type utc_date = float
-
-
(** {2 Collection Types} *)
-
-
(** Represents a JSON object used as a map from String to arbitrary values.
-
-
In JMAP, many objects are represented as maps with string keys. This type
-
provides a convenient OCaml representation using hash tables for efficient
-
lookup and modification.
-
-
{b Usage example}: Account capabilities, session capabilities, and various
-
property maps throughout the protocol.
-
-
@param 'v The type of values stored in the map *)
-
type 'v string_map = (string, 'v) Hashtbl.t
-
-
(** Represents a JSON object used as a map from Id to arbitrary values.
-
-
This is similar to [string_map] but specifically for JMAP Id keys. Common
-
use cases include mapping object IDs to objects, errors, or update information.
-
-
{b Usage example}: The "create" argument in /set methods maps client-assigned
-
IDs to objects to be created.
-
-
@param 'v The type of values stored in the map *)
-
type 'v id_map = (id, 'v) Hashtbl.t
-
-
(** {2 Protocol-Specific Types} *)
-
-
(** Represents a JSON Pointer path with JMAP extensions.
-
-
A JSON Pointer is a string syntax for identifying specific values within
-
a JSON document. JMAP extends this with additional syntax for referencing
-
values from previous method calls within the same request.
-
-
Examples of valid JSON pointers in JMAP:
-
- "/property" - References the "property" field in the root object
-
- "/items/0" - References the first item in the "items" array
-
- "*" - Represents all properties or all array elements
-
-
The pointer syntax is used extensively in result references and patch
-
operations within JMAP.
-
-
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.7> RFC 8620, Section 3.7
-
@see <https://www.rfc-editor.org/rfc/rfc6901.html> RFC 6901 (JSON Pointer) *)
-
type json_pointer = string
-
-
(** {2 Protocol Constants} *)
-
-
(** Protocol constants for common values.
-
-
This module contains commonly used constant values throughout the
-
JMAP protocol, reducing hardcoded strings and providing type safety. *)
-
module Constants : sig
-
(** VacationResponse singleton object ID.
-
-
VacationResponse objects always use this fixed ID per JMAP specification.
-
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7> RFC 8621, Section 7 *)
-
val vacation_response_id : string
-
-
(** HTTP Content-Type values for JMAP protocol. *)
-
module Content_type : sig
-
(** JMAP protocol content type. *)
-
val json : string
-
end
-
-
(** Default User-Agent strings. *)
-
module User_agent : sig
-
(** Default OCaml JMAP client user agent. *)
-
val ocaml_jmap : string
-
-
(** Eio-based client user agent. *)
-
val eio_client : string
-
end
-
end
+85
jmap/jmap/uint.ml
···
+
(** JMAP UnsignedInt Implementation *)
+
+
type t = int
+
+
(* Maximum safe integer value for JavaScript: 2^53 - 1 *)
+
let max_safe_value = 9007199254740991
+
+
let is_valid_int i = i >= 0 && i <= max_safe_value
+
+
let of_int i =
+
if is_valid_int i then Ok i
+
else if i < 0 then Error "UnsignedInt cannot be negative"
+
else Error "UnsignedInt cannot exceed 2^53-1"
+
+
let to_int uint = uint
+
+
let of_string str =
+
try
+
let i = int_of_string str in
+
of_int i
+
with
+
| Failure _ -> Error "Invalid integer string format"
+
| Invalid_argument _ -> Error "Invalid integer string format"
+
+
let to_string uint = string_of_int uint
+
+
let pp ppf uint = Format.fprintf ppf "%d" uint
+
+
let pp_hum ppf uint = Format.fprintf ppf "UInt(%d)" uint
+
+
(* Constants *)
+
let zero = 0
+
let one = 1
+
let max_safe = max_safe_value
+
+
let validate uint =
+
if is_valid_int uint then Ok ()
+
else Error "UnsignedInt value out of valid range"
+
+
(* Arithmetic operations with overflow checking *)
+
let add uint1 uint2 =
+
let result = uint1 + uint2 in
+
if result >= uint1 && result >= uint2 && is_valid_int result then
+
Ok result
+
else
+
Error "UnsignedInt addition overflow"
+
+
let sub uint1 uint2 =
+
if uint1 >= uint2 then Ok (uint1 - uint2)
+
else Error "UnsignedInt subtraction would result in negative value"
+
+
let mul uint1 uint2 =
+
if uint1 = 0 || uint2 = 0 then Ok 0
+
else if uint1 <= max_safe_value / uint2 then
+
Ok (uint1 * uint2)
+
else
+
Error "UnsignedInt multiplication overflow"
+
+
(* Comparison and utilities *)
+
let equal = (=)
+
+
let compare = compare
+
+
let min uint1 uint2 = if uint1 <= uint2 then uint1 else uint2
+
+
let max uint1 uint2 = if uint1 >= uint2 then uint1 else uint2
+
+
let pp_debug ppf uint = Format.fprintf ppf "UInt(%d)" uint
+
+
let to_string_debug uint = Printf.sprintf "UInt(%d)" uint
+
+
(* JSON serialization *)
+
let to_json uint = `Int uint
+
+
let of_json = function
+
| `Int i -> of_int i
+
| `Float f ->
+
(* Handle case where JSON parser represents integers as floats *)
+
if f >= 0.0 && f <= float_of_int max_safe_value && f = Float.round f then
+
of_int (int_of_float f)
+
else
+
Error "Float value is not a valid UnsignedInt"
+
| json ->
+
let json_str = Yojson.Safe.to_string json in
+
Error (Printf.sprintf "Expected JSON number for UnsignedInt, got: %s" json_str)
+128
jmap/jmap/uint.mli
···
+
(** JMAP UnsignedInt data type with range validation and JSON serialization.
+
+
The UnsignedInt data type is an unsigned integer in the range [0, 2^53-1].
+
This corresponds to the safe integer range for unsigned values in JavaScript
+
and JSON implementations.
+
+
In OCaml, this is represented as a regular [int]. Note that OCaml's [int]
+
on 64-bit platforms has a larger range, but JMAP protocol compliance
+
requires staying within the specified range and ensuring non-negative values.
+
+
Common uses include counts, limits, positions, and sizes within the protocol.
+
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.3> RFC 8620, Section 1.3 *)
+
+
(** Abstract type representing a JMAP UnsignedInt. *)
+
type t
+
+
(** JSON serialization interface *)
+
include Jmap_sigs.JSONABLE with type t := t
+
+
(** Pretty-printing interface *)
+
include Jmap_sigs.PRINTABLE with type t := t
+
+
(** {2 Construction and Access} *)
+
+
(** Create an UnsignedInt from an int.
+
@param i The int value.
+
@return Ok with the UnsignedInt, or Error if the value is negative or too large. *)
+
val of_int : int -> (t, string) result
+
+
(** Convert an UnsignedInt to an int.
+
@param uint The UnsignedInt to convert.
+
@return The int representation. *)
+
val to_int : t -> int
+
+
(** Create an UnsignedInt from a string.
+
@param str The string representation of a non-negative integer.
+
@return Ok with the UnsignedInt, or Error if parsing fails or value is invalid. *)
+
val of_string : string -> (t, string) result
+
+
(** Convert an UnsignedInt to a string.
+
@param uint The UnsignedInt to convert.
+
@return The string representation. *)
+
val to_string : t -> string
+
+
(** Pretty-print an UnsignedInt.
+
@param ppf The formatter.
+
@param uint The UnsignedInt to print. *)
+
val pp : Format.formatter -> t -> unit
+
+
(** {2 Constants} *)
+
+
(** Zero value. *)
+
val zero : t
+
+
(** One value. *)
+
val one : t
+
+
(** Maximum safe value (2^53 - 1). *)
+
val max_safe : t
+
+
(** {2 Validation} *)
+
+
(** Check if an int is a valid UnsignedInt value.
+
@param i The int to validate.
+
@return True if the value is in valid range, false otherwise. *)
+
val is_valid_int : int -> bool
+
+
(** Validate an UnsignedInt according to JMAP constraints.
+
@param uint The UnsignedInt to validate.
+
@return Ok () if valid, Error with description if invalid. *)
+
val validate : t -> (unit, string) result
+
+
(** {2 Arithmetic Operations} *)
+
+
(** Add two UnsignedInts.
+
@param uint1 First UnsignedInt.
+
@param uint2 Second UnsignedInt.
+
@return Ok with the sum, or Error if overflow would occur. *)
+
val add : t -> t -> (t, string) result
+
+
(** Subtract two UnsignedInts.
+
@param uint1 First UnsignedInt (minuend).
+
@param uint2 Second UnsignedInt (subtrahend).
+
@return Ok with the difference, or Error if result would be negative. *)
+
val sub : t -> t -> (t, string) result
+
+
(** Multiply two UnsignedInts.
+
@param uint1 First UnsignedInt.
+
@param uint2 Second UnsignedInt.
+
@return Ok with the product, or Error if overflow would occur. *)
+
val mul : t -> t -> (t, string) result
+
+
(** {2 Comparison and Utilities} *)
+
+
(** Compare two UnsignedInts for equality.
+
@param uint1 First UnsignedInt.
+
@param uint2 Second UnsignedInt.
+
@return True if equal, false otherwise. *)
+
val equal : t -> t -> bool
+
+
(** Compare two UnsignedInts numerically.
+
@param uint1 First UnsignedInt.
+
@param uint2 Second UnsignedInt.
+
@return Negative if uint1 < uint2, zero if equal, positive if uint1 > uint2. *)
+
val compare : t -> t -> int
+
+
(** Get the minimum of two UnsignedInts.
+
@param uint1 First UnsignedInt.
+
@param uint2 Second UnsignedInt.
+
@return The smaller value. *)
+
val min : t -> t -> t
+
+
(** Get the maximum of two UnsignedInts.
+
@param uint1 First UnsignedInt.
+
@param uint2 Second UnsignedInt.
+
@return The larger value. *)
+
val max : t -> t -> t
+
+
(** Pretty-print an UnsignedInt for debugging.
+
@param ppf The formatter.
+
@param uint The UnsignedInt to format. *)
+
val pp_debug : Format.formatter -> t -> unit
+
+
(** Convert an UnsignedInt to a human-readable string for debugging.
+
@param uint The UnsignedInt to format.
+
@return A debug string representation. *)
+
val to_string_debug : t -> string
+4 -4
jmap/jmap/wire.ml
···
-
open Types
+
(* Use underlying types directly to avoid circular dependency with Jmap module *)
module Invocation = struct
type t = {
···
type t = {
result_of : string;
name : string;
-
path : json_pointer;
+
path : string;
}
let result_of t = t.result_of
···
type t = {
using : string list;
method_calls : Invocation.t list;
-
created_ids : id id_map option;
+
created_ids : (string, string) Hashtbl.t option;
}
let using t = t.using
···
module Response = struct
type t = {
method_responses : response_invocation list;
-
created_ids : id id_map option;
+
created_ids : (string, string) Hashtbl.t option;
session_state : string;
}
+7 -7
jmap/jmap/wire.mli
···
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3> RFC 8620, Section 3 *)
-
open Types
+
(* Use underlying types directly to avoid circular dependency with Jmap module *)
(** {1 Method Invocations} *)
···
(** Get the JSON Pointer path within the referenced property.
@return The JSON Pointer path (e.g., "/0", "/items/5/id") *)
-
val path : t -> json_pointer
+
val path : t -> string
(** Create a new result reference.
@param result_of The method call ID to reference
···
val v :
result_of:string ->
name:string ->
-
path:json_pointer ->
+
path:string ->
unit ->
t
end
···
(** Get the optional createdIds map.
@return Map from client IDs to server IDs, if present *)
-
val created_ids : t -> id id_map option
+
val created_ids : t -> (string, string) Hashtbl.t option
(** Create a new request object.
@param using List of capability URIs required for this request
···
val v :
using:string list ->
method_calls:Invocation.t list ->
-
?created_ids:id id_map ->
+
?created_ids:(string, string) Hashtbl.t ->
unit ->
t
end
···
(** Get the optional createdIds map.
@return Map from client IDs to server IDs, if present *)
-
val created_ids : t -> id id_map option
+
val created_ids : t -> (string, string) Hashtbl.t option
(** Get the current session state.
@return Session state string for subsequent requests *)
···
@return A new response object *)
val v :
method_responses:response_invocation list ->
-
?created_ids:id id_map ->
+
?created_ids:(string, string) Hashtbl.t ->
session_state:string ->
unit ->
t
+3 -3
jmap/test_method.ml
···
let valid_id = Jmap.Types.Id.of_string "abc123-_xyz" in
match valid_id with
| Ok id ->
-
printf "✓ Created valid ID: %s\n" (Jmap.Types.Id.to_string id);
-
printf "✓ Debug representation: %s\n" (Jmap.Types.Id.to_string_debug id)
+
printf "✓ Created valid ID: %s\n" (stringo_string id);
+
printf "✓ Debug representation: %s\n" (stringo_string_debug id)
| Error msg ->
printf "✗ Failed to create valid ID: %s\n" msg
···
(* Test Id JSON roundtrip *)
(match Jmap.Types.Id.of_string "test123" with
| Ok id ->
-
let json = Jmap.Types.Id.to_json id in
+
let json = stringo_json id in
let parsed = Jmap.Types.Id.of_json json in
(match parsed with
| Ok parsed_id when Jmap.Types.Id.equal id parsed_id ->