add headers_lib

src/assets.ml

@@ -102,12 +102,13 @@ let is_supported_mimetype mime = Array.mem mime supported_mimetype_arr
 
 (* ! lang and mime must be supported *)
 let get_content ~lang ~mime t =
+  let etag = Headers_lib.Etag.to_raw_string (etag t) in
   let ext =
     match Util.mimetype_to_extension mime with
     | None -> Fmt.failwith "mimetype `%s/%s` unknown" (fst mime) (snd mime)
     | Some ext -> ext
   in
-  let path = Fpath.to_string Fpath.((base_dir t / lang / etag t) + ext) in
+  let path = Fpath.to_string Fpath.((base_dir t / lang / etag) + ext) in
   match Assets_crunch.read path with
   | None -> Fmt.failwith "static file not found: `%s`" path
   | Some data -> data

src/config.ml

@@ -17,7 +17,7 @@ let privacy_dir = Fpath.(v "privacy")
 (* ETAG is used as base filename
    it should be encoded in Crockford base-32
    we do not generate it and we do not verify it *)
-let terms_etag = "0"
-let privacy_etag = "0"
+let terms_etag = "0" |> Headers_lib.Etag.of_crockford32 |> Result.get_ok
+let privacy_etag = "0" |> Headers_lib.Etag.of_crockford32 |> Result.get_ok
 let terms_legal_version = "1"
 let privacy_legal_version = "1"

src/dune

@@ -1,8 +1,25 @@
 (executable
  (public_name mte)
  (name mte)
- (modules assets assets_crunch headers mte config util syntax)
- (libraries vif fmt jsont cohttp))
+ (modules assets assets_crunch headers mte config util)
+ (libraries
+  headers_lib
+  syntax
+  ;
+  vif
+  fmt
+  jsont
+  cohttp))
+
+(library
+ (name headers_lib)
+ (modules headers_lib)
+ (libraries fmt syntax))
+
+(library
+ (name syntax)
+ (modules syntax)
+ (libraries))
 
 (rule
  (target assets_crunch.ml)

src/headers.ml

@@ -42,84 +42,3 @@ let select_encoding headers =
   | `Identity :: _ -> None
   | `DEFLATE :: _ -> Some `DEFLATE
   | `Gzip :: _ -> Some `Gzip
-
-(* TODO(etag)
-   - test
-   - don't ignore invalid_etag
-   - can still bypass this module and directly set Etag header
-     but its fine *)
-module Etag : sig
-  (* https://httpwg.org/specs/rfc9110.html#field.etag
-       module to parse < "*" / #entity-tag >,
-       used for If-Match and If-None-Match headers *)
-  type t
-  type header_value
-
-  val parse : string -> (header_value, string) result
-  val of_crockford32 : string -> (t, string) result
-  val to_field_value : t -> string
-  val evaluate : t -> header_value -> bool
-end = struct
-  (* raw etag *)
-  type t = string
-
-  (* type for the value of header field *)
-  type header_etag_item = { weak: bool; value: string }
-  type header_value = Any_etag | Etag_list of header_etag_item list
-
-  let pp_header_etag_item ppf { weak; value } =
-    if weak then Fmt.pf ppf {|W/"%s"|} value else Fmt.pf ppf {|"%s"|} value
-
-  let to_field_value t =
-    (* always weak comparison for If-None-Match header *)
-    let v = { weak= true; value= t } in
-    Fmt.str "%a" pp_header_etag_item v
-
-  let invalid_etag = Error "invalid etag field"
-
-  let has_valid_charset s =
-    let f c =
-      let n = Char.code c in
-      (n >= 0x21 && n <= 0x7E && n <> 0x22) || (n >= 0x80 && n <= 0xFF)
-    in
-    String.for_all f s
-
-  let of_crockford32 s =
-    match has_valid_charset s with false -> invalid_etag | true -> Ok s
-
-  let trim_dquote s =
-    let len = String.length s in
-    if len >= 2 && s.[0] = '"' && s.[len - 1] = '"' then
-      Ok (String.sub s 1 (len - 2))
-    else invalid_etag
-
-  let parse s =
-    if String.trim s = "*" then Ok Any_etag
-    else
-      String.split_on_char ',' s
-      |> List.map String.trim
-      |> List.filter (( <> ) "")
-      |> Syntax.list_map (fun s ->
-             (* "W/" is the weak comparison indicator *)
-             let weak, s =
-               if String.starts_with ~prefix:"W/" s then
-                 (true, String.sub s 2 (String.length s - 2))
-               else (false, s)
-             in
-             Result.bind (trim_dquote s) (fun s ->
-                 if has_valid_charset s then Ok { weak; value= s }
-                 else invalid_etag))
-      |> Result.map (fun l -> Etag_list l)
-
-  (* To evaluate a received If-None-Match header field:
-     - If the field value is "*", the condition is false
-       if the origin server has a current representation for the target resource.
-     - If the field value is a list of entity tags, the condition is false
-       if one of the listed tags matches the entity tag of the selected representation.
-     - Otherwise, the condition is true. *)
-  let evaluate t header_value =
-    match header_value with
-    | Any_etag -> false
-    | Etag_list l ->
-        not @@ List.exists (fun { weak= _; value } -> String.equal t value) l
-end

src/headers_lib.ml

@@ -0,0 +1,84 @@
+(* independent module for headers fields value *)
+
+(* TODO
+   - test
+   - can still bypass this module and directly set Etag header, but its fine *)
+module Etag : sig
+  (* module to parse < "*" / #entity-tag >,
+     used for If-Match and If-None-Match headers
+
+     https://httpwg.org/specs/rfc9110.html#field.etag *)
+  type t
+  type header_value
+
+  val parse : string -> (header_value, string) result
+  val of_crockford32 : string -> (t, string) result
+  val to_raw_string : t -> string
+  val to_field_value : t -> string
+  val evaluate : t -> header_value -> bool
+end = struct
+  (* raw etag *)
+  type t = string
+
+  (* type for the value of header field *)
+  type header_etag_item = { weak: bool; value: string }
+  type header_value = Any_etag | Etag_list of header_etag_item list
+
+  let pp_header_etag_item ppf { weak; value } =
+    if weak then Fmt.pf ppf {|W/"%s"|} value else Fmt.pf ppf {|"%s"|} value
+
+  let to_raw_string t = t
+
+  let to_field_value t =
+    (* always weak comparison for If-None-Match header *)
+    let v = { weak= true; value= t } in
+    Fmt.str "%a" pp_header_etag_item v
+
+  let invalid_etag = Error "invalid etag field"
+
+  let has_valid_charset s =
+    let f c =
+      let n = Char.code c in
+      (n >= 0x21 && n <= 0x7E && n <> 0x22) || (n >= 0x80 && n <= 0xFF)
+    in
+    String.for_all f s
+
+  let of_crockford32 s =
+    match has_valid_charset s with false -> invalid_etag | true -> Ok s
+
+  let trim_dquote s =
+    let len = String.length s in
+    if len >= 2 && s.[0] = '"' && s.[len - 1] = '"' then
+      Ok (String.sub s 1 (len - 2))
+    else invalid_etag
+
+  let parse s =
+    if String.trim s = "*" then Ok Any_etag
+    else
+      String.split_on_char ',' s
+      |> List.map String.trim
+      |> List.filter (( <> ) "")
+      |> Syntax.list_map (fun s ->
+             (* "W/" is the weak comparison indicator *)
+             let weak, s =
+               if String.starts_with ~prefix:"W/" s then
+                 (true, String.sub s 2 (String.length s - 2))
+               else (false, s)
+             in
+             Result.bind (trim_dquote s) (fun s ->
+                 if has_valid_charset s then Ok { weak; value= s }
+                 else invalid_etag))
+      |> Result.map (fun l -> Etag_list l)
+
+  (* To evaluate a received If-None-Match header field:
+     - If the field value is "*", the condition is false
+       if the origin server has a current representation for the target resource.
+     - If the field value is a list of entity tags, the condition is false
+       if one of the listed tags matches the entity tag of the selected representation.
+     - Otherwise, the condition is true. *)
+  let evaluate t header_value =
+    match header_value with
+    | Any_etag -> false
+    | Etag_list l ->
+        not @@ List.exists (fun { weak= _; value } -> String.equal t value) l
+end

src/mte.ml

@@ -29,16 +29,13 @@ module Static = struct
       | Error e -> Fmt.failwith "TODO handle me, %s" e
       | Ok v -> v
     in
-    let etag =
-      (* TODO keep our static asset etag as Etag.t in Config? *)
-      Assets.etag kind |> Headers.Etag.of_crockford32 |> Result.get_ok
-    in
+    let etag = Assets.etag kind in
     let headers = Vif.Request.headers req in
     let has_matching_etag =
       match Vif.Headers.get headers "if-none-match" with
       | None -> false
       | Some s ->
-          s |> Headers.Etag.parse |> get_ok |> Headers.Etag.evaluate etag
+          Headers_lib.Etag.parse s |> get_ok |> Headers_lib.Etag.evaluate etag
     in
     match has_matching_etag with
     | true ->
@@ -54,7 +51,7 @@ module Static = struct
         let open Vif.Response.Syntax in
         let* () = Vif.Response.with_string ?compression req data in
         let* () =
-          let etag_field_value = Headers.Etag.to_field_value etag in
+          let etag_field_value = Headers_lib.Etag.to_field_value etag in
           Vif.Response.add ~field:"etag" etag_field_value
         in
         let* () =