diff --git a/eddsa_sed.sh b/eddsa_sed.sh new file mode 100644 index 00000000..1ef8a9a6 --- /dev/null +++ b/eddsa_sed.sh @@ -0,0 +1,27 @@ +#!/bin/bash +set -e + +sed "s/EddsaPrivateKey\.t /Eddsa\.priv /g" -i src/* +sed "s/EddsaPrivateKey\.t;/Eddsa\.priv;/g" -i src/* +sed "s/EddsaPublicKey\.t /Eddsa\.pub /g" -i src/* +sed "s/EddsaPublicKey\.t;/Eddsa\.pub;/g" -i src/* +sed "s/EddsaSignature\.t /Eddsa\.sig_ /g" -i src/* +sed "s/EddsaSignature\.t;/Eddsa\.sig_;/g" -i src/* +sed "s/EddsaPublicKey\.t)/Eddsa\.pub)/g" -i src/* + +sed "s/EddsaPrivateKey\.of_octets /Eddsa\.priv_of_octets /g" -i src/* +sed "s/EddsaPrivateKey\.to_octets /Eddsa\.priv_to_octets /g" -i src/* +sed "s/EddsaPrivateKey\.pub_of_priv /Eddsa\.pub_of_priv /g" -i src/* +sed "s/EddsaPrivateKey\.generate /Eddsa\.generate /g" -i src/* +sed "s/EddsaPrivateKey\.bin /Eddsa\.priv_bin /g" -i src/* + +sed "s/EddsaPublicKey\.to_b32 /Eddsa\.pub_to_b32 /g" -i src/* +sed "s/EddsaPublicKey\.of_b32 /Eddsa\.pub_of_b32 /g" -i src/* +sed "s/EddsaSignature\.sign /Eddsa\.sign /g" -i src/* + +sed "s/EddsaPrivateKey\.jsont/Eddsa\.priv_jsont/g" -i src/* +sed "s/EddsaPublicKey\.jsont/Eddsa\.pub_jsont/g" -i src/* +sed "s/EddsaSignature\.jsont/Eddsa\.sig_jsont/g" -i src/* +sed "s/EddsaPrivateKey\.caqti/Eddsa\.priv_caqti/g" -i src/* +sed "s/EddsaPublicKey\.caqti/Eddsa\.pub_caqti/g" -i src/* +sed "s/EddsaSignature\.caqti/Eddsa\.sig_caqti/g" -i src/* diff --git a/src/api.ml b/src/api.ml index 2a6ea9cc..1cf8f3b5 100644 --- a/src/api.ml +++ b/src/api.ml @@ -7,8 +7,8 @@ - payto_uri - uri *) +module DenominationHash = Hash.DenominationHash open Time -open Crypto open Signatures let encode jsont v = Jsont_bytesrw.encode_string jsont v @@ -275,7 +275,7 @@ let config = module RsaDenominationKey = struct type t = { age_mask: int; - rsa_pub: RsaPublicKey.t; + rsa_pub: Rsa.pub; } let jsont = @@ -284,7 +284,7 @@ module RsaDenominationKey = struct let rsa_pub v = v.rsa_pub in Jsont.Object.map ~kind:"RsaDenominationKey" make |> Jsont.Object.mem "age_mask" Jsont.int ~enc:age_mask - |> Jsont.Object.mem "rsa_pub" RsaPublicKey.jsont ~enc:rsa_pub + |> Jsont.Object.mem "rsa_pub" Rsa.pub_jsont ~enc:rsa_pub |> Jsont.Object.finish end @@ -309,7 +309,7 @@ end module FutureSignKey = struct type t = { - key: EddsaPublicKey.t; + key: Eddsa.pub; stamp_start: Timestamp.t; stamp_expire: Timestamp.t; stamp_end: Timestamp.t; @@ -326,7 +326,7 @@ module FutureSignKey = struct let stamp_end v = v.stamp_end in let signkey_secmod_sig v = v.signkey_secmod_sig in map ~kind:"FutureSignKey" make - |> mem "key" EddsaPublicKey.jsont ~enc:key + |> mem "key" Eddsa.pub_jsont ~enc:key |> mem "stamp_start" Timestamp.jsont ~enc:stamp_start |> mem "stamp_expire" Timestamp.jsont ~enc:stamp_expire |> mem "stamp_end" Timestamp.jsont ~enc:stamp_end @@ -403,9 +403,9 @@ module FutureKeysResponse = struct type t = { future_denoms: FutureDenom.t list; future_signkeys: FutureSignKey.t list; - master_pub: EddsaPublicKey.t; - denom_secmod_public_key: EddsaPublicKey.t; - signkey_secmod_public_key: EddsaPublicKey.t; + master_pub: Eddsa.pub; + denom_secmod_public_key: Eddsa.pub; + signkey_secmod_public_key: Eddsa.pub; } let jsont = @@ -429,17 +429,17 @@ module FutureKeysResponse = struct |> mem "future_signkeys" (Jsont.list FutureSignKey.jsont) ~enc:future_signkeys - |> mem "master_pub" EddsaPublicKey.jsont ~enc:master_pub - |> mem "denom_secmod_public_key" EddsaPublicKey.jsont + |> mem "master_pub" Eddsa.pub_jsont ~enc:master_pub + |> mem "denom_secmod_public_key" Eddsa.pub_jsont ~enc:denom_secmod_public_key - |> mem "signkey_secmod_public_key" EddsaPublicKey.jsont + |> mem "signkey_secmod_public_key" Eddsa.pub_jsont ~enc:signkey_secmod_public_key |> finish end module SignKeySignature = struct type t = { - key: EddsaPublicKey.t; + key: Eddsa.pub; master_sig: ExchangeSigningKeyValidity.t; } @@ -448,7 +448,7 @@ module SignKeySignature = struct let key v = v.key in let master_sig v = v.master_sig in map ~kind:"SignKeySignature" make - |> mem "key" EddsaPublicKey.jsont ~enc:key + |> mem "key" Eddsa.pub_jsont ~enc:key |> mem "master_sig" ExchangeSigningKeyValidity.jsont ~enc:master_sig |> finish end @@ -511,7 +511,7 @@ module AuditorSetupMessage = struct type t = { auditor_url: string; auditor_name: string; - auditor_pub: EddsaPublicKey.t; + auditor_pub: Eddsa.pub; master_sig: MasterAddAuditor.t; validity_start: Timestamp.t; } @@ -528,7 +528,7 @@ module AuditorSetupMessage = struct map ~kind:"AuditorSetupMessage" make |> mem "auditor_url" Jsont.string ~enc:auditor_url |> mem "auditor_name" Jsont.string ~enc:auditor_name - |> mem "auditor_pub" EddsaPublicKey.jsont ~enc:auditor_pub + |> mem "auditor_pub" Eddsa.pub_jsont ~enc:auditor_pub |> mem "master_sig" MasterAddAuditor.jsont ~enc:master_sig |> mem "validity_start" Timestamp.jsont ~enc:validity_start |> finish @@ -724,7 +724,7 @@ end module AmlOfficerSetup = struct type t = { - officer_pub: EddsaPublicKey.t; + officer_pub: Eddsa.pub; master_sig: MasterAmlOfficerStatus.t; officer_name: string; is_active: bool; @@ -751,7 +751,7 @@ module AmlOfficerSetup = struct let master_sig v = v.master_sig in let change_date v = v.change_date in map ~kind:"AmlOfficerSetup" make - |> mem "officer_pub" EddsaPublicKey.jsont ~enc:officer_pub + |> mem "officer_pub" Eddsa.pub_jsont ~enc:officer_pub |> mem "officer_name" Jsont.string ~enc:officer_name |> mem "is_active" Jsont.bool ~enc:is_active |> mem "read_only" Jsont.bool ~enc:read_only @@ -763,7 +763,7 @@ end module ExchangePartnerSetupRequest = struct type t = { partner_base_url: string; - partner_pub: EddsaPublicKey.t; + partner_pub: Eddsa.pub; wad_frequency: TimeRelative.t; master_sig: PartnerConfiguration.t; start_date: Timestamp.t; @@ -793,7 +793,7 @@ module ExchangePartnerSetupRequest = struct let wad_fee v = v.wad_fee in map ~kind:"ExchangePartnerSetupRequest" make |> mem "partner_base_url" Jsont.string ~enc:partner_base_url - |> mem "partner_pub" EddsaPublicKey.jsont ~enc:partner_pub + |> mem "partner_pub" Eddsa.pub_jsont ~enc:partner_pub |> mem "wad_frequency" TimeRelative.jsont ~enc:wad_frequency |> mem "master_sig" PartnerConfiguration.jsont ~enc:master_sig |> mem "start_date" Timestamp.jsont ~enc:start_date @@ -807,7 +807,7 @@ end module ExchangePartnerListEntry = struct type t = { partner_base_url: string; - partner_master_pub: EddsaPublicKey.t; + partner_master_pub: Eddsa.pub; wad_fee: Amount.t; wad_frequency: TimeRelative.t; start_date: Timestamp.t; @@ -837,7 +837,7 @@ module ExchangePartnerListEntry = struct let master_sig v = v.master_sig in map ~kind:"ExchangePartnerListEntry" make |> mem "partner_base_url" Jsont.string ~enc:partner_base_url - |> mem "partner_master_pub" EddsaPublicKey.jsont ~enc:partner_master_pub + |> mem "partner_master_pub" Eddsa.pub_jsont ~enc:partner_master_pub |> mem "wad_fee" Amount.jsont ~enc:wad_fee |> mem "wad_frequency" TimeRelative.jsont ~enc:wad_frequency |> mem "start_date" Timestamp.jsont ~enc:start_date @@ -891,7 +891,7 @@ end module AuditorKeys = struct type t = { - auditor_pub: EddsaPublicKey.t; + auditor_pub: Eddsa.pub; auditor_url: string; auditor_name: string; denomination_keys: AuditorDenominationKey.t list; @@ -906,7 +906,7 @@ module AuditorKeys = struct let auditor_name v = v.auditor_name in let denomination_keys v = v.denomination_keys in map ~kind:"AuditorKeys" make - |> mem "auditor_pub" EddsaPublicKey.jsont ~enc:auditor_pub + |> mem "auditor_pub" Eddsa.pub_jsont ~enc:auditor_pub |> mem "auditor_url" Jsont.string ~enc:auditor_url |> mem "auditor_name" Jsont.string ~enc:auditor_name |> mem "denomination_keys" @@ -917,7 +917,7 @@ end module SignKey = struct type t = { - key: EddsaPublicKey.t; + key: Eddsa.pub; stamp_start: Timestamp.t; stamp_expire: Timestamp.t; stamp_end: Timestamp.t; @@ -943,7 +943,7 @@ module SignKey = struct let stamp_end v = v.stamp_end in let master_sig v = v.master_sig in map ~kind:"SignKey" make - |> mem "key" EddsaPublicKey.jsont ~enc:key + |> mem "key" Eddsa.pub_jsont ~enc:key |> mem "stamp_start" Timestamp.jsont ~enc:stamp_start |> mem "stamp_expire" Timestamp.jsont ~enc:stamp_expire |> mem "stamp_end" Timestamp.jsont ~enc:stamp_end @@ -965,7 +965,7 @@ end module RsaDenom = struct (* correspond to: ({ rsa_pub: RsaPublicKey;} & DenomCommon) *) type t = { - rsa_pub: RsaPublicKey.t; + rsa_pub: Rsa.pub; master_sig: DenominationKeyValidity.t; stamp_start: Timestamp.t; stamp_expire_withdraw: Timestamp.t; @@ -995,7 +995,7 @@ module RsaDenom = struct let stamp_expire_legal v = v.stamp_expire_legal in let lost v = v.lost in map ~kind:"RsaDenom" make - |> mem "rsa_pub" RsaPublicKey.jsont ~enc:rsa_pub + |> mem "rsa_pub" Rsa.pub_jsont ~enc:rsa_pub |> mem "master_sig" DenominationKeyValidity.jsont ~enc:master_sig |> mem "stamp_start" Timestamp.jsont ~enc:stamp_start |> mem "stamp_expire_withdraw" Timestamp.jsont ~enc:stamp_expire_withdraw @@ -1283,14 +1283,14 @@ module ExchangeKeysResponse = struct wads: ExchangePartnerListEntry.t list; kyc_enabled: bool; disable_direct_deposit: bool; - master_public_key: EddsaPublicKey.t; + master_public_key: Eddsa.pub; reserve_closing_delay: TimeRelative.t; wallet_balance_limit_without_kyc: Amount.t list option; hard_limits: AccountLimit.t list; zero_limits: ZeroLimitedOperation.t list; denominations: DenomGroup.t list; exchange_sig: ExchangeKeySet.t; - exchange_pub: EddsaPublicKey.t; + exchange_pub: Eddsa.pub; recoup: RecoupDenoms.t list; global_fees: GlobalFees.t list; list_issue_date: Timestamp.t; @@ -1300,7 +1300,7 @@ module ExchangeKeysResponse = struct (* Signature by the exchange master key of the SHA-256 hash of the normalized JSON-object of field extensions, if it was set. The signature has purpose TALER_SIGNATURE_MASTER_EXTENSIONS. *) - extensions_sig: EddsaSignature.t option; + extensions_sig: Eddsa.sig_ option; } let jsont = @@ -1403,7 +1403,7 @@ module ExchangeKeysResponse = struct |> mem "wads" (Jsont.list ExchangePartnerListEntry.jsont) ~enc:wads |> mem "kyc_enabled" Jsont.bool ~enc:kyc_enabled |> mem "disable_direct_deposit" Jsont.bool ~enc:disable_direct_deposit - |> mem "master_public_key" EddsaPublicKey.jsont ~enc:master_public_key + |> mem "master_public_key" Eddsa.pub_jsont ~enc:master_public_key |> mem "reserve_closing_delay" TimeRelative.jsont ~enc:reserve_closing_delay |> opt_mem "wallet_balance_limit_without_kyc" (Jsont.list Amount.jsont) ~enc:wallet_balance_limit_without_kyc @@ -1413,7 +1413,7 @@ module ExchangeKeysResponse = struct ~enc:zero_limits |> mem "denominations" (Jsont.list DenomGroup.jsont) ~enc:denominations |> mem "exchange_sig" ExchangeKeySet.jsont ~enc:exchange_sig - |> mem "exchange_pub" EddsaPublicKey.jsont ~enc:exchange_pub + |> mem "exchange_pub" Eddsa.pub_jsont ~enc:exchange_pub |> mem "recoup" (Jsont.list RecoupDenoms.jsont) ~enc:recoup |> mem "global_fees" (Jsont.list GlobalFees.jsont) ~enc:global_fees |> mem "list_issue_date" Timestamp.jsont ~enc:list_issue_date @@ -1422,6 +1422,6 @@ module ExchangeKeysResponse = struct |> opt_mem "extensions" (Jsont.Object.as_string_map ExtensionManifest.jsont) ~enc:extensions - |> opt_mem "extensions_sig" EddsaSignature.jsont ~enc:extensions_sig + |> opt_mem "extensions_sig" Eddsa.sig_jsont ~enc:extensions_sig |> finish end diff --git a/src/crypto.ml b/src/crypto.ml deleted file mode 100644 index 54b1b516..00000000 --- a/src/crypto.ml +++ /dev/null @@ -1,350 +0,0 @@ -(* TODO refacto crypto+hash+fdh_rsa *) -open Syntax - -module Binary_format_rsa = struct - (* RSA public key binary format - https://www.gnupg.org/documentation/manuals/gcrypt/MPI-formats.html - := { uint16_be: n size; uint16_be: e size; n; e} - - integer in big-endian format (MSB first) - leading zeroes are stripped unless they are required to keep a value positive - no 0-termination *) - - let z_array_to_octets (arr : Z.t array) = - let nb = Array.length arr in - let bits_arr = Array.map Mirage_crypto_pk.Z_extra.to_octets_be arr in - let len_arr = Array.map String.length bits_arr in - let len = (2 * nb) + Array.fold_left ( + ) 0 len_arr in - let b = Bytes.make len '\x00' in - let pos = ref 0 in - Array.iter - (fun len -> - Bytes.set_uint16_be b !pos len; - pos := !pos + 2) - len_arr; - Array.iteri - (fun i bits -> - let len = len_arr.(i) in - Bytes.blit_string bits 0 b !pos len; - pos := !pos + len) - bits_arr; - Bytes.unsafe_to_string b - - let z_array_of_octets ~nb s = - let s_len = String.length s in - if s_len <= 2 * nb then Error "rsa of_octets error" - else - let pos = ref 0 in - let len_arr = - Array.init nb (fun _i -> - let len = String.get_uint16_be s !pos in - pos := !pos + 2; - len) - in - let len = (2 * nb) + Array.fold_left ( + ) 0 len_arr in - if s_len <> len then Error "rsa of_octets error" - else - let z_arr = - Array.init nb (fun i -> - let len = len_arr.(i) in - let s = String.sub s !pos len in - let z = Mirage_crypto_pk.Z_extra.of_octets_be s in - pos := !pos + len; - z) - in - Ok z_arr - - let pub_to_octets ({ n; e } : Mirage_crypto_pk.Rsa.pub) = - z_array_to_octets [| n; e |] - - let pub_of_octets s = - let* arr = z_array_of_octets ~nb:2 s in - match arr with - | [| n; e |] -> - let+ pub = Mirage_crypto_pk.Rsa.pub ~n ~e |> unwrap_msg in - pub - | _ -> assert false - - (* custom private key binary format <> than gcrypt *) - let priv_to_octets ({ e; d; n; p; q; dp; dq; q' } : Mirage_crypto_pk.Rsa.priv) - = - z_array_to_octets [| e; d; n; p; q; dp; dq; q' |] - - let priv_of_octets s = - let* arr = z_array_of_octets ~nb:8 s in - match arr with - | [| e; d; n; p; q; dp; dq; q' |] -> - let+ priv = - Mirage_crypto_pk.Rsa.priv ~e ~d ~n ~p ~q ~dp ~dq ~q' |> unwrap_msg - in - priv - | _ -> assert false -end - -module EddsaPublicKey = struct - open Mirage_crypto_ec.Ed25519 - - type t = pub - - let to_octets t = pub_to_octets t - - let of_octets t = - pub_of_octets t |> function - | Error e -> Fmt.error "%a" Mirage_crypto_ec.pp_error e - | 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 of_b32 s = - let* octets = B32.decode s in - let* pub = of_octets octets in - Ok pub - - let to_b32 t = B32.encode (to_octets t) - let jsont = Jsont.of_of_string ~kind:"EddsaPublicKey" of_b32 ~enc:to_b32 - - let caqti = - Caqti_type.custom - ~encode:(fun v -> Ok (to_octets v)) - ~decode:(fun v -> of_octets v) - Caqti_type.octets -end - -module EddsaPrivateKey = struct - (* EdDSA and ECDHE public keys always point on Curve25519 - and represented using the standard 256 bits Ed25519 compact format, - converted to Crockford Base32. *) - open Mirage_crypto_ec.Ed25519 - - type t = priv - - let generate = generate - let pub_of_priv = pub_of_priv - let to_octets t = priv_to_octets t - - 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* octets = B32.decode s in - 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 -end - -module EddsaSignature : sig - type t - - val sign : key:EddsaPrivateKey.t -> string -> t - - (* Ok () on verification success *) - val verify : key:EddsaPublicKey.t -> t -> msg:string -> (unit, string) result - val to_octets : t -> string - val of_octets : string -> (t, string) result - val jsont : t Jsont.t - val bin : t Bin.t - val caqti : t Caqti_type.t -end = struct - (* transmitted as 64-bytes base32 - binary-encoded objects with just the R and S values *) - type t = string - - (* mirage_crypto: - "The result is the concatenation of r and s, as specified in RFC 8032." *) - let sign ~key s = Mirage_crypto_ec.Ed25519.sign ~key s - - let verify ~key s ~msg = - let b = Mirage_crypto_ec.Ed25519.verify ~key s ~msg in - match b with - | false -> Error "EddsaSignature verification: invalid signature" - | true -> Ok () - - let to_octets t = t - - let check_size t = - match String.length t = 64 with - | false -> Error "EddsaSignature of_octets: data is not 64 bytes." - | true -> Ok () - - let of_octets v = - let+ () = check_size v in - v - - 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 jsont = - let of_b32 s = - let* t = B32.decode s in - of_octets t - in - let to_b32 = B32.encode in - Jsont.of_of_string ~kind:"EddsaSignature" of_b32 ~enc:to_b32 - - let caqti = - Caqti_type.custom - ~encode:(fun v -> Ok (to_octets v)) - ~decode:(fun s -> of_octets s) - Caqti_type.octets -end - -module RsaPublicKey = struct - open Mirage_crypto_pk - - type t = Rsa.pub - - let to_octets = Binary_format_rsa.pub_to_octets - let of_octets = Binary_format_rsa.pub_of_octets - let to_b32 t = B32.encode (to_octets t) - - let of_b32 s = - let* s = B32.decode s in - let+ v = of_octets s in - v - - let jsont = Jsont.of_of_string ~kind:"RsaPublicKey" of_b32 ~enc:to_b32 - - let caqti : t Caqti_type.t = - Caqti_type.custom - ~encode:(fun v -> Ok (to_octets v)) - ~decode:(fun v -> of_octets v) - Caqti_type.octets -end - -module RsaPrivateKey = struct - open Mirage_crypto_pk.Rsa - - type t = priv - - let generate ~bits () = - let priv = generate ~bits () in - let pub = pub_of_priv priv in - (priv, pub) - - let pub_of_priv = pub_of_priv - let of_octets = Binary_format_rsa.priv_of_octets - let to_octets = Binary_format_rsa.priv_to_octets - - (* we use Bin.cstring because size of key (~bits) can change depending on section_name - we also have to b32 encode/decode our octets because of null-char - - enforce all to be of the same size instead? *) - let bin = - let of_octets_exn s = - let res = - let* s = B32.decode s in - of_octets s - in - match res with - | Error e -> Fmt.failwith "RsaPrivateKey.bin decoding failure: %s." e - | Ok t -> t - in - let to_octets t = to_octets t |> B32.encode in - Bin.map Bin.cstring of_octets_exn to_octets - - let jsont = - let of_b32 s = - let* s = B32.decode s in - let+ v = of_octets s in - v - in - let to_b32 t = B32.encode (to_octets t) in - Jsont.of_of_string ~kind:"RsaPrivateKey" of_b32 ~enc:to_b32 -end - -module RsaSignature : sig - type t - - val sign : key:RsaPrivateKey.t -> string -> t - val jsont : t Jsont.t -end = struct - type t = string - - (* decrypt <=> sign *) - let sign ~key bmsg = - Mirage_crypto_pk.Rsa.decrypt ~crt_hardening:true ~key bmsg - - let jsont = - let of_b32 s = B32.decode s in - let to_b32 t = B32.encode t in - Jsont.of_of_string ~kind:"RsaSignature" of_b32 ~enc:to_b32 -end - -module DenominationHash : sig - type t - - val bin : t Bin.t - val caqti : t Caqti_type.t - val jsont : t Jsont.t - val hash_of_rsa : RsaPublicKey.t -> t - val of_octets : string -> t - val to_octets : t -> string - val of_b32 : B32.t -> (t, string) result - val to_b32 : t -> B32.t -end = struct - open Digestif - - type t = SHA512.t - - type cipher = - | RSA - | CS [@ocaml.warning "-37"] - - (* = GNUNET_CRYPTO_BSA_(RSA|CS) *) - let cipher_to_int32 = function RSA -> 1_l | CS -> 2_l - - let hash_of_rsa pub = - let age_mask = 0_l in - let cipher = cipher_to_int32 RSA in - let pub = RsaPublicKey.to_octets pub in - let len = String.length pub in - let buf = Bytes.create (4 + 4 + len) in - Bytes.set_int32_be buf 0 age_mask; - Bytes.set_int32_be buf 4 cipher; - Bytes.blit_string pub 0 buf 8 len; - SHA512.digest_bytes buf - - let of_octets s = - match SHA512.of_raw_string_opt s with - | None -> Fmt.failwith "H64.of_octets failure" - | Some t -> t - - let to_octets = SHA512.to_raw_string - let of_b32 s = Result.map of_octets (B32.decode s) - let to_b32 t = B32.encode (to_octets t) - - let bin = - let open Bin in - map (bytes 64) of_octets to_octets - - let caqti = - let open Caqti_type in - custom - ~encode:(fun v -> Ok (to_octets v)) - ~decode:(fun v -> Ok (of_octets v)) - octets - - let jsont = Jsont.of_of_string ~kind:"DenominationHash" of_b32 ~enc:to_b32 -end - -(* some type aliases, just for prettier .mli *) -type eddsa_priv = EddsaPrivateKey.t -type eddsa_pub = EddsaPublicKey.t -type eddsa_sig = EddsaSignature.t -type rsa_priv = RsaPrivateKey.t -type rsa_pub = RsaPublicKey.t -type rsa_sig = RsaSignature.t -type denom_hash = DenominationHash.t diff --git a/src/denomination.ml b/src/denomination.ml index 4594b6d4..3f013097 100644 --- a/src/denomination.ml +++ b/src/denomination.ml @@ -1,8 +1,8 @@ -open Crypto +module DenominationHash = Hash.DenominationHash open Time type t = { - pub: rsa_pub; + pub: Rsa.pub; value: Amount.t; stamp_start: Timestamp.t; stamp_expire_withdraw: Timestamp.t; @@ -13,7 +13,7 @@ type t = { fee_refresh: Amount.t; fee_refund: Amount.t; age_mask: int; - h_pub: denom_hash; + h_pub: DenominationHash.t; master_sig: Signatures.DenominationKeyValidity.t; } diff --git a/src/eddsa.ml b/src/eddsa.ml new file mode 100644 index 00000000..e97f22f6 --- /dev/null +++ b/src/eddsa.ml @@ -0,0 +1,96 @@ +open Syntax + +type priv = Mirage_crypto_ec.Ed25519.priv +type pub = Mirage_crypto_ec.Ed25519.pub + +(* transmitted as 64-bytes base32 + binary-encoded objects with just the R and S values *) +type sig_ = Sig of string + +let generate = Mirage_crypto_ec.Ed25519.generate +let pub_of_priv = Mirage_crypto_ec.Ed25519.pub_of_priv +let priv_to_octets t = Mirage_crypto_ec.Ed25519.priv_to_octets t + +let priv_of_octets t = + Mirage_crypto_ec.Ed25519.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 priv_bin = + let priv_of_octets_exn t = priv_of_octets t |> Result.get_ok in + Bin.map (Bin.bytes 32) priv_of_octets_exn priv_to_octets + +let priv_jsont = + let of_b32 s = + let* octets = B32.decode s in + priv_of_octets octets + in + let to_b32 t = B32.encode (priv_to_octets t) in + Jsont.of_of_string ~kind:"EddsaPrivateKey" of_b32 ~enc:to_b32 + +let pub_to_octets t = Mirage_crypto_ec.Ed25519.pub_to_octets t + +let pub_of_octets t = + Mirage_crypto_ec.Ed25519.pub_of_octets t |> function + | Error e -> Fmt.error "%a" Mirage_crypto_ec.pp_error e + | Ok v -> Ok v + +let pub_bin = + let pub_of_octets_exn t = pub_of_octets t |> Result.get_ok in + Bin.map (Bin.bytes 32) pub_of_octets_exn pub_to_octets + +let pub_of_b32 s = + let* octets = B32.decode s in + pub_of_octets octets + +let pub_to_b32 t = B32.encode (pub_to_octets t) + +let pub_jsont = + Jsont.of_of_string ~kind:"EddsaPublicKey" pub_of_b32 ~enc:pub_to_b32 + +let pub_caqti = + Caqti_type.custom + ~encode:(fun v -> Ok (pub_to_octets v)) + ~decode:(fun v -> pub_of_octets v) + Caqti_type.octets + +let sign ~key s = + let sig_ = Mirage_crypto_ec.Ed25519.sign ~key s in + Sig sig_ + +let verify ~key (Sig s) ~msg = + let b = Mirage_crypto_ec.Ed25519.verify ~key s ~msg in + match b with + | false -> Error "EddsaSignature verification: invalid signature" + | true -> Ok () + +let sig_to_octets (Sig s) = s + +let check_size s = + match String.length s = 64 with + | false -> Error "EddsaSignature of_octets: data is not 64 bytes." + | true -> Ok () + +let sig_of_octets s = + let+ () = check_size s in + Sig s + +let sig_bin = + let sig_of_octets_exn t = sig_of_octets t |> Result.get_ok in + Bin.map (Bin.bytes 64) sig_of_octets_exn sig_to_octets + +let sig_jsont = + let sig_of_b32 s = + let* s = B32.decode s in + sig_of_octets s + in + let sig_to_b32 (Sig s) = B32.encode s in + Jsont.of_of_string ~kind:"EddsaSignature" sig_of_b32 ~enc:sig_to_b32 + +let sig_caqti = + Caqti_type.custom + ~encode:(fun v -> Ok (sig_to_octets v)) + ~decode:(fun s -> sig_of_octets s) + Caqti_type.octets diff --git a/src/fdh_rsa.ml b/src/fdh_rsa.ml deleted file mode 100644 index f8e98634..00000000 --- a/src/fdh_rsa.ml +++ /dev/null @@ -1,81 +0,0 @@ -(* WIP fdh-rsa - full-domain-hash RSA - based on libgnunetutil crypto_rsa.c *) - -module Z_extra = Mirage_crypto_pk.Z_extra -open Crypto - -module Kdf = struct - module XTR = Hkdf.Make (Digestif.SHA512) - module PRF = Hkdf.Make (Digestif.SHA256) - - let kdf = - fun ~xts ~ikm ~ctx ~len -> - let prk = XTR.extract ~salt:xts ikm in - let okm = PRF.expand ~prk ~info:ctx len in - okm - - let kdf_mod_n ~n ~xts ~ikm ~ctx = - let nbits = Z.numbits n in - let len = ((nbits - 1) / 8) + 1 in - assert (8 * len = nbits); - let rec go ctr = - (* cat ctx ctr_be *) - let ctx = - let ctx_len = String.length ctx in - let b = Bytes.create (ctx_len + 2) in - Bytes.blit_string ctx 0 b 0 ctx_len; - Bytes.set_uint16_be b ctx_len ctr; - Bytes.unsafe_to_string b - in - let okm = kdf ~xts ~ikm ~ctx ~len in - assert (String.length okm = len); - let r = Z_extra.of_octets_be okm in - if Z.gt r n then go (succ ctr) else r - in - go 0 -end - -let gcd_validate r n = - match Z.equal (Z.gcd r n) Z.one with - | true -> () - | false -> Fmt.failwith "RSA key is malicious" - -let rsa_full_domain_hash pub msg = - let xts = RsaPublicKey.to_octets pub in - let ctx = "RSA-FDA FTpsW!" in - let r = Kdf.kdf_mod_n ~n:pub.n ~xts ~ikm:msg ~ctx in - gcd_validate r pub.n; r - -let rsa_blinding_key_derive (pub : RsaPublicKey.t) bks = - let xts = "Blinding KDF extractor HMAC key" in - let ctx = "Blinding KDF" in - let r = Kdf.kdf_mod_n ~n:pub.n ~xts ~ikm:bks ~ctx in - gcd_validate r pub.n; r - -let blind_msg pub ~bks msg = - let data = rsa_full_domain_hash pub msg in - let bkey = rsa_blinding_key_derive pub bks in - let r_e = Z.powm_sec bkey pub.e pub.n in - let data_r_e = Z.rem (Z.mul data r_e) pub.n in - Z_extra.to_octets_be data_r_e - -let unblind_sig pub ~bks bsig = - let data = Z_extra.of_octets_be bsig in - let bkey = rsa_blinding_key_derive pub bks in - let r_inv = - try Z.invert bkey pub.n - with Division_by_zero -> - (* => gcd(r,n) <> 1, should be already checked for *) - assert false - in - let data = Z.rem (Z.mul data r_inv) pub.n in - Z_extra.to_octets_be data - -let verify ~key s ~msg = - let msg_fdh = rsa_full_domain_hash key msg in - let s1 = Mirage_crypto_pk.Z_extra.to_octets_be msg_fdh in - let s2 = Mirage_crypto_pk.Rsa.encrypt ~key s in - match Eqaf.equal s1 s2 with - | false -> Fmt.error "RSA signature verification failed" - | true -> Ok () diff --git a/src/hash.ml b/src/hash.ml index 72a1d557..251c601c 100644 --- a/src/hash.ml +++ b/src/hash.ml @@ -85,6 +85,63 @@ module H64_cstring : S = struct let hash s = hash (s ^ "\x00") end +module DenominationHash : sig + type t + + val bin : t Bin.t + val caqti : t Caqti_type.t + val jsont : t Jsont.t + val hash_of_rsa : Rsa.pub -> t + val of_octets : string -> t + val to_octets : t -> string + val of_b32 : B32.t -> (t, string) result + val to_b32 : t -> B32.t +end = struct + open Digestif + + type t = SHA512.t + + type cipher = + | RSA + | CS [@ocaml.warning "-37"] + + (* = GNUNET_CRYPTO_BSA_(RSA|CS) *) + let cipher_to_int32 = function RSA -> 1_l | CS -> 2_l + + let hash_of_rsa pub = + let age_mask = 0_l in + let cipher = cipher_to_int32 RSA in + let pub = Rsa.pub_to_octets pub in + let len = String.length pub in + let buf = Bytes.create (4 + 4 + len) in + Bytes.set_int32_be buf 0 age_mask; + Bytes.set_int32_be buf 4 cipher; + Bytes.blit_string pub 0 buf 8 len; + SHA512.digest_bytes buf + + let of_octets s = + match SHA512.of_raw_string_opt s with + | None -> Fmt.failwith "H64.of_octets failure" + | Some t -> t + + let to_octets = SHA512.to_raw_string + let of_b32 s = Result.map of_octets (B32.decode s) + let to_b32 t = B32.encode (to_octets t) + + let bin = + let open Bin in + map (bytes 64) of_octets to_octets + + let caqti = + let open Caqti_type in + custom + ~encode:(fun v -> Ok (to_octets v)) + ~decode:(fun v -> Ok (of_octets v)) + octets + + let jsont = Jsont.of_of_string ~kind:"DenominationHash" of_b32 ~enc:to_b32 +end + (* TODO check which hash algorithm to use for each hash type *) module FullPaytoHash : S = H32 diff --git a/src/keys.ml b/src/keys.ml index 41c5e6f0..d6fe5397 100644 --- a/src/keys.ml +++ b/src/keys.ml @@ -1,14 +1,14 @@ open Syntax -open Crypto +module DenominationHash = Hash.DenominationHash open Time type 'a result = ('a, string) Result.t module type S = sig - val sign : eddsa_pub -> string -> eddsa_sig - val sign_denom : denom_hash -> string -> rsa_sig - val find_signkey : eddsa_pub -> Signkey.t option result - val find_denomination : denom_hash -> Denomination.t option result + val sign : Eddsa.pub -> string -> Eddsa.sig_ + val sign_denom : DenominationHash.t -> string -> Rsa.sig_ + val find_signkey : Eddsa.pub -> Signkey.t option result + val find_denomination : DenominationHash.t -> Denomination.t option result val signkeys : unit -> Signkey.t list result val denominations : unit -> Denomination.t list result val denominations_last_change : unit -> Timestamp.t @@ -21,10 +21,12 @@ module type S = sig val certify_future_denomination : Api.DenomSignature.t -> unit result val revoke_signkey : - eddsa_pub -> Signatures.MasterSigningKeyRevocation.t -> unit result + Eddsa.pub -> Signatures.MasterSigningKeyRevocation.t -> unit result val revoke_denomination : - denom_hash -> Signatures.MasterDenominationKeyRevocation.t -> unit result + DenominationHash.t -> + Signatures.MasterDenominationKeyRevocation.t -> + unit result end module Make (Conn : Pg.CONN) (Fs : Fat.FS) : S = struct @@ -94,7 +96,7 @@ module Make (Conn : Pg.CONN) (Fs : Fat.FS) : S = struct l let make_future_sk (pub, (start, expire)) = - Logs.debug (fun m -> m "make_future_sk: `%s`" (EddsaPublicKey.to_b32 pub)); + Logs.debug (fun m -> m "make_future_sk: `%s`" (Eddsa.pub_to_b32 pub)); let open Time in let stamp_start = Timestamp.of_absolute start in let stamp_expire = Timestamp.of_absolute expire in @@ -307,7 +309,7 @@ module Make (Conn : Pg.CONN) (Fs : Fat.FS) : S = struct let sk = sk_of_future_sk future_sk master_sig in let+ () = Pg.insert_signkey conn sk |> unwrap_caqti in Logs.info (fun m -> - m "certified signkey `%s`" (EddsaPublicKey.to_b32 sk.pub)); + m "certified signkey `%s`" (Eddsa.pub_to_b32 sk.pub)); ()) let certify_future_denomination @@ -336,7 +338,7 @@ module Make (Conn : Pg.CONN) (Fs : Fat.FS) : S = struct let+ () = Pg.insert_signkey_revocation conn pub revoked_sig |> unwrap_caqti in - Logs.info (fun m -> m "revoked signkey `%s`" (EddsaPublicKey.to_b32 pub)); + Logs.info (fun m -> m "revoked signkey `%s`" (Eddsa.pub_to_b32 pub)); () let revoke_denomination h_pub revoked_sig = diff --git a/src/mte_management.ml b/src/mte_management.ml index fcde4e67..6f913d01 100644 --- a/src/mte_management.ml +++ b/src/mte_management.ml @@ -59,7 +59,7 @@ module Denom_revoke = struct Logs.info (fun m -> m "POST /management/denominations/$H_DENOM_PUB/revoke/"); let keys = Vifu.Server.device Global.keys server in let res = - let* h_denom_pub = Crypto.DenominationHash.of_b32 h_denom_pub in + let* h_denom_pub = Hash.DenominationHash.of_b32 h_denom_pub in let* v = Vifu.Request.of_json req |> unwrap_msg in let* () = verify keys h_denom_pub v in let* () = do_ keys h_denom_pub v in @@ -85,7 +85,7 @@ module Signkey_revoke = struct Logs.info (fun m -> m "POST /management/signkeys/$EXCHANGE_PUB/revoke/"); let keys = Vifu.Server.device Global.keys server in let res = - let* exchange_pub = Crypto.EddsaPublicKey.of_b32 exchange_pub in + let* exchange_pub = Eddsa.pub_of_b32 exchange_pub in let* v = Vifu.Request.of_json req |> unwrap_msg in let* () = verify keys exchange_pub v in let* () = do_ keys exchange_pub v in @@ -171,8 +171,7 @@ module Auditors_disable = struct in let+ () = Pg.update_auditor db_conn auditor |> unwrap_caqti in Logs.info (fun m -> - m "revoked auditor `%s`" - (Crypto.EddsaPublicKey.to_b32 auditor_pub)); + m "revoked auditor `%s`" (Eddsa.pub_to_b32 auditor_pub)); ()) let jsont = AuditorTeardownMessage.jsont @@ -182,7 +181,7 @@ module Auditors_disable = struct let keys = Vifu.Server.device Global.keys server in let db_conn = Vifu.Server.device Global.db_conn server in let res = - let* auditor_pub = Crypto.EddsaPublicKey.of_b32 auditor_pub in + let* auditor_pub = Eddsa.pub_of_b32 auditor_pub in let* v = Vifu.Request.of_json req |> unwrap_msg in let* () = verify keys auditor_pub v in let* () = do_ ~db_conn auditor_pub v in diff --git a/src/pg.ml b/src/pg.ml index 39d968dc..09949928 100644 --- a/src/pg.ml +++ b/src/pg.ml @@ -10,7 +10,6 @@ module Caqti_type = struct include Caqti_request.Infix end -open Crypto open Api let preflight = @@ -39,7 +38,7 @@ let find_signkey = "SELECT exchange_pub, valid_from, expire_sign, expire_legal, master_sig \ FROM exchange_sign_keys WHERE exchange_pub=$1" in - fun (module Conn : CONN) (exchange_pub : EddsaPublicKey.t) -> + fun (module Conn : CONN) (exchange_pub : Eddsa.pub) -> Conn.find_opt req exchange_pub let get_signkeys = diff --git a/src/pg_type.ml b/src/pg_type.ml index e7288744..f092f010 100644 --- a/src/pg_type.ml +++ b/src/pg_type.ml @@ -1,6 +1,5 @@ (* this module defines caqti encoding/decodings *) open Caqti_type -open Crypto open Api let amount : Amount.t t = @@ -17,9 +16,9 @@ let ptime : unit t = Caqti_type.unit let time = Time.Timestamp.caqti let time_span = Time.TimeRelative.caqti let age_mask : int t = Caqti_type.int -let rsa_pub = RsaPublicKey.caqti -let eddsa_pub = EddsaPublicKey.caqti -let eddsa_sig = EddsaSignature.caqti +let rsa_pub = Rsa.pub_caqti +let eddsa_pub = Eddsa.pub_caqti +let eddsa_sig = Eddsa.sig_caqti (* todo: enum type for wire_method? *) let wire_method = Caqti_type.string @@ -353,7 +352,7 @@ let exchange_partner_setup = module Auditor = struct type t = { - auditor_pub: Crypto.EddsaPublicKey.t; + auditor_pub: Eddsa.pub; auditor_url: string; auditor_name: string; last_change: Time.Timestamp.t; diff --git a/src/rsa.ml b/src/rsa.ml new file mode 100644 index 00000000..0163f2c7 --- /dev/null +++ b/src/rsa.ml @@ -0,0 +1,223 @@ +open Syntax + +module Binary_format_rsa = struct + (* RSA public key binary format + https://www.gnupg.org/documentation/manuals/gcrypt/MPI-formats.html + := { uint16_be: n size; uint16_be: e size; n; e} + + integer in big-endian format (MSB first) + leading zeroes are stripped unless they are required to keep a value positive + no 0-termination *) + + let z_array_to_octets (arr : Z.t array) = + let nb = Array.length arr in + let bits_arr = Array.map Mirage_crypto_pk.Z_extra.to_octets_be arr in + let len_arr = Array.map String.length bits_arr in + let len = (2 * nb) + Array.fold_left ( + ) 0 len_arr in + let b = Bytes.make len '\x00' in + let pos = ref 0 in + Array.iter + (fun len -> + Bytes.set_uint16_be b !pos len; + pos := !pos + 2) + len_arr; + Array.iteri + (fun i bits -> + let len = len_arr.(i) in + Bytes.blit_string bits 0 b !pos len; + pos := !pos + len) + bits_arr; + Bytes.unsafe_to_string b + + let z_array_of_octets ~nb s = + let s_len = String.length s in + if s_len <= 2 * nb then Error "rsa of_octets error" + else + let pos = ref 0 in + let len_arr = + Array.init nb (fun _i -> + let len = String.get_uint16_be s !pos in + pos := !pos + 2; + len) + in + let len = (2 * nb) + Array.fold_left ( + ) 0 len_arr in + if s_len <> len then Error "rsa of_octets error" + else + let z_arr = + Array.init nb (fun i -> + let len = len_arr.(i) in + let s = String.sub s !pos len in + let z = Mirage_crypto_pk.Z_extra.of_octets_be s in + pos := !pos + len; + z) + in + Ok z_arr + + let pub_to_octets ({ n; e } : Mirage_crypto_pk.Rsa.pub) = + z_array_to_octets [| n; e |] + + let pub_of_octets s = + let* arr = z_array_of_octets ~nb:2 s in + match arr with + | [| n; e |] -> + let+ pub = Mirage_crypto_pk.Rsa.pub ~n ~e |> unwrap_msg in + pub + | _ -> assert false + + (* custom private key binary format <> than gcrypt *) + let priv_to_octets ({ e; d; n; p; q; dp; dq; q' } : Mirage_crypto_pk.Rsa.priv) + = + z_array_to_octets [| e; d; n; p; q; dp; dq; q' |] + + let priv_of_octets s = + let* arr = z_array_of_octets ~nb:8 s in + match arr with + | [| e; d; n; p; q; dp; dq; q' |] -> + let+ priv = + Mirage_crypto_pk.Rsa.priv ~e ~d ~n ~p ~q ~dp ~dq ~q' |> unwrap_msg + in + priv + | _ -> assert false +end + +type priv = Mirage_crypto_pk.Rsa.priv +type pub = Mirage_crypto_pk.Rsa.pub +type sig_ = Sig of string + +let generate ~bits () = + let priv = Mirage_crypto_pk.Rsa.generate ~bits () in + let pub = Mirage_crypto_pk.Rsa.pub_of_priv priv in + (priv, pub) + +let pub_of_priv = Mirage_crypto_pk.Rsa.pub_of_priv +let priv_of_octets = Binary_format_rsa.priv_of_octets +let priv_to_octets = Binary_format_rsa.priv_to_octets +let pub_to_octets = Binary_format_rsa.pub_to_octets +let pub_of_octets = Binary_format_rsa.pub_of_octets + +(* we use Bin.cstring because size of key (~bits) can change depending on section_name + we also have to b32 encode/decode our octets because of null-char + + enforce all to be of the same size instead? *) +let priv_bin = + let priv_of_octets_exn s = + let res = + let* s = B32.decode s in + priv_of_octets s + in + match res with + | Error e -> Fmt.failwith "RSA private key decoding failure: %s." e + | Ok t -> t + in + let priv_to_octets t = priv_to_octets t |> B32.encode in + Bin.map Bin.cstring priv_of_octets_exn priv_to_octets + +let pub_to_b32 t = B32.encode (pub_to_octets t) + +let pub_of_b32 s = + let* s = B32.decode s in + let+ v = pub_of_octets s in + v + +let pub_caqti = + Caqti_type.custom + ~encode:(fun v -> Ok (pub_to_octets v)) + ~decode:(fun v -> pub_of_octets v) + Caqti_type.octets + +let priv_jsont = + let priv_of_b32 s = + let* s = B32.decode s in + priv_of_octets s + in + let priv_to_b32 t = B32.encode (priv_to_octets t) in + Jsont.of_of_string ~kind:"RsaPrivateKey" priv_of_b32 ~enc:priv_to_b32 + +let pub_jsont = + Jsont.of_of_string ~kind:"RsaPublicKey" pub_of_b32 ~enc:pub_to_b32 + +let sig_jsont = + Jsont.of_of_string ~kind:"RsaSignature" B32.decode ~enc:B32.encode + +(* WIP fdh-rsa + full-domain-hash RSA + based on libgnunetutil crypto_rsa.c *) +module Kdf = struct + module XTR = Hkdf.Make (Digestif.SHA512) + module PRF = Hkdf.Make (Digestif.SHA256) + + let kdf = + fun ~xts ~ikm ~ctx ~len -> + let prk = XTR.extract ~salt:xts ikm in + let okm = PRF.expand ~prk ~info:ctx len in + okm + + let kdf_mod_n ~n ~xts ~ikm ~ctx = + let nbits = Z.numbits n in + let len = ((nbits - 1) / 8) + 1 in + assert (8 * len = nbits); + let rec go ctr = + (* cat ctx ctr_be *) + let ctx = + let ctx_len = String.length ctx in + let b = Bytes.create (ctx_len + 2) in + Bytes.blit_string ctx 0 b 0 ctx_len; + Bytes.set_uint16_be b ctx_len ctr; + Bytes.unsafe_to_string b + in + let okm = kdf ~xts ~ikm ~ctx ~len in + assert (String.length okm = len); + let r = Mirage_crypto_pk.Z_extra.of_octets_be okm in + if Z.gt r n then go (succ ctr) else r + in + go 0 +end + +let gcd_validate r n = + match Z.equal (Z.gcd r n) Z.one with + | true -> () + | false -> Fmt.failwith "RSA key is malicious" + +let rsa_full_domain_hash pub msg = + let xts = pub_to_octets pub in + let ctx = "RSA-FDA FTpsW!" in + let r = Kdf.kdf_mod_n ~n:pub.n ~xts ~ikm:msg ~ctx in + gcd_validate r pub.n; r + +let rsa_blinding_key_derive (pub : pub) bks = + let xts = "Blinding KDF extractor HMAC key" in + let ctx = "Blinding KDF" in + let r = Kdf.kdf_mod_n ~n:pub.n ~xts ~ikm:bks ~ctx in + gcd_validate r pub.n; r + +let blind_msg pub ~bks msg = + let data = rsa_full_domain_hash pub msg in + let bkey = rsa_blinding_key_derive pub bks in + let r_e = Z.powm_sec bkey pub.e pub.n in + let data_r_e = Z.rem (Z.mul data r_e) pub.n in + Mirage_crypto_pk.Z_extra.to_octets_be data_r_e + +let unblind_sig pub ~bks bsig = + let data = Mirage_crypto_pk.Z_extra.of_octets_be bsig in + let bkey = rsa_blinding_key_derive pub bks in + let r_inv = + try Z.invert bkey pub.n + with Division_by_zero -> + (* => gcd(r,n) <> 1, should be already checked for *) + assert false + in + let data = Z.rem (Z.mul data r_inv) pub.n in + Mirage_crypto_pk.Z_extra.to_octets_be data + +let verify ~key (Sig s) ~msg = + let msg_fdh = rsa_full_domain_hash key msg in + let s1 = Mirage_crypto_pk.Z_extra.to_octets_be msg_fdh in + let s2 = Mirage_crypto_pk.Rsa.encrypt ~key s in + match Eqaf.equal s1 s2 with + | false -> Fmt.error "RSA signature verification failed" + | true -> Ok () + +(* decrypt <=> sign *) +let sign ~key bmsg : sig_ = + let sig_ = Mirage_crypto_pk.Rsa.decrypt ~crt_hardening:true ~key bmsg in + Sig sig_ diff --git a/src/secmod_eddsa.ml b/src/secmod_eddsa.ml index 4a6576e0..15e9868d 100644 --- a/src/secmod_eddsa.ml +++ b/src/secmod_eddsa.ml @@ -17,7 +17,6 @@ module Log = (val Logs.src_log src : Logs.LOG) (* - *) open Syntax -open Crypto open Time module Sfn = Mfat.Sfn module Spath = Mfat.Spath @@ -31,45 +30,45 @@ module Cfg = struct end type key = { - priv: EddsaPrivateKey.t; - pub: EddsaPublicKey.t; + priv: Eddsa.priv; + pub: Eddsa.pub; t1: TimeAbsolute.t; t2: TimeAbsolute.t; } type t = { fs: Fat.t; - sm_priv: EddsaPrivateKey.t; - sm_pub: EddsaPublicKey.t; - ht: (EddsaPublicKey.t, key) Hashtbl.t; + sm_priv: Eddsa.priv; + sm_pub: Eddsa.pub; + ht: (Eddsa.pub, key) Hashtbl.t; } (* todo: this should be encoded in little-endian *) let key_bin = let open Bin in record (fun t1 t2 priv -> - let pub = EddsaPrivateKey.pub_of_priv priv in + let pub = Eddsa.pub_of_priv priv in { t1; t2; priv; pub }) |+ field TimeAbsolute.bin (fun t -> t.t1) |+ field TimeAbsolute.bin (fun t -> t.t2) - |+ field EddsaPrivateKey.bin (fun t -> t.priv) + |+ field Eddsa.priv_bin (fun t -> t.priv) |> sealr (* for sm_key only *) let read_eddsa fs spath = Log.debug (fun m -> m "reading key file `%a`" Spath.pp spath); let* data = Fat.read fs spath |> unwrap_msg in - let* priv = EddsaPrivateKey.of_octets data in - let pub = EddsaPrivateKey.pub_of_priv priv in + let* priv = Eddsa.priv_of_octets data in + let pub = Eddsa.pub_of_priv priv in Ok (priv, pub) let write_eddsa fs spath priv = Log.debug (fun m -> m "writing key file `%a`" Spath.pp spath); - let data = EddsaPrivateKey.to_octets priv in + let data = Eddsa.priv_to_octets priv in Fat.write fs spath data |> unwrap_msg let key_spath k = - let sfn_res = String.sub (EddsaPublicKey.to_b32 k.pub) 0 8 |> Sfn.of_string in + let sfn_res = String.sub (Eddsa.pub_to_b32 k.pub) 0 8 |> Sfn.of_string in match sfn_res with | Error _ -> failwith "not possible" | Ok sfn -> Spath.(Cfg.key_dir / sfn) @@ -93,9 +92,9 @@ let delete_file fs spath = () let gen_key t1 t2 = - let priv, pub = EddsaPrivateKey.generate () in + let priv, pub = Eddsa.generate () in let k = { priv; pub; t1; t2 } in - Log.debug (fun m -> m "generated key `%s`" (EddsaPublicKey.to_b32 pub)); + Log.debug (fun m -> m "generated key `%s`" (Eddsa.pub_to_b32 pub)); k let sort_keys l = List.sort (fun a b -> TimeAbsolute.compare a.t2 b.t2) l @@ -151,9 +150,9 @@ let init fs = match opt with | Some t -> Ok t | None -> - let sm_priv, sm_pub = EddsaPrivateKey.generate () in + let sm_priv, sm_pub = Eddsa.generate () in Log.debug (fun m -> - m "generated secmod key: `%s`" (EddsaPublicKey.to_b32 sm_pub)); + m "generated secmod key: `%s`" (Eddsa.pub_to_b32 sm_pub)); let ht = Hashtbl.create 0xff in let t = { fs; sm_priv; sm_pub; ht } in let* () = write_eddsa fs Cfg.sm_key t.sm_priv in @@ -196,11 +195,11 @@ module Make (Fs : Fat.FS) = struct (* ---- *) let sm_pub = t.sm_pub - let sign_secmod s = EddsaSignature.sign ~key:t.sm_priv s + let sign_secmod s = Eddsa.sign ~key:t.sm_priv s let sign pub s = let+ k = find pub in - let data = EddsaSignature.sign ~key:k.priv s in + let data = Eddsa.sign ~key:k.priv s in data (* delete and replace *) diff --git a/src/secmod_rsa.ml b/src/secmod_rsa.ml index 4c368dc8..2637af66 100644 --- a/src/secmod_rsa.ml +++ b/src/secmod_rsa.ml @@ -4,10 +4,10 @@ module Log = (val Logs.src_log src : Logs.LOG) (* - *) open Syntax -open Crypto open Time module Sfn = Mfat.Sfn module Spath = Mfat.Spath +module DenominationHash = Hash.DenominationHash module Coin_config = struct type t = { @@ -43,8 +43,8 @@ end type key = { section_name: string; - priv: RsaPrivateKey.t; - pub: RsaPublicKey.t; + priv: Rsa.priv; + pub: Rsa.pub; h_pub: DenominationHash.t; t1: TimeAbsolute.t; t2: TimeAbsolute.t; @@ -52,21 +52,21 @@ type key = { type t = { fs: Fat.t; - sm_priv: EddsaPrivateKey.t; - sm_pub: EddsaPublicKey.t; + sm_priv: Eddsa.priv; + sm_pub: Eddsa.pub; ht: (DenominationHash.t, key) Hashtbl.t; } let key_bin = let open Bin in record (fun t1 t2 section_name priv -> - let pub = RsaPrivateKey.pub_of_priv priv in + let pub = Rsa.pub_of_priv priv in let h_pub = DenominationHash.hash_of_rsa pub in { section_name; t1; t2; priv; pub; h_pub }) |+ field TimeAbsolute.bin (fun t -> t.t1) |+ field TimeAbsolute.bin (fun t -> t.t2) |+ field cstring (fun t -> t.section_name) - |+ field RsaPrivateKey.bin (fun t -> t.priv) + |+ field Rsa.priv_bin (fun t -> t.priv) |> sealr let key_spath k = @@ -80,13 +80,13 @@ let key_spath k = let read_eddsa fs spath = Log.debug (fun m -> m "reading key file `%a`" Spath.pp spath); let* data = Fat.read fs spath |> unwrap_msg in - let* priv = EddsaPrivateKey.of_octets data in - let pub = EddsaPrivateKey.pub_of_priv priv in + let* priv = Eddsa.priv_of_octets data in + let pub = Eddsa.pub_of_priv priv in Ok (priv, pub) let write_eddsa fs spath priv = Log.debug (fun m -> m "writing key file `%a`" Spath.pp spath); - let data = EddsaPrivateKey.to_octets priv in + let data = Eddsa.priv_to_octets priv in Fat.write fs spath data |> unwrap_msg let read_key fs spath = @@ -109,7 +109,7 @@ let delete_file fs spath = (* -- *) let gen_key cfg t1 t2 = - let priv, pub = RsaPrivateKey.generate ~bits:cfg.Coin_config.rsa_keysize () in + let priv, pub = Rsa.generate ~bits:cfg.Coin_config.rsa_keysize () in let h_pub = DenominationHash.hash_of_rsa pub in let k = { section_name= cfg.name; priv; pub; h_pub; t1; t2 } in Log.debug (fun m -> @@ -170,9 +170,9 @@ let init fs = match opt with | Some t -> Ok t | None -> - let sm_priv, sm_pub = EddsaPrivateKey.generate () in + let sm_priv, sm_pub = Eddsa.generate () in Log.debug (fun m -> - m "generated secmod key: `%s`" (EddsaPublicKey.to_b32 sm_pub)); + m "generated secmod key: `%s`" (Eddsa.pub_to_b32 sm_pub)); let* () = write_eddsa fs Cfg.sm_key sm_priv in let ht = Hashtbl.create 0xff in Ok { fs; sm_priv; sm_pub; ht } @@ -217,11 +217,11 @@ module Make (Fs : Fat.FS) = struct () let sm_pub = t.sm_pub - let sign_secmod s = EddsaSignature.sign ~key:t.sm_priv s + let sign_secmod s = Eddsa.sign ~key:t.sm_priv s let sign h_pub msg = let+ k = find h_pub in - let data = RsaSignature.sign ~key:k.priv msg in + let data = Rsa.sign ~key:k.priv msg in data let revoke h_pub = diff --git a/src/signatures.ml b/src/signatures.ml index c7a3db0b..8f3b5b7e 100644 --- a/src/signatures.ml +++ b/src/signatures.ml @@ -2,10 +2,25 @@ open Time open Hash module Aliases = struct - module DenominationHash = Crypto.DenominationHash + module EddsaPrivateKey = struct + type t = Eddsa.priv + + let bin = Eddsa.priv_bin + end + + module EddsaPublicKey = struct + type t = Eddsa.pub + + let bin = Eddsa.pub_bin + end + + module EddsaSignature = struct + type t = Eddsa.sig_ + + let bin = Eddsa.sig_bin + end (* some of those are actuall ecdhe, or union of eddsa|ecdhe *) - open Crypto module PursePublicKey = EddsaPublicKey module AuditorPublicKeyP = EddsaPublicKey module ReservePublicKeyP = EddsaPublicKey @@ -140,8 +155,6 @@ module MK (R : sig val bin : r Bin.t end) : sig - open Crypto - (* record type of data to sign *) type r = R.r @@ -150,8 +163,8 @@ end) : sig (* todo - type for unknown/verified signatures? (nk/ok) *) - val verify : EddsaPublicKey.t -> t -> r -> (unit, string) result - val signf : (string -> EddsaSignature.t) -> r -> t + val verify : Eddsa.pub -> t -> r -> (unit, string) result + val signf : (string -> Eddsa.sig_) -> r -> t val jsont : t Jsont.t val caqti : t Caqti_type.t @@ -159,17 +172,15 @@ end) : sig (signature over contatentation of all of the master_sigs) *) val to_octets : t -> string end = struct - open Crypto - type r = R.r - type t = EddsaSignature.t + type t = Eddsa.sig_ let to_string = Bin.to_string R.bin - let verify key t r = EddsaSignature.verify ~key t ~msg:(to_string r) + let verify key t r = Eddsa.verify ~key t ~msg:(to_string r) let signf f r = f (to_string r) - let jsont = EddsaSignature.jsont - let caqti : EddsaSignature.t Caqti_type.t = EddsaSignature.caqti - let to_octets t = EddsaSignature.to_octets t + let jsont = Eddsa.sig_jsont + let caqti = Eddsa.sig_caqti + let to_octets t = Eddsa.sig_to_octets t end (* ---- *) diff --git a/src/signkey.ml b/src/signkey.ml index cb3f1299..0109efaf 100644 --- a/src/signkey.ml +++ b/src/signkey.ml @@ -1,8 +1,7 @@ -open Crypto open Time type t = { - pub: eddsa_pub; + pub: Eddsa.pub; stamp_start: Timestamp.t; stamp_expire: Timestamp.t; stamp_end: Timestamp.t;