let read_file path =
  let ic = open_in path in
  let n = in_channel_length ic in
  let s = really_input_string ic n in
  close_in ic;
  s

let contains_sub haystack needle =
  let hl = String.length haystack and nl = String.length needle in
  if nl > hl then false
  else
    let rec check i =
      if i + nl > hl then false
      else if String.sub haystack i nl = needle then true
      else check (i + 1)
    in
    check 0

let decode_chunked body =
  let len = String.length body in
  let buf = Buffer.create (len / 2) in
  let i = ref 0 in
  (try
     while !i < len do
       let line_end =
         let rec find j =
           if j >= len then raise Exit else if body.[j] = '\r' then j
           else find (j + 1)
         in
         find !i
       in
       let size_str = String.sub body !i (line_end - !i) in
       let size_str =
         match String.index_opt size_str ';' with
         | Some idx -> String.sub size_str 0 idx
         | None -> size_str
       in
       let size = int_of_string ("0x" ^ String.trim size_str) in
       if size = 0 then raise Exit;
       i := line_end + 2;
       if !i + size <= len then
         Buffer.add_string buf (String.sub body !i size);
       i := !i + size + 2
     done
   with Exit -> ());
  Buffer.contents buf

let b64_encode src =
  let tbl = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" in
  let len = String.length src in
  let buf = Buffer.create (len * 4 / 3 + 4) in
  let i = ref 0 in
  while !i + 2 < len do
    let a = Char.code src.[!i] and b = Char.code src.[!i+1] and c = Char.code src.[!i+2] in
    Buffer.add_char buf tbl.[(a lsr 2) land 0x3f];
    Buffer.add_char buf tbl.[((a lsl 4) lor (b lsr 4)) land 0x3f];
    Buffer.add_char buf tbl.[((b lsl 2) lor (c lsr 6)) land 0x3f];
    Buffer.add_char buf tbl.[c land 0x3f];
    i := !i + 3
  done;
  (match len - !i with
  | 2 ->
      let a = Char.code src.[!i] and b = Char.code src.[!i+1] in
      Buffer.add_char buf tbl.[(a lsr 2) land 0x3f];
      Buffer.add_char buf tbl.[((a lsl 4) lor (b lsr 4)) land 0x3f];
      Buffer.add_char buf tbl.[(b lsl 2) land 0x3f];
      Buffer.add_char buf '='
  | 1 ->
      let a = Char.code src.[!i] in
      Buffer.add_char buf tbl.[(a lsr 2) land 0x3f];
      Buffer.add_char buf tbl.[(a lsl 4) land 0x3f];
      Buffer.add_string buf "=="
  | _ -> ());
  Buffer.contents buf

let ssl_inited = ref false

let https_request ~meth ~host ~path ?(headers=[]) ?(body="") () =
  if not !ssl_inited then (
    Ssl.init ();
    ssl_inited := true);
  let he = Unix.gethostbyname host in
  let addr = he.h_addr_list.(0) in
  let sockaddr = Unix.ADDR_INET (addr, 443) in
  let ctx = Ssl.create_context Ssl.TLSv1_2 Ssl.Client_context in
  let sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
  Unix.connect sock sockaddr;
  let ssl = Ssl.embed_socket sock ctx in
  Ssl.set_client_SNI_hostname ssl host;
  Ssl.connect ssl;
  let extra_headers =
    List.fold_left (fun acc (k, v) -> acc ^ k ^ ": " ^ v ^ "\r\n") "" headers
  in
  let content_len = if body <> "" then
    Printf.sprintf "Content-Length: %d\r\n" (String.length body)
  else "" in
  let req =
    Printf.sprintf "%s %s HTTP/1.1\r\nHost: %s\r\nUser-Agent: meat/1.0\r\nConnection: close\r\n%s%s\r\n%s"
      meth path host extra_headers content_len body
  in
  ignore (Ssl.write ssl (Bytes.of_string req) 0 (String.length req));
  let buf = Buffer.create 8192 in
  let chunk = Bytes.create 4096 in
  (try
     while true do
       let n = Ssl.read ssl chunk 0 4096 in
       if n = 0 then raise Exit;
       Buffer.add_subbytes buf chunk 0 n
     done
   with _ -> ());
  (try Ssl.shutdown_connection ssl with _ -> ());
  Unix.close sock;
  let response = Buffer.contents buf in
  let rlen = String.length response in
  let header_end =
    let rec find pos =
      if pos + 3 >= rlen then rlen
      else if
        response.[pos] = '\r'
        && response.[pos + 1] = '\n'
        && response.[pos + 2] = '\r'
        && response.[pos + 3] = '\n'
      then pos
      else find (pos + 1)
    in
    find 0
  in
  let resp_headers = String.sub response 0 header_end in
  let body_start = min (header_end + 4) rlen in
  let resp_body = String.sub response body_start (rlen - body_start) in
  if
    contains_sub
      (String.lowercase_ascii resp_headers)
      "transfer-encoding: chunked"
  then decode_chunked resp_body
  else resp_body

let https_get ~host ~path =
  https_request ~meth:"GET" ~host ~path
    ~headers:[("User-Agent", "git/2.0")] ()

let https_post ~host ~path ~body =
  https_request ~meth:"POST" ~host ~path
    ~headers:[
      ("Content-Type", "application/json");
      ("Accept", "application/json");
      ("Authorization", "Basic " ^ b64_encode "aWVSALXpZv:X8gPHnzL52wFEekuxsfQ9cSh");
    ] ~body ()

let parse_pktline body =
  let len = String.length body in
  let i = ref 0 in
  let refs = ref [] in
  let hex_val c =
    match c with
    | '0' .. '9' -> Char.code c - Char.code '0'
    | 'a' .. 'f' -> Char.code c - Char.code 'a' + 10
    | 'A' .. 'F' -> Char.code c - Char.code 'A' + 10
    | _ -> 0
  in
  let read_pkt_len () =
    if !i + 4 > len then 0
    else
      let a = hex_val body.[!i]
      and b = hex_val body.[!i + 1]
      and c = hex_val body.[!i + 2]
      and d = hex_val body.[!i + 3] in
      i := !i + 4;
      (a * 4096) + (b * 256) + (c * 16) + d
  in
  let plen = read_pkt_len () in
  if plen > 4 then i := !i + (plen - 4);
  ignore (read_pkt_len ());
  let continue = ref true in
  while !continue do
    let plen = read_pkt_len () in
    if plen = 0 then continue := false
    else
      let payload_len = plen - 4 in
      if !i + payload_len <= len && payload_len >= 41 then (
        let payload = String.sub body !i payload_len in
        i := !i + payload_len;
        let sha = String.sub payload 0 40 in
        let rest = String.sub payload 41 (String.length payload - 41) in
        let refname =
          let s =
            match String.index_opt rest '\000' with
            | Some idx -> String.sub rest 0 idx
            | None -> rest
          in
          match String.index_opt s '\n' with
          | Some idx -> String.sub s 0 idx
          | None -> s
        in
        refs := (refname, sha) :: !refs)
      else i := !i + max 0 payload_len
  done;
  List.rev !refs

let derelativise base = List.map (fun a -> base ^ "/" ^ a)

let filter_dirs fullpath dirs =
  dirs |> derelativise fullpath
  |> List.filter (fun d -> (Unix.stat d).st_kind = Unix.S_DIR)

let readdir d = try Sys.readdir d with Sys_error _ -> [||]

let walk entry =
  let open List in
  let rec loop dir : string list =
    let contents = readdir dir |> Array.to_list in
    let is_flake = mem "flake.nix" contents in
    if dir = entry then
      let subdirs = contents |> filter_dirs dir in
      flatten (map loop subdirs)
    else if is_flake then
      let subdirs = contents |> filter_dirs dir in
      let children = flatten (map loop subdirs) in
      [ dir ] @ children
    else []
  in
  loop entry

let countdepth s =
  s |> String.fold_left (fun acc el -> acc + if el = '/' then 1 else 0) 0

let compdepth a b =
  let ad = countdepth a and bd = countdepth b in
  let dif = ad - bd in
  match dif with 0 -> 0 | _ -> dif / abs dif

let fmt_dir d = String.split_on_char '/' d |> List.rev |> List.hd |> Common.all_caps