jon.recoil.org
forked from
anil.recoil.org/ocaml-imap
IMAP in OCaml
1(*---------------------------------------------------------------------------
2 Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3 SPDX-License-Identifier: ISC
4 ---------------------------------------------------------------------------*)
5
6(** FETCH Items
7
8 Fetch data items for the FETCH command as specified in RFC 9051 Section 6.4.5. *)
9
10(** {1 Request Items} *)
11
12type request =
13 | Envelope
14 | Flags
15 | Internaldate
16 | Rfc822
17 | Rfc822_size
18 | Rfc822_header
19 | Rfc822_text
20 | Uid
21 | Body
22 | Bodystructure
23 | Body_section of string * (int * int) option
24 | Body_peek of string * (int * int) option
25 | Binary of string * (int * int) option
26 | Binary_peek of string * (int * int) option
27 | Binary_size of string
28 | Modseq (** Request MODSEQ value - RFC 7162 CONDSTORE *)
29
30let pp_request ppf = function
31 | Envelope -> Fmt.string ppf "ENVELOPE"
32 | Flags -> Fmt.string ppf "FLAGS"
33 | Internaldate -> Fmt.string ppf "INTERNALDATE"
34 | Rfc822 -> Fmt.string ppf "RFC822"
35 | Rfc822_size -> Fmt.string ppf "RFC822.SIZE"
36 | Rfc822_header -> Fmt.string ppf "RFC822.HEADER"
37 | Rfc822_text -> Fmt.string ppf "RFC822.TEXT"
38 | Uid -> Fmt.string ppf "UID"
39 | Body -> Fmt.string ppf "BODY"
40 | Bodystructure -> Fmt.string ppf "BODYSTRUCTURE"
41 | Body_section (s, _) -> Fmt.pf ppf "BODY[%s]" s
42 | Body_peek (s, _) -> Fmt.pf ppf "BODY.PEEK[%s]" s
43 | Binary (s, _) -> Fmt.pf ppf "BINARY[%s]" s
44 | Binary_peek (s, _) -> Fmt.pf ppf "BINARY.PEEK[%s]" s
45 | Binary_size s -> Fmt.pf ppf "BINARY.SIZE[%s]" s
46 | Modseq -> Fmt.string ppf "MODSEQ"
47
48(** {1 Response Items} *)
49
50type response =
51 | Item_envelope of Envelope.t
52 | Item_flags of Flag.t list
53 | Item_internaldate of string
54 | Item_rfc822_size of int64
55 | Item_uid of int64
56 | Item_modseq of int64
57 | Item_body of Body.t
58 | Item_bodystructure of Body.t
59 | Item_body_section of {
60 section : Body.section option;
61 origin : int option;
62 data : string option;
63 }
64 | Item_binary of { section : int list; data : string option }
65 | Item_binary_size of { section : int list; size : int64 }
66
67(** {1 Parsed Message} *)
68
69type message = {
70 seq : int;
71 uid : int64 option;
72 flags : Flag.t list option;
73 envelope : Envelope.t option;
74 body_structure : Body.t option;
75 internaldate : string option;
76 size : int64 option;
77 modseq : int64 option;
78 body_section : string option;
79}
80
81let empty_message =
82 {
83 seq = 0;
84 uid = None;
85 flags = None;
86 envelope = None;
87 body_structure = None;
88 internaldate = None;
89 size = None;
90 modseq = None;
91 body_section = None;
92 }
93
94let message_of_items seq items =
95 List.fold_left
96 (fun msg item ->
97 match item with
98 | Item_uid u -> { msg with uid = Some u }
99 | Item_flags f -> { msg with flags = Some f }
100 | Item_envelope e -> { msg with envelope = Some e }
101 | Item_body b | Item_bodystructure b -> { msg with body_structure = Some b }
102 | Item_internaldate d -> { msg with internaldate = Some d }
103 | Item_rfc822_size s -> { msg with size = Some s }
104 | Item_modseq m -> { msg with modseq = Some m }
105 | Item_body_section { data; _ } -> { msg with body_section = data }
106 | _ -> msg)
107 { empty_message with seq }
108 items