(* Routes and actions, independent of the HTTP server: a request in, a
   response out. bin/main.ml adapts this to cohttp-eio, and the tests call
   it directly. *)

type request = {
  meth : string;
  path : string;
  query : (string * string) list;
  header : string -> string option;  (** by lower-case name *)
  body : string;
}

type response = { status : int; headers : (string * string) list; body : string }

type t = {
  store : Store.t;
  origin : string;  (** this app's own origin, e.g. https://todo-ocaml.bfj.oncarlos.com *)
  version : string;
}

(* `make bump` edits this constant so the next build must recompile this file. *)
let build_marker = "todomvc"

let create ~store ~origin ~version = { store; origin; version }

let cookie_name = "todomvc_list"

(* Kept for 400 days, the longest a browser will keep a cookie. *)
let cookie_max_age = 400 * 24 * 60 * 60

(* The inline script that marks the page as having JavaScript, and its hash
   for the Content-Security-Policy. *)
let csp =
  "default-src 'self'; script-src 'self' 'sha256-qOhFsq0QMV2REqNwk5hGH5bZE9SkX6gt6yeyKdYPv+U='; \
   img-src 'self' data:; frame-ancestors 'none'; base-uri 'none'; form-action 'self'"

let respond ?(headers = []) status body = { status; headers; body }
let text ?(headers = []) status body =
  respond status body ~headers:(("content-type", "text/plain; charset=utf-8") :: headers)

let html ?(headers = []) status body =
  respond status body
    ~headers:
      ([ ("content-type", "text/html; charset=utf-8");
         ("cache-control", "private, no-cache");
         ("content-security-policy", csp);
         ("x-content-type-options", "nosniff");
         ("referrer-policy", "same-origin") ]
      @ headers)

let is_token s =
  String.length s = 32 && String.for_all (function '0' .. '9' | 'a' .. 'f' -> true | _ -> false) s

(* The caller's list id. An unknown or garbled cookie gets a fresh list,
   and the response sets the cookie for it. *)
let visitor t req =
  let known =
    Option.bind (req.header "cookie") (fun h -> Form.cookie h cookie_name)
    |> Option.map String.trim
    |> Option.to_list
    |> List.find_opt (fun id -> is_token id && Store.list_exists t.store id)
  in
  match known with
  | Some id -> (id, [])
  | None ->
      let id = Rand.token () in
      Store.create_list t.store id;
      let secure = String.starts_with ~prefix:"https:" t.origin in
      ( id,
        [ ( "set-cookie",
            Printf.sprintf "%s=%s; Max-Age=%d; Path=/; HttpOnly; SameSite=Lax%s" cookie_name id
              cookie_max_age (if secure then "; Secure" else "") ) ] )

let static name =
  let asset body ctype =
    respond 200 body
      ~headers:[ ("content-type", ctype); ("cache-control", "public, max-age=86400");
                 ("x-content-type-options", "nosniff") ]
  in
  match name with
  | "base.css" -> Some (asset Assets.base_css "text/css; charset=utf-8")
  | "index.css" -> Some (asset Assets.index_css "text/css; charset=utf-8")
  | "app.css" -> Some (asset Assets.app_css "text/css; charset=utf-8")
  | "app.js" -> Some (asset Assets.app_js "text/javascript; charset=utf-8")
  | _ -> None

(* GET /, /active and /completed. *)
let page t req filter =
  let list, cookie = visitor t req in
  let editing = Option.bind (List.assoc_opt "edit" req.query) int_of_string_opt in
  html 200 ~headers:cookie (View.page ~version:t.version ~filter ?editing (Store.todos t.store ~list))

type action =
  | Add
  | Toggle_all
  | Clear_completed
  | Toggle of int
  | Edit of int
  | Destroy of int

let action_of_path path =
  let id s =
    if s <> "" && String.for_all (function '0' .. '9' -> true | _ -> false) s then int_of_string_opt s
    else None
  in
  match String.split_on_char '/' path with
  | [ ""; "todos" ] -> Some Add
  | [ ""; "todos"; "toggle-all" ] -> Some Toggle_all
  | [ ""; "todos"; "clear-completed" ] -> Some Clear_completed
  | [ ""; "todos"; n; verb ] -> (
      match (id n, verb) with
      | Some n, "toggle" -> Some (Toggle n)
      | Some n, "edit" -> Some (Edit n)
      | Some n, "destroy" -> Some (Destroy n)
      | _ -> None)
  | _ -> None

let perform store ~list fields = function
  | Add ->
      let title = Form.trim (Option.value ~default:"" (List.assoc_opt "title" fields)) in
      if title <> "" then Store.add store ~list title;
      true
  | Toggle_all -> Store.toggle_all store ~list; true
  | Clear_completed -> Store.clear_completed store ~list; true
  | Toggle id -> Store.toggle store ~list id
  | Destroy id -> Store.delete store ~list id
  | Edit id -> (
      match Form.trim (Option.value ~default:"" (List.assoc_opt "title" fields)) with
      | "" -> Store.delete store ~list id
      | title -> Store.rename store ~list id title)

(* Every action is a form POST answering 303 back to the filter. With
   X-Fragment: todoapp (sent by app.js) it answers section.todoapp instead. *)
let post t req action =
  match req.header "origin" with
  | Some o when o <> t.origin -> text 403 "Cross-origin request refused\n"
  | _ when not (String.is_valid_utf_8 req.body) -> text 400 "Bad form body\n"
  | _ ->
      let fields = Form.parse req.body in
      if not (List.for_all (fun (_, v) -> String.is_valid_utf_8 v) fields) then text 400 "Bad form body\n"
      else
        let list, cookie = visitor t req in
        let filter = View.filter_of_string (Option.value ~default:"" (List.assoc_opt "filter" fields)) in
        if not (perform t.store ~list fields action) then text 404 ~headers:cookie "No such todo\n"
        else if req.header "x-fragment" = Some "todoapp" then
          html 200 ~headers:cookie (View.fragment ~filter (Store.todos t.store ~list))
        else respond 303 "" ~headers:(("location", View.filter_path filter) :: cookie)

let handle t req =
  let filter = function
    | "/" -> Some View.All
    | "/active" -> Some View.Active
    | "/completed" -> Some View.Completed
    | _ -> None
  in
  match (req.meth, req.path) with
  | ("GET" | "HEAD"), "/healthz" -> text 200 "ok\n"
  | ("GET" | "HEAD"), "/api/version" -> text 200 t.version
  | ("GET" | "HEAD"), p when String.starts_with ~prefix:"/static/" p -> (
      match static (String.sub p 8 (String.length p - 8)) with
      | Some r -> r
      | None -> text 404 "Not found\n")
  | ("GET" | "HEAD"), p when filter p <> None -> page t req (Option.get (filter p))
  | "POST", p when action_of_path p <> None -> post t req (Option.get (action_of_path p))
  | _, p when filter p <> None || action_of_path p <> None ->
      text 405 "Method not allowed\n" ~headers:[ ("allow", if filter p <> None then "GET, HEAD" else "POST") ]
  | _ -> text 404 "Not found\n"