114 lines
3.4 KiB
OCaml
114 lines
3.4 KiB
OCaml
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"
|