diff --git a/src/bin_sig.ml b/src/bin_sig.ml index 0804017f..1c95cdcc 100644 --- a/src/bin_sig.ml +++ b/src/bin_sig.ml @@ -102,14 +102,7 @@ end = struct | true -> Ok () let jsont = EddsaSignature.jsont - - 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 + let caqti : EddsaSignature.t Caqti_type.t = EddsaSignature.caqti end module DenominationKeyAnnouncement = struct diff --git a/src/crypto.ml b/src/crypto.ml index b806d590..4dee255f 100644 --- a/src/crypto.ml +++ b/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 - | Error e -> Fmt.error "%a" Mirage_crypto_ec.pp_error e - | Ok priv -> Ok priv + of_octets octets 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." - | true -> v + Fmt.error "EddsaSignature.of_octets failure: data is not 64 bytes." + | 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 diff --git a/src/data_file.ml b/src/data_file.ml index eb2f0701..a95f5817 100644 --- a/src/data_file.ml +++ b/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 - 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)) + EddsaPrivateKey.of_octets data |> function + | Error err -> Error (`Msg err) + | Ok v -> 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 - | Error e -> Error (`Msg e) - | Ok v -> Ok v + RsaPrivateKey.of_octets data |> function + | Error e -> Error (`Msg e) + | Ok v -> Ok (Some 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 - 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)) + Ok v + +let load_signkey conn fname = + let* opt = read_eddsa fname in + match opt with + | None -> Ok None + | Some priv -> + let* signkey_data = db_lookup_signkey_data conn fname priv in + Ok (Some signkey_data) diff --git a/src/secmod_denom.ml b/src/secmod_denom.ml index b1bdcc4d..582d1ef7 100644 --- a/src/secmod_denom.ml +++ b/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 *) - Data_file.load_denom conn ~section_name fname) + let* opt = Data_file.read_rsa fname in + 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 diff --git a/src/secmod_signkey.ml b/src/secmod_signkey.ml index 823b0321..8ca280fc 100644 --- a/src/secmod_signkey.ml +++ b/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 = - Syntax.list_map (fun fname -> Data_file.load_signkey conn fname) l - in - match Syntax.opt_list l with - | Error () -> error_invalid_state - | Ok opt -> Ok opt + let* l = list_map (fun fname -> Data_file.load_signkey conn fname) l in + match opt_list l with Error () -> error_invalid_state | Ok opt -> Ok opt in match (sm_key, signkeys) with | None, None -> Ok None diff --git a/tools/offline_impl.ml b/tools/offline_impl.ml index 7e105f84..38ea35c3 100644 --- a/tools/offline_impl.ml +++ b/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