(** Request handlers: the seam between Git data and rendered pages.

    Each handler opens exactly one repository context, reads what its page
    needs, renders it, and closes the context — so the Git store, resolved
    metadata and default-branch policy are shared by every operation in a
    request instead of being reopened per query.

    Errors keep the category {!module:Resolvers} gave them until they reach
    {!error_response}, which is the single place a category becomes an HTTP
    status: malformed input is [400], a missing repository or object is [404],
    and storage failures are [500]. Handlers therefore never choose a status
    themselves.

    This is also the only layer allowed to touch both configuration and the
    filesystem; views receive plain values. *)

(** Map a resolver failure to the status and wording shown to the reader.
    Internal failures are deliberately vague, since their detail is for the
    server log rather than the visitor. *)
let error_response error =
  let status, title, message =
    match error with
    | Resolvers.Bad_request raw -> (`Bad_Request, "Bad request", raw)
    | Resolvers.Not_found raw -> (`Not_Found, "Not found", raw)
    | Resolvers.Store_error _ ->
        ( `Internal_Server_Error,
          "Internal server error",
          "An unexpected error occurred while reading repository data." )
    | Resolvers.Internal _ ->
        ( `Internal_Server_Error,
          "Internal server error",
          "An unexpected error occurred." )
  in
  Views.error_page ~status ~title message

(* The configured title wins; otherwise derive one from the user name. Named for
   the resolution it performs, to distinguish it from the [root_title] fields it
   reads and writes. *)
let resolve_root_title config =
  if config.Config.root_title = "" then
    if config.Config.user_name = "" then "Repositories"
    else "Repositories for " ^ config.Config.user_name
  else config.Config.root_title

let site config =
  Layout.site ~user_name:config.Config.user_name
    ~root_title:(resolve_root_title config)
    ~nav_logo:config.Config.nav_logo

let collect_repo_paths ?(prefix = "") nodes =
  let rec walk current_prefix acc = function
    | Resolvers.Repo { repo_name; _ } ->
        let full =
          if current_prefix = "" then repo_name
          else current_prefix ^ "/" ^ repo_name
        in
        full :: acc
    | Resolvers.Directory (dir_name, children) ->
        let p =
          if current_prefix = "" then dir_name
          else current_prefix ^ "/" ^ dir_name
        in
        List.fold_left (walk p) acc children
  in
  List.fold_left (walk prefix) [] nodes |> List.rev

(* Head commit dates for the repository list pages, keyed by (path, head
   hash). Any new commit changes the key, so an entry can never go stale. *)
let date_cache : (int64 * Git.User.tz_offset option) option Cache.t =
  Cache.create ~capacity:1024

let fetch_repo_dates config repo_paths =
  let open Lwt.Syntax in
  let fetch path =
    Lwt.bind (Resolvers.open_repository config path) @@ function
    | Error _ -> Lwt.return None
    | Ok repository ->
        let* date = Resolvers.head_commit_date repository in
        let* () = Resolvers.close_repository repository in
        Lwt.return date
  in
  Lwt_list.map_p
    (fun path ->
      match Resolvers.head_hash_hint config path with
      | None ->
          let* date = fetch path in
          Lwt.return (path, date)
      | Some head -> (
          let key = path ^ "\x00" ^ head in
          match Cache.find date_cache key with
          | Some date -> Lwt.return (path, date)
          | None ->
              let* date = fetch path in
              Cache.add date_cache key date;
              Lwt.return (path, date)))
    repo_paths

let root config _request =
  match Resolvers.scan_project_root config with
  | Ok nodes ->
      let open Lwt.Syntax in
      let repo_paths = collect_repo_paths nodes in
      let* dates = fetch_repo_dates config repo_paths in
      let node_name = function
        | Resolvers.Repo { repo_name; _ } -> repo_name
        | Resolvers.Directory (dir_name, _) -> dir_name ^ "/"
      in
      let strip_dot_git name =
        if String.ends_with ~suffix:".git" name then
          String.sub name 0 (String.length name - 4)
        else name
      in
      let name_matches config_entry node_name =
        (* Directories end with '/' — match exactly *)
        if String.ends_with ~suffix:"/" node_name then node_name = config_entry
        else
          (* Repos: match with or without .git suffix *)
          strip_dot_git node_name = strip_dot_git config_entry
      in
      let is_in_list config_list node =
        let name = node_name node in
        List.exists (fun entry -> name_matches entry name) config_list
      in
      let is_favorite node =
        is_in_list config.Config.favorite_repositories node
      in
      let is_archived node =
        is_in_list config.Config.archived_repositories node
      in
      let favorites, rest = List.partition is_favorite nodes in
      let archived, regular = List.partition is_archived rest in
      (* Preserve the order specified in the config for favorites *)
      let sorted_favorites =
        List.filter_map
          (fun entry ->
            List.find_opt (fun n -> name_matches entry (node_name n)) favorites)
          config.Config.favorite_repositories
      in
      let readme = Resolvers.read_root_readme config in
      Views.root (site config) ~dates ~favorites:sorted_favorites ~archived
        ?readme regular
  | Error error -> error_response error

module Repo = struct
  let ( let* ) result continue =
    Lwt.bind result @@ function
    | Ok value -> continue value
    | Error error -> error_response error

  let view_context config repository =
    Views.Repo.context ~site:(site config)
      ~repo:(Resolvers.repository_name repository)
      ~description:(Resolvers.repository_description repository)

  let with_repository config name continue =
    Lwt.bind (Resolvers.open_repository config name) @@ function
    | Error error -> error_response error
    | Ok repository ->
        let context = view_context config repository in
        Lwt.finalize
          (fun () -> continue repository context)
          (fun () -> Resolvers.close_repository repository)

  let summary _config repository context =
    let* readme = Resolvers.Repo.readme repository in
    Views.Repo.summary context ?readme ()

  let commit_matches ?filter_type ?author ?committer
      (commit : Resolvers.Commit.t) =
    let type_matches =
      match filter_type with
      | None -> true
      | Some expected ->
          let summary =
            match commit.message with
            | None -> ""
            | Some message -> (
                match String.split_on_char '\n' message with
                | [] -> ""
                | summary :: _ -> summary)
          in
          let commit_type, _ = Commit_message.parse_conventional summary in
          commit_type = Some expected
    in
    let author_matches =
      match author with
      | None -> true
      | Some email -> String.equal commit.author.email email
    in
    let committer_matches =
      match committer with
      | None -> true
      | Some email -> String.equal commit.committer.email email
    in
    type_matches && author_matches && committer_matches

  let commits config request repository context =
    let page_size = config.Config.commits_max_displayed in
    let filter_type = Dream.query request "type" in
    let author = Dream.query request "author" in
    let committer = Dream.query request "committer" in
    (* The query parameter keeps its short name; the binding says what it is. *)
    let page_number =
      let ( >>= ) = Option.bind in
      Dream.query request "page" >>= int_of_string_opt
      >>= (fun p -> if p > 0 then Some p else None)
      |> Option.value ~default:1
    in
    let offset = (page_number - 1) * page_size in
    (* Fetch one beyond orphan threshold to detect whether more exist *)
    let fetch_count = offset + page_size + 11 in
    let predicate = commit_matches ?filter_type ?author ?committer in
    let* all_commits, truncated =
      Resolvers.Commit.recent_matching repository fetch_count predicate
    in
    let total = List.length all_commits in
    let after_offset =
      if offset >= total then [] else List_ext.drop offset all_commits
    in
    let remaining = List.length after_offset in
    (* Avoid a final page with fewer than 10 items — absorb them into this
       page instead, so users don't paginate for a near-empty last page. *)
    let effective_size =
      if remaining > page_size && remaining <= page_size + 10 then remaining
      else page_size
    in
    let page_commits = List_ext.take effective_size after_offset in
    let has_next = remaining > effective_size in
    let has_prev = page_number > 1 in
    Views.Repo.commits ?filter_type ?author ?committer ~truncated ~page_number
      ~has_prev ~has_next context page_commits

  let commits_branch config repository context branch =
    let page_size = config.Config.commits_max_displayed in
    let* reference = Resolvers.Reference.of_id repository branch in
    let fetch_count = page_size + 11 in
    let* commits =
      Resolvers.Commit.recent_from repository reference.hash fetch_count
    in
    let remaining = List.length commits in
    let effective_size =
      if remaining > page_size && remaining <= page_size + 10 then remaining
      else page_size
    in
    let page_commits = List_ext.take effective_size commits in
    let has_next = remaining > effective_size in
    Views.Repo.commits ~page_number:1 ~has_prev:false ~has_next context
      page_commits

  let commit_id repository context id =
    let* commit = Resolvers.Commit.of_id repository id in
    let* diff = Resolvers.Diff.of_commit repository commit in
    Views.Repo.commit context commit diff

  let files_at_head repository context =
    let* tree = Resolvers.Tree.head repository in
    let* nodes = Resolvers.Tree.expand repository tree in
    Views.Repo.files context [] nodes

  let file_id repository context id =
    let* trail = Resolvers.Tree.find_path repository id in
    let* object_ = Resolvers.blob_or_tree repository id in
    match object_ with
    | `Tree tree ->
        let* nodes = Resolvers.Tree.expand repository tree in
        Views.Repo.files context trail nodes
    | `Blob blob -> Views.Repo.file context trail blob

  let file_at repository context path =
    let* object_, trail = Resolvers.object_at_path repository path in
    match object_ with
    | `Tree tree ->
        let* nodes = Resolvers.Tree.expand repository tree in
        Views.Repo.files context trail nodes
    | `Blob blob -> Views.Repo.file context trail blob

  let mime_of_filename filename =
    match Filename.extension filename |> String.lowercase_ascii with
    | ".png" -> "image/png"
    | ".jpg" | ".jpeg" -> "image/jpeg"
    | ".gif" -> "image/gif"
    | ".svg" -> "image/svg+xml"
    | ".webp" -> "image/webp"
    | ".ico" -> "image/x-icon"
    | ".bmp" -> "image/bmp"
    | ".avif" -> "image/avif"
    | _ -> "text/plain; charset=utf-8"

  (* Raw blobs are repository content served from ogit's own origin. The
     sandbox policy stops any active content — an SVG carrying a script is the
     canonical case — from running with the site's authority, and [nosniff]
     stops browsers from promoting text/plain to something executable. *)
  let raw_headers content_type =
    [
      ("Content-Type", content_type);
      ("Content-Security-Policy", "sandbox");
      ("X-Content-Type-Options", "nosniff");
    ]

  let raw_file repository _context id =
    let* trail = Resolvers.Tree.find_path repository id in
    let* object_ = Resolvers.blob_or_tree repository id in
    match object_ with
    | `Blob blob ->
        let content_type =
          match List.rev trail with
          | (name, _) :: _ -> mime_of_filename name
          | [] -> "text/plain; charset=utf-8"
        in
        Lwt.return
          (Dream.response ~headers:(raw_headers content_type) blob.content)
    | `Tree _ ->
        error_response (Resolvers.Bad_request "object is a tree, not a blob")

  let raw_at repository _context path =
    let* object_, _trail = Resolvers.object_at_path repository path in
    match object_ with
    | `Blob blob ->
        let content_type =
          match List.rev (String.split_on_char '/' path) with
          | name :: _ -> mime_of_filename name
          | [] -> "text/plain; charset=utf-8"
        in
        Lwt.return
          (Dream.response ~headers:(raw_headers content_type) blob.content)
    | `Tree _ ->
        error_response (Resolvers.Bad_request "path names a tree, not a file")
end

let project_dir config subdir =
  match Resolvers.scan_subdirectory config subdir with
  | Ok nodes ->
      let open Lwt.Syntax in
      let repo_paths = collect_repo_paths ~prefix:subdir nodes in
      let* dates = fetch_repo_dates config repo_paths in
      let readme = Resolvers.read_subdir_readme config subdir in
      Views.root (site config) ~dates ~prefix:subdir ?readme nodes
  | Error error -> error_response error

(* Rendered pages are memoized per repository head: the key embeds the hash
   HEAD names, so any new commit changes the key and an entry can never serve
   a moved branch's old content. What CAN go stale until eviction is metadata
   outside the object store — the description file — which is accepted.
   Requests whose head cannot be resolved cheaply are served uncached. *)
let page_cache : (Dream.status * (string * string) list * string) Cache.t =
  Cache.create ~capacity:256

(* Raw blobs pass through here too; the size cap keeps a handful of large
   files from occupying the whole cache. *)
let max_cacheable_body_bytes = 512 * 1024

let respond_cached config name request serve =
  match Resolvers.head_hash_hint config name with
  | None -> serve ()
  | Some head -> (
      let key = String.concat "\x00" [ name; head; Dream.target request ] in
      match Cache.find page_cache key with
      | Some (status, headers, body) ->
          Lwt.return (Dream.response ~status ~headers body)
      | None ->
          let open Lwt.Syntax in
          let* response = serve () in
          let* body = Dream.body response in
          let status = Dream.status response in
          let headers = Dream.all_headers response in
          if
            Dream.status_to_int status = 200
            && String.length body <= max_cacheable_body_bytes
          then Cache.add page_cache key (status, headers, body);
          Lwt.return (Dream.response ~status ~headers body))

(* The repository a route is scoped to, or [None] for the root page, which
   depends on every repository and is not cached. *)
let route_repo = function
  | Routes.Root -> None
  | Routes.Project_dir name
  | Routes.Repo name
  | Routes.Commits name
  | Routes.Commits_branch (name, _)
  | Routes.Commit (name, _)
  | Routes.Files name
  | Routes.File (name, _)
  | Routes.File_at (name, _)
  | Routes.Raw_file (name, _)
  | Routes.Raw_at (name, _) ->
      Some name

let routes config =
  let repo_dispatcher request =
    let path = Dream.target request in
    (* Strip leading slash and query string *)
    let path =
      if String.starts_with ~prefix:"/" path then
        String.sub path 1 (String.length path - 1)
      else path
    in
    let path =
      match String.index_opt path '?' with
      | None -> path
      | Some i -> String.sub path 0 i
    in
    (* A path without a reserved segment names either a repository (serve its
       summary) or a directory of repositories (serve the listing). The
       filesystem decides: a name that opens as a repository is one. *)
    let summary_or_directory name =
      Lwt.bind (Resolvers.open_repository config name) (function
        | Error (Resolvers.Not_found _) -> project_dir config name
        | Error error -> error_response error
        | Ok repository ->
            let context = Repo.view_context config repository in
            Lwt.finalize
              (fun () -> Repo.summary config repository context)
              (fun () -> Resolvers.close_repository repository))
    in
    match Routes.dispatch path with
    | None -> error_response (Not_found ("not found: " ^ Dream.target request))
    | Some route -> (
        let serve () =
          match route with
          | Routes.Root -> root config request
          | Routes.Project_dir name | Routes.Repo name ->
              summary_or_directory name
          | Routes.Commits name ->
              Repo.with_repository config name (fun repository context ->
                  Repo.commits config request repository context)
          | Routes.Commits_branch (name, branch) ->
              Repo.with_repository config name (fun repository context ->
                  Repo.commits_branch config repository context branch)
          | Routes.Commit (name, hash) ->
              Repo.with_repository config name (fun repository context ->
                  Repo.commit_id repository context hash)
          | Routes.Files name ->
              Repo.with_repository config name Repo.files_at_head
          | Routes.File (name, hash) ->
              Repo.with_repository config name (fun repository context ->
                  Repo.file_id repository context hash)
          | Routes.File_at (name, path) ->
              Repo.with_repository config name (fun repository context ->
                  Repo.file_at repository context path)
          | Routes.Raw_file (name, hash) ->
              Repo.with_repository config name (fun repository context ->
                  Repo.raw_file repository context hash)
          | Routes.Raw_at (name, path) ->
              Repo.with_repository config name (fun repository context ->
                  Repo.raw_at repository context path)
        in
        match route_repo route with
        | None -> serve ()
        | Some name -> respond_cached config name request serve)
  in
  [
    Dream.get "/" (root config);
    Dream.get "/static/**" Static_handler.handler;
    Dream.get "/**" repo_dispatcher;
  ]