src/config.ml

@@ -1,10 +1,10 @@
 open Parse_config
 
 let config_filename = "mte.conf"
+
+(* TODO config : rm *)
 let secrets_dir = Fpath.v "secrets"
 let secmod_dir = Fpath.(secrets_dir / "secmod")
-
-(* TODO config *)
 let secmod_eddsa_dir = Fpath.(secrets_dir / "secmod_eddsa")
 
 let config_data =
@@ -190,7 +190,9 @@ module Exchange_secmod_rsa = struct
 
   let lookahead_sign = get "lookahead_sign" |> duration
   let overlap_duration = get "overlap_duration" |> duration
-  (* not relevant: sm_priv_key key_dir unixpath *)
+  let duration = get "duration" |> duration
+  let sm_priv_key = get "sm_priv_key"
+  let key_dir = get "key_dir"
 end
 
 module Exchange_secmod_eddsa = struct
@@ -201,27 +203,8 @@ module Exchange_secmod_eddsa = struct
   let lookahead_sign = get "lookahead_sign" |> duration
   let overlap_duration = get "overlap_duration" |> duration
   let duration = get "duration" |> duration
-
-  (* TODO config
-LOOKAHEAD_SIGN
-
-    How long do we generate denomination and signing keys ahead of time?
-OVERLAP_DURATION
-
-    How much should validity periods for coins overlap? Should be long enough to avoid problems with wallets picking one key and then due to network latency another key being valid. The DURATION_WITHDRAW period must be longer than this value.
-DURATION
-
-    For how long should EdDSA keys be valid for signing?
-SM_PRIV_KEY
-
-    Where should the security module store its long-term private key?
-KEY_DIR
-
-    Where should the security module store the private keys it manages?
-UNIXPATH
-
-    On which path should the security module listen for signing requests?
-    *)
+  let sm_priv_key = get "sm_priv_key"
+  let key_dir = get "key_dir"
 end
 
 (* -- *)

src/secmod_eddsa.ml

@@ -1,49 +1,169 @@
 open Syntax
 open Crypto
-
-let read fname = Bos.OS.File.read fname |> unwrap_err_msg
-let write fname s = Bos.OS.File.write fname s |> unwrap_err_msg
-
-let read_eddsa fname =
-  let* data = read fname in
-  EddsaPrivateKey.of_octets data
-
-let write_eddsa fname priv = write fname (EddsaPrivateKey.to_octets priv)
-
-module Config = struct
-  (* TODO config *)
-  open Config.Exchange_secmod_eddsa
-
-  let dir = Config.secmod_eddsa_dir
-  let lookahead_sign = lookahead_sign
-  let overlap_duration = overlap_duration
-  let duration = duration
-end
-
 open Mirage_crypto_ec
+open Config.Exchange_secmod_eddsa
+open Time
 
 type priv = Ed25519.priv
 type pub = Ed25519.pub
 
-type t = {
+type key = {
   priv: priv;
   pub: pub;
-  start: Timestamp.t;
-  end_: Timestamp.t;
+  t1: Absolute.t;
+  t2: Absolute.t;
 }
 
+type t = {
+  sm_key_priv: priv;
+  sm_key_pub: pub;
+  keys: key list;
+}
+
+let time_abs_of_string s =
+  match int_of_string_opt s with
+  | None -> None
+  | Some n ->
+      let ts = Absolute.of_s (Int64.of_int n) in
+      Some ts
+
+let time_abs_to_string abs =
+  abs
+  |> Timestamp.of_absolute
+  |> Timestamp.to_s
+  |> Option.get
+  |> Int64.to_int
+  |> string_of_int
+
+let read_key fname =
+  let fpath = Fpath.(v key_dir / fname) in
+  let* data = Bos.OS.File.read fpath |> unwrap_err_msg in
+  EddsaPrivateKey.of_octets data
+
+let write_eddsa fname priv =
+  let fpath = Fpath.(v key_dir / fname) in
+  let data = EddsaPrivateKey.to_octets priv in
+  Bos.OS.File.write fpath data |> unwrap_err_msg
+
+let write_key t =
+  let t1 = time_abs_to_string t.t1 in
+  let t2 = time_abs_to_string t.t2 in
+  let fname = Fmt.str "%s-%s" t1 t2 in
+  write_eddsa fname t.priv
+
+let split_in_periodes ~start ~end_ =
+  (* no overlap on first periode
+     this is to not generate a key valid in the past *)
+  let t1 = start in
+  let t2 = Absolute.add start duration in
+  let acc = [ (t1, t2) ] in
+  let start = t2 in
+  let rec go acc start end_ =
+    let t1 = Absolute.sub start overlap_duration in
+    let t2 = Absolute.add start duration in
+    if t2 > end_ then acc else go ((t1, t2) :: acc) t2 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
+  let start =
+    let l_rev = List.rev l in
+    match l_rev with
+    | [] -> now
+    | hd :: _ -> Absolute.sub hd.t2 overlap_duration
+  in
+  let end_ = Absolute.add now lookahead_sign in
+  let periodes = split_in_periodes ~start ~end_ in
+  let new_keys =
+    List.map
+      (fun (t1, t2) ->
+        let priv, pub = Mirage_crypto_ec.Ed25519.generate () in
+        { priv; pub; t1; t2 })
+      periodes
+  in
+  new_keys
+
+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
+
+let load_key fpath =
+  let fname = Fpath.filename fpath in
+  if fname = 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 ->
+            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 key_dir in
+  let* b = Bos.OS.Dir.create ~mode:0o700 dir |> unwrap_err_msg in
+  if b then
+    Logs.info (fun m -> m "secmod_eddsa: created directory `%a`" Fpath.pp dir);
+  let* l =
+    Bos.OS.Dir.contents ~dotfiles:false ~rel:true dir |> unwrap_err_msg
+  in
+  let* l = list_map load_key l in
+  let keys = List.filter_map Fun.id l in
+  match keys with
+  | [] -> Ok None
+  | _l ->
+      let* sm_key_priv = read_key sm_priv_key in
+      let sm_key_pub = EddsaPrivateKey.pub_of_priv sm_key_priv in
+      Ok (Some { sm_key_priv; sm_key_pub; keys })
+
+let init () =
+  let* opt = load () in
+  let* t =
+    match opt with
+    | Some t -> Ok t
+    | None ->
+        let sm_key_priv, sm_key_pub = Mirage_crypto_ec.Ed25519.generate () in
+        let* () = write_eddsa sm_priv_key sm_key_priv in
+        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* () = list_iter write_key new_keys in
+  let keys = keys @ new_keys in
+  let keys = sort_keys 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
+  | Ok t -> t
+
 (*
-  create dir if not exists
-  read dir contents
-  init sm_key
-  check filename
-  build sorted list
-  check overlaps
-  just fail if not good
-  add keys until lookahead
-
-
-
   - sign
   - verify
   - expose future_sk list

src/syntax.ml

@@ -7,6 +7,8 @@ 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