add data_file.ml

src/crypto.ml

@@ -165,6 +165,27 @@ module RsaPublicKey = struct
   let jsont = Jsont.of_of_string ~kind:"RsaPublicKey" of_b32 ~enc:to_b32
 end
 
+module RsaPrivateKey = struct
+  open Mirage_crypto_pk.Rsa
+
+  type t = priv
+
+  let pub_of_priv = pub_of_priv
+
+  (* TODO rsa *)
+  let to_octets _t : string = assert false
+  let of_octets _t : t = assert false
+  (*let bin = Bin.map (Bin.bytes 32) of_octets to_octets*)
+
+  let of_b32 s =
+    let open Syntax in
+    let* octets = B32.decode s in
+    Ok (of_octets octets)
+
+  let to_b32 t = B32.encode (to_octets t)
+  let jsont = Jsont.of_of_string ~kind:"EddsaPrivateKey" of_b32 ~enc:to_b32
+end
+
 module RsaSignature : sig
   type t
 

src/data_file.ml

@@ -0,0 +1,93 @@
+open Bos.OS
+open Syntax
+open Crypto
+
+let read fname =
+  let* b = File.exists fname in
+  match b with
+  | false -> Ok None
+  | true ->
+      let+ content = File.read fname in
+      Some content
+
+let read_eddsa fname =
+  let+ content_opt = read fname in
+  Option.map EddsaPrivateKey.of_octets content_opt
+
+let read_rsa fname =
+  let+ content_opt = read fname in
+  Option.map RsaPrivateKey.of_octets content_opt
+
+let write_eddsa fname priv = EddsaPrivateKey.to_octets priv |> File.write fname
+let write_rsa fname priv = RsaPrivateKey.to_octets priv |> File.write fname
+
+let load_signkey conn fname =
+  let* opt = read_eddsa fname in
+  match opt with
+  | None -> Ok None
+  | Some priv -> (
+      let pub = EddsaPrivateKey.pub_of_priv priv in
+      let* opt = Pg.lookup_signing_key conn pub in
+      match opt with
+      | None ->
+          Fmt.error_msg
+            "load_signkey error no associated metadata found in database for \
+             signkey `%s`."
+            (Fpath.to_string fname)
+      | Some (stamp_start, stamp_expire, stamp_end) ->
+          (* TODO master_sig *)
+          let master_sig = None in
+          let v =
+            Signkey.
+              { pub; priv; stamp_start; stamp_expire; stamp_end; master_sig }
+          in
+          Ok (Some v))
+
+let load_denom conn ~section_name fname =
+  let* opt = read_rsa fname in
+  match opt with
+  | None -> Ok None
+  | Some priv -> (
+      let pub = RsaPrivateKey.pub_of_priv priv in
+      let h_pub = Bin_type.DenominationHash.hash (RsaPublicKey.to_octets pub) in
+      let* opt = Pg.lookup_denomination_key conn h_pub in
+      match opt with
+      | None ->
+          Fmt.error_msg
+            "load_denom error no associated metadata found in database for \
+             denom `%s`."
+            (Fpath.to_string fname)
+      | Some
+          ( stamp_start,
+            stamp_expire_withdraw,
+            stamp_expire_deposit,
+            stamp_expire_legal,
+            value,
+            fee_withdraw,
+            fee_deposit,
+            fee_refresh,
+            fee_refund,
+            age_mask ) ->
+          (* TODO master_sig *)
+          let master_sig = None in
+          let v =
+            Denomination.
+              {
+                pub;
+                priv;
+                section_name;
+                value;
+                stamp_start;
+                stamp_expire_withdraw;
+                stamp_expire_deposit;
+                stamp_expire_legal;
+                fee_withdraw;
+                fee_deposit;
+                fee_refresh;
+                fee_refund;
+                age_mask;
+                h_pub;
+                master_sig;
+              }
+          in
+          Ok (Some v))

src/denomination.ml

@@ -2,6 +2,7 @@ open Crypto
 
 type t = {
   pub: RsaPublicKey.t;
+  priv: RsaPrivateKey.t;
   section_name: string;
   value: Amount.t;
   stamp_start: Timestamp.t;
@@ -14,7 +15,6 @@ type t = {
   fee_refund: Amount.t;
   age_mask: int;
   h_pub: Bin_type.DenominationHash.t;
-  sign: string -> RsaSignature.t;
   master_sig: EddsaSignature.t option;
 }
 
@@ -51,10 +51,10 @@ let make
   let priv = generate ~bits:rsa_keysize () in
   let pub = pub_of_priv priv in
   let h_pub = Bin_type.DenominationHash.hash (RsaPublicKey.to_octets pub) in
-  let sign = RsaSignature.sign ~key:priv in
   let master_sig = None in
   {
     pub;
+    priv;
     section_name;
     value;
     stamp_start;
@@ -67,6 +67,5 @@ let make
     fee_refund;
     age_mask= 0;
     h_pub;
-    sign;
     master_sig;
   }

src/devices.ml

@@ -1,3 +1,5 @@
+open Syntax
+
 type env = {
   caqti_switch: Caqti_miou.Switch.t;
   db_uri: Uri.t;
@@ -16,8 +18,6 @@ let db_connection : (env, Caqti_miou.connection) Vif.Device.device =
           Fmt.failwith "Database preflight failure: %a." Caqti_error.pp err
       | Ok () -> conn)
 
-(* TODO KV store *)
-
 module Secmod_signkey = struct
   type t = {
     sm_key: Signkey.t;
@@ -26,83 +26,31 @@ module Secmod_signkey = struct
 
   let dir = Fpath.(v "data" / "secmod_signkey")
 
-  let read_eddsa_key_files fname =
-    let open Syntax in
-    let open Bos.OS in
-    let open Crypto in
-    let pub = Fpath.(dir / fname) |> Fpath.set_ext "pub" in
-    let priv = Fpath.(dir / fname) in
-    let* b0 = File.exists pub in
-    let* b1 = File.exists priv in
-    match (b0, b1) with
-    | true, true ->
-        let* pub = File.read pub in
-        let* priv = File.read priv in
-        let pub = EddsaPublicKey.of_octets pub in
-        let priv = EddsaPrivateKey.of_octets priv in
-        Ok (Some (pub, priv))
-    | false, false -> Ok None
-    | _, _ -> Error (`Msg "secmod_signkey: invalid local file state.")
+  let store_secmod_data t =
+    let* () = Data_file.write_eddsa Fpath.(dir / "sm_key") t.sm_key.priv in
+    t.keys
+    |> List.mapi (fun i key ->
+        let fname = Fpath.(dir / string_of_int i) in
+        (fname, key.Signkey.priv))
+    |> list_iter (fun (fname, key) -> Data_file.write_eddsa fname key)
 
-  let write_eddsa_key_files fname signkey =
-    let open Syntax in
-    let open Bos.OS in
-    let open Crypto in
-    let pub_file = Fpath.(dir / fname) |> Fpath.set_ext "pub" in
-    let priv_file = Fpath.(dir / fname) in
-    let pub = EddsaPublicKey.to_octets signkey.Signkey.pub in
-    let priv = EddsaPrivateKey.to_octets signkey.priv in
-    let* () = File.write pub_file pub in
-    let* () = File.write priv_file priv in
-    Ok ()
-
-  let write_local_keys t =
-    let open Syntax in
-    let* () = write_eddsa_key_files "eddsa_sm_key" t.sm_key in
-    let keys =
-      List.mapi (fun i key -> ("eddsa_" ^ string_of_int i, key)) t.keys
+  let load conn =
+    let error_invalid_state =
+      Fmt.error_msg "secmod_signkey load error: invalid store state."
     in
-    let* () = list_iter (fun (s, key) -> write_eddsa_key_files s key) keys in
-    Ok ()
-
-  let load_local_keys conn =
-    let open Syntax in
-    let load s =
-      let* opt = read_eddsa_key_files s in
-      match opt with
-      | None -> Ok None
-      | Some (pub, priv) -> (
-          let* opt = Pg.lookup_signing_key conn pub in
-          match opt with
-          | None ->
-              Fmt.error_msg
-                "secmod_signkey error: no associtaed metadata found in \
-                 database for key `%s`."
-                s
-          | Some (stamp_start, stamp_expire, stamp_end) ->
-              let master_sig = None in
-              Ok
-                (Some
-                   Signkey.
-                     {
-                       pub;
-                       priv;
-                       stamp_start;
-                       stamp_expire;
-                       stamp_end;
-                       master_sig;
-                     }))
+    let* sm_key = Data_file.load_signkey conn Fpath.(dir / "sm_key") in
+    let* key_0 =
+      let fname = Fpath.(dir / string_of_int 0) in
+      Data_file.load_signkey conn fname
     in
-    let* sm_key = load "sm_key" in
-    let* key_0 = load "0" in
     match (sm_key, key_0) with
     | None, None -> Ok None
     | Some sm_key, Some key_0 ->
         let keys = [ key_0 ] in
         Ok (Some { sm_key; keys })
-    | _, _ -> Error (`Msg "secmod_signkey: invalid local file state.")
+    | _, _ -> error_invalid_state
 
-  let generate_fresh_keys () =
+  let generate_fresh_secmod_data () =
     let sm_key = Signkey.generate () in
     let keys = [ Signkey.generate () ] in
     { sm_key; keys }
@@ -112,17 +60,13 @@ module Secmod_signkey = struct
     Vif.Device.v ~name:"secmod_signkey" ~finally
       [ Vif.Device.value db_connection ]
     @@ fun conn (_env : env) ->
-    match load_local_keys conn with
+    match load conn with
     | Ok None ->
-        Fmt.pr "secmod_signkey: generate_fresh_keys@.";
-        let t = generate_fresh_keys () in
-        (*write_local_keys t |> Result.get_ok;*)
+        let t = generate_fresh_secmod_data () in
         t
-    | Ok (Some v) ->
-        Fmt.pr "secmod_signkey: loaded local keys@.";
-        v
+    | Ok (Some v) -> v
     | Error _ ->
-        (* TODO pp error *)
+        (* TODO error: pretty print *)
         Fmt.failwith "secmod_signkey init failure."
 end
 
@@ -132,12 +76,60 @@ module Secmod_denom = struct
     keys: Denomination.t list;
   }
 
-  let v =
-    let finally _key = () in
-    Vif.Device.v ~name:"secmod_denom" ~finally [] @@ fun (_env : env) ->
+  let dir = Fpath.(v "data" / "secmod_signkey")
+
+  let store_secmod_data t =
+    let* () = Data_file.write_eddsa Fpath.(dir / "sm_key") t.sm_key.priv in
+    t.keys
+    |> List.mapi (fun i key ->
+        let fname = Fpath.(dir / string_of_int i) in
+        (fname, key.Denomination.priv))
+    |> list_iter (fun (fname, key) -> Data_file.write_rsa fname key)
+
+  let load conn =
+    let error_invalid_state =
+      Fmt.error_msg "secmod_denom load error: invalid store state."
+    in
+    let* sm_key = Data_file.load_signkey conn Fpath.(dir / "sm_key") in
+    let* keys =
+      let* l =
+        let open Config.Coin in
+        list_map
+          (fun coin ->
+            let section_name = coin.section_name in
+            let fname = Fpath.(dir / section_name) in
+            (* todo: could check that coin config match db values *)
+            Data_file.load_denom conn ~section_name fname)
+          all_coins
+      in
+      match (List.for_all Option.is_none l, List.for_all Option.is_some l) with
+      | _, true ->
+          let l = List.map Option.get l in
+          Ok (Some l)
+      | true, _ -> Ok None
+      | _, _ -> error_invalid_state
+    in
+    match (sm_key, keys) with
+    | None, None -> Ok None
+    | Some sm_key, Some keys -> Ok (Some { sm_key; keys })
+    | _, _ -> error_invalid_state
+
+  let generate_fresh_secmod_data () =
     let sm_key = Signkey.generate () in
     let keys = List.map Denomination.make Config.Coin.all_coins in
     { sm_key; keys }
+
+  let v =
+    let finally _key = () in
+    Vif.Device.v ~name:"secmod_denom" ~finally
+      [ Vif.Device.value db_connection ]
+    @@ fun conn (_env : env) ->
+    match load conn with
+    | Ok None ->
+        let t = generate_fresh_secmod_data () in
+        t
+    | Ok (Some v) -> v
+    | Error _ -> Fmt.failwith "secmod_denom init failure."
 end
 
 let secmod_signkey = Secmod_signkey.v

src/management.ml

@@ -4,6 +4,7 @@ open Devices
 let mk_future_denom denom_key_signf
     ({
        pub;
+       priv= _;
        section_name;
        value;
        stamp_start;
@@ -16,7 +17,6 @@ let mk_future_denom denom_key_signf
        fee_refund;
        age_mask;
        h_pub;
-       sign= _;
        master_sig= _;
      } :
       Denomination.t) =

src/pg.ml

@@ -128,6 +128,7 @@ let add_denomination_key =
     Denomination.
       {
         pub;
+        priv= _;
         section_name= _;
         value;
         stamp_start;
@@ -140,7 +141,6 @@ let add_denomination_key =
         fee_refund;
         age_mask;
         h_pub;
-        sign= _;
         master_sig;
       }
   ->