wip: secmod/keys initialization

src/devices.ml

@@ -1,22 +1,129 @@
-(* TODO KV store *)
-
 type env = {
   caqti_switch: Caqti_miou.Switch.t;
   db_uri: Uri.t;
 }
 
+let db_connection : (env, Caqti_miou.connection) Vif.Device.device =
+  let finally (module Conn : Caqti_miou.CONNECTION) = Conn.disconnect () in
+  Vif.Device.v ~name:"db_connection" ~finally []
+  @@ fun { caqti_switch; db_uri } ->
+  match Caqti_miou_unix.connect ~sw:caqti_switch db_uri with
+  | Error err ->
+      Fmt.failwith "Database connection failure: %a." Caqti_error.pp err
+  | Ok conn -> (
+      match Pg.preflight conn with
+      | Error err ->
+          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;
     keys: Signkey.t list;
   }
 
-  let v =
-    let finally _key = () in
-    Vif.Device.v ~name:"secmod_signkey" ~finally [] @@ fun (_env : env) ->
+  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 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
+    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;
+                     }))
+    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.")
+
+  let generate_fresh_keys () =
     let sm_key = Signkey.generate () in
     let keys = [ Signkey.generate () ] in
     { sm_key; keys }
+
+  let v =
+    let finally _key = () in
+    Vif.Device.v ~name:"secmod_signkey" ~finally
+      [ Vif.Device.value db_connection ]
+    @@ fun conn (_env : env) ->
+    match load_local_keys conn with
+    | Ok None ->
+        Fmt.pr "secmod_signkey: generate_fresh_keys@.";
+        let t = generate_fresh_keys () in
+        (*write_local_keys t |> Result.get_ok;*)
+        t
+    | Ok (Some v) ->
+        Fmt.pr "secmod_signkey: loaded local keys@.";
+        v
+    | Error _ ->
+        (* TODO pp error *)
+        Fmt.failwith "secmod_signkey init failure."
 end
 
 module Secmod_denom = struct
@@ -35,16 +142,3 @@ end
 
 let secmod_signkey = Secmod_signkey.v
 let secmod_denom = Secmod_denom.v
-
-let db_connection : (env, Caqti_miou.connection) Vif.Device.device =
-  let finally (module Conn : Caqti_miou.CONNECTION) = Conn.disconnect () in
-  Vif.Device.v ~name:"db_connection" ~finally []
-  @@ fun { caqti_switch; db_uri } ->
-  match Caqti_miou_unix.connect ~sw:caqti_switch db_uri with
-  | Error err ->
-      Fmt.failwith "Database connection failure: %a." Caqti_error.pp err
-  | Ok conn -> (
-      match Pg.preflight conn with
-      | Error err ->
-          Fmt.failwith "Database preflight failure: %a." Caqti_error.pp err
-      | Ok () -> conn)