~

src/keys.ml

@@ -140,10 +140,8 @@ module Make (Conn : Pg.CONN) : S = struct
       }
 
   let future_signkeys () =
-    let l : Sm_eddsa.info list = Sm_eddsa.keys () in
-    let+ l =
-      list_map
-        (fun (pub, t1, t2) ->
+    Sm_eddsa.keys ()
+    |> list_filter_map (fun (pub, t1, t2) ->
         let* opt = find_signkey pub in
         match opt with
         | None ->
@@ -156,14 +154,10 @@ module Make (Conn : Pg.CONN) : S = struct
                   "secmod/database stamp_start mismatch for signkey `%s`"
                   (EddsaPublicKey.to_b32 pub)
             | true -> Ok None))
-        l
-    in
-    List.filter_map Fun.id l
 
   let future_denominations () =
-    let+ l =
-      list_map
-        (fun (section_name, pub, t1) ->
+    Sm_rsa.keys ()
+    |> list_filter_map (fun (section_name, pub, t1) ->
         let h_pub = Hash.DenominationHash.hash (RsaPublicKey.to_octets pub) in
         let* opt = find_denomination h_pub in
         match opt with
@@ -175,8 +169,7 @@ module Make (Conn : Pg.CONN) : S = struct
               |> function
               | Some v -> Ok v
               | None ->
-                    Fmt.error "coin `%s` not found in configuration"
-                      section_name
+                  Fmt.error "coin `%s` not found in configuration" section_name
             in
             let future_dn = make_future_dn ~coin ~pub ~start:t1 in
             Ok (Some future_dn)
@@ -187,9 +180,6 @@ module Make (Conn : Pg.CONN) : S = struct
                   "secmod/database stamp_start mismatch for denomination `%s`"
                   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
-  | true -> Ok None
-  | false -> (
   match parse_filename fpath with
   | None -> Fmt.error "invalid file `%a`" Fpath.pp fpath
   | Some (t1, t2) ->
-          let* priv = read_key fpath in
+      let+ priv = read_key fpath in
       let pub = EddsaPrivateKey.pub_of_priv priv in
-          Ok (Some { priv; pub; t1; t2 }))
+      { 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 keys = List.filter_map Fun.id l in
+  let l =
+    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
-  | true -> Ok None
-  | false -> (
   match parse_filename fpath with
   | None -> Fmt.error "invalid file `%a`" Fpath.pp fpath
   | Some (t1, t2) ->
-          let* priv = read_rsa fpath in
+      let+ priv = read_rsa fpath in
       let pub = RsaPrivateKey.pub_of_priv priv in
-          Ok (Some { section_name; priv; pub; t1; t2 }))
+      { 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 keys = List.filter_map Fun.id l in
+  let l =
+    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 ->