(*
 *    _  _   ____                         _  
 *  _| || |_/ ___|  ___ _ __  _ __   ___ | | 
 * |_  ..  _\___ \ / _ \ '_ \| '_ \ / _ \| | 
 * |_      _|___) |  __/ |_) | |_) | (_) |_| 
 *   |_||_| |____/ \___| .__/| .__/ \___/(_) 
 *                     |_|   |_|             
 *
 * Personal Social Web.
 *
 * cgi.ml
 *
 * Copyright (C) The #Seppo contributors. All rights reserved.
 *
 * This program is free software: you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation, either version 3 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 General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program.  If not, see <http://www.gnu.org/licenses/>.
 *)

open Seppo_lib

let ( let* ) = Result.bind
let ( >>= )  = Result.bind
let ( >>| ) a b = match a with
  | Error _ as e -> Lwt.return e
  | Ok a -> b a

(* still does a Lwt_main.run *)
let handle uuid tnow ic (req : Cgi.Request.t) : Cgi.Response.t =
  let t0 = Sys.time() in
  Logr.debug (fun m -> m "%s.%s %a %s %s %s" "Cgi" "handle" Uuidm.pp uuid req.remote_addr req.request_method req.path_info);
  let redir_if_auth_miss (r : Cgi.Request.t) =
    let loc = Iweb.Passwd.path in
    if (Auth.fn |> File.exists) || (r.path_info |> String.equal loc)
    then Ok r
    else
      let* sec = Result.map_error
          (Http.err500 "expected cookie secret")
          Cfg.CookieSecret.(make "" >>= from_file) in
      (* start a 'recovery' session *)
      let header = [ Iweb.MyCookie.new_session ~tnow sec req Auth.dummy ] in
      r.script_name ^ loc |> Http.s302 ~header
  and restore_assets lst r = let _ = Assets.Const.restore_if_nonex File.pFile lst in
    Ok r in
  let dispatch (r : Cgi.Request.t) =
    (* Logr.debug (fun m -> m "%s.%s path_info '%s'" "Cgi" "handle.dispatch" r.path_info); *)
    let fn_tok = "app/var/run/token" in
    let send_file ct p = p
                         |> File.to_string
                         |> Http.clob_send uuid ct
    and send_res ct p = match p |> Res.read with
      | None   -> Http.s500
      | Some b -> Http.clob_send uuid ct b
    and ases = Iweb.ases tnow
    and auth = Iweb.uid_redir
    and ban  = Ban.escalate Ban.cdb
    and csrf_mk v =
      Logr.debug(fun m -> m "%s.%s create and store token" "Cgi" "handle.dispatch");
      (* is it ok to use the request uuid as token? *)
      let tok = uuid |> Uuidm.to_string in
      let mode = [ Open_binary; Open_creat; Open_trunc; Open_wronly ] in
      File.out_channel ~mode fn_tok (fun oc -> output_string oc tok);
      Ok (tok, v)
    and csrf_ck v =
      Logr.debug (fun m -> m "%s.%s load and purge token" "Cgi" "handle.dispatch");
      let tok = File.in_channel fn_tok input_line in
      Iweb.check_token (fun () -> Unix.unlink fn_tok) tok v
    and form ic r = Ok (Http.Form.of_channel ic, r)
    and base () = (* lazy, may not exist yet *) Cfg.Base.(from_file fn) |> Result.get_ok
    and s302
        ?(qs="")
        ?(header = [])
        p =
      r.script_name ^ p ^ qs
      |> Http.s302 ~header
    and rt = Lwt.return in
    let re = match r.path_info, r.request_method |> Cohttp.Code.method_of_string with
      | ("/var/lock/challenge" as p,   `GET) -> let f = "app" ^ p in f |> send_file Http.Mime.text_plain |> rt
      | ("/doap.rdf" as p,             `GET) -> p |> send_res Http.Mime.text_xml |> rt
      | ("/LICENSE" as p,              `GET)
      | ("/version" as p,              `GET) -> p |> send_res Http.Mime.text_plain |> rt
      | "/search",                     `GET  -> Http.s501 |> rt
      | "/ping",                       `GET  -> r |>                                           Iweb.Ping.get ~base uuid
      | "/activitypub/inbox.jsa",      `POST -> r |>                                           Is2s.Inbox.post ~base uuid tnow ic
      (* | "/activitypub/monitor.txt", `GET  -> r |> Activitypub.monitor *)
      | "/passwd",                     `GET  -> r |> ases >>= auth >>=             csrf_mk >>= Iweb.Passwd.get uuid |> rt
      | "/passwd",                     `POST -> r |> ases >>= auth >>= form ic >>= csrf_ck >>= Iweb.Passwd.post uuid tnow |> rt
      | "/login",                      `GET  -> r |>                               csrf_mk >>= Iweb.Login.get uuid |> rt
      | "/login",                      `POST -> r |>                   form ic >>= csrf_ck >>= Iweb.Login.post uuid tnow ban |> rt
      | "/logout",                     `GET  -> r |> ases                                  >>= Iweb.Logout.get uuid |> rt
      | "/edit",                       `GET
      | "/post",                       `GET  -> r |> ases >>= auth >>=             csrf_mk >>= Iweb.Post.get ~base uuid |> rt
      | "/edit",                       `POST
      | "/post",                       `POST -> r |> ases >>= auth >>= form ic >>= csrf_ck >>| Iweb.Post.post ~base uuid tnow
      | "/activitypub/actor.xml",      `GET  -> r |> ases >>= auth >>=             csrf_mk >>| Iweb.Actor.get ~base uuid
      | "/activitypub/actor.xml",      `POST -> r |> ases >>= auth >>= form ic >>= csrf_ck >>| Iweb.Actor.post ~base uuid tnow
      | "/activitypub/actor.xml/icon", `GET  -> r |>                                           Iweb.Actor.Icon.get ~base uuid
      | "/backoffice/",                `GET  -> r |> ases >>= auth                         >>= Iweb.Health.get ~base uuid |> rt
      | "/http",                       `GET  -> r |> ases >>= auth                         >>| Iweb.Http_.get ~base uuid tnow
      | "/note",                       `GET  -> r |> ases >>= auth >>=             csrf_mk >>= Iweb.Note.get uuid |> rt
      | "/profile",                    `GET  -> r |> ases >>= auth >>=             csrf_mk >>= Iweb.Profile.get uuid |> rt
      | "/profile",                    `POST -> r |> ases >>= auth >>= form ic >>= csrf_ck >>= Iweb.Profile.post uuid tnow |> rt
      | "/session",                    `GET  -> r |> ases                                  >>= Iweb.Session.get uuid |> rt
      | "/notifyme",                   `GET  -> r |> Result.ok                             >>| Iweb.Notifyme.get ~base uuid tnow
      | "/tools",                      `GET  -> Http.s501 |> rt
      | "/tools",                      `POST -> Http.s501 |> rt
      | "/",                           `GET  -> ".." |> Http.s302 |> rt
      | "",                            `GET when "" = r.query_string -> Http.s302 "." |> rt
      | "",                            `GET  -> (let q = r.query_string |> Uri.query_of_encoded in
                                                 (* shaarli compatibility *)
                                                 match q |> List.assoc_opt "do" with
                                                 | Some ["login"]     -> s302 Iweb.Login.path
                                                 | Some ["logout"]    -> s302 Iweb.Logout.path
                                                 | Some ["configure"] -> s302 Iweb.Profile.path
                                                 | _                  ->
                                                   (* accessing random urls leads to a ban, eventually *)
                                                   ban tnow r.remote_addr;
                                                   Http.s404
                                                ) |> rt
      | _,                             `GET
        when
          assert ("acct" = Webfinger.scheme);
          r.path_info |> St.starts_with ~prefix:"/@"
          || r.path_info |> St.starts_with ~prefix:"/acct:" ->
        (let rfc7033 =
           match r.path_info |> St.after ~prefix:"/@" with
           | Some we -> we
           | None -> match r.path_info |> St.after ~prefix:"/acct:" with
             | Some we -> we
             | None    -> Logr.err (fun m -> m "%s.%s fatal, cannot happen" "Cgi" "handle.dispatch"); "" in
         match rfc7033
               |> Webfinger.of_string
               |> Webfinger.well_known_uri with
         | Error e ->
           Logr.warn (fun m -> m "%s.%s %s" "Cgi" "handle.dispatch" e);
           Error (`Bad_request, [Http.H.ct_plain], fun oc -> e |> output_string oc)
           |> rt
         | Ok wk ->
           let key = None in (* sign the get request for remote actor profile for calckey? *)
           let%lwt fi = wk |> Webfinger.Client.http_get ~key in
           (match fi with
            | Error e  ->
              Logr.warn (fun m -> m "%s.%s %s" "Cgi" "handle.dispatch" e);
              Http.s502
            | Ok v     -> match v.links |> As2_vocab.Types.Webfinger.self_link with
              | None   -> Http.s502
              | Some u ->
                let path = r.script_name ^ Iweb.Actor.path in
                let query = [("id", [u |> Uri.to_string])] in
                Uri.make ~path ~query ()
                |> Uri.to_string
                |> Http.s302)
           |> rt )
      | _                                  ->
        (* accessing random urls leads to a ban, eventually *)
        ban tnow r.remote_addr;
        Http.s404 |> rt in
    re |> Lwt_main.run
  and merge (x : (Cgi.Response.t, Cgi.Response.t) result) : Cgi.Response.t =
    let (status,_,_) as x = match x with
      | Ok x    -> x
      | Error x -> x in
    Logr.info (fun m -> m "%s.%s %a dt=%.3fs HTTP %s %s %s -> localhost%s"
                  "Cgi" "handle"
                  Uuidm.pp uuid
                  (Sys.time() -. t0)
                  (status |> Cohttp.Code.string_of_status)
                  req.request_method
                  req.remote_addr
                  (req |> Cgi.Request.path_and_query));
    x in
  Ok req
  >>= Ban.(check_req (prepare_cdb cdb) tnow)
  >>= Assets.Const.(restore_assets all)
  >>= redir_if_auth_miss
  >>= dispatch
  |> merge
