(** High-level email submission API for JMAP clients. This module provides ergonomic functions for submitting emails via JMAP, including creating submissions, managing envelopes, and tracking delivery status. Based on patterns from rust-jmap for a familiar API design. *) (* open Printf - removed unused *) (** Result type alias for cleaner signatures *) type 'a result = ('a, Jmap.Error.error) Result.t (** {1 Email Submission Creation} *) (** Submit an email with minimal configuration. Creates an EmailSubmission for the specified email using the given identity. The email will be sent immediately unless the server applies scheduling rules. @param env Eio environment for network operations @param ctx Connection context @param email_id The ID of the email to submit @param identity_id The identity to use for sending @return The created EmailSubmission object or an error *) let submit_email _env _ctx ~email_id ~identity_id = try (* Get account ID from context *) (* Extract account ID from context - we'll use a placeholder for now In production, this would be extracted from the session *) let account_id = match Jmap.Id.of_string "primary-account" with | Ok id -> id | Error _ -> failwith "Invalid account ID" in (* Create the submission *) let submission_create = match Jmap_email.Submission.Create.create ~identity_id ~email_id () with | Ok s -> s | Error msg -> failwith msg in (* Build set request *) let set_args = match Jmap_email.Submission.Set_args.create ~account_id ~create:[((match Jmap.Id.of_string "submission-create-1" with | Ok id -> id | Error _ -> failwith "Invalid ID"), submission_create)] () with | Ok args -> args | Error msg -> failwith msg in (* Execute request *) (* Build request - for now we'll create the JSON directly In production, this would use the request builder *) let _builder_json = Jmap_email.Submission.Set_args.to_json set_args in (* Execute request - for now return a placeholder In production, this would execute via the connection *) match Error (`Protocol_error "Email submission API not yet fully integrated") with | Ok response -> (* Parse response *) (match Jmap.Wire.Response.method_responses response with | Ok invocation :: _ -> let args_json = Jmap.Wire.Invocation.arguments invocation in (match Jmap_email.Submission.Set_response.of_json args_json with | Ok set_response -> let created = Jmap_email.Submission.Set_response.created set_response in (if Hashtbl.length created > 0 then begin (* Get the first created submission *) let submission_response = ref None in Hashtbl.iter (fun _client_id response -> submission_response := Some response ) created; match !submission_response with | Some resp -> (* Build a full submission object from the response *) let id = Jmap_email.Submission.Create.Response.id resp in let thread_id = Jmap_email.Submission.Create.Response.thread_id resp in let send_at = Jmap_email.Submission.Create.Response.send_at resp in (match Jmap_email.Submission.create ~id ~identity_id ~email_id ~thread_id ~send_at ~undo_status:`Pending () with | Ok submission -> Ok submission | Error msg -> Error (`Protocol_error msg)) | None -> Error (`Protocol_error "No submission in response") end else (* Check for errors *) match Jmap_email.Submission.Set_response.not_created set_response with | Some not_created when Hashtbl.length not_created > 0 -> let error_msg = ref "Submission failed" in Hashtbl.iter (fun _client_id err -> error_msg := Option.value (Jmap.Error.Set_error.description err) ~default:"Unknown error" ) not_created; Error (`Protocol_error !error_msg) | _ -> Error (`Protocol_error "No submission created")) | Error msg -> Error (`Protocol_error msg)) | Error (err, call_id) :: _ -> Error (`Method_error ("EmailSubmission/set", call_id, Jmap.Error.Method_error.type_ err, None)) | [] -> Error (`Protocol_error "No method response")) | Error error -> Error error with | Failure msg -> Error (`Protocol_error msg) | exn -> Error (`Protocol_error (Printexc.to_string exn)) (** Submit an email with a custom SMTP envelope. Creates an EmailSubmission with explicit SMTP envelope addresses, overriding the addresses derived from the email headers. @param env Eio environment for network operations @param ctx Connection context @param email_id The ID of the email to submit @param identity_id The identity to use for sending @param mail_from SMTP MAIL FROM address @param rcpt_to List of SMTP RCPT TO addresses @return The created EmailSubmission object or an error *) let submit_email_with_envelope _env _ctx ~email_id ~identity_id ~mail_from ~rcpt_to = try (* Get account ID from context *) (* Extract account ID from context - we'll use a placeholder for now In production, this would be extracted from the session *) let account_id = match Jmap.Id.of_string "primary-account" with | Ok id -> id | Error _ -> failwith "Invalid account ID" in (* Create envelope addresses *) let mail_from_addr = match Jmap_email.Submission.EnvelopeAddress.create ~email:mail_from () with | Ok addr -> addr | Error msg -> failwith msg in let rcpt_to_addrs = List.map (fun email -> match Jmap_email.Submission.EnvelopeAddress.create ~email () with | Ok addr -> addr | Error msg -> failwith msg ) rcpt_to in (* Create envelope *) let envelope = match Jmap_email.Submission.Envelope.create ~mail_from:mail_from_addr ~rcpt_to:rcpt_to_addrs with | Ok env -> env | Error msg -> failwith msg in (* Create the submission with envelope *) let submission_create = match Jmap_email.Submission.Create.create ~identity_id ~email_id ~envelope () with | Ok s -> s | Error msg -> failwith msg in (* Build set request *) let set_args = match Jmap_email.Submission.Set_args.create ~account_id ~create:[((match Jmap.Id.of_string "submission-create-1" with | Ok id -> id | Error _ -> failwith "Invalid ID"), submission_create)] () with | Ok args -> args | Error msg -> failwith msg in (* Execute request *) (* Build request - for now we'll create the JSON directly In production, this would use the request builder *) let _builder_json = Jmap_email.Submission.Set_args.to_json set_args in (* Execute request - for now return a placeholder In production, this would execute via the connection *) match Error (`Protocol_error "Email submission API not yet fully integrated") with | Ok response -> (* Parse response - similar to submit_email *) (match Jmap.Wire.Response.method_responses response with | Ok invocation :: _ -> let args_json = Jmap.Wire.Invocation.arguments invocation in (match Jmap_email.Submission.Set_response.of_json args_json with | Ok set_response -> let created = Jmap_email.Submission.Set_response.created set_response in (if Hashtbl.length created > 0 then begin let submission_response = ref None in Hashtbl.iter (fun _client_id response -> submission_response := Some response ) created; match !submission_response with | Some resp -> let id = Jmap_email.Submission.Create.Response.id resp in let thread_id = Jmap_email.Submission.Create.Response.thread_id resp in let send_at = Jmap_email.Submission.Create.Response.send_at resp in (match Jmap_email.Submission.create ~id ~identity_id ~email_id ~thread_id ~envelope ~send_at ~undo_status:`Pending () with | Ok submission -> Ok submission | Error msg -> Error (`Protocol_error msg)) | None -> Error (`Protocol_error "No submission in response") end else Error (`Protocol_error "No submission created")) | Error msg -> Error (`Protocol_error msg)) | Error (err, call_id) :: _ -> Error (`Method_error ("EmailSubmission/set", call_id, Jmap.Error.Method_error.type_ err, None)) | [] -> Error (`Protocol_error "No method response")) | Error error -> Error error with | Failure msg -> Error (`Protocol_error msg) | exn -> Error (`Protocol_error (Printexc.to_string exn)) (** Submit an email and automatically destroy the draft. Creates an EmailSubmission and marks the original email for destruction upon successful submission. Useful for sending draft emails. @param env Eio environment for network operations @param ctx Connection context @param email_id The ID of the draft email to submit and destroy @param identity_id The identity to use for sending @return The created EmailSubmission object or an error *) let submit_and_destroy_draft _env _ctx ~email_id ~identity_id = try (* Get account ID from context *) (* Extract account ID from context - we'll use a placeholder for now In production, this would be extracted from the session *) let account_id = match Jmap.Id.of_string "primary-account" with | Ok id -> id | Error _ -> failwith "Invalid account ID" in (* Create the submission *) let submission_create = match Jmap_email.Submission.Create.create ~identity_id ~email_id () with | Ok s -> s | Error msg -> failwith msg in (* Build set request with onSuccessDestroyEmail *) let set_args = match Jmap_email.Submission.Set_args.create ~account_id ~create:[((match Jmap.Id.of_string "submission-create-1" with | Ok id -> id | Error _ -> failwith "Invalid ID"), submission_create)] ~on_success_destroy_email:[email_id] () with | Ok args -> args | Error msg -> failwith msg in (* Execute request *) (* Build request - for now we'll create the JSON directly In production, this would use the request builder *) let _builder_json = Jmap_email.Submission.Set_args.to_json set_args in (* Execute request - for now return a placeholder In production, this would execute via the connection *) match Error (`Protocol_error "Email submission API not yet fully integrated") with | Ok response -> (* Parse response *) (match Jmap.Wire.Response.method_responses response with | Ok invocation :: _ -> let args_json = Jmap.Wire.Invocation.arguments invocation in (match Jmap_email.Submission.Set_response.of_json args_json with | Ok set_response -> let created = Jmap_email.Submission.Set_response.created set_response in (if Hashtbl.length created > 0 then begin let submission_response = ref None in Hashtbl.iter (fun _client_id response -> submission_response := Some response ) created; match !submission_response with | Some resp -> let id = Jmap_email.Submission.Create.Response.id resp in let thread_id = Jmap_email.Submission.Create.Response.thread_id resp in let send_at = Jmap_email.Submission.Create.Response.send_at resp in (match Jmap_email.Submission.create ~id ~identity_id ~email_id ~thread_id ~send_at ~undo_status:`Pending () with | Ok submission -> Ok submission | Error msg -> Error (`Protocol_error msg)) | None -> Error (`Protocol_error "No submission in response") end else Error (`Protocol_error "No submission created")) | Error msg -> Error (`Protocol_error msg)) | Error (err, call_id) :: _ -> Error (`Method_error ("EmailSubmission/set", call_id, Jmap.Error.Method_error.type_ err, None)) | [] -> Error (`Protocol_error "No method response")) | Error error -> Error error with | Failure msg -> Error (`Protocol_error msg) | exn -> Error (`Protocol_error (Printexc.to_string exn)) (** {1 Submission Status Management} *) (** Cancel a pending email submission. Changes the undo status of a pending submission to 'canceled', preventing it from being sent. Only works for submissions with undoStatus = 'pending'. @param env Eio environment for network operations @param ctx Connection context @param submission_id The ID of the submission to cancel @return Unit on success or an error *) let cancel_submission _env _ctx ~submission_id = try (* Get account ID from context *) (* Extract account ID from context - we'll use a placeholder for now In production, this would be extracted from the session *) let account_id = match Jmap.Id.of_string "primary-account" with | Ok id -> id | Error _ -> failwith "Invalid account ID" in (* Create update to cancel *) let cancel_update = match Jmap_email.Submission.Update.cancel with | Ok update -> update | Error msg -> failwith msg in (* Build set request *) let set_args = match Jmap_email.Submission.Set_args.create ~account_id ~update:[(submission_id, cancel_update)] () with | Ok args -> args | Error msg -> failwith msg in (* Execute request *) (* Build request - for now we'll create the JSON directly In production, this would use the request builder *) let _builder_json = Jmap_email.Submission.Set_args.to_json set_args in (* Execute request - for now return a placeholder In production, this would execute via the connection *) match Error (`Protocol_error "Email submission API not yet fully integrated") with | Ok response -> (match Jmap.Wire.Response.method_responses response with | Ok invocation :: _ -> let args_json = Jmap.Wire.Invocation.arguments invocation in (match Jmap_email.Submission.Set_response.of_json args_json with | Ok set_response -> (match Jmap_email.Submission.Set_response.updated set_response with | Some updated when Hashtbl.length updated > 0 -> Ok () | _ -> (match Jmap_email.Submission.Set_response.not_updated set_response with | Some not_updated when Hashtbl.length not_updated > 0 -> let error_msg = ref "Failed to cancel" in Hashtbl.iter (fun _id err -> error_msg := Option.value (Jmap.Error.Set_error.description err) ~default:"Unknown error" ) not_updated; Error (`Protocol_error !error_msg) | _ -> Error (`Protocol_error "Submission not updated"))) | Error msg -> Error (`Protocol_error msg)) | Error (err, call_id) :: _ -> Error (`Method_error ("EmailSubmission/set", call_id, Jmap.Error.Method_error.type_ err, None)) | [] -> Error (`Protocol_error "No method response")) | Error error -> Error error with | Failure msg -> Error (`Protocol_error msg) | exn -> Error (`Protocol_error (Printexc.to_string exn)) (** {1 Submission Queries} *) (** Get an email submission by ID. Retrieves a single EmailSubmission object with all or specified properties. @param env Eio environment for network operations @param ctx Connection context @param submission_id The ID of the submission to retrieve @param properties Optional list of properties to fetch (None for all) @return The EmailSubmission object or None if not found *) let get_submission _env _ctx ~submission_id ?properties () = try (* Get account ID from context *) (* Extract account ID from context - we'll use a placeholder for now In production, this would be extracted from the session *) let account_id = match Jmap.Id.of_string "primary-account" with | Ok id -> id | Error _ -> failwith "Invalid account ID" in (* Build get request *) let get_args = match Jmap_email.Submission.Get_args.create ~account_id ~ids:[submission_id] ?properties () with | Ok args -> args | Error msg -> failwith msg in (* Execute request *) (* Build request - for now we'll create the JSON directly In production, this would use the request builder *) let _builder_json = Jmap_email.Submission.Get_args.to_json get_args in (* Execute request - for now return a placeholder In production, this would execute via the connection *) match Error (`Protocol_error "Email submission API not yet fully integrated") with | Ok response -> (match Jmap.Wire.Response.method_responses response with | Ok invocation :: _ -> let args_json = Jmap.Wire.Invocation.arguments invocation in (match Jmap_email.Submission.Get_response.of_json args_json with | Ok get_response -> let submissions = Jmap_email.Submission.Get_response.list get_response in (match submissions with | submission :: _ -> Ok (Some submission) | [] -> let not_found = Jmap_email.Submission.Get_response.not_found get_response in if List.mem submission_id not_found then Ok None else Ok None) | Error msg -> Error (`Protocol_error msg)) | Error (err, call_id) :: _ -> Error (`Method_error ("EmailSubmission/set", call_id, Jmap.Error.Method_error.type_ err, None)) | [] -> Error (`Protocol_error "No method response")) | Error error -> Error error with | Failure msg -> Error (`Protocol_error msg) | exn -> Error (`Protocol_error (Printexc.to_string exn)) (** Query email submissions with filters. Searches for EmailSubmission objects matching the specified criteria. @param env Eio environment for network operations @param ctx Connection context @param filter Optional filter to apply @param sort Optional sort order @param limit Maximum number of results @return List of submission IDs matching the query *) let query_submissions _env _ctx ?filter ?sort ?limit () = try (* Get account ID from context *) (* Extract account ID from context - we'll use a placeholder for now In production, this would be extracted from the session *) let account_id = match Jmap.Id.of_string "primary-account" with | Ok id -> id | Error _ -> failwith "Invalid account ID" in (* Build query request *) let query_args = match Jmap_email.Submission.Query_args.create ~account_id ?filter ?sort ?limit () with | Ok args -> args | Error msg -> failwith msg in (* Execute request *) (* Build request - for now we'll create the JSON directly In production, this would use the request builder *) let _builder_json = Jmap_email.Submission.Query_args.to_json query_args in (* Execute request - for now return a placeholder In production, this would execute via the connection *) match Error (`Protocol_error "Email submission API not yet fully integrated") with | Ok response -> (match Jmap.Wire.Response.method_responses response with | Ok invocation :: _ -> let args_json = Jmap.Wire.Invocation.arguments invocation in (match Jmap_email.Submission.Query_response.of_json args_json with | Ok query_response -> Ok (Jmap_email.Submission.Query_response.ids query_response) | Error msg -> Error (`Protocol_error msg)) | Error (err, call_id) :: _ -> Error (`Method_error ("EmailSubmission/set", call_id, Jmap.Error.Method_error.type_ err, None)) | [] -> Error (`Protocol_error "No method response")) | Error error -> Error error with | Failure msg -> Error (`Protocol_error msg) | exn -> Error (`Protocol_error (Printexc.to_string exn)) (** Query for pending submissions. Convenience function to find all submissions that can still be cancelled. @param env Eio environment for network operations @param ctx Connection context @return List of pending submission IDs *) let query_pending_submissions env ctx = let filter = Jmap_email.Submission.Filter.undo_status `Pending in query_submissions env ctx ~filter () (** Query submissions for a specific email. Finds all submissions associated with a particular email ID. @param env Eio environment for network operations @param ctx Connection context @param email_id The email ID to search for @return List of submission IDs for the email *) let query_submissions_for_email env ctx ~email_id = let filter = Jmap_email.Submission.Filter.email_ids [email_id] in query_submissions env ctx ~filter () (** {1 Delivery Status} *) (** Check delivery status of a submission. Retrieves the current delivery status for all recipients of a submission. @param env Eio environment for network operations @param ctx Connection context @param submission_id The submission to check @return Hashtable of recipient addresses to delivery status, or None *) let get_delivery_status env ctx ~submission_id = match get_submission env ctx ~submission_id ~properties:["id"; "deliveryStatus"] () with | Ok (Some submission) -> Ok (Jmap_email.Submission.delivery_status submission) | Ok None -> Ok None | Error err -> Error err (** {1 Batch Operations} *) (** Cancel all pending submissions. Queries for all pending submissions and cancels them. @param env Eio environment for network operations @param ctx Connection context @return Number of submissions cancelled *) let cancel_all_pending env ctx = match query_pending_submissions env ctx with | Ok submission_ids -> let cancelled = ref 0 in List.iter (fun id -> match cancel_submission env ctx ~submission_id:id with | Ok () -> incr cancelled | Error _ -> () ) submission_ids; Ok !cancelled | Error err -> Error err