this repo has no description
more
+378
-42
+59
-17
stack/jmap/CLAUDE.md
+59
-17
stack/jmap/CLAUDE.md
···
25
25
let req = Jmap_core.Jmap_request.Parser.of_json request_json in
26
26
```
27
27
28
-
### ✅ Good - Using the JMAP library API:
28
+
### ✅ Good - Using the typed JMAP library API:
29
29
```ocaml
30
-
(* Build query arguments *)
31
-
let query_args = `O [
32
-
("accountId", `String account_id);
33
-
("limit", `Float 10.);
34
-
("sort", `A [`O [("property", `String "receivedAt"); ("isAscending", `Bool false)]]);
35
-
("calculateTotal", `Bool true);
36
-
] in
30
+
(* Build Email/query request using typed constructors *)
31
+
let query_request = Jmap_mail.Jmap_email.Query.request_v
32
+
~account_id:(Jmap_core.Jmap_id.of_string account_id)
33
+
~limit:(Jmap_core.Jmap_primitives.UnsignedInt.of_int 10)
34
+
~sort:[Jmap_core.Jmap_comparator.v ~property:"receivedAt" ~is_ascending:false ()]
35
+
~calculate_total:true
36
+
() in
37
37
38
-
(* Create invocation using Echo witness for generic JSON *)
39
-
let invocation = Jmap_invocation.Invocation {
38
+
(* Convert to JSON *)
39
+
let query_args = Jmap_mail.Jmap_email.Query.request_to_json query_request in
40
+
41
+
(* Create invocation using Echo witness *)
42
+
let query_invocation = Jmap_core.Jmap_invocation.Invocation {
40
43
method_name = "Email/query";
41
44
arguments = query_args;
42
-
call_id = "c1";
43
-
witness = Jmap_invocation.Echo;
45
+
call_id = "q1";
46
+
witness = Jmap_core.Jmap_invocation.Echo;
44
47
} in
45
48
46
49
(* Build request using constructors *)
47
-
let req = Jmap_request.make
48
-
~using:[Jmap_capability.core; Jmap_capability.mail]
49
-
[Jmap_invocation.Packed invocation]
50
+
let req = Jmap_core.Jmap_request.make
51
+
~using:[Jmap_core.Jmap_capability.core; Jmap_core.Jmap_capability.mail]
52
+
[Jmap_core.Jmap_invocation.Packed query_invocation]
50
53
in
54
+
55
+
(* Make the call *)
56
+
let query_resp = Jmap_client.call client req in
57
+
58
+
(* Extract results using type-safe response_to_json *)
59
+
let method_responses = Jmap_core.Jmap_response.method_responses query_resp in
60
+
match method_responses with
61
+
| [packed_resp] ->
62
+
let response_json = Jmap_core.Jmap_invocation.response_to_json packed_resp in
63
+
(* Now parse response_json... *)
64
+
(match response_json with
65
+
| `O fields ->
66
+
(match List.assoc_opt "ids" fields with
67
+
| Some (`A ids) -> (* process ids... *)
68
+
| _ -> ())
69
+
| _ -> ())
70
+
| _ -> failwith "Unexpected response"
51
71
```
72
+
73
+
The key principles:
74
+
1. Use typed `request_v` constructors (e.g., `Email.Query.request_v`, `Email.Get.request_v`)
75
+
2. Convert typed requests to JSON with `request_to_json`
76
+
3. Wrap in invocations and build JMAP requests with `Jmap_request.make`
77
+
4. Use `Jmap_invocation.response_to_json` to safely extract response data from packed responses
52
78
53
79
## Architecture
54
80
···
105
131
## Current Limitations
106
132
107
133
- Full typed method support is partially implemented
108
-
- Some methods still use Echo witness with raw JSON arguments
109
-
- Response parsing extracts raw JSON rather than fully typed responses
134
+
- Methods use Echo witness with JSON arguments/responses (type-safe from user perspective)
135
+
- Response parsing stores raw JSON with Echo witness, then `response_to_json` provides type-safe access
136
+
137
+
### Type Safety - Zero Obj.magic
138
+
139
+
**The entire JMAP library is completely free of `Obj.magic`**. The library provides:
140
+
- `response_to_json` to safely extract responses from packed types
141
+
- Typed constructors for building requests
142
+
- Type-safe JSON conversion functions
143
+
144
+
The implementation uses Echo witness for all invocations/responses, storing `Ezjsonm.value` directly:
145
+
```ocaml
146
+
| Echo -> response (* response is already Ezjsonm.value - completely type-safe! *)
147
+
```
148
+
149
+
Non-Echo witness cases (Get, Query, etc.) immediately fail with descriptive error messages if called, ensuring that any misuse is caught immediately rather than silently corrupting data with unsafe casts.
150
+
151
+
When full typed witnesses are implemented in the future, proper serialization functions will be added to support them safely.
110
152
111
153
These will be improved as the library matures.
+41
-8
stack/jmap/jmap-core/jmap_invocation.ml
+41
-8
stack/jmap/jmap-core/jmap_invocation.ml
···
162
162
let args_json : Ezjsonm.value = match witness with
163
163
| Echo -> arguments (* Echo arguments are already Ezjsonm.value *)
164
164
| Get _ ->
165
-
(* For Get, need to serialize Get.request *)
166
-
(* For now, assume arguments is already JSON (hack from parsing) *)
167
-
(Obj.magic arguments : Ezjsonm.value)
168
-
| Changes _ -> (Obj.magic arguments : Ezjsonm.value)
169
-
| Set _ -> (Obj.magic arguments : Ezjsonm.value)
170
-
| Copy _ -> (Obj.magic arguments : Ezjsonm.value)
171
-
| Query _ -> (Obj.magic arguments : Ezjsonm.value)
172
-
| QueryChanges _ -> (Obj.magic arguments : Ezjsonm.value)
165
+
(* This code path should never execute - we only create invocations with Echo witness.
166
+
If it does execute, fail immediately rather than using unsafe magic. *)
167
+
failwith "to_json: Get witness not supported - use Echo witness with pre-serialized JSON"
168
+
| Changes _ ->
169
+
failwith "to_json: Changes witness not supported - use Echo witness with pre-serialized JSON"
170
+
| Set _ ->
171
+
failwith "to_json: Set witness not supported - use Echo witness with pre-serialized JSON"
172
+
| Copy _ ->
173
+
failwith "to_json: Copy witness not supported - use Echo witness with pre-serialized JSON"
174
+
| Query _ ->
175
+
failwith "to_json: Query witness not supported - use Echo witness with pre-serialized JSON"
176
+
| QueryChanges _ ->
177
+
failwith "to_json: QueryChanges witness not supported - use Echo witness with pre-serialized JSON"
173
178
in
174
179
`A [`String method_name; args_json; `String call_id]
180
+
181
+
(** Extract response data as JSON from a packed response.
182
+
This provides safe access to response data.
183
+
184
+
NOTE: Currently all responses are parsed with Echo witness and stored as
185
+
Ezjsonm.value, so only the Echo case executes. The other cases will fail
186
+
immediately if called - they should never execute in the current implementation. *)
187
+
let response_to_json : packed_response -> Ezjsonm.value = function
188
+
| PackedResponse (ResponseInvocation { response; witness; _ }) ->
189
+
(* Pattern match on witness to convert response to JSON type-safely *)
190
+
match witness with
191
+
| Echo ->
192
+
(* For Echo witness, response is already Ezjsonm.value - completely type-safe! *)
193
+
response
194
+
| Get _ ->
195
+
(* This code path should never execute - we only create responses with Echo witness.
196
+
If it does execute, fail immediately rather than using unsafe magic. *)
197
+
failwith "response_to_json: Get witness not supported - responses use Echo witness"
198
+
| Changes _ ->
199
+
failwith "response_to_json: Changes witness not supported - responses use Echo witness"
200
+
| Set _ ->
201
+
failwith "response_to_json: Set witness not supported - responses use Echo witness"
202
+
| Copy _ ->
203
+
failwith "response_to_json: Copy witness not supported - responses use Echo witness"
204
+
| Query _ ->
205
+
failwith "response_to_json: Query witness not supported - responses use Echo witness"
206
+
| QueryChanges _ ->
207
+
failwith "response_to_json: QueryChanges witness not supported - responses use Echo witness"
+3
stack/jmap/jmap-core/jmap_invocation.mli
+3
stack/jmap/jmap-core/jmap_invocation.mli
+163
stack/jmap/jmap-mail/jmap_email.ml
+163
stack/jmap/jmap-mail/jmap_email.ml
···
686
686
all_in_thread_have_keyword; some_in_thread_have_keyword;
687
687
none_in_thread_have_keyword; has_keyword; not_keyword; has_attachment;
688
688
text; from; to_; cc; bcc; subject; body; header }
689
+
690
+
(* Convert to JSON *)
691
+
let to_json t =
692
+
let fields = [] in
693
+
let fields = match t.in_mailbox with
694
+
| Some id -> ("inMailbox", Jmap_core.Jmap_id.to_json id) :: fields
695
+
| None -> fields
696
+
in
697
+
let fields = match t.in_mailbox_other_than with
698
+
| Some ids -> ("inMailboxOtherThan", `A (List.map Jmap_core.Jmap_id.to_json ids)) :: fields
699
+
| None -> fields
700
+
in
701
+
let fields = match t.before with
702
+
| Some d -> ("before", `String (Jmap_core.Jmap_primitives.UTCDate.to_string d)) :: fields
703
+
| None -> fields
704
+
in
705
+
let fields = match t.after with
706
+
| Some d -> ("after", `String (Jmap_core.Jmap_primitives.UTCDate.to_string d)) :: fields
707
+
| None -> fields
708
+
in
709
+
let fields = match t.min_size with
710
+
| Some s -> ("minSize", Jmap_core.Jmap_primitives.UnsignedInt.to_json s) :: fields
711
+
| None -> fields
712
+
in
713
+
let fields = match t.max_size with
714
+
| Some s -> ("maxSize", Jmap_core.Jmap_primitives.UnsignedInt.to_json s) :: fields
715
+
| None -> fields
716
+
in
717
+
let fields = match t.all_in_thread_have_keyword with
718
+
| Some k -> ("allInThreadHaveKeyword", `String k) :: fields
719
+
| None -> fields
720
+
in
721
+
let fields = match t.some_in_thread_have_keyword with
722
+
| Some k -> ("someInThreadHaveKeyword", `String k) :: fields
723
+
| None -> fields
724
+
in
725
+
let fields = match t.none_in_thread_have_keyword with
726
+
| Some k -> ("noneInThreadHaveKeyword", `String k) :: fields
727
+
| None -> fields
728
+
in
729
+
let fields = match t.has_keyword with
730
+
| Some k -> ("hasKeyword", `String k) :: fields
731
+
| None -> fields
732
+
in
733
+
let fields = match t.not_keyword with
734
+
| Some k -> ("notKeyword", `String k) :: fields
735
+
| None -> fields
736
+
in
737
+
let fields = match t.has_attachment with
738
+
| Some b -> ("hasAttachment", `Bool b) :: fields
739
+
| None -> fields
740
+
in
741
+
let fields = match t.text with
742
+
| Some s -> ("text", `String s) :: fields
743
+
| None -> fields
744
+
in
745
+
let fields = match t.from with
746
+
| Some s -> ("from", `String s) :: fields
747
+
| None -> fields
748
+
in
749
+
let fields = match t.to_ with
750
+
| Some s -> ("to", `String s) :: fields
751
+
| None -> fields
752
+
in
753
+
let fields = match t.cc with
754
+
| Some s -> ("cc", `String s) :: fields
755
+
| None -> fields
756
+
in
757
+
let fields = match t.bcc with
758
+
| Some s -> ("bcc", `String s) :: fields
759
+
| None -> fields
760
+
in
761
+
let fields = match t.subject with
762
+
| Some s -> ("subject", `String s) :: fields
763
+
| None -> fields
764
+
in
765
+
let fields = match t.body with
766
+
| Some s -> ("body", `String s) :: fields
767
+
| None -> fields
768
+
in
769
+
let fields = match t.header with
770
+
| Some hdrs ->
771
+
let hdr_arr = List.map (fun (name, value) ->
772
+
`O [("name", `String name); ("value", `String value)]
773
+
) hdrs in
774
+
("header", `A hdr_arr) :: fields
775
+
| None -> fields
776
+
in
777
+
`O fields
689
778
end
690
779
691
780
(** Standard /get method (RFC 8621 Section 4.2) *)
···
774
863
*)
775
864
let response_of_json json =
776
865
Jmap_core.Jmap_standard_methods.Get.response_of_json of_json json
866
+
867
+
(** Convert get request to JSON *)
868
+
let request_to_json req =
869
+
let fields = [
870
+
("accountId", Jmap_core.Jmap_id.to_json req.account_id);
871
+
] in
872
+
let fields = match req.ids with
873
+
| Some ids -> ("ids", `A (List.map Jmap_core.Jmap_id.to_json ids)) :: fields
874
+
| None -> fields
875
+
in
876
+
let fields = match req.properties with
877
+
| Some props -> ("properties", `A (List.map (fun s -> `String s) props)) :: fields
878
+
| None -> fields
879
+
in
880
+
let fields = match req.body_properties with
881
+
| Some bp -> ("bodyProperties", `A (List.map (fun s -> `String s) bp)) :: fields
882
+
| None -> fields
883
+
in
884
+
let fields = match req.fetch_text_body_values with
885
+
| Some ftbv -> ("fetchTextBodyValues", `Bool ftbv) :: fields
886
+
| None -> fields
887
+
in
888
+
let fields = match req.fetch_html_body_values with
889
+
| Some fhbv -> ("fetchHTMLBodyValues", `Bool fhbv) :: fields
890
+
| None -> fields
891
+
in
892
+
let fields = match req.fetch_all_body_values with
893
+
| Some fabv -> ("fetchAllBodyValues", `Bool fabv) :: fields
894
+
| None -> fields
895
+
in
896
+
let fields = match req.max_body_value_bytes with
897
+
| Some mbvb -> ("maxBodyValueBytes", Jmap_core.Jmap_primitives.UnsignedInt.to_json mbvb) :: fields
898
+
| None -> fields
899
+
in
900
+
`O fields
777
901
end
778
902
779
903
(** Standard /changes method (RFC 8621 Section 4.3) *)
···
871
995
Test files: test/data/mail/email_query_response.json *)
872
996
let response_of_json json =
873
997
Jmap_core.Jmap_standard_methods.Query.response_of_json json
998
+
999
+
(** Convert query request to JSON *)
1000
+
let request_to_json req =
1001
+
let fields = [
1002
+
("accountId", Jmap_core.Jmap_id.to_json req.account_id);
1003
+
] in
1004
+
let fields = match req.filter with
1005
+
| Some f -> ("filter", Jmap_core.Jmap_filter.to_json Filter.to_json f) :: fields
1006
+
| None -> fields
1007
+
in
1008
+
let fields = match req.sort with
1009
+
| Some s -> ("sort", `A (List.map Jmap_core.Jmap_comparator.to_json s)) :: fields
1010
+
| None -> fields
1011
+
in
1012
+
let fields = match req.position with
1013
+
| Some p -> ("position", Jmap_core.Jmap_primitives.Int53.to_json p) :: fields
1014
+
| None -> fields
1015
+
in
1016
+
let fields = match req.anchor with
1017
+
| Some a -> ("anchor", Jmap_core.Jmap_id.to_json a) :: fields
1018
+
| None -> fields
1019
+
in
1020
+
let fields = match req.anchor_offset with
1021
+
| Some ao -> ("anchorOffset", Jmap_core.Jmap_primitives.Int53.to_json ao) :: fields
1022
+
| None -> fields
1023
+
in
1024
+
let fields = match req.limit with
1025
+
| Some l -> ("limit", Jmap_core.Jmap_primitives.UnsignedInt.to_json l) :: fields
1026
+
| None -> fields
1027
+
in
1028
+
let fields = match req.calculate_total with
1029
+
| Some ct -> ("calculateTotal", `Bool ct) :: fields
1030
+
| None -> fields
1031
+
in
1032
+
let fields = match req.collapse_threads with
1033
+
| Some ct -> ("collapseThreads", `Bool ct) :: fields
1034
+
| None -> fields
1035
+
in
1036
+
`O fields
874
1037
end
875
1038
876
1039
(** Standard /queryChanges method (RFC 8621 Section 4.5) *)
+3
stack/jmap/jmap-mail/jmap_email.mli
+3
stack/jmap/jmap-mail/jmap_email.mli
···
269
269
t
270
270
271
271
val of_json : Ezjsonm.value -> t
272
+
val to_json : t -> Ezjsonm.value
272
273
end
273
274
274
275
(** Standard /get method *)
···
310
311
request
311
312
312
313
val request_of_json : Ezjsonm.value -> request
314
+
val request_to_json : request -> Ezjsonm.value
313
315
val response_of_json : Ezjsonm.value -> response
314
316
end
315
317
···
364
366
request
365
367
366
368
val request_of_json : Ezjsonm.value -> request
369
+
val request_to_json : request -> Ezjsonm.value
367
370
val response_of_json : Ezjsonm.value -> response
368
371
end
369
372
+109
-17
stack/jmap/test/test_fastmail.ml
+109
-17
stack/jmap/test/test_fastmail.ml
···
68
68
in
69
69
Printf.printf " Account ID: %s\n\n%!" account_id;
70
70
71
-
(* Build a JMAP request using the library API *)
71
+
(* Build a JMAP request using the typed library API *)
72
72
Printf.printf "Querying for 10 most recent emails...\n";
73
73
Printf.printf " API URL: %s\n%!" (Jmap_core.Jmap_session.api_url session);
74
74
75
-
(* Build query arguments *)
76
-
let query_args = `O [
77
-
("accountId", `String account_id);
78
-
("limit", `Float 10.);
79
-
("sort", `A [`O [("property", `String "receivedAt"); ("isAscending", `Bool false)]]);
80
-
("calculateTotal", `Bool true);
81
-
] in
75
+
(* Build Email/query request using typed constructors *)
76
+
let query_request = Jmap_mail.Jmap_email.Query.request_v
77
+
~account_id:(Jmap_core.Jmap_id.of_string account_id)
78
+
~limit:(Jmap_core.Jmap_primitives.UnsignedInt.of_int 10)
79
+
~sort:[Jmap_core.Jmap_comparator.v ~property:"receivedAt" ~is_ascending:false ()]
80
+
~calculate_total:true
81
+
() in
82
82
83
-
(* Create invocation using Echo witness for generic JSON *)
84
-
let invocation = Jmap_core.Jmap_invocation.Invocation {
83
+
(* Convert to JSON *)
84
+
let query_args = Jmap_mail.Jmap_email.Query.request_to_json query_request in
85
+
86
+
(* Create invocation using Echo witness *)
87
+
let query_invocation = Jmap_core.Jmap_invocation.Invocation {
85
88
method_name = "Email/query";
86
89
arguments = query_args;
87
-
call_id = "c1";
90
+
call_id = "q1";
88
91
witness = Jmap_core.Jmap_invocation.Echo;
89
92
} in
90
93
91
94
(* Build request using constructors *)
92
95
let req = Jmap_core.Jmap_request.make
93
96
~using:[Jmap_core.Jmap_capability.core; Jmap_core.Jmap_capability.mail]
94
-
[Jmap_core.Jmap_invocation.Packed invocation]
97
+
[Jmap_core.Jmap_invocation.Packed query_invocation]
95
98
in
96
99
97
-
Printf.printf " Request built using JMAP library API\n%!";
100
+
Printf.printf " Request built using typed Email.Query API\n%!";
98
101
99
102
Printf.printf " Making API call...\n%!";
100
103
(try
101
-
let resp = Jmap_client.call client req in
104
+
let query_resp = Jmap_client.call client req in
102
105
Printf.printf "✓ Query successful!\n";
103
-
Printf.printf " Session state: %s\n" (Jmap_core.Jmap_response.session_state resp);
104
-
Printf.printf "\n✓ Test completed successfully!\n%!"
106
+
107
+
(* Extract email IDs from the query response *)
108
+
let method_responses = Jmap_core.Jmap_response.method_responses query_resp in
109
+
let email_ids = match method_responses with
110
+
| [packed_resp] ->
111
+
let response_json = Jmap_core.Jmap_invocation.response_to_json packed_resp in
112
+
(match response_json with
113
+
| `O fields ->
114
+
(match List.assoc_opt "ids" fields with
115
+
| Some (`A ids) ->
116
+
List.map (fun id ->
117
+
match id with
118
+
| `String s -> Jmap_core.Jmap_id.of_string s
119
+
| _ -> failwith "Expected string ID"
120
+
) ids
121
+
| _ -> failwith "No 'ids' field in query response")
122
+
| _ -> failwith "Expected object response")
123
+
| _ -> failwith "Unexpected response structure"
124
+
in
125
+
126
+
Printf.printf " Found %d email(s)\n\n%!" (List.length email_ids);
127
+
128
+
if List.length email_ids > 0 then (
129
+
(* Fetch the actual emails with Email/get *)
130
+
let get_request = Jmap_mail.Jmap_email.Get.request_v
131
+
~account_id:(Jmap_core.Jmap_id.of_string account_id)
132
+
~ids:email_ids
133
+
~properties:["id"; "subject"; "from"; "receivedAt"]
134
+
() in
135
+
136
+
let get_args = Jmap_mail.Jmap_email.Get.request_to_json get_request in
137
+
138
+
let get_invocation = Jmap_core.Jmap_invocation.Invocation {
139
+
method_name = "Email/get";
140
+
arguments = get_args;
141
+
call_id = "g1";
142
+
witness = Jmap_core.Jmap_invocation.Echo;
143
+
} in
144
+
145
+
let get_req = Jmap_core.Jmap_request.make
146
+
~using:[Jmap_core.Jmap_capability.core; Jmap_core.Jmap_capability.mail]
147
+
[Jmap_core.Jmap_invocation.Packed get_invocation]
148
+
in
149
+
150
+
let get_resp = Jmap_client.call client get_req in
151
+
152
+
(* Parse and display emails *)
153
+
let get_method_responses = Jmap_core.Jmap_response.method_responses get_resp in
154
+
(match get_method_responses with
155
+
| [packed_resp] ->
156
+
let response_json = Jmap_core.Jmap_invocation.response_to_json packed_resp in
157
+
(match response_json with
158
+
| `O fields ->
159
+
(match List.assoc_opt "list" fields with
160
+
| Some (`A emails) ->
161
+
Printf.printf "Recent emails:\n\n";
162
+
List.iteri (fun i email_json ->
163
+
match email_json with
164
+
| `O email_fields ->
165
+
let subject = match List.assoc_opt "subject" email_fields with
166
+
| Some (`String s) -> s
167
+
| _ -> "(no subject)"
168
+
in
169
+
let from = match List.assoc_opt "from" email_fields with
170
+
| Some (`A []) -> "(unknown sender)"
171
+
| Some (`A ((`O addr_fields)::_)) ->
172
+
(match List.assoc_opt "email" addr_fields with
173
+
| Some (`String e) ->
174
+
(match List.assoc_opt "name" addr_fields with
175
+
| Some (`String n) -> Printf.sprintf "%s <%s>" n e
176
+
| _ -> e)
177
+
| _ -> "(unknown)")
178
+
| _ -> "(unknown sender)"
179
+
in
180
+
let date = match List.assoc_opt "receivedAt" email_fields with
181
+
| Some (`String d) -> d
182
+
| _ -> "(unknown date)"
183
+
in
184
+
Printf.printf "%d. %s\n" (i + 1) subject;
185
+
Printf.printf " From: %s\n" from;
186
+
Printf.printf " Date: %s\n\n" date
187
+
| _ -> ()
188
+
) emails
189
+
| _ -> Printf.printf "No emails in response\n")
190
+
| _ -> Printf.printf "Unexpected response format\n")
191
+
| _ -> Printf.printf "Unexpected method response structure\n");
192
+
193
+
Printf.printf "\n✓ Test completed successfully!\n%!"
194
+
) else (
195
+
Printf.printf "No emails found\n";
196
+
Printf.printf "\n✓ Test completed successfully!\n%!"
197
+
)
105
198
with
106
199
| Failure msg when String.starts_with ~prefix:"JMAP API call failed: HTTP" msg ->
107
200
Printf.eprintf "API call failed with error: %s\n" msg;
108
201
Printf.eprintf "This likely means the request JSON is malformed.\n";
109
-
Printf.eprintf "Check the request JSON above.\n";
110
202
exit 1
111
203
| e ->
112
204
Printf.eprintf "Error making API call: %s\n%!" (Printexc.to_string e);