My agentic slop goes here. Not intended for anyone else!
anil.recoil.org
1(** JMAP Invocation with Type-Safe Method Dispatch
2
3 Invocations use GADTs to ensure compile-time type safety between
4 method calls and their responses.
5
6 An Invocation is a 3-tuple: [method_name, arguments, call_id]
7
8 Reference: RFC 8620 Section 3.2
9 Test files: test/data/core/request_echo.json (methodCalls field)
10*)
11
12(** Method witness type - encodes the relationship between
13 method names and their argument/response types.
14
15 This GADT ensures that for each method, we know:
16 - What type the arguments should have
17 - What type the response will have
18*)
19type ('args, 'resp) method_witness =
20 (* Core methods *)
21 | Echo : (Ezjsonm.value, Ezjsonm.value) method_witness
22
23 (* Standard methods - polymorphic over object type *)
24 | Get : string -> ('a Jmap_standard_methods.Get.request, 'a Jmap_standard_methods.Get.response) method_witness
25 | Changes : string -> (Jmap_standard_methods.Changes.request, Jmap_standard_methods.Changes.response) method_witness
26 | Set : string -> ('a Jmap_standard_methods.Set.request, 'a Jmap_standard_methods.Set.response) method_witness
27 | Copy : string -> ('a Jmap_standard_methods.Copy.request, 'a Jmap_standard_methods.Copy.response) method_witness
28 | Query : string -> ('f Jmap_standard_methods.Query.request, Jmap_standard_methods.Query.response) method_witness
29 | QueryChanges : string -> ('f Jmap_standard_methods.QueryChanges.request, Jmap_standard_methods.QueryChanges.response) method_witness
30
31(** Type-safe invocation pairing method name with typed arguments *)
32type _ invocation =
33 | Invocation : {
34 method_name : string;
35 arguments : 'args;
36 call_id : string;
37 witness : ('args, 'resp) method_witness;
38 } -> 'resp invocation
39
40(** Existential wrapper for heterogeneous invocation lists *)
41type packed_invocation =
42 | Packed : 'resp invocation -> packed_invocation
43
44(** Heterogeneous list of invocations (for Request.method_calls) *)
45type invocation_list = packed_invocation list
46
47(** Response invocation - pairs method name with typed response *)
48type _ response_invocation =
49 | ResponseInvocation : {
50 method_name : string;
51 response : 'resp;
52 call_id : string;
53 witness : ('args, 'resp) method_witness;
54 } -> 'resp response_invocation
55
56(** Packed response invocation *)
57type packed_response =
58 | PackedResponse : 'resp response_invocation -> packed_response
59
60(** Heterogeneous list of responses (for Response.method_responses) *)
61type response_list = packed_response list
62
63(** Error response *)
64type error_response = {
65 error_type : Jmap_error.method_error;
66 call_id : string;
67}
68
69(** Response can be either success or error *)
70type method_response =
71 | Success of packed_response
72 | Error of error_response
73
74(** Get method name from witness *)
75let method_name_of_witness : type a r. (a, r) method_witness -> string = function
76 | Echo -> "Core/echo"
77 | Get typ -> typ ^ "/get"
78 | Changes typ -> typ ^ "/changes"
79 | Set typ -> typ ^ "/set"
80 | Copy typ -> typ ^ "/copy"
81 | Query typ -> typ ^ "/query"
82 | QueryChanges typ -> typ ^ "/queryChanges"
83
84(** Parse method name and return appropriate witness *)
85let witness_of_method_name name : packed_invocation =
86 (* Extract type name from method *)
87 match String.split_on_char '/' name with
88 | ["Core"; "echo"] ->
89 Packed (Invocation {
90 method_name = name;
91 arguments = `Null; (* Placeholder *)
92 call_id = ""; (* Will be filled in *)
93 witness = Echo;
94 })
95 | [typ; "get"] ->
96 Packed (Invocation {
97 method_name = name;
98 arguments = Jmap_standard_methods.Get.{ account_id = Jmap_id.of_string ""; ids = None; properties = None }; (* Placeholder *)
99 call_id = "";
100 witness = Get typ;
101 })
102 | [typ; "changes"] ->
103 Packed (Invocation {
104 method_name = name;
105 arguments = Jmap_standard_methods.Changes.{ account_id = Jmap_id.of_string ""; since_state = ""; max_changes = None }; (* Placeholder *)
106 call_id = "";
107 witness = Changes typ;
108 })
109 | [typ; "set"] ->
110 Packed (Invocation {
111 method_name = name;
112 arguments = Jmap_standard_methods.Set.{
113 account_id = Jmap_id.of_string "";
114 if_in_state = None;
115 create = None;
116 update = None;
117 destroy = None;
118 };
119 call_id = "";
120 witness = Set typ;
121 })
122 | [typ; "query"] ->
123 Packed (Invocation {
124 method_name = name;
125 arguments = Jmap_standard_methods.Query.{
126 account_id = Jmap_id.of_string "";
127 filter = None;
128 sort = None;
129 position = None;
130 anchor = None;
131 anchor_offset = None;
132 limit = None;
133 calculate_total = None;
134 };
135 call_id = "";
136 witness = Query typ;
137 })
138 | _ ->
139 raise (Jmap_error.Parse_error (Printf.sprintf "Unknown method: %s" name))
140
141(** Parse invocation from JSON array [method_name, arguments, call_id].
142 Test files: test/data/core/request_echo.json *)
143let of_json json =
144 (* Parse invocation from JSON array: [method_name, arguments, call_id] *)
145 match json with
146 | `A [(`String method_name); arguments; (`String call_id)] ->
147 (* For now, create a generic invocation without full type checking *)
148 (* We'll store the raw JSON as the arguments *)
149 Packed (Invocation {
150 method_name;
151 arguments; (* Store raw JSON for now *)
152 call_id;
153 witness = Echo; (* Use Echo as a generic witness *)
154 })
155 | `A _ -> raise (Jmap_error.Parse_error "Invocation must be [method, args, id]")
156 | _ -> raise (Jmap_error.Parse_error "Invocation must be a JSON array")
157
158(** Convert invocation to JSON *)
159let to_json : type resp. resp invocation -> Ezjsonm.value =
160 fun (Invocation { method_name; arguments; call_id; witness }) ->
161 (* Serialize arguments based on witness type *)
162 let args_json : Ezjsonm.value = match witness with
163 | Echo -> arguments (* Echo arguments are already Ezjsonm.value *)
164 | Get _ ->
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"
178 in
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. *)
187let 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"