swrup/mte
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

refacto crypto: add eddsa.ml + rsa.ml

Browse source
This commit is contained in:
swrup 2026-03-20 22:47:58 +01:00 • committed by Swrup
parent 4e707b080a
commit 87f06339c8
16 changed files with 517 additions and 537 deletions
Download patch file Download diff file Expand all files Collapse all files

27
eddsa_sed.sh Normal file
View file

@ -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/*

66
src/api.ml
View file

@ -7,8 +7,8 @@
- payto_uri - payto_uri
- uri *) - uri *)
module DenominationHash = Hash.DenominationHash
open Time open Time
open Crypto
open Signatures open Signatures
let encode jsont v = Jsont_bytesrw.encode_string jsont v let encode jsont v = Jsont_bytesrw.encode_string jsont v
@ -275,7 +275,7 @@ let config =
module RsaDenominationKey = struct module RsaDenominationKey = struct
type t = { type t = {
age_mask: int; age_mask: int;
rsa_pub: RsaPublicKey.t; rsa_pub: Rsa.pub;
} }
let jsont = let jsont =
@ -284,7 +284,7 @@ module RsaDenominationKey = struct
let rsa_pub v = v.rsa_pub in let rsa_pub v = v.rsa_pub in
Jsont.Object.map ~kind:"RsaDenominationKey" make Jsont.Object.map ~kind:"RsaDenominationKey" make
|> Jsont.Object.mem "age_mask" Jsont.int ~enc:age_mask |> 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 |> Jsont.Object.finish
end end
@ -309,7 +309,7 @@ end
module FutureSignKey = struct module FutureSignKey = struct
type t = { type t = {
key: EddsaPublicKey.t; key: Eddsa.pub;
stamp_start: Timestamp.t; stamp_start: Timestamp.t;
stamp_expire: Timestamp.t; stamp_expire: Timestamp.t;
stamp_end: Timestamp.t; stamp_end: Timestamp.t;
@ -326,7 +326,7 @@ module FutureSignKey = struct
let stamp_end v = v.stamp_end in let stamp_end v = v.stamp_end in
let signkey_secmod_sig v = v.signkey_secmod_sig in let signkey_secmod_sig v = v.signkey_secmod_sig in
map ~kind:"FutureSignKey" make 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_start" Timestamp.jsont ~enc:stamp_start
|> mem "stamp_expire" Timestamp.jsont ~enc:stamp_expire |> mem "stamp_expire" Timestamp.jsont ~enc:stamp_expire
|> mem "stamp_end" Timestamp.jsont ~enc:stamp_end |> mem "stamp_end" Timestamp.jsont ~enc:stamp_end
@ -403,9 +403,9 @@ module FutureKeysResponse = struct
type t = { type t = {
future_denoms: FutureDenom.t list; future_denoms: FutureDenom.t list;
future_signkeys: FutureSignKey.t list; future_signkeys: FutureSignKey.t list;
master_pub: EddsaPublicKey.t; master_pub: Eddsa.pub;
denom_secmod_public_key: EddsaPublicKey.t; denom_secmod_public_key: Eddsa.pub;
signkey_secmod_public_key: EddsaPublicKey.t; signkey_secmod_public_key: Eddsa.pub;
} }
let jsont = let jsont =
@ -429,17 +429,17 @@ module FutureKeysResponse = struct
|> mem "future_signkeys" |> mem "future_signkeys"
(Jsont.list FutureSignKey.jsont) (Jsont.list FutureSignKey.jsont)
~enc:future_signkeys ~enc:future_signkeys
|> mem "master_pub" EddsaPublicKey.jsont ~enc:master_pub |> mem "master_pub" Eddsa.pub_jsont ~enc:master_pub
|> mem "denom_secmod_public_key" EddsaPublicKey.jsont |> mem "denom_secmod_public_key" Eddsa.pub_jsont
~enc:denom_secmod_public_key ~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 ~enc:signkey_secmod_public_key
|> finish |> finish
end end
module SignKeySignature = struct module SignKeySignature = struct
type t = { type t = {
key: EddsaPublicKey.t; key: Eddsa.pub;
master_sig: ExchangeSigningKeyValidity.t; master_sig: ExchangeSigningKeyValidity.t;
} }
@ -448,7 +448,7 @@ module SignKeySignature = struct
let key v = v.key in let key v = v.key in
let master_sig v = v.master_sig in let master_sig v = v.master_sig in
map ~kind:"SignKeySignature" make 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 |> mem "master_sig" ExchangeSigningKeyValidity.jsont ~enc:master_sig
|> finish |> finish
end end
@ -511,7 +511,7 @@ module AuditorSetupMessage = struct
type t = { type t = {
auditor_url: string; auditor_url: string;
auditor_name: string; auditor_name: string;
auditor_pub: EddsaPublicKey.t; auditor_pub: Eddsa.pub;
master_sig: MasterAddAuditor.t; master_sig: MasterAddAuditor.t;
validity_start: Timestamp.t; validity_start: Timestamp.t;
} }
@ -528,7 +528,7 @@ module AuditorSetupMessage = struct
map ~kind:"AuditorSetupMessage" make map ~kind:"AuditorSetupMessage" make
|> mem "auditor_url" Jsont.string ~enc:auditor_url |> mem "auditor_url" Jsont.string ~enc:auditor_url
|> mem "auditor_name" Jsont.string ~enc:auditor_name |> 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 "master_sig" MasterAddAuditor.jsont ~enc:master_sig
|> mem "validity_start" Timestamp.jsont ~enc:validity_start |> mem "validity_start" Timestamp.jsont ~enc:validity_start
|> finish |> finish
@ -724,7 +724,7 @@ end
module AmlOfficerSetup = struct module AmlOfficerSetup = struct
type t = { type t = {
officer_pub: EddsaPublicKey.t; officer_pub: Eddsa.pub;
master_sig: MasterAmlOfficerStatus.t; master_sig: MasterAmlOfficerStatus.t;
officer_name: string; officer_name: string;
is_active: bool; is_active: bool;
@ -751,7 +751,7 @@ module AmlOfficerSetup = struct
let master_sig v = v.master_sig in let master_sig v = v.master_sig in
let change_date v = v.change_date in let change_date v = v.change_date in
map ~kind:"AmlOfficerSetup" make 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 "officer_name" Jsont.string ~enc:officer_name
|> mem "is_active" Jsont.bool ~enc:is_active |> mem "is_active" Jsont.bool ~enc:is_active
|> mem "read_only" Jsont.bool ~enc:read_only |> mem "read_only" Jsont.bool ~enc:read_only
@ -763,7 +763,7 @@ end
module ExchangePartnerSetupRequest = struct module ExchangePartnerSetupRequest = struct
type t = { type t = {
partner_base_url: string; partner_base_url: string;
partner_pub: EddsaPublicKey.t; partner_pub: Eddsa.pub;
wad_frequency: TimeRelative.t; wad_frequency: TimeRelative.t;
master_sig: PartnerConfiguration.t; master_sig: PartnerConfiguration.t;
start_date: Timestamp.t; start_date: Timestamp.t;
@ -793,7 +793,7 @@ module ExchangePartnerSetupRequest = struct
let wad_fee v = v.wad_fee in let wad_fee v = v.wad_fee in
map ~kind:"ExchangePartnerSetupRequest" make map ~kind:"ExchangePartnerSetupRequest" make
|> mem "partner_base_url" Jsont.string ~enc:partner_base_url |> 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 "wad_frequency" TimeRelative.jsont ~enc:wad_frequency
|> mem "master_sig" PartnerConfiguration.jsont ~enc:master_sig |> mem "master_sig" PartnerConfiguration.jsont ~enc:master_sig
|> mem "start_date" Timestamp.jsont ~enc:start_date |> mem "start_date" Timestamp.jsont ~enc:start_date
@ -807,7 +807,7 @@ end
module ExchangePartnerListEntry = struct module ExchangePartnerListEntry = struct
type t = { type t = {
partner_base_url: string; partner_base_url: string;
partner_master_pub: EddsaPublicKey.t; partner_master_pub: Eddsa.pub;
wad_fee: Amount.t; wad_fee: Amount.t;
wad_frequency: TimeRelative.t; wad_frequency: TimeRelative.t;
start_date: Timestamp.t; start_date: Timestamp.t;
@ -837,7 +837,7 @@ module ExchangePartnerListEntry = struct
let master_sig v = v.master_sig in let master_sig v = v.master_sig in
map ~kind:"ExchangePartnerListEntry" make map ~kind:"ExchangePartnerListEntry" make
|> mem "partner_base_url" Jsont.string ~enc:partner_base_url |> 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_fee" Amount.jsont ~enc:wad_fee
|> mem "wad_frequency" TimeRelative.jsont ~enc:wad_frequency |> mem "wad_frequency" TimeRelative.jsont ~enc:wad_frequency
|> mem "start_date" Timestamp.jsont ~enc:start_date |> mem "start_date" Timestamp.jsont ~enc:start_date
@ -891,7 +891,7 @@ end
module AuditorKeys = struct module AuditorKeys = struct
type t = { type t = {
auditor_pub: EddsaPublicKey.t; auditor_pub: Eddsa.pub;
auditor_url: string; auditor_url: string;
auditor_name: string; auditor_name: string;
denomination_keys: AuditorDenominationKey.t list; denomination_keys: AuditorDenominationKey.t list;
@ -906,7 +906,7 @@ module AuditorKeys = struct
let auditor_name v = v.auditor_name in let auditor_name v = v.auditor_name in
let denomination_keys v = v.denomination_keys in let denomination_keys v = v.denomination_keys in
map ~kind:"AuditorKeys" make 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_url" Jsont.string ~enc:auditor_url
|> mem "auditor_name" Jsont.string ~enc:auditor_name |> mem "auditor_name" Jsont.string ~enc:auditor_name
|> mem "denomination_keys" |> mem "denomination_keys"
@ -917,7 +917,7 @@ end
module SignKey = struct module SignKey = struct
type t = { type t = {
key: EddsaPublicKey.t; key: Eddsa.pub;
stamp_start: Timestamp.t; stamp_start: Timestamp.t;
stamp_expire: Timestamp.t; stamp_expire: Timestamp.t;
stamp_end: Timestamp.t; stamp_end: Timestamp.t;
@ -943,7 +943,7 @@ module SignKey = struct
let stamp_end v = v.stamp_end in let stamp_end v = v.stamp_end in
let master_sig v = v.master_sig in let master_sig v = v.master_sig in
map ~kind:"SignKey" make 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_start" Timestamp.jsont ~enc:stamp_start
|> mem "stamp_expire" Timestamp.jsont ~enc:stamp_expire |> mem "stamp_expire" Timestamp.jsont ~enc:stamp_expire
|> mem "stamp_end" Timestamp.jsont ~enc:stamp_end |> mem "stamp_end" Timestamp.jsont ~enc:stamp_end
@ -965,7 +965,7 @@ end
module RsaDenom = struct module RsaDenom = struct
(* correspond to: ({ rsa_pub: RsaPublicKey;} & DenomCommon) *) (* correspond to: ({ rsa_pub: RsaPublicKey;} & DenomCommon) *)
type t = { type t = {
rsa_pub: RsaPublicKey.t; rsa_pub: Rsa.pub;
master_sig: DenominationKeyValidity.t; master_sig: DenominationKeyValidity.t;
stamp_start: Timestamp.t; stamp_start: Timestamp.t;
stamp_expire_withdraw: 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 stamp_expire_legal v = v.stamp_expire_legal in
let lost v = v.lost in let lost v = v.lost in
map ~kind:"RsaDenom" make 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 "master_sig" DenominationKeyValidity.jsont ~enc:master_sig
|> mem "stamp_start" Timestamp.jsont ~enc:stamp_start |> mem "stamp_start" Timestamp.jsont ~enc:stamp_start
|> mem "stamp_expire_withdraw" Timestamp.jsont ~enc:stamp_expire_withdraw |> mem "stamp_expire_withdraw" Timestamp.jsont ~enc:stamp_expire_withdraw
@ -1283,14 +1283,14 @@ module ExchangeKeysResponse = struct
wads: ExchangePartnerListEntry.t list; wads: ExchangePartnerListEntry.t list;
kyc_enabled: bool; kyc_enabled: bool;
disable_direct_deposit: bool; disable_direct_deposit: bool;
master_public_key: EddsaPublicKey.t; master_public_key: Eddsa.pub;
reserve_closing_delay: TimeRelative.t; reserve_closing_delay: TimeRelative.t;
wallet_balance_limit_without_kyc: Amount.t list option; wallet_balance_limit_without_kyc: Amount.t list option;
hard_limits: AccountLimit.t list; hard_limits: AccountLimit.t list;
zero_limits: ZeroLimitedOperation.t list; zero_limits: ZeroLimitedOperation.t list;
denominations: DenomGroup.t list; denominations: DenomGroup.t list;
exchange_sig: ExchangeKeySet.t; exchange_sig: ExchangeKeySet.t;
exchange_pub: EddsaPublicKey.t; exchange_pub: Eddsa.pub;
recoup: RecoupDenoms.t list; recoup: RecoupDenoms.t list;
global_fees: GlobalFees.t list; global_fees: GlobalFees.t list;
list_issue_date: Timestamp.t; 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 (* Signature by the exchange master key of the SHA-256 hash of the
normalized JSON-object of field extensions, if it was set. normalized JSON-object of field extensions, if it was set.
The signature has purpose TALER_SIGNATURE_MASTER_EXTENSIONS. *) The signature has purpose TALER_SIGNATURE_MASTER_EXTENSIONS. *)
extensions_sig: EddsaSignature.t option; extensions_sig: Eddsa.sig_ option;
} }
let jsont = let jsont =
@ -1403,7 +1403,7 @@ module ExchangeKeysResponse = struct
|> mem "wads" (Jsont.list ExchangePartnerListEntry.jsont) ~enc:wads |> mem "wads" (Jsont.list ExchangePartnerListEntry.jsont) ~enc:wads
|> mem "kyc_enabled" Jsont.bool ~enc:kyc_enabled |> mem "kyc_enabled" Jsont.bool ~enc:kyc_enabled
|> mem "disable_direct_deposit" Jsont.bool ~enc:disable_direct_deposit |> 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 |> mem "reserve_closing_delay" TimeRelative.jsont ~enc:reserve_closing_delay
|> opt_mem "wallet_balance_limit_without_kyc" (Jsont.list Amount.jsont) |> opt_mem "wallet_balance_limit_without_kyc" (Jsont.list Amount.jsont)
~enc:wallet_balance_limit_without_kyc ~enc:wallet_balance_limit_without_kyc
@ -1413,7 +1413,7 @@ module ExchangeKeysResponse = struct
~enc:zero_limits ~enc:zero_limits
|> mem "denominations" (Jsont.list DenomGroup.jsont) ~enc:denominations |> mem "denominations" (Jsont.list DenomGroup.jsont) ~enc:denominations
|> mem "exchange_sig" ExchangeKeySet.jsont ~enc:exchange_sig |> 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 "recoup" (Jsont.list RecoupDenoms.jsont) ~enc:recoup
|> mem "global_fees" (Jsont.list GlobalFees.jsont) ~enc:global_fees |> mem "global_fees" (Jsont.list GlobalFees.jsont) ~enc:global_fees
|> mem "list_issue_date" Timestamp.jsont ~enc:list_issue_date |> mem "list_issue_date" Timestamp.jsont ~enc:list_issue_date
@ -1422,6 +1422,6 @@ module ExchangeKeysResponse = struct
|> opt_mem "extensions" |> opt_mem "extensions"
(Jsont.Object.as_string_map ExtensionManifest.jsont) (Jsont.Object.as_string_map ExtensionManifest.jsont)
~enc:extensions ~enc:extensions
|> opt_mem "extensions_sig" EddsaSignature.jsont ~enc:extensions_sig |> opt_mem "extensions_sig" Eddsa.sig_jsont ~enc:extensions_sig
|> finish |> finish
end end

350
src/crypto.ml
View file

@ -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

6
src/denomination.ml
View file

@ -1,8 +1,8 @@
open Crypto module DenominationHash = Hash.DenominationHash
open Time open Time
type t = { type t = {
pub: rsa_pub; pub: Rsa.pub;
value: Amount.t; value: Amount.t;
stamp_start: Timestamp.t; stamp_start: Timestamp.t;
stamp_expire_withdraw: Timestamp.t; stamp_expire_withdraw: Timestamp.t;
@ -13,7 +13,7 @@ type t = {
fee_refresh: Amount.t; fee_refresh: Amount.t;
fee_refund: Amount.t; fee_refund: Amount.t;
age_mask: int; age_mask: int;
h_pub: denom_hash; h_pub: DenominationHash.t;
master_sig: Signatures.DenominationKeyValidity.t; master_sig: Signatures.DenominationKeyValidity.t;
} }

96
src/eddsa.ml Normal file
View file

@ -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

81
src/fdh_rsa.ml
View file

@ -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 ()

57
src/hash.ml
View file

@ -85,6 +85,63 @@ module H64_cstring : S = struct
let hash s = hash (s ^ "\x00") let hash s = hash (s ^ "\x00")
end 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 (* TODO
check which hash algorithm to use for each hash type *) check which hash algorithm to use for each hash type *)
module FullPaytoHash : S = H32 module FullPaytoHash : S = H32

22
src/keys.ml
View file

@ -1,14 +1,14 @@
open Syntax open Syntax
open Crypto module DenominationHash = Hash.DenominationHash
open Time open Time
type 'a result = ('a, string) Result.t type 'a result = ('a, string) Result.t
module type S = sig module type S = sig
val sign : eddsa_pub -> string -> eddsa_sig val sign : Eddsa.pub -> string -> Eddsa.sig_
val sign_denom : denom_hash -> string -> rsa_sig val sign_denom : DenominationHash.t -> string -> Rsa.sig_
val find_signkey : eddsa_pub -> Signkey.t option result val find_signkey : Eddsa.pub -> Signkey.t option result
val find_denomination : denom_hash -> Denomination.t option result val find_denomination : DenominationHash.t -> Denomination.t option result
val signkeys : unit -> Signkey.t list result val signkeys : unit -> Signkey.t list result
val denominations : unit -> Denomination.t list result val denominations : unit -> Denomination.t list result
val denominations_last_change : unit -> Timestamp.t 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 certify_future_denomination : Api.DenomSignature.t -> unit result
val revoke_signkey : val revoke_signkey :
eddsa_pub -> Signatures.MasterSigningKeyRevocation.t -> unit result Eddsa.pub -> Signatures.MasterSigningKeyRevocation.t -> unit result
val revoke_denomination : val revoke_denomination :
denom_hash -> Signatures.MasterDenominationKeyRevocation.t -> unit result DenominationHash.t ->
Signatures.MasterDenominationKeyRevocation.t ->
unit result
end end
module Make (Conn : Pg.CONN) (Fs : Fat.FS) : S = struct 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 l
let make_future_sk (pub, (start, expire)) = 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 open Time in
let stamp_start = Timestamp.of_absolute start in let stamp_start = Timestamp.of_absolute start in
let stamp_expire = Timestamp.of_absolute expire 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 sk = sk_of_future_sk future_sk master_sig in
let+ () = Pg.insert_signkey conn sk |> unwrap_caqti in let+ () = Pg.insert_signkey conn sk |> unwrap_caqti in
Logs.info (fun m -> 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 let certify_future_denomination
@ -336,7 +338,7 @@ module Make (Conn : Pg.CONN) (Fs : Fat.FS) : S = struct
let+ () = let+ () =
Pg.insert_signkey_revocation conn pub revoked_sig |> unwrap_caqti Pg.insert_signkey_revocation conn pub revoked_sig |> unwrap_caqti
in 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 = let revoke_denomination h_pub revoked_sig =

9
src/mte_management.ml
View file

@ -59,7 +59,7 @@ module Denom_revoke = struct
Logs.info (fun m -> m "POST /management/denominations/$H_DENOM_PUB/revoke/"); Logs.info (fun m -> m "POST /management/denominations/$H_DENOM_PUB/revoke/");
let keys = Vifu.Server.device Global.keys server in let keys = Vifu.Server.device Global.keys server in
let res = 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* v = Vifu.Request.of_json req |> unwrap_msg in
let* () = verify keys h_denom_pub v in let* () = verify keys h_denom_pub v in
let* () = do_ 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/"); Logs.info (fun m -> m "POST /management/signkeys/$EXCHANGE_PUB/revoke/");
let keys = Vifu.Server.device Global.keys server in let keys = Vifu.Server.device Global.keys server in
let res = 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* v = Vifu.Request.of_json req |> unwrap_msg in
let* () = verify keys exchange_pub v in let* () = verify keys exchange_pub v in
let* () = do_ keys exchange_pub v in let* () = do_ keys exchange_pub v in
@ -171,8 +171,7 @@ module Auditors_disable = struct
in in
let+ () = Pg.update_auditor db_conn auditor |> unwrap_caqti in let+ () = Pg.update_auditor db_conn auditor |> unwrap_caqti in
Logs.info (fun m -> Logs.info (fun m ->
m "revoked auditor `%s`" m "revoked auditor `%s`" (Eddsa.pub_to_b32 auditor_pub));
(Crypto.EddsaPublicKey.to_b32 auditor_pub));
()) ())
let jsont = AuditorTeardownMessage.jsont let jsont = AuditorTeardownMessage.jsont
@ -182,7 +181,7 @@ module Auditors_disable = struct
let keys = Vifu.Server.device Global.keys server in let keys = Vifu.Server.device Global.keys server in
let db_conn = Vifu.Server.device Global.db_conn server in let db_conn = Vifu.Server.device Global.db_conn server in
let res = 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* v = Vifu.Request.of_json req |> unwrap_msg in
let* () = verify keys auditor_pub v in let* () = verify keys auditor_pub v in
let* () = do_ ~db_conn auditor_pub v in let* () = do_ ~db_conn auditor_pub v in

3
src/pg.ml
View file

@ -10,7 +10,6 @@ module Caqti_type = struct
include Caqti_request.Infix include Caqti_request.Infix
end end
open Crypto
open Api open Api
let preflight = let preflight =
@ -39,7 +38,7 @@ let find_signkey =
"SELECT exchange_pub, valid_from, expire_sign, expire_legal, master_sig \ "SELECT exchange_pub, valid_from, expire_sign, expire_legal, master_sig \
FROM exchange_sign_keys WHERE exchange_pub=$1" FROM exchange_sign_keys WHERE exchange_pub=$1"
in in
fun (module Conn : CONN) (exchange_pub : EddsaPublicKey.t) -> fun (module Conn : CONN) (exchange_pub : Eddsa.pub) ->
Conn.find_opt req exchange_pub Conn.find_opt req exchange_pub
let get_signkeys = let get_signkeys =

9
src/pg_type.ml
View file

@ -1,6 +1,5 @@
(* this module defines caqti encoding/decodings *) (* this module defines caqti encoding/decodings *)
open Caqti_type open Caqti_type
open Crypto
open Api open Api
let amount : Amount.t t = let amount : Amount.t t =
@ -17,9 +16,9 @@ let ptime : unit t = Caqti_type.unit
let time = Time.Timestamp.caqti let time = Time.Timestamp.caqti
let time_span = Time.TimeRelative.caqti let time_span = Time.TimeRelative.caqti
let age_mask : int t = Caqti_type.int let age_mask : int t = Caqti_type.int
let rsa_pub = RsaPublicKey.caqti let rsa_pub = Rsa.pub_caqti
let eddsa_pub = EddsaPublicKey.caqti let eddsa_pub = Eddsa.pub_caqti
let eddsa_sig = EddsaSignature.caqti let eddsa_sig = Eddsa.sig_caqti
(* todo: enum type for wire_method? *) (* todo: enum type for wire_method? *)
let wire_method = Caqti_type.string let wire_method = Caqti_type.string
@ -353,7 +352,7 @@ let exchange_partner_setup =
module Auditor = struct module Auditor = struct
type t = { type t = {
auditor_pub: Crypto.EddsaPublicKey.t; auditor_pub: Eddsa.pub;
auditor_url: string; auditor_url: string;
auditor_name: string; auditor_name: string;
last_change: Time.Timestamp.t; last_change: Time.Timestamp.t;

223
src/rsa.ml Normal file
View file

@ -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_

35
src/secmod_eddsa.ml
View file

@ -17,7 +17,6 @@ module Log = (val Logs.src_log src : Logs.LOG)
(* - *) (* - *)
open Syntax open Syntax
open Crypto
open Time open Time
module Sfn = Mfat.Sfn module Sfn = Mfat.Sfn
module Spath = Mfat.Spath module Spath = Mfat.Spath
@ -31,45 +30,45 @@ module Cfg = struct
end end
type key = { type key = {
priv: EddsaPrivateKey.t; priv: Eddsa.priv;
pub: EddsaPublicKey.t; pub: Eddsa.pub;
t1: TimeAbsolute.t; t1: TimeAbsolute.t;
t2: TimeAbsolute.t; t2: TimeAbsolute.t;
} }
type t = { type t = {
fs: Fat.t; fs: Fat.t;
sm_priv: EddsaPrivateKey.t; sm_priv: Eddsa.priv;
sm_pub: EddsaPublicKey.t; sm_pub: Eddsa.pub;
ht: (EddsaPublicKey.t, key) Hashtbl.t; ht: (Eddsa.pub, key) Hashtbl.t;
} }
(* todo: this should be encoded in little-endian *) (* todo: this should be encoded in little-endian *)
let key_bin = let key_bin =
let open Bin in let open Bin in
record (fun t1 t2 priv -> 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 }) { t1; t2; priv; pub })
|+ field TimeAbsolute.bin (fun t -> t.t1) |+ field TimeAbsolute.bin (fun t -> t.t1)
|+ field TimeAbsolute.bin (fun t -> t.t2) |+ field TimeAbsolute.bin (fun t -> t.t2)
|+ field EddsaPrivateKey.bin (fun t -> t.priv) |+ field Eddsa.priv_bin (fun t -> t.priv)
|> sealr |> sealr
(* for sm_key only *) (* for sm_key only *)
let read_eddsa fs spath = let read_eddsa fs spath =
Log.debug (fun m -> m "reading key file `%a`" Spath.pp spath); Log.debug (fun m -> m "reading key file `%a`" Spath.pp spath);
let* data = Fat.read fs spath |> unwrap_msg in let* data = Fat.read fs spath |> unwrap_msg in
let* priv = EddsaPrivateKey.of_octets data in let* priv = Eddsa.priv_of_octets data in
let pub = EddsaPrivateKey.pub_of_priv priv in let pub = Eddsa.pub_of_priv priv in
Ok (priv, pub) Ok (priv, pub)
let write_eddsa fs spath priv = let write_eddsa fs spath priv =
Log.debug (fun m -> m "writing key file `%a`" Spath.pp spath); 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 Fat.write fs spath data |> unwrap_msg
let key_spath k = 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 match sfn_res with
| Error _ -> failwith "not possible" | Error _ -> failwith "not possible"
| Ok sfn -> Spath.(Cfg.key_dir / sfn) | Ok sfn -> Spath.(Cfg.key_dir / sfn)
@ -93,9 +92,9 @@ let delete_file fs spath =
() ()
let gen_key t1 t2 = let gen_key t1 t2 =
let priv, pub = EddsaPrivateKey.generate () in let priv, pub = Eddsa.generate () in
let k = { priv; pub; t1; t2 } 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 k
let sort_keys l = List.sort (fun a b -> TimeAbsolute.compare a.t2 b.t2) l 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 match opt with
| Some t -> Ok t | Some t -> Ok t
| None -> | None ->
let sm_priv, sm_pub = EddsaPrivateKey.generate () in let sm_priv, sm_pub = Eddsa.generate () in
Log.debug (fun m -> 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 ht = Hashtbl.create 0xff in
let t = { fs; sm_priv; sm_pub; ht } in let t = { fs; sm_priv; sm_pub; ht } in
let* () = write_eddsa fs Cfg.sm_key t.sm_priv 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 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 sign pub s =
let+ k = find pub in let+ k = find pub in
let data = EddsaSignature.sign ~key:k.priv s in let data = Eddsa.sign ~key:k.priv s in
data data
(* delete and replace *) (* delete and replace *)

30
src/secmod_rsa.ml
View file

@ -4,10 +4,10 @@ module Log = (val Logs.src_log src : Logs.LOG)
(* - *) (* - *)
open Syntax open Syntax
open Crypto
open Time open Time
module Sfn = Mfat.Sfn module Sfn = Mfat.Sfn
module Spath = Mfat.Spath module Spath = Mfat.Spath
module DenominationHash = Hash.DenominationHash
module Coin_config = struct module Coin_config = struct
type t = { type t = {
@ -43,8 +43,8 @@ end
type key = { type key = {
section_name: string; section_name: string;
priv: RsaPrivateKey.t; priv: Rsa.priv;
pub: RsaPublicKey.t; pub: Rsa.pub;
h_pub: DenominationHash.t; h_pub: DenominationHash.t;
t1: TimeAbsolute.t; t1: TimeAbsolute.t;
t2: TimeAbsolute.t; t2: TimeAbsolute.t;
@ -52,21 +52,21 @@ type key = {
type t = { type t = {
fs: Fat.t; fs: Fat.t;
sm_priv: EddsaPrivateKey.t; sm_priv: Eddsa.priv;
sm_pub: EddsaPublicKey.t; sm_pub: Eddsa.pub;
ht: (DenominationHash.t, key) Hashtbl.t; ht: (DenominationHash.t, key) Hashtbl.t;
} }
let key_bin = let key_bin =
let open Bin in let open Bin in
record (fun t1 t2 section_name priv -> 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 let h_pub = DenominationHash.hash_of_rsa pub in
{ section_name; t1; t2; priv; pub; h_pub }) { section_name; t1; t2; priv; pub; h_pub })
|+ field TimeAbsolute.bin (fun t -> t.t1) |+ field TimeAbsolute.bin (fun t -> t.t1)
|+ field TimeAbsolute.bin (fun t -> t.t2) |+ field TimeAbsolute.bin (fun t -> t.t2)
|+ field cstring (fun t -> t.section_name) |+ field cstring (fun t -> t.section_name)
|+ field RsaPrivateKey.bin (fun t -> t.priv) |+ field Rsa.priv_bin (fun t -> t.priv)
|> sealr |> sealr
let key_spath k = let key_spath k =
@ -80,13 +80,13 @@ let key_spath k =
let read_eddsa fs spath = let read_eddsa fs spath =
Log.debug (fun m -> m "reading key file `%a`" Spath.pp spath); Log.debug (fun m -> m "reading key file `%a`" Spath.pp spath);
let* data = Fat.read fs spath |> unwrap_msg in let* data = Fat.read fs spath |> unwrap_msg in
let* priv = EddsaPrivateKey.of_octets data in let* priv = Eddsa.priv_of_octets data in
let pub = EddsaPrivateKey.pub_of_priv priv in let pub = Eddsa.pub_of_priv priv in
Ok (priv, pub) Ok (priv, pub)
let write_eddsa fs spath priv = let write_eddsa fs spath priv =
Log.debug (fun m -> m "writing key file `%a`" Spath.pp spath); 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 Fat.write fs spath data |> unwrap_msg
let read_key fs spath = let read_key fs spath =
@ -109,7 +109,7 @@ let delete_file fs spath =
(* -- *) (* -- *)
let gen_key cfg t1 t2 = 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 h_pub = DenominationHash.hash_of_rsa pub in
let k = { section_name= cfg.name; priv; pub; h_pub; t1; t2 } in let k = { section_name= cfg.name; priv; pub; h_pub; t1; t2 } in
Log.debug (fun m -> Log.debug (fun m ->
@ -170,9 +170,9 @@ let init fs =
match opt with match opt with
| Some t -> Ok t | Some t -> Ok t
| None -> | None ->
let sm_priv, sm_pub = EddsaPrivateKey.generate () in let sm_priv, sm_pub = Eddsa.generate () in
Log.debug (fun m -> 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* () = write_eddsa fs Cfg.sm_key sm_priv in
let ht = Hashtbl.create 0xff in let ht = Hashtbl.create 0xff in
Ok { fs; sm_priv; sm_pub; ht } Ok { fs; sm_priv; sm_pub; ht }
@ -217,11 +217,11 @@ module Make (Fs : Fat.FS) = struct
() ()
let sm_pub = t.sm_pub 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 sign h_pub msg =
let+ k = find h_pub in 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 data
let revoke h_pub = let revoke h_pub =

37
src/signatures.ml
View file

@ -2,10 +2,25 @@ open Time
open Hash open Hash
module Aliases = struct 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 *) (* some of those are actuall ecdhe, or union of eddsa|ecdhe *)
open Crypto
module PursePublicKey = EddsaPublicKey module PursePublicKey = EddsaPublicKey
module AuditorPublicKeyP = EddsaPublicKey module AuditorPublicKeyP = EddsaPublicKey
module ReservePublicKeyP = EddsaPublicKey module ReservePublicKeyP = EddsaPublicKey
@ -140,8 +155,6 @@ module MK (R : sig
val bin : r Bin.t val bin : r Bin.t
end) : sig end) : sig
open Crypto
(* record type of data to sign *) (* record type of data to sign *)
type r = R.r type r = R.r
@ -150,8 +163,8 @@ end) : sig
(* todo (* todo
- type for unknown/verified signatures? (nk/ok) *) - type for unknown/verified signatures? (nk/ok) *)
val verify : EddsaPublicKey.t -> t -> r -> (unit, string) result val verify : Eddsa.pub -> t -> r -> (unit, string) result
val signf : (string -> EddsaSignature.t) -> r -> t val signf : (string -> Eddsa.sig_) -> r -> t
val jsont : t Jsont.t val jsont : t Jsont.t
val caqti : t Caqti_type.t val caqti : t Caqti_type.t
@ -159,17 +172,15 @@ end) : sig
(signature over contatentation of all of the master_sigs) *) (signature over contatentation of all of the master_sigs) *)
val to_octets : t -> string val to_octets : t -> string
end = struct end = struct
open Crypto
type r = R.r type r = R.r
type t = EddsaSignature.t type t = Eddsa.sig_
let to_string = Bin.to_string R.bin 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 signf f r = f (to_string r)
let jsont = EddsaSignature.jsont let jsont = Eddsa.sig_jsont
let caqti : EddsaSignature.t Caqti_type.t = EddsaSignature.caqti let caqti = Eddsa.sig_caqti
let to_octets t = EddsaSignature.to_octets t let to_octets t = Eddsa.sig_to_octets t
end end
(* ---- *) (* ---- *)

3
src/signkey.ml
View file

@ -1,8 +1,7 @@
open Crypto
open Time open Time
type t = { type t = {
pub: eddsa_pub; pub: Eddsa.pub;
stamp_start: Timestamp.t; stamp_start: Timestamp.t;
stamp_expire: Timestamp.t; stamp_expire: Timestamp.t;
stamp_end: Timestamp.t; stamp_end: Timestamp.t;