add depends

src/validate_str.ml

@@ -0,0 +1,114 @@
+open Syntax
+
+type v_string = string
+
+type err =
+  | Too_short of int
+  | Too_long of int
+  | Contains_forbidden_char
+  | Not_trimed
+
+let pp_err fmt e =
+  match e with
+  | Too_short n -> Fmt.pf fmt "is too short, minimum lenght is %d" n
+  | Too_long n -> Fmt.pf fmt "is too long, maximum lenght is %d" n
+  | Contains_forbidden_char ->
+    (* TODO say which ones *)
+    Fmt.pf fmt "contains forbidden character"
+  | Not_trimed -> Fmt.pf fmt "contains leading or trailing whitespace"
+
+(* TODO:
+   - not sure on what to allow/disallow and on which input strings
+   - bidi issue in html *)
+let is_not_restricted =
+  let is_not_restricted c =
+    match c with
+    | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' | '-' | '.' -> true
+    | _ -> false
+  in
+  fun s -> String.for_all is_not_restricted s
+
+(* restrict_trim with min_len check that the string is not artificially padded with whitespace *)
+let make ~min_len ~max_len ~restrict_char ~restrict_trim =
+  let check_min =
+    match min_len with
+    | None -> fun _s -> Ok ()
+    | Some min_len ->
+      fun len -> if len >= min_len then Ok () else Error (Too_short min_len)
+  in
+  let check_max =
+   fun len -> if len <= max_len then Ok () else Error (Too_long max_len)
+  in
+  let check_char =
+    match restrict_char with
+    | false -> fun _s -> Ok ()
+    | true ->
+      fun s ->
+        if is_not_restricted s then Ok () else Error Contains_forbidden_char
+  in
+  fun s : (v_string, err) Result.t ->
+    let* () =
+      if restrict_trim then
+        if String.length (String.trim s) = String.length s then Ok ()
+        else Error Not_trimed
+      else Ok ()
+    in
+    let len = String.length s in
+    let* () = check_min len in
+    let* () = check_max len in
+    let+ () = check_char s in
+    s
+
+let map_err_to_invalid_submission ~kind_str f =
+ fun s ->
+  f s
+  |> Result.map_error (fun e ->
+         let s = Fmt.str "%s %a" kind_str pp_err e in
+         Err.Unprocessable s )
+
+open Config
+
+let subject =
+  make ~max_len:subject_max_length ~min_len:subject_min_length
+    ~restrict_char:false ~restrict_trim:true
+  |> map_err_to_invalid_submission ~kind_str:"subject"
+
+let comment =
+  make ~max_len:comment_max_length ~min_len:comment_min_length
+    ~restrict_char:false ~restrict_trim:true
+  |> map_err_to_invalid_submission ~kind_str:"comment"
+
+let report =
+  make ~max_len:report_max_length ~min_len:None ~restrict_char:false
+    ~restrict_trim:true
+  |> map_err_to_invalid_submission ~kind_str:"report"
+
+let nick =
+  make ~max_len:nick_max_length ~min_len:(Some nick_min_length)
+    ~restrict_char:true ~restrict_trim:true
+  |> map_err_to_invalid_submission ~kind_str:"nick"
+
+let email =
+  (* just to force it to be trimed *)
+  make ~max_len:1_000 ~min_len:None ~restrict_char:false ~restrict_trim:true
+  |> map_err_to_invalid_submission ~kind_str:"email"
+
+let bio =
+  make ~max_len:biography_max_length ~min_len:None ~restrict_char:false
+    ~restrict_trim:false
+  |> map_err_to_invalid_submission ~kind_str:"biography"
+
+let password =
+  make ~max_len:password_max_length ~min_len:(Some password_min_length)
+    ~restrict_char:false ~restrict_trim:false
+  |> map_err_to_invalid_submission ~kind_str:"password"
+
+let image_name =
+  make ~max_len:image_name_max_length ~min_len:None ~restrict_char:false
+    ~restrict_trim:true
+  |> map_err_to_invalid_submission ~kind_str:"image name"
+
+let image_alt =
+  make ~max_len:image_description_max_length ~min_len:None ~restrict_char:false
+    ~restrict_trim:true
+  |> map_err_to_invalid_submission ~kind_str:"image description"