Source file vif_request0.ml

let src = Logs.Src.create "vif.request0"

module Log = (val Logs.src_log src : Logs.LOG)

type 'socket t = {
    request: request
  ; tls: Tls.Core.epoch_data option
  ; reqd: reqd
  ; socket: 'socket
  ; on_localhost: bool
  ; body: [ `V1 of H1.Body.Reader.t | `V2 of H2.Body.Reader.t ]
  ; queries: (string * string list) list
  ; tags: Logs.Tag.set
}

and reqd = Httpcats_core.Server.reqd

(* and socket = [ `Tcp of Miou_unix.file_descr | `Tls of Tls_miou_unix.t ] *)
and request = V1 of H1.Request.t | V2 of H2.Request.t

let accept { request; _ } =
  let hdrs =
    match request with
    | V1 req -> H1.Headers.to_list req.H1.Request.headers
    | V2 req -> H2.Headers.to_list req.H2.Request.headers
  in
  match Vif_headers.get hdrs "accept" with
  | None -> []
  | Some str ->
      let types = String.split_on_char ',' str in
      let types = List.map String.trim types in
      let fn str =
        match String.split_on_char ';' str with
        | [] -> assert false
        | [ mime_type; p ] ->
            let p = String.trim p in
            let p =
              if String.starts_with ~prefix:"q=" p then
                try float_of_string String.(sub p 2 (length p - 2))
                with _ -> 1.0
              else 1.0
            in
            (String.trim mime_type, p)
        | mime_type :: _ -> (String.trim mime_type, 1.0)
      in
      let types = List.map fn types in
      let types = List.sort (fun (_, a) (_, b) -> Float.compare b a) types in
      List.map fst types

let tags { tags; _ } = tags

let to_source ~src ~schedule ~close body =
  Flux.Source.with_task ~size:0x7ff @@ fun bqueue ->
  let rec on_eof () =
    close body;
    Flux.Bqueue.close bqueue;
    Logs.debug ~src (fun m -> m "-> request body closed")
  and on_read bstr ~off ~len =
    let str = Bigstringaf.substring bstr ~off ~len in
    Logs.debug ~src (fun m -> m "-> + %d byte(s)" (String.length str));
    Flux.Bqueue.put bqueue str;
    schedule body ~on_eof ~on_read
  in
  Log.debug (fun m -> m "schedule a reader");
  schedule body ~on_eof ~on_read

let to_source ~src = function
  | `V1 reqd ->
      let body = H1.Reqd.request_body reqd in
      to_source ~src ~schedule:H1.Body.Reader.schedule_read
        ~close:H1.Body.Reader.close body
  | `V2 reqd ->
      let body = H2.Reqd.request_body reqd in
      to_source ~src ~schedule:H2.Body.Reader.schedule_read
        ~close:H2.Body.Reader.close body

let of_reqd ?(with_tls = Fun.const None) ?(peer = Fun.const "<socket>")
    ?(is_localhost = Fun.const false) socket reqd =
  let request, body =
    match reqd with
    | `V1 reqd -> (V1 (H1.Reqd.request reqd), `V1 (H1.Reqd.request_body reqd))
    | `V2 reqd -> (V2 (H2.Reqd.request reqd), `V2 (H2.Reqd.request_body reqd))
  in
  let target =
    match request with
    | V1 req -> req.H1.Request.target
    | V2 req -> req.H2.Request.target
  in
  let tls = with_tls socket in
  let on_localhost = is_localhost socket in
  let tags = Logs.Tag.empty in
  let tags =
    Logs.Tag.add Vif_tags.client (Fmt.str "vif:%s" (peer socket)) tags
  in
  let queries = Pct.query_of_target target in
  { request; tls; reqd; socket; on_localhost; body; queries; tags }

let headers { request; _ } =
  match request with
  | V1 req -> H1.Headers.to_list req.H1.Request.headers
  | V2 req -> H2.Headers.to_list req.H2.Request.headers

let queries { queries; _ } = queries

let meth { request; _ } =
  match request with
  | V1 req -> req.H1.Request.meth
  | V2 req -> req.H2.Request.meth

let target { request; _ } =
  match request with
  | V1 req -> req.H1.Request.target
  | V2 req -> req.H2.Request.target

let request_body { reqd; _ } =
  match reqd with
  | `V1 reqd -> `V1 (H1.Reqd.request_body reqd)
  | `V2 reqd -> `V2 (H2.Reqd.request_body reqd)

let report_exn { reqd; _ } exn =
  match reqd with
  | `V1 reqd -> H1.Reqd.report_exn reqd exn
  | `V2 reqd -> H2.Reqd.report_exn reqd exn

let version { request; _ } = match request with V1 _ -> 1 | V2 _ -> 2
let tls { tls; _ } = tls
let on_localhost { on_localhost; _ } = on_localhost
let reqd { reqd; _ } = reqd

let source { reqd; tags; _ } =
  Log.debug (fun m -> m ~tags "the user request for a source of the request");
  to_source ~src reqd

let close { body; tags; _ } =
  Log.debug (fun m -> m ~tags "close the reader body");
  match body with
  | `V1 body -> H1.Body.Reader.close body
  | `V2 body -> H2.Body.Reader.close body