Convert to polymorphic variants and add extended keywords/roles

- Convert filter operator, error types, mailbox roles, and submission
statuses from regular variants to polymorphic variants
- Add draft-ietf-mailmaint extended keywords: $notify, $muted, $followed,
$memo, $hasmemo, $hasattachment, $hasnoattachment, $autosent,
$unsubscribed, $canunsubscribe, $imported, $istrusted, $maskedemail, $new
- Add Apple Mail flag color keywords ($MailFlagBit0/1/2) with flag_color
type and conversion functions
- Add extended mailbox roles: snoozed, scheduled, memos
- Add RFC 8621 submission-specific errors: forbiddenMailFrom,
forbiddenFrom, forbiddenToSend

🤖 Generated with [Claude Code](https://claude.com/claude-code)

Co-Authored-By: Claude Opus 4.5 <[e-mail]>

bin/jmap.ml

···
             (* Find inbox *)
             let inbox =
               List.find_opt (fun (m : Jmap.Proto.Mailbox.t) ->
-                m.role = Some Jmap.Proto.Mailbox.Inbox
+                m.role = Some `Inbox
               ) mbox_result.list
             in
             match inbox with

lib/core/jmap.ml

···
   let is_subscribed m = Proto.Mailbox.is_subscribed m
 
   let role m =
-    let convert_role = function
-      | Proto.Mailbox.Inbox -> `Inbox
-      | Proto.Mailbox.Sent -> `Sent
-      | Proto.Mailbox.Drafts -> `Drafts
-      | Proto.Mailbox.Trash -> `Trash
-      | Proto.Mailbox.Junk -> `Junk
-      | Proto.Mailbox.Archive -> `Archive
-      | Proto.Mailbox.Flagged -> `Flagged
-      | Proto.Mailbox.Important -> `Important
-      | Proto.Mailbox.All -> `All
-      | Proto.Mailbox.Subscribed -> `Subscribed
-      | Proto.Mailbox.Other s -> `Custom s
+    (* Proto.Mailbox.role now returns polymorphic variants directly *)
+    let convert_role : Proto.Mailbox.role -> Role.t = function
+      | `Inbox -> `Inbox
+      | `Sent -> `Sent
+      | `Drafts -> `Drafts
+      | `Trash -> `Trash
+      | `Junk -> `Junk
+      | `Archive -> `Archive
+      | `Flagged -> `Flagged
+      | `Important -> `Important
+      | `All -> `All
+      | `Subscribed -> `Subscribed
+      | `Snoozed -> `Snoozed
+      | `Scheduled -> `Scheduled
+      | `Memos -> `Memos
+      | `Other s -> `Custom s
     in
     Option.map convert_role (Proto.Mailbox.role m)
 
···
 module Mailbox_filter = struct
   type condition = Proto.Mailbox.Filter_condition.t
 
-  let convert_role = function
-    | `Inbox -> Proto.Mailbox.Inbox
-    | `Sent -> Proto.Mailbox.Sent
-    | `Drafts -> Proto.Mailbox.Drafts
-    | `Trash -> Proto.Mailbox.Trash
-    | `Junk -> Proto.Mailbox.Junk
-    | `Archive -> Proto.Mailbox.Archive
-    | `Flagged -> Proto.Mailbox.Flagged
-    | `Important -> Proto.Mailbox.Important
-    | `All -> Proto.Mailbox.All
-    | `Subscribed -> Proto.Mailbox.Subscribed
-    | `Custom s -> Proto.Mailbox.Other s
+  let convert_role : Role.t -> Proto.Mailbox.role = function
+    | `Inbox -> `Inbox
+    | `Sent -> `Sent
+    | `Drafts -> `Drafts
+    | `Trash -> `Trash
+    | `Junk -> `Junk
+    | `Archive -> `Archive
+    | `Flagged -> `Flagged
+    | `Important -> `Important
+    | `All -> `All
+    | `Subscribed -> `Subscribed
+    | `Snoozed -> `Snoozed
+    | `Scheduled -> `Scheduled
+    | `Memos -> `Memos
+    | `Custom s -> `Other s
 
   (** Create a mailbox filter condition.
 

lib/core/jmap.mli

···
     Standard keywords are represented as polymorphic variants.
     Custom keywords use [`Custom of string]. *)
 module Keyword : sig
-  type t = [
+  (** RFC 8621 standard keywords *)
+  type standard = [
     | `Seen
     | `Flagged
     | `Answered
···
     | `Phishing
     | `Junk
     | `NotJunk
+  ]
+
+  (** draft-ietf-mailmaint extended keywords *)
+  type extended = [
+    | `Notify
+    | `Muted
+    | `Followed
+    | `Memo
+    | `HasMemo
+    | `HasAttachment
+    | `HasNoAttachment
+    | `AutoSent
+    | `Unsubscribed
+    | `CanUnsubscribe
+    | `Imported
+    | `IsTrusted
+    | `MaskedEmail
+    | `New
+  ]
+
+  (** Apple Mail flag color keywords *)
+  type flag_bits = [
+    | `MailFlagBit0
+    | `MailFlagBit1
+    | `MailFlagBit2
+  ]
+
+  type t = [
+    | standard
+    | extended
+    | flag_bits
     | `Custom of string
   ]
 
   val of_string : string -> t
   val to_string : t -> string
   val pp : Format.formatter -> t -> unit
+
+  (** Apple Mail flag colors *)
+  type flag_color = [
+    | `Red
+    | `Orange
+    | `Yellow
+    | `Green
+    | `Blue
+    | `Purple
+    | `Gray
+  ]
+
+  val flag_color_of_keywords : t list -> flag_color option
+  (** [flag_color_of_keywords keywords] extracts the flag color from a list
+      of keywords. Returns [None] for invalid bit combinations. *)
+
+  val flag_color_to_keywords : flag_color -> t list
+  (** [flag_color_to_keywords color] returns the keywords to set for the color. *)
 end
 
 (** Mailbox role type.
···
     Standard roles are represented as polymorphic variants.
     Custom roles use [`Custom of string]. *)
 module Role : sig
-  type t = [
+  (** RFC 8621 standard roles *)
+  type standard = [
     | `Inbox
     | `Sent
     | `Drafts
···
     | `Important
     | `All
     | `Subscribed
+  ]
+
+  (** draft-ietf-mailmaint extended roles *)
+  type extended = [
+    | `Snoozed
+    | `Scheduled
+    | `Memos
+  ]
+
+  type t = [
+    | standard
+    | extended
     | `Custom of string
   ]
 

lib/core/jmap_types.ml

···
 (** {1 Keyword Type} *)
 
 module Keyword = struct
-  type t = [
+  (** RFC 8621 standard keywords *)
+  type standard = [
     | `Seen
     | `Flagged
     | `Answered
···
     | `Phishing
     | `Junk
     | `NotJunk
+  ]
+
+  (** draft-ietf-mailmaint extended keywords *)
+  type extended = [
+    | `Notify
+    | `Muted
+    | `Followed
+    | `Memo
+    | `HasMemo
+    | `HasAttachment
+    | `HasNoAttachment
+    | `AutoSent
+    | `Unsubscribed
+    | `CanUnsubscribe
+    | `Imported
+    | `IsTrusted
+    | `MaskedEmail
+    | `New
+  ]
+
+  (** Apple Mail flag color keywords *)
+  type flag_bits = [
+    | `MailFlagBit0
+    | `MailFlagBit1
+    | `MailFlagBit2
+  ]
+
+  type t = [
+    | standard
+    | extended
+    | flag_bits
     | `Custom of string
   ]
 
   let of_string = function
+    (* RFC 8621 standard keywords *)
     | "$seen" -> `Seen
     | "$flagged" -> `Flagged
     | "$answered" -> `Answered
···
     | "$phishing" -> `Phishing
     | "$junk" -> `Junk
     | "$notjunk" -> `NotJunk
+    (* draft-ietf-mailmaint extended keywords *)
+    | "$notify" -> `Notify
+    | "$muted" -> `Muted
+    | "$followed" -> `Followed
+    | "$memo" -> `Memo
+    | "$hasmemo" -> `HasMemo
+    | "$hasattachment" -> `HasAttachment
+    | "$hasnoattachment" -> `HasNoAttachment
+    | "$autosent" -> `AutoSent
+    | "$unsubscribed" -> `Unsubscribed
+    | "$canunsubscribe" -> `CanUnsubscribe
+    | "$imported" -> `Imported
+    | "$istrusted" -> `IsTrusted
+    | "$maskedemail" -> `MaskedEmail
+    | "$new" -> `New
+    (* Apple Mail flag color keywords *)
+    | "$MailFlagBit0" -> `MailFlagBit0
+    | "$MailFlagBit1" -> `MailFlagBit1
+    | "$MailFlagBit2" -> `MailFlagBit2
     | s -> `Custom s
 
   let to_string = function
+    (* RFC 8621 standard keywords *)
     | `Seen -> "$seen"
     | `Flagged -> "$flagged"
     | `Answered -> "$answered"
···
     | `Phishing -> "$phishing"
     | `Junk -> "$junk"
     | `NotJunk -> "$notjunk"
+    (* draft-ietf-mailmaint extended keywords *)
+    | `Notify -> "$notify"
+    | `Muted -> "$muted"
+    | `Followed -> "$followed"
+    | `Memo -> "$memo"
+    | `HasMemo -> "$hasmemo"
+    | `HasAttachment -> "$hasattachment"
+    | `HasNoAttachment -> "$hasnoattachment"
+    | `AutoSent -> "$autosent"
+    | `Unsubscribed -> "$unsubscribed"
+    | `CanUnsubscribe -> "$canunsubscribe"
+    | `Imported -> "$imported"
+    | `IsTrusted -> "$istrusted"
+    | `MaskedEmail -> "$maskedemail"
+    | `New -> "$new"
+    (* Apple Mail flag color keywords *)
+    | `MailFlagBit0 -> "$MailFlagBit0"
+    | `MailFlagBit1 -> "$MailFlagBit1"
+    | `MailFlagBit2 -> "$MailFlagBit2"
     | `Custom s -> s
 
   let pp ppf k = Format.pp_print_string ppf (to_string k)
+
+  (** Apple Mail flag colors *)
+  type flag_color = [
+    | `Red
+    | `Orange
+    | `Yellow
+    | `Green
+    | `Blue
+    | `Purple
+    | `Gray
+  ]
+
+  let flag_color_of_keywords (keywords : t list) : flag_color option =
+    let has k = List.mem k keywords in
+    let bit0 = has `MailFlagBit0 in
+    let bit1 = has `MailFlagBit1 in
+    let bit2 = has `MailFlagBit2 in
+    match (bit0, bit1, bit2) with
+    | (false, false, false) -> Some `Red
+    | (true, false, false) -> Some `Orange
+    | (false, true, false) -> Some `Yellow
+    | (true, true, true) -> Some `Green
+    | (false, false, true) -> Some `Blue
+    | (true, false, true) -> Some `Purple
+    | (false, true, true) -> Some `Gray
+    | (true, true, false) -> None
+
+  let flag_color_to_keywords : flag_color -> t list = function
+    | `Red -> []
+    | `Orange -> [`MailFlagBit0]
+    | `Yellow -> [`MailFlagBit1]
+    | `Green -> [`MailFlagBit0; `MailFlagBit1; `MailFlagBit2]
+    | `Blue -> [`MailFlagBit2]
+    | `Purple -> [`MailFlagBit0; `MailFlagBit2]
+    | `Gray -> [`MailFlagBit1; `MailFlagBit2]
 end
 
 (** {1 Mailbox Role Type} *)
 
 module Role = struct
-  type t = [
+  (** RFC 8621 standard roles *)
+  type standard = [
     | `Inbox
     | `Sent
     | `Drafts
···
     | `Important
     | `All
     | `Subscribed
+  ]
+
+  (** draft-ietf-mailmaint extended roles *)
+  type extended = [
+    | `Snoozed
+    | `Scheduled
+    | `Memos
+  ]
+
+  type t = [
+    | standard
+    | extended
     | `Custom of string
   ]
 
   let of_string = function
+    (* RFC 8621 standard roles *)
     | "inbox" -> `Inbox
     | "sent" -> `Sent
     | "drafts" -> `Drafts
···
     | "important" -> `Important
     | "all" -> `All
     | "subscribed" -> `Subscribed
+    (* draft-ietf-mailmaint extended roles *)
+    | "snoozed" -> `Snoozed
+    | "scheduled" -> `Scheduled
+    | "memos" -> `Memos
     | s -> `Custom s
 
   let to_string = function
+    (* RFC 8621 standard roles *)
     | `Inbox -> "inbox"
     | `Sent -> "sent"
     | `Drafts -> "drafts"
···
     | `Important -> "important"
     | `All -> "all"
     | `Subscribed -> "subscribed"
+    (* draft-ietf-mailmaint extended roles *)
+    | `Snoozed -> "snoozed"
+    | `Scheduled -> "scheduled"
+    | `Memos -> "memos"
     | `Custom s -> s
 
   let pp ppf r = Format.pp_print_string ppf (to_string r)

lib/mail/mail_email.ml

···
   ---------------------------------------------------------------------------*)
 
 module Keyword = struct
+  (* RFC 8621 Standard Keywords *)
   let draft = "$draft"
   let seen = "$seen"
   let flagged = "$flagged"
···
   let phishing = "$phishing"
   let junk = "$junk"
   let not_junk = "$notjunk"
+
+  (* draft-ietf-mailmaint Extended Keywords *)
+  let notify = "$notify"
+  let muted = "$muted"
+  let followed = "$followed"
+  let memo = "$memo"
+  let has_memo = "$hasmemo"
+  let has_attachment = "$hasattachment"
+  let has_no_attachment = "$hasnoattachment"
+  let auto_sent = "$autosent"
+  let unsubscribed = "$unsubscribed"
+  let can_unsubscribe = "$canunsubscribe"
+  let imported = "$imported"
+  let is_trusted = "$istrusted"
+  let masked_email = "$maskedemail"
+  let new_ = "$new"
+
+  (* Apple Mail Flag Color Keywords *)
+  let mail_flag_bit0 = "$MailFlagBit0"
+  let mail_flag_bit1 = "$MailFlagBit1"
+  let mail_flag_bit2 = "$MailFlagBit2"
+
+  type flag_color = [
+    | `Red
+    | `Orange
+    | `Yellow
+    | `Green
+    | `Blue
+    | `Purple
+    | `Gray
+  ]
+
+  (* Flag color bitmask:
+     - 000 = red, 100 = orange, 010 = yellow, 111 = green
+     - 001 = blue, 101 = purple, 011 = gray *)
+  let flag_color_to_keywords = function
+    | `Red -> []  (* 000 - no bits set *)
+    | `Orange -> [mail_flag_bit0]  (* 100 *)
+    | `Yellow -> [mail_flag_bit1]  (* 010 *)
+    | `Green -> [mail_flag_bit0; mail_flag_bit1; mail_flag_bit2]  (* 111 *)
+    | `Blue -> [mail_flag_bit2]  (* 001 *)
+    | `Purple -> [mail_flag_bit0; mail_flag_bit2]  (* 101 *)
+    | `Gray -> [mail_flag_bit1; mail_flag_bit2]  (* 011 *)
+
+  let flag_color_of_keywords keywords =
+    let has k = List.mem k keywords in
+    let bit0 = has mail_flag_bit0 in
+    let bit1 = has mail_flag_bit1 in
+    let bit2 = has mail_flag_bit2 in
+    match (bit0, bit1, bit2) with
+    | (false, false, false) -> Some `Red
+    | (true, false, false) -> Some `Orange
+    | (false, true, false) -> Some `Yellow
+    | (true, true, true) -> Some `Green
+    | (false, false, true) -> Some `Blue
+    | (true, false, true) -> Some `Purple
+    | (false, true, true) -> Some `Gray
+    | (true, true, false) -> None  (* Invalid combination *)
 end
 
 type t = {

lib/mail/mail_email.mli

···
 
 (** {1 Standard Keywords} *)
 
-(** Standard email keywords per RFC 8621. *)
+(** Standard email keywords per RFC 8621 and draft-ietf-mailmaint.
+
+    Keywords are stored as strings in JMAP, but these constants provide
+    type-safe access to standard keywords. *)
 module Keyword : sig
+
+  (** {2 RFC 8621 Standard Keywords} *)
+
   val draft : string
-  (** ["$draft"] *)
+  (** ["$draft"] - The Email is a draft the user is composing. *)
 
   val seen : string
-  (** ["$seen"] *)
+  (** ["$seen"] - The Email has been read. *)
 
   val flagged : string
-  (** ["$flagged"] *)
+  (** ["$flagged"] - The Email has been flagged for urgent/special attention. *)
 
   val answered : string
-  (** ["$answered"] *)
+  (** ["$answered"] - The Email has been replied to. *)
 
   val forwarded : string
-  (** ["$forwarded"] *)
+  (** ["$forwarded"] - The Email has been forwarded. *)
 
   val phishing : string
-  (** ["$phishing"] *)
+  (** ["$phishing"] - The Email is highly likely to be phishing. *)
 
   val junk : string
-  (** ["$junk"] *)
+  (** ["$junk"] - The Email is definitely spam. *)
 
   val not_junk : string
-  (** ["$notjunk"] *)
+  (** ["$notjunk"] - The Email is definitely not spam. *)
+
+  (** {2 draft-ietf-mailmaint Extended Keywords} *)
+
+  val notify : string
+  (** ["$notify"] - A notification should be shown for this message. *)
+
+  val muted : string
+  (** ["$muted"] - The user is not interested in future replies to this thread. *)
+
+  val followed : string
+  (** ["$followed"] - The user is particularly interested in future replies
+      to this thread. Mutually exclusive with muted. *)
+
+  val memo : string
+  (** ["$memo"] - The message is a note-to-self regarding another message
+      in the same thread. *)
+
+  val has_memo : string
+  (** ["$hasmemo"] - The message has an associated memo with the $memo keyword. *)
+
+  val has_attachment : string
+  (** ["$hasattachment"] - The message has an attachment (server-set). *)
+
+  val has_no_attachment : string
+  (** ["$hasnoattachment"] - The message does not have an attachment (server-set). *)
+
+  val auto_sent : string
+  (** ["$autosent"] - The message was sent automatically as a response
+      due to a user rule or setting (e.g., vacation response). *)
+
+  val unsubscribed : string
+  (** ["$unsubscribed"] - The client has unsubscribed from this mailing list. *)
+
+  val can_unsubscribe : string
+  (** ["$canunsubscribe"] - The message has an RFC8058-compliant
+      List-Unsubscribe header. *)
+
+  val imported : string
+  (** ["$imported"] - The message was imported from another mailbox. *)
+
+  val is_trusted : string
+  (** ["$istrusted"] - The authenticity of the from name and email address
+      have been verified with complete confidence by the server. *)
+
+  val masked_email : string
+  (** ["$maskedemail"] - The message was received via an alias created for
+      an individual sender to hide the user's real email address. *)
+
+  val new_ : string
+  (** ["$new"] - The message should be made more prominent to the user
+      due to a recent action (e.g., awakening from snooze). *)
+
+  (** {2 Apple Mail Flag Color Keywords}
+
+      These 3 keywords form a 3-bit bitmask defining the flag color:
+      - 000 = red, 100 = orange, 010 = yellow, 111 = green
+      - 001 = blue, 101 = purple, 011 = gray
+
+      These are only meaningful when the message has the $flagged keyword set. *)
+
+  val mail_flag_bit0 : string
+  (** ["$MailFlagBit0"] - Bit 0 of the flag color bitmask. *)
+
+  val mail_flag_bit1 : string
+  (** ["$MailFlagBit1"] - Bit 1 of the flag color bitmask. *)
+
+  val mail_flag_bit2 : string
+  (** ["$MailFlagBit2"] - Bit 2 of the flag color bitmask. *)
+
+  (** {2 Flag Color Type}
+
+      High-level type for working with Apple Mail flag colors. *)
+
+  type flag_color = [
+    | `Red      (** Bits: 000 *)
+    | `Orange   (** Bits: 100 *)
+    | `Yellow   (** Bits: 010 *)
+    | `Green    (** Bits: 111 *)
+    | `Blue     (** Bits: 001 *)
+    | `Purple   (** Bits: 101 *)
+    | `Gray     (** Bits: 011 *)
+  ]
+
+  val flag_color_to_keywords : flag_color -> string list
+  (** [flag_color_to_keywords color] returns the list of $MailFlagBit keywords
+      that should be set for the given color. *)
+
+  val flag_color_of_keywords : string list -> flag_color option
+  (** [flag_color_of_keywords keywords] extracts the flag color from a list
+      of keywords, if the $MailFlagBit keywords are present. Returns [None]
+      if no color bits are set (defaults to red when $flagged is set). *)
 end
 
 (** {1 Email Object} *)

lib/mail/mail_mailbox.ml

···
     |> Jsont.Object.finish
 end
 
-type role =
-  | All
-  | Archive
-  | Drafts
-  | Flagged
-  | Important
-  | Inbox
-  | Junk
-  | Sent
-  | Subscribed
-  | Trash
-  | Other of string
+type role = [
+  | `All
+  | `Archive
+  | `Drafts
+  | `Flagged
+  | `Important
+  | `Inbox
+  | `Junk
+  | `Sent
+  | `Subscribed
+  | `Trash
+  | `Snoozed
+  | `Scheduled
+  | `Memos
+  | `Other of string
+]
 
 let role_to_string = function
-  | All -> "all"
-  | Archive -> "archive"
-  | Drafts -> "drafts"
-  | Flagged -> "flagged"
-  | Important -> "important"
-  | Inbox -> "inbox"
-  | Junk -> "junk"
-  | Sent -> "sent"
-  | Subscribed -> "subscribed"
-  | Trash -> "trash"
-  | Other s -> s
+  | `All -> "all"
+  | `Archive -> "archive"
+  | `Drafts -> "drafts"
+  | `Flagged -> "flagged"
+  | `Important -> "important"
+  | `Inbox -> "inbox"
+  | `Junk -> "junk"
+  | `Sent -> "sent"
+  | `Subscribed -> "subscribed"
+  | `Trash -> "trash"
+  | `Snoozed -> "snoozed"
+  | `Scheduled -> "scheduled"
+  | `Memos -> "memos"
+  | `Other s -> s
 
 let role_of_string = function
-  | "all" -> All
-  | "archive" -> Archive
-  | "drafts" -> Drafts
-  | "flagged" -> Flagged
-  | "important" -> Important
-  | "inbox" -> Inbox
-  | "junk" -> Junk
-  | "sent" -> Sent
-  | "subscribed" -> Subscribed
-  | "trash" -> Trash
-  | s -> Other s
+  | "all" -> `All
+  | "archive" -> `Archive
+  | "drafts" -> `Drafts
+  | "flagged" -> `Flagged
+  | "important" -> `Important
+  | "inbox" -> `Inbox
+  | "junk" -> `Junk
+  | "sent" -> `Sent
+  | "subscribed" -> `Subscribed
+  | "trash" -> `Trash
+  | "snoozed" -> `Snoozed
+  | "scheduled" -> `Scheduled
+  | "memos" -> `Memos
+  | s -> `Other s
 
 let role_jsont =
   Jsont.map ~kind:"MailboxRole"

lib/mail/mail_mailbox.mli

···
 
 (** {1 Standard Roles} *)
 
-(** Standard mailbox roles per RFC 8621 Section 2. *)
-type role =
-  | All
-  | Archive
-  | Drafts
-  | Flagged
-  | Important
-  | Inbox
-  | Junk
-  | Sent
-  | Subscribed
-  | Trash
-  | Other of string
+(** Standard mailbox roles per RFC 8621 Section 2 and draft-ietf-mailmaint. *)
+type role = [
+  | `All
+  | `Archive
+  | `Drafts
+  | `Flagged
+  | `Important
+  | `Inbox
+  | `Junk
+  | `Sent
+  | `Subscribed
+  | `Trash
+  | `Snoozed     (** draft-ietf-mailmaint: Messages snoozed until a later time. *)
+  | `Scheduled   (** draft-ietf-mailmaint: Messages scheduled to send. *)
+  | `Memos       (** draft-ietf-mailmaint: Messages with the $memo keyword. *)
+  | `Other of string
+]
 
 val role_to_string : role -> string
 val role_of_string : string -> role

lib/mail/mail_submission.ml

···
 end
 
 module Delivery_status = struct
-  type delivered = Queued | Yes | No | Unknown
+  type delivered = [ `Queued | `Yes | `No | `Unknown ]
 
   let delivered_to_string = function
-    | Queued -> "queued"
-    | Yes -> "yes"
-    | No -> "no"
-    | Unknown -> "unknown"
+    | `Queued -> "queued"
+    | `Yes -> "yes"
+    | `No -> "no"
+    | `Unknown -> "unknown"
 
   let delivered_of_string = function
-    | "queued" -> Queued
-    | "yes" -> Yes
-    | "no" -> No
-    | _ -> Unknown
+    | "queued" -> `Queued
+    | "yes" -> `Yes
+    | "no" -> `No
+    | _ -> `Unknown
 
   let delivered_jsont =
     Jsont.map ~kind:"DeliveryStatus.delivered"
       ~dec:delivered_of_string ~enc:delivered_to_string Jsont.string
 
-  type displayed = Unknown | Yes
+  type displayed = [ `Unknown | `Yes ]
 
   let displayed_to_string = function
-    | Unknown -> "unknown"
-    | Yes -> "yes"
+    | `Unknown -> "unknown"
+    | `Yes -> "yes"
 
   let displayed_of_string = function
-    | "yes" -> Yes
-    | _ -> Unknown
+    | "yes" -> `Yes
+    | _ -> `Unknown
 
   let displayed_jsont =
     Jsont.map ~kind:"DeliveryStatus.displayed"
···
     |> Jsont.Object.finish
 end
 
-type undo_status = Pending | Final | Canceled
+type undo_status = [ `Pending | `Final | `Canceled ]
 
 let undo_status_to_string = function
-  | Pending -> "pending"
-  | Final -> "final"
-  | Canceled -> "canceled"
+  | `Pending -> "pending"
+  | `Final -> "final"
+  | `Canceled -> "canceled"
 
 let undo_status_of_string = function
-  | "pending" -> Pending
-  | "final" -> Final
-  | "canceled" -> Canceled
+  | "pending" -> `Pending
+  | "final" -> `Final
+  | "canceled" -> `Canceled
   | s -> Jsont.Error.msgf Jsont.Meta.none "Unknown undo status: %s" s
 
 let undo_status_jsont =

lib/mail/mail_submission.mli

···
 
 (** Status of delivery to a recipient. *)
 module Delivery_status : sig
-  type delivered =
-    | Queued
-    | Yes
-    | No
-    | Unknown
+  type delivered = [
+    | `Queued
+    | `Yes
+    | `No
+    | `Unknown
+  ]
 
-  type displayed =
-    | Unknown
-    | Yes
+  type displayed = [
+    | `Unknown
+    | `Yes
+  ]
 
   type t = {
     smtp_reply : string;
···
 
 (** {1 Undo Status} *)
 
-type undo_status =
-  | Pending
-  | Final
-  | Canceled
+type undo_status = [
+  | `Pending
+  | `Final
+  | `Canceled
+]
 
 val undo_status_jsont : undo_status Jsont.t
 

lib/proto/proto_error.ml

···
   ---------------------------------------------------------------------------*)
 
 module Request_error = struct
-  type urn =
-    | Unknown_capability
-    | Not_json
-    | Not_request
-    | Limit
-    | Other of string
+  type urn = [
+    | `Unknown_capability
+    | `Not_json
+    | `Not_request
+    | `Limit
+    | `Other of string
+  ]
 
   let urn_to_string = function
-    | Unknown_capability -> "urn:ietf:params:jmap:error:unknownCapability"
-    | Not_json -> "urn:ietf:params:jmap:error:notJSON"
-    | Not_request -> "urn:ietf:params:jmap:error:notRequest"
-    | Limit -> "urn:ietf:params:jmap:error:limit"
-    | Other s -> s
+    | `Unknown_capability -> "urn:ietf:params:jmap:error:unknownCapability"
+    | `Not_json -> "urn:ietf:params:jmap:error:notJSON"
+    | `Not_request -> "urn:ietf:params:jmap:error:notRequest"
+    | `Limit -> "urn:ietf:params:jmap:error:limit"
+    | `Other s -> s
 
   let urn_of_string = function
-    | "urn:ietf:params:jmap:error:unknownCapability" -> Unknown_capability
-    | "urn:ietf:params:jmap:error:notJSON" -> Not_json
-    | "urn:ietf:params:jmap:error:notRequest" -> Not_request
-    | "urn:ietf:params:jmap:error:limit" -> Limit
-    | s -> Other s
+    | "urn:ietf:params:jmap:error:unknownCapability" -> `Unknown_capability
+    | "urn:ietf:params:jmap:error:notJSON" -> `Not_json
+    | "urn:ietf:params:jmap:error:notRequest" -> `Not_request
+    | "urn:ietf:params:jmap:error:limit" -> `Limit
+    | s -> `Other s
 
   let urn_jsont =
     let kind = "Request error URN" in
···
     |> Jsont.Object.finish
 end
 
-type method_error_type =
-  | Server_unavailable
-  | Server_fail
-  | Server_partial_fail
-  | Unknown_method
-  | Invalid_arguments
-  | Invalid_result_reference
-  | Forbidden
-  | Account_not_found
-  | Account_not_supported_by_method
-  | Account_read_only
-  | Other of string
+type method_error_type = [
+  | `Server_unavailable
+  | `Server_fail
+  | `Server_partial_fail
+  | `Unknown_method
+  | `Invalid_arguments
+  | `Invalid_result_reference
+  | `Forbidden
+  | `Account_not_found
+  | `Account_not_supported_by_method
+  | `Account_read_only
+  | `Other of string
+]
 
 let method_error_type_to_string = function
-  | Server_unavailable -> "serverUnavailable"
-  | Server_fail -> "serverFail"
-  | Server_partial_fail -> "serverPartialFail"
-  | Unknown_method -> "unknownMethod"
-  | Invalid_arguments -> "invalidArguments"
-  | Invalid_result_reference -> "invalidResultReference"
-  | Forbidden -> "forbidden"
-  | Account_not_found -> "accountNotFound"
-  | Account_not_supported_by_method -> "accountNotSupportedByMethod"
-  | Account_read_only -> "accountReadOnly"
-  | Other s -> s
+  | `Server_unavailable -> "serverUnavailable"
+  | `Server_fail -> "serverFail"
+  | `Server_partial_fail -> "serverPartialFail"
+  | `Unknown_method -> "unknownMethod"
+  | `Invalid_arguments -> "invalidArguments"
+  | `Invalid_result_reference -> "invalidResultReference"
+  | `Forbidden -> "forbidden"
+  | `Account_not_found -> "accountNotFound"
+  | `Account_not_supported_by_method -> "accountNotSupportedByMethod"
+  | `Account_read_only -> "accountReadOnly"
+  | `Other s -> s
 
 let method_error_type_of_string = function
-  | "serverUnavailable" -> Server_unavailable
-  | "serverFail" -> Server_fail
-  | "serverPartialFail" -> Server_partial_fail
-  | "unknownMethod" -> Unknown_method
-  | "invalidArguments" -> Invalid_arguments
-  | "invalidResultReference" -> Invalid_result_reference
-  | "forbidden" -> Forbidden
-  | "accountNotFound" -> Account_not_found
-  | "accountNotSupportedByMethod" -> Account_not_supported_by_method
-  | "accountReadOnly" -> Account_read_only
-  | s -> Other s
+  | "serverUnavailable" -> `Server_unavailable
+  | "serverFail" -> `Server_fail
+  | "serverPartialFail" -> `Server_partial_fail
+  | "unknownMethod" -> `Unknown_method
+  | "invalidArguments" -> `Invalid_arguments
+  | "invalidResultReference" -> `Invalid_result_reference
+  | "forbidden" -> `Forbidden
+  | "accountNotFound" -> `Account_not_found
+  | "accountNotSupportedByMethod" -> `Account_not_supported_by_method
+  | "accountReadOnly" -> `Account_read_only
+  | s -> `Other s
 
 let method_error_type_jsont =
   let kind = "Method error type" in
···
   |> Jsont.Object.opt_mem "description" Jsont.string ~enc:method_error_description
   |> Jsont.Object.finish
 
-type set_error_type =
-  | Forbidden
-  | Over_quota
-  | Too_large
-  | Rate_limit
-  | Not_found
-  | Invalid_patch
-  | Will_destroy
-  | Invalid_properties
-  | Singleton
-  | Other of string
+type set_error_type = [
+  | `Forbidden
+  | `Over_quota
+  | `Too_large
+  | `Rate_limit
+  | `Not_found
+  | `Invalid_patch
+  | `Will_destroy
+  | `Invalid_properties
+  | `Singleton
+  | `Forbidden_mail_from
+  | `Forbidden_from
+  | `Forbidden_to_send
+  | `Other of string
+]
 
 let set_error_type_to_string = function
-  | Forbidden -> "forbidden"
-  | Over_quota -> "overQuota"
-  | Too_large -> "tooLarge"
-  | Rate_limit -> "rateLimit"
-  | Not_found -> "notFound"
-  | Invalid_patch -> "invalidPatch"
-  | Will_destroy -> "willDestroy"
-  | Invalid_properties -> "invalidProperties"
-  | Singleton -> "singleton"
-  | Other s -> s
+  | `Forbidden -> "forbidden"
+  | `Over_quota -> "overQuota"
+  | `Too_large -> "tooLarge"
+  | `Rate_limit -> "rateLimit"
+  | `Not_found -> "notFound"
+  | `Invalid_patch -> "invalidPatch"
+  | `Will_destroy -> "willDestroy"
+  | `Invalid_properties -> "invalidProperties"
+  | `Singleton -> "singleton"
+  | `Forbidden_mail_from -> "forbiddenMailFrom"
+  | `Forbidden_from -> "forbiddenFrom"
+  | `Forbidden_to_send -> "forbiddenToSend"
+  | `Other s -> s
 
 let set_error_type_of_string = function
-  | "forbidden" -> Forbidden
-  | "overQuota" -> Over_quota
-  | "tooLarge" -> Too_large
-  | "rateLimit" -> Rate_limit
-  | "notFound" -> Not_found
-  | "invalidPatch" -> Invalid_patch
-  | "willDestroy" -> Will_destroy
-  | "invalidProperties" -> Invalid_properties
-  | "singleton" -> Singleton
-  | s -> Other s
+  | "forbidden" -> `Forbidden
+  | "overQuota" -> `Over_quota
+  | "tooLarge" -> `Too_large
+  | "rateLimit" -> `Rate_limit
+  | "notFound" -> `Not_found
+  | "invalidPatch" -> `Invalid_patch
+  | "willDestroy" -> `Will_destroy
+  | "invalidProperties" -> `Invalid_properties
+  | "singleton" -> `Singleton
+  | "forbiddenMailFrom" -> `Forbidden_mail_from
+  | "forbiddenFrom" -> `Forbidden_from
+  | "forbiddenToSend" -> `Forbidden_to_send
+  | s -> `Other s
 
 let set_error_type_jsont =
   let kind = "SetError type" in

lib/proto/proto_error.mli

···
 
 (** Request-level error URNs *)
 module Request_error : sig
-  type urn =
-    | Unknown_capability
+  type urn = [
+    | `Unknown_capability
     (** urn:ietf:params:jmap:error:unknownCapability
         The client included a capability in "using" that the server does not support. *)
-    | Not_json
+    | `Not_json
     (** urn:ietf:params:jmap:error:notJSON
         The content type was not application/json or the request was not valid JSON. *)
-    | Not_request
+    | `Not_request
     (** urn:ietf:params:jmap:error:notRequest
         The request was valid JSON but not a valid JMAP Request object. *)
-    | Limit
+    | `Limit
     (** urn:ietf:params:jmap:error:limit
         A server-defined limit was reached. *)
-    | Other of string
+    | `Other of string
     (** Other URN not in the standard set. *)
+  ]
 
   val urn_to_string : urn -> string
   (** [urn_to_string urn] returns the URN string. *)
···
     when a method call fails. *)
 
 (** Standard method error types per RFC 8620 Section 3.6.2 *)
-type method_error_type =
-  | Server_unavailable
+type method_error_type = [
+  | `Server_unavailable
   (** The server is temporarily unavailable. *)
-  | Server_fail
+  | `Server_fail
   (** An unexpected error occurred. *)
-  | Server_partial_fail
+  | `Server_partial_fail
   (** Some, but not all, changes were successfully made. *)
-  | Unknown_method
+  | `Unknown_method
   (** The method name is not recognized. *)
-  | Invalid_arguments
+  | `Invalid_arguments
   (** One or more arguments are invalid. *)
-  | Invalid_result_reference
+  | `Invalid_result_reference
   (** A result reference could not be resolved. *)
-  | Forbidden
+  | `Forbidden
   (** The method/arguments are valid but forbidden. *)
-  | Account_not_found
+  | `Account_not_found
   (** The accountId does not correspond to a valid account. *)
-  | Account_not_supported_by_method
+  | `Account_not_supported_by_method
   (** The account does not support this method. *)
-  | Account_read_only
+  | `Account_read_only
   (** The account is read-only. *)
-  | Other of string
+  | `Other of string
   (** Other error type not in the standard set. *)
+]
 
 val method_error_type_to_string : method_error_type -> string
 (** [method_error_type_to_string t] returns the type string. *)
···
 
     Errors returned in notCreated/notUpdated/notDestroyed responses. *)
 
-(** Standard SetError types per RFC 8620 Section 5.3 *)
-type set_error_type =
-  | Forbidden
+(** Standard SetError types per RFC 8620 Section 5.3 and RFC 8621 Section 7 *)
+type set_error_type = [
+  | `Forbidden
   (** The operation is not permitted. *)
-  | Over_quota
+  | `Over_quota
   (** The maximum server quota has been reached. *)
-  | Too_large
+  | `Too_large
   (** The object is too large. *)
-  | Rate_limit
+  | `Rate_limit
   (** Too many objects of this type have been created recently. *)
-  | Not_found
+  | `Not_found
   (** The id does not exist (for update/destroy). *)
-  | Invalid_patch
+  | `Invalid_patch
   (** The PatchObject is invalid. *)
-  | Will_destroy
+  | `Will_destroy
   (** The object will be destroyed by another operation in the request. *)
-  | Invalid_properties
+  | `Invalid_properties
   (** Some properties were invalid. *)
-  | Singleton
+  | `Singleton
   (** Only one object of this type can exist (for create). *)
-  | Other of string
+  | `Forbidden_mail_from
+  (** RFC 8621: The server does not permit the user to send from the address. *)
+  | `Forbidden_from
+  (** RFC 8621: The server does not permit the user to send a message with
+      the From header of the message to be sent. *)
+  | `Forbidden_to_send
+  (** RFC 8621: The user does not have permission to send at all. *)
+  | `Other of string
   (** Other error type. *)
+]
 
 val set_error_type_to_string : set_error_type -> string
 val set_error_type_of_string : string -> set_error_type

lib/proto/proto_filter.ml

···
    SPDX-License-Identifier: ISC
   ---------------------------------------------------------------------------*)
 
-type operator = And | Or | Not
+type operator = [ `And | `Or | `Not ]
 
 let operator_to_string = function
-  | And -> "AND"
-  | Or -> "OR"
-  | Not -> "NOT"
+  | `And -> "AND"
+  | `Or -> "OR"
+  | `Not -> "NOT"
 
 let operator_of_string = function
-  | "AND" -> And
-  | "OR" -> Or
-  | "NOT" -> Not
+  | "AND" -> `And
+  | "OR" -> `Or
+  | "NOT" -> `Not
   | s -> Jsont.Error.msgf Jsont.Meta.none "Unknown filter operator: %s" s
 
 let operator_jsont =

lib/proto/proto_filter.mli

···
 (** {1 Filter Operators} *)
 
 (** Filter operator types. *)
-type operator =
-  | And  (** All conditions must match *)
-  | Or   (** At least one condition must match *)
-  | Not  (** Inverts a single condition *)
+type operator = [
+  | `And  (** All conditions must match *)
+  | `Or   (** At least one condition must match *)
+  | `Not  (** Inverts a single condition *)
+]
 
 val operator_jsont : operator Jsont.t
 (** JSON codec for filter operators. *)

test/proto/test_proto.ml

···
     match decode Error.method_error_jsont json with
     | Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)
     | Ok err ->
-        Alcotest.(check method_error_type_testable) "type" Error.Unknown_method err.type_
+        Alcotest.(check method_error_type_testable) "type" `Unknown_method err.type_
 
   (* Additional error type tests *)
   let test_set_error_forbidden () =
···
     match decode Error.set_error_jsont json with
     | Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)
     | Ok err ->
-        Alcotest.(check set_error_type_testable) "type" Error.Invalid_properties err.Error.type_;
+        Alcotest.(check set_error_type_testable) "type" `Invalid_properties err.Error.type_;
         match err.Error.properties with
         | None -> Alcotest.fail "expected properties"
         | Some props -> Alcotest.(check int) "properties count" 2 (List.length props)
···
     | Ok mb ->
         Alcotest.(check string) "id" "mb1" (Jmap.Proto.Id.to_string (Mailbox.id mb));
         Alcotest.(check string) "name" "Inbox" (Mailbox.name mb);
-        Alcotest.(check (option role_testable)) "role" (Some Mailbox.Inbox) (Mailbox.role mb);
+        Alcotest.(check (option role_testable)) "role" (Some `Inbox) (Mailbox.role mb);
         Alcotest.(check int64) "totalEmails" 150L (Mailbox.total_emails mb);
         Alcotest.(check int64) "unreadEmails" 5L (Mailbox.unread_emails mb)
 
···
     match decode Mailbox.jsont json with
     | Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)
     | Ok mb ->
-        Alcotest.(check (option role_testable)) "role" (Some Mailbox.Archive) (Mailbox.role mb);
+        Alcotest.(check (option role_testable)) "role" (Some `Archive) (Mailbox.role mb);
         Alcotest.(check int64) "totalEmails" 1000L (Mailbox.total_emails mb)
 
   let tests = [
···
         Alcotest.(check string) "id" "sub1" (Jmap.Proto.Id.to_string (Submission.id sub));
         (* Check undoStatus is Pending *)
         match Submission.undo_status sub with
-        | Submission.Pending -> ()
+        | `Pending -> ()
         | _ -> Alcotest.fail "expected undoStatus to be pending"
 
   let tests = [