From 0b6f5e3db553612fc10ffe05b0647b9b2b99a29b Mon Sep 17 00:00:00 2001 From: swrup Date: Fri, 13 Feb 2026 09:34:03 +0100 Subject: [PATCH] wip FDH-RSA --- dune-project | 1 + mte.opam | 1 + src/assets.ml | 1 - src/crypto.ml | 107 ++++++++++++++++++++++++++++++++++++++++++++++--- src/dune | 1 + test/crypto.ml | 47 ++++++++++++++++++++++ 6 files changed, 152 insertions(+), 6 deletions(-) diff --git a/dune-project b/dune-project index 1aadd32c..d4fc79ff 100644 --- a/dune-project +++ b/dune-project @@ -35,6 +35,7 @@ bin angstrom mirage-crypto + kdf digestif duration jsont diff --git a/mte.opam b/mte.opam index 53820528..3d706521 100644 --- a/mte.opam +++ b/mte.opam @@ -22,6 +22,7 @@ depends: [ "bin" "angstrom" "mirage-crypto" + "kdf" "digestif" "duration" "jsont" diff --git a/src/assets.ml b/src/assets.ml index 1826b27e..9313ee49 100644 --- a/src/assets.ml +++ b/src/assets.ml @@ -1,5 +1,4 @@ (* https://docs.taler.net/design-documents/003-tos-rendering.html - https://docs.taler.net/design-documents/003-tos-rendering.html must support `text/plain` and `text/markdown` *) diff --git a/src/crypto.ml b/src/crypto.ml index 92d1dadb..6e2d12fa 100644 --- a/src/crypto.ml +++ b/src/crypto.ml @@ -64,6 +64,7 @@ module Binary_format_rsa = struct 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' |] @@ -259,15 +260,10 @@ end module RsaSignature : sig type t - val sign : key:Mirage_crypto_pk.Rsa.priv -> string -> t val jsont : t Jsont.t end = struct type t = string - (* TODO rsa sign *) - let sign ~key s = - Mirage_crypto_pk.Rsa.decrypt ~crt_hardening:true ~mask:`Yes ~key s - let jsont = let of_b32 s = B32.decode s in let to_b32 t = B32.encode t in @@ -282,3 +278,104 @@ type rsa_priv = RsaPrivateKey.t type rsa_pub = RsaPublicKey.t type rsa_sig = RsaSignature.t type denomination_hash = Hash.DenominationHash.t + +(* WIP *) +module FDH_RSA = struct + open Mirage_crypto_pk + + 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 rsa_blind pub ~bks ~msg = + let data = rsa_full_domain_hash pub msg in + let bkey = rsa_blinding_key_derive pub bks in + (* can we just use [powm] here instead? *) + 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 + + (* -- WIP crypto -- *) + + (* TODO crypto + not sure about signature scheme used by taler + libgnunetutil crypto_rsa.c use "(flags raw)" => no padding *) + (* decrypt <=> sign *) + let rsa_sign_z priv r = + let data = Z_extra.to_octets_be r in + Rsa.decrypt ~crt_hardening:true ~key:priv data + + (* TODO crypto + look into mirage-crypto for this + use Eqaf for constant time string compare *) + let rsa_verify_z pub r sig_ = + let data = Z_extra.to_octets_be r in + let sig_' = Rsa.encrypt ~key:pub data in + match String.equal sig_ sig_' with + | false -> Fmt.error "RSA signature verification failed" + | true -> Ok () + + let rsa_sign_fdh priv msg = + let pub = Rsa.pub_of_priv priv in + let r = rsa_full_domain_hash pub msg in + rsa_sign_z priv r + + let rsa_unblind pub ~bks ~sig_ = + 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 ubsig = Z.rem (Z.mul sig_ r_inv) pub.n in + ubsig + + let rsa_verify pub ~msg ~sig_ = + let r = rsa_full_domain_hash pub msg in + rsa_verify_z pub r sig_ +end diff --git a/src/dune b/src/dune index a9322eed..0a6fa0ea 100644 --- a/src/dune +++ b/src/dune @@ -17,6 +17,7 @@ caqti-driver-pgx bin mirage-crypto + kdf.hkdf digestif duration vif diff --git a/test/crypto.ml b/test/crypto.ml index 9b7578e7..0dbf2a02 100644 --- a/test/crypto.ml +++ b/test/crypto.ml @@ -73,3 +73,50 @@ let () = in () + +let () = + (* kdf *) + let salt = "94KPT83PCNS7J83KC5P78Y8" in + let ikm = "94KPT83MD1JJ0WV5CDS6AX10D5Q70XBM41NPAY90DNGQ8SBJD5GPR" in + let ctx = + "94KPT83141HPYVKMCNW78833D1TPWTSC41GPRWVF41NPWVVQDRG62WS04XMPWSKF4WG6JVH0EHM6A82J8S1G" + in + let out_len = 64 in + let out = + "GTMR4QT05Z9WF5HKVG0WK9RPXGHSMHJNW377G9GJXCA8B0FEKPF4D27RJMSJZYWSQNTBJ5EYVV7ZW18B48Z0JVJJ80RHB706Y96Q358" + in + + let xts = salt |> decode in + let ikm = ikm |> decode in + let ctx = ctx |> decode in + let okm = Crypto.FDH_RSA.Kdf.kdf ~xts ~ikm ~ctx ~len:out_len in + let okm = okm |> encode in + assert (okm = out); + + () + +let () = + (* rsa blinding *) + (* rsa_private_key data is given in gcrypt sexpr format.. *) + let message_hash = + "XKQMJ4CNTXBFE1V2WR6JS063J7PZQE4XMB5JH3RS5X0THQ1JQSQ69Y7KDBC9TYRJEZH48MEPY2SF4QHQ4VHXC0YQX5935MQEGP0AX6R" + in + let rsa_public_key = + "040000YRN1NVJ68RS6RJF52PGRCQG19ZKWQPSTJX2G7ZDCKSZFE2VW3HHA81YF5C639JHJF5TX8YTEE2FW2WQCG1PTKNBSPPJEJGA032CN3E8QZ27VWY0K6JFT8ZSYWRH2SKDMXW56A4QKY46JJBWJ6T0ZRVBW6S1HTHXVE2RW8MXRW5T801077MDY13N5F8Z1JZVKBJ06TK3S0YPEDBXK0VEHRHEQJ5X5XYKR4KQTFAZNBMKXY8836VCHBXTK4YNX6AJ1CK29SMJH3Z3QRM16A2TNQGFR0HSMV446BF7FMT2E379ZAT5ST4G3BM2NWZYW545S2SW5MG5S6M88XZZ7SKFD48YVXNZ205GGSEYJPVBMR76WG4ZG30WBCPC1N54XE12RMAG81D8C09WG22PKGGDHYXX68N04002" + in + let blinding_key_secret = + "3SWF49XZPHQMENTSBZQR7Z0B8ZSZ2JRARE79Q4VXZMQ7W6QABXMG" + in + let blinded_message = + "3KHKZJZ30ABB4E56MA2V0EQWGCWH0QQG9P2ZHYHR186C5HZXJMM4N9WXAQTKS94QSV9Y17GGNXN5MB1PZZFG7Q0FY88QPKKRG4MYCPSMTZK5W59R0MJVNJ4P4AQM96TDG5W7RV8GSNR1QQZ1GNHW3CX6D6ZRTMXB2NKB5SSYTDJS79F5ZFBRZ4HVED9JBBPWSR79KVV5QQ4APBGHBCKGMF9NJJS53A1BVYHDEVYAGFYF2SNEP827ZP50FKJ5GKGV8NQ15ESEZ69AT7GJG0T3TZVENY2YN9CVR98W3BKEZ53J7VTANARG8SJS8AMJQ7S23P5HRJ7XE9KTNRNXKH49MXV9JHHYE5535N7AGWEKR47SBCGNF44Z7XJ9RV5BQV12ZRJKN4HBZQHDNCMH3QKX9Z6G64" + in + let open Crypto in + let msg = message_hash |> decode in + let pub = + rsa_public_key |> decode |> RsaPublicKey.of_octets |> Result.get_ok + in + let bks = blinding_key_secret |> decode in + let s = FDH_RSA.rsa_blind pub ~bks ~msg |> encode in + assert (s = blinded_message); + + ()