(** URL paths, in both directions.

    One {!t} value describes a page, and the same value both generates a link
    ({!path_of}) and is recovered from an incoming request ({!dispatch}).
    Keeping the two directions in one module is what stops generated links and
    served routes from drifting apart. *)

type t =
  | Root
  | Project_dir of string
  | Repo of string
  | Commits of string
  | Commits_branch of string * string
  | Commit of string * string
  | Files of string
  | File of string * string
  | File_at of string * string
  | Raw_file of string * string
  | Raw_at of string * string

(* Path arguments in [File_at] and [Raw_at] carry repository file names, which
   may contain characters that are not safe in a URL. [path_of] percent-encodes
   each segment and [dispatch] decodes them, so the round trip preserves any
   name. Repository names and object ids are emitted as-is: the former are
   constrained by [Resolvers.is_valid_repo_name], the latter are hexadecimal. *)

let encode_segment segment =
  let buffer = Buffer.create (String.length segment) in
  String.iter
    (fun char ->
      match char with
      | 'A' .. 'Z' | 'a' .. 'z' | '0' .. '9' | '-' | '.' | '_' | '~' ->
          Buffer.add_char buffer char
      | _ ->
          Buffer.add_string buffer (Printf.sprintf "%%%02X" (Char.code char)))
    segment;
  Buffer.contents buffer

let encode_path path =
  String.split_on_char '/' path |> List.map encode_segment |> String.concat "/"

let hex_digit_value = function
  | '0' .. '9' as digit -> Some (Char.code digit - Char.code '0')
  | 'a' .. 'f' as digit -> Some (Char.code digit - Char.code 'a' + 10)
  | 'A' .. 'F' as digit -> Some (Char.code digit - Char.code 'A' + 10)
  | _ -> None

(* A '%' that is not followed by two hexadecimal digits is kept literally
   rather than rejected: the segment then simply names no existing file. *)
let decode_segment segment =
  let length = String.length segment in
  let buffer = Buffer.create length in
  let rec go index =
    if index >= length then ()
    else if segment.[index] = '%' && index + 2 < length then (
      match
        (hex_digit_value segment.[index + 1], hex_digit_value segment.[index + 2])
      with
      | Some high, Some low ->
          Buffer.add_char buffer (Char.chr ((high * 16) + low));
          go (index + 3)
      | _ ->
          Buffer.add_char buffer '%';
          go (index + 1))
    else (
      Buffer.add_char buffer segment.[index];
      go (index + 1))
  in
  go 0;
  Buffer.contents buffer

let decode_path segments =
  List.map decode_segment segments |> String.concat "/"

(* Generate URL paths for routes *)
let path_of = function
  | Root -> "/"
  | Project_dir dir -> "/" ^ dir ^ "/"
  | Repo repo -> "/" ^ repo ^ "/summary/"
  | Commits repo -> "/" ^ repo ^ "/commits/"
  | Commits_branch (repo, branch) -> "/" ^ repo ^ "/commits/" ^ branch
  | Commit (repo, hash) -> "/" ^ repo ^ "/commit/" ^ hash
  | Files repo -> "/" ^ repo ^ "/files/"
  | File (repo, hash) -> "/" ^ repo ^ "/file/" ^ hash
  | File_at (repo, path) -> "/" ^ repo ^ "/file/" ^ encode_path path
  | Raw_file (repo, hash) -> "/" ^ repo ^ "/raw/" ^ hash
  | Raw_at (repo, path) -> "/" ^ repo ^ "/raw/" ^ encode_path path

let known_actions = [ "summary"; "commits"; "commit"; "files"; "file"; "raw" ]

(* The store hashes objects with SHA-1, whose hexadecimal form is 40
   characters. A single segment of that shape is an object id; anything else
   under file/ or raw/ is a path. *)
let is_hex_hash candidate =
  String.length candidate = 40
  && String.for_all
       (function '0' .. '9' | 'a' .. 'f' | 'A' .. 'F' -> true | _ -> false)
       candidate

(* The split point is the first segment naming a known action; everything
   before it is the repository or directory path. Anything after the action
   that the route shapes above do not account for is rejected rather than
   ignored, so every accepted path is one [path_of] can regenerate. *)
let dispatch path =
  let segments =
    String.split_on_char '/' path |> List.filter (fun s -> s <> "")
  in
  let rec find_split repo_acc = function
    | [] -> (
        (* No action segment: the root, or a repository/directory path whose
           page is the implicit summary. Only the filesystem can tell a
           repository from a directory of repositories, so dispatch reports
           [Project_dir] and the handler resolves which one it is. *)
        match String.concat "/" (List.rev repo_acc) with
        | "" -> Some Root
        | repo -> Some (Project_dir repo))
    | seg :: rest when List.mem seg known_actions -> (
        let repo = String.concat "/" (List.rev repo_acc) in
        if repo = "" then None
        else
          match (seg, rest) with
          | "summary", [] -> Some (Repo repo)
          | "commits", [] -> Some (Commits repo)
          | "commits", [ branch ] -> Some (Commits_branch (repo, branch))
          | "commit", [ hash ] -> Some (Commit (repo, hash))
          | "files", [] -> Some (Files repo)
          | "file", [ hash ] when is_hex_hash hash -> Some (File (repo, hash))
          | "file", (_ :: _ as path) -> Some (File_at (repo, decode_path path))
          | "raw", [ hash ] when is_hex_hash hash ->
              Some (Raw_file (repo, hash))
          | "raw", (_ :: _ as path) -> Some (Raw_at (repo, decode_path path))
          | _ -> None)
    | seg :: rest -> find_split (seg :: repo_acc) rest
  in
  find_split [] segments