(* Ocsigen
 * http://www.ocsigen.org
 * Module eliommod_pagegen.ml
 * Copyright (C) 2007 Vincent Balat
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU Lesser General Public License as published by
 * the Free Software Foundation, with linking exception;
 * either version 2.1 of the License, or (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU Lesser General Public License for more details.
 *
 * You should have received a copy of the GNU Lesser General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 *)

open Lwt.Infix

let headers_with_content_type headers =
  Cohttp.Header.add_opt
    headers
    Ocsigen_header.Name.(to_string content_type)
    (Printf.sprintf "%s; charset=utf-8"
       Eliom_content_core.Html.D.Info.content_type)

let out =
  let encode x = fst (Xml_print.Utf8.normalize_html x) in
  Eliom_content_core.Html.Printer.pp ~encode ()

let make_response ?headers ~status body =
  let body = Cohttp_lwt.Body.of_string (Format.asprintf "%a" out body)
  and response =
    let headers = headers_with_content_type headers in
    Cohttp.Response.make ~status ~headers ()
  in
  Lwt.return (Ocsigen_response.make ~body response)

(* module Html_content = Ocsigen_senders.Make_XML_Content(Xml)(Html.F) *)

(* Exception handler for the site *)

let def_handler e = Lwt.fail e

(* Update cookie tables *)
let update_cookie_table ?now sitedata (ci, sci) =
  let now = match now with
    | Some n -> n
    | None -> Unix.gettimeofday ()
  in

  let update_exp
      (service_cookies_info, data_cookies_info, pers_cookies_info) =
  (* Update service expiration date and value *)
    Eliom_common.Full_state_name_table.iter

      (fun name (_oldvalue, newr) ->
      (* catch fun () -> *)
        match !newr with
          | Eliom_common.SCData_session_expired
          | Eliom_common.SCNo_data -> () (* The cookie has been removed *)
          | Eliom_common.SC newc ->
            newc.Eliom_common.sc_exp :=
              match !(newc.Eliom_common.sc_timeout) with
                | Eliom_common.TGlobal ->
                  let globaltimeout =
                    Eliommod_timeouts.find_global `Service name sitedata
                  in
                  (match globaltimeout with
                    | None -> None
                    | Some t -> Some (t +. now))
                | Eliom_common.TNone -> None
                | Eliom_common.TSome t -> Some (t +. now)
      )

      !service_cookies_info;

    (* Update "in memory data" expiration date and value *)
    Eliom_common.Full_state_name_table.iter

      (fun name v ->
        (* 2018-07-17 We do this for all volatile sessions,
           even if it has not been used,
           otherwise, sessions could have different duration.
           (Before: we were doing this only if (Lazy.is_val v))
           Keeping same duration is important for example for comet
           (which is using both service and volatile data sessions).
        *)
         let (_oldvalue, newr) = Lazy.force v in
         match !newr with
         | Eliom_common.SCData_session_expired
         | Eliom_common.SCNo_data -> () (* The cookie has been removed *)
         | Eliom_common.SC newc ->
           newc.Eliom_common.dc_exp :=
             match !(newc.Eliom_common.dc_timeout) with
             | Eliom_common.TGlobal ->
               let globaltimeout =
                 Eliommod_timeouts.find_global `Data name sitedata
               in
               (match globaltimeout with
                | None -> None
                | Some t -> Some (t +. now))
             | Eliom_common.TNone -> None
             | Eliom_common.TSome t -> Some (t +. now)
      )

      !data_cookies_info;

    let module Expiry_tolerance = struct
      (* Avoid cookie updates that only change the cookie
         expiry date by a negligible amount of time. *)
      let timeout_tolerance_factor = 0.01
      let within_tolerance x y =
        let diff = Float.abs (x -. y) in
        diff < timeout_tolerance_factor *. Float.abs (x -. now)
      let within_tolerance_opt x y = match x, y with
        | Some x, Some y -> within_tolerance x y
        | _ -> x = y
    end in

    (* Update persistent expiration date, user timeout and value *)
    (* 2018-07-17 We do this for all persistent sessions
       only if one persistent session has been used:
       - all persistent sessions will have same duration
       - will not do too many database requests
    *)
    if
      Eliom_common.Full_state_name_table.exists
        (fun _ v -> Lazy.is_val v)
        !pers_cookies_info
    then
      Eliom_common.Full_state_name_table.fold

        (fun name v thr ->
           let thr2 =
            Lazy.force v >>= fun (oldvalue, newr) ->
            match !newr with
              | Eliom_common.SCData_session_expired
              | Eliom_common.SCNo_data -> (* The cookie has been removed *)
                Lwt.return ()
              | Eliom_common.SC newc ->
                let newexp =
                  match !(newc.Eliom_common.pc_timeout) with
                    | Eliom_common.TGlobal ->
                      let globaltimeout =
                        Eliommod_timeouts.find_global `Persistent
                          name sitedata
                      in
                      (match globaltimeout with
                        | None -> None
                        | Some t -> Some (t +. now))
                    | Eliom_common.TNone -> None
                    | Eliom_common.TSome t -> Some (t +. now)
                in
                match oldvalue with
                  | Some (_, oldti, oldexp, oldgrp) when
                      (Expiry_tolerance.within_tolerance_opt oldexp newexp &&
                          oldti = !(newc.Eliom_common.pc_timeout) &&
                          oldgrp = !(newc.Eliom_common.pc_session_group) &&
                       newc.Eliom_common.pc_set_value = None) -> Lwt.return ()
                (* nothing to do *)
                  | Some (_, _oldti, oldexp, _oldgrp) when
                      newc.Eliom_common.pc_set_value = None ->
                    Lwt.catch
                      (fun () ->
                        let cookieid = Eliom_common.(Hashed_cookies.to_string newc.pc_hvalue) in
                        Eliommod_cookies.Persistent_cookies.replace_if_exists
                          cookieid
                          {Eliommod_cookies.full_state_name = name;
                           expiry = newexp;
                           timeout = !(newc.Eliom_common.pc_timeout);
                           session_group = !(newc.Eliom_common.pc_session_group)}
                        >>= fun () ->
                        Eliommod_cookies.Persistent_cookies.Expiry_dates.remove_cookie oldexp cookieid)
                      (function
                        | Not_found -> Lwt.return ()
                        (* someone else closed the session *)
                        | e -> Lwt.fail e)
                  | _ ->
                    Eliommod_cookies.Persistent_cookies.add
                      Eliom_common.(Hashed_cookies.to_string newc.pc_hvalue)
                      {Eliommod_cookies.full_state_name = name;
                       expiry = newexp;
                       timeout = !(newc.Eliom_common.pc_timeout);
                       session_group = !(newc.Eliom_common.pc_session_group)}

        (*VVV Do not forget to change persistent_cookie_table_version
          if you change the type of persistent table data,
          otherwise the server will crash!!!
        *)
        in thr >>= fun () -> thr2
      )

      !pers_cookies_info

      Lwt.return_unit
    else Lwt.return_unit
  in
  update_exp ci >>= fun () ->

  (* the same, for secure cookies: *)
  update_exp sci


(*****************************************************************************)
(* Generation of the page or naservice
   + update the cookie tables (value, expiration date and timeout)        *)

let execute
    now
    generate_page
    ({Eliom_common.all_cookie_info; tab_cookie_info} as info)
    sitedata =
  let%lwt result =
    Lwt.catch
      (fun () -> generate_page now info sitedata)
      (fun e -> sitedata.Eliom_common.exn_handler e)
  in
  let%lwt () = update_cookie_table ~now sitedata all_cookie_info in
  let%lwt () = update_cookie_table ~now sitedata tab_cookie_info in
  Lwt.return result



(** Set expired sessions in request data *)
let set_expired_sessions ri closedservsessions =
  if closedservsessions = ([], [])
  then ()
  else
    Polytables.set
      (Ocsigen_request.request_cache
        ri.Ocsigen_extensions.request_info)
      Eliom_common.eliom_service_session_expired
      closedservsessions


open Ocsigen_extensions

let handled_method = function
  | `GET
  | `HEAD
  | `POST
  | `PUT
  | `DELETE -> true
  | _ -> false

let do_redirection header_id status uri =
  Ocsigen_extensions.Ext_found
    (fun () ->
      let response =
        let headers =
          Cohttp.Header.init_with
            Ocsigen_header.Name.(to_string header_id)
            uri
        in
        Cohttp.Response.make ~status ~headers ()
      in
      Lwt.return (Ocsigen_response.make response))

let gen_req_not_found ~is_eliom_extension ~sitedata ~previous_extension_err ~req =
  let req = Eliom_common.patch_request_info req in
  let now = Unix.gettimeofday () in
  let%lwt (ri, si, previous_tab_cookies_info) =
    Eliom_common.get_session_info sitedata req 404
  in
  let (all_cookie_info, closedsessions) =
    Eliommod_cookies.get_cookie_info now
      sitedata
      si.Eliom_common.si_service_session_cookies
      si.Eliom_common.si_data_session_cookies
      si.Eliom_common.si_persistent_session_cookies
      si.Eliom_common.si_secure_cookie_info
  in
  let ((tab_cookie_info, closedsessions_tab), user_tab_cookies) =
    (* If tab cookie info exists in rc (because an action put them here),
       we get it from here.
       Otherwise we get it from tab cookies in parameters.
    *)
    match previous_tab_cookies_info with
      | Some (atci, utc) -> ((atci, []), utc)
      | None ->
        ((Eliommod_cookies.get_cookie_info now
            sitedata
            si.Eliom_common.si_service_session_cookies_tab
            si.Eliom_common.si_data_session_cookies_tab
            si.Eliom_common.si_persistent_session_cookies_tab
            si.Eliom_common.si_secure_cookie_info_tab),
         Ocsigen_cookie_map.empty
        )
  in
  set_expired_sessions ri (closedsessions, closedsessions_tab);
  let rec gen_aux ({Eliom_common.request = ri;
                                 session_info = si;
                                 all_cookie_info} as info) =
    let sp = Eliom_common.make_server_params sitedata info None None in
    (* The last two arguments are not yet available, so for now we use None.
       This value will later be overwritten once this information is available. *)
    Lwt.with_value Eliom_common.sp_key (Some sp) @@ fun () ->
    let genfun =
      match si.Eliom_common.si_nonatt_info with
        | Eliom_common.RNa_no ->
          (* page generation *)
          Eliom_route.get_page
        | _ ->
          (* anonymous service *)
          Eliom_route.make_naservice
    in
    Lwt.catch
      (fun () ->
         let%lwt res = execute now genfun info sitedata in
         let response, _ = Ocsigen_response.to_cohttp res
         and all_user_cookies = Ocsigen_response.cookies res in
         let%lwt cookies =
           Eliommod_cookies.compute_cookies_to_send
             sitedata
             all_cookie_info
             all_user_cookies
         in
         let res =
           match
             Ocsigen_request.header
               ri.Ocsigen_extensions.request_info
               (Ocsigen_header.Name.of_string
                  Eliom_common_base.cookie_substitutes_header_name)
           with
           | Some _ ->
             let response =
               let headers =
                 Cohttp.Header.add
                   (Cohttp.Response.headers response)
                   Eliom_common_base.set_cookie_substitutes_header_name
                   (Eliommod_cookies.cookieset_to_json cookies)
               in
               { response with Cohttp.Response.headers }
             in
             Ocsigen_response.update ~response ~cookies res
           | None ->
             Ocsigen_response.update ~cookies res
         in
         try
           Polytables.get
             ~table:
               (Ocsigen_request.request_cache
                  ri.Ocsigen_extensions.request_info)
             ~key:Eliom_common.found_stop_key;
           (* if we find this information in request cache,
              the request has already been completed.
              (used after an action).
              Do not try the following extensions.
           *)
           Lwt.return
             (Ocsigen_extensions.Ext_found_stop
                (fun () -> Lwt.return res))
         with Not_found ->
           Lwt.return
             (Ocsigen_extensions.Ext_found (fun () -> Lwt.return res))
      )
      (function
        (* FIXME COHTTP transition ; restore all that *)
         | Eliom_common.Eliom_Typing_Error l ->
           Lwt.return
             (Ocsigen_extensions.Ext_found
                (fun () ->
                   make_response ~status:`Bad_request
                     (Eliom_error_pages.page_error_param_type l)))
         | Eliom_common.Eliom_Wrong_parameter ->
           let%lwt ripp =
             match
               Ocsigen_request.post_params
                 req.request_info
                 ri.request_config.Ocsigen_extensions.uploaddir
                 ri.request_config.Ocsigen_extensions.maxuploadfilesize
             with
             | None ->
               Lwt.return []
             | Some l ->
               l
           in
           let response =
             Eliom_error_pages.page_bad_param
               (try
                  ignore @@ Polytables.get
                    ~table:
                      (Ocsigen_request.request_cache
                         ri.request_info)
                    ~key:Eliom_common.eliom_params_after_action;
                  true
                with Not_found ->
                  false)
               (Ocsigen_request.get_params_flat ri.request_info)
               (List.map fst ripp)
           in
           Lwt.return @@
           Ocsigen_extensions.Ext_found
             (fun () ->
                make_response ~status:`Bad_request response)
         | Eliom_common.Eliom_404 ->
           Lwt.return
             (Ocsigen_extensions.Ext_next previous_extension_err)
         | Eliom_common.Eliom_retry_with a -> gen_aux a
         | Eliom_common.Eliom_do_redirection uri ->
           Lwt.return @@
           do_redirection
             Ocsigen_header.Name.location
             `Temporary_redirect
             uri
         | Eliom_common.Eliom_do_half_xhr_redirection uri ->
           Lwt.return @@
           do_redirection
             (Ocsigen_header.Name.of_string
                Eliom_common.half_xhr_redir_header)
             `No_content
             uri
         | e -> Lwt.fail e)
  in
  let info =
    {Eliom_common.request = ri;
     session_info = si;
     all_cookie_info;
     tab_cookie_info;
     user_tab_cookies}
  in
  begin match is_eliom_extension with
    | Some ext -> Eliom_extension.run_eliom_extension ext now info sitedata
    | None -> gen_aux info
  end

let gen is_eliom_extension sitedata =
  let open Ocsigen_extensions in
  function
  | Req_found _ ->
    Lwt.return Ext_do_nothing
  | Req_not_found (`Not_found as previous_extension_err, req)
    when handled_method (Ocsigen_request.meth
                           req.request_info) ->
    gen_req_not_found ~is_eliom_extension ~sitedata ~previous_extension_err ~req
  | Req_not_found (_, _ri) ->
    Lwt.return Ext_do_nothing
