diff --git a/.gitmodules b/.gitmodules index ced9d3a2a..b99ec8949 100644 --- a/.gitmodules +++ b/.gitmodules @@ -4,3 +4,6 @@ [submodule "cbits/blst"] path = cbits/blst url = https://github.com/supranational/blst.git +[submodule "cbits/libsecp256k1"] + path = cbits/libsecp256k1 + url = https://github.com/bitcoin-core/secp256k1.git diff --git a/CHANGELOG.md b/CHANGELOG.md index 817cf7d3e..ac679b053 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,16 @@ +# Unreleased + +Crypto: +- Ethereum primitives for SimpleX names: secp256k1 with public key + recovery (vendored libsecp256k1), BIP-39 mnemonics, BIP-32 key derivation, + Keccak-256, EIP-55 addresses and EIP-712 typed data hashing. Client-side + signing only - no transaction construction and no chain writes; the resolver + path remains read-only. See `plans/2026-08-05-eth-crypto-bindings.md`. +- ERC-5564 stealth addresses (`Simplex.Messaging.Eth.Stealth`): a recipient + publishes a spend/view meta-address, a sender derives a one-time address from + it non-interactively, and only the recipient can find or spend from it. Adds + `publicKeyTweakMul` and `publicKeyTweakAdd` to the secp256k1 bindings. + # 6.5.1 Version 6.5.1.0 diff --git a/cbits/libsecp256k1 b/cbits/libsecp256k1 new file mode 160000 index 000000000..6e2c8bc4e --- /dev/null +++ b/cbits/libsecp256k1 @@ -0,0 +1 @@ +Subproject commit 6e2c8bc4ecdc6e71dbe7a368f360d8d453ce435d diff --git a/plans/2026-08-05-eth-crypto-bindings.md b/plans/2026-08-05-eth-crypto-bindings.md new file mode 100644 index 000000000..35bc7679f --- /dev/null +++ b/plans/2026-08-05-eth-crypto-bindings.md @@ -0,0 +1,325 @@ +# Ethereum crypto primitives for simplexmq + +Client-side crypto for SimpleX names: enough to derive an Ethereum key from a +recovery phrase and sign EIP-712 typed data. General-purpose — these modules +know nothing about names, registrars or relayers. + +This is Workstream B of the SimpleX names v2 plan. The design it serves: names +are owned by a plain EOA derived per chat profile from one BIP-39 seed, and +every post-registration action (transfer, record edit) is a one-shot EIP-712 +intent signed by that key and relayed by SimpleX, which pays the gas. + +## What is deliberately absent + +- **No RLP encoder, and no transaction building.** RLP is only needed to + construct raw transactions or EIP-7702 authorizations. The client does + neither: it signs EIP-712 typed data and hands the signature to the relayer. + The client never reads a nonce, estimates gas or broadcasts anything, so the + `RSLV` resolver path in this repo stays strictly read-only. +- **No low-s normalization.** libsecp256k1 already emits the canonical low-`s` + form EIP-2 requires. `isLowS` exists so tests assert that rather than assume + it. There is deliberately no normalization entry point: we never accept a + foreign signature, we only produce our own. +- **No BIP-32 public derivation.** We always hold the seed, so CKDpub, xpub + serialization and fingerprints are not implemented. Non-hardened *private* + derivation is, because BIP-44 paths end in non-hardened components. +- **No EIP-712 schema encoder.** The caller supplies the canonical type string. + Our structs are a handful of fixed shapes agreed with the contracts, and a + hand-written string checked against Solidity in a test is easier to audit than + a schema encoder whose output nobody reads. +- **English wordlist only.** Every English BIP-39 word is ASCII, so the NFKD + normalization BIP-39 mandates is a no-op on the mnemonic side and no + normalization dependency is needed. + +## Modules + +``` +Simplex.Messaging.Crypto.Secp256k1 FFI to libsecp256k1 +Simplex.Messaging.Crypto.BIP39 mnemonics +Simplex.Messaging.Crypto.BIP39.English generated 2048-word list +Simplex.Messaging.Crypto.BIP32 HD derivation +Simplex.Messaging.Eth.Keccak Keccak-256 +Simplex.Messaging.Eth.Address addresses, EIP-55 +Simplex.Messaging.Eth.EIP712 typed data hashing +``` + +## Types + +```haskell +newtype PrivateKey -- 32 bytes, validated in [1, n-1] +newtype PublicKey -- libsecp256k1's opaque 64-byte form +data RecoverableSignature = RecoverableSignature {rsCompact :: ByteString, rsRecId :: Int} +data PubKeyFormat = Compressed | Uncompressed + +data Mnemonic -- validated indexes + words, always consistent +data MnemonicStrength = MS128 | MS160 | MS192 | MS224 | MS256 + +data ExtendedKey = ExtendedKey {xkKey :: PrivateKey, xkChainCode :: ByteString} + +newtype Address -- 20 bytes; Show renders the EIP-55 form +data Eip712Domain = Eip712Domain {edName, edVersion :: ByteString, edChainId :: Integer, edVerifyingContract :: Address} +data Value = VUint Integer | VInt Integer | VBool Bool | VAddress Address + | VFixedBytes ByteString | VBytes ByteString | VString ByteString + | VArray [Value] | VStruct ByteString +``` + +`PrivateKey`, `Mnemonic` and `ExtendedKey` have **redacting `Show` instances**, +and `PrivateKey` compares with `constEq`. These keys authorise transfers of +assets with monetary value: a derived `Show` would put one in a log the first +time anything is traced. A chain code is secret too — it plus one child key +derives siblings. + +## Functions + +```haskell +-- Secp256k1 +mkPrivateKey :: ByteString -> Either String PrivateKey +publicKey :: PrivateKey -> PublicKey -- total: key is validated +parsePublicKey :: ByteString -> Either String PublicKey +serializePublicKey :: PubKeyFormat -> PublicKey -> ByteString +privateKeyTweakAdd :: PrivateKey -> ByteString -> Maybe PrivateKey +signRecoverable :: PrivateKey -> ByteString -> Either String RecoverableSignature +recoverPublicKey :: RecoverableSignature -> ByteString -> Either String PublicKey +isLowS :: RecoverableSignature -> Bool + +-- BIP39 +entropyToMnemonic :: ByteString -> Either String Mnemonic +mnemonicToEntropy :: Mnemonic -> ByteString -- total +parseMnemonic :: ByteString -> Either String Mnemonic +mnemonicToSeed :: Mnemonic -> ByteString -> ByteString +randomMnemonic :: MnemonicStrength -> TVar ChaChaDRG -> STM Mnemonic + +-- BIP32 +masterKey :: ByteString -> Either String ExtendedKey +deriveChild :: ExtendedKey -> Word32 -> Either String ExtendedKey +derivePath :: ExtendedKey -> [Word32] -> Either String ExtendedKey +parsePath :: ByteString -> Either String [Word32] +renderPath :: [Word32] -> ByteString + +-- Eth +keccak256 :: ByteString -> ByteString +addressFromPrivateKey :: PrivateKey -> Address +checksumAddress :: Address -> ByteString +parseAddress :: ByteString -> Either String Address +ethereumPath :: Word32 -> [Word32] -- m/44'/60'/i'/0/0 +typeHash :: ByteString -> ByteString +hashStruct :: ByteString -> [Value] -> Either String ByteString +domainSeparator :: Eip712Domain -> Either String ByteString +hashTypedData :: Eip712Domain -> ByteString -> [Value] -> Either String ByteString +``` + +`randomMnemonic` is shaped like `Simplex.Messaging.Crypto.randomBytes` so it +composes with the agent's DRG instead of reaching for system entropy. + +`parseMnemonic` lower-cases and splits on any whitespace, so a user retyping +their recovery key is not rejected for capitalising a word. This does not change +the derived seed: `mnemonicPhrase` always rebuilds the canonical lowercase +sentence from the wordlist, and that is what `mnemonicToSeed` hashes. + +## How applications use it + +An application defines the derivation path and the EIP-712 type strings. For +SimpleX names, one seed per chat database and one key per chat profile — +see `Simplex.Chat.Names.Wallet` in simplex-chat: + +```haskell +m <- either fail pure $ parseMnemonic phrase +mk <- either fail pure $ masterKey (mnemonicToSeed m "") +xk <- either fail pure $ derivePath mk (ethereumPath userId) +let addr = addressFromPrivateKey (xkKey xk) +``` + +Signing a transfer intent — the type string must match the contract's exactly, +including EIP-712 canonical form (no spaces after commas, referenced struct +types appended in alphabetical order): + +```haskell +digest <- either fail pure $ hashTypedData domain + "TransferName(address from,address to,uint256 tokenId,uint256 nonce,uint256 deadline)" + [VAddress from, VAddress to, VUint tokenId, VUint nonce, VUint deadline] +sig <- either fail pure $ signRecoverable (xkKey xk) digest +-- Ethereum's v is rsRecId + 27 +``` + +Nested structs go in as `VStruct` holding an already-computed `hashStruct`; +arrays as `VArray`, which hashes the concatenation of its members. + +## libsecp256k1 C API mapping + +```c +secp256k1_context_create(SECP256K1_CONTEXT_NONE) /* once, then _randomize */ +secp256k1_ec_seckey_verify(ctx, seckey) +secp256k1_ec_pubkey_create(ctx, pubkey, seckey) +secp256k1_ec_pubkey_parse(ctx, pubkey, input, inputlen) +secp256k1_ec_pubkey_serialize(ctx, output, outputlen, pubkey, flags) +secp256k1_ec_seckey_tweak_add(ctx, seckey, tweak) +secp256k1_ecdsa_sign_recoverable(ctx, sig, msghash32, seckey, NULL, NULL) +secp256k1_ecdsa_recoverable_signature_serialize_compact(ctx, output64, recid, sig) +secp256k1_ecdsa_recoverable_signature_parse_compact(ctx, sig, input64, recid) +secp256k1_ecdsa_recover(ctx, pubkey, sig, msghash32) +``` + +Passing `NULL` for the nonce function selects RFC-6979, so signing is a +deterministic pure function of (key, digest) — which is why the module exposes a +pure API over `unsafePerformIO`. The context is created and blinded once at +first use; randomization is a side-channel countermeasure that affects no +output, and signing does not mutate the context, so one shared context is safe +across threads. + +`secp256k1_ec_seckey_tweak_add` returns 0 exactly when BIP-32 says "proceed with +the next index" (tweak out of range, or a zero result), which is why +`privateKeyTweakAdd` returns `Maybe` and `deriveChild` can surface it. + +libsecp256k1 never reads OS entropy — RFC-6979 nonces are derived from the key +and digest, and the context blinding seed is supplied by the caller. So unlike +libbbs it raises no `getentropy` / ITMS-90338 concern on iOS, and needs no +equivalent of the `commoncrypto` flag. + +## Build + +Submodule in `cbits/`, same pattern as blst and libbbs: +`cbits/libsecp256k1` — https://github.com/bitcoin-core/secp256k1, pinned to +**v0.8.0**. + +``` +c-sources: cbits/libsecp256k1/src/{secp256k1,precomputed_ecmult,precomputed_ecmult_gen}.c +include-dirs: cbits/libsecp256k1{,/include,/src} +cc-options: -DENABLE_MODULE_RECOVERY=1 +``` + +Built **without** its autotools config header. Every knob has an `#ifndef` +default in the headers, and the checked-in precomputed tables are generated for +those defaults, so only the recovery module has to be switched on. The recovery +module is `#include`d from `secp256k1.c`, so it needs no extra `c-sources` +entry. `secp256k1.c` defines `SECP256K1_BUILD` itself, so that needs no `-D` +either. + +32-bit targets (armv7a-android, i686 musl) are covered by libsecp256k1's own +fallback: `src/util.h` selects `SECP256K1_WIDEMUL_INT64` with the 10x26 field +and 8x32 scalar backends when `__SIZEOF_INT128__` is absent. + +`include-dirs` order matters: libsecp256k1's directories come last, after +libbbs and blst. There are no filename collisions between the three (checked), +and C quoted includes prefer the including file's own directory anyway, but the +ordering keeps it that way if any library later adds a generically-named header. + +`-DENABLE_MODULE_RECOVERY=1` lands on the shared `cc-options`, so it also +reaches blst, libbbs and sntrup761 — harmless, none of them use the macro, and +symmetrically `-D__BLST_PORTABLE__` reaches libsecp256k1. + +No `flake.nix` change is needed in simplex-chat: the per-platform overrides +there only force `packages.simplexmq.components.library.libs` (external +libraries, i.e. openssl for `extra-libraries: crypto`) and flags. Vendored +`c-sources` need no nix entry, which is why blst and libbbs have none either. + +### Cross-compilation status + +Verified by building simplex-chat through its flake: + +| Target | Result | +|---|---| +| `x86_64-linux` (native, nix) | compiles and links | +| `aarch64-android` | **compiles and links** into the final shared object | +| `armv7a-android` | libsecp256k1 compiles; final link not reached (see below) | +| `x86_64-windows` (mingw) | blocked before our code — see below | +| `aarch64-darwin-ios` | not yet run (needs a darwin host) | + +`aarch64-android` is the meaningful pass: it proves the C both cross-compiles +and links into the artifact the app actually ships. + +`armv7a-android` gets far enough to prove the 32-bit path compiles — that is, +libsecp256k1's `SECP256K1_WIDEMUL_INT64` fallback builds under the NDK — but the +build then dies in simplex-chat's own `Simplex.Chat.Operators`, on the +`$(embedFile "PRIVACY.md")` splice. Cross-compiled Template Haskell runs the +splice on the target via `iserv-proxy` under `qemu-arm`, and that interpreter +fails to resolve `realpath` out of `libHSdirectory` and segfaults. It is +unrelated to this work: none of these modules use Template Haskell, and +simplexmq (which does) builds for armv7a fine. So 32-bit *linking* remains +unproven, though there is no plausible mechanism by which it would fail given +aarch64 links and the 32-bit objects compile. + +`x86_64-windows` fails while bootstrapping the mingw cross-GHC, long before any +of our code is considered: haskell.nix applies +`ghc-9.6-fix-code-symbol-jumps.patch` to `rts/linker/PEi386.c` twice from the +same store path, and the second application aborts. That is a duplicate entry in +the patch list of the pinned haskell.nix branch +(`github:input-output-hk/haskell.nix/armv7a`), not something this change can +influence. + +Both gaps can be closed without GHC by compiling the three C files with the +cross toolchain directly and linking a program that calls into both the core and +the recovery module — that isolates the C question from the Haskell build +entirely. + +## Tests + +`tests/CoreTests/EthCryptoTests.hs`, 98 examples. Everything is checked against +published vectors rather than our own output: + +- **BIP-39** — all 24 official English vectors from + `trezor/python-mnemonic/vectors.json`, entropy → mnemonic → entropy and + mnemonic → seed with the `TREZOR` passphrase. +- **BIP-32** — spec test vectors 1 (all six chains) and 2. Expected private keys + and chain codes were decoded from the published `xprv` base58 strings, since + we do not implement xprv serialization. +- **EIP-55** — the four addresses from the EIP-55 spec, round-tripped. +- **EIP-712** — the `Mail` example from the spec: domain separator, `hashStruct` + and the final digest. +- **BIP-44** — the well-known `0x9858EfFD232B4033E47d90003D41EC34EcaEda94` for + the `abandon … about` mnemonic at `m/44'/60'/0'/0/0`, plus accounts 1 and 2. +- Keccak-256 against SHA3-256, so the padding-byte confusion cannot pass. +- Negative cases: zero and out-of-range private keys, wrong digest length, + malformed public keys, bad BIP-39 checksums and word counts, out-of-range + seeds, bad EIP-55 checksums, and every EIP-712 range and length check. + +The EIP-712 and BIP-44 expectations were additionally reproduced by an +independent pure-Python secp256k1 reference written for the purpose, so they are +not just our implementation agreeing with itself. + +## Addendum: ERC-5564 stealth addresses + +`Simplex.Messaging.Eth.Stealth`, added for the names v2 gifting flow (rc3 §7.4). +A recipient publishes a meta-address — a spending public key and a viewing +public key — and a sender derives a one-time destination from it with no +handshake. Only the viewing key finds those destinations; only the spending key +spends from them. + +### Why not `secp256k1_ecdh` + +The ECDH module hashes the shared secret point with SHA-256 and offers no way to +substitute a hash without a C callback. ERC-5564 hashes with keccak256. So the +module stays disabled and the two core-API point operations are bound instead: + +- `secp256k1_ec_pubkey_tweak_mul` → `publicKeyTweakMul`, for `r · P_view` +- `secp256k1_ec_pubkey_tweak_add` → `publicKeyTweakAdd`, for `P_spend + s_h · G` + +Both are in `secp256k1.h`, so no build flag changed. The recipient's key, +`p_spend + s_h`, reuses the existing `privateKeyTweakAdd`. + +### The parts the EIP does not specify + +ERC-5564 fixes the algebra but not the encoding, and getting either wrong +produces a wallet that is self-consistent and interoperable with nothing. From +the EIP author's reference implementation +(`Nerolation/EIP-Stealth-Address-ERC`, `minimal_poc.ipynb`): + +- the shared secret point is serialized **uncompressed with the SEC1 prefix + removed**, `x || y`, 64 bytes; +- it is hashed with **keccak256**; +- the **view tag is the first byte** of that hash. + +That is the same encoding Ethereum uses to turn a public key into an address, so +`addressFromPublicKey` performs the final step unchanged. + +### Tests + +13 examples in `CoreTests.EthCryptoTests`, 111 in the module overall. Beyond the +round-trip and negative cases, two carry the weight: + +- **Batch scanning.** A recipient scans 512 announcements addressed to someone + else; about two pass the one-byte view tag by chance and none yields an address + they control. The complementary test confirms they find all 64 of their own. + This exercises the scan loop rather than a single derivation. +- **Independent agreement.** The pinned vector was reproduced by a from-scratch + pure-Python secp256k1 implementing the reference algorithm directly, sharing no + code with libsecp256k1. Without that, a pin only records our own output. diff --git a/simplexmq.cabal b/simplexmq.cabal index 0019bc018..1cbfb0221 100644 --- a/simplexmq.cabal +++ b/simplexmq.cabal @@ -31,6 +31,8 @@ extra-source-files: cbits/blst/**/*.asm cbits/libbbs/**/*.c cbits/libbbs/**/*.h + cbits/libsecp256k1/**/*.c + cbits/libsecp256k1/**/*.h apps/common/Web/static/index.html apps/common/Web/static/link.html apps/common/Web/static/media/apk_icon.png @@ -135,6 +137,10 @@ library Simplex.Messaging.Crypto.Lazy Simplex.Messaging.Crypto.Ratchet Simplex.Messaging.Crypto.BBS + Simplex.Messaging.Crypto.BIP32 + Simplex.Messaging.Crypto.BIP39 + Simplex.Messaging.Crypto.BIP39.English + Simplex.Messaging.Crypto.Secp256k1 Simplex.Messaging.Crypto.SNTRUP761 Simplex.Messaging.Crypto.SNTRUP761.Bindings Simplex.Messaging.Crypto.SNTRUP761.Bindings.Defines @@ -143,6 +149,10 @@ library Simplex.Messaging.Crypto.ShortLink Simplex.Messaging.Encoding Simplex.Messaging.Encoding.String + Simplex.Messaging.Eth.Address + Simplex.Messaging.Eth.EIP712 + Simplex.Messaging.Eth.Keccak + Simplex.Messaging.Eth.Stealth Simplex.Messaging.Names.Record Simplex.Messaging.Notifications.Client Simplex.Messaging.Notifications.Protocol @@ -323,7 +333,13 @@ library cbits/blst/src cbits/libbbs/include cbits/libbbs/src - cc-options: -D__BLST_PORTABLE__ + cbits/libsecp256k1 + cbits/libsecp256k1/include + cbits/libsecp256k1/src + -- libsecp256k1 is built without its autotools config header: every knob it + -- needs has an #ifndef default, and the checked-in precomputed tables match + -- those defaults. Only the recovery module has to be switched on explicitly. + cc-options: -D__BLST_PORTABLE__ -DENABLE_MODULE_RECOVERY=1 if flag(commoncrypto) cc-options: -DBBS_CRYPTO_CC frameworks: Security @@ -337,6 +353,9 @@ library cbits/libbbs/src/compat-string.c cbits/libbbs/src/sha256.c cbits/libbbs/src/shake256.c + cbits/libsecp256k1/src/secp256k1.c + cbits/libsecp256k1/src/precomputed_ecmult.c + cbits/libsecp256k1/src/precomputed_ecmult_gen.c asm-sources: cbits/blst/build/assembly.S extra-libraries: @@ -541,6 +560,7 @@ test-suite simplexmq-test CoreTests.CryptoFileTests CoreTests.CryptoTests CoreTests.EncodingTests + CoreTests.EthCryptoTests CoreTests.MsgStoreTests CoreTests.RetryIntervalTests CoreTests.SOCKSSettings diff --git a/src/Simplex/Messaging/Crypto/BIP32.hs b/src/Simplex/Messaging/Crypto/BIP32.hs new file mode 100644 index 000000000..7b7d7d60d --- /dev/null +++ b/src/Simplex/Messaging/Crypto/BIP32.hs @@ -0,0 +1,145 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | BIP-32 hierarchical deterministic key derivation over secp256k1. +-- +-- Private derivation only: we always hold the seed, so the neutered/extended +-- public key half of BIP-32 (CKDpub, xpub serialization, fingerprints) is not +-- implemented. Non-hardened child derivation is supported, because BIP-44 paths +-- end in non-hardened components. +module Simplex.Messaging.Crypto.BIP32 + ( ExtendedKey (..), + masterKey, + deriveChild, + derivePath, + parsePath, + renderPath, + hardenedOffset, + hardened, + isHardened, + chainCodeSize, + ) +where + +import qualified Crypto.Hash as H +import qualified Crypto.MAC.HMAC as HMAC +import qualified Data.ByteArray as BA +import Data.Bits (shiftR, (.&.)) +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as BC +import Data.List (intercalate) +import Data.Word (Word32) +import qualified Simplex.Messaging.Crypto.Secp256k1 as S + +-- | An extended private key: the key plus its chain code. +-- +-- 'Show' is redacting — the chain code plus one child key is enough to derive +-- siblings, so it is secret material too. +data ExtendedKey = ExtendedKey + { xkKey :: S.PrivateKey, + xkChainCode :: ByteString + } + deriving (Eq) + +instance Show ExtendedKey where + show _ = "ExtendedKey " + +chainCodeSize :: Int +chainCodeSize = 32 + +-- | Child indexes at or above this are hardened. +hardenedOffset :: Word32 +hardenedOffset = 0x80000000 + +-- | @hardened 44 == 44'@. Indexes at or above 'hardenedOffset' are returned +-- unchanged, so @hardened . hardened@ is idempotent rather than overflowing. +hardened :: Word32 -> Word32 +hardened i + | i >= hardenedOffset = i + | otherwise = i + hardenedOffset + +isHardened :: Word32 -> Bool +isHardened i = i >= hardenedOffset + +-- | Derive the master key from a BIP-39 seed (BIP-32 allows 16 to 64 bytes). +masterKey :: ByteString -> Either String ExtendedKey +masterKey seed + | seedLen < 16 || seedLen > 64 = + Left $ "seed: expected 16 to 64 bytes, got " <> show seedLen + | otherwise = do + k <- either (const $ Left "seed: invalid master key, use a different seed") Right $ S.mkPrivateKey il + Right ExtendedKey {xkKey = k, xkChainCode = ir} + where + seedLen = B.length seed + i = hmacSHA512 "Bitcoin seed" seed + il = B.take 32 i + ir = B.drop 32 i + +-- | CKDpriv. 'Left' only in the negligible case BIP-32 defines as "proceed with +-- the next index"; callers deriving a fixed path should surface it rather than +-- silently skipping, since it never happens for real seeds. +deriveChild :: ExtendedKey -> Word32 -> Either String ExtendedKey +deriveChild xk i = + case S.privateKeyTweakAdd (xkKey xk) il of + Nothing -> Left $ "derivation: invalid child at index " <> show i <> ", use the next index" + Just k -> Right ExtendedKey {xkKey = k, xkChainCode = ir} + where + dat + | isHardened i = B.singleton 0 <> S.unPrivateKey (xkKey xk) <> ser32 i + | otherwise = S.serializePublicKey S.Compressed (S.publicKey (xkKey xk)) <> ser32 i + hm = hmacSHA512 (xkChainCode xk) dat + il = B.take 32 hm + ir = B.drop 32 hm + +derivePath :: ExtendedKey -> [Word32] -> Either String ExtendedKey +derivePath = foldl (\acc i -> acc >>= (`deriveChild` i)) . Right + +-- | Parse a path such as @m\/44'\/60'\/0'\/0\/0@. A leading @m@ or @M@ is +-- optional; both @'@ and @h@ mark a hardened index. +parsePath :: ByteString -> Either String [Word32] +parsePath s = case BC.split '/' (BC.filter (/= ' ') s) of + [] -> Right [] + (h : rest) + | h == "m" || h == "M" || B.null h -> traverse element rest + | otherwise -> traverse element (h : rest) + where + element e + | B.null e = Left "path: empty component" + | otherwise = + let (digits, suffix) = BC.span (`elem` ("0123456789" :: String)) e + mark + | suffix == "'" || suffix == "h" || suffix == "H" = Right True + | B.null suffix = Right False + | otherwise = Left $ "path: bad component " <> BC.unpack e + in if B.null digits + then Left $ "path: bad component " <> BC.unpack e + else do + h' <- mark + n <- readIndex digits + if h' then Right (n + hardenedOffset) else Right n + readIndex digits = + let n = BC.foldl' (\acc c -> acc * 10 + toInteger (fromEnum c - fromEnum '0')) 0 digits + in if n >= toInteger hardenedOffset + then Left $ "path: index out of range: " <> BC.unpack digits + else Right (fromInteger n) + +renderPath :: [Word32] -> ByteString +renderPath is = BC.pack $ intercalate "/" ("m" : map component is) + where + component i + | isHardened i = show (i - hardenedOffset) <> "'" + | otherwise = show i + +hmacSHA512 :: ByteString -> ByteString -> ByteString +hmacSHA512 key msg = BA.convert (HMAC.hmac key msg :: HMAC.HMAC H.SHA512) + +ser32 :: Word32 -> ByteString +ser32 i = + B.pack + [ fromIntegral (i `shiftR` 24), + fromIntegral ((i `shiftR` 16) .&. 0xFF), + fromIntegral ((i `shiftR` 8) .&. 0xFF), + fromIntegral (i .&. 0xFF) + ] diff --git a/src/Simplex/Messaging/Crypto/BIP39.hs b/src/Simplex/Messaging/Crypto/BIP39.hs new file mode 100644 index 000000000..bfe693379 --- /dev/null +++ b/src/Simplex/Messaging/Crypto/BIP39.hs @@ -0,0 +1,198 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | BIP-39 mnemonics over the English wordlist. +-- +-- Scope is deliberately narrow: English only. Every English word is ASCII, so +-- the Unicode NFKD normalization BIP-39 mandates is a no-op on the mnemonic +-- side and this module needs no normalization dependency. A passphrase, if +-- used, is taken as bytes and is the caller's responsibility to normalize. +-- +-- A mnemonic is the root secret for name ownership, so 'Mnemonic' has a +-- redacting 'Show'. +module Simplex.Messaging.Crypto.BIP39 + ( Mnemonic, + MnemonicStrength (..), + mnemonicIndexes, + mnemonicWords, + mnemonicPhrase, + entropyToMnemonic, + mnemonicToEntropy, + parseMnemonic, + mnemonicToSeed, + randomMnemonic, + strengthBytes, + strengthWordCount, + seedSize, + wordListSize, + ) +where + +import Control.Concurrent.STM +import Crypto.Hash (Digest, SHA256, SHA512 (..), hash) +import qualified Crypto.KDF.PBKDF2 as PBKDF2 +import Crypto.Random (ChaChaDRG, randomBytesGenerate) +import qualified Data.ByteArray as BA +import Data.Bits (shiftL, shiftR, (.&.), (.|.)) +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as BC +import Data.Char (toLower) +import Data.IntMap.Strict (IntMap) +import qualified Data.IntMap.Strict as IM +import Data.List (foldl') +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as M +import Simplex.Messaging.Crypto.BIP39.English (englishWordList) + +-- | A validated BIP-39 mnemonic. Indexes and words are always consistent +-- because the constructor is private and every index is in @[0, 2047]@. +data Mnemonic = Mnemonic + { mnemonicIndexes :: [Int], + mnemonicWords :: [ByteString] + } + deriving (Eq) + +instance Show Mnemonic where + show m = "Mnemonic <" <> show (length (mnemonicIndexes m)) <> " words, redacted>" + +-- | Entropy size, named by bit length as BIP-39 does. +data MnemonicStrength = MS128 | MS160 | MS192 | MS224 | MS256 + deriving (Eq, Show, Bounded, Enum) + +strengthBytes :: MnemonicStrength -> Int +strengthBytes = \case + MS128 -> 16 + MS160 -> 20 + MS192 -> 24 + MS224 -> 28 + MS256 -> 32 + +-- | 12, 15, 18, 21 or 24. +strengthWordCount :: MnemonicStrength -> Int +strengthWordCount s = (entBits + entBits `div` 32) `div` 11 + where + entBits = strengthBytes s * 8 + +-- | BIP-39 seeds are always 64 bytes, whatever the entropy size. +seedSize :: Int +seedSize = 64 + +wordListSize :: Int +wordListSize = 2048 + +validEntropySizes :: [Int] +validEntropySizes = [16, 20, 24, 28, 32] + +validWordCounts :: [Int] +validWordCounts = [12, 15, 18, 21, 24] + +-- Wordlist indexes + +wordByIndex :: IntMap ByteString +wordByIndex = IM.fromList $ zip [0 ..] englishWordList +{-# NOINLINE wordByIndex #-} + +indexByWord :: Map ByteString Int +indexByWord = M.fromList $ zip englishWordList [0 ..] +{-# NOINLINE indexByWord #-} + +-- | The mnemonic as one space-separated phrase — the exact bytes BIP-39 feeds +-- to PBKDF2. +mnemonicPhrase :: Mnemonic -> ByteString +mnemonicPhrase = BC.unwords . mnemonicWords + +-- | Build a mnemonic from raw entropy of 16, 20, 24, 28 or 32 bytes. +entropyToMnemonic :: ByteString -> Either String Mnemonic +entropyToMnemonic ent + | entLen `notElem` validEntropySizes = + Left $ "entropy: expected 16, 20, 24, 28 or 32 bytes, got " <> show entLen + | otherwise = Right $ mnemonicFromIndexes $ entropyToIndexes ent + where + entLen = B.length ent + +-- | Entropy to 11-bit word indexes. Assumes a validated entropy length; every +-- result is masked to 11 bits, so all indexes are in @[0, 2047]@. +entropyToIndexes :: ByteString -> [Int] +entropyToIndexes ent = + [fromIntegral ((combined `shiftR` (11 * (n - 1 - i))) .&. 0x7FF) | i <- [0 .. n - 1]] + where + entBits = B.length ent * 8 + csBits = entBits `div` 32 + -- csBits is at most 8 (256/32), so the first checksum byte always suffices. + csByte = B.head (sha256 ent) + combined = beToInteger ent `shiftL` csBits .|. fromIntegral (csByte `shiftR` (8 - csBits)) + n = (entBits + csBits) `div` 11 + +-- | Total: a 'Mnemonic' can only hold a valid word count and valid indexes. +mnemonicToEntropy :: Mnemonic -> ByteString +mnemonicToEntropy m = integerToBE (entBits `div` 8) (combined `shiftR` csBits) + where + idxs = mnemonicIndexes m + totalBits = length idxs * 11 + entBits = totalBits * 32 `div` 33 + csBits = totalBits - entBits + combined = foldl' (\acc i -> acc `shiftL` 11 .|. fromIntegral i) (0 :: Integer) idxs + +-- | Parse and fully validate a phrase: word count, wordlist membership, and the +-- BIP-39 checksum. Words may be separated by any whitespace, and input is +-- lower-cased first, so a user retyping their recovery key does not get an +-- unhelpful failure for capitalising a word. This does not change the derived +-- seed: 'mnemonicPhrase' always rebuilds the canonical lowercase sentence from +-- the wordlist, and that is what 'mnemonicToSeed' hashes. +parseMnemonic :: ByteString -> Either String Mnemonic +parseMnemonic phrase + | n `notElem` validWordCounts = + Left $ "mnemonic: expected 12, 15, 18, 21 or 24 words, got " <> show n + | otherwise = do + idxs <- traverse lookupWord ws + let m = mnemonicFromIndexes idxs + -- Stripping the checksum bits and recomputing them is the checksum check: + -- if the supplied bits were wrong, the round trip cannot reproduce them. + if entropyToIndexes (mnemonicToEntropy m) == idxs + then Right m + else Left "mnemonic: checksum mismatch" + where + ws = BC.words $ BC.map toLower phrase + n = length ws + lookupWord w = + maybe (Left $ "mnemonic: not in wordlist: " <> BC.unpack w) Right $ M.lookup w indexByWord + +-- | PBKDF2-HMAC-SHA512, 2048 iterations, salt @\"mnemonic\" <> passphrase@. +-- Pass an empty passphrase for the common case. +mnemonicToSeed :: Mnemonic -> ByteString -> ByteString +mnemonicToSeed m passphrase = + PBKDF2.generate + (PBKDF2.prfHMAC SHA512) + PBKDF2.Parameters {PBKDF2.iterCounts = 2048, PBKDF2.outputLength = seedSize} + (mnemonicPhrase m) + ("mnemonic" <> passphrase :: ByteString) + +-- | Generate a fresh mnemonic. Shaped like 'Simplex.Messaging.Crypto.randomBytes' +-- so it composes with the agent's DRG instead of reaching for system entropy. +randomMnemonic :: MnemonicStrength -> TVar ChaChaDRG -> STM Mnemonic +randomMnemonic s gVar = do + ent <- stateTVar gVar $ randomBytesGenerate (strengthBytes s) + pure $ mnemonicFromIndexes $ entropyToIndexes ent + +-- Internal + +-- | Indexes must be in @[0, 2047]@; both call paths guarantee that (an 11-bit +-- mask, or a lookup in the wordlist itself). The default is the empty word so +-- that a violation would fail loudly downstream rather than silently produce a +-- different valid mnemonic. +mnemonicFromIndexes :: [Int] -> Mnemonic +mnemonicFromIndexes idxs = + Mnemonic {mnemonicIndexes = idxs, mnemonicWords = map wordAt idxs} + where + wordAt i = IM.findWithDefault "" i wordByIndex + +sha256 :: ByteString -> ByteString +sha256 bs = BA.convert (hash bs :: Digest SHA256) + +beToInteger :: ByteString -> Integer +beToInteger = B.foldl' (\acc w -> acc `shiftL` 8 .|. fromIntegral w) 0 + +integerToBE :: Int -> Integer -> ByteString +integerToBE n x = B.pack [fromIntegral (x `shiftR` (8 * (n - 1 - i))) | i <- [0 .. n - 1]] diff --git a/src/Simplex/Messaging/Crypto/BIP39/English.hs b/src/Simplex/Messaging/Crypto/BIP39/English.hs new file mode 100644 index 000000000..471addb81 --- /dev/null +++ b/src/Simplex/Messaging/Crypto/BIP39/English.hs @@ -0,0 +1,359 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | The BIP-39 English wordlist (2048 words), verbatim from +-- . +-- SHA-256 of the source file: 2f5eed53a4727b4bf8880d8f3f199efc90e58503646d9ff8eff3a2ed3b24dbda +-- +-- This module is generated data; do not edit by hand. Every word is ASCII, and +-- the first four bytes of each word are unique, which is what makes BIP-39 +-- mnemonics unambiguous under four-letter truncation. +module Simplex.Messaging.Crypto.BIP39.English (englishWordList) where + +import Data.ByteString.Char8 (ByteString) + +-- | All 2048 words, in BIP-39 index order (index 0 is @abandon@). +englishWordList :: [ByteString] +englishWordList = + [ "abandon", "ability", "able", "about", "above", "absent" + , "absorb", "abstract", "absurd", "abuse", "access", "accident" + , "account", "accuse", "achieve", "acid", "acoustic", "acquire" + , "across", "act", "action", "actor", "actress", "actual" + , "adapt", "add", "addict", "address", "adjust", "admit" + , "adult", "advance", "advice", "aerobic", "affair", "afford" + , "afraid", "again", "age", "agent", "agree", "ahead" + , "aim", "air", "airport", "aisle", "alarm", "album" + , "alcohol", "alert", "alien", "all", "alley", "allow" + , "almost", "alone", "alpha", "already", "also", "alter" + , "always", "amateur", "amazing", "among", "amount", "amused" + , "analyst", "anchor", "ancient", "anger", "angle", "angry" + , "animal", "ankle", "announce", "annual", "another", "answer" + , "antenna", "antique", "anxiety", "any", "apart", "apology" + , "appear", "apple", "approve", "april", "arch", "arctic" + , "area", "arena", "argue", "arm", "armed", "armor" + , "army", "around", "arrange", "arrest", "arrive", "arrow" + , "art", "artefact", "artist", "artwork", "ask", "aspect" + , "assault", "asset", "assist", "assume", "asthma", "athlete" + , "atom", "attack", "attend", "attitude", "attract", "auction" + , "audit", "august", "aunt", "author", "auto", "autumn" + , "average", "avocado", "avoid", "awake", "aware", "away" + , "awesome", "awful", "awkward", "axis", "baby", "bachelor" + , "bacon", "badge", "bag", "balance", "balcony", "ball" + , "bamboo", "banana", "banner", "bar", "barely", "bargain" + , "barrel", "base", "basic", "basket", "battle", "beach" + , "bean", "beauty", "because", "become", "beef", "before" + , "begin", "behave", "behind", "believe", "below", "belt" + , "bench", "benefit", "best", "betray", "better", "between" + , "beyond", "bicycle", "bid", "bike", "bind", "biology" + , "bird", "birth", "bitter", "black", "blade", "blame" + , "blanket", "blast", "bleak", "bless", "blind", "blood" + , "blossom", "blouse", "blue", "blur", "blush", "board" + , "boat", "body", "boil", "bomb", "bone", "bonus" + , "book", "boost", "border", "boring", "borrow", "boss" + , "bottom", "bounce", "box", "boy", "bracket", "brain" + , "brand", "brass", "brave", "bread", "breeze", "brick" + , "bridge", "brief", "bright", "bring", "brisk", "broccoli" + , "broken", "bronze", "broom", "brother", "brown", "brush" + , "bubble", "buddy", "budget", "buffalo", "build", "bulb" + , "bulk", "bullet", "bundle", "bunker", "burden", "burger" + , "burst", "bus", "business", "busy", "butter", "buyer" + , "buzz", "cabbage", "cabin", "cable", "cactus", "cage" + , "cake", "call", "calm", "camera", "camp", "can" + , "canal", "cancel", "candy", "cannon", "canoe", "canvas" + , "canyon", "capable", "capital", "captain", "car", "carbon" + , "card", "cargo", "carpet", "carry", "cart", "case" + , "cash", "casino", "castle", "casual", "cat", "catalog" + , "catch", "category", "cattle", "caught", "cause", "caution" + , "cave", "ceiling", "celery", "cement", "census", "century" + , "cereal", "certain", "chair", "chalk", "champion", "change" + , "chaos", "chapter", "charge", "chase", "chat", "cheap" + , "check", "cheese", "chef", "cherry", "chest", "chicken" + , "chief", "child", "chimney", "choice", "choose", "chronic" + , "chuckle", "chunk", "churn", "cigar", "cinnamon", "circle" + , "citizen", "city", "civil", "claim", "clap", "clarify" + , "claw", "clay", "clean", "clerk", "clever", "click" + , "client", "cliff", "climb", "clinic", "clip", "clock" + , "clog", "close", "cloth", "cloud", "clown", "club" + , "clump", "cluster", "clutch", "coach", "coast", "coconut" + , "code", "coffee", "coil", "coin", "collect", "color" + , "column", "combine", "come", "comfort", "comic", "common" + , "company", "concert", "conduct", "confirm", "congress", "connect" + , "consider", "control", "convince", "cook", "cool", "copper" + , "copy", "coral", "core", "corn", "correct", "cost" + , "cotton", "couch", "country", "couple", "course", "cousin" + , "cover", "coyote", "crack", "cradle", "craft", "cram" + , "crane", "crash", "crater", "crawl", "crazy", "cream" + , "credit", "creek", "crew", "cricket", "crime", "crisp" + , "critic", "crop", "cross", "crouch", "crowd", "crucial" + , "cruel", "cruise", "crumble", "crunch", "crush", "cry" + , "crystal", "cube", "culture", "cup", "cupboard", "curious" + , "current", "curtain", "curve", "cushion", "custom", "cute" + , "cycle", "dad", "damage", "damp", "dance", "danger" + , "daring", "dash", "daughter", "dawn", "day", "deal" + , "debate", "debris", "decade", "december", "decide", "decline" + , "decorate", "decrease", "deer", "defense", "define", "defy" + , "degree", "delay", "deliver", "demand", "demise", "denial" + , "dentist", "deny", "depart", "depend", "deposit", "depth" + , "deputy", "derive", "describe", "desert", "design", "desk" + , "despair", "destroy", "detail", "detect", "develop", "device" + , "devote", "diagram", "dial", "diamond", "diary", "dice" + , "diesel", "diet", "differ", "digital", "dignity", "dilemma" + , "dinner", "dinosaur", "direct", "dirt", "disagree", "discover" + , "disease", "dish", "dismiss", "disorder", "display", "distance" + , "divert", "divide", "divorce", "dizzy", "doctor", "document" + , "dog", "doll", "dolphin", "domain", "donate", "donkey" + , "donor", "door", "dose", "double", "dove", "draft" + , "dragon", "drama", "drastic", "draw", "dream", "dress" + , "drift", "drill", "drink", "drip", "drive", "drop" + , "drum", "dry", "duck", "dumb", "dune", "during" + , "dust", "dutch", "duty", "dwarf", "dynamic", "eager" + , "eagle", "early", "earn", "earth", "easily", "east" + , "easy", "echo", "ecology", "economy", "edge", "edit" + , "educate", "effort", "egg", "eight", "either", "elbow" + , "elder", "electric", "elegant", "element", "elephant", "elevator" + , "elite", "else", "embark", "embody", "embrace", "emerge" + , "emotion", "employ", "empower", "empty", "enable", "enact" + , "end", "endless", "endorse", "enemy", "energy", "enforce" + , "engage", "engine", "enhance", "enjoy", "enlist", "enough" + , "enrich", "enroll", "ensure", "enter", "entire", "entry" + , "envelope", "episode", "equal", "equip", "era", "erase" + , "erode", "erosion", "error", "erupt", "escape", "essay" + , "essence", "estate", "eternal", "ethics", "evidence", "evil" + , "evoke", "evolve", "exact", "example", "excess", "exchange" + , "excite", "exclude", "excuse", "execute", "exercise", "exhaust" + , "exhibit", "exile", "exist", "exit", "exotic", "expand" + , "expect", "expire", "explain", "expose", "express", "extend" + , "extra", "eye", "eyebrow", "fabric", "face", "faculty" + , "fade", "faint", "faith", "fall", "false", "fame" + , "family", "famous", "fan", "fancy", "fantasy", "farm" + , "fashion", "fat", "fatal", "father", "fatigue", "fault" + , "favorite", "feature", "february", "federal", "fee", "feed" + , "feel", "female", "fence", "festival", "fetch", "fever" + , "few", "fiber", "fiction", "field", "figure", "file" + , "film", "filter", "final", "find", "fine", "finger" + , "finish", "fire", "firm", "first", "fiscal", "fish" + , "fit", "fitness", "fix", "flag", "flame", "flash" + , "flat", "flavor", "flee", "flight", "flip", "float" + , "flock", "floor", "flower", "fluid", "flush", "fly" + , "foam", "focus", "fog", "foil", "fold", "follow" + , "food", "foot", "force", "forest", "forget", "fork" + , "fortune", "forum", "forward", "fossil", "foster", "found" + , "fox", "fragile", "frame", "frequent", "fresh", "friend" + , "fringe", "frog", "front", "frost", "frown", "frozen" + , "fruit", "fuel", "fun", "funny", "furnace", "fury" + , "future", "gadget", "gain", "galaxy", "gallery", "game" + , "gap", "garage", "garbage", "garden", "garlic", "garment" + , "gas", "gasp", "gate", "gather", "gauge", "gaze" + , "general", "genius", "genre", "gentle", "genuine", "gesture" + , "ghost", "giant", "gift", "giggle", "ginger", "giraffe" + , "girl", "give", "glad", "glance", "glare", "glass" + , "glide", "glimpse", "globe", "gloom", "glory", "glove" + , "glow", "glue", "goat", "goddess", "gold", "good" + , "goose", "gorilla", "gospel", "gossip", "govern", "gown" + , "grab", "grace", "grain", "grant", "grape", "grass" + , "gravity", "great", "green", "grid", "grief", "grit" + , "grocery", "group", "grow", "grunt", "guard", "guess" + , "guide", "guilt", "guitar", "gun", "gym", "habit" + , "hair", "half", "hammer", "hamster", "hand", "happy" + , "harbor", "hard", "harsh", "harvest", "hat", "have" + , "hawk", "hazard", "head", "health", "heart", "heavy" + , "hedgehog", "height", "hello", "helmet", "help", "hen" + , "hero", "hidden", "high", "hill", "hint", "hip" + , "hire", "history", "hobby", "hockey", "hold", "hole" + , "holiday", "hollow", "home", "honey", "hood", "hope" + , "horn", "horror", "horse", "hospital", "host", "hotel" + , "hour", "hover", "hub", "huge", "human", "humble" + , "humor", "hundred", "hungry", "hunt", "hurdle", "hurry" + , "hurt", "husband", "hybrid", "ice", "icon", "idea" + , "identify", "idle", "ignore", "ill", "illegal", "illness" + , "image", "imitate", "immense", "immune", "impact", "impose" + , "improve", "impulse", "inch", "include", "income", "increase" + , "index", "indicate", "indoor", "industry", "infant", "inflict" + , "inform", "inhale", "inherit", "initial", "inject", "injury" + , "inmate", "inner", "innocent", "input", "inquiry", "insane" + , "insect", "inside", "inspire", "install", "intact", "interest" + , "into", "invest", "invite", "involve", "iron", "island" + , "isolate", "issue", "item", "ivory", "jacket", "jaguar" + , "jar", "jazz", "jealous", "jeans", "jelly", "jewel" + , "job", "join", "joke", "journey", "joy", "judge" + , "juice", "jump", "jungle", "junior", "junk", "just" + , "kangaroo", "keen", "keep", "ketchup", "key", "kick" + , "kid", "kidney", "kind", "kingdom", "kiss", "kit" + , "kitchen", "kite", "kitten", "kiwi", "knee", "knife" + , "knock", "know", "lab", "label", "labor", "ladder" + , "lady", "lake", "lamp", "language", "laptop", "large" + , "later", "latin", "laugh", "laundry", "lava", "law" + , "lawn", "lawsuit", "layer", "lazy", "leader", "leaf" + , "learn", "leave", "lecture", "left", "leg", "legal" + , "legend", "leisure", "lemon", "lend", "length", "lens" + , "leopard", "lesson", "letter", "level", "liar", "liberty" + , "library", "license", "life", "lift", "light", "like" + , "limb", "limit", "link", "lion", "liquid", "list" + , "little", "live", "lizard", "load", "loan", "lobster" + , "local", "lock", "logic", "lonely", "long", "loop" + , "lottery", "loud", "lounge", "love", "loyal", "lucky" + , "luggage", "lumber", "lunar", "lunch", "luxury", "lyrics" + , "machine", "mad", "magic", "magnet", "maid", "mail" + , "main", "major", "make", "mammal", "man", "manage" + , "mandate", "mango", "mansion", "manual", "maple", "marble" + , "march", "margin", "marine", "market", "marriage", "mask" + , "mass", "master", "match", "material", "math", "matrix" + , "matter", "maximum", "maze", "meadow", "mean", "measure" + , "meat", "mechanic", "medal", "media", "melody", "melt" + , "member", "memory", "mention", "menu", "mercy", "merge" + , "merit", "merry", "mesh", "message", "metal", "method" + , "middle", "midnight", "milk", "million", "mimic", "mind" + , "minimum", "minor", "minute", "miracle", "mirror", "misery" + , "miss", "mistake", "mix", "mixed", "mixture", "mobile" + , "model", "modify", "mom", "moment", "monitor", "monkey" + , "monster", "month", "moon", "moral", "more", "morning" + , "mosquito", "mother", "motion", "motor", "mountain", "mouse" + , "move", "movie", "much", "muffin", "mule", "multiply" + , "muscle", "museum", "mushroom", "music", "must", "mutual" + , "myself", "mystery", "myth", "naive", "name", "napkin" + , "narrow", "nasty", "nation", "nature", "near", "neck" + , "need", "negative", "neglect", "neither", "nephew", "nerve" + , "nest", "net", "network", "neutral", "never", "news" + , "next", "nice", "night", "noble", "noise", "nominee" + , "noodle", "normal", "north", "nose", "notable", "note" + , "nothing", "notice", "novel", "now", "nuclear", "number" + , "nurse", "nut", "oak", "obey", "object", "oblige" + , "obscure", "observe", "obtain", "obvious", "occur", "ocean" + , "october", "odor", "off", "offer", "office", "often" + , "oil", "okay", "old", "olive", "olympic", "omit" + , "once", "one", "onion", "online", "only", "open" + , "opera", "opinion", "oppose", "option", "orange", "orbit" + , "orchard", "order", "ordinary", "organ", "orient", "original" + , "orphan", "ostrich", "other", "outdoor", "outer", "output" + , "outside", "oval", "oven", "over", "own", "owner" + , "oxygen", "oyster", "ozone", "pact", "paddle", "page" + , "pair", "palace", "palm", "panda", "panel", "panic" + , "panther", "paper", "parade", "parent", "park", "parrot" + , "party", "pass", "patch", "path", "patient", "patrol" + , "pattern", "pause", "pave", "payment", "peace", "peanut" + , "pear", "peasant", "pelican", "pen", "penalty", "pencil" + , "people", "pepper", "perfect", "permit", "person", "pet" + , "phone", "photo", "phrase", "physical", "piano", "picnic" + , "picture", "piece", "pig", "pigeon", "pill", "pilot" + , "pink", "pioneer", "pipe", "pistol", "pitch", "pizza" + , "place", "planet", "plastic", "plate", "play", "please" + , "pledge", "pluck", "plug", "plunge", "poem", "poet" + , "point", "polar", "pole", "police", "pond", "pony" + , "pool", "popular", "portion", "position", "possible", "post" + , "potato", "pottery", "poverty", "powder", "power", "practice" + , "praise", "predict", "prefer", "prepare", "present", "pretty" + , "prevent", "price", "pride", "primary", "print", "priority" + , "prison", "private", "prize", "problem", "process", "produce" + , "profit", "program", "project", "promote", "proof", "property" + , "prosper", "protect", "proud", "provide", "public", "pudding" + , "pull", "pulp", "pulse", "pumpkin", "punch", "pupil" + , "puppy", "purchase", "purity", "purpose", "purse", "push" + , "put", "puzzle", "pyramid", "quality", "quantum", "quarter" + , "question", "quick", "quit", "quiz", "quote", "rabbit" + , "raccoon", "race", "rack", "radar", "radio", "rail" + , "rain", "raise", "rally", "ramp", "ranch", "random" + , "range", "rapid", "rare", "rate", "rather", "raven" + , "raw", "razor", "ready", "real", "reason", "rebel" + , "rebuild", "recall", "receive", "recipe", "record", "recycle" + , "reduce", "reflect", "reform", "refuse", "region", "regret" + , "regular", "reject", "relax", "release", "relief", "rely" + , "remain", "remember", "remind", "remove", "render", "renew" + , "rent", "reopen", "repair", "repeat", "replace", "report" + , "require", "rescue", "resemble", "resist", "resource", "response" + , "result", "retire", "retreat", "return", "reunion", "reveal" + , "review", "reward", "rhythm", "rib", "ribbon", "rice" + , "rich", "ride", "ridge", "rifle", "right", "rigid" + , "ring", "riot", "ripple", "risk", "ritual", "rival" + , "river", "road", "roast", "robot", "robust", "rocket" + , "romance", "roof", "rookie", "room", "rose", "rotate" + , "rough", "round", "route", "royal", "rubber", "rude" + , "rug", "rule", "run", "runway", "rural", "sad" + , "saddle", "sadness", "safe", "sail", "salad", "salmon" + , "salon", "salt", "salute", "same", "sample", "sand" + , "satisfy", "satoshi", "sauce", "sausage", "save", "say" + , "scale", "scan", "scare", "scatter", "scene", "scheme" + , "school", "science", "scissors", "scorpion", "scout", "scrap" + , "screen", "script", "scrub", "sea", "search", "season" + , "seat", "second", "secret", "section", "security", "seed" + , "seek", "segment", "select", "sell", "seminar", "senior" + , "sense", "sentence", "series", "service", "session", "settle" + , "setup", "seven", "shadow", "shaft", "shallow", "share" + , "shed", "shell", "sheriff", "shield", "shift", "shine" + , "ship", "shiver", "shock", "shoe", "shoot", "shop" + , "short", "shoulder", "shove", "shrimp", "shrug", "shuffle" + , "shy", "sibling", "sick", "side", "siege", "sight" + , "sign", "silent", "silk", "silly", "silver", "similar" + , "simple", "since", "sing", "siren", "sister", "situate" + , "six", "size", "skate", "sketch", "ski", "skill" + , "skin", "skirt", "skull", "slab", "slam", "sleep" + , "slender", "slice", "slide", "slight", "slim", "slogan" + , "slot", "slow", "slush", "small", "smart", "smile" + , "smoke", "smooth", "snack", "snake", "snap", "sniff" + , "snow", "soap", "soccer", "social", "sock", "soda" + , "soft", "solar", "soldier", "solid", "solution", "solve" + , "someone", "song", "soon", "sorry", "sort", "soul" + , "sound", "soup", "source", "south", "space", "spare" + , "spatial", "spawn", "speak", "special", "speed", "spell" + , "spend", "sphere", "spice", "spider", "spike", "spin" + , "spirit", "split", "spoil", "sponsor", "spoon", "sport" + , "spot", "spray", "spread", "spring", "spy", "square" + , "squeeze", "squirrel", "stable", "stadium", "staff", "stage" + , "stairs", "stamp", "stand", "start", "state", "stay" + , "steak", "steel", "stem", "step", "stereo", "stick" + , "still", "sting", "stock", "stomach", "stone", "stool" + , "story", "stove", "strategy", "street", "strike", "strong" + , "struggle", "student", "stuff", "stumble", "style", "subject" + , "submit", "subway", "success", "such", "sudden", "suffer" + , "sugar", "suggest", "suit", "summer", "sun", "sunny" + , "sunset", "super", "supply", "supreme", "sure", "surface" + , "surge", "surprise", "surround", "survey", "suspect", "sustain" + , "swallow", "swamp", "swap", "swarm", "swear", "sweet" + , "swift", "swim", "swing", "switch", "sword", "symbol" + , "symptom", "syrup", "system", "table", "tackle", "tag" + , "tail", "talent", "talk", "tank", "tape", "target" + , "task", "taste", "tattoo", "taxi", "teach", "team" + , "tell", "ten", "tenant", "tennis", "tent", "term" + , "test", "text", "thank", "that", "theme", "then" + , "theory", "there", "they", "thing", "this", "thought" + , "three", "thrive", "throw", "thumb", "thunder", "ticket" + , "tide", "tiger", "tilt", "timber", "time", "tiny" + , "tip", "tired", "tissue", "title", "toast", "tobacco" + , "today", "toddler", "toe", "together", "toilet", "token" + , "tomato", "tomorrow", "tone", "tongue", "tonight", "tool" + , "tooth", "top", "topic", "topple", "torch", "tornado" + , "tortoise", "toss", "total", "tourist", "toward", "tower" + , "town", "toy", "track", "trade", "traffic", "tragic" + , "train", "transfer", "trap", "trash", "travel", "tray" + , "treat", "tree", "trend", "trial", "tribe", "trick" + , "trigger", "trim", "trip", "trophy", "trouble", "truck" + , "true", "truly", "trumpet", "trust", "truth", "try" + , "tube", "tuition", "tumble", "tuna", "tunnel", "turkey" + , "turn", "turtle", "twelve", "twenty", "twice", "twin" + , "twist", "two", "type", "typical", "ugly", "umbrella" + , "unable", "unaware", "uncle", "uncover", "under", "undo" + , "unfair", "unfold", "unhappy", "uniform", "unique", "unit" + , "universe", "unknown", "unlock", "until", "unusual", "unveil" + , "update", "upgrade", "uphold", "upon", "upper", "upset" + , "urban", "urge", "usage", "use", "used", "useful" + , "useless", "usual", "utility", "vacant", "vacuum", "vague" + , "valid", "valley", "valve", "van", "vanish", "vapor" + , "various", "vast", "vault", "vehicle", "velvet", "vendor" + , "venture", "venue", "verb", "verify", "version", "very" + , "vessel", "veteran", "viable", "vibrant", "vicious", "victory" + , "video", "view", "village", "vintage", "violin", "virtual" + , "virus", "visa", "visit", "visual", "vital", "vivid" + , "vocal", "voice", "void", "volcano", "volume", "vote" + , "voyage", "wage", "wagon", "wait", "walk", "wall" + , "walnut", "want", "warfare", "warm", "warrior", "wash" + , "wasp", "waste", "water", "wave", "way", "wealth" + , "weapon", "wear", "weasel", "weather", "web", "wedding" + , "weekend", "weird", "welcome", "west", "wet", "whale" + , "what", "wheat", "wheel", "when", "where", "whip" + , "whisper", "wide", "width", "wife", "wild", "will" + , "win", "window", "wine", "wing", "wink", "winner" + , "winter", "wire", "wisdom", "wise", "wish", "witness" + , "wolf", "woman", "wonder", "wood", "wool", "word" + , "work", "world", "worry", "worth", "wrap", "wreck" + , "wrestle", "wrist", "write", "wrong", "yard", "year" + , "yellow", "you", "young", "youth", "zebra", "zero" + , "zone", "zoo" + ] diff --git a/src/Simplex/Messaging/Crypto/Secp256k1.hs b/src/Simplex/Messaging/Crypto/Secp256k1.hs new file mode 100644 index 000000000..dcdff54b4 --- /dev/null +++ b/src/Simplex/Messaging/Crypto/Secp256k1.hs @@ -0,0 +1,367 @@ +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | FFI bindings to libsecp256k1 (ECDSA over secp256k1 with public key recovery). +-- +-- Only what Ethereum signing needs: key validation, public key derivation and +-- serialization, scalar addition (for BIP-32 child derivation), recoverable +-- signing and recovery. +-- +-- Signatures are produced with libsecp256k1's default RFC-6979 deterministic +-- nonce, so signing is a pure function of (key, digest) — which is why this +-- module exposes a pure API over 'unsafePerformIO'. libsecp256k1 also always +-- emits the low-@s@ form, so every signature from 'signRecoverable' is already +-- EIP-2 compliant; 'isLowS' is provided so callers can assert that rather than +-- trust it. Note there is deliberately no normalization entry point: we never +-- accept a foreign signature, we only produce our own. +module Simplex.Messaging.Crypto.Secp256k1 + ( PrivateKey, + PublicKey, + RecoverableSignature (..), + PubKeyFormat (..), + mkPrivateKey, + unPrivateKey, + publicKey, + parsePublicKey, + serializePublicKey, + privateKeyTweakAdd, + publicKeyTweakMul, + publicKeyTweakAdd, + signRecoverable, + recoverPublicKey, + isLowS, + privateKeySize, + compressedSize, + uncompressedSize, + digestSize, + ) +where + +import Control.Monad (when) +import Crypto.Random (drgNew, randomBytesGenerate) +import qualified Data.ByteArray as BA +import qualified Data.ByteArray.Encoding as BAE +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as BC +import qualified Data.ByteString.Unsafe as BU +import Foreign +import Foreign.C +import System.IO.Unsafe (unsafePerformIO) + +-- Sizes + +-- | A secp256k1 scalar is 32 bytes, big-endian. +privateKeySize :: Int +privateKeySize = 32 + +-- | SEC1 compressed point: @0x02@/@0x03@ prefix and the x coordinate. +compressedSize :: Int +compressedSize = 33 + +-- | SEC1 uncompressed point: @0x04@ prefix, x, y. +uncompressedSize :: Int +uncompressedSize = 65 + +-- | ECDSA signs a 32-byte digest, never a message. +digestSize :: Int +digestSize = 32 + +-- | Internal size of @secp256k1_pubkey@ (opaque, not a serialization). +pubKeyInternalSize :: Int +pubKeyInternalSize = 64 + +-- | Internal size of @secp256k1_ecdsa_recoverable_signature@. +recSigInternalSize :: Int +recSigInternalSize = 65 + +compactSize :: Int +compactSize = 64 + +-- Types + +-- | A validated secp256k1 private key: 32 bytes, in @[1, n-1]@. +-- +-- 'Show' is redacting and 'Eq' is constant-time, both deliberately: this key +-- authorises transfers of assets with monetary value, so it must not reach a +-- log through a derived 'Show' and must not leak through comparison timing. +newtype PrivateKey = PrivateKey ByteString + +instance Show PrivateKey where + show _ = "PrivateKey " + +instance Eq PrivateKey where + PrivateKey a == PrivateKey b = BA.constEq a b + +-- | A parsed public key, held in libsecp256k1's opaque 64-byte internal form. +-- Use 'serializePublicKey' to get the SEC1 bytes. +newtype PublicKey = PublicKey ByteString + deriving newtype (Eq) + +instance Show PublicKey where + show pk = "PublicKey " <> BC.unpack (hex $ serializePublicKey Compressed pk) + +hex :: ByteString -> ByteString +hex = BAE.convertToBase BAE.Base16 + +-- | SEC1 output format for 'serializePublicKey'. +data PubKeyFormat = Compressed | Uncompressed + deriving (Eq, Show) + +-- | A signature plus the recovery id needed to recover the signing key. +-- @rsCompact@ is @r || s@, 64 bytes big-endian; @rsRecId@ is in @[0, 3]@. +-- Ethereum's @v@ is @rsRecId + 27@ (or @+ 35 + 2 * chainId@ for EIP-155). +data RecoverableSignature = RecoverableSignature + { rsCompact :: ByteString, + rsRecId :: Int + } + deriving (Eq, Show) + +-- FFI + +data Ctx + +data PubKeyRaw + +data RecSigRaw + +foreign import ccall "secp256k1_context_create" + c_context_create :: CUInt -> IO (Ptr Ctx) + +foreign import ccall "secp256k1_context_randomize" + c_context_randomize :: Ptr Ctx -> Ptr Word8 -> IO CInt + +foreign import ccall "secp256k1_ec_seckey_verify" + c_ec_seckey_verify :: Ptr Ctx -> Ptr Word8 -> IO CInt + +foreign import ccall "secp256k1_ec_pubkey_create" + c_ec_pubkey_create :: Ptr Ctx -> Ptr PubKeyRaw -> Ptr Word8 -> IO CInt + +foreign import ccall "secp256k1_ec_pubkey_parse" + c_ec_pubkey_parse :: Ptr Ctx -> Ptr PubKeyRaw -> Ptr Word8 -> CSize -> IO CInt + +foreign import ccall "secp256k1_ec_pubkey_serialize" + c_ec_pubkey_serialize :: Ptr Ctx -> Ptr Word8 -> Ptr CSize -> Ptr PubKeyRaw -> CUInt -> IO CInt + +foreign import ccall "secp256k1_ec_seckey_tweak_add" + c_ec_seckey_tweak_add :: Ptr Ctx -> Ptr Word8 -> Ptr Word8 -> IO CInt + +foreign import ccall "secp256k1_ec_pubkey_tweak_mul" + c_ec_pubkey_tweak_mul :: Ptr Ctx -> Ptr PubKeyRaw -> Ptr Word8 -> IO CInt +foreign import ccall "secp256k1_ec_pubkey_tweak_add" + c_ec_pubkey_tweak_add :: Ptr Ctx -> Ptr PubKeyRaw -> Ptr Word8 -> IO CInt + +foreign import ccall "secp256k1_ecdsa_sign_recoverable" + c_ecdsa_sign_recoverable :: Ptr Ctx -> Ptr RecSigRaw -> Ptr Word8 -> Ptr Word8 -> Ptr () -> Ptr () -> IO CInt + +foreign import ccall "secp256k1_ecdsa_recoverable_signature_serialize_compact" + c_recsig_serialize_compact :: Ptr Ctx -> Ptr Word8 -> Ptr CInt -> Ptr RecSigRaw -> IO CInt + +foreign import ccall "secp256k1_ecdsa_recoverable_signature_parse_compact" + c_recsig_parse_compact :: Ptr Ctx -> Ptr RecSigRaw -> Ptr Word8 -> CInt -> IO CInt + +foreign import ccall "secp256k1_ecdsa_recover" + c_ecdsa_recover :: Ptr Ctx -> Ptr PubKeyRaw -> Ptr RecSigRaw -> Ptr Word8 -> IO CInt + +-- SECP256K1_CONTEXT_NONE = SECP256K1_FLAGS_TYPE_CONTEXT +contextNone :: CUInt +contextNone = 1 + +-- SECP256K1_EC_COMPRESSED = SECP256K1_FLAGS_TYPE_COMPRESSION | SECP256K1_FLAGS_BIT_COMPRESSION +-- SECP256K1_EC_UNCOMPRESSED = SECP256K1_FLAGS_TYPE_COMPRESSION +formatFlag :: PubKeyFormat -> CUInt +formatFlag = \case + Compressed -> 2 .|. 256 + Uncompressed -> 2 + +-- | The process-wide context, created and blinded once. +-- +-- Randomization is a side-channel countermeasure only: it does not affect any +-- output, and signing does not mutate the context, so sharing one context +-- across threads is safe and the pure API below is sound. +secp256k1Ctx :: Ptr Ctx +secp256k1Ctx = unsafePerformIO $ do + ctx <- c_context_create contextNone + when (ctx == nullPtr) $ ioError (userError "secp256k1_context_create failed") + drg <- drgNew + let (seed :: ByteString, _) = randomBytesGenerate 32 drg + rc <- BU.unsafeUseAsCString seed $ \p -> c_context_randomize ctx (castPtr p) + when (rc /= 1) $ ioError (userError "secp256k1_context_randomize failed") + pure ctx +{-# NOINLINE secp256k1Ctx #-} + +-- Helpers + +withBS :: ByteString -> (Ptr Word8 -> IO a) -> IO a +withBS bs f = BU.unsafeUseAsCString bs $ f . castPtr + +packPtr :: Ptr Word8 -> Int -> IO ByteString +packPtr p n = B.packCStringLen (castPtr p, n) + +-- | Marshal a 'PublicKey' back into its opaque C representation. +withPubKeyRaw :: PublicKey -> (Ptr PubKeyRaw -> IO a) -> IO a +withPubKeyRaw (PublicKey bs) f = withBS bs $ f . castPtr + +-- | Marshal a 'RecoverableSignature' into the opaque C representation, failing +-- if libsecp256k1 rejects it. +withRecSigRaw :: RecoverableSignature -> (Ptr RecSigRaw -> IO (Either String a)) -> IO (Either String a) +withRecSigRaw (RecoverableSignature compact recId) f + | B.length compact /= compactSize = pure $ Left "signature: expected 64 bytes" + | recId < 0 || recId > 3 = pure $ Left "signature: recovery id out of range" + | otherwise = + allocaBytes recSigInternalSize $ \sigPtr -> + withBS compact $ \cPtr -> do + rc <- c_recsig_parse_compact secp256k1Ctx sigPtr cPtr (fromIntegral recId) + if rc /= 1 then pure $ Left "signature: malformed" else f sigPtr + +-- Public API + +-- | Validate 32 bytes as a private key. Rejects zero and anything at or above +-- the group order, which is what makes 'publicKey' and 'signRecoverable' total. +mkPrivateKey :: ByteString -> Either String PrivateKey +mkPrivateKey bs + | B.length bs /= privateKeySize = Left $ "private key: expected 32 bytes, got " <> show (B.length bs) + | otherwise = unsafePerformIO $ withBS bs $ \p -> do + rc <- c_ec_seckey_verify secp256k1Ctx p + pure $ if rc == 1 then Right (PrivateKey bs) else Left "private key: not in [1, n-1]" + +unPrivateKey :: PrivateKey -> ByteString +unPrivateKey (PrivateKey bs) = bs + +-- | Derive the public key. Total, because 'PrivateKey' is validated. +publicKey :: PrivateKey -> PublicKey +publicKey (PrivateKey sk) = unsafePerformIO $ + allocaBytes pubKeyInternalSize $ \pkPtr -> + withBS sk $ \skPtr -> do + rc <- c_ec_pubkey_create secp256k1Ctx pkPtr skPtr + -- Cannot fail: the key was verified by mkPrivateKey. + when (rc /= 1) $ ioError (userError "secp256k1_ec_pubkey_create failed on a validated key") + PublicKey <$> packPtr (castPtr pkPtr) pubKeyInternalSize + +-- | Parse a SEC1 point, compressed (33 bytes) or uncompressed (65 bytes). +parsePublicKey :: ByteString -> Either String PublicKey +parsePublicKey bs + | len /= compressedSize && len /= uncompressedSize = + Left $ "public key: expected 33 or 65 bytes, got " <> show len + | otherwise = unsafePerformIO $ + allocaBytes pubKeyInternalSize $ \pkPtr -> + withBS bs $ \inPtr -> do + rc <- c_ec_pubkey_parse secp256k1Ctx pkPtr inPtr (fromIntegral len) + if rc == 1 + then Right . PublicKey <$> packPtr (castPtr pkPtr) pubKeyInternalSize + else pure $ Left "public key: not a valid curve point" + where + len = B.length bs + +serializePublicKey :: PubKeyFormat -> PublicKey -> ByteString +serializePublicKey fmt pk = unsafePerformIO $ + allocaBytes outLen $ \outPtr -> + alloca $ \lenPtr -> + withPubKeyRaw pk $ \pkPtr -> do + poke lenPtr (fromIntegral outLen) + rc <- c_ec_pubkey_serialize secp256k1Ctx outPtr lenPtr pkPtr (formatFlag fmt) + when (rc /= 1) $ ioError (userError "secp256k1_ec_pubkey_serialize failed") + written <- peek lenPtr + packPtr outPtr (fromIntegral written) + where + outLen = case fmt of + Compressed -> compressedSize + Uncompressed -> uncompressedSize + +-- | @sk + tweak mod n@, as BIP-32 child derivation needs. +-- +-- 'Nothing' when the result is zero or the tweak is out of range — BIP-32 +-- requires the caller to skip to the next child index in that case. +privateKeyTweakAdd :: PrivateKey -> ByteString -> Maybe PrivateKey +privateKeyTweakAdd (PrivateKey sk) tweak + | B.length tweak /= privateKeySize = Nothing + | otherwise = unsafePerformIO $ + allocaBytes privateKeySize $ \skPtr -> + withBS tweak $ \twPtr -> do + withBS sk $ \src -> copyBytes skPtr src privateKeySize + rc <- c_ec_seckey_tweak_add secp256k1Ctx skPtr twPtr + if rc == 1 + then Just . PrivateKey <$> packPtr skPtr privateKeySize + else pure Nothing + +-- | @tweak * P@. The scalar multiplication behind an ECDH shared secret. +-- +-- Deliberately exposed instead of @secp256k1_ecdh@: that function hashes the +-- resulting point with SHA-256, while ERC-5564 hashes it with keccak256 over +-- the uncompressed coordinates. Returning the point leaves the hash to the +-- caller. +-- +-- 'Nothing' when the tweak is zero or out of range. +publicKeyTweakMul :: PublicKey -> ByteString -> Maybe PublicKey +publicKeyTweakMul = tweakPubKey c_ec_pubkey_tweak_mul + +-- | @P + tweak * G@, the point addition stealth address derivation needs. +-- +-- 'Nothing' when the tweak is out of range or the result is the point at +-- infinity. +publicKeyTweakAdd :: PublicKey -> ByteString -> Maybe PublicKey +publicKeyTweakAdd = tweakPubKey c_ec_pubkey_tweak_add + +tweakPubKey :: (Ptr Ctx -> Ptr PubKeyRaw -> Ptr Word8 -> IO CInt) -> PublicKey -> ByteString -> Maybe PublicKey +tweakPubKey f pk tweak + | B.length tweak /= privateKeySize = Nothing + | otherwise = unsafePerformIO $ + allocaBytes pubKeyInternalSize $ \pkPtr -> + withBS tweak $ \twPtr -> do + withPubKeyRaw pk $ \src -> copyBytes (castPtr pkPtr) (castPtr src) pubKeyInternalSize + rc <- f secp256k1Ctx pkPtr twPtr + if rc == 1 + then Just . PublicKey <$> packPtr (castPtr pkPtr) pubKeyInternalSize + else pure Nothing + +-- | Sign a 32-byte digest. Deterministic (RFC 6979) and always low-@s@. +signRecoverable :: PrivateKey -> ByteString -> Either String RecoverableSignature +signRecoverable (PrivateKey sk) digest + | B.length digest /= digestSize = + Left $ "digest: expected 32 bytes, got " <> show (B.length digest) + | otherwise = unsafePerformIO $ + allocaBytes recSigInternalSize $ \sigPtr -> + withBS digest $ \msgPtr -> + withBS sk $ \skPtr -> do + rc <- c_ecdsa_sign_recoverable secp256k1Ctx sigPtr msgPtr skPtr nullPtr nullPtr + if rc /= 1 + then pure $ Left "secp256k1_ecdsa_sign_recoverable failed" + else allocaBytes compactSize $ \outPtr -> + alloca $ \recIdPtr -> do + rc' <- c_recsig_serialize_compact secp256k1Ctx outPtr recIdPtr sigPtr + if rc' /= 1 + then pure $ Left "secp256k1_ecdsa_recoverable_signature_serialize_compact failed" + else do + compact <- packPtr outPtr compactSize + recId <- peek recIdPtr + pure $ Right RecoverableSignature {rsCompact = compact, rsRecId = fromIntegral recId} + +-- | Recover the signing public key from a signature and the digest it signed. +recoverPublicKey :: RecoverableSignature -> ByteString -> Either String PublicKey +recoverPublicKey sig digest + | B.length digest /= digestSize = + Left $ "digest: expected 32 bytes, got " <> show (B.length digest) + | otherwise = unsafePerformIO $ + withRecSigRaw sig $ \sigPtr -> + allocaBytes pubKeyInternalSize $ \pkPtr -> + withBS digest $ \msgPtr -> do + rc <- c_ecdsa_recover secp256k1Ctx pkPtr sigPtr msgPtr + if rc == 1 + then Right . PublicKey <$> packPtr (castPtr pkPtr) pubKeyInternalSize + else pure $ Left "secp256k1_ecdsa_recover failed" + +-- | Whether @s <= n/2@, i.e. the signature is in the canonical form EIP-2 +-- requires. libsecp256k1 guarantees this for anything it signs; this exists so +-- tests can assert it rather than assume it. +isLowS :: RecoverableSignature -> Bool +isLowS (RecoverableSignature compact _) = + B.length compact == compactSize && beToInteger (B.drop 32 compact) <= halfOrder + where + halfOrder :: Integer + halfOrder = 0x7FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF5D576E7357A4501DDFE92F46681B20A0 + +beToInteger :: ByteString -> Integer +beToInteger = B.foldl' (\acc w -> acc * 256 + fromIntegral w) 0 diff --git a/src/Simplex/Messaging/Eth/Address.hs b/src/Simplex/Messaging/Eth/Address.hs new file mode 100644 index 000000000..6ae606b0d --- /dev/null +++ b/src/Simplex/Messaging/Eth/Address.hs @@ -0,0 +1,114 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | Ethereum addresses: derivation from a public key, and EIP-55 mixed-case +-- checksum encoding. +module Simplex.Messaging.Eth.Address + ( Address, + unAddress, + mkAddress, + addressFromPublicKey, + addressFromPrivateKey, + checksumAddress, + parseAddress, + addressSize, + ethereumPath, + ) +where + +import Data.Bits (shiftR, (.&.)) +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as BC +import Data.Char (isDigit, isHexDigit, isLower, isUpper, toLower) +import Data.Word (Word32, Word8) +import Simplex.Messaging.Crypto.BIP32 (hardened) +import qualified Simplex.Messaging.Crypto.Secp256k1 as S +import Simplex.Messaging.Eth.Keccak (keccak256) + +-- | A 20-byte Ethereum address. 'Show' renders the EIP-55 checksummed form, +-- which is what a user would paste into a block explorer. +newtype Address = Address ByteString + deriving (Eq, Ord) + +instance Show Address where + show = BC.unpack . checksumAddress + +addressSize :: Int +addressSize = 20 + +unAddress :: Address -> ByteString +unAddress (Address bs) = bs + +mkAddress :: ByteString -> Either String Address +mkAddress bs + | B.length bs /= addressSize = Left $ "address: expected 20 bytes, got " <> show (B.length bs) + | otherwise = Right (Address bs) + +-- | The low 20 bytes of @keccak256@ of the uncompressed public key with its +-- @0x04@ SEC1 prefix removed. +addressFromPublicKey :: S.PublicKey -> Address +addressFromPublicKey pk = + Address . B.drop 12 . keccak256 . B.drop 1 $ S.serializePublicKey S.Uncompressed pk + +addressFromPrivateKey :: S.PrivateKey -> Address +addressFromPrivateKey = addressFromPublicKey . S.publicKey + +-- | EIP-55: @0x@ followed by 40 hex digits whose case encodes a checksum over +-- the lowercase hex form. +checksumAddress :: Address -> ByteString +checksumAddress (Address bs) = "0x" <> B.pack (zipWith adjust [0 ..] lowerHex) + where + lowerHex = B.unpack (toHex bs) + hashed = keccak256 (B.pack lowerHex) + adjust :: Int -> Word8 -> Word8 + adjust i c + | isHexLetter c && nibbleAt i >= 8 = upper c + | otherwise = c + nibbleAt i = + let byte = B.index hashed (i `div` 2) + in if even i then byte `shiftR` 4 else byte .&. 0x0F + isHexLetter c = c >= 0x61 && c <= 0x66 -- 'a'..'f' + upper c = c - 0x20 + +-- | Parse @0x@-prefixed or bare hex. A mixed-case address is checked against +-- its EIP-55 checksum; an all-lowercase or all-uppercase one carries no +-- checksum and is accepted as-is, which is what every Ethereum client does. +parseAddress :: ByteString -> Either String Address +parseAddress s + | B.length body /= 40 = Left $ "address: expected 40 hex digits, got " <> show (B.length body) + | not (BC.all isHexDigit body) = Left "address: not hexadecimal" + | mixedCase && checksumAddress addr /= "0x" <> body = Left "address: EIP-55 checksum mismatch" + | otherwise = Right addr + where + body = if "0x" `B.isPrefixOf` s || "0X" `B.isPrefixOf` s then B.drop 2 s else s + bodyC = BC.unpack body + letters = filter (not . isDigit) bodyC + mixedCase = any isUpper letters && any isLower letters + addr = Address (fromHex (BC.map toLower body)) + +-- | BIP-44 path for Ethereum account @i@: @m\/44'\/60'\/i'\/0\/0@. +ethereumPath :: Word32 -> [Word32] +ethereumPath account = [hardened 44, hardened 60, hardened account, 0, 0] + +-- Hex helpers, local so that Address does not depend on a base16 package and +-- the case handling stays explicit (EIP-55 is entirely about case). + +toHex :: ByteString -> ByteString +toHex = B.concatMap (\w -> B.pack [hexDigit (w `shiftR` 4), hexDigit (w .&. 0x0F)]) + where + hexDigit n + | n < 10 = 0x30 + n + | otherwise = 0x57 + n -- 'a' - 10 + +-- | Assumes a validated even-length lowercase hex string. +fromHex :: ByteString -> ByteString +fromHex bs = B.pack $ go (B.unpack bs) + where + go (h : l : rest) = (nibble h * 16 + nibble l) : go rest + go _ = [] + nibble w + | w >= 0x30 && w <= 0x39 = w - 0x30 + | w >= 0x61 && w <= 0x66 = w - 0x57 + | w >= 0x41 && w <= 0x46 = w - 0x37 + | otherwise = 0 diff --git a/src/Simplex/Messaging/Eth/EIP712.hs b/src/Simplex/Messaging/Eth/EIP712.hs new file mode 100644 index 000000000..b09e6ac4e --- /dev/null +++ b/src/Simplex/Messaging/Eth/EIP712.hs @@ -0,0 +1,122 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | EIP-712 typed structured data hashing. +-- +-- This implements the hashing half of EIP-712 — @typeHash@, @encodeData@, +-- @hashStruct@ and the final @0x19 0x01@ digest — over an explicit list of +-- member values. It deliberately does *not* derive the canonical type string +-- from a schema: the caller supplies it. Our structs are a handful of fixed +-- shapes agreed with the contracts, and a hand-written type string that is +-- checked against Solidity in a test is both simpler and easier to audit than a +-- schema encoder whose output nobody reads. +-- +-- The type string must be the EIP-712 canonical encoding: no spaces after +-- commas, member type and name separated by one space, and any referenced +-- struct types appended in alphabetical order. For example: +-- +-- > "TransferName(address from,address to,uint256 tokenId,uint256 nonce,uint256 deadline)" +module Simplex.Messaging.Eth.EIP712 + ( Eip712Domain (..), + Value (..), + typeHash, + encodeValue, + encodeData, + hashStruct, + domainSeparator, + hashTypedData, + ) +where + +import Data.Bits (shiftR, (.&.)) +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import Simplex.Messaging.Eth.Address (Address, unAddress) +import Simplex.Messaging.Eth.Keccak (keccak256) + +-- | The standard EIP-712 domain. All four fields are used; the spec allows +-- omitting any of them, but every contract in this project includes all four, +-- and fixing the shape keeps 'domainSeparator' total. +data Eip712Domain = Eip712Domain + { edName :: ByteString, + edVersion :: ByteString, + edChainId :: Integer, + edVerifyingContract :: Address + } + deriving (Eq, Show) + +-- | A struct member value, in the EIP-712 sense. +-- +-- 'VStruct' takes an already-computed 'hashStruct' result, which is how nested +-- structs are encoded; 'VArray' hashes the concatenation of its members. +data Value + = VUint Integer + | VInt Integer + | VBool Bool + | VAddress Address + | -- | @bytesN@ for @N@ in @[1, 32]@, left-aligned and zero-padded. + VFixedBytes ByteString + | -- | Dynamic @bytes@. + VBytes ByteString + | -- | @string@; the caller supplies UTF-8 bytes. + VString ByteString + | VArray [Value] + | -- | A nested struct, given as its 32-byte @hashStruct@. + VStruct ByteString + deriving (Eq, Show) + +-- | @keccak256@ of the canonical type string. +typeHash :: ByteString -> ByteString +typeHash = keccak256 + +-- | Encode one member as exactly 32 bytes. +encodeValue :: Value -> Either String ByteString +encodeValue = \case + VUint n + | n < 0 || n >= two256 -> Left $ "eip712: uint256 out of range: " <> show n + | otherwise -> Right (word256 n) + VInt n + | n < negate two255 || n >= two255 -> Left $ "eip712: int256 out of range: " <> show n + | otherwise -> Right (word256 (if n < 0 then n + two256 else n)) + VBool b -> Right (word256 (if b then 1 else 0)) + VAddress a -> Right (B.replicate 12 0 <> unAddress a) + VFixedBytes bs + | B.null bs || B.length bs > 32 -> Left $ "eip712: bytesN length " <> show (B.length bs) + | otherwise -> Right (bs <> B.replicate (32 - B.length bs) 0) + VBytes bs -> Right (keccak256 bs) + VString bs -> Right (keccak256 bs) + VArray vs -> keccak256 . B.concat <$> traverse encodeValue vs + VStruct h + | B.length h /= 32 -> Left $ "eip712: struct hash must be 32 bytes, got " <> show (B.length h) + | otherwise -> Right h + where + two256 = 2 ^ (256 :: Int) :: Integer + two255 = 2 ^ (255 :: Int) :: Integer + +encodeData :: [Value] -> Either String ByteString +encodeData vs = B.concat <$> traverse encodeValue vs + +-- | @keccak256(typeHash ‖ encodeData(members))@. +hashStruct :: ByteString -> [Value] -> Either String ByteString +hashStruct typeString members = keccak256 . (typeHash typeString <>) <$> encodeData members + +domainSeparator :: Eip712Domain -> Either String ByteString +domainSeparator d = + hashStruct + "EIP712Domain(string name,string version,uint256 chainId,address verifyingContract)" + [ VString (edName d), + VString (edVersion d), + VUint (edChainId d), + VAddress (edVerifyingContract d) + ] + +-- | The final digest to sign: @keccak256(0x19 ‖ 0x01 ‖ domainSeparator ‖ hashStruct)@. +hashTypedData :: Eip712Domain -> ByteString -> [Value] -> Either String ByteString +hashTypedData d typeString members = do + ds <- domainSeparator d + hs <- hashStruct typeString members + pure $ keccak256 (B.pack [0x19, 0x01] <> ds <> hs) + +word256 :: Integer -> ByteString +word256 x = B.pack [fromIntegral ((x `shiftR` (8 * (31 - i))) .&. 0xFF) | i <- [0 .. 31]] diff --git a/src/Simplex/Messaging/Eth/Keccak.hs b/src/Simplex/Messaging/Eth/Keccak.hs new file mode 100644 index 000000000..763eac0fb --- /dev/null +++ b/src/Simplex/Messaging/Eth/Keccak.hs @@ -0,0 +1,23 @@ +-- | Keccak-256 — the hash Ethereum uses everywhere. +-- +-- This is *not* SHA3-256. The two differ only in the padding byte (0x01 vs +-- 0x06) and produce completely different digests, and crypton exposes both as +-- @Keccak_256@ and @SHA3_256@. Confusing them is the classic way to write an +-- Ethereum implementation that is wrong in a way nothing catches until a +-- signature is rejected on-chain, so every Ethereum hash in this codebase goes +-- through this module rather than reaching for @Crypto.Hash@ directly. +module Simplex.Messaging.Eth.Keccak + ( keccak256, + keccak256Size, + ) +where + +import Crypto.Hash (Digest, Keccak_256, hash) +import qualified Data.ByteArray as BA +import Data.ByteString (ByteString) + +keccak256 :: ByteString -> ByteString +keccak256 bs = BA.convert (hash bs :: Digest Keccak_256) + +keccak256Size :: Int +keccak256Size = 32 diff --git a/src/Simplex/Messaging/Eth/Stealth.hs b/src/Simplex/Messaging/Eth/Stealth.hs new file mode 100644 index 000000000..5e896803d --- /dev/null +++ b/src/Simplex/Messaging/Eth/Stealth.hs @@ -0,0 +1,147 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | ERC-5564 stealth addresses on secp256k1, scheme id 1 ("with view tags"). +-- +-- A recipient publishes a __meta-address__: two public keys, spending and +-- viewing. A sender picks a random ephemeral key, derives a one-time address +-- from it and the meta-address, and publishes the ephemeral public key. Only +-- the recipient — who holds the viewing key — can tell which one-time addresses +-- are theirs, and only they can spend from them. +-- +-- The meta-address is not an address and never appears on chain, so publishing +-- it discloses nothing beyond the ability to send to its owner. +-- +-- == Interoperability +-- +-- ERC-5564 specifies the algebra but /not/ how the shared-secret point is +-- serialized before hashing, nor which hash is used. Those come from the EIP +-- author's reference implementation +-- ( @minimal_poc.ipynb@): +-- +-- * the shared secret point is serialized __uncompressed with no SEC1 prefix__, +-- as @x || y@, 64 bytes; +-- * it is hashed with __keccak256__, not SHA-256 — which is why this module +-- multiplies points directly rather than calling @secp256k1_ecdh@, whose +-- built-in hash is SHA-256; +-- * the __view tag is the first byte__ of that hash. +-- +-- Encoding the point the same way an Ethereum address encodes a public key is +-- not a coincidence, and it means 'Simplex.Messaging.Eth.Address' already +-- performs the last step unchanged. +module Simplex.Messaging.Eth.Stealth + ( StealthMetaAddress (..), + ViewTag, + StealthDestination (..), + metaAddress, + metaAddressBytes, + parseMetaAddress, + metaAddressSize, + stealthDestination, + stealthMatch, + stealthPrivateKey, + sharedSecretHash, + ) +where + +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import Data.Word (Word8) +import Simplex.Messaging.Eth.Address (Address, addressFromPublicKey) +import Simplex.Messaging.Eth.Keccak (keccak256) +import qualified Simplex.Messaging.Crypto.Secp256k1 as S + +-- | A recipient's published key pair: spending key, then viewing key. +data StealthMetaAddress = StealthMetaAddress + { smaSpend :: S.PublicKey, + smaView :: S.PublicKey + } + deriving (Eq, Show) + +-- | The first byte of the hashed shared secret. Lets a recipient discard about +-- 255 announcements in 256 with one point multiplication and one hash, instead +-- of also deriving an address for each. +type ViewTag = Word8 + +-- | What a sender produces and publishes. +data StealthDestination = StealthDestination + { -- | Where to send. Unlinkable to the meta-address it came from. + sdAddress :: Address, + -- | The ephemeral public key, compressed. Must reach the recipient, either + -- in an announcement event or a message, or the destination is + -- undiscoverable. + sdEphemeralPubKey :: ByteString, + sdViewTag :: ViewTag + } + deriving (Eq, Show) + +metaAddress :: S.PrivateKey -> S.PrivateKey -> StealthMetaAddress +metaAddress spend view = + StealthMetaAddress {smaSpend = S.publicKey spend, smaView = S.publicKey view} + +metaAddressSize :: Int +metaAddressSize = 2 * S.compressedSize + +-- | Spending key then viewing key, both compressed. 66 bytes. +metaAddressBytes :: StealthMetaAddress -> ByteString +metaAddressBytes ma = pub (smaSpend ma) <> pub (smaView ma) + where + pub = S.serializePublicKey S.Compressed + +parseMetaAddress :: ByteString -> Either String StealthMetaAddress +parseMetaAddress bs + | B.length bs /= metaAddressSize = + Left $ "meta-address: expected " <> show metaAddressSize <> " bytes, got " <> show (B.length bs) + | otherwise = do + let (spend, view) = B.splitAt S.compressedSize bs + StealthMetaAddress <$> S.parsePublicKey spend <*> S.parsePublicKey view + +-- | @keccak256(x || y)@ of @sk * P@ — the value both sides arrive at, the +-- sender from the ephemeral key and the recipient from the viewing key. +sharedSecretHash :: S.PrivateKey -> S.PublicKey -> Either String ByteString +sharedSecretHash sk pk = + case S.publicKeyTweakMul pk (S.unPrivateKey sk) of + Nothing -> Left "stealth: shared secret is not a valid point" + Just p -> Right . keccak256 . B.drop 1 $ S.serializePublicKey S.Uncompressed p + +-- | Sender side. @ephemeral@ must be freshly random and used once: reusing it +-- across recipients lets them link the destinations, and reusing it for one +-- recipient produces the same address twice. +stealthDestination :: S.PrivateKey -> StealthMetaAddress -> Either String StealthDestination +stealthDestination ephemeral ma = do + sh <- sharedSecretHash ephemeral (smaView ma) + stealthPub <- tweakSpend (smaSpend ma) sh + pure + StealthDestination + { sdAddress = addressFromPublicKey stealthPub, + sdEphemeralPubKey = S.serializePublicKey S.Compressed (S.publicKey ephemeral), + sdViewTag = B.head sh + } + +-- | Recipient side. Returns the address when this announcement is ours. +-- +-- The view tag is checked before the point addition, which is the whole reason +-- it exists — a non-match costs one multiplication and one hash. +stealthMatch :: S.PrivateKey -> S.PublicKey -> ByteString -> ViewTag -> Either String (Maybe Address) +stealthMatch view spend ephemeralPub tag = do + eph <- S.parsePublicKey ephemeralPub + sh <- sharedSecretHash view eph + if B.head sh /= tag + then pure Nothing + else Just . addressFromPublicKey <$> tweakSpend spend sh + +-- | Recipient side. The key that controls a matched destination: @p_spend + s_h@. +-- +-- Needs the spending key, which is why a viewing key can be delegated for +-- scanning without granting the ability to spend. +stealthPrivateKey :: S.PrivateKey -> S.PrivateKey -> ByteString -> Either String S.PrivateKey +stealthPrivateKey spend view ephemeralPub = do + eph <- S.parsePublicKey ephemeralPub + sh <- sharedSecretHash view eph + case S.privateKeyTweakAdd spend sh of + Nothing -> Left "stealth: derived key out of range" + Just sk -> Right sk + +tweakSpend :: S.PublicKey -> ByteString -> Either String S.PublicKey +tweakSpend spend sh = case S.publicKeyTweakAdd spend sh of + Nothing -> Left "stealth: derived point out of range" + Just p -> Right p diff --git a/tests/CoreTests/EthCryptoTests.hs b/tests/CoreTests/EthCryptoTests.hs new file mode 100644 index 000000000..7f3841be2 --- /dev/null +++ b/tests/CoreTests/EthCryptoTests.hs @@ -0,0 +1,502 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | Tests for the Ethereum crypto primitives: secp256k1, BIP-39, BIP-32, +-- Keccak-256, EIP-55 and EIP-712. +-- +-- Everything here is checked against published vectors rather than against our +-- own output: the official BIP-39 English vectors, BIP-32 spec test vectors 1 +-- and 2 (expected private keys and chain codes decoded from the published +-- @xprv@ strings), the EIP-55 spec addresses, and the @Mail@ example from the +-- EIP-712 spec. +module CoreTests.EthCryptoTests (ethCryptoTests) where + +import Control.Concurrent.STM (atomically) +import Control.Monad (forM_) +import qualified Data.ByteArray.Encoding as BAE +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as BC +import Data.Either (isLeft) +import Data.Word (Word32) +import qualified Simplex.Messaging.Crypto as C +import qualified Simplex.Messaging.Crypto.BIP32 as B32 +import qualified Simplex.Messaging.Crypto.BIP39 as B39 +import qualified Simplex.Messaging.Crypto.Secp256k1 as S +import Simplex.Messaging.Eth.Address +import Simplex.Messaging.Eth.EIP712 +import Simplex.Messaging.Eth.Keccak (keccak256) +import Simplex.Messaging.Eth.Stealth +import Test.Hspec hiding (fit, it) +import Util + +ethCryptoTests :: Spec +ethCryptoTests = do + describe "Keccak-256" keccakTests + describe "secp256k1" secp256k1Tests + describe "BIP-39" bip39Tests + describe "BIP-32" bip32Tests + describe "BIP-44 derivation" derivationTests + describe "EIP-55 addresses" eip55Tests + describe "EIP-712 typed data" eip712Tests + describe "ERC-5564 stealth addresses" stealthTests + +-- helpers + +hx :: ByteString -> ByteString +hx s = either (const $ error $ "bad hex literal: " <> BC.unpack s) id $ BAE.convertFromBase BAE.Base16 s + +toHex :: ByteString -> ByteString +toHex = BAE.convertToBase BAE.Base16 + +right :: Either String a -> a +right = either (error . ("unexpected Left: " <>)) id + +hardened' :: Word32 -> Word32 +hardened' = B32.hardened + +keccakTests :: Spec +keccakTests = do + it "hashes the empty string" $ + toHex (keccak256 "") `shouldBe` "c5d2460186f7233c927e7db2dcc703c0e500b653ca82273b7bfad8045d85a470" + it "hashes abc" $ + toHex (keccak256 "abc") `shouldBe` "4e03657aea45a94fc7d47ba826c8d667c0d1e6e33a64a036ec44f58fa12d6c45" + it "is Keccak-256, not SHA3-256" $ + -- SHA3-256 of the empty string, which differs only in the padding byte + toHex (keccak256 "") `shouldNotBe` "a7ffc6f8bf1ed76651c14756a061d662f580ff4de43b49fa82d80a4b80f8434a" + +secp256k1Tests :: Spec +secp256k1Tests = do + it "derives the known address for a known key" $ + show (addressFromPrivateKey testKey) `shouldBe` "0x2c7536E3605D9C16a7a3D7b1898e529396a65c23" + it "signs deterministically (RFC 6979)" $ + right (S.signRecoverable testKey testDigest) `shouldBe` testSig + it "produces low-s signatures (EIP-2)" $ + S.isLowS testSig `shouldBe` True + it "recovers the signing key" $ + right (S.recoverPublicKey testSig testDigest) `shouldBe` S.publicKey testKey + it "does not recover the signing key from another digest" $ + S.recoverPublicKey testSig (keccak256 "SimpleX names ") `shouldNotBe` Right (S.publicKey testKey) + it "round-trips a compressed public key" $ do + let pk = S.publicKey testKey + ser = S.serializePublicKey S.Compressed pk + B.length ser `shouldBe` 33 + S.parsePublicKey ser `shouldBe` Right pk + it "round-trips an uncompressed public key" $ do + let pk = S.publicKey testKey + ser = S.serializePublicKey S.Uncompressed pk + B.length ser `shouldBe` 65 + S.parsePublicKey ser `shouldBe` Right pk + it "rejects a zero private key" $ + S.mkPrivateKey (B.replicate 32 0) `shouldSatisfy` isLeft + it "rejects a private key at the group order" $ + S.mkPrivateKey (hx "fffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364141") `shouldSatisfy` isLeft + it "rejects a short private key" $ + S.mkPrivateKey (B.replicate 31 1) `shouldSatisfy` isLeft + it "rejects a digest that is not 32 bytes" $ + S.signRecoverable testKey (B.replicate 31 0) `shouldSatisfy` isLeft + it "rejects a malformed public key" $ + S.parsePublicKey (B.replicate 33 0) `shouldSatisfy` isLeft + it "redacts the private key in Show" $ + show testKey `shouldBe` "PrivateKey " + it "adds a tweak to a private key" $ + (toHex . S.unPrivateKey <$> S.privateKeyTweakAdd testKey (B.replicate 31 0 <> B.singleton 1)) + `shouldBe` Just "4c0883a69102937d6231471b5dbb6204fe5129617082792ae468d01a3f362319" + where + testKey = right $ S.mkPrivateKey (hx "4c0883a69102937d6231471b5dbb6204fe5129617082792ae468d01a3f362318") + testDigest = keccak256 "SimpleX names" + testSig = right $ S.signRecoverable testKey testDigest + +bip39Tests :: Spec +bip39Tests = do + describe "official English vectors" $ + forM_ (zip [0 :: Int ..] bip39Vectors) $ \(i, (entHex, phrase, seedHex)) -> + it ("vector " <> show i) $ do + let m = right $ B39.entropyToMnemonic (hx entHex) + p = right $ B39.parseMnemonic phrase + B39.mnemonicPhrase m `shouldBe` phrase + toHex (B39.mnemonicToEntropy p) `shouldBe` entHex + toHex (B39.mnemonicToSeed p "TREZOR") `shouldBe` seedHex + it "has a 2048-word list" $ + B39.wordListSize `shouldBe` 2048 + it "maps strengths to word counts" $ + map B39.strengthWordCount [minBound .. maxBound] `shouldBe` [12, 15, 18, 21, 24] + it "rejects a bad checksum" $ + B39.parseMnemonic "abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon" + `shouldSatisfy` isLeft + it "rejects a word outside the list" $ + B39.parseMnemonic "abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon simplex" + `shouldSatisfy` isLeft + it "rejects a wrong word count" $ + B39.parseMnemonic "abandon abandon about" `shouldSatisfy` isLeft + it "accepts a capitalised phrase and normalises it" $ + (B39.mnemonicPhrase <$> B39.parseMnemonic "Abandon ABANDON abandon abandon abandon abandon abandon abandon abandon abandon abandon About") + `shouldBe` Right canonicalPhrase + it "accepts extra whitespace" $ + B39.parseMnemonic " abandon\tabandon abandon abandon abandon abandon abandon abandon abandon abandon abandon about " + `shouldBe` B39.parseMnemonic canonicalPhrase + it "rejects an invalid entropy size" $ + B39.entropyToMnemonic (B.replicate 17 0) `shouldSatisfy` isLeft + it "generates mnemonics that parse back" $ do + g <- C.newRandom + forM_ [minBound .. maxBound] $ \s -> do + m <- atomically $ B39.randomMnemonic s g + length (B39.mnemonicWords m) `shouldBe` B39.strengthWordCount s + B39.parseMnemonic (B39.mnemonicPhrase m) `shouldBe` Right m + it "redacts the mnemonic in Show" $ do + g <- C.newRandom + m <- atomically $ B39.randomMnemonic B39.MS128 g + show m `shouldBe` "Mnemonic <12 words, redacted>" + +canonicalPhrase :: ByteString +canonicalPhrase = "abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon about" + +bip32Tests :: Spec +bip32Tests = do + describe "spec test vector 1" $ + forM_ vector1 $ \(name, path, keyHex, ccHex) -> + it name $ do + let xk = right $ B32.derivePath master1 path + toHex (S.unPrivateKey $ B32.xkKey xk) `shouldBe` keyHex + toHex (B32.xkChainCode xk) `shouldBe` ccHex + it "spec test vector 2, chain m" $ do + toHex (S.unPrivateKey $ B32.xkKey master2) `shouldBe` "4b03d6fc340455b363f51020ad3ecca4f0850280cf436c70c727923f6db46c3e" + toHex (B32.xkChainCode master2) `shouldBe` "60499f801b896d83179a4374aeb7822aaeaceaa0db1f85ee3e904c4defbd9689" + it "rejects a seed shorter than 16 bytes" $ + B32.masterKey (B.replicate 15 1) `shouldSatisfy` isLeft + it "rejects a seed longer than 64 bytes" $ + B32.masterKey (B.replicate 65 1) `shouldSatisfy` isLeft + it "redacts the extended key in Show" $ + show master2 `shouldBe` "ExtendedKey " + describe "path parsing" $ do + it "parses a BIP-44 path" $ + B32.parsePath "m/44'/60'/0'/0/0" `shouldBe` Right [hardened' 44, hardened' 60, hardened' 0, 0, 0] + it "accepts h as the hardened marker" $ + B32.parsePath "m/44h/60h/2h/0/1" `shouldBe` Right [hardened' 44, hardened' 60, hardened' 2, 0, 1] + it "accepts a path without the leading m" $ + B32.parsePath "44'/60'" `shouldBe` Right [hardened' 44, hardened' 60] + it "renders a path" $ + B32.renderPath [hardened' 44, hardened' 60, hardened' 0, 0, 0] `shouldBe` "m/44'/60'/0'/0/0" + it "round-trips render and parse" $ + B32.parsePath (B32.renderPath (ethereumPath 7)) `shouldBe` Right (ethereumPath 7) + it "rejects a non-numeric component" $ + B32.parsePath "m/44x/60" `shouldSatisfy` isLeft + it "rejects an index at the hardened boundary" $ + B32.parsePath "m/2147483648" `shouldSatisfy` isLeft + where + master1 = right $ B32.masterKey (hx "000102030405060708090a0b0c0d0e0f") + master2 = + right . B32.masterKey $ + hx "fffcf9f6f3f0edeae7e4e1dedbd8d5d2cfccc9c6c3c0bdbab7b4b1aeaba8a5a29f9c999693908d8a8784817e7b7875726f6c696663605d5a5754514e4b484542" + vector1 = + [ ( "chain m", + [], + "e8f32e723decf4051aefac8e2c93c9c5b214313817cdb01a1494b917c8436b35", + "873dff81c02f525623fd1fe5167eac3a55a049de3d314bb42ee227ffed37d508" + ), + ( "chain m/0'", + [hardened' 0], + "edb2e14f9ee77d26dd93b4ecede8d16ed408ce149b6cd80b0715a2d911a0afea", + "47fdacbd0f1097043b78c63c20c34ef4ed9a111d980047ad16282c7ae6236141" + ), + ( "chain m/0'/1", + [hardened' 0, 1], + "3c6cb8d0f6a264c91ea8b5030fadaa8e538b020f0a387421a12de9319dc93368", + "2a7857631386ba23dacac34180dd1983734e444fdbf774041578e9b6adb37c19" + ), + ( "chain m/0'/1/2'", + [hardened' 0, 1, hardened' 2], + "cbce0d719ecf7431d88e6a89fa1483e02e35092af60c042b1df2ff59fa424dca", + "04466b9cc8e161e966409ca52986c584f07e9dc81f735db683c3ff6ec7b1503f" + ), + ( "chain m/0'/1/2'/2", + [hardened' 0, 1, hardened' 2, 2], + "0f479245fb19a38a1954c5c7c0ebab2f9bdfd96a17563ef28a6a4b1a2a764ef4", + "cfb71883f01676f587d023cc53a35bc7f88f724b1f8c2892ac1275ac822a3edd" + ), + ( "chain m/0'/1/2'/2/1000000000", + [hardened' 0, 1, hardened' 2, 2, 1000000000], + "471b76e389e528d6de6d816857e012c5455051cad6660850e58372a6c3e6e7c8", + "c783e67b921d2beb8f6b389cc646d7263b4145701dadd2161548a8b078e65e9e" + ) + ] + +derivationTests :: Spec +derivationTests = do + it "derives the standard BIP-39 seed" $ + toHex seed + `shouldBe` "5eb00bbddcf069084889a8ab9155568165f5c453ccb85e70811aaed6f6da5fc19a5ac40b389cd370d086206dec8aa6c43daea6690f20ad3d8d48b2d2ce9e38e4" + it "derives the well-known account 0 address" $ + show (addrAt 0) `shouldBe` "0x9858EfFD232B4033E47d90003D41EC34EcaEda94" + it "derives account 1" $ + show (addrAt 1) `shouldBe` "0x78839F6054d7ed13918bAe0473BA31b1Ca9D7265" + it "derives account 2" $ + show (addrAt 2) `shouldBe` "0x07B5FdfEB4E11826D233403Fe8Db0611CCF4c231" + it "gives each chat profile a distinct address" $ + map addrAt [0 .. 4] `shouldSatisfy` \as -> length as == length (foldr dedup [] as) + where + m = right $ B39.parseMnemonic canonicalPhrase + seed = B39.mnemonicToSeed m "" + master = right $ B32.masterKey seed + addrAt i = addressFromPrivateKey . B32.xkKey . right $ B32.derivePath master (ethereumPath i) + dedup a as = if a `elem` as then as else a : as + +eip55Tests :: Spec +eip55Tests = do + describe "spec vectors round-trip" $ + forM_ specAddresses $ \a -> + it (BC.unpack a) $ + BC.pack (show . right $ parseAddress a) `shouldBe` a + it "accepts an all-lowercase address" $ + parseAddress "0x5aaeb6053f3e94c9b9a09f33669435e7ef1beaed" `shouldSatisfy` isRight' + it "accepts an all-uppercase address" $ + parseAddress "0x5AAEB6053F3E94C9B9A09F33669435E7EF1BEAED" `shouldSatisfy` isRight' + it "accepts an address without the 0x prefix" $ + parseAddress "5aaeb6053f3e94c9b9a09f33669435e7ef1beaed" `shouldSatisfy` isRight' + it "rejects a bad EIP-55 checksum" $ + parseAddress "0x5aAeb6053f3E94C9b9A09f33669435E7Ef1BeAed" `shouldSatisfy` isLeft + it "rejects the wrong length" $ + parseAddress "0x5aAeb6053F3E94C9b9A09f33669435E7Ef1BeAe" `shouldSatisfy` isLeft + it "rejects non-hex characters" $ + parseAddress "0xZaAeb6053F3E94C9b9A09f33669435E7Ef1BeAed" `shouldSatisfy` isLeft + it "rejects raw bytes of the wrong length" $ + mkAddress (B.replicate 19 0) `shouldSatisfy` isLeft + where + isRight' = either (const False) (const True) + specAddresses = + [ "0x5aAeb6053F3E94C9b9A09f33669435E7Ef1BeAed", + "0xfB6916095ca1df60bB79Ce92cE3Ea74c37c5d359", + "0xdbF03B407c01E7cD3CBea99509d93f8DDDC8C6FB", + "0xD1220A0cf47c7B9Be7A2E6BA89F429762e7b9aDb" + ] + +eip712Tests :: Spec +eip712Tests = do + it "computes the spec domain separator" $ + toHex (right $ domainSeparator domain) `shouldBe` "f2cee375fa42b42143804025fc449deafd50cc031ca257e0b194a650a912090f" + it "computes hashStruct for the Mail example" $ + toHex mailHash `shouldBe` "c52c0ee5d84264471806290a3f2c4cecfc5490626bf912d01f240d7a274b371e" + it "computes the final signing digest" $ + toHex (right $ hashTypedData domain mailType mailMembers) + `shouldBe` "be609aee343fb3c4b28e1df9e632fca64fcfaede20f02e86244efddf30957bd2" + it "encodes a bool" $ + toHex (right $ encodeValue (VBool True)) `shouldBe` "0000000000000000000000000000000000000000000000000000000000000001" + it "encodes a negative int as two's complement" $ + toHex (right $ encodeValue (VInt (-1))) `shouldBe` "ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff" + it "left-aligns bytesN" $ + toHex (right $ encodeValue (VFixedBytes "\x01\x02")) `shouldBe` "0102000000000000000000000000000000000000000000000000000000000000" + it "right-aligns an address" $ + toHex (right . encodeValue . VAddress . right $ parseAddress "0xCcCCccccCCCCcCCCCCCcCcCccCcCCCcCcccccccC") + `shouldBe` "000000000000000000000000cccccccccccccccccccccccccccccccccccccccc" + it "hashes an array to a single word" $ + B.length (right $ encodeValue (VArray [VUint 1, VUint 2])) `shouldBe` 32 + it "rejects a uint above 2^256" $ + encodeValue (VUint (2 ^ (256 :: Int))) `shouldSatisfy` isLeft + it "rejects a negative uint" $ + encodeValue (VUint (-1)) `shouldSatisfy` isLeft + it "rejects an int outside int256" $ + encodeValue (VInt (2 ^ (255 :: Int))) `shouldSatisfy` isLeft + it "rejects bytesN longer than 32" $ + encodeValue (VFixedBytes (B.replicate 33 0)) `shouldSatisfy` isLeft + it "rejects empty bytesN" $ + encodeValue (VFixedBytes "") `shouldSatisfy` isLeft + it "rejects a struct hash that is not 32 bytes" $ + encodeValue (VStruct "short") `shouldSatisfy` isLeft + where + domain = + Eip712Domain + { edName = "Ether Mail", + edVersion = "1", + edChainId = 1, + edVerifyingContract = right $ parseAddress "0xCcCCccccCCCCcCCCCCCcCcCccCcCCCcCcccccccC" + } + personType = "Person(string name,address wallet)" + mailType = "Mail(Person from,Person to,string contents)Person(string name,address wallet)" + person n w = right $ hashStruct personType [VString n, VAddress (right $ parseAddress w)] + mailMembers = + [ VStruct $ person "Cow" "0xCD2a3d9F938E13CD947Ec05AbC7FE734Df8DD826", + VStruct $ person "Bob" "0xbBbBBBBbbBBBbbbBbbBbbbbBBbBbbbbBbBbbBBbB", + VString "Hello, Bob!" + ] + mailHash = right $ hashStruct mailType mailMembers + +-- | Official BIP-39 English test vectors from +-- , +-- all generated with the passphrase @TREZOR@: (entropy, mnemonic, seed). +bip39Vectors :: [(ByteString, ByteString, ByteString)] +bip39Vectors = + [ ( "00000000000000000000000000000000", + "abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon about", + "c55257c360c07c72029aebc1b53c05ed0362ada38ead3e3e9efa3708e53495531f09a6987599d18264c1e1c92f2cf141630c7a3c4ab7c81b2f001698e7463b04" ) + , ( "7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f", + "legal winner thank year wave sausage worth useful legal winner thank yellow", + "2e8905819b8723fe2c1d161860e5ee1830318dbf49a83bd451cfb8440c28bd6fa457fe1296106559a3c80937a1c1069be3a3a5bd381ee6260e8d9739fce1f607" ) + , ( "80808080808080808080808080808080", + "letter advice cage absurd amount doctor acoustic avoid letter advice cage above", + "d71de856f81a8acc65e6fc851a38d4d7ec216fd0796d0a6827a3ad6ed5511a30fa280f12eb2e47ed2ac03b5c462a0358d18d69fe4f985ec81778c1b370b652a8" ) + , ( "ffffffffffffffffffffffffffffffff", + "zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo wrong", + "ac27495480225222079d7be181583751e86f571027b0497b5b5d11218e0a8a13332572917f0f8e5a589620c6f15b11c61dee327651a14c34e18231052e48c069" ) + , ( "000000000000000000000000000000000000000000000000", + "abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon agent", + "035895f2f481b1b0f01fcf8c289c794660b289981a78f8106447707fdd9666ca06da5a9a565181599b79f53b844d8a71dd9f439c52a3d7b3e8a79c906ac845fa" ) + , ( "7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f", + "legal winner thank year wave sausage worth useful legal winner thank year wave sausage worth useful legal will", + "f2b94508732bcbacbcc020faefecfc89feafa6649a5491b8c952cede496c214a0c7b3c392d168748f2d4a612bada0753b52a1c7ac53c1e93abd5c6320b9e95dd" ) + , ( "808080808080808080808080808080808080808080808080", + "letter advice cage absurd amount doctor acoustic avoid letter advice cage absurd amount doctor acoustic avoid letter always", + "107d7c02a5aa6f38c58083ff74f04c607c2d2c0ecc55501dadd72d025b751bc27fe913ffb796f841c49b1d33b610cf0e91d3aa239027f5e99fe4ce9e5088cd65" ) + , ( "ffffffffffffffffffffffffffffffffffffffffffffffff", + "zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo when", + "0cd6e5d827bb62eb8fc1e262254223817fd068a74b5b449cc2f667c3f1f985a76379b43348d952e2265b4cd129090758b3e3c2c49103b5051aac2eaeb890a528" ) + , ( "0000000000000000000000000000000000000000000000000000000000000000", + "abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon art", + "bda85446c68413707090a52022edd26a1c9462295029f2e60cd7c4f2bbd3097170af7a4d73245cafa9c3cca8d561a7c3de6f5d4a10be8ed2a5e608d68f92fcc8" ) + , ( "7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f", + "legal winner thank year wave sausage worth useful legal winner thank year wave sausage worth useful legal winner thank year wave sausage worth title", + "bc09fca1804f7e69da93c2f2028eb238c227f2e9dda30cd63699232578480a4021b146ad717fbb7e451ce9eb835f43620bf5c514db0f8add49f5d121449d3e87" ) + , ( "8080808080808080808080808080808080808080808080808080808080808080", + "letter advice cage absurd amount doctor acoustic avoid letter advice cage absurd amount doctor acoustic avoid letter advice cage absurd amount doctor acoustic bless", + "c0c519bd0e91a2ed54357d9d1ebef6f5af218a153624cf4f2da911a0ed8f7a09e2ef61af0aca007096df430022f7a2b6fb91661a9589097069720d015e4e982f" ) + , ( "ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff", + "zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo vote", + "dd48c104698c30cfe2b6142103248622fb7bb0ff692eebb00089b32d22484e1613912f0a5b694407be899ffd31ed3992c456cdf60f5d4564b8ba3f05a69890ad" ) + , ( "9e885d952ad362caeb4efe34a8e91bd2", + "ozone drill grab fiber curtain grace pudding thank cruise elder eight picnic", + "274ddc525802f7c828d8ef7ddbcdc5304e87ac3535913611fbbfa986d0c9e5476c91689f9c8a54fd55bd38606aa6a8595ad213d4c9c9f9aca3fb217069a41028" ) + , ( "6610b25967cdcca9d59875f5cb50b0ea75433311869e930b", + "gravity machine north sort system female filter attitude volume fold club stay feature office ecology stable narrow fog", + "628c3827a8823298ee685db84f55caa34b5cc195a778e52d45f59bcf75aba68e4d7590e101dc414bc1bbd5737666fbbef35d1f1903953b66624f910feef245ac" ) + , ( "68a79eaca2324873eacc50cb9c6eca8cc68ea5d936f98787c60c7ebc74e6ce7c", + "hamster diagram private dutch cause delay private meat slide toddler razor book happy fancy gospel tennis maple dilemma loan word shrug inflict delay length", + "64c87cde7e12ecf6704ab95bb1408bef047c22db4cc7491c4271d170a1b213d20b385bc1588d9c7b38f1b39d415665b8a9030c9ec653d75e65f847d8fc1fc440" ) + , ( "c0ba5a8e914111210f2bd131f3d5e08d", + "scheme spot photo card baby mountain device kick cradle pact join borrow", + "ea725895aaae8d4c1cf682c1bfd2d358d52ed9f0f0591131b559e2724bb234fca05aa9c02c57407e04ee9dc3b454aa63fbff483a8b11de949624b9f1831a9612" ) + , ( "6d9be1ee6ebd27a258115aad99b7317b9c8d28b6d76431c3", + "horn tenant knee talent sponsor spell gate clip pulse soap slush warm silver nephew swap uncle crack brave", + "fd579828af3da1d32544ce4db5c73d53fc8acc4ddb1e3b251a31179cdb71e853c56d2fcb11aed39898ce6c34b10b5382772db8796e52837b54468aeb312cfc3d" ) + , ( "9f6a2878b2520799a44ef18bc7df394e7061a224d2c33cd015b157d746869863", + "panda eyebrow bullet gorilla call smoke muffin taste mesh discover soft ostrich alcohol speed nation flash devote level hobby quick inner drive ghost inside", + "72be8e052fc4919d2adf28d5306b5474b0069df35b02303de8c1729c9538dbb6fc2d731d5f832193cd9fb6aeecbc469594a70e3dd50811b5067f3b88b28c3e8d" ) + , ( "23db8160a31d3e0dca3688ed941adbf3", + "cat swing flag economy stadium alone churn speed unique patch report train", + "deb5f45449e615feff5640f2e49f933ff51895de3b4381832b3139941c57b59205a42480c52175b6efcffaa58a2503887c1e8b363a707256bdd2b587b46541f5" ) + , ( "8197a4a47f0425faeaa69deebc05ca29c0a5b5cc76ceacc0", + "light rule cinnamon wrap drastic word pride squirrel upgrade then income fatal apart sustain crack supply proud access", + "4cbdff1ca2db800fd61cae72a57475fdc6bab03e441fd63f96dabd1f183ef5b782925f00105f318309a7e9c3ea6967c7801e46c8a58082674c860a37b93eda02" ) + , ( "066dca1a2bb7e8a1db2832148ce9933eea0f3ac9548d793112d9a95c9407efad", + "all hour make first leader extend hole alien behind guard gospel lava path output census museum junior mass reopen famous sing advance salt reform", + "26e975ec644423f4a4c4f4215ef09b4bd7ef924e85d1d17c4cf3f136c2863cf6df0a475045652c57eb5fb41513ca2a2d67722b77e954b4b3fc11f7590449191d" ) + , ( "f30f8c1da665478f49b001d94c5fc452", + "vessel ladder alter error federal sibling chat ability sun glass valve picture", + "2aaa9242daafcee6aa9d7269f17d4efe271e1b9a529178d7dc139cd18747090bf9d60295d0ce74309a78852a9caadf0af48aae1c6253839624076224374bc63f" ) + , ( "c10ec20dc3cd9f652c7fac2f1230f7a3c828389a14392f05", + "scissors invite lock maple supreme raw rapid void congress muscle digital elegant little brisk hair mango congress clump", + "7b4a10be9d98e6cba265566db7f136718e1398c71cb581e1b2f464cac1ceedf4f3e274dc270003c670ad8d02c4558b2f8e39edea2775c9e232c7cb798b069e88" ) + , ( "f585c11aec520db57dd353c69554b21a89b20fb0650966fa0a9d6f74fd989d8f", + "void come effort suffer camp survey warrior heavy shoot primary clutch crush open amazing screen patrol group space point ten exist slush involve unfold", + "01f5bced59dec48e362f2c45b5de68b9fd6c92c6634f44d6d40aab69056506f0e35524a518034ddc1192e1dacd32c1ed3eaa3c3b131c88ed8e7e54c49a5d0998" ) + ] + +-- ERC-5564 stealth addresses. +-- +-- The EIP fixes the algebra but not the serialization or the hash, so the +-- pinned vector below is the interoperability contract: it follows the EIP +-- author's reference implementation (keccak256 over the shared secret point as +-- x||y, view tag = first byte). Anything that changes it breaks compatibility +-- with every other ERC-5564 wallet, which is why it is pinned rather than +-- computed. +stealthTests :: Spec +stealthTests = do + it "sender and recipient derive the same address" $ do + let d = right $ stealthDestination ephemeralKey aliceMeta + right (stealthMatch aliceView (smaSpend aliceMeta) (sdEphemeralPubKey d) (sdViewTag d)) + `shouldBe` Just (sdAddress d) + + it "the recipient's derived key controls that address" $ do + let d = right $ stealthDestination ephemeralKey aliceMeta + sk = right $ stealthPrivateKey aliceSpend aliceView (sdEphemeralPubKey d) + addressFromPrivateKey sk `shouldBe` sdAddress d + + it "the derived key actually signs for it" $ do + let d = right $ stealthDestination ephemeralKey aliceMeta + sk = right $ stealthPrivateKey aliceSpend aliceView (sdEphemeralPubKey d) + digest = keccak256 "transfer" + sig = right $ S.signRecoverable sk digest + addressFromPublicKey (right $ S.recoverPublicKey sig digest) `shouldBe` sdAddress d + + it "the view tag is the first byte of the hashed shared secret" $ do + let d = right $ stealthDestination ephemeralKey aliceMeta + sh = right $ sharedSecretHash aliceView (right . S.parsePublicKey $ sdEphemeralPubKey d) + sdViewTag d `shouldBe` B.head sh + + it "a different ephemeral key gives an unrelated address" $ do + let d1 = right $ stealthDestination ephemeralKey aliceMeta + d2 = right $ stealthDestination ephemeralKey2 aliceMeta + sdAddress d1 `shouldNotBe` sdAddress d2 + + it "the viewing key alone does not spend" $ do + -- Using the viewing key where the spending key belongs must not produce the + -- address: this is what makes delegated scanning safe. + let d = right $ stealthDestination ephemeralKey aliceMeta + wrong = right $ stealthPrivateKey aliceView aliceView (sdEphemeralPubKey d) + addressFromPrivateKey wrong `shouldNotBe` sdAddress d + + it "another recipient never matches, over a batch of announcements" $ do + -- Bob scans 512 announcements addressed to Alice. About two will pass the + -- one-byte view tag by chance; none may yield an address Bob controls. + let ds = [right $ stealthDestination (ephemeralN i) aliceMeta | i <- [1 .. 512 :: Int]] + matches = + [ a + | d <- ds, + Just a <- [right $ stealthMatch bobView (smaSpend bobMeta) (sdEphemeralPubKey d) (sdViewTag d)] + ] + filter (`elem` map sdAddress ds) matches `shouldBe` [] + + it "the recipient finds their own in the same batch" $ do + let ds = [right $ stealthDestination (ephemeralN i) aliceMeta | i <- [1 .. 64 :: Int]] + found = + [ a + | d <- ds, + Just a <- [right $ stealthMatch aliceView (smaSpend aliceMeta) (sdEphemeralPubKey d) (sdViewTag d)] + ] + found `shouldBe` map sdAddress ds + + it "agrees with an independent implementation of the scheme" $ do + -- Cross-checked against a from-scratch pure-Python secp256k1 implementing + -- the reference algorithm directly (scratchpad @stealth_ref.py@), sharing + -- no code with libsecp256k1. Agreement here is what makes this an + -- interoperability vector rather than a record of our own output. + let d = right $ stealthDestination ephemeralKey aliceMeta + checksumAddress (sdAddress d) `shouldBe` "0xbC287a4f0345cD7Fea8d523fBa25Aec4f0B29a6c" + toHex (sdEphemeralPubKey d) `shouldBe` "029ac20335eb38768d2052be1dbbc3c8f6178407458e51e6b4ad22f1d91758895b" + sdViewTag d `shouldBe` 224 + + describe "meta-address encoding" $ do + it "round-trips" $ + parseMetaAddress (metaAddressBytes aliceMeta) `shouldBe` Right aliceMeta + it "is 66 bytes, spending key first" $ do + let bs = metaAddressBytes aliceMeta + B.length bs `shouldBe` 66 + B.take 33 bs `shouldBe` S.serializePublicKey S.Compressed (smaSpend aliceMeta) + it "rejects a wrong length" $ + parseMetaAddress (B.take 65 $ metaAddressBytes aliceMeta) `shouldSatisfy` isLeft + it "rejects points not on the curve" $ + parseMetaAddress (B.replicate 66 0xAA) `shouldSatisfy` isLeft + +aliceSpend, aliceView, bobSpend, bobView, ephemeralKey, ephemeralKey2 :: S.PrivateKey +aliceSpend = right $ S.mkPrivateKey (hx "1111111111111111111111111111111111111111111111111111111111111111") +aliceView = right $ S.mkPrivateKey (hx "2222222222222222222222222222222222222222222222222222222222222222") +bobSpend = right $ S.mkPrivateKey (hx "3333333333333333333333333333333333333333333333333333333333333333") +bobView = right $ S.mkPrivateKey (hx "4444444444444444444444444444444444444444444444444444444444444444") +ephemeralKey = right $ S.mkPrivateKey (hx "5555555555555555555555555555555555555555555555555555555555555555") +ephemeralKey2 = right $ S.mkPrivateKey (hx "6666666666666666666666666666666666666666666666666666666666666666") + +aliceMeta, bobMeta :: StealthMetaAddress +aliceMeta = metaAddress aliceSpend aliceView +bobMeta = metaAddress bobSpend bobView + +-- Distinct ephemeral keys for batch tests. +ephemeralN :: Int -> S.PrivateKey +ephemeralN i = right . S.mkPrivateKey . keccak256 . BC.pack $ "ephemeral " <> show i diff --git a/tests/Test.hs b/tests/Test.hs index c2968828b..c4a892536 100644 --- a/tests/Test.hs +++ b/tests/Test.hs @@ -11,6 +11,7 @@ import CoreTests.BatchingTests import CoreTests.CryptoFileTests import CoreTests.CryptoTests import CoreTests.EncodingTests +import CoreTests.EthCryptoTests import CoreTests.MsgStoreTests import CoreTests.RetryIntervalTests import CoreTests.SOCKSSettings @@ -87,6 +88,7 @@ main = do describe "Encoding tests" encodingTests describe "Version range" versionRangeTests describe "Encryption tests" cryptoTests + describe "Ethereum crypto tests" ethCryptoTests describe "Encrypted files tests" cryptoFileTests describe "Message store tests" msgStoreTests describe "Retry interval tests" retryIntervalTests