open Lwt
open XHTML.M
open Eliom_services
open Eliom_parameters
open Eliom_predefmod.Xhtml

(* Data Types *)
let db_name = "/var/www/ocsigen/reminder.db"

type reminder = { id : string; description: string; registered: float; due: float;
		  contact : string list; inactive : string list} with orm

type account = { email : string; token : string; count : int } with orm

let string_of_reminder r = r.id
let reminder_of_string i =
  let db = reminder_init db_name in
    match (reminder_get ~id:(`Eq i) db) with
      |(r::rs) -> r
      |_ -> raise Not_found


(* Urls *)
let completed =
  new_service
    ~path:["done"]
    ~get_params:(user_type reminder_of_string string_of_reminder "id" ** (string "email" ** string "token"))
    ()

let confirm = 
  new_service
    ~path:["confirm"]
    ~get_params:(user_type reminder_of_string string_of_reminder "id" ** (string "email" ** string "token"))
    ()

let who = 
  new_service
    ~path:["who"]
    ~get_params:(string "email" ** string "token")
    ()

let summary = 
  new_service
    ~path:[""]
    ~get_params:unit
    ()

(* Page Helpers *)
let now () = let t = Unix.localtime (Unix.time ()) in
  (t.Unix.tm_year, (t.Unix.tm_mon + 1 ,t.Unix.tm_mday))

let html_page body_html =
  return
    (html
       (head (title (pcdata "")) [] )
       (body body_html))

let sort_reminders = BatList.sort ~cmp:(fun s1 s2 -> compare s1.due s2.due)

let time_left due = 
  match (due -. (Unix.time ())) with
    | t when t < 0. -> " is OVERDUE!"
    | t when t < 60. -> " in less than a minute"
    | t when t < 3600. -> " in " ^ (string_of_int (int_of_float (t/.60.))) ^ " minutes"
    | t when t < 86400. -> " in " ^ (string_of_int (int_of_float (t/.3600.))) ^ " hours"
    | t when t < 2678400. -> " in " ^ (string_of_int (int_of_float (t/.86400.))) ^ " days"
    | t when t < 32140800. -> " in " ^ (string_of_int (int_of_float (t/.2678400.))) ^ " months" 
    | t -> "in over a year"

let show_reminders sp rs em tok = div (List.map (fun r -> p [ a (preapply completed (r, (em, tok))) sp [pcdata "mark done"] (); 
								 pcdata " ";
								 pcdata (r.description ^ (time_left r.due))]) rs)

let with_login em tok bad good = 
  let db_acc = account_init db_name in
    match account_get ~email:(`Eq em) ~token:(`Eq tok) db_acc with
      |[] -> bad ()
      |(a::_) -> good a


let hash_for_url s = BatString.replace_chars (function '/' ->  "" | '=' -> "" | c -> BatString.of_char c) (Netencoding.Base64.encode s)


let send_confirmation em r =
  let db_acc = account_init db_name in
  let token = 
    match (account_get ~email:(`Eq em) db_acc) with
      |[] ->
	 let tok = hash_for_url (Cryptokit.Random.string (Cryptokit.Random.device_rng "/dev/urandom") 5) in
	   begin
	     account_save db_acc {email=em; token=tok; count=0};
	     tok
	   end
      |(a::_) -> a.token in
  let uri = 
    "http://lab.dbpatterson.com/remind/confirm?id=" ^ r.id
    ^ "&token=" ^ token ^ "&email=" ^ em in
    begin
      Printf.printf "Sending confirmation %s." uri;
      if BatString.ends_with em "@txt.att.net"
      then (* wicked short version for my mobile *)
	Lwt_preemptive.detach 
	  (fun () -> Sendmail.sendmail 
	     ("", em)
	     "CONFIRM EMAIL REMINDER"
	     ("for " ^ (BatString.slice ~last:40 r.description) ^ "\n" ^ uri)
	     ()) ()
      else (* Regular email version *)
	Lwt_preemptive.detach
	  (fun () -> Sendmail.sendmail
	     ("", em)
	     ("Confirm registration of reminder: " ^ (BatString.slice ~last:40 r.description) ^ " due " ^ (time_left r.due))
	     (uri ^ "\n\nView all your tasks: http://lab.dbpatterson.com/remind/who?email=" ^ em ^ "&token=" ^ token)
	     ()) ()
    end

(* Actions *)
let delete_action =
  Eliom_predefmod.Action.register_new_post_coservice'
    ~post_params:(user_type reminder_of_string string_of_reminder "reminder")
    (fun sp () reminder ->
       let db = reminder_init db_name in
	 reminder_delete db reminder;
	 Lwt.return ())

let record_action =
  Eliom_predefmod.Action.register_new_post_coservice'
    ~post_params:(int "year" ** (int "month" ** (int "day" **
                 (int "hour" ** (int "minute" ** (string "token" ** (string "contact" ** 
		 (string "description"))))))))
    (fun _ () (y, (mo, (da, (hr, (min, (tok, (cont, desc))))))) ->
       let reg = Unix.time () in
       let (due, _) = Unix.mktime {Unix.tm_sec=0; Unix.tm_min=min; Unix.tm_hour = hr-3 (* west coast time *);
				   Unix.tm_mday=da;Unix.tm_mon=(mo-1);Unix.tm_year=(y - 1900);
				   Unix.tm_wday=0; Unix.tm_yday=0; Unix.tm_isdst=false} in
       let good_email s = 
	 try
	   match (List.hd (Netaddress.parse s)) with 
	     |`Mailbox m -> begin 
		 match m#spec with
		   |(nam, Some host) -> true
		   |_ -> raise (Netaddress.Parse_error (0, "error parsing, didn't have name and host"))
	       end
	     |`Group g -> raise (Netaddress.Parse_error (0,"error parsing, ended up with group"))
	 with |e -> false in
       let contact = List.filter good_email (List.map BatString.trim (BatString.nsplit cont ",")) in
       let id = 
	 let h = Cryptokit.Hash.sha1 () in
	 let _ = h#add_string ((string_of_float reg) ^ (string_of_float due) ^ desc ^ cont) in
	   hash_for_url (h#result) in
       let db_acc = account_init db_name in
	 if (BatList.is_empty contact) then
	   return () else
	 match account_get ~token:(`Eq tok) db_acc with
	   |ts when ts = [] || "" = tok || not (List.mem (List.hd ts).email contact) ->
	      let r = {id=id; description=desc; registered=reg; due=due;
		       contact=[]; inactive=contact} in
	      let db = reminder_init db_name in
		begin
		  Lwt_list.iter_s (fun em -> send_confirmation em r) contact >>=
		  (fun () -> Lwt_preemptive.detach (fun () -> reminder_save db r) ()) >>=
		  (fun () -> Lwt.return ())
		end
	   |(a::_) ->
	      let unconfirmed = List.filter ((<>) a.email) contact in
	      let r = {id=id; description=desc; registered=reg; due=due;
		       contact=[a.email]; inactive= unconfirmed} in
	      let db = reminder_init db_name in
		begin
		  Lwt_list.iter_s (fun em -> send_confirmation em r) unconfirmed >>=
		  (fun () -> Lwt_preemptive.detach (fun () -> reminder_save db r) ()) >>=
		  (fun () -> Lwt.return ())
		end)

(* Forms *)
let record_form em tok = 
  (fun (year_n, (month_n, (day_n, (hour_n, (min_n, (token_n, (contact_n, description_n))))))) ->
     let (year,(month,day)) = now () in
       [p [pcdata "Year: ";
	   int_select ~name:year_n (Option ([], 2010, None, 2010 = year))
	   (List.map (fun y -> (Option ([], y, None, y = year))) 
		(BatList.init 5 ((+) 2011)));
	   pcdata "Month: ";
	   int_select ~name:month_n (Option ([], 1, None, 1 = month)) 
	     (List.map (fun m -> (Option ([], m, None, m = month))) 
		(BatList.init 11 ((+) 2)));
	   pcdata "Day: ";
	   int_select ~name:day_n (Option ([], 1, None, 1 = day)) 
	     (List.map (fun d -> (Option ([], d, None, d = day))) 
		(BatList.init 30 ((+) 2)));
	   pcdata "Hour: ";
	   int_select ~name:hour_n (Option ([], 0, None, false)) 
	     (List.map (fun h -> (Option ([], h, None, false))) 
		(BatList.init 23 ((+) 1)));
	   pcdata "Minute: ";
	   int_select ~name:min_n (Option ([], 0, None, false)) 
	     (List.map (fun m -> (Option ([], m, None, false))) 
		(BatList.init 59 ((+) 1)));
	   br ();
	   pcdata "Description: ";
	   br ();
	   textarea ~name:description_n ~rows:3 ~cols:50 ();
	   br ();
	   string_input ~input_type:`Hidden ~name:token_n ~value:tok ();
	   pcdata "Contact (email addresses, separatd by ','): ";
	   br ();
	   textarea ~name:contact_n ~rows:3 ~cols:20 ~value:em ();
	   br ();
	   string_input ~input_type:`Submit ~value:"Remind Me" ()]])  

(* Url Handlers *)
let _ =
  register completed
    (fun sp (r,(e, t)) () ->
       with_login e t
	 (fun () -> html_page [h2 [pcdata "Invalid email/token."]])
	 (fun ac -> 
	    if List.mem e r.contact 
	    then 
	      let db = reminder_init db_name in
	      let db_acc = account_init db_name in
		begin
		  reminder_delete db r;
		  account_save db_acc {ac with count=(ac.count+1)};
		  html_page [h2 [pcdata "Completed!"];
			     div [pcdata ("Marked " ^ r.description ^ " as done.");
				  br ();
				  a (preapply who (e,t)) sp [pcdata "see all tasks"] ()]]
		end 
	    else html_page [h2 [pcdata "Invalid email/token."]]))
    
let _ =
  Eliom_predefmod.Redirection.register confirm 
    (fun sp (r, (e, t)) ->
       with_login e t 
	 (fun () -> (fun () -> return summary))
	 (fun _ -> 
	    let db = reminder_init db_name in
	      begin
		reminder_delete db r;
		reminder_save db {r with 
				    contact = r.contact@(List.filter ((=) e) r.inactive); 
				    inactive=(List.filter ((<>) e) r.inactive)};
		(fun () -> return (preapply who (e,t)))
	      end))

let _ =
  register who
    (fun sp (em,tok) () ->
       with_login em tok
	 (fun () ->
	    html_page [h2 [pcdata "Invalid email/token."]])
	 (fun ac ->
	    let db = reminder_init db_name in
	    let outstanding = sort_reminders (reminder_get ~custom:(fun r -> List.mem em r.contact) db) in
	      html_page [h2 [pcdata ("Reminders for " ^ em ^ ":")];
			 show_reminders sp outstanding em tok;
			 div [p [pcdata ((string_of_int (ac.count)) ^ " completed tasks.")]];
			 h2 [pcdata "Add a reminder:"];
			 div [post_form record_action sp (record_form em tok) ()];
			 div [a (preapply who (em,tok)) sp [pcdata "refresh"] ()]]))

let _ =
  register summary
    (fun sp () () ->
       html_page [h2 [pcdata "Reminders!"];
		  div [post_form record_action sp (record_form "" "") ()]])