add result.ml; polymorphic variant errors + refacto

src/config_parser.ml

@@ -3,6 +3,15 @@
 
    do not support "$"-path expansion *)
 
+let failure fmt =
+  Fmt.kstr
+    (fun s ->
+      Fmt.epr "Config failure: %s.@." s;
+      exit 1)
+    fmt
+
+let unwrap_or_failure = function Error e -> failure "`%s`" e | Ok v -> v
+
 open Angstrom
 
 type item = {
@@ -15,10 +24,6 @@ type section = {
   items: item list;
 }
 
-let fail fmt =
-  let k _ppf = exit 1 in
-  Fmt.kpf k Fmt.stderr ("Configuration failure: " ^^ fmt ^^ ".@.")
-
 let is_eol = function '\n' | '\r' -> true | _ -> false
 let is_whitespace = function ' ' | '\t' -> true | _ -> false
 let blanks = skip_while is_whitespace
@@ -54,7 +59,7 @@ module Config_section = struct
     let quoted_value =
       char '"' *> take_till is_eol <* end_of_line >>= fun s ->
       match String.ends_with ~suffix:"\"" s && s <> "\"" with
-      | false -> fail "invalid quoted value"
+      | false -> failure "invalid quoted value `%s`" s
       | true ->
           let value = String.sub s 0 (String.length s - 1) in
           return value
@@ -75,7 +80,7 @@ module Config_section = struct
       match l with
       | [] ->
           if List.is_empty item_l then section_l
-          else fail "invalid configuration structure"
+          else failure "invalid section structure"
       | Blank :: tl | Comment _ :: tl -> loop section_l item_l tl
       | Item item :: tl -> loop section_l (item :: item_l) tl
       | Header header :: tl ->
@@ -86,7 +91,7 @@ module Config_section = struct
 
   let parse s =
     match parse_string ~consume:All config s with
-    | Error msg -> fail "parse error `%s`" msg
+    | Error msg -> failure "parse error `%s`" msg
     | Ok v -> fold_sections v
 end
 
@@ -99,7 +104,7 @@ module Config_duration = struct
   let integer =
     take_while1 (function '0' .. '9' -> true | _ -> false) >>= fun s ->
     match int_of_string_opt s with
-    | None -> fail "expected integer, got `%s`" s
+    | None -> failure "expected integer, got `%s`" s
     | Some i -> return i
 
   let duration_element =
@@ -113,7 +118,7 @@ module Config_duration = struct
       | "hour" | "hours" -> return `Hour
       | "minute" | "minutes" -> return `Minute
       | "second" | "seconds" | "s" -> return `Second
-      | s -> fail "expected a duration unit, got `%s`" s
+      | s -> failure "expected a duration unit, got `%s`" s
     in
     lift2 (fun number dunit -> { number; dunit }) number dunit
 
@@ -140,12 +145,10 @@ module Config_duration = struct
 
   let parse s : duration_element list =
     match parse_string ~consume:All duration s with
-    | Error msg -> fail "duration parse error `%s`" msg
+    | Error msg -> failure "duration parse error `%s`" msg
     | Ok v -> v
 end
 
-let unwrap = function Error e -> fail "`%s`." e | Ok v -> v
-
 let get_opt t ~section ~field =
   match List.find_opt (fun v -> v.header = section) t with
   | None -> None
@@ -156,33 +159,34 @@ let get_opt t ~section ~field =
 
 let get t ~section ~field =
   match get_opt t ~section ~field with
-  | None -> fail "option `[%s].%s` not found" section field
+  | None -> failure "option `[%s].%s` not found" section field
   | Some v -> v
 
 let int s =
   match int_of_string_opt s with
-  | None -> fail "expected int value, got `%s`" s
+  | None -> failure "expected int value, got `%s`" s
   | Some v -> v
 
 let float s =
   match float_of_string_opt s with
-  | None -> fail "expected float value, got `%s`" s
+  | None -> failure "expected float value, got `%s`" s
   | Some v -> v
 
 let const_value a b =
-  match a = b with false -> fail "unexpected value `%s`" b | true -> a
+  match a = b with false -> failure "unexpected value `%s`" b | true -> a
 
 let yes_no = function
   | "NO" -> `NO
   | "YES" -> `YES
-  | s -> fail "expected `YES`/`NO` value, got `%s`" s
+  | s -> failure "expected `YES`/`NO` value, got `%s`" s
 
+let etag s = s
 let uri s = Uri.of_string s
 
 let amount =
   let currency = ref None in
   fun s ->
-    let amount = s |> Amount.of_string |> unwrap in
+    let amount = s |> Amount.of_string |> unwrap_or_failure in
     match !currency with
     | None ->
         currency := Some amount.currency;
@@ -190,18 +194,19 @@ let amount =
     | Some cur -> (
         match String.equal amount.currency cur with
         | false ->
-            fail "only one kind of currency is supported, found: `%s` and `%s`."
+            failure
+              "only one kind of currency is supported, found: `%s` and `%s`."
               amount.currency cur
         | true -> amount)
 
 let duration s = Config_duration.(s |> parse |> to_time_span)
 
-let ed25519 s =
-  s
-  |> B32.decode
-  |> unwrap
-  |> Mirage_crypto_ec.Ed25519.pub_of_octets
-  |> Result.map_error (fun e -> Fmt.str "%a" Mirage_crypto_ec.pp_error e)
-  |> unwrap
+let rsa_keysize s =
+  let nbits = int s in
+  let len = ((nbits - 1) / 8) + 1 in
+  if 8 * len = nbits then nbits
+  else
+    (* because of [kdf_mod_n] *)
+    failure "RSA keysize must be multiple of 8, found `%d`" nbits
 
-let etag s = s
+let ed25519 s = Eddsa.pub_of_b32 s |> unwrap_or_failure