ocaml-jmap / bin / jmap_vacation_manager.ml

(*
 * jmap_vacation_manager.ml - Manage vacation/out-of-office auto-responses
 *
 * This binary demonstrates JMAP's vacation response capabilities for setting
 * up and managing automatic email responses.
 *
 * For step 2, we're only testing type checking. No implementations required.
 *)

open Cmdliner

(** Vacation response actions **)
type vacation_action = 
  | Show
  | Enable of vacation_config
  | Disable
  | Update of vacation_config

and vacation_config = {
  subject : string option;
  text_body : string;
  html_body : string option;
  from_date : float option;
  to_date : float option;
  exclude_addresses : string list;
}

(** Command-line arguments **)

let host_arg =
  Arg.(required & opt (some string) None & info ["h"; "host"] 
       ~docv:"HOST" ~doc:"JMAP server hostname")

let user_arg =
  Arg.(required & opt (some string) None & info ["u"; "user"] 
       ~docv:"USERNAME" ~doc:"Username for authentication")

let password_arg =
  Arg.(required & opt (some string) None & info ["p"; "password"] 
       ~docv:"PASSWORD" ~doc:"Password for authentication")

let enable_arg =
  Arg.(value & flag & info ["e"; "enable"] 
       ~doc:"Enable vacation response")

let disable_arg =
  Arg.(value & flag & info ["d"; "disable"] 
       ~doc:"Disable vacation response")

let show_arg =
  Arg.(value & flag & info ["s"; "show"] 
       ~doc:"Show current vacation settings")

let subject_arg =
  Arg.(value & opt (some string) None & info ["subject"] 
       ~docv:"SUBJECT" ~doc:"Vacation email subject line")

let message_arg =
  Arg.(value & opt (some string) None & info ["m"; "message"] 
       ~docv:"TEXT" ~doc:"Vacation message text")

let message_file_arg =
  Arg.(value & opt (some string) None & info ["message-file"] 
       ~docv:"FILE" ~doc:"Read vacation message from file")

let html_message_arg =
  Arg.(value & opt (some string) None & info ["html-message"] 
       ~docv:"HTML" ~doc:"HTML vacation message")

let from_date_arg =
  Arg.(value & opt (some string) None & info ["from-date"] 
       ~docv:"DATE" ~doc:"Start date for vacation (YYYY-MM-DD)")

let to_date_arg =
  Arg.(value & opt (some string) None & info ["to-date"] 
       ~docv:"DATE" ~doc:"End date for vacation (YYYY-MM-DD)")

let exclude_arg =
  Arg.(value & opt_all string [] & info ["exclude"] 
       ~docv:"EMAIL" ~doc:"Email address to exclude from auto-response")

(** Helper functions **)

(* Parse date string to Unix timestamp *)
let parse_date date_str =
  try
    let (year, month, day) = Scanf.sscanf date_str "%d-%d-%d" (fun y m d -> (y, m, d)) in
    let tm = Unix.{ tm_sec = 0; tm_min = 0; tm_hour = 0;
                    tm_mday = day; tm_mon = month - 1; tm_year = year - 1900;
                    tm_wday = 0; tm_yday = 0; tm_isdst = false } in
    Some (Unix.mktime tm |> fst)
  with _ ->
    Printf.eprintf "Invalid date format: %s (use YYYY-MM-DD)\n" date_str;
    None

(* Format Unix timestamp as date string *)
let format_date timestamp =
  let tm = Unix.localtime timestamp in
  Printf.sprintf "%04d-%02d-%02d"
    (tm.Unix.tm_year + 1900) (tm.Unix.tm_mon + 1) tm.Unix.tm_mday

(* Read file contents *)
let read_file filename =
  let ic = open_in filename in
  let len = in_channel_length ic in
  let content = really_input_string ic len in
  close_in ic;
  content

(* Display vacation response settings *)
let show_vacation_response vacation =
  Printf.printf "\nVacation Response Settings:\n";
  Printf.printf "==========================\n\n";
  
  Printf.printf "Status: %s\n" 
    (if Jmap_email.Vacation.Vacation_response.is_enabled vacation then "ENABLED" else "DISABLED");
  
  (match Jmap_email.Vacation.Vacation_response.subject vacation with
  | Some subj -> Printf.printf "Subject: %s\n" subj
  | None -> Printf.printf "Subject: (default)\n");
  
  (match Jmap_email.Vacation.Vacation_response.text_body vacation with
  | Some body -> 
      Printf.printf "\nMessage:\n";
      Printf.printf "--------\n";
      Printf.printf "%s\n" body;
      Printf.printf "--------\n"
  | None -> Printf.printf "\nMessage: (none set)\n");
  
  (match Jmap_email.Vacation.Vacation_response.from_date vacation with
  | Some date -> Printf.printf "\nActive from: %s\n" (format_date date)
  | None -> ());
  
  (match Jmap_email.Vacation.Vacation_response.to_date vacation with
  | Some date -> Printf.printf "Active until: %s\n" (format_date date)
  | None -> ());
  
  let excluded = match Jmap_email.Vacation.Vacation_response.id vacation with
    | _ -> []  (* exclude_addresses not available in interface *) in
  if excluded <> [] then (
    Printf.printf "\nExcluded addresses:\n";
    List.iter (Printf.printf "  - %s\n") excluded
  )

(* Get current vacation response *)
let get_vacation_response ctx session account_id =
  let get_args = Jmap.Methods.Get_args.v
    ~account_id
    ~properties:["isEnabled"; "subject"; "textBody"; "htmlBody"; 
                 "fromDate"; "toDate"; "excludeAddresses"]
    () in
    
  let invocation = Jmap.Wire.Invocation.v
    ~method_name:"VacationResponse/get"
    ~arguments:(`Assoc []) (* Would serialize get_args *)
    ~method_call_id:"get1"
    () in
    
  let request = Jmap.Wire.Request.v
    ~using:[Jmap.capability_core; Jmap_email.capability_mail; Jmap_email.capability_vacationresponse]
    ~method_calls:[invocation]
    () in
    
  match Jmap_unix.request ctx request with
  | Ok _ ->
      (* Would extract from response - for now create a sample *)
      Ok (Jmap_email.Vacation.Vacation_response.v
        ~id:"vacation1"
        ~is_enabled:false
        ~subject:"Out of Office"
        ~text_body:"I am currently out of the office and will respond when I return."
        ())
  | Error e -> Error e

(* Update vacation response *)
let update_vacation_response ctx session account_id vacation_id updates =
  let update_map = Hashtbl.create 1 in
  Hashtbl.add update_map vacation_id updates;
  
  let set_args = Jmap.Methods.Set_args.v
    ~account_id
    ~update:update_map
    () in
    
  let invocation = Jmap.Wire.Invocation.v
    ~method_name:"VacationResponse/set"
    ~arguments:(`Assoc []) (* Would serialize set_args *)
    ~method_call_id:"set1"
    () in
    
  let request = Jmap.Wire.Request.v
    ~using:[Jmap.capability_core; Jmap_email.capability_mail; Jmap_email.capability_vacationresponse]
    ~method_calls:[invocation]
    () in
    
  match Jmap_unix.request ctx request with
  | Ok _ -> Ok ()
  | Error e -> Error e

(* Process vacation action *)
let process_vacation_action ctx session account_id action =
  match action with
  | Show ->
      (match get_vacation_response ctx session account_id with
      | Ok vacation ->
          show_vacation_response vacation;
          0
      | Error e ->
          Printf.eprintf "Failed to get vacation response: %s\n" (Jmap.Error.error_to_string e);
          1)
      
  | Enable config ->
      Printf.printf "Enabling vacation response...\n";
      
      (* Build the vacation response object *)
      let vacation = Jmap_email.Vacation.Vacation_response.v
        ~id:"singleton"
        ~is_enabled:true
        ?subject:config.subject
        ~text_body:config.text_body
        ?html_body:config.html_body
        ?from_date:config.from_date
        ?to_date:config.to_date
        () in
        
      (match update_vacation_response ctx session account_id "singleton" vacation with
      | Ok () ->
          Printf.printf "\nVacation response enabled successfully!\n";
          
          (* Show what was set *)
          show_vacation_response vacation;
          0
      | Error e ->
          Printf.eprintf "Failed to enable vacation response: %s\n" (Jmap.Error.error_to_string e);
          1)
      
  | Disable ->
      Printf.printf "Disabling vacation response...\n";
      
      let updates = Jmap_email.Vacation.Vacation_response.v
        ~id:"singleton"
        ~is_enabled:false
        () in
        
      (match update_vacation_response ctx session account_id "singleton" updates with
      | Ok () ->
          Printf.printf "Vacation response disabled successfully!\n";
          0
      | Error e ->
          Printf.eprintf "Failed to disable vacation response: %s\n" (Jmap.Error.error_to_string e);
          1)
      
  | Update config ->
      Printf.printf "Updating vacation response...\n";
      
      (* Only update specified fields *)
      let vacation = Jmap_email.Vacation.Vacation_response.v
        ~id:"singleton"
        ?subject:config.subject
        ~text_body:config.text_body
        ?html_body:config.html_body
        ?from_date:config.from_date
        ?to_date:config.to_date
        () in
        
      (match update_vacation_response ctx session account_id "singleton" vacation with
      | Ok () ->
          Printf.printf "Vacation response updated successfully!\n";
          
          (* Show current settings *)
          (match get_vacation_response ctx session account_id with
          | Ok current -> show_vacation_response current
          | Error _ -> ());
          0
      | Error e ->
          Printf.eprintf "Failed to update vacation response: %s\n" (Jmap.Error.error_to_string e);
          1)

(* Command implementation *)
let vacation_command host user password enable disable show subject message 
                     message_file html_message from_date to_date exclude : int =
  Printf.printf "JMAP Vacation Manager\n";
  Printf.printf "Server: %s\n" host;
  Printf.printf "User: %s\n\n" user;
  
  (* Determine action *)
  let action_count = (if enable then 1 else 0) + 
                     (if disable then 1 else 0) + 
                     (if show then 1 else 0) in
                     
  if action_count = 0 then (
    Printf.eprintf "Error: Must specify an action: --enable, --disable, or --show\n";
    exit 1
  );
  
  if action_count > 1 then (
    Printf.eprintf "Error: Can only specify one action at a time\n";
    exit 1
  );
  
  (* Build vacation config if enabling or updating *)
  let config = if enable || (not disable && not show) then
    (* Read message content *)
    let text_body = match message, message_file with
      | Some text, _ -> text
      | None, Some file -> read_file file
      | None, None ->
          if enable then (
            Printf.eprintf "Error: Must provide vacation message (--message or --message-file)\n";
            exit 1
          ) else ""
    in
    
    (* Parse dates *)
    let from_date = match from_date with
      | Some date_str -> parse_date date_str
      | None -> None
    in
    
    let to_date = match to_date with
      | Some date_str -> parse_date date_str
      | None -> None
    in
    
    Some {
      subject;
      text_body;
      html_body = html_message;
      from_date;
      to_date;
      exclude_addresses = exclude;
    }
  else
    None
  in
  
  (* Determine action *)
  let action = 
    if show then Show
    else if disable then Disable
    else if enable then Enable (Option.get config)
    else Update (Option.get config)
  in
  
  (* Connect to server *)
  let ctx = Jmap_unix.create_client () in
  let result = Jmap_unix.quick_connect ~host ~username:user ~password in
  
  let (ctx, session) = match result with
    | Ok (ctx, session) -> (ctx, session)
    | Error e -> 
        Printf.eprintf "Connection failed: %s\n" (Jmap.Error.error_to_string e);
        exit 1
  in
  
  (* Check vacation capability *)
  (* Note: has_capability not available in interface, assuming server supports it *)
  
  (* Get the primary account ID *)
  let account_id = match Jmap.get_primary_account session Jmap_email.capability_mail with
    | Ok id -> id
    | Error e -> 
        Printf.eprintf "No mail account found: %s\n" (Jmap.Error.error_to_string e);
        exit 1
  in
  
  (* Process the action *)
  process_vacation_action ctx session account_id action

(* Command definition *)
let vacation_cmd =
  let doc = "manage vacation/out-of-office auto-responses" in
  let man = [
    `S Manpage.s_description;
    `P "Manage vacation responses (out-of-office auto-replies) via JMAP.";
    `P "Configure automatic email responses for when you're away.";
    `S Manpage.s_examples;
    `P "Show current vacation settings:";
    `P "  $(mname) -h jmap.example.com -u [e-mail] -p secret123 --show";
    `P "";
    `P "Enable vacation response:";
    `P "  $(mname) -h jmap.example.com -u [e-mail] -p secret123 --enable \\";
    `P "    --subject \"Out of Office\" \\";
    `P "    --message \"I am currently out of the office and will return on Monday.\"";
    `P "";
    `P "Enable with date range:";
    `P "  $(mname) -h jmap.example.com -u [e-mail] -p secret123 --enable \\";
    `P "    --message-file vacation.txt \\";
    `P "    --from-date 2024-07-01 --to-date 2024-07-15";
    `P "";
    `P "Disable vacation response:";
    `P "  $(mname) -h jmap.example.com -u [e-mail] -p secret123 --disable";
  ] in
  
  let cmd =
    Cmd.v
      (Cmd.info "jmap-vacation-manager" ~version:"1.0" ~doc ~man)
      Term.(const vacation_command $ host_arg $ user_arg $ password_arg $ 
            enable_arg $ disable_arg $ show_arg $ subject_arg $ message_arg $
            message_file_arg $ html_message_arg $ from_date_arg $ to_date_arg $
            exclude_arg)
  in
  cmd

(* Main entry point *)
let () = exit (Cmd.eval' vacation_cmd)