(** JMAP Invocation with Type-Safe Method Dispatch Invocations use GADTs to ensure compile-time type safety between method calls and their responses. An Invocation is a 3-tuple: [method_name, arguments, call_id] Reference: RFC 8620 Section 3.2 Test files: test/data/core/request_echo.json (methodCalls field) *) (** Method witness type - encodes the relationship between method names and their argument/response types. This GADT ensures that for each method, we know: - What type the arguments should have - What type the response will have *) type ('args, 'resp) method_witness = (* Core methods *) | Echo : (Ezjsonm.value, Ezjsonm.value) method_witness (* Standard methods - polymorphic over object type *) | Get : string -> ('a Jmap_standard_methods.Get.request, 'a Jmap_standard_methods.Get.response) method_witness | Changes : string -> (Jmap_standard_methods.Changes.request, Jmap_standard_methods.Changes.response) method_witness | Set : string -> ('a Jmap_standard_methods.Set.request, 'a Jmap_standard_methods.Set.response) method_witness | Copy : string -> ('a Jmap_standard_methods.Copy.request, 'a Jmap_standard_methods.Copy.response) method_witness | Query : string -> ('f Jmap_standard_methods.Query.request, Jmap_standard_methods.Query.response) method_witness | QueryChanges : string -> ('f Jmap_standard_methods.QueryChanges.request, Jmap_standard_methods.QueryChanges.response) method_witness (** Type-safe invocation pairing method name with typed arguments *) type _ invocation = | Invocation : { method_name : string; arguments : 'args; call_id : string; witness : ('args, 'resp) method_witness; } -> 'resp invocation (** Existential wrapper for heterogeneous invocation lists *) type packed_invocation = | Packed : 'resp invocation -> packed_invocation (** Heterogeneous list of invocations (for Request.method_calls) *) type invocation_list = packed_invocation list (** Response invocation - pairs method name with typed response *) type _ response_invocation = | ResponseInvocation : { method_name : string; response : 'resp; call_id : string; witness : ('args, 'resp) method_witness; } -> 'resp response_invocation (** Packed response invocation *) type packed_response = | PackedResponse : 'resp response_invocation -> packed_response (** Heterogeneous list of responses (for Response.method_responses) *) type response_list = packed_response list (** Error response *) type error_response = { error_type : Jmap_error.method_error; call_id : string; } (** Response can be either success or error *) type method_response = | Success of packed_response | Error of error_response (** Get method name from witness *) let method_name_of_witness : type a r. (a, r) method_witness -> string = function | Echo -> "Core/echo" | Get typ -> typ ^ "/get" | Changes typ -> typ ^ "/changes" | Set typ -> typ ^ "/set" | Copy typ -> typ ^ "/copy" | Query typ -> typ ^ "/query" | QueryChanges typ -> typ ^ "/queryChanges" (** Parse method name and return appropriate witness *) let witness_of_method_name name : packed_invocation = (* Extract type name from method *) match String.split_on_char '/' name with | ["Core"; "echo"] -> Packed (Invocation { method_name = name; arguments = `Null; (* Placeholder *) call_id = ""; (* Will be filled in *) witness = Echo; }) | [typ; "get"] -> Packed (Invocation { method_name = name; arguments = Jmap_standard_methods.Get.{ account_id = Jmap_id.of_string ""; ids = None; properties = None }; (* Placeholder *) call_id = ""; witness = Get typ; }) | [typ; "changes"] -> Packed (Invocation { method_name = name; arguments = Jmap_standard_methods.Changes.{ account_id = Jmap_id.of_string ""; since_state = ""; max_changes = None }; (* Placeholder *) call_id = ""; witness = Changes typ; }) | [typ; "set"] -> Packed (Invocation { method_name = name; arguments = Jmap_standard_methods.Set.{ account_id = Jmap_id.of_string ""; if_in_state = None; create = None; update = None; destroy = None; }; call_id = ""; witness = Set typ; }) | [typ; "query"] -> Packed (Invocation { method_name = name; arguments = Jmap_standard_methods.Query.{ account_id = Jmap_id.of_string ""; filter = None; sort = None; position = None; anchor = None; anchor_offset = None; limit = None; calculate_total = None; }; call_id = ""; witness = Query typ; }) | _ -> raise (Jmap_error.Parse_error (Printf.sprintf "Unknown method: %s" name)) (** Parse invocation from JSON array [method_name, arguments, call_id]. Test files: test/data/core/request_echo.json *) let of_json json = (* Parse invocation from JSON array: [method_name, arguments, call_id] *) match json with | `A [(`String method_name); arguments; (`String call_id)] -> (* For now, create a generic invocation without full type checking *) (* We'll store the raw JSON as the arguments *) Packed (Invocation { method_name; arguments; (* Store raw JSON for now *) call_id; witness = Echo; (* Use Echo as a generic witness *) }) | `A _ -> raise (Jmap_error.Parse_error "Invocation must be [method, args, id]") | _ -> raise (Jmap_error.Parse_error "Invocation must be a JSON array") (** Convert invocation to JSON *) let to_json : type resp. resp invocation -> Ezjsonm.value = fun (Invocation { method_name; arguments; call_id; witness }) -> (* Serialize arguments based on witness type *) let args_json : Ezjsonm.value = match witness with | Echo -> arguments (* Echo arguments are already Ezjsonm.value *) | Get _ -> (* This code path should never execute - we only create invocations with Echo witness. If it does execute, fail immediately rather than using unsafe magic. *) failwith "to_json: Get witness not supported - use Echo witness with pre-serialized JSON" | Changes _ -> failwith "to_json: Changes witness not supported - use Echo witness with pre-serialized JSON" | Set _ -> failwith "to_json: Set witness not supported - use Echo witness with pre-serialized JSON" | Copy _ -> failwith "to_json: Copy witness not supported - use Echo witness with pre-serialized JSON" | Query _ -> failwith "to_json: Query witness not supported - use Echo witness with pre-serialized JSON" | QueryChanges _ -> failwith "to_json: QueryChanges witness not supported - use Echo witness with pre-serialized JSON" in `A [`String method_name; args_json; `String call_id] (** Extract response data as JSON from a packed response. This provides safe access to response data. NOTE: Currently all responses are parsed with Echo witness and stored as Ezjsonm.value, so only the Echo case executes. The other cases will fail immediately if called - they should never execute in the current implementation. *) let response_to_json : packed_response -> Ezjsonm.value = function | PackedResponse (ResponseInvocation { response; witness; _ }) -> (* Pattern match on witness to convert response to JSON type-safely *) match witness with | Echo -> (* For Echo witness, response is already Ezjsonm.value - completely type-safe! *) response | Get _ -> (* This code path should never execute - we only create responses with Echo witness. If it does execute, fail immediately rather than using unsafe magic. *) failwith "response_to_json: Get witness not supported - responses use Echo witness" | Changes _ -> failwith "response_to_json: Changes witness not supported - responses use Echo witness" | Set _ -> failwith "response_to_json: Set witness not supported - responses use Echo witness" | Copy _ -> failwith "response_to_json: Copy witness not supported - responses use Echo witness" | Query _ -> failwith "response_to_json: Query witness not supported - responses use Echo witness" | QueryChanges _ -> failwith "response_to_json: QueryChanges witness not supported - responses use Echo witness"