+ secmod_eddsa

default/assets/mte.conf

@@ -41,11 +41,17 @@ config = "pgx://mte:hunter2@localhost:5432/taler-exchange"
 
 [taler-exchange-secmod-rsa]
 lookahead_sign = "1 year"
-overlap_duration = "1 year"
+overlap_duration = "1 hour"
+duration = "3 weeks"
+key_dir = "secrets/secmod_rsa"
+sm_priv_key = "secrets/secmod_rsa/sm_key"
 
 [taler-exchange-secmod-eddsa]
 lookahead_sign = "1 year"
-overlap_duration = "1 year"
+overlap_duration = "1 hour"
+duration = "3 weeks"
+key_dir = "secrets/secmod_eddsa"
+sm_priv_key = "secrets/secmod_eddsa/sm_key"
 
 [coin_kudo_1]
 value= EUR:0.01

src/config.ml

@@ -1,11 +1,9 @@
 open Parse_config
 
 let config_filename = "mte.conf"
-let secrets_dir = Fpath.v "secrets"
-let secmod_dir = Fpath.(secrets_dir / "secmod")
 
-(* TODO config *)
-let secmod_eddsa_dir = Fpath.(secrets_dir / "secmod_eddsa")
+(* TODO config
+   read Fpath.t *)
 
 let config_data =
   match Assets_crunch.read config_filename with
@@ -190,7 +188,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 +201,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 key_dir = get "key_dir"
+  let sm_priv_key = get "sm_priv_key"
 end
 
 (* -- *)

src/keys.ml

@@ -40,11 +40,14 @@ module Make (Conn : Pg.CONN) = struct
   }
 
   let conn = (module Conn : Pg.CONN)
-  let sm_key_fname = Fpath.(Config.secmod_dir / "sm_key")
-  let sk_fname i = Fpath.(Config.secmod_dir / Fmt.str "sk_%d" i)
+  let sm_key_fname = Fpath.(v Config.Exchange_secmod_eddsa.sm_priv_key)
+
+  let sk_fname i =
+    Fpath.(v Config.Exchange_secmod_eddsa.key_dir / Fmt.str "sk_%d" i)
 
   let dn_fname section_name =
-    Fpath.(Config.secmod_dir / Fmt.str "dn_%s" section_name)
+    Fpath.(
+      v Config.Exchange_secmod_eddsa.key_dir / Fmt.str "dn_%s" section_name)
 
   let sign_with_sm_key t s = EddsaSignature.sign ~key:t.sm_key s
 
@@ -238,7 +241,7 @@ module Make (Conn : Pg.CONN) = struct
     Ok t
 
   let init () =
-    let dir = Config.secmod_dir in
+    let dir = Fpath.v Config.Exchange_secmod_eddsa.key_dir in
     let* b = Bos.OS.Dir.create ~mode:0o700 dir |> unwrap_err_msg in
     if b then Logs.info (fun m -> m "Keys: created directory `%a`" Fpath.pp dir);
     let* l =

src/secmod_eddsa.ml

@@ -1,60 +1,212 @@
 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 Time
 open Mirage_crypto_ec
+module Cfg = Config.Exchange_secmod_eddsa
 
 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;
 }
 
-(*
-  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
+type t = {
+  sm_key_priv: priv;
+  sm_key_pub: pub;
+  mutable keys: key list;
+}
 
+(* -- util -- *)
 
+let time_abs_of_string s =
+  int_of_string_opt s |> Option.map (fun n -> Absolute.of_s (Int64.of_int n))
 
-  - sign
-  - verify
-  - expose future_sk list
-  - purge
+let t1_t2_of_fpath fpath =
+  let fname = Fpath.filename fpath in
+  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
+  |> Timestamp.to_s
+  |> Option.get
+  |> Int64.to_int
+  |> string_of_int
+
+let key_fpath k =
+  let t1 = time_abs_to_string k.t1 in
+  let t2 = time_abs_to_string k.t2 in
+  let fname = Fmt.str "%s-%s" t1 t2 in
+  Fpath.(v Cfg.key_dir / fname)
+
+(* -- IO -- *)
+
+let read_key fpath =
+  let* data = Bos.OS.File.read fpath |> unwrap_err_msg in
+  EddsaPrivateKey.of_octets data
+
+let write_eddsa fpath priv =
+  let data = EddsaPrivateKey.to_octets priv in
+  Bos.OS.File.write fpath data |> unwrap_err_msg
+
+let write_key k = write_eddsa (key_fpath k) k.priv
+
+let delete_key_file k =
+  let+ () =
+    Bos.OS.File.delete ~must_exist:true (key_fpath k) |> unwrap_err_msg
+  in
+  ()
+
+let get_key_dir_contents dir =
+  let* dir = Fpath.of_string dir |> unwrap_err_msg 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
+  l
+
+(* -- *)
+
+let sort_keys l = List.sort (fun a b -> Absolute.compare a.t2 b.t2) l
+
+let split_in_periodes ~start ~end_ =
+  assert (start < end_);
+  (* no overlap on first periode *)
+  let t1 = start in
+  let t2 = Absolute.add start Cfg.duration in
+  let acc = [ (t1, t2) ] in
+  let start = t2 in
+  let rec go acc start end_ =
+    let t1 = Absolute.sub start Cfg.overlap_duration in
+    let t2 = Absolute.add start Cfg.duration in
+    if t2 > end_ then acc else go ((t1, t2) :: acc) t2 end_
+  in
+  go acc start end_
+
+let gen_additional_keys_until_lookahead ~now l =
+  (* try to _not_ generate keys with validity start in the past
+     (probably not important) *)
+  let start =
+    match List.rev (sort_keys l) with
+    | [] -> now
+    | hd :: _ -> Absolute.sub hd.t2 Cfg.overlap_duration
+  in
+  let end_ = Absolute.add now Cfg.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 sm_key_fpath =
+  Result.get_ok
+  @@
+  let+ fpath = Fpath.of_string Cfg.sm_priv_key |> unwrap_err_msg in
+  Fpath.normalize 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 t1_t2_of_fpath fpath with
+      | None -> Fmt.error "invalid file `%a`" Fpath.pp fpath
+      | Some (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 keys = List.filter_map Fun.id l in
+  match keys with
+  | [] -> Ok None
+  | _l ->
+      let* sm_key_priv = read_key sm_key_fpath 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_key_fpath sm_key_priv in
+        Ok { sm_key_priv; sm_key_pub; keys= [] }
+  in
+  let now = Absolute.of_ptime (Ptime_clock.now ()) 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 = sort_keys (t.keys @ new_keys) in
+  { t with keys }
+
+(* --- *)
+
+let t =
+  match init () with
+  | Error e -> Fmt.failwith "secmod_eddsa initialization failure: %s." e
+  | Ok t -> t
+
+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 find_key pub =
+  List.find_opt (fun k -> k.pub = pub) t.keys
+  |> Option.to_result ~none:"key not found"
+
+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;
+  delete_key_file k
+
+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
   - schedule tasks
   - !lock
 
-  todo taler doc/config is confusing
+  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)
 *)

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