src/secmod_eddsa.ml

@@ -27,6 +27,15 @@ let time_abs_of_string s =
       let ts = Absolute.of_s (Int64.of_int n) in
       Some ts
 
+let t1_t2_of_filename fname =
+  match String.split_on_char '-' fname with
+  | [] -> Fmt.failwith "not possible"
+  | [ t1; t2 ] -> (
+      match (time_abs_of_string t1, time_abs_of_string t2) with
+      | None, _ | _, None -> None
+      | Some t1, Some t2 -> Some (t1, t2))
+  | _ -> None
+
 let time_abs_to_string abs =
   abs
   |> Timestamp.of_absolute
@@ -51,10 +60,10 @@ let write_eddsa fname priv =
   Bos.OS.File.write fpath data |> unwrap_err_msg
 
 let write_key k = write_eddsa (key_filename k) k.priv
+let sort_keys l = List.sort (fun a b -> Absolute.compare a.t2 b.t2) l
 
 let split_in_periodes ~start ~end_ =
-  (* no overlap on first periode
-     this is to not generate a key valid in the past *)
+  (* no overlap on first periode *)
   let t1 = start in
   let t2 = Absolute.add start Cfg.duration in
   let acc = [ (t1, t2) ] in
@@ -66,13 +75,11 @@ let split_in_periodes ~start ~end_ =
   in
   go acc start end_
 
-let sort_keys l = List.sort (fun a b -> Absolute.compare a.t2 b.t2) l
-
 let gen_additional_keys_until_lookahead ~now l =
-  let l = sort_keys l in
+  (* try to _not_ generate keys with validity start in the past
+     (probably not important) *)
   let start =
-    let l_rev = List.rev l in
-    match l_rev with
+    match List.rev (sort_keys l) with
     | [] -> now
     | hd :: _ -> Absolute.sub hd.t2 Cfg.overlap_duration
   in
@@ -91,36 +98,19 @@ let check_periodes _l =
   (* TODO *)
   Ok ()
 
-let purge _t =
-  (* TODO *)
-  Ok ()
-
-let purge_outdated ~now l =
-  let+ l =
-    list_map
-      (fun t ->
-        if Absolute.compare now t.t2 >= 0 then
-          let* () = purge t in
-          Ok None
-        else Ok (Some t))
-      l
-  in
-  List.filter_map Fun.id l
-
+(* we load sm_key separately
+   we don't accept non-key files in key_dir *)
 let load_key fpath =
   let fname = Fpath.filename fpath in
-  if fname = Cfg.sm_priv_key then Ok None
-  else
-    match String.split_on_char '-' fname with
-    | [] -> Fmt.failwith "not possible"
-    | [ t1; t2 ] -> (
-        match (time_abs_of_string t1, time_abs_of_string t2) with
-        | None, _ | _, None -> Fmt.error "invalid filename `%s`" fname
-        | Some t1, Some t2 ->
+  match fname = Cfg.sm_priv_key with
+  | true -> Ok None
+  | false -> (
+      match t1_t2_of_filename fname with
+      | None -> Fmt.error "invalid filename `%s`" fname
+      | Some (t1, t2) ->
           let* priv = read_key fname in
           let pub = EddsaPrivateKey.pub_of_priv priv in
           Ok (Some { priv; pub; t1; t2 }))
-    | _ -> Ok None
 
 let load () =
   let dir = Fpath.v Cfg.key_dir in
@@ -150,15 +140,15 @@ let init () =
         Ok { sm_key_priv; sm_key_pub; keys= [] }
   in
   let now = Absolute.of_ptime (Ptime_clock.now ()) in
-  let* keys = purge_outdated ~now t.keys in
-  let* () = check_periodes keys in
-  let new_keys = gen_additional_keys_until_lookahead ~now keys in
+  let* () = check_periodes t.keys in
+  let new_keys = gen_additional_keys_until_lookahead ~now t.keys in
   let* () = list_iter write_key new_keys in
-  let keys = keys @ new_keys in
-  let keys = sort_keys keys in
+  let keys = sort_keys (t.keys @ new_keys) in
   let t = { t with keys } in
   Ok t
 
+(* --- *)
+
 let t =
   match init () with
   | Error e -> Fmt.failwith "secmod_eddsa initialization failure: %s." e
@@ -168,25 +158,30 @@ let sm_key_pub = t.sm_key_pub
 let keys () = List.map (fun { priv= _; pub; t1; t2 } -> (pub, t1, t2)) t.keys
 let sign_with_sm_key s = EddsaSignature.sign ~key:t.sm_key_priv s
 
-let sign ~pub s =
-  match List.find_opt (fun k -> k.pub = pub) t.keys with
-  | None -> Error "key not found"
-  | Some k ->
-      let data = EddsaSignature.sign ~key:k.priv s in
-      Ok data
+let find_key pub =
+  List.find_opt (fun k -> k.pub = pub) t.keys
+  |> Option.to_result ~none:"key not found"
 
-let delete_key ~pub =
-  let k = List.find_opt (fun k -> k.pub = pub) t.keys in
-  match k with
-  | None -> Error "key not found"
-  | Some k ->
+let sign ~pub s =
+  let+ k = find_key pub in
+  let data = EddsaSignature.sign ~key:k.priv s in
+  data
+
+let delete_key pub =
+  let* k = find_key pub in
   let l = List.filter (fun k -> k.pub <> pub) t.keys in
   t.keys <- l;
   (* rm file *)
   let fname = key_filename k in
   let fpath = Fpath.(v Cfg.key_dir / fname) in
-      let+ () = Bos.OS.File.delete ~must_exist:true fpath |> unwrap_err_msg in
-      ()
+  let* () = Bos.OS.File.delete ~must_exist:true fpath |> unwrap_err_msg in
+  Ok ()
+
+let delete_outdated ~now =
+  t.keys
+  |> List.filter (fun k -> Absolute.compare now k.t2 >= 0)
+  |> List.map (fun k -> k.pub)
+  |> list_iter delete_key
 
 (* TODO
   - sign: check time
@@ -196,7 +191,8 @@ let delete_key ~pub =
   taler doc/config is confusing
   how is computed stamp_expire stamp_end
   what to do of 'Exchange.signkey_legal_duration'
-  => (??)
+  =>
     stamp_expire = stamp_start + duration
     stamp_end = stamp_start + signkey_legal_duration
+    (not sure about it)
 *)