wip fix mess

src/bin_sig.ml

@@ -102,14 +102,7 @@ end = struct
     | true -> Ok ()
 
   let jsont = EddsaSignature.jsont
-
+  let caqti : EddsaSignature.t Caqti_type.t = EddsaSignature.caqti
-  let caqti : EddsaSignature.t Caqti_type.t =
-    let open Caqti_type in
-    let open EddsaSignature in
-    custom
-      ~encode:(fun v -> Ok (to_octets v))
-      ~decode:(fun s -> Ok (of_octets s))
-      octets
 end
 
 module DenominationKeyAnnouncement = struct

src/crypto.ml

@@ -49,16 +49,23 @@ module EddsaPrivateKey = struct
 
   let pub_of_priv = pub_of_priv
   let to_octets t = priv_to_octets t
-  let of_octets t = priv_of_octets t |> Result.get_ok
+
-  let bin = Bin.map (Bin.bytes 32) of_octets to_octets
+  let of_octets t =
+    priv_of_octets t |> function
+    | Error err ->
+        let err = Fmt.str "%a" Mirage_crypto_ec.pp_error err in
+        Error err
+    | Ok v -> Ok v
+
+  let bin =
+    let of_octets_exn t = of_octets t |> Result.get_ok in
+    Bin.map (Bin.bytes 32) of_octets_exn to_octets
 
   let jsont =
     let of_b32 s =
       let open Syntax in
       let* octets = B32.decode s in
-      match priv_of_octets octets with
+      of_octets octets
-      | Error e -> Fmt.error "%a" Mirage_crypto_ec.pp_error e
-      | Ok priv -> Ok priv
     in
     let to_b32 t = B32.encode (to_octets t) in
     Jsont.of_of_string ~kind:"EddsaPrivateKey" of_b32 ~enc:to_b32
@@ -70,7 +77,7 @@ module EddsaSignature : sig
   val sign : key:EddsaPrivateKey.t -> string -> t
   val verify : key:EddsaPublicKey.t -> t -> msg:string -> bool
   val to_octets : t -> string
-  val of_octets : string -> t
+  val of_octets : string -> (t, string) result
   val jsont : t Jsont.t
   val bin : t Bin.t
   val caqti : t Caqti_type.t
@@ -89,10 +96,12 @@ end = struct
   let of_octets v =
     match String.length v = 64 with
     | false ->
-        Fmt.failwith "EddsaSignature.of_octets failure: data is not 64 bytes."
+        Fmt.error "EddsaSignature.of_octets failure: data is not 64 bytes."
-    | true -> v
+    | true -> Ok v
 
-  let bin = Bin.map (Bin.bytes 64) of_octets to_octets
+  let bin =
+    let of_octets_exn t = of_octets t |> Result.get_ok in
+    Bin.map (Bin.bytes 64) of_octets_exn to_octets
 
   let check_size t =
     match String.length t = 64 with
@@ -112,7 +121,7 @@ end = struct
   let caqti =
     Caqti_type.custom
       ~encode:(fun v -> Ok (to_octets v))
-      ~decode:(fun s -> Ok (of_octets s))
+      ~decode:(fun s -> of_octets s)
       Caqti_type.octets
 end
 

src/data_file.ml

@@ -13,79 +13,46 @@ let read fname =
 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 read_eddsa fname =
   let* opt = read fname in
   match opt with
   | None -> Ok None
   | Some data -> (
-      let priv = EddsaPrivateKey.of_octets data in
+      EddsaPrivateKey.of_octets data |> function
-      let pub = EddsaPrivateKey.pub_of_priv priv in
+      | Error err -> Error (`Msg err)
-      let* opt = Pg.lookup_signing_key conn pub in
+      | Ok v -> Ok (Some v))
-      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 read_rsa fname =
   let* opt = read fname in
   match opt with
   | None -> Ok None
   | Some data -> (
-      let* priv =
+      RsaPrivateKey.of_octets data |> function
-        RsaPrivateKey.of_octets data |> function
+      | Error e -> Error (`Msg e)
-        | Error e -> Error (`Msg e)
+      | Ok v -> Ok (Some v))
-        | Ok v -> Ok v
+
+(* todo: move this *)
+let db_lookup_signkey_data conn fname priv =
+  let pub = Crypto.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
-      let pub = RsaPrivateKey.pub_of_priv priv in
+      Ok v
-      let h_pub = Bin_type.DenominationHash.hash (RsaPublicKey.to_octets pub) in
+
-      let* opt = Pg.lookup_denomination_key conn h_pub in
+let load_signkey conn fname =
-      match opt with
+  let* opt = read_eddsa fname in
-      | None ->
+  match opt with
-          Fmt.error_msg
+  | None -> Ok None
-            "load_denom error no associated metadata found in database for \
+  | Some priv ->
-             denom `%s`."
+      let* signkey_data = db_lookup_signkey_data conn fname priv in
-            (Fpath.to_string fname)
+      Ok (Some signkey_data)
-      | 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/secmod_denom.ml

@@ -1,3 +1,6 @@
+(* TODO
+   have something better to represent initialization state
+   (missing master_sig for fresh denom) *)
 open Syntax
 
 type h_denom_pub = Bin_type.DenominationHash.t
@@ -53,6 +56,52 @@ let _store_secmod_data t =
       (fname, key.Denomination.priv))
   |> list_iter (fun (fname, key) -> Data_file.write_rsa fname key)
 
+let db_lookup_denom_data conn ~section_name priv =
+  let pub = Crypto.RsaPrivateKey.pub_of_priv priv in
+  let h_pub =
+    Bin_type.DenominationHash.hash (Crypto.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 \
+         denomination `%s`."
+        section_name
+  | Some
+      ( stamp_start,
+        stamp_expire_withdraw,
+        stamp_expire_deposit,
+        stamp_expire_legal,
+        value,
+        fee_withdraw,
+        fee_deposit,
+        fee_refresh,
+        fee_refund,
+        age_mask ) ->
+      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 v
+
 let load conn =
   let error_invalid_state =
     Fmt.error_msg "secmod_denom load error: invalid store state."
@@ -61,12 +110,17 @@ let load conn =
   let* denoms =
     let* l =
       let open Config.Coin in
-      Syntax.list_map
+      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 *)
+          let* opt = Data_file.read_rsa fname in
-          Data_file.load_denom conn ~section_name fname)
+          match opt with
+          | None -> Ok None
+          | Some priv ->
+              (* todo: could check that coin config match db values *)
+              let* denom_data = db_lookup_denom_data conn ~section_name priv in
+              Ok (Some denom_data))
         all_coins
     in
     match Syntax.opt_list l with

src/secmod_signkey.ml

@@ -61,12 +61,8 @@ let load conn =
   let* sm_key = Data_file.load_signkey conn Fpath.(dir / "sm_key") in
   let* signkeys =
     let l = List.init 1 (fun i -> Fpath.(dir / string_of_int i)) in
-    let* l =
+    let* l = list_map (fun fname -> Data_file.load_signkey conn fname) l in
-      Syntax.list_map (fun fname -> Data_file.load_signkey conn fname) l
+    match opt_list l with Error () -> error_invalid_state | Ok opt -> Ok opt
-    in
-    match Syntax.opt_list l with
-    | Error () -> error_invalid_state
-    | Ok opt -> Ok opt
   in
   match (sm_key, signkeys) with
   | None, None -> Ok None

tools/offline_impl.ml

@@ -42,7 +42,7 @@ let sign ~master_key ~input ~output =
   let open Crypto in
   let* input = read_file input in
   let* master_key = read_file master_key in
-  let master_key = EddsaPrivateKey.of_octets master_key in
+  let* master_key = EddsaPrivateKey.of_octets master_key in
   let master_pub = EddsaPrivateKey.pub_of_priv master_key in
   let* future_keys_response = Api.decode Api.FutureKeysResponse.jsont input in
   let* () =
@@ -58,7 +58,7 @@ let sign ~master_key ~input ~output =
 let revoke_denom ~output ~master_key ~h_denom =
   let open Crypto in
   let* key = read_file master_key in
-  let key = EddsaPrivateKey.of_octets key in
+  let* key = EddsaPrivateKey.of_octets key in
   let* h_denom = B32.decode h_denom in
   let h_denom = Bin_type.DenominationHash.of_octets h_denom in
   let denom_revoke = Offline_sig.mk_denom_revoke ~key h_denom in
@@ -69,7 +69,7 @@ let revoke_denom ~output ~master_key ~h_denom =
 let revoke_signkey ~output ~master_key ~signkey =
   let open Crypto in
   let* key = read_file master_key in
-  let key = EddsaPrivateKey.of_octets key in
+  let* key = EddsaPrivateKey.of_octets key in
   let* signkey = EddsaPublicKey.of_b32 signkey in
   let v = Offline_sig.mk_signkey_revoke ~key signkey in
   let* s = Api.encode Api.SignkeyRevocationSignature.jsont v in