add Syntax.list_filter_map

src/keys.ml

@@ -140,56 +140,46 @@ module Make (Conn : Pg.CONN) : S = struct
       }
 
   let future_signkeys () =
-    let l : Sm_eddsa.info list = Sm_eddsa.keys () in
+    Sm_eddsa.keys ()
-    let+ l =
+    |> list_filter_map (fun (pub, t1, t2) ->
-      list_map
+        let* opt = find_signkey pub in
-        (fun (pub, t1, t2) ->
+        match opt with
-          let* opt = find_signkey pub in
+        | None ->
-          match opt with
+            let future_sk = make_future_sk ~pub ~start:t1 ~expire:t2 in
-          | None ->
+            Ok (Some future_sk)
-              let future_sk = make_future_sk ~pub ~start:t1 ~expire:t2 in
+        | Some sk -> (
-              Ok (Some future_sk)
+            match Timestamp.of_absolute t1 = sk.stamp_start with
-          | Some sk -> (
+            | false ->
-              match Timestamp.of_absolute t1 = sk.stamp_start with
+                Fmt.error
-              | false ->
+                  "secmod/database stamp_start mismatch for signkey `%s`"
-                  Fmt.error
+                  (EddsaPublicKey.to_b32 pub)
-                    "secmod/database stamp_start mismatch for signkey `%s`"
+            | true -> Ok None))
-                    (EddsaPublicKey.to_b32 pub)
-              | true -> Ok None))
-        l
-    in
-    List.filter_map Fun.id l
 
   let future_denominations () =
-    let+ l =
+    Sm_rsa.keys ()
-      list_map
+    |> list_filter_map (fun (section_name, pub, t1) ->
-        (fun (section_name, pub, t1) ->
+        let h_pub = Hash.DenominationHash.hash (RsaPublicKey.to_octets pub) in
-          let h_pub = Hash.DenominationHash.hash (RsaPublicKey.to_octets pub) in
+        let* opt = find_denomination h_pub in
-          let* opt = find_denomination h_pub in
+        match opt with
-          match opt with
+        | None ->
-          | None ->
+            let* coin =
-              let* coin =
+              Config.Coin.all_coins
-                Config.Coin.all_coins
+              |> List.find_opt (fun coin ->
-                |> List.find_opt (fun coin ->
+                  coin.Config.Coin.section_name = section_name)
-                    coin.Config.Coin.section_name = section_name)
+              |> function
-                |> function
+              | Some v -> Ok v
-                | Some v -> Ok v
+              | None ->
-                | None ->
+                  Fmt.error "coin `%s` not found in configuration" section_name
-                    Fmt.error "coin `%s` not found in configuration"
+            in
-                      section_name
+            let future_dn = make_future_dn ~coin ~pub ~start:t1 in
-              in
+            Ok (Some future_dn)
-              let future_dn = make_future_dn ~coin ~pub ~start:t1 in
+        | Some sk -> (
-              Ok (Some future_dn)
+            match Timestamp.of_absolute t1 = sk.stamp_start with
-          | Some sk -> (
+            | false ->
-              match Timestamp.of_absolute t1 = sk.stamp_start with
+                Fmt.error
-              | false ->
+                  "secmod/database stamp_start mismatch for denomination `%s`"
-                  Fmt.error
+                  section_name
-                    "secmod/database stamp_start mismatch for denomination `%s`"
+            | true -> Ok None))
-                    section_name
-              | true -> Ok None))
-        (Sm_rsa.keys ())
-    in
-    List.filter_map Fun.id l
 
   let make_future_keys_response () =
     let* future_signkeys = future_signkeys () in

src/secmod_eddsa.ml

@@ -122,20 +122,21 @@ let sm_key_fpath =
 (* we load sm_key separately
    we don't accept non-key files in key_dir *)
 let load_key fpath =
-  match Fpath.equal (Fpath.normalize fpath) sm_key_fpath with
+  match parse_filename fpath with
-  | true -> Ok None
+  | None -> Fmt.error "invalid file `%a`" Fpath.pp fpath
-  | false -> (
+  | Some (t1, t2) ->
-      match parse_filename fpath with
+      let+ priv = read_key fpath in
-      | None -> Fmt.error "invalid file `%a`" Fpath.pp fpath
+      let pub = EddsaPrivateKey.pub_of_priv priv in
-      | Some (t1, t2) ->
+      { priv; pub; t1; t2 }
-          let* priv = read_key fpath in
-          let pub = EddsaPrivateKey.pub_of_priv priv in
-          Ok (Some { priv; pub; t1; t2 }))
 
 let load () =
   let* l = get_key_dir_contents Cfg.key_dir in
-  let* l = list_map load_key l in
+  let l =
-  let keys = List.filter_map Fun.id l in
+    l
+    |> List.map Fpath.normalize
+    |> List.filter (fun fpath -> not @@ Fpath.equal fpath sm_key_fpath)
+  in
+  let* keys = list_map load_key l in
   match keys with
   | [] -> Ok None
   | _l ->

src/secmod_rsa.ml

@@ -167,21 +167,22 @@ let sm_key_fpath =
 (* we load sm_key separately
    we don't accept non-key files in key_dir *)
 let load_key ~section_name fpath =
-  match Fpath.equal (Fpath.normalize fpath) sm_key_fpath with
+  match parse_filename fpath with
-  | true -> Ok None
+  | None -> Fmt.error "invalid file `%a`" Fpath.pp fpath
-  | false -> (
+  | Some (t1, t2) ->
-      match parse_filename fpath with
+      let+ priv = read_rsa fpath in
-      | None -> Fmt.error "invalid file `%a`" Fpath.pp fpath
+      let pub = RsaPrivateKey.pub_of_priv priv in
-      | Some (t1, t2) ->
+      { section_name; priv; pub; t1; t2 }
-          let* priv = read_rsa fpath in
-          let pub = RsaPrivateKey.pub_of_priv priv in
-          Ok (Some { section_name; priv; pub; t1; t2 }))
 
 let load_section section_name =
   let section_fpath = Fpath.(v Cfg.key_dir / section_name) in
   let* l = get_key_dir_contents section_fpath in
-  let* l = list_map (load_key ~section_name) l in
+  let l =
-  let keys = List.filter_map Fun.id l in
+    l
+    |> List.map Fpath.normalize
+    |> List.filter (fun fpath -> not @@ Fpath.equal fpath sm_key_fpath)
+  in
+  let* keys = list_map (load_key ~section_name) l in
   Ok keys
 
 let load () =

src/syntax.ml

@@ -7,8 +7,6 @@ let unwrap_err_msg o = match o with Error (`Msg e) -> Error e | Ok v -> Ok v
 let unwrap_err_caqti o =
   match o with Error err -> Fmt.error "%a" Caqti_error.pp err | Ok v -> Ok v
 
-(* TODO list_filter_map *)
-
 let list_iter f l =
   let err = ref None in
   try
@@ -37,6 +35,20 @@ let list_map f l =
          l)
   with Exit -> ( match !err with None -> assert false | Some v -> v)
 
+let list_filter_map f l =
+  let err = ref None in
+  try
+    Ok
+      (List.filter_map
+         (fun v ->
+           match f v with
+           | Error _e as e ->
+               err := Some e;
+               raise Exit
+           | Ok v -> v)
+         l)
+  with Exit -> ( match !err with None -> assert false | Some v -> v)
+
 let list_fold_left f acc l =
   List.fold_left
     (fun acc v ->