Merge pull request #16 from dinosaure/test-content-type

Add tests about content-type parsing

lib/content_type.ml

@@ -602,9 +602,10 @@ let of_string str =
   let open Rresult in
   Unstrctrd.of_string str
   >>| (fun (_, v) -> Unstrctrd.fold_fws v)
+  >>= Unstrctrd.without_comments
   >>| Unstrctrd.to_utf_8_string
   >>= fun str ->
-  match Angstrom.parse_string ~consume:All Decoder.content str with
+  match Angstrom.parse_string ~consume:Prefix Decoder.content str with
   | Ok v -> Ok v
   | Error _ -> R.error_msgf "Invalid (unfolded) Content-Type value: %S" str
 

lib/multipart_form.mli

@@ -51,6 +51,8 @@ module Content_type : sig
     type t =
       [ `Ietf_token of string | `Iana_token of string | `X_token of string ]
 
+    val iana : string -> (t, [> `Msg of string ]) result
+
     val pp : t Fmt.t
   end
 
@@ -63,6 +65,14 @@ module Content_type : sig
 
     type t = value Map.t
 
+    val key : string -> (key, [> `Msg of string ]) result
+
+    val value : string -> (value, [> `Msg of string ]) result
+
+    val add : key -> value -> t -> t
+
+    val empty : t
+
     val pp : t Fmt.t
   end
 
@@ -72,6 +82,10 @@ module Content_type : sig
     parameters : (string * Parameters.value) list;
   }
 
+  val make : Type.t -> Subtype.t -> Parameters.value Parameters.Map.t -> t
+
+  val equal : t -> t -> bool
+
   val pp : t Fmt.t
 
   val of_string : string -> (t, [> `Msg of string ]) result

multipart_form.opam

@@ -26,6 +26,7 @@ depends: [
   "logs"
   "ke" {>= "0.4"}
   "alcotest" {with-test}
+  "rosetta" {with-test}
   "bigarray-compat" {>= "1.0.0"}
   "bigstringaf" {>= "0.7.0"}
   "result" {>= "1.5"}

test/dune

@@ -1,6 +1,7 @@
 (executable
  (name test)
- (libraries alcotest fmt rresult result angstrom multipart_form))
+ (libraries rosetta unstrctrd unstrctrd.parser alcotest fmt rresult result
+   angstrom multipart_form))
 
 (rule
  (alias runtest)

test/test.ml

@@ -207,9 +207,59 @@ let make_simple_multipart =
         "file2" (List.assoc "file2" m) "Content of a.txt.\n"
   | Error (`Msg err) -> Alcotest.fail err
 
+let parse_content_type x = Multipart_form.Content_type.of_string (x ^ "\r\n")
+
+let content_type =
+  Alcotest.testable Multipart_form.Content_type.pp
+    Multipart_form.Content_type.equal
+
+let make raw expect =
+  Alcotest.test_case raw `Quick @@ fun () ->
+  match parse_content_type raw with
+  | Ok value -> Alcotest.(check content_type) raw expect value
+  | Error err ->
+      Fmt.invalid_arg "Invalid content-type value: %s (%a)." raw
+        Rresult.R.pp_msg err
+
+let content_type_0 =
+  let open Multipart_form.Content_type in
+  let value =
+    let open Rresult.R in
+    Parameters.key "charset" >>= fun charset ->
+    Parameters.value "us-ascii" >>= fun us_ascii ->
+    Subtype.iana "plain" >>| fun subty ->
+    make `Text subty Parameters.(add charset us_ascii empty) in
+  Rresult.R.get_ok value
+
+let content_type_1 =
+  let open Multipart_form.Content_type in
+  let value =
+    let open Rresult.R in
+    Parameters.key "charset" >>= fun charset ->
+    Parameters.value "us-ascii" >>= fun us_ascii ->
+    Subtype.iana "plain" >>| fun subty ->
+    make `Text subty Parameters.(add charset us_ascii empty) in
+  Rresult.R.get_ok value
+
+let content_type_2 =
+  let open Multipart_form.Content_type in
+  let value =
+    let open Rresult.R in
+    Parameters.key "charset" >>= fun charset ->
+    Parameters.value (Rosetta.encoding_to_string `ISO_8859_1) >>= fun latin1 ->
+    Subtype.iana "plain" >>| fun subty ->
+    make `Text subty Parameters.(add charset latin1 empty) in
+  Rresult.R.get_ok value
+
 let () =
   Alcotest.run "multipart_form"
     [
+      ( "content-type",
+        [
+          make "text/plain; charset=us-ascii (Plain text)" content_type_0;
+          make "text/plain; charset=\"us-ascii\"" content_type_1;
+          make "text/plain; charset=ISO-8859-1" content_type_2;
+        ] );
       ( "multipart_form (decoder)",
         [ simple_multipart_form; simple_with_helpers ] );
       ("multipart_form (encoder)", [ make_simple_multipart ]);