This repository has no description
Fix JMAP Fastmail client to properly connect to API
- Fix typo in URI from "sessio" to "session"
- Modify HTTP client to support both GET and POST methods as required by API
- Improve JSON parsing to handle null values in API responses
- Add detailed debug logging to help troubleshoot API interactions
- Update mailbox and email parsers to be more robust with server responses
🤖 Generated with [Claude Code](https://claude.ai/code)
Co-Authored-By: Claude <noreply@anthropic.com>
author
Anil Madhavapeddy
co-author
Claude
date
(Mar 9, 2025, 11:41 AM UTC)
commit
696bbe1e
696bbe1eb916557826cb8276c3ec2487e5005e2f
parent
81fdfadc
81fdfadc29633f672d0d3000d99b6f5ed532b5d5
+146
-36
+1
-1
bin/fastmail_list.ml
+1
-1
bin/fastmail_list.ml
+12
-7
lib/jmap.ml
+12
-7
lib/jmap.ml
···
394
394
json_to_string json
395
395
396
396
(** Make a raw HTTP request *)
397
-
let make_http_request ~headers ~body uri =
397
+
let make_http_request ~method_ ~headers ~body uri =
398
398
let open Cohttp in
399
399
let open Cohttp_lwt_unix in
400
400
let headers = Header.add_list (Header.init ()) headers in
···
402
402
(* Debug: print request details *)
403
403
Printf.printf "\n===== HTTP REQUEST =====\n";
404
404
Printf.printf "URI: %s\n" (Uri.to_string uri);
405
-
Printf.printf "METHOD: POST\n";
405
+
Printf.printf "METHOD: %s\n" method_;
406
406
Printf.printf "HEADERS:\n";
407
407
Header.iter (fun k v -> Printf.printf " %s: %s\n" k v) headers;
408
408
Printf.printf "BODY:\n%s\n" body;
···
410
410
411
411
Lwt.catch
412
412
(fun () ->
413
-
let* resp, body = Client.post ~headers ~body:(Cohttp_lwt.Body.of_string body) uri in
413
+
let* resp, body =
414
+
match method_ with
415
+
| "GET" -> Client.get ~headers uri
416
+
| "POST" -> Client.post ~headers ~body:(Cohttp_lwt.Body.of_string body) uri
417
+
| _ -> failwith (Printf.sprintf "Unsupported HTTP method: %s" method_)
418
+
in
414
419
let* body_str = Cohttp_lwt.Body.to_string body in
415
420
let status = Response.status resp |> Code.code_of_status in
416
421
···
451
456
("Content-Length", string_of_int (String.length body));
452
457
("Authorization", auth_header)
453
458
] in
454
-
let* result = make_http_request ~headers ~body config.api_uri in
459
+
let* result = make_http_request ~method_:"POST" ~headers ~body config.api_uri in
455
460
match result with
456
461
| Ok response_body ->
457
462
(match parse_json_string response_body with
···
538
543
| _ -> [("Content-Type", "application/json")]
539
544
in
540
545
541
-
let* result = make_http_request ~headers ~body:"" uri in
546
+
let* result = make_http_request ~method_:"GET" ~headers ~body:"" uri in
542
547
match result with
543
548
| Ok response_body ->
544
549
(match parse_json_string response_body with
···
561
566
("Authorization", "Basic " ^ Base64.encode_string (config.username ^ ":" ^ config.authentication_token))
562
567
] in
563
568
564
-
let* result = make_http_request ~headers ~body:data upload_uri in
569
+
let* result = make_http_request ~method_:"POST" ~headers ~body:data upload_uri in
565
570
match result with
566
571
| Ok response_body ->
567
572
(match parse_json_string response_body with
···
604
609
("Authorization", "Basic " ^ Base64.encode_string (config.username ^ ":" ^ config.authentication_token))
605
610
] in
606
611
607
-
let* result = make_http_request ~headers ~body:"" download_uri in
612
+
let* result = make_http_request ~method_:"GET" ~headers ~body:"" download_uri in
608
613
Lwt.return result
609
614
end
+133
-28
lib/jmap_mail.ml
+133
-28
lib/jmap_mail.ml
···
907
907
let mailbox_of_json json =
908
908
try
909
909
let open Ezjsonm in
910
+
Printf.printf "Parsing mailbox JSON\n";
911
+
910
912
let id = get_string (find json ["id"]) in
913
+
Printf.printf "Got id: %s\n" id;
914
+
911
915
let name = get_string (find json ["name"]) in
912
-
let parent_id = find_opt json ["parentId"] |> Option.map get_string in
913
-
let role = find_opt json ["role"] |> Option.map (fun r -> Json.mailbox_role_of_string (get_string r)) in
916
+
Printf.printf "Got name: %s\n" name;
917
+
918
+
(* Handle parentId which can be null *)
919
+
let parent_id =
920
+
match find_opt json ["parentId"] with
921
+
| Some (`Null) -> None
922
+
| Some (`String s) -> Some s
923
+
| None -> None
924
+
| _ -> None
925
+
in
926
+
Printf.printf "Got parent_id: %s\n" (match parent_id with Some p -> p | None -> "None");
927
+
928
+
(* Handle role which might be null *)
929
+
let role =
930
+
match find_opt json ["role"] with
931
+
| Some (`Null) -> None
932
+
| Some (`String s) -> Some (Json.mailbox_role_of_string s)
933
+
| None -> None
934
+
| _ -> None
935
+
in
936
+
Printf.printf "Got role\n";
937
+
914
938
let sort_order = get_int (find json ["sortOrder"]) in
939
+
Printf.printf "Got sort_order: %d\n" sort_order;
940
+
915
941
let total_emails = get_int (find json ["totalEmails"]) in
942
+
Printf.printf "Got total_emails: %d\n" total_emails;
943
+
916
944
let unread_emails = get_int (find json ["unreadEmails"]) in
945
+
Printf.printf "Got unread_emails: %d\n" unread_emails;
946
+
917
947
let total_threads = get_int (find json ["totalThreads"]) in
948
+
Printf.printf "Got total_threads: %d\n" total_threads;
949
+
918
950
let unread_threads = get_int (find json ["unreadThreads"]) in
951
+
Printf.printf "Got unread_threads: %d\n" unread_threads;
952
+
919
953
let is_subscribed = get_bool (find json ["isSubscribed"]) in
954
+
Printf.printf "Got is_subscribed: %b\n" is_subscribed;
920
955
921
956
let rights_json = find json ["myRights"] in
957
+
Printf.printf "Got rights_json\n";
958
+
922
959
let my_rights = {
923
960
Types.may_read_items = get_bool (find rights_json ["mayReadItems"]);
924
961
may_add_items = get_bool (find rights_json ["mayAddItems"]);
···
930
967
may_delete = get_bool (find rights_json ["mayDelete"]);
931
968
may_submit = get_bool (find rights_json ["maySubmit"]);
932
969
} in
970
+
Printf.printf "Constructed my_rights\n";
933
971
934
-
Ok ({
972
+
let result = {
935
973
Types.id;
936
974
name;
937
975
parent_id;
···
943
981
unread_threads;
944
982
is_subscribed;
945
983
my_rights;
946
-
})
984
+
} in
985
+
Printf.printf "Constructed mailbox result\n";
986
+
987
+
Ok (result)
947
988
with
948
-
| Not_found -> Error (Parse_error "Required field not found in mailbox object")
949
-
| Invalid_argument msg -> Error (Parse_error msg)
950
-
| e -> Error (Parse_error (Printexc.to_string e))
989
+
| Not_found as e ->
990
+
Printf.printf "Not_found error: %s\n" (Printexc.to_string e);
991
+
Printexc.print_backtrace stdout;
992
+
Error (Parse_error "Required field not found in mailbox object")
993
+
| Invalid_argument msg ->
994
+
Printf.printf "Invalid_argument error: %s\n" msg;
995
+
Error (Parse_error msg)
996
+
| e ->
997
+
Printf.printf "Unknown error: %s\n" (Printexc.to_string e);
998
+
Error (Parse_error (Printexc.to_string e))
951
999
952
1000
(** Convert JSON email object to OCaml type *)
953
1001
let email_of_json json =
954
1002
try
955
1003
let open Ezjsonm in
1004
+
Printf.printf "Parsing email JSON\n";
1005
+
956
1006
let id = get_string (find json ["id"]) in
1007
+
Printf.printf "Got email id: %s\n" id;
1008
+
957
1009
let blob_id = get_string (find json ["blobId"]) in
958
1010
let thread_id = get_string (find json ["threadId"]) in
959
1011
···
974
1026
975
1027
let size = get_int (find json ["size"]) in
976
1028
let received_at = get_string (find json ["receivedAt"]) in
977
-
let message_id = match find json ["messageId"] with
978
-
| `A ids -> List.map (fun id -> get_string id) ids
979
-
| _ -> raise (Invalid_argument "messageId is not an array")
1029
+
1030
+
(* Handle messageId which might be an array or missing *)
1031
+
let message_id =
1032
+
match find_opt json ["messageId"] with
1033
+
| Some (`A ids) -> List.map (fun id ->
1034
+
match id with
1035
+
| `String s -> s
1036
+
| _ -> raise (Invalid_argument "messageId item is not a string")
1037
+
) ids
1038
+
| Some (`String s) -> [s] (* Handle single string case *)
1039
+
| None -> [] (* Handle missing case *)
1040
+
| _ -> raise (Invalid_argument "messageId has unexpected type")
980
1041
in
981
1042
982
1043
(* Parse optional fields *)
···
984
1045
match opt_json with
985
1046
| Some (`A items) ->
986
1047
Some (List.map (fun addr_json ->
987
-
let name = find_opt addr_json ["name"] |> Option.map get_string in
1048
+
let name =
1049
+
match find_opt addr_json ["name"] with
1050
+
| Some (`String s) -> Some s
1051
+
| Some (`Null) -> None
1052
+
| None -> None
1053
+
| _ -> None
1054
+
in
988
1055
let email = get_string (find addr_json ["email"]) in
989
-
let parameters = match find_opt addr_json ["parameters"] with
990
-
| Some (`O items) -> List.map (fun (k, v) -> (k, get_string v)) items
1056
+
let parameters =
1057
+
match find_opt addr_json ["parameters"] with
1058
+
| Some (`O items) -> List.map (fun (k, v) ->
1059
+
match v with
1060
+
| `String s -> (k, s)
1061
+
| _ -> (k, "")
1062
+
) items
991
1063
| _ -> []
992
1064
in
993
1065
{ Types.name; email; parameters }
···
995
1067
| _ -> None
996
1068
in
997
1069
998
-
let in_reply_to = find_opt json ["inReplyTo"] |> Option.map (function
999
-
| `A ids -> List.map get_string ids
1000
-
| _ -> []
1001
-
) in
1070
+
(* Handle optional string arrays with null handling *)
1071
+
let parse_string_array_opt field_name =
1072
+
match find_opt json [field_name] with
1073
+
| Some (`A ids) ->
1074
+
Some (List.filter_map (function
1075
+
| `String s -> Some s
1076
+
| _ -> None
1077
+
) ids)
1078
+
| Some (`Null) -> None
1079
+
| None -> None
1080
+
| _ -> None
1081
+
in
1002
1082
1003
-
let references = find_opt json ["references"] |> Option.map (function
1004
-
| `A ids -> List.map get_string ids
1005
-
| _ -> []
1006
-
) in
1083
+
let in_reply_to = parse_string_array_opt "inReplyTo" in
1084
+
let references = parse_string_array_opt "references" in
1007
1085
1008
1086
let sender = parse_email_addresses (find_opt json ["sender"]) in
1009
1087
let from = parse_email_addresses (find_opt json ["from"]) in
···
1012
1090
let bcc = parse_email_addresses (find_opt json ["bcc"]) in
1013
1091
let reply_to = parse_email_addresses (find_opt json ["replyTo"]) in
1014
1092
1015
-
let subject = find_opt json ["subject"] |> Option.map get_string in
1016
-
let sent_at = find_opt json ["sentAt"] |> Option.map get_string in
1017
-
let has_attachment = find_opt json ["hasAttachment"] |> Option.map get_bool in
1018
-
let preview = find_opt json ["preview"] |> Option.map get_string in
1093
+
(* Handle optional string fields with null handling *)
1094
+
let parse_string_opt field_name =
1095
+
match find_opt json [field_name] with
1096
+
| Some (`String s) -> Some s
1097
+
| Some (`Null) -> None
1098
+
| None -> None
1099
+
| _ -> None
1100
+
in
1101
+
1102
+
let subject = parse_string_opt "subject" in
1103
+
let sent_at = parse_string_opt "sentAt" in
1104
+
1105
+
(* Handle optional boolean fields with null handling *)
1106
+
let parse_bool_opt field_name =
1107
+
match find_opt json [field_name] with
1108
+
| Some (`Bool b) -> Some b
1109
+
| Some (`Null) -> None
1110
+
| None -> None
1111
+
| _ -> None
1112
+
in
1113
+
1114
+
let has_attachment = parse_bool_opt "hasAttachment" in
1115
+
let preview = parse_string_opt "preview" in
1019
1116
1020
1117
(* Body parts parsing would go here - omitting for brevity *)
1118
+
Printf.printf "Email parsed successfully\n";
1021
1119
1022
1120
Ok ({
1023
1121
Types.id;
···
1047
1145
headers = None;
1048
1146
})
1049
1147
with
1050
-
| Not_found -> Error (Parse_error "Required field not found in email object")
1051
-
| Invalid_argument msg -> Error (Parse_error msg)
1052
-
| e -> Error (Parse_error (Printexc.to_string e))
1148
+
| Not_found as e ->
1149
+
Printf.printf "Email parse error - Not_found: %s\n" (Printexc.to_string e);
1150
+
Printexc.print_backtrace stdout;
1151
+
Error (Parse_error "Required field not found in email object")
1152
+
| Invalid_argument msg ->
1153
+
Printf.printf "Email parse error - Invalid_argument: %s\n" msg;
1154
+
Error (Parse_error msg)
1155
+
| e ->
1156
+
Printf.printf "Email parse error - Unknown: %s\n" (Printexc.to_string e);
1157
+
Error (Parse_error (Printexc.to_string e))
1053
1158
1054
1159
(** Login to a JMAP server and establish a connection
1055
1160
@param uri The URI of the JMAP server