diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,106 +4,379 @@ The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/) and this project adheres to [Semantic Versioning](http://semver.org/spec/v2.0.0.html). -## 0.5.0 +## [2.0.1] - 2026-11-07 + ### Changed + +- Documentation: the README explains the purpose and design of the bindings, + with installation steps for every platform, a tutorial, a usage guide, the + differences from Bitcoin Core and security notes. Every module, including + the foreign imports, has Haddock, and the main module and key functions say + why they work the way they do. +- CI builds, tests and documents the package with Stack, against the + libsecp256k1 of Ubuntu and with `stack --nix`. +- Build with Stackage nightly-2026-11-07. + +## [2.0.0] - 2026-11-03 + +This release follows a review of the bindings, including the changes of +1.8.0. The raw constructors are hidden, the text instances use standard +encodings, and more values are validated when they are built. Several +changes are breaking; see Changed. + +### Changed + +- The raw constructors of `SecKey`, `PubKey`, `Sig`, `CompactSig`, + `SchnorrSig`, `Msg` and `Tweak`, and the `Ctx` constructor, are no longer + exported from `Crypto.Secp256k1`. Build values with `secKey`, `pubKey`, + `sig`, `compactSig`, `schnorrSig`, `msg`, `tweak` or the import functions. + The `get` field is still exported. The constructors remain available from + `Crypto.Secp256k1.Internal.Base`, without validation. +- `tweak` rejects numbers not below the curve order. `sig` rejects a zero + component. `Read` and `IsString` follow. +- `Show`, `Read` and `IsString` for `PubKey` use the compressed SEC1 encoding + in hex; `Read` and `IsString` also accept the uncompressed and hybrid + encodings. The same instances for `Sig` use the compact encoding in hex. + Before, they used the internal representation of libsecp256k1, which is not + portable between platforms or library versions. +- `normalizeSig` is total: `Ctx -> Sig -> Sig`. It returns the lower-S form of + any signature. Before, it returned `Nothing` for a signature that was + already in that form. +- `importSig` and `importCompactSig` return `Nothing` for a signature with a + zero component. libsecp256k1 parses a DER component that is not below the + curve order as zero while reporting success, and such a signature can never + verify. +- `tweakNegate` returns `Just` zero for a zero tweak. +- `combinePubKeys` raises an error for a raw key of the wrong length, as every + other function does, instead of returning `Nothing`. +- `signSchnorr`, `signSchnorrWithAux` and `signSchnorrIO` verify the signature + before returning it, as BIP-340 requires, and raise an error if that fails. +- The package requires libsecp256k1 0.2.0 or later through `pkg-config`. The + Schnorr bindings of 1.8.0 already needed that version to link. + +### Added + +- ECDSA public key recovery, in the new module `Crypto.Secp256k1.Recovery`: + `RecSig`, `recSig`, `signRecMsg`, `recover`, `convertRecSig`, + `importCompactRecSig` and `exportCompactRecSig`, bound to the `recovery` + module of libsecp256k1. `signRecMsg` gives the signatures of Bitcoin Core's + message signing, and `recover` is what its message verification does. The + package flag `recovery`, on by default, builds the module; turn it off for a + libsecp256k1 built without `--enable-module-recovery`. +- `signMsgLowR` grinds the nonce until r is below 2^255, with the same extra + nonce data as Bitcoin Core, so DER signatures are at most 70 bytes and are + byte-for-byte the same as Bitcoin Core's. +- `isLowS` and `isLowR`. +- `Show`, `Read` and `IsString` instances for `CompactSig`. +- `Arbitrary` instance for `Tweak`. +- Documentation of the thread-safety rule of `randomizeContext`, of what + `Show` prints for a `SecKey`, of the memory handling of secret keys, of the + lower-S requirement of `verifySig`, of the x-only representation of BIP-340 + keys, and of the differences from Bitcoin Core. + +### Fixed + +- `importPubKey` and `exportPubKey` were documented as DER. The format is + SEC1. +- `tweakMulPubKey` was documented as adding a multiple of the generator. +- Removed the unused `unliftio-core` dependency and unused imports. The + library and the tests build with `-Wall` without warnings. + +## [1.8.0] - 2026-11-03 + +### Added + +- BIP-340 Schnorr signatures, built on the `schnorrsig` and `extrakeys` + modules of libsecp256k1, which it enables by default since version 0.2.0: + `SchnorrSig`, `schnorrSig`, `signSchnorr`, `signSchnorrWithAux`, + `signSchnorrIO` and `verifySchnorr`. No build flag is needed. +- `importXOnlyPubKey` and `exportXOnlyPubKey` convert between `PubKey` and + 32-byte BIP-340 x-only public keys. +- `tweakAddXOnlyPubKey` and `tweakAddXOnlySecKey` add a BIP-341 Taproot tweak + to a public key and to its secret key. + +### Fixed + +- `secKey` rejects zero and numbers not lower than the curve order, as + `secp256k1_ec_seckey_verify` does. `Read` and `IsString` for `SecKey` follow. +- `pubKey` and `sig` reject bytes that are not a canonical internal + representation of a point on the curve or of a signature with both + components below the order. `Read` and `IsString` follow. +- An illegal argument no longer aborts the program. Contexts get a callback + that makes libsecp256k1 return failure, so a zero `PubKey` built with the + raw constructor gives `False`, `Nothing` or an exception. +- Functions raise an error for a `SecKey`, `PubKey`, `Sig`, `CompactSig`, + `Msg` or `Tweak` of the wrong length built with the raw constructor, instead + of letting libsecp256k1 read past the end of the buffer. +- `combinePubKeys` passes the key count as `size_t`, as the C function expects, + and returns `Nothing` when a key is not a valid point, since + `secp256k1_ec_pubkey_combine` does not check. +- Tweak functions write to a fresh buffer instead of mutating a `ByteString` + in place. + +## [1.7.0] - 2026-10-31 + +### Added + +- Reinstaded some functions removed by accident. + +## [1.6.0] - 2026-10-31 + +### Removed + +- No longer does this module expose the destroyContext function. + Context is now only destroyed safely by the garbage collector. + +## [1.5.1] - 2026-10-31 + +### Fixed + +- This package is now compatible with base16 version 2.0. + +## [1.5.0] - 2026-08-12 + +### Fixed + +- Use seckey instead of privkey aliases. + +## [1.4.6] - 2025-05-09 + +### Removed + +- Removed more unnecessary file boilerplate. + +## [1.4.5] - 2025-05-09 + +### Removed + +- Removed unnecessary file boilerplate. + +## [1.4.4] - 2025-05-09 + +### Changed + +- Simplify author name. + +## [1.4.3] - 2025-05-08 + +### Changed + +- New home in github.com/jprupp rather than github.com/haskoin. + +## [1.4.2] - 2024-12-10 + +### Changed + +- Relax all upper-bound version restrictions in `package.yaml`. + +## [1.4.1] - 2024-12-10 + +### Changed + +- Relax version restriction on QuickCheck. + +## [1.4.0] - 2024-08-28 + +### Removed + +- Removed BIP-340 support. Fedora’s version of secp256k1 libraries do not have required symbols. + +## [1.3.0] - 2024-08-28 + +### Added + +- Added BIP-340 support. + +## [1.2.0] - 2023-03-14 + +### Changed + +- Make compatible with latest upstream LTS Haskell. + +## [1.1.0] - 2023-11-01 + +### Changed + +- Use ForeignPtr to allow the garbage collector manage the context object (Ctx). + +## [1.0.1] - 2023-09-20 + +### Changed + +- Reworked the structure of the Internal modules to allow having add-on packages for optional libsecp256k1 features. + +## [1.0.0] - 2023-07-28 + +### Changed + +- Context data structure must be created and passed explicitly. +- Field selectors are now short and duplicates are allowed. +- Use DuplicateRecordFields and OverloadedRecordDot language extensions. + +## [0.6.1] - 2022-04-18 + +### Changed + +- Bump version and LTS Haskell. +- Update dependencies. + +## [0.6.0] - 2021-08-27 + +### Changed + +- Remove all use of CPP. +- Depend on base16 instead of the old base16-bytestring package. +- Target ghc-9.0.1 compiler. + +### Fixed + +- Do not crash on bytestrings that are backed by null C pointers. + +## [0.5.0] - 2020-10-16 + +### Changed + - Include version boundaries and other changes submitted by Emily Pillmore. -## 0.4.0 +## [0.4.0] - 2020-07-23 + ### Changed + - Remove fragile ForeignPtr implementation in favor of just storing ByteStrings. - Reuse memory instead of copying when possible. -## 0.3.1 +## [0.3.1] - 2020-07-03 + ### Fixed + - Use unsafe calls in FFI. -## 0.3.0 +## [0.3.0] - 2020-06-13 + ### Fixed + - Compiles with all flags now. ### Added + - Script to compile with all flags. ### Removed + - Remove ECDH support. - Remove Schnorr support. - Remove Recovery support. -## 0.2.5 +## [0.2.5] - 2020-06-13 + ### Changed + - Reuse context aggressively. - Generate context in a single thread. ### Fixed + - Memory deallocation bug. -## 0.2.4 +## [0.2.4] - 2020-06-12 + ### Changed + - Update Cabal and package version. -## 0.2.3 +## [0.2.3] - 2020-06-07 + ### Changed + - Return meaningful error upon encountering weird ret status from upstream code. ### Added + - Test parallel signature creation and verification. -## 0.2.2 +## [0.2.2] - 2020-04-14 + ### Removed + - Hide tweak negation behind a flag for compatibilidy with Debian 9. ### Fixed + - Correct code that was not compiling with some flags enabled. -## 0.2.1 +## [0.2.1] - 2020-04-10 + ### Changed + - Do not depend on hardcoded DER signatures in tests. -## 0.2.0 +## [0.2.0] - 2020-04-10 + ### Added + - Support for ECDH APIs. - Support for Schnorr APIs. ### Removed + - Enabling key recovery APIs need a flag. -## 0.1.8 +## [0.1.8] - 2020-01-15 + ### Added + - Add missing `NFData` instances for some types. -## 0.1.7 +## [0.1.7] - 2020-01-15 + ### Added + - Add `NFData` instances for all types. -## 0.1.6 +## [0.1.6] - 2019-12-26 + ### Added + - Use `pkgconfig` for C library dependency. -## 0.1.5 +## [0.1.5] - 2019-09-19 + ### Added + - Flag for ECDH bindings. -## 0.1.4 +## [0.1.4] - 2018-10-25 + ### Changed + - Constrain imports to avoid clashes with a QuickCheck function. -## 0.1.3 +## [0.1.3] - 2018-10-13 + ### Added + - Hashable instances for various types. -## 0.1.2 +## [0.1.2] - 2018-09-10 + ### Changed + - Separate dependencies between library and tests. - Remove `hspec` default to prevent problems with Nix. ### Removed + - Dependency to `cryptohash` not needed. -## 0.1.1 +## [0.1.1] - 2018-09-10 + ### Changed + - Update changelog to reflect name and version change. - Update to LTS Haskell 12.9. -## 0.1.0 +## [0.1.0] - 2018-09-10 + ### Changed + - Name of package change from `secp256k1` to `secp256k1-haskell` to avoid Nix conflicts. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,6 +1,453 @@ -[![Build Status](https://travis-ci.org/haskoin/secp256k1-haskell.svg?branch=master)](https://travis-ci.org/haskoin/secp256k1-haskell) +# secp256k1-haskell -# Haskell bindings for secp256k1 +[![Hackage](https://img.shields.io/hackage/v/secp256k1-haskell.svg)](https://hackage.haskell.org/package/secp256k1-haskell) +[![CI](https://github.com/jprupp/secp256k1-haskell/actions/workflows/ci.yml/badge.svg)](https://github.com/jprupp/secp256k1-haskell/actions/workflows/ci.yml) +[![License: MIT](https://img.shields.io/badge/license-MIT-blue.svg)](https://github.com/jprupp/secp256k1-haskell/blob/master/LICENSE) -This project contains Haskell bindings for the -[secp256k1](https://github.com/bitcoin-core/secp256k1) library. +Haskell bindings to [libsecp256k1](https://github.com/bitcoin-core/secp256k1), +the library that Bitcoin Core uses for elliptic curve cryptography on the +secp256k1 curve. It covers ECDSA signatures, BIP-340 Schnorr signatures, +BIP-341 Taproot tweaks, key tweaking for BIP-32 derivation, and ECDSA public +key recovery for Bitcoin signed messages. + +- [API documentation](https://hackage.haskell.org/package/secp256k1-haskell) +- [Changelog](https://github.com/jprupp/secp256k1-haskell/blob/master/CHANGELOG.md) +- [Report a bug](https://github.com/jprupp/secp256k1-haskell/issues) + +## Contents + +- [Why secp256k1-haskell](#why-secp256k1-haskell) +- [Design principles](#design-principles) +- [Features](#features) +- [Installation](#installation) +- [Quick start](#quick-start) +- [Tutorial: sign, verify and serialize](#tutorial-sign-verify-and-serialize) +- [Concepts](#concepts) +- [Usage guide](#usage-guide) +- [Differences from Bitcoin Core](#differences-from-bitcoin-core) +- [Module overview](#module-overview) +- [Security notes](#security-notes) +- [Development](#development) +- [Related projects](#related-projects) +- [License](#license) + +## Why secp256k1-haskell + +Elliptic curve cryptography is easy to write and very hard to get right. A +signing routine whose running time depends on the secret key leaks it through +timing. A nonce that repeats once reveals the key outright. An edge case in +point arithmetic accepts a forged signature. These are not theoretical: each has +cost real users real money. + +libsecp256k1 is the answer the Bitcoin community converged on. It is +constant-time wherever secrets are involved, blinds secret key operations +against side channels, is tested exhaustively, and has been reviewed for over a +decade. It is what Bitcoin Core runs. + +This package lets a Haskell program use that library instead of reimplementing +it, and wraps it in types that make the usual mistakes hard to make. It is the +cryptographic foundation of [haskoin-core](https://github.com/jprupp/haskoin-core) +and, through it, of the rest of the Haskoin libraries. + +## Design principles + +- **Valid by construction.** Every key, signature, hash and tweak goes through + a smart constructor or an import function that checks it. A `PubKey` is + always a point on the curve; a `Sig` always has both components in range. + Invalid input is refused where it enters the program, not deep inside a + computation. +- **Never abort the process.** By default libsecp256k1 calls `abort()` on an + illegal argument, which kills the whole Haskell program and cannot be caught. + Every context this package creates installs a callback that makes the C + function fail instead, so a bad argument becomes `Nothing`, `False` or an + exception. +- **Pure where the mathematics is pure.** Signing with deterministic nonces, + verifying, deriving and tweaking keys are pure functions. Only operations + that need fresh randomness run in `IO`. +- **Standard encodings at the edges.** `Show`, `Read` and `IsString` use SEC1, + compact or plain hex, never libsecp256k1's internal memory layout, which + differs between platforms and library versions. +- **Explicit about Bitcoin Core.** Where Bitcoin Core goes beyond the + standards, such as grinding signatures to a low R value or accepting high-S + signatures from old blocks, this package offers the behaviour as a separate, + documented function instead of silently picking one. +- **Thin.** Hashing, address encoding, BIP-32 paths and transaction formats + belong in higher-level libraries such as haskoin-core. + +## Features + +| Area | What you get | +| -------------------- | ---------------------------------------------------------------------------------------------- | +| ECDSA | Deterministic RFC 6979 signing, Bitcoin Core's low-R grinding, verification, lower-S normalization | +| Encodings | SEC1 public keys (33 or 65 bytes), DER and compact signatures, hex `Show`/`Read`/`IsString` | +| Schnorr (BIP-340) | Signing (deterministic, with given or fresh auxiliary randomness), verification, x-only keys | +| Taproot (BIP-341) | Tweaking an x-only public key and its secret key | +| Key arithmetic | Add or multiply secret and public keys by a tweak, negate, combine public keys | +| Recovery | Recoverable ECDSA signatures and public key recovery, as Bitcoin signed messages use | +| Safety | Validated values, no aborts, length checks before every C call, contexts shared across threads | +| Testing | QuickCheck `Arbitrary` instances for secret keys, hashes and tweaks | + +### What is not included + +- No hashing. Pass a 32-byte hash you computed with a hash library, such as + `cryptohash-sha256` or haskoin-core. +- No ECDH, MuSig2 or adaptor signatures, although libsecp256k1 or its + forks offer some of them. +- No secure erasure of secret keys from memory. See [Security notes](#security-notes). + +## Installation + +### System library + +The package needs [libsecp256k1](https://github.com/bitcoin-core/secp256k1) +**0.2.0 or later** and `pkg-config` to find it. Public key recovery also needs +the library's recovery module, which the packages below include. + +```sh +# Debian and Ubuntu (24.04 ships 0.2.0) +sudo apt-get install libsecp256k1-dev pkg-config + +# Fedora +sudo dnf install libsecp256k1-devel pkgconf + +# macOS with Homebrew +brew install secp256k1 pkg-config + +# Nix +nix-shell -p secp256k1 pkg-config +``` + +Check what you have: + +```sh +pkg-config --modversion libsecp256k1 # must print 0.2.0 or later +``` + +Older distributions, such as Debian 11, ship an earlier version. Build the +library from source then: + +```sh +git clone https://github.com/bitcoin-core/secp256k1.git +cd secp256k1 +./autogen.sh +./configure --enable-module-recovery +make && sudo make install +``` + +If your library was built without the recovery module, build this package with +the `recovery` flag off: `stack build --flag secp256k1-haskell:-recovery`, or +`cabal build -f -recovery`. Everything except `Crypto.Secp256k1.Recovery` still +works. + +### Step by step with Stack + +1. Install [Stack](https://docs.haskellstack.org/) and the library above. +2. Create a project: + + ```sh + stack new sig-demo simple + cd sig-demo + ``` + +3. Add `secp256k1-haskell` and `bytestring` to `build-depends` in + `sig-demo.cabal`. +4. If your resolver does not include the package, add it to `stack.yaml`: + + ```yaml + extra-deps: + - secp256k1-haskell-2.0.1 + - base16-2.0 + ``` + +5. Put the [quick start](#quick-start) program in `src/Main.hs` and run it with + `stack run`. It prints `True` three times. + +### With Cabal + +```cabal +build-depends: + base + , bytestring + , secp256k1-haskell +``` + +Run `cabal update` first, then `cabal build`. + +## Quick start + +```haskell +{-# LANGUAGE OverloadedStrings #-} + +import Crypto.Secp256k1 + +main :: IO () +main = do + ctx <- createContext + + -- Hex literals go through IsString, which validates them. + let key = "c7e5a2b4f4c5d7e8a9b0c1d2e3f405162738495a6b7c8d9e0f1a2b3c4d5e6f70" :: SecKey + hash = "4b688df40bcedbe641ddb16ff0a1842d9c67ea1c3bf63f3e0471baa664531d1a" :: Msg + pub = derivePubKey ctx key + + -- ECDSA + let s = signMsg ctx key hash + print (verifySig ctx pub s hash) + + -- BIP-340 Schnorr, with fresh auxiliary randomness + schnorr <- signSchnorrIO ctx key hash + print (verifySchnorr ctx pub schnorr hash) + + -- Round trip through the standard encodings + let Just pub' = importPubKey ctx (exportPubKey ctx True pub) + print (pub == pub') +``` + +## Tutorial: sign, verify and serialize + +This walks through what a wallet or a protocol implementation typically does, +and why each step looks the way it does. + +### 1. Create one context and share it + +```haskell +ctx <- createContext +``` + +A context holds precomputed tables and random blinding values. Creating one is +relatively expensive, and one context can be used by every thread for the life +of the program. `createContext` randomizes it once, which is what libsecp256k1 +recommends. + +### 2. Get keys from bytes + +```haskell +case secKey keyBytes of + Nothing -> fail "not a valid secret key" + Just key -> ... +``` + +`secKey` refuses 0 and numbers not below the curve order, so a `SecKey` is +always usable. In practice, keys come from a wallet: from a BIP-39 mnemonic and +BIP-32 derivation in haskoin-core, or from 32 bytes of the operating system's +secure randomness (`getEntropy 32` from the `entropy` package). + +### 3. Hash, then sign + +The library signs 32-byte hashes, not messages. Which hash to use is part of +the protocol: Bitcoin transactions use double SHA-256 of a specific +serialization, BIP-340 uses tagged hashes. Build the `Msg` from your hash: + +```haskell +let Just m = msg hashBytes + s = signMsgLowR ctx key m -- or signMsg for plain RFC 6979 +``` + +Signing is deterministic: the same key and hash give the same signature, so +there is no random number generator to get wrong. + +### 4. Serialize for the wire + +Never send the `get` bytes of a `PubKey` or `Sig`: they are libsecp256k1's +internal layout. Use the standard encodings: + +```haskell +let pubBytes = exportPubKey ctx True pub -- 33-byte compressed SEC1 + derBytes = exportSig ctx s -- DER, as in Bitcoin transactions + compactBytes = exportCompactSig ctx s -- 64 bytes r || s +``` + +### 5. Parse and verify what you receive + +```haskell +verified = fromMaybe False $ do + pub <- importPubKey ctx pubBytes + s <- importSig ctx derBytes + m <- msg hashBytes + return (verifySig ctx pub (normalizeSig ctx s) m) +``` + +Every import returns `Maybe`, so malformed input is handled in one place. +`normalizeSig` is there because `verifySig` only accepts lower-S signatures; +apply it when the signature may come from software that does not produce them, +such as old Bitcoin transactions. Leave it out when your protocol requires +lower-S, as Bitcoin's relay rules do. + +### 6. Move to Schnorr where the protocol allows + +```haskell +sig <- signSchnorrIO ctx key m +let ok = verifySchnorr ctx pub sig m + xonly = exportXOnlyPubKey ctx pub -- 32 bytes, as BIP-340 publishes keys +``` + +Schnorr signatures are always 64 bytes, are not malleable, and are what Taproot +uses. `signSchnorrIO` mixes fresh randomness into the nonce, as BIP-340 +recommends, to protect against fault attacks. + +## Concepts + +### Values + +| Type | What it holds | Built with | +| ------------ | -------------------------------------------------------- | --------------------------------------- | +| `SecKey` | 32-byte number from 1 to n − 1 | `secKey`, `IsString` | +| `PubKey` | A point on the curve | `importPubKey`, `derivePubKey` | +| `Msg` | 32-byte hash | `msg` | +| `Sig` | ECDSA signature with both components from 1 to n − 1 | `signMsg`, `importSig`, `importCompactSig` | +| `CompactSig` | 64 bytes, r ‖ s | `exportCompactSig`, `compactSig` | +| `SchnorrSig` | 64-byte BIP-340 signature | `signSchnorr`, `schnorrSig` | +| `Tweak` | 32-byte number from 0 to n − 1 | `tweak` | +| `RecSig` | ECDSA signature with its recovery id | `signRecMsg`, `importCompactRecSig` | + +Here n is the order of the curve. The raw constructors are hidden, so these +are the only ways to build values. Each type has a `get` field with its bytes. + +### Contexts + +Every operation takes a `Ctx`. It is created once, shared freely between +threads, and destroyed by the garbage collector. The only operation that +modifies a context is `randomizeContext`, which needs exclusive access; most +programs never call it. + +### Errors + +Parsing and constructing return `Maybe`. Arithmetic that can produce an +invalid result, such as a tweak that cancels a key, returns `Maybe`. Pure +operations on valid values, such as signing, cannot fail and return their +result directly. Programming errors, such as a value of the wrong length built +with an internal constructor, raise an exception. + +## Usage guide + +### Lower-S and low-R + +```haskell +isLowS ctx s -- the form verifySig accepts +isLowR ctx s -- r below 2^255, so DER is at most 70 bytes +normalizeSig ctx s -- the lower-S form of any signature +``` + +### Key tweaking + +```haskell +let Just t = tweak tweakBytes + Just childKey = tweakAddSecKey ctx parentKey t + Just childPub = tweakAddPubKey ctx parentPub t +-- derivePubKey ctx childKey == childPub +``` + +This is the operation behind BIP-32 derivation; the tweak itself comes from an +HMAC of the chain code, computed by haskoin-core. `tweakMulSecKey`, +`tweakMulPubKey`, `tweakNegate` and `combinePubKeys` cover the other group +operations. + +### Taproot + +```haskell +let Just t = tweak taprootTweakBytes -- tagged hash of key and script tree + Just outputKey = tweakAddXOnlyPubKey ctx internalKey t + Just outputSecKey = tweakAddXOnlySecKey ctx internalSecKey t +``` + +Computing the tweak, a BIP-341 tagged hash, is left to the caller. + +### Bitcoin signed messages + +```haskell +import Crypto.Secp256k1.Recovery + +let r = signRecMsg ctx key m + (compact, recId) = exportCompactRecSig ctx r +-- the 65-byte message signature is a header byte (27 + recId, + 4 if the key +-- is compressed) followed by the 64 compact bytes +recover ctx r m -- Just the signer's PubKey +``` + +### Testing with QuickCheck + +`SecKey`, `Msg` and `Tweak` have `Arbitrary` instances, so properties can +range over them directly. With a context `ctx` created once for the test suite: + +```haskell +prop_roundTrip :: SecKey -> Msg -> Bool +prop_roundTrip key m = + verifySig ctx (derivePubKey ctx key) (signMsg ctx key m) m +``` + +## Differences from Bitcoin Core + +| Topic | This package | Bitcoin Core | +| -------------------------- | ------------------------------------------------ | ------------------------------------- | +| ECDSA nonce | `signMsg`: plain RFC 6979 | Grinds for low R | +| Low-R signatures | `signMsgLowR`: same grinding, same signatures | Default since 0.17 | +| High-S signatures | `verifySig` refuses them; use `normalizeSig` | Normalizes before verifying | +| Verify after ECDSA signing | No | Yes, as a precaution | +| Taproot tweak when signing | Separate step: `tweakAddXOnlySecKey` | Built into Schnorr signing | +| Message signatures | `signRecMsg`, no grinding | Same, so signatures are identical | + +## Module overview + +| Module | Contents | +| --------------------------------------- | --------------------------------------------------------- | +| `Crypto.Secp256k1` | The public API: contexts, keys, ECDSA, Schnorr, tweaks | +| `Crypto.Secp256k1.Recovery` | Recoverable signatures and public key recovery | +| `Crypto.Secp256k1.Internal.*` | Raw constructors and foreign imports; no stability promise | + +## Security notes + +- **Secret keys stay in memory.** A `SecKey` is an ordinary `ByteString`. The + garbage collector may copy it, and nothing clears it when it is no longer + used. If your threat model includes an attacker reading process memory, + keep keys in a hardware device instead. +- **`Show` prints secret keys.** Showing a record that holds a `SecKey`, in a + log line or an error message, reveals it. +- **Verification only proves what was signed.** It is your protocol's job to + hash the right data; signing a hash an attacker chose is as good as signing + whatever they want. +- **Use fresh randomness for Schnorr when you can.** `signSchnorrIO` protects + against fault attacks that deterministic signing does not. +- **Keep libsecp256k1 up to date.** Security fixes land in the C library; + this package only binds it. + +## Development + +```sh +git clone https://github.com/jprupp/secp256k1-haskell.git +cd secp256k1-haskell + +stack build # build against the system library +stack --nix build # or take GHC and libsecp256k1 from nixpkgs +stack test # run the tests +stack haddock --no-haddock-deps # build the API documentation +``` + +`package.yaml` is the source of the package description. Change it rather than +`secp256k1-haskell.cabal`, which [hpack](https://github.com/sol/hpack) +generates. + +The tests are in `test/` and use [hspec](https://hspec.github.io/) and +QuickCheck, with published test vectors from RFC 6979, Bitcoin Core and +BIP-340. CI runs them with the system library and +with `stack --nix`. + +### Contributing + +Pull requests are welcome. + +- Add tests for the behaviour you change, with published test vectors where + they exist. +- Keep the documentation in step with the code, as `CLAUDE.md` describes. +- Describe the change in `CHANGELOG.md`, which follows + [Keep a Changelog](https://keepachangelog.com/en/1.0.0/). + +## Related projects + +- [haskoin-core](https://github.com/jprupp/haskoin-core) builds Bitcoin keys, + addresses, transactions and PSBTs on this package. +- [libsecp256k1](https://github.com/bitcoin-core/secp256k1) is the C library + underneath. + +## License + +secp256k1-haskell is released under the +[MIT License](https://github.com/jprupp/secp256k1-haskell/blob/master/LICENSE). diff --git a/cbits/illegal_callback.c b/cbits/illegal_callback.c new file mode 100644 --- /dev/null +++ b/cbits/illegal_callback.c @@ -0,0 +1,17 @@ +/* + * Illegal-argument callback installed on every context this package creates. + * + * The default callback of libsecp256k1 prints the message to stderr and calls + * abort(). That kills the whole Haskell process and cannot be caught. With + * this callback installed, the C function that received the illegal argument + * returns 0 instead, and the Haskell side turns that into Nothing, False or + * an ErrorCall exception. + * + * The error callback, which reports internal consistency failures of the + * library itself, keeps its default. Those indicate a broken build and + * should still abort. + */ +void secp256k1_haskell_illegal_callback(const char *message, void *data) { + (void)message; + (void)data; +} diff --git a/secp256k1-haskell.cabal b/secp256k1-haskell.cabal --- a/secp256k1-haskell.cabal +++ b/secp256k1-haskell.cabal @@ -1,19 +1,18 @@ -cabal-version: 1.24 +cabal-version: 2.0 --- This file has been generated from package.yaml by hpack version 0.34.2. +-- This file has been generated from package.yaml by hpack version 0.39.6. -- -- see: https://github.com/sol/hpack name: secp256k1-haskell -version: 0.5.0 +version: 2.0.1 synopsis: Bindings for secp256k1 description: Sign and verify signatures using the secp256k1 library. category: Crypto -homepage: http://github.com/haskoin/secp256k1-haskell#readme -bug-reports: https://github.com/haskoin/secp256k1-haskell.git/issues -author: Jean-Pierre Rupp +homepage: http://github.com/jprupp/secp256k1-haskell#readme +bug-reports: https://github.com/jprupp/secp256k1-haskell/issues +author: JP Rupp maintainer: jprupp@protonmail.ch -copyright: (c) 2017 Jean-Pierre Rupp license: MIT license-file: LICENSE build-type: Simple @@ -23,57 +22,76 @@ source-repository head type: git - location: https://github.com/haskoin/secp256k1-haskell.git + location: https://github.com/jprupp/secp256k1-haskell +flag recovery + description: Bind the ECDSA public key recovery module of libsecp256k1. The library must have been built with it (--enable-module-recovery), as the packages of the Linux distributions, Homebrew and Nixpkgs are. Turn the flag off for a library built without it. + manual: True + default: True + library exposed-modules: Crypto.Secp256k1 - Crypto.Secp256k1.Internal + Crypto.Secp256k1.Internal.Base + Crypto.Secp256k1.Internal.BaseOps + Crypto.Secp256k1.Internal.Context + Crypto.Secp256k1.Internal.ForeignTypes + Crypto.Secp256k1.Internal.Util Paths_secp256k1_haskell autogen-modules: Paths_secp256k1_haskell hs-source-dirs: src + ghc-options: -Wall + c-sources: + cbits/illegal_callback.c pkgconfig-depends: - libsecp256k1 + libsecp256k1 >= 0.2.0 build-depends: - QuickCheck >=2.9.2 && <2.15 + QuickCheck >=2.9.2 , base >=4.9 && <5 - , base16-bytestring >=0.1.1.6 && <1.1 - , bytestring >=0.10.8 && <0.11 - , cereal >=0.5.4 && <0.6 - , deepseq >=1.4.2 && <1.5 - , entropy >=0.3.8 && <0.5 - , hashable >=1.2.6 && <1.4 - , string-conversions >=0.4 && <0.5 - , unliftio-core >=0.1.0 && <0.3 + , base16 >=2.0 + , bytestring >=0.10.8 + , deepseq >=1.4.2 + , entropy >=0.3.8 + , hashable >=1.2.6 + , string-conversions >=0.4 default-language: Haskell2010 + if flag(recovery) + exposed-modules: + Crypto.Secp256k1.Internal.Recovery + Crypto.Secp256k1.Internal.RecoveryOps + Crypto.Secp256k1.Recovery test-suite spec type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: + Crypto.Secp256k1.Fixtures Crypto.Secp256k1.InternalSpec + Crypto.Secp256k1.RecoverySpec Crypto.Secp256k1Spec Paths_secp256k1_haskell + autogen-modules: + Paths_secp256k1_haskell hs-source-dirs: test - ghc-options: -threaded -rtsopts -with-rtsopts=-N + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N build-depends: HUnit - , QuickCheck >=2.9.2 && <2.15 + , QuickCheck >=2.9.2 , base >=4.9 && <5 - , base16-bytestring >=0.1.1.6 && <1.1 - , bytestring >=0.10.8 && <0.11 - , cereal >=0.5.4 && <0.6 - , deepseq >=1.4.2 && <1.5 - , entropy >=0.3.8 && <0.5 - , hashable >=1.2.6 && <1.4 + , base16 >=2.0 + , bytestring >=0.10.8 + , deepseq >=1.4.2 + , entropy >=0.3.8 + , hashable >=1.2.6 , hspec , monad-par , mtl , secp256k1-haskell - , string-conversions >=0.4 && <0.5 - , unliftio-core >=0.1.0 && <0.3 + , string-conversions >=0.4 default-language: Haskell2010 + if flag(recovery) + cpp-options: -DRECOVERY build-tool-depends: hspec-discover:hspec-discover diff --git a/src/Crypto/Secp256k1.hs b/src/Crypto/Secp256k1.hs --- a/src/Crypto/Secp256k1.hs +++ b/src/Crypto/Secp256k1.hs @@ -1,445 +1,185 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-| -Module : Crypto.Secp256k1 -License : UNLICENSE -Maintainer : Jean-Pierre Rupp -Stability : experimental -Portability : POSIX +{-# LANGUAGE DuplicateRecordFields #-} -Crytpographic functions from Bitcoin’s secp256k1 library. --} +-- | ECDSA and BIP-340 Schnorr signatures on the secp256k1 curve, through +-- . +-- +-- == Purpose +-- +-- secp256k1 is the elliptic curve of Bitcoin, and libsecp256k1 is the C +-- library Bitcoin Core uses for it: constant-time where secrets are involved, +-- hardened against side channels, exhaustively tested and reviewed. Getting +-- elliptic curve cryptography right is hard enough that a Haskell program +-- should not reimplement it. This package gives Haskell the same library, with +-- types that make the common mistakes hard to make. +-- +-- == Design +-- +-- * __Valid by construction.__ Every value goes through a smart constructor or +-- an import function that checks it. Code that holds a 'PubKey' or a 'Sig' +-- never has to wonder whether it is a point on the curve or a well-formed +-- signature, and invalid input is refused at the boundary where it arrives. +-- +-- * __Never abort.__ The C library calls @abort()@ on an illegal argument by +-- default, which kills the whole Haskell process and cannot be caught. Every +-- context this package creates replaces that callback, so a bad argument +-- becomes 'Nothing', 'False' or an exception instead. +-- +-- * __Pure where the mathematics is pure.__ Signing, verifying and tweaking are +-- deterministic functions of their inputs, so they are pure functions here. +-- Only the operations that need fresh randomness, such as 'signSchnorrIO' +-- and 'randomizeContext', run in 'IO'. +-- +-- * __Standard encodings at the edges.__ Values print and parse in the encodings +-- other software understands (SEC1, DER, compact, BIP-340), never in the +-- library's internal memory layout, which differs between platforms. +-- +-- * __Bitcoin Core compatibility is explicit.__ Where Bitcoin Core does +-- something beyond the standards, such as low-R grinding or accepting high-S +-- signatures from old blocks, this package offers it as a separate function +-- and documents the difference, rather than silently picking one behaviour. +-- +-- == Values +-- +-- Every value is built through a smart constructor or an import function +-- that validates it, so a value of one of these types is always well formed: +-- +-- * 'SecKey': a 32-byte big-endian number in the range 1 to n−1, where n is +-- the order of the curve ('secKey'). +-- * 'PubKey': a point on the curve ('importPubKey' for the SEC1 encoding). +-- * 'Sig': a signature whose components are both in the range 1 to n−1 +-- ('importSig' for DER, 'importCompactSig' for the compact encoding). +-- * 'Msg': a 32-byte hash ('msg'). +-- * 'Tweak': a 32-byte big-endian number in the range 0 to n−1 ('tweak'). +-- * 'SchnorrSig': a 64-byte BIP-340 signature ('schnorrSig' checks the +-- length, 'verifySchnorr' the values). +-- +-- The @get@ field of each type gives its bytes. For 'SecKey', 'Msg', 'Tweak', +-- 'CompactSig' and 'SchnorrSig' these are the standard big-endian bytes. For 'PubKey' and +-- 'Sig' they are the internal representation of libsecp256k1, which is +-- opaque and not portable. Use 'exportPubKey', 'exportSig' and +-- 'exportCompactSig' to serialize those. +-- +-- 'Show', 'Read' and 'Data.String.IsString' use hex of a standard encoding: compressed +-- SEC1 for 'PubKey', compact for 'Sig', and the plain bytes for the others. +-- 'Show' prints secret keys. See 'SecKey' for what that means for logging. +-- +-- The raw constructors are not exported from this module. They are in +-- "Crypto.Secp256k1.Internal.Base", which has no API stability guarantee. +-- +-- == Schnorr signatures +-- +-- BIP-340 public keys are x-only: the 32-byte x coordinate of a point whose +-- y coordinate is even. This module keeps them as 'PubKey' and converts with +-- 'importXOnlyPubKey' and 'exportXOnlyPubKey'. 'verifySchnorr' uses only the +-- x coordinate, so a key and its negation verify the same signatures. +-- 'tweakAddXOnlyPubKey' and 'tweakAddXOnlySecKey' apply a BIP-341 Taproot +-- tweak. Computing the tweak itself, a tagged hash of the internal key and +-- the script tree, is left to the caller. +-- +-- 'signSchnorr' is deterministic. BIP-340 recommends fresh auxiliary +-- randomness for every signature, which 'signSchnorrIO' provides. Every +-- Schnorr signing function verifies the signature before returning it, as +-- BIP-340 requires. +-- +-- == Contexts +-- +-- Every operation takes a 'Ctx'. Create one with 'createContext' and share it +-- between threads. Only 'randomizeContext' modifies a context and needs +-- exclusive access. +-- +-- == Differences from Bitcoin Core +-- +-- 'signMsg' is plain RFC 6979 and matches the published test vectors. +-- Bitcoin Core also grinds the nonce until r is below 2^255, which keeps DER +-- signatures at 70 bytes. 'signMsgLowR' does the same and gives the same +-- signatures as Bitcoin Core. +-- +-- 'verifySig' only accepts lower-S signatures, as libsecp256k1 does. Bitcoin +-- Core normalizes a signature before verifying it, because high-S signatures +-- exist in old blocks. Use 'normalizeSig' before 'verifySig' for that. +-- +-- Bitcoin Core verifies every ECDSA signature it makes, as a precaution +-- against a corrupted signature. 'signMsg' does not. The Schnorr signing +-- functions do, because BIP-340 requires it. +-- +-- Bitcoin Core's Schnorr signing applies the Taproot tweak itself when it is +-- given a Merkle root. Here 'tweakAddXOnlySecKey' does that step separately. +-- +-- == Public key recovery +-- +-- ECDSA public key recovery, which Bitcoin signed messages use, is in the +-- module @Crypto.Secp256k1.Recovery@. It is built when the @recovery@ flag of +-- the package is on, which is the default. module Crypto.Secp256k1 - ( -- * Messages - Msg - , msg - , getMsg + ( -- * Context + Ctx, + withContext, + createContext, + randomizeContext, + cloneContext, + -- * Messages + Msg (get), + msg, + -- * Secret Keys - , SecKey - , secKey - , getSecKey - , derivePubKey + SecKey (get), + secKey, + derivePubKey, -- * Public Keys - , PubKey - , importPubKey - , exportPubKey + PubKey (get), + pubKey, + importPubKey, + exportPubKey, -- * Signatures - , Sig - , signMsg - , verifySig - , normalizeSig + Sig (get), + sig, + signMsg, + signMsgLowR, + verifySig, + normalizeSig, + isLowS, + isLowR, + -- ** DER - , importSig - , exportSig + importSig, + exportSig, + -- ** Compact - , CompactSig - , getCompactSig - , compactSig - , exportCompactSig - , importCompactSig + CompactSig (get), + compactSig, + exportCompactSig, + importCompactSig, -- * Addition & Multiplication - , Tweak - , tweak - , getTweak - , tweakAddSecKey - , tweakMulSecKey - , tweakAddPubKey - , tweakMulPubKey - , combinePubKeys - , tweakNegate - ) where - -import Control.DeepSeq (NFData) -import Control.Monad (replicateM, unless, (<=<)) -import Crypto.Secp256k1.Internal -import Data.ByteString (ByteString) -import qualified Data.ByteString as BS -import qualified Data.ByteString.Base16 as B16 -import Data.Hashable (Hashable (..)) -import Data.Maybe (fromJust, fromMaybe, isJust) -import Data.Serialize (Serialize (..), getByteString, - putByteString) -import Data.String (IsString (..)) -import Data.String.Conversions (ConvertibleStrings, cs) -import Foreign (alloca, allocaArray, allocaBytes, - free, mallocBytes, nullFunPtr, - nullPtr, peek, poke, pokeArray) -import GHC.Generics (Generic) -import System.IO.Unsafe (unsafePerformIO) -import Test.QuickCheck (Arbitrary (..), - arbitraryBoundedRandom, suchThat) -import Text.Read (Lexeme (String), lexP, parens, - pfail, readPrec) - -newtype PubKey = PubKey { getPubKey :: ByteString } - deriving (Eq, Generic, NFData) -newtype Msg = Msg { getMsg :: ByteString } - deriving (Eq, Generic, NFData) -newtype Sig = Sig { getSig :: ByteString } - deriving (Eq, Generic, NFData) -newtype SecKey = SecKey { getSecKey :: ByteString } - deriving (Eq, Generic, NFData) -newtype Tweak = Tweak { getTweak :: ByteString } - deriving (Eq, Generic, NFData) -newtype CompactSig = CompactSig { getCompactSig :: ByteString } - deriving (Eq, Generic, NFData) - -instance Serialize PubKey where - put (PubKey bs) = putByteString bs - get = PubKey <$> getByteString 64 - -instance Serialize Msg where - put (Msg m) = putByteString m - get = Msg <$> getByteString 32 - -instance Serialize Sig where - put (Sig bs) = putByteString bs - get = Sig <$> getByteString 64 - -instance Serialize SecKey where - put (SecKey bs) = putByteString bs - get = SecKey <$> getByteString 32 - -instance Serialize Tweak where - put (Tweak bs) = putByteString bs - get = Tweak <$> getByteString 32 - -instance Serialize CompactSig where - put (CompactSig bs) = putByteString bs - get = CompactSig <$> getByteString 64 - -decodeHex :: ConvertibleStrings a ByteString => a -> Maybe ByteString -#if MIN_VERSION_base16_bytestring(1,0,0) -decodeHex str = case B16.decode $ cs str of - Right bs -> Just bs - Left _ -> Nothing -#else -decodeHex str = if BS.null r then Just bs else Nothing where - (bs, r) = B16.decode $ cs str -#endif - -instance Read PubKey where - readPrec = do - String str <- lexP - maybe pfail return $ importPubKey =<< decodeHex str - -instance Hashable PubKey where - i `hashWithSalt` k = i `hashWithSalt` exportPubKey True k - -instance IsString PubKey where - fromString = fromMaybe e . (importPubKey <=< decodeHex) where - e = error "Could not decode public key from hex string" - -instance Show PubKey where - showsPrec _ = shows . B16.encode . exportPubKey True - -instance Read Msg where - readPrec = parens $ do - String str <- lexP - maybe pfail return $ msg =<< decodeHex str - -instance Hashable Msg where - i `hashWithSalt` m = i `hashWithSalt` getMsg m - -instance IsString Msg where - fromString = fromMaybe e . (msg <=< decodeHex) where - e = error "Could not decode message from hex string" - -instance Show Msg where - showsPrec _ = shows . B16.encode . getMsg - -instance Read Sig where - readPrec = parens $ do - String str <- lexP - maybe pfail return $ importSig =<< decodeHex str - -instance IsString Sig where - fromString = fromMaybe e . (importSig <=< decodeHex) where - e = error "Could not decode signature from hex string" - -instance Hashable Sig where - i `hashWithSalt` s = i `hashWithSalt` exportSig s - -instance Show Sig where - showsPrec _ = shows . B16.encode . exportSig - -instance Read SecKey where - readPrec = parens $ do - String str <- lexP - maybe pfail return $ secKey =<< decodeHex str - -instance Hashable SecKey where - i `hashWithSalt` k = i `hashWithSalt` getSecKey k - -instance IsString SecKey where - fromString = fromMaybe e . (secKey <=< decodeHex) where - e = error "Colud not decode secret key from hex string" - -instance Show SecKey where - showsPrec _ = shows . B16.encode . getSecKey - -instance Hashable Tweak where - i `hashWithSalt` t = i `hashWithSalt` getTweak t - -instance Read Tweak where - readPrec = parens $ do - String str <- lexP - maybe pfail return $ tweak =<< decodeHex str - -instance IsString Tweak where - fromString = fromMaybe e . (tweak <=< decodeHex) where - e = error "Could not decode tweak from hex string" - -instance Show Tweak where - showsPrec _ = shows . B16.encode . getTweak - --- | Import 32-byte 'ByteString' as 'Msg'. -msg :: ByteString -> Maybe Msg -msg bs - | BS.length bs == 32 = Just (Msg bs) - | otherwise = Nothing - --- | Import 32-byte 'ByteString' as 'SecKey'. -secKey :: ByteString -> Maybe SecKey -secKey bs - | BS.length bs == 32 = Just (SecKey bs) - | otherwise = Nothing - -compactSig :: ByteString -> Maybe CompactSig -compactSig bs - | BS.length bs == 64 = Just (CompactSig bs) - | otherwise = Nothing - --- | Convert signature to a normalized lower-S form. 'Nothing' indicates that it --- was already normal. -normalizeSig :: Sig -> Maybe Sig -normalizeSig (Sig sig) = unsafePerformIO $ - unsafeUseByteString sig $ \(sig_in, _) -> do - sig_out <- mallocBytes 64 - ret <- ecdsaSignatureNormalize ctx sig_out sig_in - if isSuccess ret - then do - bs <- unsafePackByteString (sig_out, 64) - return (Just (Sig bs)) - else do - free sig_out - return Nothing - --- | 32-Byte 'ByteString' as 'Tweak'. -tweak :: ByteString -> Maybe Tweak -tweak bs - | BS.length bs == 32 = Just (Tweak bs) - | otherwise = Nothing - --- | Import DER-encoded public key. -importPubKey :: ByteString -> Maybe PubKey -importPubKey bs = unsafePerformIO $ - unsafeUseByteString bs $ \(input, len) -> do - pub_key <- mallocBytes 64 - ret <- ecPubKeyParse ctx pub_key input len - if isSuccess ret - then do - out <- unsafePackByteString (pub_key, 64) - return (Just (PubKey out)) - else do - free pub_key - return Nothing - --- | Encode public key as DER. First argument 'True' for compressed output. -exportPubKey :: Bool -> PubKey -> ByteString -exportPubKey compress (PubKey in_bs) = unsafePerformIO $ - unsafeUseByteString in_bs $ \(in_ptr, _) -> - alloca $ \len_ptr -> - allocaBytes len $ \out_ptr -> do - poke len_ptr $ fromIntegral len - ret <- ecPubKeySerialize ctx out_ptr len_ptr in_ptr flags - unless (isSuccess ret) $ error "could not serialize public key" - final_len <- peek len_ptr - packByteString (out_ptr, final_len) - where - len = if compress then 33 else 65 - flags = if compress then compressed else uncompressed - -exportCompactSig :: Sig -> CompactSig -exportCompactSig (Sig sig_bs) = unsafePerformIO $ - unsafeUseByteString sig_bs $ \(sig_ptr, _) -> do - out_ptr <- mallocBytes 64 - ret <- ecdsaSignatureSerializeCompact ctx out_ptr sig_ptr - unless (isSuccess ret) $ do - free out_ptr - error "Could not obtain compact signature" - out_bs <- unsafePackByteString (out_ptr, 64) - return $ CompactSig out_bs - -importCompactSig :: CompactSig -> Maybe Sig -importCompactSig (CompactSig compact_sig) = unsafePerformIO $ - unsafeUseByteString compact_sig $ \(compact_ptr, _) -> do - out_sig <- mallocBytes 64 - ret <- ecdsaSignatureParseCompact ctx out_sig compact_ptr - if isSuccess ret - then do - out_bs <- unsafePackByteString (out_sig, 64) - return (Just (Sig out_bs)) - else do - free out_sig - return Nothing - --- | Import DER-encoded signature. -importSig :: ByteString -> Maybe Sig -importSig bs = unsafePerformIO $ - unsafeUseByteString bs $ \(in_ptr, in_len) -> do - out_sig <- mallocBytes 64 - ret <- ecdsaSignatureParseDer ctx out_sig in_ptr in_len - if isSuccess ret - then do - out_bs <- unsafePackByteString (out_sig, 64) - return (Just (Sig out_bs)) - else do - free out_sig - return Nothing - --- | Encode signature as strict DER. -exportSig :: Sig -> ByteString -exportSig (Sig in_sig) = unsafePerformIO $ - unsafeUseByteString in_sig $ \(in_ptr, _) -> - alloca $ \out_len -> - allocaBytes 72 $ \out_ptr -> do - poke out_len 72 - ret <- ecdsaSignatureSerializeDer ctx out_ptr out_len in_ptr - unless (isSuccess ret) $ error "could not serialize signature" - final_len <- peek out_len - packByteString (out_ptr, final_len) - --- | Verify message signature. 'True' means that the signature is correct. -verifySig :: PubKey -> Sig -> Msg -> Bool -verifySig (PubKey pub_key) (Sig sig) (Msg m) = unsafePerformIO $ - unsafeUseByteString pub_key $ \(pub_key_ptr, _) -> - unsafeUseByteString sig $ \(sig_ptr, _) -> - unsafeUseByteString m $ \(msg_ptr, _) -> - isSuccess <$> ecdsaVerify ctx sig_ptr msg_ptr pub_key_ptr - -signMsg :: SecKey -> Msg -> Sig -signMsg (SecKey sec_key) (Msg m) = unsafePerformIO $ - unsafeUseByteString sec_key $ \(sec_key_ptr, _) -> - unsafeUseByteString m $ \(msg_ptr, _) -> do - sig_ptr <- mallocBytes 64 - ret <- ecdsaSign ctx sig_ptr msg_ptr sec_key_ptr nullFunPtr nullPtr - unless (isSuccess ret) $ do - free sig_ptr - error "could not sign message" - Sig <$> unsafePackByteString (sig_ptr, 64) - -derivePubKey :: SecKey -> PubKey -derivePubKey (SecKey sec_key) = unsafePerformIO $ - unsafeUseByteString sec_key $ \(sec_key_ptr, _) -> do - pub_key_ptr <- mallocBytes 64 - ret <- ecPubKeyCreate ctx pub_key_ptr sec_key_ptr - unless (isSuccess ret) $ do - free pub_key_ptr - error "could not compute public key" - PubKey <$> unsafePackByteString (pub_key_ptr, 64) - - --- | Add tweak to secret key. -tweakAddSecKey :: SecKey -> Tweak -> Maybe SecKey -tweakAddSecKey (SecKey sec_key) (Tweak t) = unsafePerformIO $ - unsafeUseByteString new_bs $ \(sec_key_ptr, _) -> - unsafeUseByteString t $ \(tweak_ptr, _) -> do - ret <- ecSecKeyTweakAdd ctx sec_key_ptr tweak_ptr - if isSuccess ret - then return (Just (SecKey new_bs)) - else return Nothing - where - new_bs = BS.copy sec_key - --- | Multiply secret key by tweak. -tweakMulSecKey :: SecKey -> Tweak -> Maybe SecKey -tweakMulSecKey (SecKey sec_key) (Tweak t) = unsafePerformIO $ - unsafeUseByteString new_bs $ \(sec_key_ptr, _) -> - unsafeUseByteString t $ \(tweak_ptr, _) -> do - ret <- ecSecKeyTweakMul ctx sec_key_ptr tweak_ptr - if isSuccess ret - then return (Just (SecKey new_bs)) - else return Nothing - where - new_bs = BS.copy sec_key - --- | Add tweak to public key. Tweak is multiplied first by G to obtain a point. -tweakAddPubKey :: PubKey -> Tweak -> Maybe PubKey -tweakAddPubKey (PubKey pub_key) (Tweak t) = unsafePerformIO $ - unsafeUseByteString new_bs $ \(pub_key_ptr, _) -> - unsafeUseByteString t $ \(tweak_ptr, _) -> do - ret <- ecPubKeyTweakAdd ctx pub_key_ptr tweak_ptr - if isSuccess ret - then return (Just (PubKey new_bs)) - else return Nothing - where - new_bs = BS.copy pub_key - --- | Multiply public key by tweak. Tweak is multiplied first by G to obtain a --- point. -tweakMulPubKey :: PubKey -> Tweak -> Maybe PubKey -tweakMulPubKey (PubKey pub_key) (Tweak t) = unsafePerformIO $ - unsafeUseByteString new_bs $ \(pub_key_ptr, _) -> - unsafeUseByteString t $ \(tweak_ptr, _) -> do - ret <- ecPubKeyTweakMul ctx pub_key_ptr tweak_ptr - if isSuccess ret - then return (Just (PubKey new_bs)) - else return Nothing - where - new_bs = BS.copy pub_key - --- | Add multiple public keys together. -combinePubKeys :: [PubKey] -> Maybe PubKey -combinePubKeys [] = Nothing -combinePubKeys pubs = unsafePerformIO $ - pointers [] pubs $ \ps -> - allocaArray (length ps) $ \a -> do - out <- mallocBytes 64 - pokeArray a ps - ret <- ecPubKeyCombine ctx out a (fromIntegral $ length ps) - if isSuccess ret - then do - bs <- unsafePackByteString (out, 64) - return (Just (PubKey bs)) - else do - free out - return Nothing - where - pointers ps [] f = f ps - pointers ps (PubKey pub_key : pub_keys) f = - unsafeUseByteString pub_key $ \(p, _) -> - pointers (p : ps) pub_keys f + Tweak (get), + tweak, + tweakAddSecKey, + tweakMulSecKey, + tweakAddPubKey, + tweakMulPubKey, + combinePubKeys, + tweakNegate, -tweakNegate :: Tweak -> Maybe Tweak -tweakNegate (Tweak t) = unsafePerformIO $ - unsafeUseByteString new $ \(out, _) -> do - ret <- ecTweakNegate ctx out - if isSuccess ret - then return (Just (Tweak new)) - else return Nothing - where - new = BS.copy t + -- * Schnorr Signatures (BIP-340) + SchnorrSig (get), + schnorrSig, + signSchnorr, + signSchnorrWithAux, + signSchnorrIO, + verifySchnorr, -instance Arbitrary Msg where - arbitrary = gen_msg - where - valid_bs = bs_gen `suchThat` isJust - bs_gen = msg . BS.pack <$> replicateM 32 arbitraryBoundedRandom - gen_msg = fromJust <$> valid_bs + -- ** X-Only Public Keys + importXOnlyPubKey, + exportXOnlyPubKey, -instance Arbitrary SecKey where - arbitrary = gen_key where - valid_bs = bs_gen `suchThat` isJust - bs_gen = secKey . BS.pack <$> replicateM 32 arbitraryBoundedRandom - gen_key = fromJust <$> valid_bs + -- ** Taproot Tweaks (BIP-341) + tweakAddXOnlyPubKey, + tweakAddXOnlySecKey, + ) +where -instance Arbitrary PubKey where - arbitrary = derivePubKey <$> arbitrary +import Crypto.Secp256k1.Internal.Base +import Crypto.Secp256k1.Internal.Context diff --git a/src/Crypto/Secp256k1/Internal.hs b/src/Crypto/Secp256k1/Internal.hs deleted file mode 100644 --- a/src/Crypto/Secp256k1/Internal.hs +++ /dev/null @@ -1,270 +0,0 @@ -{-| -Module : Crypto.Secp256k1.Internal -License : UNLICENSE -Maintainer : Jean-Pierre Rupp -Stability : experimental -Portability : POSIX - -The API for this module may change at any time. This is an internal module only -exposed for hacking and experimentation. --} -module Crypto.Secp256k1.Internal where - -import Data.ByteString (ByteString) -import qualified Data.ByteString as BS -import qualified Data.ByteString.Unsafe as BU -import Foreign (FunPtr, Ptr, castPtr) -import Foreign.C (CInt (..), CSize (..), CString, CUChar, - CUInt (..)) -import System.IO.Unsafe (unsafePerformIO) - -data LCtx -data PubKey64 -data Msg32 -data Sig64 -data Compact64 -data Seed32 -data SecKey32 -data Tweak32 - -type CtxFlags = CUInt -type SerFlags = CUInt -type Ret = CInt - -type NonceFun a = - Ptr CUChar -> - Ptr CUChar -> - Ptr CUChar -> - Ptr CUChar -> - Ptr a -> - CInt -> - IO CInt - -type Ctx = Ptr LCtx - -verify :: CtxFlags -verify = 0x0101 - -sign :: CtxFlags -sign = 0x0201 - -signVerify :: CtxFlags -signVerify = 0x0301 - -compressed :: SerFlags -compressed = 0x0102 - -uncompressed :: SerFlags -uncompressed = 0x0002 - -isSuccess :: Ret -> Bool -isSuccess 0 = False -isSuccess 1 = True -isSuccess n = error $ "isSuccess expected 0 or 1 but got " ++ show n - -unsafeUseByteString :: ByteString -> ((Ptr a, CSize) -> IO b) -> IO b -unsafeUseByteString bs f = - BU.unsafeUseAsCStringLen bs $ \(b, l) -> - f (castPtr b, fromIntegral l) - -useByteString :: ByteString -> ((Ptr a, CSize) -> IO b) -> IO b -useByteString bs f = - BS.useAsCStringLen bs $ \(b, l) -> - f (castPtr b, fromIntegral l) - -unsafePackByteString :: (Ptr a, CSize) -> IO ByteString -unsafePackByteString (b, l) = - BU.unsafePackMallocCStringLen (castPtr b, fromIntegral l) - -packByteString :: (Ptr a, CSize) -> IO ByteString -packByteString (b, l) = - BS.packCStringLen (castPtr b, fromIntegral l) - -ctx :: Ctx -ctx = unsafePerformIO $ contextCreate signVerify -{-# NOINLINE ctx #-} - -foreign import ccall safe - "secp256k1.h secp256k1_context_create" - contextCreate - :: CtxFlags - -> IO Ctx - -foreign import ccall safe - "secp256k1.h secp256k1_context_clone" - contextClone - :: Ctx - -> IO Ctx - -foreign import ccall safe - "secp256k1.h &secp256k1_context_destroy" - contextDestroy - :: FunPtr (Ctx -> IO ()) - -foreign import ccall safe - "secp256k1.h secp256k1_context_set_illegal_callback" - setIllegalCallback - :: Ctx - -> FunPtr (CString -> Ptr a -> IO ()) -- ^ message, data - -> Ptr a -- ^ data - -> IO () - -foreign import ccall safe - "secp256k1.h secp256k1_context_set_error_callback" - setErrorCallback - :: Ctx - -> FunPtr (CString -> Ptr a -> IO ()) -- ^ message, data - -> Ptr a -- ^ data - -> IO () - -foreign import ccall safe - "secp256k1.h secp256k1_ec_pubkey_parse" - ecPubKeyParse - :: Ctx - -> Ptr PubKey64 - -> Ptr CUChar -- ^ encoded public key array - -> CSize -- ^ size of encoded public key array - -> IO Ret - -foreign import ccall safe - "secp256k1.h secp256k1_ec_pubkey_serialize" - ecPubKeySerialize - :: Ctx - -> Ptr CUChar -- ^ array for encoded public key, must be large enough - -> Ptr CSize -- ^ size of encoded public key, will be updated - -> Ptr PubKey64 - -> SerFlags - -> IO Ret - -foreign import ccall safe - "secp256k1.h secp256k1_ecdsa_signature_parse_compact" - ecdsaSignatureParseCompact - :: Ctx - -> Ptr Sig64 - -> Ptr Compact64 - -> IO Ret - - -foreign import ccall safe - "secp256k1.h secp256k1_ecdsa_signature_parse_der" - ecdsaSignatureParseDer - :: Ctx - -> Ptr Sig64 - -> Ptr CUChar -- ^ encoded DER signature - -> CSize -- ^ size of encoded signature - -> IO Ret - -foreign import ccall safe - "secp256k1.h secp256k1_ecdsa_signature_serialize_der" - ecdsaSignatureSerializeDer - :: Ctx - -> Ptr CUChar -- ^ array for encoded signature, must be large enough - -> Ptr CSize -- ^ size of encoded signature, will be updated - -> Ptr Sig64 - -> IO Ret - -foreign import ccall safe - "secp256k1.h secp256k1_ecdsa_signature_serialize_compact" - ecdsaSignatureSerializeCompact - :: Ctx - -> Ptr Compact64 - -> Ptr Sig64 - -> IO Ret - -foreign import ccall safe - "secp256k1.h secp256k1_ecdsa_verify" - ecdsaVerify - :: Ctx - -> Ptr Sig64 - -> Ptr Msg32 - -> Ptr PubKey64 - -> IO Ret - -foreign import ccall safe - "secp256k1.h secp256k1_ecdsa_signature_normalize" - ecdsaSignatureNormalize - :: Ctx - -> Ptr Sig64 -- ^ output - -> Ptr Sig64 -- ^ input - -> IO Ret - -foreign import ccall safe - "secp256k1.h secp256k1_ecdsa_sign" - ecdsaSign - :: Ctx - -> Ptr Sig64 - -> Ptr Msg32 - -> Ptr SecKey32 - -> FunPtr (NonceFun a) - -> Ptr a -- ^ nonce data - -> IO Ret - -foreign import ccall safe - "secp256k1.h secp256k1_ec_seckey_verify" - ecSecKeyVerify - :: Ctx - -> Ptr SecKey32 - -> IO Ret - -foreign import ccall safe - "secp256k1.h secp256k1_ec_pubkey_create" - ecPubKeyCreate - :: Ctx - -> Ptr PubKey64 - -> Ptr SecKey32 - -> IO Ret - -foreign import ccall safe - "secp256k1.h secp256k1_ec_privkey_tweak_add" - ecSecKeyTweakAdd - :: Ctx - -> Ptr SecKey32 - -> Ptr Tweak32 - -> IO Ret - -foreign import ccall safe - "secp256k1.h secp256k1_ec_privkey_negate" - ecTweakNegate - :: Ctx - -> Ptr Tweak32 - -> IO Ret - -foreign import ccall unsafe - "secp256k1.h secp256k1_ec_pubkey_tweak_add" - ecPubKeyTweakAdd - :: Ctx - -> Ptr PubKey64 - -> Ptr Tweak32 - -> IO Ret - -foreign import ccall safe - "secp256k1.h secp256k1_ec_privkey_tweak_mul" - ecSecKeyTweakMul - :: Ctx - -> Ptr SecKey32 - -> Ptr Tweak32 - -> IO Ret - -foreign import ccall safe - "secp256k1.h secp256k1_ec_pubkey_tweak_mul" - ecPubKeyTweakMul - :: Ctx - -> Ptr PubKey64 - -> Ptr Tweak32 - -> IO Ret - -foreign import ccall safe - "secp256k1.h secp256k1_context_randomize" - contextRandomize - :: Ctx - -> Ptr Seed32 - -> IO Ret - -foreign import ccall safe - "secp256k1.h secp256k1_ec_pubkey_combine" - ecPubKeyCombine - :: Ctx - -> Ptr PubKey64 -- ^ pointer to public key storage - -> Ptr (Ptr PubKey64) -- ^ pointer to array of public keys - -> CInt -- ^ number of public keys - -> IO Ret diff --git a/src/Crypto/Secp256k1/Internal/Base.hs b/src/Crypto/Secp256k1/Internal/Base.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Secp256k1/Internal/Base.hs @@ -0,0 +1,837 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE NoFieldSelectors #-} + +-- | Internal module. Everything is exported, including the raw constructors +-- that "Crypto.Secp256k1" hides, and there is no API stability guarantee. +-- +-- A value built with a raw constructor skips validation. Every function here +-- still checks the length of its bytes before calling the C library and +-- raises an 'Control.Exception.ErrorCall' when the length is wrong, but it does not check the +-- content. A raw 'PubKey' or 'Sig' with invalid content makes functions +-- return 'Nothing', 'False' or throw, never abort or read outside a buffer. +module Crypto.Secp256k1.Internal.Base where + +import Control.DeepSeq (NFData) +import Control.Exception (evaluate, finally) +import Control.Monad (guard, join, replicateM, unless, (<=<)) +import Control.Monad.IO.Class (MonadIO, liftIO) +import Crypto.Secp256k1.Internal.BaseOps + ( ecPubKeyCombine, + ecPubKeyCreate, + ecPubKeyParse, + ecPubKeySerialize, + ecPubKeyTweakAdd, + ecPubKeyTweakMul, + ecSecKeyTweakAdd, + ecSecKeyTweakMul, + ecTweakNegate, + ecdsaSign, + ecdsaSignatureNormalize, + ecdsaSignatureParseCompact, + ecdsaSignatureParseDer, + ecdsaSignatureSerializeCompact, + ecdsaSignatureSerializeDer, + ecdsaVerify, + keyPairCreate, + keyPairSec, + keyPairXOnlyPub, + keyPairXOnlyTweakAdd, + schnorrSigSign32, + schnorrSigVerify, + xOnlyPubKeyFromPubKey, + xOnlyPubKeySerialize, + xOnlyPubKeyTweakAdd, + ) +import Crypto.Secp256k1.Internal.Context (Ctx (..), validationContext) +import Crypto.Secp256k1.Internal.ForeignTypes + ( KeyPair96, + LCtx, + SchnorrSig64, + XOnlyPubKey64, + compressed, + isSuccess, + uncompressed, + ) +import Crypto.Secp256k1.Internal.Util + ( decodeHex, + fillOutput, + packByteString, + showsHex, + unsafeUseByteString, + useFixedByteString, + withCopy, + withOutput, + wrongLength, + ) +import Data.Bits (shiftR) +import Data.ByteString (ByteString) +import Data.ByteString qualified as BS +import Data.Hashable (Hashable (..)) +import Data.Maybe (fromJust, fromMaybe, isJust) +import Data.String (IsString (..)) +import Data.Word (Word32) +import Foreign + ( Ptr, + alloca, + allocaArray, + allocaBytes, + castPtr, + fillBytes, + nullFunPtr, + nullPtr, + peek, + poke, + pokeArray, + withForeignPtr, + ) +import Foreign.C (CUChar) +import GHC.Generics (Generic) +import System.Entropy (getEntropy) +import System.IO.Unsafe (unsafePerformIO) +import Test.QuickCheck + ( Arbitrary (..), + arbitraryBoundedRandom, + suchThat, + ) +import Text.Read + ( Lexeme (String), + lexP, + parens, + pfail, + readPrec, + ) + +-- | Public key in the internal representation of libsecp256k1 (64 bytes). +-- +-- The bytes in @get@ are opaque. They are not a standard encoding, and they +-- are not portable between platforms or library versions. Use 'exportPubKey' +-- to serialize a key and 'importPubKey' to parse one. 'pubKey' only exists to +-- rebuild a key from the bytes of @get@ on the same platform. +-- +-- 'Show', 'Read' and 'IsString' use the compressed SEC1 encoding in hex. +-- 'Read' and 'IsString' also accept the uncompressed and hybrid encodings. +newtype PubKey = PubKey {get :: ByteString} + deriving (Eq, Generic, Hashable, NFData) + +-- | 32-byte message hash to sign or verify. +-- +-- This must be the output of a cryptographic hash function chosen by the +-- verifier. Verifying a value that an attacker can choose makes it easy to +-- produce a signature that verifies without knowing the secret key. +-- +-- 'Show', 'Read' and 'IsString' use hex. +newtype Msg = Msg {get :: ByteString} + deriving (Eq, Generic, Hashable, NFData) + +-- | ECDSA signature in the internal representation of libsecp256k1 (64 +-- bytes). Both components of a valid 'Sig' are in the range 1 to n−1, where n +-- is the order of the curve. +-- +-- The bytes in @get@ are opaque and not portable. Use 'exportSig' (DER) or +-- 'exportCompactSig' (64-byte r‖s) to serialize. 'sig' only exists to rebuild +-- a signature from the bytes of @get@ on the same platform. +-- +-- 'Show', 'Read' and 'IsString' use the compact encoding in hex: r and s as +-- 32-byte big-endian numbers. +newtype Sig = Sig {get :: ByteString} + deriving (Eq, Generic, Hashable, NFData) + +-- | 32-byte secret key as a big-endian number in the range 1 to n−1, where n +-- is the order of the curve. +-- +-- 'Show', 'Read' and 'IsString' use hex. 'Show' prints the key, so showing a +-- record that holds a key, in a log line or an error message for instance, +-- reveals it. The bytes live in an ordinary 'ByteString', so the garbage +-- collector copies them and nothing ever clears them from memory. +newtype SecKey = SecKey {get :: ByteString} + deriving (Eq, Generic, Hashable, NFData) + +-- | 32-byte scalar as a big-endian number in the range 0 to n−1, to add to or +-- multiply with a key. 'Show', 'Read' and 'IsString' use hex. +newtype Tweak = Tweak {get :: ByteString} + deriving (Eq, Generic, Hashable, NFData) + +-- | Compact signature encoding: r and s as 32-byte big-endian numbers. +-- 'compactSig' only checks the length. 'importCompactSig' checks the values. +-- 'Show', 'Read' and 'IsString' use hex. +newtype CompactSig = CompactSig {get :: ByteString} + deriving (Eq, Generic, Hashable, NFData) + +-- | BIP-340 Schnorr signature. Unlike 'Sig', the 64 bytes in @get@ are the +-- serialized form that BIP-340 defines, r‖s as 32-byte big-endian numbers, +-- which is the same on every platform. 'schnorrSig' only checks the length. +-- 'verifySchnorr' checks the values. 'Show', 'Read' and 'IsString' use hex. +newtype SchnorrSig = SchnorrSig {get :: ByteString} + deriving (Eq, Generic, Hashable, NFData) + +instance Read PubKey where + readPrec = parens $ do + String str <- lexP + maybe pfail return $ importPubKey validationContext =<< decodeHex str + +instance IsString PubKey where + fromString = fromMaybe e . (importPubKey validationContext <=< decodeHex) + where + e = error "Could not decode public key from hex string" + +instance Show PubKey where + showsPrec _ = showsHex . exportPubKey validationContext True + +instance Read Msg where + readPrec = parens $ do + String str <- lexP + maybe pfail return $ msg =<< decodeHex str + +instance IsString Msg where + fromString = fromMaybe e . (msg <=< decodeHex) + where + e = error "Could not decode message from hex string" + +instance Show Msg where + showsPrec _ = showsHex . (.get) + +instance Read Sig where + readPrec = parens $ do + String str <- lexP + maybe pfail return $ sigFromCompactBytes =<< decodeHex str + +instance IsString Sig where + fromString = fromMaybe e . (sigFromCompactBytes <=< decodeHex) + where + e = error "Could not decode signature from hex string" + +instance Show Sig where + showsPrec _ = showsHex . (.get) . exportCompactSig validationContext + +instance Read SecKey where + readPrec = parens $ do + String str <- lexP + maybe pfail return $ secKey =<< decodeHex str + +instance IsString SecKey where + fromString = fromMaybe e . (secKey <=< decodeHex) + where + e = error "Could not decode secret key from hex string" + +instance Show SecKey where + showsPrec _ = showsHex . (.get) + +instance Read Tweak where + readPrec = parens $ do + String str <- lexP + maybe pfail return $ tweak =<< decodeHex str + +instance IsString Tweak where + fromString = fromMaybe e . (tweak <=< decodeHex) + where + e = error "Could not decode tweak from hex string" + +instance Show Tweak where + showsPrec _ = showsHex . (.get) + +instance Read CompactSig where + readPrec = parens $ do + String str <- lexP + maybe pfail return $ compactSig =<< decodeHex str + +instance IsString CompactSig where + fromString = fromMaybe e . (compactSig <=< decodeHex) + where + e = error "Could not decode compact signature from hex string" + +instance Show CompactSig where + showsPrec _ = showsHex . (.get) + +instance Read SchnorrSig where + readPrec = parens $ do + String str <- lexP + maybe pfail return $ schnorrSig =<< decodeHex str + +instance IsString SchnorrSig where + fromString = fromMaybe e . (schnorrSig <=< decodeHex) + where + e = error "Could not decode Schnorr signature from hex string" + +instance Show SchnorrSig where + showsPrec _ = showsHex . (.get) + +-- | Parse the 64-byte compact encoding into a 'Sig' without a caller-provided +-- context. Used by the 'Read' and 'IsString' instances. +sigFromCompactBytes :: ByteString -> Maybe Sig +sigFromCompactBytes = importCompactSig validationContext <=< compactSig + +-- | Order of the secp256k1 group, n, as a 32-byte big-endian number. +curveOrder :: ByteString +curveOrder = + BS.pack + [ 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, + 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xfe, + 0xba, 0xae, 0xdc, 0xe6, 0xaf, 0x48, 0xa0, 0x3b, + 0xbf, 0xd2, 0x5e, 0x8c, 0xd0, 0x36, 0x41, 0x41 + ] + +-- | Thirty-two zero bytes. +zero32 :: ByteString +zero32 = BS.replicate 32 0 + +-- | True when the bytes are a 32-byte big-endian number lower than the curve +-- order. 'ByteString' comparison is lexicographic, which for two strings of +-- the same length is the numeric order of the big-endian numbers. +belowCurveOrder :: ByteString -> Bool +belowCurveOrder bs = BS.length bs == 32 && bs < curveOrder + +-- | Import a signature from the bytes of its internal representation, as +-- found in the @get@ field of a 'Sig' on the same platform. 'Nothing' unless +-- the bytes are the canonical representation of a signature whose components +-- are both in the range 1 to n−1. Signatures from other sources go through +-- 'importSig' or 'importCompactSig'. +sig :: ByteString -> Maybe Sig +sig bs + | isCanonicalSig bs = Just (Sig bs) + | otherwise = Nothing + +-- | Serialize the internal bytes to the compact encoding, parse that back and +-- compare. Parsing checks that both components are below the curve order. +-- Comparing the bytes rejects non-canonical forms, so that each signature has +-- one representation and 'Eq' is meaningful. Zero components are rejected +-- too, because such a signature can never verify. +isCanonicalSig :: ByteString -> Bool +isCanonicalSig bs = + BS.length bs == 64 + && unsafePerformIO + ( withForeignPtr fctx $ \ctx -> + unsafeUseByteString bs $ \(sig_ptr, _) -> + allocaBytes 64 $ \compact_ptr -> do + ret <- ecdsaSignatureSerializeCompact ctx compact_ptr sig_ptr + if not (isSuccess ret) + then return False + else do + compact <- packByteString (compact_ptr, 64) + parsed <- withOutput 64 $ \out -> + isSuccess <$> ecdsaSignatureParseCompact ctx out compact_ptr + return (parsed == Just bs && hasNonZeroComponents compact) + ) + where + Ctx fctx = validationContext + +-- | True when neither r nor s of a compact-encoded signature is zero. +hasNonZeroComponents :: ByteString -> Bool +hasNonZeroComponents compact = + BS.take 32 compact /= zero32 && BS.drop 32 compact /= zero32 + +-- | Import a public key from the bytes of its internal representation, as +-- found in the @get@ field of a 'PubKey' on the same platform. 'Nothing' +-- unless the bytes are the canonical representation of a point on the curve. +-- Keys from other sources go through 'importPubKey'. +pubKey :: ByteString -> Maybe PubKey +pubKey bs + | isCanonicalPubKey bs = Just (PubKey bs) + | otherwise = Nothing + +-- | Serialize the internal bytes as an uncompressed key, parse that back and +-- compare. Parsing checks that the point is on the curve. Comparing the bytes +-- rejects non-canonical forms, so that each point has one representation and +-- 'Eq' is meaningful. +-- +-- The serialization must be uncompressed. A compressed serialization drops +-- the y coordinate, so invalid bytes with a valid x would be accepted as a +-- different point. +isCanonicalPubKey :: ByteString -> Bool +isCanonicalPubKey bs = + BS.length bs == 64 + && unsafePerformIO + ( withForeignPtr fctx $ \ctx -> + unsafeUseByteString bs $ \(pub_key_ptr, _) -> + alloca $ \len_ptr -> + allocaBytes 65 $ \ser_ptr -> do + poke len_ptr 65 + ret <- + ecPubKeySerialize ctx ser_ptr len_ptr pub_key_ptr uncompressed + if not (isSuccess ret) + then return False + else do + len <- peek len_ptr + parsed <- withOutput 64 $ \out -> + isSuccess <$> ecPubKeyParse ctx out ser_ptr len + return (parsed == Just bs) + ) + where + Ctx fctx = validationContext + +-- | Import a 32-byte message hash. +msg :: ByteString -> Maybe Msg +msg bs + | BS.length bs == 32 = Just (Msg bs) + | otherwise = Nothing + +-- | Import a 32-byte big-endian secret key. 'Nothing' unless the number is in +-- the range 1 to n−1, which is what @secp256k1_ec_seckey_verify@ requires. +secKey :: ByteString -> Maybe SecKey +secKey bs + | belowCurveOrder bs && bs /= zero32 = Just (SecKey bs) + | otherwise = Nothing + +-- | Import a 32-byte big-endian tweak. 'Nothing' unless the number is in the +-- range 0 to n−1. Zero is allowed because adding it is harmless, but +-- multiplying by it fails. +tweak :: ByteString -> Maybe Tweak +tweak bs + | belowCurveOrder bs = Just (Tweak bs) + | otherwise = Nothing + +-- | Import a 64-byte compact signature encoding. Only the length is checked. +-- 'importCompactSig' checks the values. +compactSig :: ByteString -> Maybe CompactSig +compactSig bs + | BS.length bs == 64 = Just (CompactSig bs) + | otherwise = Nothing + +-- | Convert a signature to its lower-S form. A signature that is already in +-- that form is returned unchanged. 'verifySig' only accepts lower-S +-- signatures, so apply this first to signatures that may come from software +-- that does not produce them. +normalizeSig :: Ctx -> Sig -> Sig +normalizeSig (Ctx fctx) (Sig sig_bs) = + unsafePerformIO $ withForeignPtr fctx $ \ctx -> + useFixedByteString "Sig" 64 sig_bs $ \(sig_in, _) -> + -- The return value only says whether s was high. The output is written + -- in both cases. + Sig <$> fillOutput 64 (\sig_out -> () <$ ecdsaSignatureNormalize ctx sig_out sig_in) + +-- | True when the s component is not greater than n/2. This is the form that +-- 'signMsg' produces and the only form that 'verifySig' accepts. +isLowS :: Ctx -> Sig -> Bool +isLowS (Ctx fctx) (Sig sig_bs) = + unsafePerformIO $ withForeignPtr fctx $ \ctx -> + useFixedByteString "Sig" 64 sig_bs $ \(sig_in, _) -> do + -- With a null output pointer the C function only reports whether s is + -- high: 1 when it is, 0 when it is not. + was_high <- ecdsaSignatureNormalize ctx nullPtr sig_in + return (not (isSuccess was_high)) + +-- | True when the r component is lower than 2^255, which makes the DER +-- encoding at most 70 bytes. 'signMsgLowR' produces such signatures. +isLowR :: Ctx -> Sig -> Bool +isLowR ctx s = BS.index (exportCompactSig ctx s).get 0 < 0x80 + +-- | Parse a public key in SEC1 encoding: 33 bytes compressed (prefix 0x02 or +-- 0x03), 65 bytes uncompressed (prefix 0x04) or 65 bytes hybrid (prefix 0x06 +-- or 0x07). 'Nothing' when the encoding is wrong or the point is not on the +-- curve. +importPubKey :: Ctx -> ByteString -> Maybe PubKey +importPubKey (Ctx fctx) bs + | BS.null bs = Nothing + | otherwise = + unsafePerformIO $ withForeignPtr fctx $ \ctx -> + unsafeUseByteString bs $ \(input, len) -> + (fmap . fmap) PubKey . withOutput 64 $ \pub_key -> + isSuccess <$> ecPubKeyParse ctx pub_key input len + +-- | Serialize a public key in SEC1 encoding. 'True' for the 33-byte +-- compressed form, 'False' for the 65-byte uncompressed form. +exportPubKey :: Ctx -> Bool -> PubKey -> ByteString +exportPubKey (Ctx fctx) compress (PubKey in_bs) = + unsafePerformIO $ withForeignPtr fctx $ \ctx -> + useFixedByteString "PubKey" 64 in_bs $ \(in_ptr, _) -> + alloca $ \len_ptr -> + allocaBytes len $ \out_ptr -> do + poke len_ptr $ fromIntegral len + ret <- ecPubKeySerialize ctx out_ptr len_ptr in_ptr flags + unless (isSuccess ret) $ error "could not serialize public key" + final_len <- peek len_ptr + packByteString (out_ptr, final_len) + where + len = if compress then 33 else 65 :: Int + flags = if compress then compressed else uncompressed + +-- | Serialize a signature in the compact encoding. +exportCompactSig :: Ctx -> Sig -> CompactSig +exportCompactSig (Ctx fctx) (Sig sig_bs) = + unsafePerformIO $ withForeignPtr fctx $ \ctx -> + useFixedByteString "Sig" 64 sig_bs $ \(sig_ptr, _) -> do + out <- withOutput 64 $ \out_ptr -> + isSuccess <$> ecdsaSignatureSerializeCompact ctx out_ptr sig_ptr + maybe + (error "could not serialize compact signature") + (return . CompactSig) + out + +-- | Parse a signature from the compact encoding. 'Nothing' unless both +-- components are in the range 1 to n−1. The signature may be in high-S form. +importCompactSig :: Ctx -> CompactSig -> Maybe Sig +importCompactSig (Ctx fctx) (CompactSig compact) = do + guard (hasNonZeroComponents compact) + unsafePerformIO $ withForeignPtr fctx $ \ctx -> + useFixedByteString "CompactSig" 64 compact $ \(compact_ptr, _) -> + (fmap . fmap) Sig . withOutput 64 $ \out_sig -> + isSuccess <$> ecdsaSignatureParseCompact ctx out_sig compact_ptr + +-- | Parse a signature in strict DER encoding. 'Nothing' when the encoding is +-- not strict DER or when a component is outside the range 1 to n−1. The +-- signature may be in high-S form. +importSig :: Ctx -> ByteString -> Maybe Sig +importSig ctx@(Ctx fctx) bs + | BS.null bs = Nothing + | otherwise = do + parsed <- + unsafePerformIO $ withForeignPtr fctx $ \ctx_ptr -> + unsafeUseByteString bs $ \(in_ptr, in_len) -> + (fmap . fmap) Sig . withOutput 64 $ \out_sig -> + isSuccess <$> ecdsaSignatureParseDer ctx_ptr out_sig in_ptr in_len + -- libsecp256k1 parses a component that is not below the curve order as + -- zero and still reports success. Such a signature can never verify. + guard (hasNonZeroComponents (exportCompactSig ctx parsed).get) + return parsed + +-- | Serialize a signature in strict DER encoding (8 to 72 bytes). +exportSig :: Ctx -> Sig -> ByteString +exportSig (Ctx fctx) (Sig in_sig) = + unsafePerformIO $ withForeignPtr fctx $ \ctx -> + useFixedByteString "Sig" 64 in_sig $ \(in_ptr, _) -> + alloca $ \out_len -> + allocaBytes 72 $ \out_ptr -> do + poke out_len 72 + ret <- ecdsaSignatureSerializeDer ctx out_ptr out_len in_ptr + unless (isSuccess ret) $ error "could not serialize signature" + final_len <- peek out_len + packByteString (out_ptr, final_len) + +-- | Verify a signature over a message hash. 'True' means the signature is +-- valid for the key and the hash and is in lower-S form. A valid signature +-- in high-S form gives 'False'. Apply 'normalizeSig' first to accept it. +-- +-- The lower-S rule exists because ECDSA signatures are malleable: if (r, s) +-- is valid, so is (r, n − s). Anyone could change a transaction's signature, +-- and therefore its id, without the key. Accepting only one of the two forms +-- removes that freedom, which is why libsecp256k1 and Bitcoin's relay rules +-- insist on it. +verifySig :: Ctx -> PubKey -> Sig -> Msg -> Bool +verifySig (Ctx fctx) (PubKey pub_key) (Sig sig_bs) (Msg m) = + unsafePerformIO $ withForeignPtr fctx $ \ctx -> + useFixedByteString "PubKey" 64 pub_key $ \(pub_key_ptr, _) -> + useFixedByteString "Sig" 64 sig_bs $ \(sig_ptr, _) -> + useFixedByteString "Msg" 32 m $ \(msg_ptr, _) -> + isSuccess <$> ecdsaVerify ctx sig_ptr msg_ptr pub_key_ptr + +-- | Sign a message hash. The nonce comes from RFC 6979, so the same key and +-- hash always give the same signature. The signature is in lower-S form. +-- +-- Deterministic nonces are the reason this is a pure function, and they are a +-- safety feature, not a convenience: an ECDSA nonce that repeats, or that is +-- even slightly predictable, reveals the secret key. Deriving it from the key +-- and the hash, as RFC 6979 does, removes the need for a good random number +-- generator at signing time. +signMsg :: Ctx -> SecKey -> Msg -> Sig +signMsg ctx key m = signMsgWith ctx key m Nothing + +-- | Sign a message hash with RFC 6979 and 32 bytes of extra nonce data (RFC +-- 6979 section 3.6), or without extra data for 'Nothing', which is the same as +-- 'signMsg'. The data must be exactly 32 bytes long. This is the primitive +-- behind 'signMsgLowR'. +signMsgWith :: Ctx -> SecKey -> Msg -> Maybe ByteString -> Sig +signMsgWith (Ctx fctx) (SecKey sec_key) (Msg m) nonce_data = + unsafePerformIO $ withForeignPtr fctx $ \ctx -> + useFixedByteString "SecKey" 32 sec_key $ \(sec_key_ptr, _) -> + useFixedByteString "Msg" 32 m $ \(msg_ptr, _) -> + withNonceData $ \data_ptr -> do + -- A null nonce function selects the RFC 6979 default, which still + -- receives the extra data. + out <- withOutput 64 $ \sig_ptr -> + isSuccess + <$> ecdsaSign ctx sig_ptr msg_ptr sec_key_ptr nullFunPtr data_ptr + maybe (error "could not sign message") (return . Sig) out + where + withNonceData f = case nonce_data of + Nothing -> f nullPtr + Just d -> useFixedByteString "nonce data" 32 d $ \(p, _) -> f p + +-- | Sign like 'signMsg', then retry with extra nonce data until the r +-- component is lower than 2^255, so that the DER encoding is at most 70 +-- bytes. This is what Bitcoin Core does since version 0.17, with the same +-- nonce data (a 32-bit little-endian counter padded to 32 bytes), so the +-- signatures are the same as Bitcoin Core's. On average it takes two +-- attempts. The result is still deterministic. +-- +-- Use it where the size of a signature matters, as in Bitcoin transactions, +-- where every byte costs a fee, or where signatures must match Bitcoin Core's +-- byte for byte. Use 'signMsg' where the RFC 6979 test vectors must hold. +signMsgLowR :: Ctx -> SecKey -> Msg -> Sig +signMsgLowR ctx key m = go 0 (signMsg ctx key m) + where + go :: Word32 -> Sig -> Sig + go counter s + | isLowR ctx s = s + | otherwise = + let next = counter + 1 + in go next (signMsgWith ctx key m (Just (counterData next))) + counterData c = + BS.pack (map (fromIntegral . (c `shiftR`)) [0, 8, 16, 24]) + <> BS.replicate 28 0 + +-- | Compute the public key of a secret key. +-- +-- It is a pure function and cannot fail, because a 'SecKey' is valid by +-- construction. +derivePubKey :: Ctx -> SecKey -> PubKey +derivePubKey (Ctx fctx) (SecKey sec_key) = + unsafePerformIO $ withForeignPtr fctx $ \ctx -> + useFixedByteString "SecKey" 32 sec_key $ \(sec_key_ptr, _) -> do + out <- withOutput 64 $ \pub_key_ptr -> + isSuccess <$> ecPubKeyCreate ctx pub_key_ptr sec_key_ptr + maybe (error "could not compute public key") (return . PubKey) out + +-- | Add a tweak to a secret key: @key + tweak mod n@. 'Nothing' when the +-- result would be zero, which happens when the tweak is the negation of the +-- key. +-- +-- Tweaks are the building block of key derivation: BIP-32 child keys are a +-- parent key plus a tweak, and Taproot outputs are an internal key plus a +-- tweak. 'tweakAddPubKey' does the same on the public side, which is what lets +-- a watch-only wallet derive addresses without any secret. +tweakAddSecKey :: Ctx -> SecKey -> Tweak -> Maybe SecKey +tweakAddSecKey (Ctx fctx) (SecKey sec_key) (Tweak t) = + unsafePerformIO $ withForeignPtr fctx $ \ctx -> + useFixedByteString "Tweak" 32 t $ \(tweak_ptr, _) -> + (fmap . fmap) SecKey . withCopy "SecKey" 32 sec_key $ \sec_key_ptr -> + isSuccess <$> ecSecKeyTweakAdd ctx sec_key_ptr tweak_ptr + +-- | Multiply a secret key by a tweak: @key * tweak mod n@. 'Nothing' when the +-- tweak is zero. +tweakMulSecKey :: Ctx -> SecKey -> Tweak -> Maybe SecKey +tweakMulSecKey (Ctx fctx) (SecKey sec_key) (Tweak t) = + unsafePerformIO $ withForeignPtr fctx $ \ctx -> + useFixedByteString "Tweak" 32 t $ \(tweak_ptr, _) -> + (fmap . fmap) SecKey . withCopy "SecKey" 32 sec_key $ \sec_key_ptr -> + isSuccess <$> ecSecKeyTweakMul ctx sec_key_ptr tweak_ptr + +-- | Add a tweak to a public key: @key + tweak * G@. 'Nothing' when the result +-- would be the point at infinity, which happens when the tweak is the negation +-- of the secret key. +tweakAddPubKey :: Ctx -> PubKey -> Tweak -> Maybe PubKey +tweakAddPubKey (Ctx fctx) (PubKey pub_key) (Tweak t) = + unsafePerformIO $ withForeignPtr fctx $ \ctx -> + useFixedByteString "Tweak" 32 t $ \(tweak_ptr, _) -> + (fmap . fmap) PubKey . withCopy "PubKey" 64 pub_key $ \pub_key_ptr -> + isSuccess <$> ecPubKeyTweakAdd ctx pub_key_ptr tweak_ptr + +-- | Multiply a public key by a tweak: @tweak * key@. 'Nothing' when the tweak +-- is zero. +tweakMulPubKey :: Ctx -> PubKey -> Tweak -> Maybe PubKey +tweakMulPubKey (Ctx fctx) (PubKey pub_key) (Tweak t) = + unsafePerformIO $ withForeignPtr fctx $ \ctx -> + useFixedByteString "Tweak" 32 t $ \(tweak_ptr, _) -> + (fmap . fmap) PubKey . withCopy "PubKey" 64 pub_key $ \pub_key_ptr -> + isSuccess <$> ecPubKeyTweakMul ctx pub_key_ptr tweak_ptr + +-- | Add public keys together. 'Nothing' for an empty list, when a key is not +-- a valid point, or when the sum is the point at infinity. +combinePubKeys :: Ctx -> [PubKey] -> Maybe PubKey +combinePubKeys _ [] = Nothing +combinePubKeys (Ctx fctx) pubs + -- @secp256k1_ec_pubkey_combine@ ignores whether each key loads, so an + -- invalid key would be added as if it were a point. + | not (all isValidPoint pubs) = Nothing + | otherwise = + unsafePerformIO $ withForeignPtr fctx $ \ctx -> + withPointers pubs $ \ps -> + allocaArray (length ps) $ \arr -> do + pokeArray arr ps + (fmap . fmap) PubKey . withOutput 64 $ \out -> + isSuccess <$> ecPubKeyCombine ctx out arr (fromIntegral (length ps)) + where + -- A raw key of the wrong length is a programming error, like everywhere + -- else. A raw key of the right length that is not a point gives Nothing. + isValidPoint (PubKey bs) + | BS.length bs /= 64 = wrongLength "PubKey" 64 bs + | otherwise = isCanonicalPubKey bs + withPointers [] f = f [] + withPointers (PubKey pub_key : rest) f = + useFixedByteString "PubKey" 64 pub_key $ \(p, _) -> + withPointers rest $ \ps -> f (p : ps) + +-- | Negate a tweak modulo the curve order: @n − tweak@, or zero for zero. +-- Adding a tweak and then its negation gives the original key back. +-- 'Nothing' only for a raw 'Tweak' that is not below the curve order. +tweakNegate :: Ctx -> Tweak -> Maybe Tweak +tweakNegate (Ctx fctx) (Tweak t) + | t == zero32 = Just (Tweak t) + | otherwise = + unsafePerformIO $ withForeignPtr fctx $ \ctx -> + (fmap . fmap) Tweak . withCopy "Tweak" 32 t $ \out -> + isSuccess <$> ecTweakNegate ctx out + +-- * Schnorr signatures (BIP-340) + +-- | Import a 64-byte BIP-340 Schnorr signature. Only the length is checked. +-- 'verifySchnorr' rejects a signature whose components are out of range. +schnorrSig :: ByteString -> Maybe SchnorrSig +schnorrSig bs + | BS.length bs == 64 = Just (SchnorrSig bs) + | otherwise = Nothing + +-- | Run an action with the x-only form of a public key, which keeps the x +-- coordinate and drops the parity of y. 'Nothing' if the key does not load +-- as a point. +withXOnlyPubKey :: + Ptr LCtx -> ByteString -> (Ptr XOnlyPubKey64 -> IO a) -> IO (Maybe a) +withXOnlyPubKey ctx pub_key f = + useFixedByteString "PubKey" 64 pub_key $ \(pub_key_ptr, _) -> + allocaBytes 64 $ \xonly_ptr -> do + ret <- xOnlyPubKeyFromPubKey ctx xonly_ptr nullPtr pub_key_ptr + if isSuccess ret then Just <$> f xonly_ptr else return Nothing + +-- | Run an action with the key pair of a secret key. 'Nothing' if the secret +-- key is not valid. The key pair holds the secret key, so its buffer is +-- zeroed when the action is done, whether it returns or throws. +withKeyPair :: + Ptr LCtx -> ByteString -> (Ptr KeyPair96 -> IO a) -> IO (Maybe a) +withKeyPair ctx sec_key f = + useFixedByteString "SecKey" 32 sec_key $ \(sec_key_ptr, _) -> + allocaBytes 96 $ \key_pair -> do + let create = do + ret <- keyPairCreate ctx key_pair sec_key_ptr + if isSuccess ret then Just <$> f key_pair else return Nothing + create `finally` fillBytes key_pair 0 96 + +-- | Import a 32-byte BIP-340 x-only public key: the x coordinate of a point. +-- The result is the point with that x coordinate and an even y coordinate, +-- as BIP-340 defines. 'Nothing' if no point has that x coordinate. +importXOnlyPubKey :: Ctx -> ByteString -> Maybe PubKey +importXOnlyPubKey ctx bs + | BS.length bs == 32 = importPubKey ctx (BS.cons 0x02 bs) + | otherwise = Nothing + +-- | Export a public key as a 32-byte BIP-340 x-only public key: its x +-- coordinate. A key and its negation have the same x-only form. +exportXOnlyPubKey :: Ctx -> PubKey -> ByteString +exportXOnlyPubKey (Ctx fctx) (PubKey pub_key) = + unsafePerformIO $ withForeignPtr fctx $ \ctx -> do + out <- withXOnlyPubKey ctx pub_key $ \xonly_ptr -> + fillOutput 32 $ \out_ptr -> do + ret <- xOnlyPubKeySerialize ctx out_ptr xonly_ptr + unless (isSuccess ret) $ error "could not serialize x-only public key" + maybe (error "could not serialize x-only public key") return out + +-- | Sign a message hash with BIP-340 and no auxiliary randomness. The +-- signature is deterministic, and the same as with 32 zero bytes of auxiliary +-- randomness. BIP-340 recommends fresh randomness for every signature, which +-- protects the key against side-channel and fault attacks; 'signSchnorrIO' +-- provides it. +-- +-- As BIP-340 requires, the signature is verified before it is returned, and +-- an error is raised if that fails. +signSchnorr :: Ctx -> SecKey -> Msg -> SchnorrSig +signSchnorr ctx key m = signSchnorrInternal ctx key m Nothing + +-- | Sign a message hash with BIP-340 and the given 32 bytes of auxiliary +-- randomness. 'Nothing' if the randomness is not 32 bytes long. The +-- signature is verified before it is returned, as in 'signSchnorr'. +signSchnorrWithAux :: Ctx -> SecKey -> Msg -> ByteString -> Maybe SchnorrSig +signSchnorrWithAux ctx key m aux + | BS.length aux == 32 = Just (signSchnorrInternal ctx key m (Just aux)) + | otherwise = Nothing + +-- | Sign a message hash with BIP-340 and fresh auxiliary randomness from the +-- system, as BIP-340 recommends. The signature is different each time. It is +-- verified before it is returned, as in 'signSchnorr'. +signSchnorrIO :: (MonadIO m) => Ctx -> SecKey -> Msg -> m SchnorrSig +signSchnorrIO ctx key m = liftIO $ do + aux <- getEntropy 32 + evaluate (signSchnorrInternal ctx key m (Just aux)) + +-- | Sign with optional auxiliary randomness, then verify the signature with +-- the key pair that made it. BIP-340 makes that check the last step of +-- signing, so that a signature corrupted by a fault in the signer never +-- leaves it. Bitcoin Core does the same. +signSchnorrInternal :: Ctx -> SecKey -> Msg -> Maybe ByteString -> SchnorrSig +signSchnorrInternal (Ctx fctx) (SecKey sec_key) (Msg m) aux = + unsafePerformIO $ withForeignPtr fctx $ \ctx -> + useFixedByteString "Msg" 32 m $ \(msg_ptr, _) -> + withAux $ \aux_ptr -> do + out <- withKeyPair ctx sec_key $ \key_pair -> + withOutput 64 $ \sig_ptr -> do + ret <- schnorrSigSign32 ctx sig_ptr msg_ptr key_pair aux_ptr + if isSuccess ret + then verifyFreshSignature ctx key_pair sig_ptr (castPtr msg_ptr) + else return False + case out of + Nothing -> error "could not sign message" + Just Nothing -> error "could not sign message: the signature does not verify" + Just (Just s) -> return (SchnorrSig s) + where + withAux f = case aux of + Nothing -> f nullPtr + Just bs -> useFixedByteString "auxiliary randomness" 32 bs $ \(p, _) -> f p + +-- | Verify a signature that a key pair just made, with the x-only public key +-- of that key pair. The message is 32 bytes. +verifyFreshSignature :: + Ptr LCtx -> Ptr KeyPair96 -> Ptr SchnorrSig64 -> Ptr CUChar -> IO Bool +verifyFreshSignature ctx key_pair sig_ptr msg_ptr = + allocaBytes 64 $ \xonly_ptr -> do + ret <- keyPairXOnlyPub ctx xonly_ptr nullPtr key_pair + if isSuccess ret + then isSuccess <$> schnorrSigVerify ctx sig_ptr msg_ptr 32 xonly_ptr + else return False + +-- | Verify a BIP-340 signature of a message hash. Only the x coordinate of +-- the public key is used, so a key and its negation verify the same +-- signatures. 'True' means that the signature is correct. +verifySchnorr :: Ctx -> PubKey -> SchnorrSig -> Msg -> Bool +verifySchnorr (Ctx fctx) (PubKey pub_key) (SchnorrSig sig_bs) (Msg m) = + unsafePerformIO $ withForeignPtr fctx $ \ctx -> + useFixedByteString "SchnorrSig" 64 sig_bs $ \(sig_ptr, _) -> + useFixedByteString "Msg" 32 m $ \(msg_ptr, msg_len) -> + fmap (fromMaybe False) . withXOnlyPubKey ctx pub_key $ \xonly_ptr -> + isSuccess <$> schnorrSigVerify ctx sig_ptr msg_ptr msg_len xonly_ptr + +-- | Add a tweak to the x-only form of a public key: @P + t·G@, where @P@ is +-- the point with the key's x coordinate and an even y coordinate. This is +-- how BIP-341 derives a Taproot output key from an internal key. The result +-- is a full point: its x coordinate is the tweaked x-only key, and the parity +-- of its y coordinate goes into the control block of a script path spend. +-- 'Nothing' if the result is the point at infinity, or for a raw 'Tweak' that +-- is not below the curve order. +tweakAddXOnlyPubKey :: Ctx -> PubKey -> Tweak -> Maybe PubKey +tweakAddXOnlyPubKey (Ctx fctx) (PubKey pub_key) (Tweak t) = + unsafePerformIO $ withForeignPtr fctx $ \ctx -> + useFixedByteString "Tweak" 32 t $ \(tweak_ptr, _) -> + fmap join . withXOnlyPubKey ctx pub_key $ \xonly_ptr -> + (fmap . fmap) PubKey . withOutput 64 $ \out -> + isSuccess <$> xOnlyPubKeyTweakAdd ctx out xonly_ptr tweak_ptr + +-- | Add a tweak to a secret key the way 'tweakAddXOnlyPubKey' adds it to the +-- public key: the secret key is negated first when its public key has an odd +-- y coordinate, then the tweak is added. The result signs for the Taproot +-- output of 'tweakAddXOnlyPubKey' in a key path spend. 'Nothing' if the +-- result is zero, or for a raw 'Tweak' that is not below the curve order. +tweakAddXOnlySecKey :: Ctx -> SecKey -> Tweak -> Maybe SecKey +tweakAddXOnlySecKey (Ctx fctx) (SecKey sec_key) (Tweak t) = + unsafePerformIO $ withForeignPtr fctx $ \ctx -> + useFixedByteString "Tweak" 32 t $ \(tweak_ptr, _) -> + fmap join . withKeyPair ctx sec_key $ \key_pair -> do + ret <- keyPairXOnlyTweakAdd ctx key_pair tweak_ptr + if isSuccess ret + then + (fmap . fmap) SecKey . withOutput 32 $ \out -> + isSuccess <$> keyPairSec ctx out key_pair + else return Nothing + +instance Arbitrary Msg where + arbitrary = fromJust <$> (gen `suchThat` isJust) + where + gen = msg . BS.pack <$> replicateM 32 arbitraryBoundedRandom + +instance Arbitrary SecKey where + arbitrary = fromJust <$> (gen `suchThat` isJust) + where + gen = secKey . BS.pack <$> replicateM 32 arbitraryBoundedRandom + +instance Arbitrary Tweak where + arbitrary = fromJust <$> (gen `suchThat` isJust) + where + gen = tweak . BS.pack <$> replicateM 32 arbitraryBoundedRandom diff --git a/src/Crypto/Secp256k1/Internal/BaseOps.hs b/src/Crypto/Secp256k1/Internal/BaseOps.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Secp256k1/Internal/BaseOps.hs @@ -0,0 +1,281 @@ +-- | Foreign imports of the core, @extrakeys@ and @schnorrsig@ modules of libsecp256k1. +-- +-- Each function is a direct binding to the C function of the same name in +-- @secp256k1.h@, @secp256k1_extrakeys.h@ or @secp256k1_schnorrsig.h@. The +-- bindings are @safe@ calls: signing and verifying take tens of microseconds, +-- and a @safe@ call lets other Haskell threads run meanwhile. Never call these +-- directly with unchecked inputs; "Crypto.Secp256k1.Internal.Base" validates +-- lengths and contents first. This module is internal and has no API +-- stability guarantee. +module Crypto.Secp256k1.Internal.BaseOps where + +import Crypto.Secp256k1.Internal.ForeignTypes + ( AuxRand32, + Compact64, + KeyPair96, + LCtx, + Msg32, + NonceFun, + PubKey64, + Ret, + SchnorrSig64, + SecKey32, + SerFlags, + Sig64, + Tweak32, + XOnlyPubKey64, + ) +import Foreign (FunPtr, Ptr) +import Foreign.C + ( CInt (..), + CSize (..), + CUChar, + CUInt (..), + ) + +-- | Binding to @secp256k1_ec_pubkey_parse@. +foreign import ccall safe "secp256k1.h secp256k1_ec_pubkey_parse" + ecPubKeyParse :: + Ptr LCtx -> + Ptr PubKey64 -> + -- | encoded public key array + Ptr CUChar -> + -- | size of encoded public key array + CSize -> + IO Ret + +-- | Binding to @secp256k1_ec_pubkey_serialize@. +foreign import ccall safe "secp256k1.h secp256k1_ec_pubkey_serialize" + ecPubKeySerialize :: + Ptr LCtx -> + -- | array for encoded public key, must be large enough + Ptr CUChar -> + -- | size of encoded public key, will be updated + Ptr CSize -> + Ptr PubKey64 -> + SerFlags -> + IO Ret + +-- | Binding to @secp256k1_ecdsa_signature_parse_compact@. +foreign import ccall safe "secp256k1.h secp256k1_ecdsa_signature_parse_compact" + ecdsaSignatureParseCompact :: + Ptr LCtx -> + Ptr Sig64 -> + Ptr Compact64 -> + IO Ret + +-- | Binding to @secp256k1_ecdsa_signature_parse_der@. +foreign import ccall safe "secp256k1.h secp256k1_ecdsa_signature_parse_der" + ecdsaSignatureParseDer :: + Ptr LCtx -> + Ptr Sig64 -> + -- | encoded DER signature + Ptr CUChar -> + -- | size of encoded signature + CSize -> + IO Ret + +-- | Binding to @secp256k1_ecdsa_signature_serialize_der@. +foreign import ccall safe "secp256k1.h secp256k1_ecdsa_signature_serialize_der" + ecdsaSignatureSerializeDer :: + Ptr LCtx -> + -- | array for encoded signature, must be large enough + Ptr CUChar -> + -- | size of encoded signature, will be updated + Ptr CSize -> + Ptr Sig64 -> + IO Ret + +-- | Binding to @secp256k1_ecdsa_signature_serialize_compact@. +foreign import ccall safe "secp256k1.h secp256k1_ecdsa_signature_serialize_compact" + ecdsaSignatureSerializeCompact :: + Ptr LCtx -> + Ptr Compact64 -> + Ptr Sig64 -> + IO Ret + +-- | Binding to @secp256k1_ecdsa_verify@. +foreign import ccall safe "secp256k1.h secp256k1_ecdsa_verify" + ecdsaVerify :: + Ptr LCtx -> + Ptr Sig64 -> + Ptr Msg32 -> + Ptr PubKey64 -> + IO Ret + +-- | Binding to @secp256k1_ecdsa_signature_normalize@. +foreign import ccall safe "secp256k1.h secp256k1_ecdsa_signature_normalize" + ecdsaSignatureNormalize :: + Ptr LCtx -> + -- | output + Ptr Sig64 -> + -- | input + Ptr Sig64 -> + IO Ret + +-- | Binding to @secp256k1_ecdsa_sign@. +foreign import ccall safe "secp256k1.h secp256k1_ecdsa_sign" + ecdsaSign :: + Ptr LCtx -> + Ptr Sig64 -> + Ptr Msg32 -> + Ptr SecKey32 -> + FunPtr (NonceFun a) -> + -- | nonce data + Ptr a -> + IO Ret + +-- | Binding to @secp256k1_ec_seckey_verify@. +foreign import ccall safe "secp256k1.h secp256k1_ec_seckey_verify" + ecSecKeyVerify :: + Ptr LCtx -> + Ptr SecKey32 -> + IO Ret + +-- | Binding to @secp256k1_ec_pubkey_create@. +foreign import ccall safe "secp256k1.h secp256k1_ec_pubkey_create" + ecPubKeyCreate :: + Ptr LCtx -> + Ptr PubKey64 -> + Ptr SecKey32 -> + IO Ret + +-- | Binding to @secp256k1_ec_seckey_tweak_add@. +foreign import ccall safe "secp256k1.h secp256k1_ec_seckey_tweak_add" + ecSecKeyTweakAdd :: + Ptr LCtx -> + Ptr SecKey32 -> + Ptr Tweak32 -> + IO Ret + +-- | Binding to @secp256k1_ec_seckey_negate@. +foreign import ccall safe "secp256k1.h secp256k1_ec_seckey_negate" + ecTweakNegate :: + Ptr LCtx -> + Ptr Tweak32 -> + IO Ret + +-- | Binding to @secp256k1_ec_pubkey_tweak_add@. +foreign import ccall safe "secp256k1.h secp256k1_ec_pubkey_tweak_add" + ecPubKeyTweakAdd :: + Ptr LCtx -> + Ptr PubKey64 -> + Ptr Tweak32 -> + IO Ret + +-- | Binding to @secp256k1_ec_seckey_tweak_mul@. +foreign import ccall safe "secp256k1.h secp256k1_ec_seckey_tweak_mul" + ecSecKeyTweakMul :: + Ptr LCtx -> + Ptr SecKey32 -> + Ptr Tweak32 -> + IO Ret + +-- | Binding to @secp256k1_ec_pubkey_tweak_mul@. +foreign import ccall safe "secp256k1.h secp256k1_ec_pubkey_tweak_mul" + ecPubKeyTweakMul :: + Ptr LCtx -> + Ptr PubKey64 -> + Ptr Tweak32 -> + IO Ret + +-- | Binding to @secp256k1_ec_pubkey_combine@. +foreign import ccall safe "secp256k1.h secp256k1_ec_pubkey_combine" + ecPubKeyCombine :: + Ptr LCtx -> + -- | pointer to public key storage + Ptr PubKey64 -> + -- | pointer to array of public keys + Ptr (Ptr PubKey64) -> + -- | number of public keys + CSize -> + IO Ret + +-- The following functions belong to the @extrakeys@ and @schnorrsig@ modules +-- of libsecp256k1, enabled by default since version 0.2.0. + +-- | Binding to @secp256k1_xonly_pubkey_from_pubkey@. +foreign import ccall safe "secp256k1_extrakeys.h secp256k1_xonly_pubkey_from_pubkey" + xOnlyPubKeyFromPubKey :: + Ptr LCtx -> + Ptr XOnlyPubKey64 -> + -- | parity of the public key, 1 if odd; may be NULL + Ptr CInt -> + Ptr PubKey64 -> + IO Ret + +-- | Binding to @secp256k1_xonly_pubkey_serialize@. +foreign import ccall safe "secp256k1_extrakeys.h secp256k1_xonly_pubkey_serialize" + xOnlyPubKeySerialize :: + Ptr LCtx -> + -- | 32-byte output + Ptr CUChar -> + Ptr XOnlyPubKey64 -> + IO Ret + +-- | Binding to @secp256k1_xonly_pubkey_tweak_add@. +foreign import ccall safe "secp256k1_extrakeys.h secp256k1_xonly_pubkey_tweak_add" + xOnlyPubKeyTweakAdd :: + Ptr LCtx -> + -- | tweaked public key + Ptr PubKey64 -> + Ptr XOnlyPubKey64 -> + Ptr Tweak32 -> + IO Ret + +-- | Binding to @secp256k1_keypair_create@. +foreign import ccall safe "secp256k1_extrakeys.h secp256k1_keypair_create" + keyPairCreate :: + Ptr LCtx -> + Ptr KeyPair96 -> + Ptr SecKey32 -> + IO Ret + +-- | Binding to @secp256k1_keypair_sec@. +foreign import ccall safe "secp256k1_extrakeys.h secp256k1_keypair_sec" + keyPairSec :: + Ptr LCtx -> + Ptr SecKey32 -> + Ptr KeyPair96 -> + IO Ret + +-- | Binding to @secp256k1_keypair_xonly_pub@. +foreign import ccall safe "secp256k1_extrakeys.h secp256k1_keypair_xonly_pub" + keyPairXOnlyPub :: + Ptr LCtx -> + Ptr XOnlyPubKey64 -> + -- | parity of the public key, 1 if odd; may be NULL + Ptr CInt -> + Ptr KeyPair96 -> + IO Ret + +-- | Binding to @secp256k1_keypair_xonly_tweak_add@. +foreign import ccall safe "secp256k1_extrakeys.h secp256k1_keypair_xonly_tweak_add" + keyPairXOnlyTweakAdd :: + Ptr LCtx -> + Ptr KeyPair96 -> + Ptr Tweak32 -> + IO Ret + +-- | Binding to @secp256k1_schnorrsig_sign32@. +foreign import ccall safe "secp256k1_schnorrsig.h secp256k1_schnorrsig_sign32" + schnorrSigSign32 :: + Ptr LCtx -> + Ptr SchnorrSig64 -> + Ptr Msg32 -> + Ptr KeyPair96 -> + -- | auxiliary randomness; may be NULL + Ptr AuxRand32 -> + IO Ret + +-- | Binding to @secp256k1_schnorrsig_verify@. +foreign import ccall safe "secp256k1_schnorrsig.h secp256k1_schnorrsig_verify" + schnorrSigVerify :: + Ptr LCtx -> + Ptr SchnorrSig64 -> + -- | message + Ptr CUChar -> + -- | message length + CSize -> + Ptr XOnlyPubKey64 -> + IO Ret diff --git a/src/Crypto/Secp256k1/Internal/Context.hs b/src/Crypto/Secp256k1/Internal/Context.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Secp256k1/Internal/Context.hs @@ -0,0 +1,160 @@ +{-# LANGUAGE NoFieldSelectors #-} + +-- | Internal module. Everything is exported and there is no API stability +-- guarantee. In particular 'contextDestroy' is here for add-on packages and +-- tests that manage raw context pointers. Never call it on the pointer inside +-- a 'Ctx', because the garbage collector will destroy that one again. +module Crypto.Secp256k1.Internal.Context where + +import Control.Exception (mask_) +import Control.Monad (unless) +import Crypto.Secp256k1.Internal.ForeignTypes + ( CtxFlags, + LCtx, + Ret, + Seed32, + isSuccess, + ) +import Crypto.Secp256k1.Internal.Util (withRandomSeed) +import Foreign (FunPtr, Ptr, nullPtr) +import Foreign.C (CInt (..), CString, CUInt (..)) +import Foreign.ForeignPtr + ( ForeignPtr, + newForeignPtr, + withForeignPtr, + ) +import System.IO.Unsafe (unsafePerformIO) + +-- | A libsecp256k1 context. It is destroyed by the garbage collector. +-- +-- A context can be shared between threads. Every function in +-- "Crypto.Secp256k1" only reads it, except 'randomizeContext', which needs +-- exclusive access. See there. +data Ctx = Ctx (ForeignPtr LCtx) + +-- | Re-seed the blinding values that protect secret key operations against +-- side-channel leakage. 'createContext' already does this once, which is what +-- libsecp256k1 recommends, so most programs never need to call it. +-- +-- This function modifies the context. Calling it while another thread uses +-- the same context, for example by evaluating 'Crypto.Secp256k1.signMsg', is a +-- data race in the C library. Either call it before the context is shared, or +-- protect every use of the context with a read-write lock. +randomizeContext :: Ctx -> IO () +randomizeContext (Ctx fctx) = withForeignPtr fctx $ \ctx -> do + ret <- withRandomSeed $ contextRandomize ctx + unless (isSuccess ret) $ error "Could not randomize context" + +-- | Create a context and randomize it. +createContext :: IO Ctx +createContext = do + ctx <- mask_ $ contextCreate signVerify >>= wrapContext + randomizeContext ctx + return ctx + +-- | Copy a context, including its randomization. +cloneContext :: Ctx -> IO Ctx +cloneContext (Ctx fctx) = + withForeignPtr fctx $ \ctx -> mask_ $ contextClone ctx >>= wrapContext + +-- | Create a context and pass it to the action. The context is not destroyed +-- when the action returns. It stays valid for as long as it is referenced, +-- and the garbage collector destroys it afterwards. +withContext :: (Ctx -> IO a) -> IO a +withContext = (createContext >>=) + +-- | Wrap a raw context pointer. The illegal-argument callback is replaced +-- with one that does nothing (see @cbits/illegal_callback.c@), so an invalid +-- argument makes the C function return 0 instead of aborting the process. +-- +-- Two rules follow for every binding that uses a 'Ctx'. The return value of +-- the C function must always be checked, because after a failed check its +-- outputs are undefined. And a C function that ignores the result of an +-- internal check must get validated inputs, as +-- 'Crypto.Secp256k1.combinePubKeys' does for @secp256k1_ec_pubkey_combine@. +wrapContext :: Ptr LCtx -> IO Ctx +wrapContext pctx = do + setIllegalCallback pctx illegalCallbackFunPtr nullPtr + Ctx <$> newForeignPtr contextDestroyFunPtr pctx + +-- | Context used to validate values that are built without a context, such +-- as public keys and signatures read from their internal representation or +-- from a string. It is only used for parsing and serialization, which do not +-- involve secret keys and so do not need randomization. It is never modified +-- after creation, so sharing it between threads is safe. +validationContext :: Ctx +validationContext = + unsafePerformIO . mask_ $ contextCreate none >>= wrapContext +{-# NOINLINE validationContext #-} + +-- | @SECP256K1_CONTEXT_NONE@. Enough for every operation since libsecp256k1 +-- 0.2.0, and for parsing and serialization in older versions. +none :: CtxFlags +none = 0x0001 + +-- | @SECP256K1_CONTEXT_VERIFY@. Deprecated upstream since 0.2.0, where it +-- means the same as 'none'. Older libraries need it to verify. +verify :: CtxFlags +verify = 0x0101 + +-- | @SECP256K1_CONTEXT_SIGN@. Deprecated upstream since 0.2.0, where it means +-- the same as 'none'. Older libraries need it to sign. +sign :: CtxFlags +sign = 0x0201 + +-- | Both 'sign' and 'verify', passed by 'createContext'. The package requires +-- libsecp256k1 0.2.0 or later for its Schnorr bindings, and from that version +-- on these flags mean the same as 'none'. Passing them is harmless. +signVerify :: CtxFlags +signVerify = 0x0301 + +-- | Binding to @secp256k1_context_create@. +foreign import ccall safe "secp256k1.h secp256k1_context_create" + contextCreate :: + CtxFlags -> + IO (Ptr LCtx) + +-- | Binding to @secp256k1_context_clone@. +foreign import ccall safe "secp256k1.h secp256k1_context_clone" + contextClone :: + Ptr LCtx -> + IO (Ptr LCtx) + +-- | Binding to @secp256k1_context_destroy@. +foreign import ccall safe "secp256k1.h secp256k1_context_destroy" + contextDestroy :: Ptr LCtx -> IO () + +-- | Pointer to @secp256k1_context_destroy@, for use as a finalizer or callback. +foreign import ccall safe "secp256k1.h &secp256k1_context_destroy" + contextDestroyFunPtr :: FunPtr (Ptr LCtx -> IO ()) + +-- | Pointer to @secp256k1_haskell_illegal_callback@, for use as a finalizer or callback. +foreign import ccall safe "&secp256k1_haskell_illegal_callback" + illegalCallbackFunPtr :: FunPtr (CString -> Ptr a -> IO ()) + +-- | Binding to @secp256k1_context_set_illegal_callback@. +foreign import ccall safe "secp256k1.h secp256k1_context_set_illegal_callback" + setIllegalCallback :: + Ptr LCtx -> + -- | message, data + FunPtr (CString -> Ptr a -> IO ()) -> + -- | data + Ptr a -> + IO () + +-- | Binding to @secp256k1_context_set_error_callback@. +foreign import ccall safe "secp256k1.h secp256k1_context_set_error_callback" + setErrorCallback :: + Ptr LCtx -> + -- | message, data + FunPtr (CString -> Ptr a -> IO ()) -> + -- | data + Ptr a -> + IO () + +-- | Binding to @secp256k1_context_randomize@. +foreign import ccall safe "secp256k1.h secp256k1_context_randomize" + contextRandomize :: + Ptr LCtx -> + Ptr Seed32 -> + IO Ret diff --git a/src/Crypto/Secp256k1/Internal/ForeignTypes.hs b/src/Crypto/Secp256k1/Internal/ForeignTypes.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Secp256k1/Internal/ForeignTypes.hs @@ -0,0 +1,87 @@ +-- | Types and constants shared by the foreign imports. +-- +-- Each empty data type stands for a C structure of libsecp256k1 and is only +-- ever used behind a 'Ptr', so that the foreign imports cannot mix up, say, a +-- pointer to a public key and a pointer to a signature. The number in the name +-- is the size of the structure in bytes, which the Haskell side must allocate. +-- This module is internal and has no API stability guarantee. +module Crypto.Secp256k1.Internal.ForeignTypes where + +import Foreign (Ptr) +import Foreign.C (CInt (..), CUChar, CUInt (..)) + +-- | Context (@secp256k1_context@). +data LCtx + +-- | Public key (@secp256k1_pubkey@), 64 bytes. +data PubKey64 + +-- | Message hash, 32 bytes. +data Msg32 + +-- | ECDSA signature (@secp256k1_ecdsa_signature@), 64 bytes. +data Sig64 + +-- | Randomization seed for a context, 32 bytes. +data Seed32 + +-- | Compact ECDSA signature, r and s, 64 bytes. +data Compact64 + +-- | Secret key, 32 bytes. +data SecKey32 + +-- | Tweak, 32 bytes. +data Tweak32 + +-- | Recoverable ECDSA signature (@secp256k1_ecdsa_recoverable_signature@), 65 bytes. +data RecSig65 + +-- | X-only public key (@secp256k1_xonly_pubkey@), 64 bytes. +data XOnlyPubKey64 + +-- | Key pair (@secp256k1_keypair@), 96 bytes. +data KeyPair96 + +-- | BIP-340 signature, 64 bytes. +data SchnorrSig64 + +-- | Auxiliary randomness for BIP-340 signing, 32 bytes. +data AuxRand32 + +-- | Flags passed to @secp256k1_context_create@. +type CtxFlags = CUInt + +-- | Flags passed to @secp256k1_ec_pubkey_serialize@. +type SerFlags = CUInt + +-- | Return value of a C function: 1 for success, 0 for failure. +type Ret = CInt + +-- | Nonce generation function, as @secp256k1_nonce_function@. The bindings pass +-- 'Foreign.nullFunPtr' for the default RFC 6979 function, or a pointer to +-- Bitcoin Core's grinding data through the last argument. +type NonceFun a = + Ptr CUChar -> + Ptr CUChar -> + Ptr CUChar -> + Ptr CUChar -> + Ptr a -> + CInt -> + IO CInt + +-- | @SECP256K1_EC_COMPRESSED@: serialize a public key in 33 bytes. +compressed :: SerFlags +compressed = 0x0102 + +-- | @SECP256K1_EC_UNCOMPRESSED@: serialize a public key in 65 bytes. +uncompressed :: SerFlags +uncompressed = 0x0002 + +-- | Interpret a return value. Anything but 0 or 1 means the C library and these +-- bindings disagree about a function's contract, so it raises an error rather +-- than guess. +isSuccess :: Ret -> Bool +isSuccess 0 = False +isSuccess 1 = True +isSuccess n = error $ "isSuccess expected 0 or 1 but got " ++ show n diff --git a/src/Crypto/Secp256k1/Internal/Recovery.hs b/src/Crypto/Secp256k1/Internal/Recovery.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Secp256k1/Internal/Recovery.hs @@ -0,0 +1,228 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE NoFieldSelectors #-} + +-- | Internal module. Everything is exported, including the raw 'RecSig' +-- constructor that "Crypto.Secp256k1.Recovery" hides, and there is no API +-- stability guarantee. This module is only built when the @recovery@ flag of +-- the package is on. +-- +-- A 'RecSig' built with the raw constructor skips validation. Every function +-- here still checks the length of its bytes before calling the C library and +-- raises an 'Control.Exception.ErrorCall' when the length is wrong, but it +-- does not check the content. A raw 'RecSig' with invalid content makes +-- functions return 'Nothing', a value that does not verify, or throw, never +-- abort or read outside a buffer. +module Crypto.Secp256k1.Internal.Recovery where + +import Control.DeepSeq (NFData) +import Control.Monad (guard, (<=<)) +import Crypto.Secp256k1.Internal.Base + ( CompactSig (..), + Msg (..), + PubKey (..), + SecKey (..), + Sig (..), + hasNonZeroComponents, + ) +import Crypto.Secp256k1.Internal.Context (Ctx (..), validationContext) +import Crypto.Secp256k1.Internal.ForeignTypes (isSuccess) +import Crypto.Secp256k1.Internal.RecoveryOps + ( ecdsaRecover, + ecdsaRecoverableSignatureConvert, + ecdsaRecoverableSignatureParseCompact, + ecdsaRecoverableSignatureSerializeCompact, + ecdsaSignRecoverable, + ) +import Crypto.Secp256k1.Internal.Util + ( decodeHex, + packByteString, + showsHex, + unsafeUseByteString, + useFixedByteString, + withOutput, + ) +import Data.ByteString (ByteString) +import Data.ByteString qualified as BS +import Data.Hashable (Hashable) +import Data.Maybe (fromMaybe) +import Data.String (IsString (..)) +import Data.Word (Word8) +import Foreign (alloca, allocaBytes, nullFunPtr, nullPtr, peek, withForeignPtr) +import GHC.Generics (Generic) +import System.IO.Unsafe (unsafePerformIO) +import Text.Read + ( Lexeme (String), + lexP, + parens, + pfail, + readPrec, + ) + +-- | ECDSA signature with a recovery id, in the internal representation of +-- libsecp256k1 (65 bytes). A valid 'RecSig' has both components in the range +-- 1 to n−1, where n is the order of the curve, and a recovery id of 0 to 3. +-- +-- The bytes in @get@ are opaque. They are not a standard encoding, and they +-- are not portable between platforms or library versions. Use +-- 'exportCompactRecSig' to serialize a signature and 'importCompactRecSig' to +-- parse one. 'recSig' only exists to rebuild a signature from the bytes of +-- @get@ on the same platform. +-- +-- 'Show', 'Read' and 'IsString' use hex of the 65-byte encoding that +-- 'exportCompactRecSig' gives: r and s as 32-byte big-endian numbers, then +-- the recovery id as one byte. +newtype RecSig = RecSig {get :: ByteString} + deriving (Eq, Generic, Hashable, NFData) + +instance Read RecSig where + readPrec = parens $ do + String str <- lexP + maybe pfail return $ recSigFromEncoding =<< decodeHex str + +instance IsString RecSig where + fromString = fromMaybe e . (recSigFromEncoding <=< decodeHex) + where + e = error "Could not decode recoverable signature from hex string" + +instance Show RecSig where + showsPrec _ = showsHex . recSigToEncoding + +-- | The 65-byte encoding of a signature: the compact encoding of r and s, +-- then the recovery id as one byte. Used by the 'Show' instance. +recSigToEncoding :: RecSig -> ByteString +recSigToEncoding rs = compact.get `BS.snoc` rec_id + where + (compact, rec_id) = exportCompactRecSig validationContext rs + +-- | Parse the 65-byte encoding of 'recSigToEncoding' without a +-- caller-provided context. Used by the 'Read' and 'IsString' instances. +recSigFromEncoding :: ByteString -> Maybe RecSig +recSigFromEncoding bs = do + guard (BS.length bs == 65) + importCompactRecSig validationContext (CompactSig (BS.take 64 bs)) (BS.last bs) + +-- | Import a recoverable signature from the bytes of its internal +-- representation, as found in the @get@ field of a 'RecSig' on the same +-- platform. 'Nothing' unless the bytes are the canonical representation of a +-- signature whose components are both in the range 1 to n−1, with a recovery +-- id of 0 to 3. Signatures from other sources go through +-- 'importCompactRecSig'. +recSig :: ByteString -> Maybe RecSig +recSig bs + | isCanonicalRecSig bs = Just (RecSig bs) + | otherwise = Nothing + +-- | Serialize the internal bytes to the compact encoding and the id, parse +-- those back and compare, as 'Crypto.Secp256k1.Internal.Base.isCanonicalSig' +-- does. Parsing checks that both components are below the curve order and +-- that the id is 0 to 3. Comparing the bytes rejects non-canonical forms, so +-- that each signature has one representation and 'Eq' is meaningful. Zero +-- components are rejected too, so that 'convertRecSig' always gives a valid +-- 'Sig'. +isCanonicalRecSig :: ByteString -> Bool +isCanonicalRecSig bs = + BS.length bs == 65 + && unsafePerformIO + ( withForeignPtr fctx $ \ctx -> + unsafeUseByteString bs $ \(rec_sig_ptr, _) -> + allocaBytes 64 $ \compact_ptr -> + alloca $ \rec_id_ptr -> do + ret <- + ecdsaRecoverableSignatureSerializeCompact + ctx + compact_ptr + rec_id_ptr + rec_sig_ptr + if not (isSuccess ret) + then return False + else do + rec_id <- peek rec_id_ptr + compact <- packByteString (compact_ptr, 64) + parsed <- withOutput 65 $ \out -> + isSuccess + <$> ecdsaRecoverableSignatureParseCompact ctx out compact_ptr rec_id + return (parsed == Just bs && hasNonZeroComponents compact) + ) + where + Ctx fctx = validationContext + +-- | Sign a message hash and keep the recovery id. The nonce comes from RFC +-- 6979, so the same key and hash always give the same signature, and r and s +-- are those of 'Crypto.Secp256k1.signMsg', in lower-S form. There is no low-R +-- grinding. Bitcoin Core does not grind when it signs a message with +-- @SignCompact@ either, so the signatures are the same as Bitcoin Core's. +signRecMsg :: Ctx -> SecKey -> Msg -> RecSig +signRecMsg (Ctx fctx) (SecKey sec_key) (Msg m) = + unsafePerformIO $ withForeignPtr fctx $ \ctx -> + useFixedByteString "SecKey" 32 sec_key $ \(sec_key_ptr, _) -> + useFixedByteString "Msg" 32 m $ \(msg_ptr, _) -> do + -- A null nonce function selects the RFC 6979 default. + out <- withOutput 65 $ \rec_sig_ptr -> + isSuccess + <$> ecdsaSignRecoverable ctx rec_sig_ptr msg_ptr sec_key_ptr nullFunPtr nullPtr + maybe (error "could not sign message") (return . RecSig) out + +-- | The public key that made a signature of a message hash. 'Nothing' when no +-- key comes out: no point has the x coordinate that r and the recovery id +-- give, or the computation reaches the point at infinity. +-- +-- A key that comes out verifies the signature for the hash, except for the +-- lower-S rule, which recovery does not apply: the high-S form of a +-- signature, with the parity bit of its recovery id flipped, recovers the +-- same key. Bitcoin Core accepts such message signatures too. Where the rule +-- matters, check 'Crypto.Secp256k1.isLowS' on 'convertRecSig'. The hash is +-- reduced modulo the curve order, as 'Crypto.Secp256k1.verifySig' does. +recover :: Ctx -> RecSig -> Msg -> Maybe PubKey +recover (Ctx fctx) (RecSig rec_sig) (Msg m) = + unsafePerformIO $ withForeignPtr fctx $ \ctx -> + useFixedByteString "RecSig" 65 rec_sig $ \(rec_sig_ptr, _) -> + useFixedByteString "Msg" 32 m $ \(msg_ptr, _) -> + (fmap . fmap) PubKey . withOutput 64 $ \pub_key_ptr -> + isSuccess <$> ecdsaRecover ctx pub_key_ptr rec_sig_ptr msg_ptr + +-- | The signature without its recovery id. For a signature from +-- 'signRecMsg', this is the signature that 'Crypto.Secp256k1.signMsg' gives. +convertRecSig :: Ctx -> RecSig -> Sig +convertRecSig (Ctx fctx) (RecSig rec_sig) = + unsafePerformIO $ withForeignPtr fctx $ \ctx -> + useFixedByteString "RecSig" 65 rec_sig $ \(rec_sig_ptr, _) -> do + out <- withOutput 64 $ \sig_ptr -> + isSuccess <$> ecdsaRecoverableSignatureConvert ctx sig_ptr rec_sig_ptr + maybe (error "could not convert recoverable signature") (return . Sig) out + +-- | Parse a signature from the compact encoding and its recovery id. +-- 'Nothing' unless both components are in the range 1 to n−1 and the id is 0 +-- to 3. The signature may be in high-S form. +importCompactRecSig :: Ctx -> CompactSig -> Word8 -> Maybe RecSig +importCompactRecSig (Ctx fctx) (CompactSig compact) rec_id = do + guard (rec_id <= 3) + -- libsecp256k1 accepts a zero component here and only refuses it in + -- 'recover'. It is rejected here so that 'convertRecSig' always gives a + -- valid 'Sig', as 'Crypto.Secp256k1.importCompactSig' does. + guard (hasNonZeroComponents compact) + unsafePerformIO $ withForeignPtr fctx $ \ctx -> + useFixedByteString "CompactSig" 64 compact $ \(compact_ptr, _) -> + (fmap . fmap) RecSig . withOutput 65 $ \out -> + isSuccess + <$> ecdsaRecoverableSignatureParseCompact ctx out compact_ptr (fromIntegral rec_id) + +-- | Serialize a signature to the compact encoding and its recovery id. The +-- header byte of a Bitcoin signed message is 27 plus the id, plus 4 for a +-- compressed key, which the caller adds. +exportCompactRecSig :: Ctx -> RecSig -> (CompactSig, Word8) +exportCompactRecSig (Ctx fctx) (RecSig rec_sig) = + unsafePerformIO $ withForeignPtr fctx $ \ctx -> + useFixedByteString "RecSig" 65 rec_sig $ \(rec_sig_ptr, _) -> + alloca $ \rec_id_ptr -> do + out <- withOutput 64 $ \compact_ptr -> + isSuccess + <$> ecdsaRecoverableSignatureSerializeCompact ctx compact_ptr rec_id_ptr rec_sig_ptr + case out of + Nothing -> error "could not serialize recoverable signature" + Just compact -> do + rec_id <- peek rec_id_ptr + return (CompactSig compact, fromIntegral rec_id) diff --git a/src/Crypto/Secp256k1/Internal/RecoveryOps.hs b/src/Crypto/Secp256k1/Internal/RecoveryOps.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Secp256k1/Internal/RecoveryOps.hs @@ -0,0 +1,70 @@ +-- | Foreign imports of the @recovery@ module of libsecp256k1, which the +-- library only has when it was built with @--enable-module-recovery@. See +-- "Crypto.Secp256k1.Recovery". This module is only built when the @recovery@ +-- flag of the package is on. +module Crypto.Secp256k1.Internal.RecoveryOps where + +import Crypto.Secp256k1.Internal.ForeignTypes + ( Compact64, + LCtx, + Msg32, + NonceFun, + PubKey64, + RecSig65, + Ret, + SecKey32, + Sig64, + ) +import Foreign (FunPtr, Ptr) +import Foreign.C (CInt (..)) + +-- | Binding to @secp256k1_ecdsa_recoverable_signature_parse_compact@. +foreign import ccall safe "secp256k1_recovery.h secp256k1_ecdsa_recoverable_signature_parse_compact" + ecdsaRecoverableSignatureParseCompact :: + Ptr LCtx -> + Ptr RecSig65 -> + Ptr Compact64 -> + -- | recovery id, 0 to 3 + CInt -> + IO Ret + +-- | Binding to @secp256k1_ecdsa_recoverable_signature_serialize_compact@. +foreign import ccall safe "secp256k1_recovery.h secp256k1_ecdsa_recoverable_signature_serialize_compact" + ecdsaRecoverableSignatureSerializeCompact :: + Ptr LCtx -> + Ptr Compact64 -> + -- | recovery id, written by the function + Ptr CInt -> + Ptr RecSig65 -> + IO Ret + +-- | Binding to @secp256k1_ecdsa_recoverable_signature_convert@. +foreign import ccall safe "secp256k1_recovery.h secp256k1_ecdsa_recoverable_signature_convert" + ecdsaRecoverableSignatureConvert :: + Ptr LCtx -> + -- | output + Ptr Sig64 -> + -- | input + Ptr RecSig65 -> + IO Ret + +-- | Binding to @secp256k1_ecdsa_sign_recoverable@. +foreign import ccall safe "secp256k1_recovery.h secp256k1_ecdsa_sign_recoverable" + ecdsaSignRecoverable :: + Ptr LCtx -> + Ptr RecSig65 -> + Ptr Msg32 -> + Ptr SecKey32 -> + FunPtr (NonceFun a) -> + -- | nonce data + Ptr a -> + IO Ret + +-- | Binding to @secp256k1_ecdsa_recover@. +foreign import ccall safe "secp256k1_recovery.h secp256k1_ecdsa_recover" + ecdsaRecover :: + Ptr LCtx -> + Ptr PubKey64 -> + Ptr RecSig65 -> + Ptr Msg32 -> + IO Ret diff --git a/src/Crypto/Secp256k1/Internal/Util.hs b/src/Crypto/Secp256k1/Internal/Util.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Secp256k1/Internal/Util.hs @@ -0,0 +1,113 @@ +{-# LANGUAGE FlexibleContexts #-} + +-- | Helpers to move bytes between Haskell and the C library safely. +-- +-- Most mistakes in C bindings are about memory: passing a buffer of the wrong +-- size, letting the C side write into a 'ByteString' that other code shares, +-- or leaking a buffer when an exception is thrown. Every binding goes through +-- these functions, which check lengths before calling C, give the C library +-- fresh buffers to write into, and free them on every path. This module is +-- internal and has no API stability guarantee. +module Crypto.Secp256k1.Internal.Util where + +import Control.Exception (onException) +import Crypto.Secp256k1.Internal.ForeignTypes (Seed32) +import Data.Base16.Types (extractBase16) +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import Data.ByteString.Base16 (decodeBase16, encodeBase16, parseBase16) +import qualified Data.ByteString.Unsafe as BU +import Data.String.Conversions (ConvertibleStrings, cs) +import Foreign (Ptr, castPtr, copyBytes, free, mallocBytes) +import Foreign.C (CSize (..)) +import System.Entropy (getEntropy) + +-- | Decode hex, or 'Nothing' if the string is not valid hex. +decodeHex :: (ConvertibleStrings a ByteString) => a -> Maybe ByteString +decodeHex str = + case parseBase16 $ cs str of + Right b16 -> Just $ decodeBase16 b16 + Left _ -> Nothing + +-- | Show bytes as a quoted hex string. +showsHex :: ByteString -> ShowS +showsHex = shows . extractBase16 . encodeBase16 + +-- | Pass the bytes of a 'ByteString' to C without copying them. Only for +-- arguments that the C library reads and never writes: writing would change a +-- 'ByteString' that may be shared. +unsafeUseByteString :: ByteString -> ((Ptr a, CSize) -> IO b) -> IO b +unsafeUseByteString bs f = + BU.unsafeUseAsCStringLen bs $ \(b, l) -> + f (castPtr b, fromIntegral l) + +-- | Pass a copy of the bytes of a 'ByteString' to C. +useByteString :: ByteString -> ((Ptr a, CSize) -> IO b) -> IO b +useByteString bs f = + BS.useAsCStringLen bs $ \(b, l) -> + f (castPtr b, fromIntegral l) + +-- | Like 'unsafeUseByteString', for an argument that the C library reads as a +-- fixed number of bytes. A 'ByteString' of any other length would make the +-- library read outside the buffer, so this raises an error instead. The name +-- is the Haskell type, for the error message. +useFixedByteString :: + String -> Int -> ByteString -> ((Ptr a, CSize) -> IO b) -> IO b +useFixedByteString name len bs f + | BS.length bs == len = unsafeUseByteString bs f + | otherwise = wrongLength name len bs + +-- | Raise the error for a value of the wrong length. The name is the Haskell +-- type, for the error message. +wrongLength :: String -> Int -> ByteString -> a +wrongLength name len bs = + error $ + name + ++ " must be " + ++ show len + ++ " bytes long, got " + ++ show (BS.length bs) + +-- | Allocate a buffer of the given size for the C library to fill. The buffer +-- becomes the result when the action reports success. It is freed when the +-- action reports failure or throws. +withOutput :: Int -> (Ptr a -> IO Bool) -> IO (Maybe ByteString) +withOutput len f = do + ptr <- mallocBytes len + ok <- f ptr `onException` free ptr + if ok + then Just <$> unsafePackByteString (ptr, fromIntegral len) + else free ptr >> return Nothing + +-- | Like 'withOutput', for a C function that always fills the buffer. +fillOutput :: Int -> (Ptr a -> IO ()) -> IO ByteString +fillOutput len f = do + ptr <- mallocBytes len + f ptr `onException` free ptr + unsafePackByteString (ptr, fromIntegral len) + +-- | Like 'withOutput', with the buffer starting as a copy of a fixed-size +-- input that the C library modifies in place. The input is left untouched. +withCopy :: + String -> Int -> ByteString -> (Ptr a -> IO Bool) -> IO (Maybe ByteString) +withCopy name len bs f = + useFixedByteString name len bs $ \(src, _) -> + withOutput len $ \dst -> do + copyBytes dst (castPtr src) len + f dst + +-- | Take ownership of a @malloc@'ed buffer as a 'ByteString', without copying. +unsafePackByteString :: (Ptr a, CSize) -> IO ByteString +unsafePackByteString (b, l) = + BU.unsafePackMallocCStringLen (castPtr b, fromIntegral l) + +-- | Copy a C buffer into a new 'ByteString'. +packByteString :: (Ptr a, CSize) -> IO ByteString +packByteString (b, l) = + BS.packCStringLen (castPtr b, fromIntegral l) + +-- | Pass 32 bytes from the operating system's secure random source to C. +withRandomSeed :: (Ptr Seed32 -> IO a) -> IO a +withRandomSeed go = do + bs <- getEntropy 32 + useByteString bs $ go . fst diff --git a/src/Crypto/Secp256k1/Recovery.hs b/src/Crypto/Secp256k1/Recovery.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Secp256k1/Recovery.hs @@ -0,0 +1,72 @@ +-- | ECDSA public key recovery, through the @recovery@ module of +-- . +-- +-- Up to four public keys verify a given ECDSA signature (r, s) of a hash. A +-- recovery id of 0 to 3 says which one: R is the point whose x coordinate is +-- r, or r + n for the ids 2 and 3, and whose y coordinate is even for the +-- ids 0 and 2 and odd for 1 and 3. The key is then Q = r⁻¹(s·R − e·G), where +-- e is the hash as a number. 'signRecMsg' signs and keeps the id, and +-- 'recover' computes the key from a signature, its id and the hash. +-- +-- Bitcoin signed messages use this: a signature is 65 bytes, a header byte +-- followed by r and s, and the verifier recovers the key and compares its +-- address with the one given. The header byte is 27 plus the id, plus 4 for +-- a compressed key, and BIP 137 adds 8 or 12 more for a SegWit address. +-- 'exportCompactRecSig' and 'importCompactRecSig' convert between a 'RecSig' +-- and the r‖s bytes with the id; the header byte itself is left to the +-- caller. +-- +-- == Relation to the ECDSA functions +-- +-- 'signRecMsg' uses the same RFC 6979 nonce as 'Crypto.Secp256k1.signMsg', +-- so 'convertRecSig' of its result is the signature that +-- 'Crypto.Secp256k1.signMsg' gives, in lower-S form. There is no low-R +-- grinding, and Bitcoin Core does not grind either when it signs a message, +-- so message signatures are byte for byte the same as Bitcoin Core's. +-- +-- 'recover' does not apply the lower-S rule of 'Crypto.Secp256k1.verifySig'. +-- The high-S form of a signature, with the parity bit of its id flipped, +-- recovers the same key, and Bitcoin Core accepts such message signatures +-- too. Where the rule matters, check 'Crypto.Secp256k1.isLowS' on +-- 'convertRecSig'. +-- +-- The ids 2 and 3 only come out of 'signRecMsg' when r is below p − n, which +-- happens for about one signature in 2^128. 'importCompactRecSig' accepts +-- them and 'recover' handles them. +-- +-- == The recovery module of libsecp256k1 +-- +-- libsecp256k1 only has this module when it was built with +-- @--enable-module-recovery@, or @SECP256K1_ENABLE_MODULE_RECOVERY=ON@ with +-- CMake. That is off by default upstream, but on in the libraries that +-- Debian, Ubuntu, Fedora, Arch, Alpine, openSUSE, Homebrew and Nixpkgs ship. +-- This package binds it when its @recovery@ flag is on, which is the +-- default. With a library built without the module, the first program to +-- link fails with an undefined reference to @secp256k1_ecdsa_recover@. Build +-- the package with @-f -recovery@ then, and this module is not available. +-- +-- == Values +-- +-- 'RecSig' is built through 'signRecMsg', 'importCompactRecSig' or 'recSig', +-- which validate it, so a 'RecSig' always has both components in the range 1 +-- to n−1 and an id of 0 to 3. Its @get@ field gives the internal +-- representation of libsecp256k1, which is opaque and not portable. 'Show', +-- 'Read' and 'Data.String.IsString' use hex of r and s as 32-byte big-endian +-- numbers followed by the id as one byte. The raw constructor is in +-- "Crypto.Secp256k1.Internal.Recovery", which has no API stability +-- guarantee. +module Crypto.Secp256k1.Recovery + ( -- * Recoverable signatures + RecSig (get), + recSig, + signRecMsg, + recover, + convertRecSig, + + -- ** Compact + importCompactRecSig, + exportCompactRecSig, + ) +where + +import Crypto.Secp256k1.Internal.Recovery diff --git a/test/Crypto/Secp256k1/Fixtures.hs b/test/Crypto/Secp256k1/Fixtures.hs new file mode 100644 --- /dev/null +++ b/test/Crypto/Secp256k1/Fixtures.hs @@ -0,0 +1,128 @@ +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Fixtures and helpers shared by the specifications. +module Crypto.Secp256k1.Fixtures where + +import Crypto.Secp256k1 +import Data.Base16.Types (assertBase16, extractBase16) +import Data.ByteString qualified as BS +import Data.ByteString.Base16 (decodeBase16, encodeBase16') +import Data.ByteString.Char8 qualified as B8 +import Data.Maybe (fromJust) +import Data.String (fromString) + +-- * Fixtures +-- +-- Every expected value is a literal from an independent source: the secp256k1 +-- generator, the RFC 6979 vector for key 1 and sha256 "Satoshi Nakamoto", +-- Bitcoin Core's key_tests.cpp, or this package's historical vectors, all +-- recomputed with an independent implementation of the curve. + +zero, one, order, orderMinusOne, orderPlusOne, allOnes :: String +zero = "0000000000000000000000000000000000000000000000000000000000000000" +one = "0000000000000000000000000000000000000000000000000000000000000001" +order = "fffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364141" +orderMinusOne = "fffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364140" +orderPlusOne = "fffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364142" +allOnes = "ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff" + +-- Secret key 1. Its public key is the generator G. +keyOne :: SecKey +keyOne = fromString one + +-- The generator G in its three SEC1 encodings. y is even, so the compressed +-- prefix is 02 and the hybrid prefix is 06. +genCompressed, genUncompressed, genHybrid :: String +genCompressed = + "0279be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798" +genUncompressed = + "0479be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798\ + \483ada7726a3c4655da4fbfc0e1108a8fd17b448a68554199c47d08ffb10d4b8" +genHybrid = + "0679be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798\ + \483ada7726a3c4655da4fbfc0e1108a8fd17b448a68554199c47d08ffb10d4b8" + +-- RFC 6979 vector: key 1 signing sha256 "Satoshi Nakamoto". +satoshiMsg :: Msg +satoshiMsg = "a0dc65ffca799873cbea0ac274015b9526505daaaed385155425f7337704883e" + +satoshiR, satoshiS, satoshiHighS :: String +satoshiR = "934b1ea10a4b3c1757e2b0c017d0b6143ce3c9a7e6a4a49860d7a6ab210ee3d8" +satoshiS = "2442ce9d2b916064108014783e923ec36b49743e2ffa1c4496f01a512aafd9e5" +-- n - s +satoshiHighS = "dbbd3162d46e9f9bef7feb87c16dc13b4f6568a87f4e83f728e2443ba586675c" + +satoshiDer :: String +satoshiDer = "3045022100" ++ satoshiR ++ "0220" ++ satoshiS + +-- Bitcoin Core key_tests.cpp: the secret key of WIF +-- 5HxWvvfubhXpYYpS3tJkw6fq9jE9j18THftkZjHHfmFiWtmAbrj signing +-- sha256d "Very deterministic message". +coreKey :: SecKey +coreKey = "12b004fff7f4b69ef8650e767f18f11ede158148b425660723b9f9a66e61f747" + +coreMsg :: Msg +coreMsg = "5255683da567900bfd3e786ed8836a4e7763c221bf1ac20ece2a5171b9199e8a" + +coreDer :: String +coreDer = + "304402205dbbddda71772d95ce91cd2d14b592cfbc1dd0aabd6a394b6c2d377bbe59d31d\ + \022014ddda21494a4e221f0824f0b8b924c43fa43c0ad57dccdaa11f81a6bd4582f6" + +-- Key 1 signing sha256 "4". Plain RFC 6979 gives a high r (first byte d4), +-- so Bitcoin Core's grinding retries once with counter 1 as extra nonce data. +highRMsg :: Msg +highRMsg = "4b227777d4dd1fc61c6f884f48641d02b4d121d3fd328cb08b5531fcacdabf8a" + +highRDer, groundDer :: String +highRDer = + "3045022100d479c93a086bf5f4ae1fed7eaf2604a4da2007d851c5409961c81dd7f0600194\ + \02201cd7a196454152f5b8d19865d49b4fa71e314ebff9c59e2f7b2295bf80331be8" +groundDer = + "3044022020b11f7066dd4486e811ea4f1fee43b1538fcd5bedb64b52d01e56b13422430c\ + \022056cb81320c8439cee666af08788c08e60fda80216a25f52b38714191c8cd1b99" + +-- Key 1 signing sha256 "1". Plain RFC 6979 already gives a low r. +lowRMsg :: Msg +lowRMsg = "6b86b273ff34fce19d6b804eff5a3f5747ada4eaa22f1d49c01e52ddb7875b4b" + +lowRDer :: String +lowRDer = + "304402202d24f8d536fccf696a4edfa858e5d6fc89a11d25f72ef4f89de1577d53643c0a\ + \02200d25586b118d5d7f8b79a7805c885fa8588dfa9e6cc777edc11a7e33de844285" + +-- Historical vectors of this package. +histKey :: SecKey +histKey = "f65255094d7773ed8dd417badc9fc045c1f80fdc5b2d25172b031ce6933e039a" + +histTweak :: Tweak +histTweak = "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00" + +histPub :: String +histPub = + "04dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd44705\ + \12213d5ed790522c042dee8e85c4c0ec5f96800b72bc5940c8bc1c5e11e4fcbf" + +-- The field size p of secp256k1. It is not a valid x coordinate. +fieldSize :: String +fieldSize = "fffffffffffffffffffffffffffffffffffffffffffffffffffffffefffffc2f" + +-- * Helpers + +hexToBytes :: String -> BS.ByteString +hexToBytes = decodeBase16 . assertBase16 . B8.pack + +bytesToHex :: BS.ByteString -> String +bytesToHex = B8.unpack . extractBase16 . encodeBase16' + +showRead :: (Show a, Read a, Eq a) => a -> Bool +showRead x = read (show x) == x + +-- The hex literal, quoted the way 'show' quotes a string. +quoted :: String -> String +quoted s = "\"" ++ s ++ "\"" + +-- The negation of a public key: multiplication by n - 1. +negatePubKey :: Ctx -> PubKey -> PubKey +negatePubKey ctx p = fromJust (tweakMulPubKey ctx p (fromString orderMinusOne)) diff --git a/test/Crypto/Secp256k1/InternalSpec.hs b/test/Crypto/Secp256k1/InternalSpec.hs --- a/test/Crypto/Secp256k1/InternalSpec.hs +++ b/test/Crypto/Secp256k1/InternalSpec.hs @@ -1,377 +1,438 @@ {-# LANGUAGE OverloadedStrings #-} + module Crypto.Secp256k1.InternalSpec (spec) where -import Control.Monad -import Control.Monad.Trans -import Crypto.Secp256k1.Internal -import Data.ByteString (ByteString, packCStringLen, - useAsCStringLen, copy) -import qualified Data.ByteString.Base16 as B16 -import Foreign -import System.Entropy -import Test.Hspec -import Test.HUnit (Assertion, assertBool, assertEqual) +import Control.Exception +import Control.Monad +import Control.Monad.Trans +import Crypto.Secp256k1.Internal.BaseOps +import Crypto.Secp256k1.Internal.Context +import Crypto.Secp256k1.Internal.ForeignTypes +import Crypto.Secp256k1.Internal.Util +import Data.Base16.Types (assertBase16) +import Data.ByteString + ( ByteString, + copy, + packCStringLen, + useAsCStringLen, + ) +import Data.ByteString.Base16 (decodeBase16) +import Foreign +import System.Entropy +import Test.HUnit (Assertion, assertBool, assertEqual) +import Test.Hspec spec :: Spec spec = do - describe "housekeeping" $ do - it "creates context" createContextTest - it "randomizes context" randomizeContextTest - it "clones context" cloneContextTest - describe "serialization" $ do - it "parses public key" ecPubkeyParseTest - it "serializes public key" ecPubKeySerializeTest - it "parses DER signature" ecdsaSignatureParseDerTest - it "serializes DER signature" ecdsaSignatureSerializeDerTest - describe "signatures" $ do - it "verifies signature" ecdsaVerifyTest - -- TODO: - -- , testCase "RFC6979 nonce function" nonce_function_rfc6979_test - it "signs message" ecdsaSignTest - describe "secret keys" $ do - it "verifies secret key" ecSecKeyVerifyTest - it "creates public key" ecPubkeyCreateTest - it "adds secret key" ecSecKeyTweakAddTest - it "multiplies secret key" ecSecKeyTweakMulTest - describe "public keys" $ do - it "adds public key" ecPubKeyTweakAddTest - it "multiplies public key" ecPubKeyTweakMulTest - it "combines public keys" ecPubKeyCombineTest + describe "housekeeping" $ do + it "creates context" createContextTest + it "randomizes context" randomizeContextTest + it "clones context" cloneContextTest + describe "serialization" $ do + it "parses public key" ecPubkeyParseTest + it "serializes public key" ecPubKeySerializeTest + it "parses DER signature" ecdsaSignatureParseDerTest + it "serializes DER signature" ecdsaSignatureSerializeDerTest + describe "signatures" $ do + it "verifies signature" ecdsaVerifyTest + -- TODO: + -- , testCase "RFC6979 nonce function" nonce_function_rfc6979_test + it "signs message" ecdsaSignTest + describe "secret keys" $ do + it "verifies secret key" ecSecKeyVerifyTest + it "creates public key" ecPubkeyCreateTest + it "adds secret key" ecSecKeyTweakAddTest + it "multiplies secret key" ecSecKeyTweakMulTest + describe "public keys" $ do + it "adds public key" ecPubKeyTweakAddTest + it "multiplies public key" ecPubKeyTweakMulTest + it "combines public keys" ecPubKeyCombineTest +withCtxPtr :: CtxFlags -> (Ptr LCtx -> IO a) -> IO a +withCtxPtr f = bracket (contextCreate f) contextDestroy + withEntropy :: (Ptr Seed32 -> IO a) -> IO a withEntropy f = - getEntropy 32 >>= \e -> + getEntropy 32 >>= \e -> useByteString e $ \(s, _) -> f s createContextTest :: Assertion -createContextTest = do - context_ptr <- liftIO $ contextCreate signVerify - assertBool "context not null" $ context_ptr /= nullPtr +createContextTest = withCtxPtr signVerify $ \ctx -> do + assertBool "context not null" $ ctx /= nullPtr randomizeContextTest :: Assertion -randomizeContextTest = do - ret <- liftIO $ contextCreate sign >>= \x -> - withEntropy (contextRandomize x) - assertBool "context randomized" $ isSuccess ret +randomizeContextTest = withCtxPtr sign $ \ctx -> do + ret <- withEntropy (contextRandomize ctx) + assertBool "context randomized" $ isSuccess ret cloneContextTest :: Assertion cloneContextTest = do - (x1, x2) <- liftIO $ do - x1 <- contextCreate signVerify - ret <- withEntropy $ contextRandomize x1 - unless (isSuccess ret) $ error "failed to randomize context" - x2 <- contextClone x1 - return (x1, x2) - assertBool "original context not null" $ x1 /= nullPtr - assertBool "cloned context not null" $ x2 /= nullPtr - assertBool "context ptrs different" $ x1 /= x2 + (x1, x2) <- liftIO $ do + x1 <- contextCreate signVerify + ret <- withEntropy $ contextRandomize x1 + unless (isSuccess ret) $ error "failed to randomize context" + x2 <- contextClone x1 + return (x1, x2) + assertBool "original context not null" $ x1 /= nullPtr + assertBool "cloned context not null" $ x2 /= nullPtr + assertBool "context ptrs different" $ x1 /= x2 ecPubkeyParseTest :: Assertion ecPubkeyParseTest = do - ret <- liftIO $ useAsCStringLen der $ \(i, il) -> do - x <- contextCreate verify - allocaBytes 64 $ \pubkey -> - ecPubKeyParse x pubkey (castPtr i) (fromIntegral il) - assertBool "parsed public key" (isSuccess ret) + ret <- liftIO $ useAsCStringLen der $ \(i, il) -> do + x <- contextCreate verify + allocaBytes 64 $ \pubkey -> + ecPubKeyParse x pubkey (castPtr i) (fromIntegral il) + assertBool "parsed public key" (isSuccess ret) where - der = fst $ B16.decode - "03dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd44705" + der = + decodeBase16 $ + assertBase16 + "03dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd44705" ecPubKeySerializeTest :: Assertion ecPubKeySerializeTest = do - (ret, dec) <- liftIO $ - useByteString der $ \(i, il) -> - allocaBytes 64 $ \k -> + (ret, dec) <- liftIO $ + useByteString der $ \(i, il) -> + allocaBytes 64 $ \k -> alloca $ \ol -> - allocaBytes 72 $ \o -> do - poke ol 72 - x <- contextCreate verify - ret1 <- ecPubKeyParse x k i il - unless (isSuccess ret1) $ error "failed to parse pubkey" - ret2 <- ecPubKeySerialize x o ol k compressed - len <- fromIntegral <$> peek ol - decoded <- packCStringLen (castPtr o, len) - return (ret2, decoded) - assertBool "serialized public key successfully" $ isSuccess ret - assertEqual "public key matches" der dec + allocaBytes 72 $ \o -> do + poke ol 72 + x <- contextCreate verify + ret1 <- ecPubKeyParse x k i il + unless (isSuccess ret1) $ error "failed to parse pubkey" + ret2 <- ecPubKeySerialize x o ol k compressed + len <- fromIntegral <$> peek ol + decoded <- packCStringLen (castPtr o, len) + return (ret2, decoded) + assertBool "serialized public key successfully" $ isSuccess ret + assertEqual "public key matches" der dec where - der = fst $ B16.decode - "03dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd44705" + der = + decodeBase16 $ + assertBase16 + "03dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd44705" ecdsaSignatureParseDerTest :: Assertion ecdsaSignatureParseDerTest = do - ret <- liftIO $ useAsCStringLen der $ \(d, dl) -> allocaBytes 64 $ \s -> do - x <- contextCreate verify - ecdsaSignatureParseDer x s (castPtr d) (fromIntegral dl) - assertBool "parsed signature successfully" $ isSuccess ret + ret <- liftIO $ useAsCStringLen der $ \(d, dl) -> allocaBytes 64 $ \s -> do + x <- contextCreate verify + ecdsaSignatureParseDer x s (castPtr d) (fromIntegral dl) + assertBool "parsed signature successfully" $ isSuccess ret where - der = fst $ B16.decode - "3045022100f502bfa07af43e7ef265618b0d929a7619ee01d6150e37eb6eaaf2c8bd37\ - \fb2202206f0415ab0e9a977afd78b2c26ef39b3952096d319fd4b101c768ad6c132e30\ - \45" + der = + decodeBase16 $ + assertBase16 + "3045022100f502bfa07af43e7ef265618b0d929a7619ee01d6150e37eb6eaaf2c8bd37\ + \fb2202206f0415ab0e9a977afd78b2c26ef39b3952096d319fd4b101c768ad6c132e30\ + \45" -parseDer :: Ctx -> ByteString -> IO ByteString +parseDer :: Ptr LCtx -> ByteString -> IO ByteString parseDer x bs = - useAsCStringLen bs $ \(d, dl) -> + useAsCStringLen bs $ \(d, dl) -> allocaBytes 64 $ \s -> do - ret <- ecdsaSignatureParseDer x s (castPtr d) (fromIntegral dl) - unless (isSuccess ret) $ error "could not parse DER" - packByteString (s, 64) + ret <- ecdsaSignatureParseDer x s (castPtr d) (fromIntegral dl) + unless (isSuccess ret) $ error "could not parse DER" + packByteString (s, 64) ecdsaSignatureSerializeDerTest :: Assertion ecdsaSignatureSerializeDerTest = do - (ret, enc) <- liftIO $ do - x <- contextCreate verify - sig <- parseDer x der - alloca $ \ol -> - allocaBytes 72 $ \o -> - useByteString sig $ \(s, _) -> do - poke ol 72 - ret <- ecdsaSignatureSerializeDer x o ol s - len <- fromIntegral <$> peek ol - enc <- packCStringLen (castPtr o, len) - return (ret, enc) - assertBool "serialization successful" $ isSuccess ret - assertEqual "signatures match" der enc + (ret, enc) <- liftIO . bracket (contextCreate verify) contextDestroy $ \x -> do + sig <- parseDer x der + (ret, enc) <- alloca $ \ol -> + allocaBytes 72 $ \o -> + useByteString sig $ \(s, _) -> do + poke ol 72 + ret <- ecdsaSignatureSerializeDer x o ol s + len <- fromIntegral <$> peek ol + enc <- packCStringLen (castPtr o, len) + return (ret, enc) + return (ret, enc) + assertBool "serialization successful" $ isSuccess ret + assertEqual "signatures match" der enc where - der = fst $ B16.decode - "3045022100f502bfa07af43e7ef265618b0d929a7619ee01d6150e37eb6eaaf2c8bd37\ - \fb2202206f0415ab0e9a977afd78b2c26ef39b3952096d319fd4b101c768ad6c132e30\ - \45" + der = + decodeBase16 $ + assertBase16 + "3045022100f502bfa07af43e7ef265618b0d929a7619ee01d6150e37eb6eaaf2c8bd37\ + \fb2202206f0415ab0e9a977afd78b2c26ef39b3952096d319fd4b101c768ad6c132e30\ + \45" ecdsaVerifyTest :: Assertion -ecdsaVerifyTest = do - ret <- liftIO $ do - x <- contextCreate verify - sig <- parseDer x der - pk <- useByteString pub $ \(p, pl) -> - allocaBytes 64 $ \k -> do - ret <- ecPubKeyParse x k p (fromIntegral pl) - unless (isSuccess ret) $ error "could not parse public key" - packByteString (k, 64) - useByteString msg $ \(m, _) -> - useByteString pk $ \(k, _) -> - useByteString sig $ \(s, _) -> - ecdsaVerify x s m k - assertBool "signature valid" $ isSuccess ret +ecdsaVerifyTest = withCtxPtr verify $ \ctx -> do + ret <- liftIO $ do + sig <- parseDer ctx der + pk <- useByteString pub $ \(p, pl) -> + allocaBytes 64 $ \k -> do + ret <- ecPubKeyParse ctx k p (fromIntegral pl) + unless (isSuccess ret) $ error "could not parse public key" + packByteString (k, 64) + useByteString msg $ \(m, _) -> + useByteString pk $ \(k, _) -> + useByteString sig $ \(s, _) -> + ecdsaVerify ctx s m k + assertBool "signature valid" $ isSuccess ret where - der = fst $ B16.decode - "3045022100f502bfa07af43e7ef265618b0d929a7619ee01d6150e37eb6eaaf2c8bd37\ - \fb2202206f0415ab0e9a977afd78b2c26ef39b3952096d319fd4b101c768ad6c132e30\ - \45" - pub = fst $ B16.decode - "04dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd447051221\ - \3d5ed790522c042dee8e85c4c0ec5f96800b72bc5940c8bc1c5e11e4fcbf" - msg = fst $ B16.decode - "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00" + der = + decodeBase16 $ + assertBase16 + "3045022100f502bfa07af43e7ef265618b0d929a7619ee01d6150e37eb6eaaf2c8bd37\ + \fb2202206f0415ab0e9a977afd78b2c26ef39b3952096d319fd4b101c768ad6c132e30\ + \45" + pub = + decodeBase16 $ + assertBase16 + "04dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd447051221\ + \3d5ed790522c042dee8e85c4c0ec5f96800b72bc5940c8bc1c5e11e4fcbf" + msg = + decodeBase16 $ + assertBase16 + "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00" -signCtx :: IO Ctx -signCtx = contextCreate sign >>= \c -> +signCtx :: IO (Ptr LCtx) +signCtx = + contextCreate sign >>= \c -> withEntropy (contextRandomize c) >>= \r -> - unless (isSuccess r) (error "failed to randomize context") >> return c + unless (isSuccess r) (error "failed to randomize context") >> return c -createPubKey :: Ctx -> Ptr SecKey32 -> Ptr PubKey64 -> IO () -createPubKey x k p = do - ret <- ecPubKeyCreate x p k - unless (isSuccess ret) $ error "failed to create public key" +withSignCtxPtr :: (Ptr LCtx -> IO a) -> IO a +withSignCtxPtr = bracket signCtx contextDestroy +createPubKey :: Ptr LCtx -> Ptr SecKey32 -> Ptr PubKey64 -> IO () +createPubKey ctx k p = do + ret <- ecPubKeyCreate ctx p k + unless (isSuccess ret) $ error "failed to create public key" + ecdsaSignTest :: Assertion ecdsaSignTest = do - der <- liftIO $ do - x <- signCtx - allocaBytes 64 $ \s -> - useByteString msg $ \(m, _) -> - useByteString key $ \(k, _) -> - alloca $ \ol -> + der <- liftIO $ withSignCtxPtr $ \ctx -> do + allocaBytes 64 $ \s -> + useByteString msg $ \(m, _) -> + useByteString key $ \(k, _) -> + alloca $ \ol -> allocaBytes 72 $ \o -> do - poke ol 72 - ret1 <- ecdsaSign x s m k nullFunPtr nullPtr - unless (isSuccess ret1) $ error "could not sign message" - ret2 <- ecdsaSignatureSerializeDer x o ol s - unless (isSuccess ret2) $ error "could not serialize signature" - len <- peek ol - packCStringLen (castPtr o, fromIntegral len) - ret <- liftIO $ do - pub <- allocaBytes 64 $ \p -> - useByteString key $ \(s, _) -> do - x <- signCtx - createPubKey x s p - packByteString (p, 64) - useByteString msg $ \(m, _) -> - useByteString pub $ \(p, _) -> do - x <- contextCreate verify - s' <- parseDer x der - useByteString s' $ \(s, _) -> ecdsaVerify x s m p - assertBool "signature matches" (isSuccess ret) + poke ol 72 + ret1 <- ecdsaSign ctx s m k nullFunPtr nullPtr + unless (isSuccess ret1) $ error "could not sign message" + ret2 <- ecdsaSignatureSerializeDer ctx o ol s + unless (isSuccess ret2) $ error "could not serialize signature" + len <- peek ol + packCStringLen (castPtr o, fromIntegral len) + ret <- liftIO $ do + pub <- withSignCtxPtr $ \ctx -> allocaBytes 64 $ \p -> + useByteString key $ \(s, _) -> do + createPubKey ctx s p + packByteString (p, 64) + withCtxPtr verify $ \ctx -> useByteString msg $ \(m, _) -> + useByteString pub $ \(p, _) -> do + s' <- parseDer ctx der + useByteString s' $ \(s, _) -> ecdsaVerify ctx s m p + assertBool "signature matches" (isSuccess ret) where - msg = fst $ B16.decode - "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00" - key = fst $ B16.decode - "f65255094d7773ed8dd417badc9fc045c1f80fdc5b2d25172b031ce6933e039a" - + msg = + decodeBase16 $ + assertBase16 + "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00" + key = + decodeBase16 $ + assertBase16 + "f65255094d7773ed8dd417badc9fc045c1f80fdc5b2d25172b031ce6933e039a" ecSecKeyVerifyTest :: Assertion -ecSecKeyVerifyTest = do - ret <- liftIO $ useByteString key $ \(k, _) -> do - x <- signCtx - ecSecKeyVerify x k - assertBool "valid secret key" $ isSuccess ret +ecSecKeyVerifyTest = withSignCtxPtr $ \ctx -> do + ret <- liftIO $ useByteString key $ \(k, _) -> do + ecSecKeyVerify ctx k + assertBool "valid secret key" $ isSuccess ret where - key = fst $ B16.decode - "f65255094d7773ed8dd417badc9fc045c1f80fdc5b2d25172b031ce6933e039a" + key = + decodeBase16 $ + assertBase16 + "f65255094d7773ed8dd417badc9fc045c1f80fdc5b2d25172b031ce6933e039a" ecPubkeyCreateTest :: Assertion -ecPubkeyCreateTest = do - pk <- liftIO $ - useByteString key $ \(s, _) -> - allocaBytes 64 $ \k -> do - x <- signCtx - createPubKey x s k +ecPubkeyCreateTest = withSignCtxPtr $ \ctx -> do + pk <- liftIO $ + useByteString key $ \(s, _) -> + allocaBytes 64 $ \k -> do + createPubKey ctx s k allocaBytes 65 $ \o -> - alloca $ \ol -> do + alloca $ \ol -> do poke ol 65 - rets <- ecPubKeySerialize x o ol k uncompressed + rets <- ecPubKeySerialize ctx o ol k uncompressed unless (isSuccess rets) $ error "failed to serialize public key" len <- fromIntegral <$> peek ol packCStringLen (castPtr o, len) - assertEqual "public key matches" pub pk + assertEqual "public key matches" pub pk where - key = fst $ B16.decode - "f65255094d7773ed8dd417badc9fc045c1f80fdc5b2d25172b031ce6933e039a" - pub = fst $ B16.decode - "04dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd447051221\ - \3d5ed790522c042dee8e85c4c0ec5f96800b72bc5940c8bc1c5e11e4fcbf" + key = + decodeBase16 $ + assertBase16 + "f65255094d7773ed8dd417badc9fc045c1f80fdc5b2d25172b031ce6933e039a" + pub = + decodeBase16 $ + assertBase16 + "04dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd447051221\ + \3d5ed790522c042dee8e85c4c0ec5f96800b72bc5940c8bc1c5e11e4fcbf" ecSecKeyTweakAddTest :: Assertion ecSecKeyTweakAddTest = do - (ret, tweaked) <- liftIO $ - signCtx >>= \x -> - useByteString tweak $ \(w, _) -> + (ret, tweaked) <- + liftIO . withSignCtxPtr $ \ctx -> + useByteString tweak $ \(w, _) -> useByteString key $ \(k, _) -> do - ret <- ecSecKeyTweakAdd x k w - tweaked <- packByteString (k, 32) - return (ret, tweaked) - assertBool "successful secret key tweak" $ isSuccess ret - assertEqual "tweaked keys match" expected tweaked + ret <- ecSecKeyTweakAdd ctx k w + tweaked <- packByteString (k, 32) + return (ret, tweaked) + assertBool "successful secret key tweak" $ isSuccess ret + assertEqual "tweaked keys match" expected tweaked where - key = fst $ B16.decode - "f65255094d7773ed8dd417badc9fc045c1f80fdc5b2d25172b031ce6933e039a" - tweak = fst $ B16.decode - "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00" - expected = fst $ B16.decode - "ec1e3ce1cefa18a671d51125e2b249688d934b0e28f5d1665384d9b02f929059" + key = + decodeBase16 $ + assertBase16 + "f65255094d7773ed8dd417badc9fc045c1f80fdc5b2d25172b031ce6933e039a" + tweak = + decodeBase16 $ + assertBase16 + "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00" + expected = + decodeBase16 $ + assertBase16 + "ec1e3ce1cefa18a671d51125e2b249688d934b0e28f5d1665384d9b02f929059" ecSecKeyTweakMulTest :: Assertion ecSecKeyTweakMulTest = do - (ret, tweaked) <- liftIO $ do - x <- contextCreate sign - retr <- withEntropy $ contextRandomize x - unless (isSuccess retr) $ error "failed to randomize context" - useByteString tweak $ \(w, _) -> useByteString key $ \(k, _) -> do - ret <- ecSecKeyTweakMul x k w - tweaked <- packByteString (k, 32) - return (ret, tweaked) - assertBool "successful secret key tweak" $ isSuccess ret - assertEqual "tweaked keys match" expected tweaked + (ret, tweaked) <- liftIO $ withSignCtxPtr $ \ctx -> do + useByteString tweak $ \(w, _) -> useByteString key $ \(k, _) -> do + ret <- ecSecKeyTweakMul ctx k w + tweaked <- packByteString (k, 32) + return (ret, tweaked) + assertBool "successful secret key tweak" $ isSuccess ret + assertEqual "tweaked keys match" expected tweaked where - key = fst $ B16.decode - "f65255094d7773ed8dd417badc9fc045c1f80fdc5b2d25172b031ce6933e039a" - tweak = fst $ B16.decode - "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00" - expected = fst $ B16.decode - "a96f5962493acb179f60a86a9785fc7a30e0c39b64c09d24fe064d9aef15e4c0" + key = + decodeBase16 $ + assertBase16 + "f65255094d7773ed8dd417badc9fc045c1f80fdc5b2d25172b031ce6933e039a" + tweak = + decodeBase16 $ + assertBase16 + "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00" + expected = + decodeBase16 $ + assertBase16 + "a96f5962493acb179f60a86a9785fc7a30e0c39b64c09d24fe064d9aef15e4c0" -serializeKey :: Ctx -> Ptr PubKey64 -> IO ByteString +serializeKey :: Ptr LCtx -> Ptr PubKey64 -> IO ByteString serializeKey x p = allocaBytes 72 $ \d -> alloca $ \dl -> do - poke dl 72 - ret <- ecPubKeySerialize x d dl p uncompressed - unless (isSuccess ret) $ error "could not serialize public key" - len <- peek dl - packCStringLen (castPtr d, fromIntegral len) + poke dl 72 + ret <- ecPubKeySerialize x d dl p uncompressed + unless (isSuccess ret) $ error "could not serialize public key" + len <- peek dl + packCStringLen (castPtr d, fromIntegral len) -parseKey :: Ctx -> ByteString -> IO ByteString +parseKey :: Ptr LCtx -> ByteString -> IO ByteString parseKey x bs = - allocaBytes 64 $ \p -> + allocaBytes 64 $ \p -> useByteString bs $ \(d, dl) -> do - ret <- ecPubKeyParse x p d dl - unless (isSuccess ret) $ error "could not parse public key" - packByteString (p, 64) + ret <- ecPubKeyParse x p d dl + unless (isSuccess ret) $ error "could not parse public key" + packByteString (p, 64) ecPubKeyTweakAddTest :: Assertion ecPubKeyTweakAddTest = do - (ret, tweaked) <- liftIO $ do - x <- contextCreate verify - pk <- copy <$> parseKey x pub - useByteString tweak $ \(w, _) -> - useByteString pk $ \(p, _) -> do - ret <- ecPubKeyTweakAdd x p w - tweaked <- serializeKey x p - return (ret, tweaked) - assertBool "successful secret key tweak" $ isSuccess ret - assertEqual "tweaked keys match" expected tweaked + (ret, tweaked) <- liftIO $ do + x <- contextCreate verify + pk <- copy <$> parseKey x pub + useByteString tweak $ \(w, _) -> + useByteString pk $ \(p, _) -> do + ret <- ecPubKeyTweakAdd x p w + tweaked <- serializeKey x p + return (ret, tweaked) + assertBool "successful public key tweak" $ isSuccess ret + assertEqual "tweaked keys match" expected tweaked where - pub = fst $ B16.decode - "04dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd447051221\ - \3d5ed790522c042dee8e85c4c0ec5f96800b72bc5940c8bc1c5e11e4fcbf" - tweak = fst $ B16.decode - "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00" - expected = fst $ B16.decode - "04441c3982b97576646e0df0c96736063df6b42f2ee566d13b9f6424302d1379e518fd\ - \c87a14c5435bff7a5db4552042cb4120c6b86a4bbd3d0643f3c14ad01368" + pub = + decodeBase16 $ + assertBase16 + "04dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd447051221\ + \3d5ed790522c042dee8e85c4c0ec5f96800b72bc5940c8bc1c5e11e4fcbf" + tweak = + decodeBase16 $ + assertBase16 + "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00" + expected = + decodeBase16 $ + assertBase16 + "04441c3982b97576646e0df0c96736063df6b42f2ee566d13b9f6424302d1379e518fd\ + \c87a14c5435bff7a5db4552042cb4120c6b86a4bbd3d0643f3c14ad01368" ecPubKeyTweakMulTest :: Assertion ecPubKeyTweakMulTest = do - (ret, tweaked) <- liftIO $ do - x <- contextCreate verify - pk <- copy <$> parseKey x pub - useByteString tweak $ \(w, _) -> - useByteString pk $ \(p, _) -> do - ret <- ecPubKeyTweakMul x p w - tweaked <- serializeKey x p - return (ret, tweaked) - assertBool "successful secret key tweak" $ isSuccess ret - assertEqual "tweaked keys match" expected tweaked + (ret, tweaked) <- liftIO $ do + x <- contextCreate verify + pk <- copy <$> parseKey x pub + useByteString tweak $ \(w, _) -> + useByteString pk $ \(p, _) -> do + ret <- ecPubKeyTweakMul x p w + tweaked <- serializeKey x p + return (ret, tweaked) + assertBool "successful public key tweak" $ isSuccess ret + assertEqual "tweaked keys match" expected tweaked where - pub = fst $ B16.decode - "04dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd447051221\ - \3d5ed790522c042dee8e85c4c0ec5f96800b72bc5940c8bc1c5e11e4fcbf" - tweak = fst $ B16.decode - "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00" - expected = fst $ B16.decode - "04f379dc99cdf5c83e433defa267fbb3377d61d6b779c06a0e4ce29ae3ff5353b12ae4\ - \9c9d07e7368f2ba5a446c203255ce912322991a2d6a9d5d5761c61ed1845" + pub = + decodeBase16 $ + assertBase16 + "04dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd447051221\ + \3d5ed790522c042dee8e85c4c0ec5f96800b72bc5940c8bc1c5e11e4fcbf" + tweak = + decodeBase16 $ + assertBase16 + "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00" + expected = + decodeBase16 $ + assertBase16 + "04f379dc99cdf5c83e433defa267fbb3377d61d6b779c06a0e4ce29ae3ff5353b12ae4\ + \9c9d07e7368f2ba5a446c203255ce912322991a2d6a9d5d5761c61ed1845" ecPubKeyCombineTest :: Assertion ecPubKeyCombineTest = do - (ret, com) <- liftIO $ - allocaBytes 64 $ \p1 -> - allocaBytes 64 $ \p2 -> + (ret, com) <- liftIO $ + allocaBytes 64 $ \p1 -> + allocaBytes 64 $ \p2 -> allocaBytes 64 $ \p3 -> - allocaArray 3 $ \a -> - allocaBytes 64 $ \p -> do - x <- contextCreate verify - parse x pub1 p1 - parse x pub2 p2 - parse x pub3 p3 - pokeArray a [p1, p2, p3] - ret <- ecPubKeyCombine x p a 3 - com <- serializeKey x p - return (ret, com) - assertBool "successful key combination" $ isSuccess ret - assertEqual "combined keys match" expected com + allocaArray 3 $ \a -> + allocaBytes 64 $ \p -> do + x <- contextCreate verify + parse x pub1 p1 + parse x pub2 p2 + parse x pub3 p3 + pokeArray a [p1, p2, p3] + ret <- ecPubKeyCombine x p a 3 + com <- serializeKey x p + return (ret, com) + assertBool "successful key combination" $ isSuccess ret + assertEqual "combined keys match" expected com where parse x pub p = useByteString pub $ \(d, dl) -> do - ret <- ecPubKeyParse x p d dl - unless (isSuccess ret) $ error "could not parse public key" - pub1 = fst $ B16.decode - "04dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd447051221\ - \3d5ed790522c042dee8e85c4c0ec5f96800b72bc5940c8bc1c5e11e4fcbf" - pub2 = fst $ B16.decode - "0487d82042d93447008dfe2af762068a1e53ff394a5bf8f68a045fa642b99ea5d153f5\ - \77dd2dba6c7ae4cfd7b6622409d7edd2d76dd13a8092cd3af97b77bd2c77" - pub3 = fst $ B16.decode - "049b101edcbe1ee37ff6b2318526a425b629e823d7d8d9154417880595a28000ee3feb\ - \d908754b8ce4e491aa6fe488b41fb5d4bb3788e33c9ff95a7a9229166d59" - expected = fst $ B16.decode - "043d9a7ec70011efc23c33a7e62d2ea73cca87797e3b659d93bea6aa871aebde56c3bc\ - \6134ca82e324b0ab9c0e601a6d2933afe7fb5d9f3aae900f5c5dc6e362c8" + ret <- ecPubKeyParse x p d dl + unless (isSuccess ret) $ error "could not parse public key" + pub1 = + decodeBase16 $ + assertBase16 + "04dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd447051221\ + \3d5ed790522c042dee8e85c4c0ec5f96800b72bc5940c8bc1c5e11e4fcbf" + pub2 = + decodeBase16 $ + assertBase16 + "0487d82042d93447008dfe2af762068a1e53ff394a5bf8f68a045fa642b99ea5d153f5\ + \77dd2dba6c7ae4cfd7b6622409d7edd2d76dd13a8092cd3af97b77bd2c77" + pub3 = + decodeBase16 $ + assertBase16 + "049b101edcbe1ee37ff6b2318526a425b629e823d7d8d9154417880595a28000ee3feb\ + \d908754b8ce4e491aa6fe488b41fb5d4bb3788e33c9ff95a7a9229166d59" + expected = + decodeBase16 $ + assertBase16 + "043d9a7ec70011efc23c33a7e62d2ea73cca87797e3b659d93bea6aa871aebde56c3bc\ + \6134ca82e324b0ab9c0e601a6d2933afe7fb5d9f3aae900f5c5dc6e362c8" diff --git a/test/Crypto/Secp256k1/RecoverySpec.hs b/test/Crypto/Secp256k1/RecoverySpec.hs new file mode 100644 --- /dev/null +++ b/test/Crypto/Secp256k1/RecoverySpec.hs @@ -0,0 +1,334 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | ECDSA public key recovery. The module under test only exists when the +-- @recovery@ flag of the package is on, so the whole specification is behind +-- the same flag. This module avoids string gaps, because CPP would join +-- their lines. +module Crypto.Secp256k1.RecoverySpec (spec) where + +import Test.Hspec + +#ifdef RECOVERY + +import Control.DeepSeq (deepseq) +import Control.Exception (evaluate) +import Control.Monad (forM_) +import Control.Monad.Par qualified as P +import Crypto.Secp256k1 +import Crypto.Secp256k1.Fixtures +import Crypto.Secp256k1.Internal.Base (CompactSig (CompactSig), Msg (Msg), SecKey (SecKey)) +import Crypto.Secp256k1.Internal.Recovery (RecSig (RecSig)) +import Crypto.Secp256k1.Recovery +import Data.Bits (xor) +import Data.ByteString qualified as BS +import Data.Hashable (hash) +import Data.Maybe (fromJust, isJust) +import Data.String (fromString) +import Data.Word (Word8) +import Test.QuickCheck +import Text.Read (readMaybe) + +spec :: Spec +spec = around withContext $ describe "public key recovery" $ do + signingSpec + recoverySpec + formulaSpec + compactSpec + valueSpec + rawValueSpec + instanceSpec + +-- * Fixtures +-- +-- As in "Crypto.Secp256k1.Fixtures", every expected value is a literal from +-- an independent source, recomputed with an independent implementation of +-- the curve. + +-- Bitcoin Core key_tests.cpp: the SignCompact signature of coreKey over +-- coreMsg is 20 ++ coreR ++ coreS. The header byte 0x20 = 32 = 27 + 1 + 4 +-- says recovery id 1 and a compressed key. coreDer is 30440220 ++ coreR ++ +-- 0220 ++ coreS. +coreR, coreS :: String +coreR = "5dbbddda71772d95ce91cd2d14b592cfbc1dd0aabd6a394b6c2d377bbe59d31d" +coreS = "14ddda21494a4e221f0824f0b8b924c43fa43c0ad57dccdaa11f81a6bd4582f6" + +coreRecId :: Word8 +coreRecId = 1 + +-- The compressed public key of coreKey, and the key that recovery id 0 gives +-- for the same signature. +corePub, coreOtherPub :: String +corePub = "030b4c866585dd868a9d62348a9cd008d6a312937048fff31670e7e920cfc7a744" +coreOtherPub = "02818f8ef9ebd82871789a39ea0385398c267d3d6bb6f537166bd813135870c8ec" + +-- Bitcoin Core util_tests.cpp, message_sign: the key of the address +-- 15CRxFdyRpGZLW9w8HnHvVduizdL5jKNbs signs the message "Trust no one". +messageKey :: SecKey +messageKey = "d97f5108f11cda6eeebaaa420fef0726b1f898060b98489fa3098463c0032866" + +-- sha256d of the varstrings "Bitcoin Signed Message:\n" and "Trust no one". +messageHash :: Msg +messageHash = "aa8215d723ecd2f14867eeb7e19f192be7bc15a2352a24b991d4f5870cbaf6e8" + +-- The expected signature, base64 +-- IPojfrX2dfPnH26UegfbGQQLrdK844DlHq5157/P6h57WyuS/Qsl+h/WSVGDF4MUi4rWSswW38oimDYfNNUBUOk= +-- decoded: the header byte 0x20, recovery id 1 and a compressed key, then r +-- and s. +messageR, messageS :: String +messageR = "fa237eb5f675f3e71f6e947a07db19040badd2bce380e51eae75e7bfcfea1e7b" +messageS = "5b2b92fd0b25fa1fd64951831783148b8ad64acc16dfca2298361f34d50150e9" + +-- The compressed public key of messageKey. +messagePub :: String +messagePub = "03d2be3dddb497c7c4388cfcb941e14a222cf3e26fe5e2cc260da1821e60d26022" + +-- The RFC 6979 vector has recovery id 1. Recovery id 0 gives this other key. +satoshiOtherPub :: String +satoshiOtherPub = "0354d58835e07b996d6378eafa930ae9d2211e767381f1d52aedc67f48c8886f0b" + +-- Key 1 signing sha256 "4" (highRDer): r, s and recovery id 0. +highRR, highRS :: String +highRR = "d479c93a086bf5f4ae1fed7eaf2604a4da2007d851c5409961c81dd7f0600194" +highRS = "1cd7a196454152f5b8d19865d49b4fa71e314ebff9c59e2f7b2295bf80331be8" + +-- Values for the formula Q = r⁻¹(s·R − e·G). +two, five :: String +two = "0000000000000000000000000000000000000000000000000000000000000002" +-- 5³ + 7 = 132 is not a square modulo p, so no point has x = 5. +five = "0000000000000000000000000000000000000000000000000000000000000005" + +-- x = 1 is on the curve: 1 + 7 = 8 is a square modulo p. pointOne is the +-- point with x = 1 and an even y, so its compressed encoding is 02 ++ one and +-- that of its negation is 03 ++ one. +pointOne, pointOneMinusG, twicePointOne :: String +pointOne = "02" ++ one +pointOneMinusG = "02871e0c836ec675e07395aef58d72b646f77e0e33ce1622dfaa0fb8e131f3fe12" +twicePointOne = "03c7ffffffffffffffffffffffffffffffffffffffffffffffffffffff37fffd03" + +-- x = n + 2 is on the curve, x = n + 1 is not. +orderPlusTwo :: String +orderPlusTwo = "fffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364143" + +-- Half of the point with x = n + 2 and an even y. +halfPointOrderPlusTwo :: String +halfPointOrderPlusTwo = "02ad802f2145df548ce1fc418b851cb32669c5a6bb939e6caf744de90310f8f1ff" + +-- p − n and p − n − 1. With the recovery id 2, the first gives x = p, which +-- is outside the field, and the second x = p − 1, which is not on the curve. +fieldMinusOrder, fieldMinusOrderMinusOne :: String +fieldMinusOrder = "000000000000000000000000000000014551231950b75fc4402da1722fc9baee" +fieldMinusOrderMinusOne = "000000000000000000000000000000014551231950b75fc4402da1722fc9baed" + +-- The x coordinate of G, and the key −(x⁻¹)·G. +genX, genNegatedOverX :: String +genX = drop 2 genCompressed +genNegatedOverX = "028ff83d8cf12121491609c4939dc11c4aa35503508fe432dc5a5c1905608b9218" + +-- * Signing + +signingSpec :: SpecWith Ctx +signingSpec = describe "signing" $ do + it "produces Bitcoin Core's SignCompact signature of sha256d 'Very deterministic message'" $ \ctx -> + exportCompactRecSig ctx (signRecMsg ctx coreKey coreMsg) + `shouldBe` (fromString (coreR ++ coreS), coreRecId) + it "produces Bitcoin Core's signmessage signature of 'Trust no one'" $ \ctx -> + exportCompactRecSig ctx (signRecMsg ctx messageKey messageHash) + `shouldBe` (fromString (messageR ++ messageS), 1) + it "produces the RFC 6979 vector with recovery id 1" $ \ctx -> + exportCompactRecSig ctx (signRecMsg ctx keyOne satoshiMsg) + `shouldBe` (fromString (satoshiR ++ satoshiS), 1) + it "keeps a high r, as Bitcoin Core's message signing does" $ \ctx -> do + exportCompactRecSig ctx (signRecMsg ctx keyOne highRMsg) + `shouldBe` (fromString (highRR ++ highRS), 0) + convertRecSig ctx (signRecMsg ctx keyOne highRMsg) `shouldNotBe` signMsgLowR ctx keyOne highRMsg + it "signs with the r and s of signMsg" $ \ctx -> + property $ \(m :: Msg, k :: SecKey) -> convertRecSig ctx (signRecMsg ctx k m) == signMsg ctx k m + it "is deterministic" $ \ctx -> + property $ \(m :: Msg, k :: SecKey) -> signRecMsg ctx k m == signRecMsg ctx k m + it "gives a recovery id of 0 or 1" $ \ctx -> + -- The ids 2 and 3 need r below p - n, about one signature in 2^128. + property $ \(m :: Msg, k :: SecKey) -> + snd (exportCompactRecSig ctx (signRecMsg ctx k m)) `elem` [0, 1] + it "produces lower-S signatures" $ \ctx -> + property $ \(m :: Msg, k :: SecKey) -> isLowS ctx (convertRecSig ctx (signRecMsg ctx k m)) + it "signs and recovers in parallel" $ \ctx -> + property $ \(xs :: [(Msg, SecKey)]) -> P.runPar $ do + results <- mapM (P.spawnP . signsAndRecovers ctx) xs + and <$> mapM P.get results + where + signsAndRecovers ctx (m, k) = + recover ctx (signRecMsg ctx k m) m == Just (derivePubKey ctx k) + +-- * Recovery + +recoverySpec :: SpecWith Ctx +recoverySpec = describe "recovery" $ do + it "recovers the key of Bitcoin Core's SignCompact vector" $ \ctx -> + recovered ctx (coreR ++ coreS ++ "01") coreMsg `shouldBe` Just corePub + it "recovers another key with the other recovery id" $ \ctx -> + recovered ctx (coreR ++ coreS ++ "00") coreMsg `shouldBe` Just coreOtherPub + it "recovers the signer of Bitcoin Core's 'Trust no one' message" $ \ctx -> + recovered ctx (messageR ++ messageS ++ "01") messageHash `shouldBe` Just messagePub + it "recovers G from the RFC 6979 vector" $ \ctx -> do + recovered ctx (satoshiR ++ satoshiS ++ "01") satoshiMsg `shouldBe` Just genCompressed + recovered ctx (satoshiR ++ satoshiS ++ "00") satoshiMsg `shouldBe` Just satoshiOtherPub + it "recovers the signing key" $ \ctx -> + property $ \(m :: Msg, k :: SecKey) -> + recover ctx (signRecMsg ctx k m) m == Just (derivePubKey ctx k) + it "recovers a different key for another message" $ \ctx -> + property $ \(m :: Msg, m' :: Msg, k :: SecKey) -> + m /= m' ==> recover ctx (signRecMsg ctx k m) m' /= Just (derivePubKey ctx k) + it "recovers the same key from the high-S form with the parity bit flipped" $ \ctx -> do + -- The RFC 6979 vector with s replaced by n - s and the id 1 turned into 0. + recovered ctx (satoshiR ++ satoshiHighS ++ "00") satoshiMsg `shouldBe` Just genCompressed + recovered ctx (satoshiR ++ satoshiHighS ++ "01") satoshiMsg `shouldNotBe` Just genCompressed + it "does not apply the lower-S rule" $ \ctx -> + property $ \(m :: Msg, k :: SecKey) -> + let (compact, i) = exportCompactRecSig ctx (signRecMsg ctx k m) + (r, s) = BS.splitAt 32 compact.get + -- n - s, through the negation of a tweak. + highS = (fromJust (tweakNegate ctx (fromJust (tweak s)))).get + high = fromJust (importCompactRecSig ctx (fromJust (compactSig (r <> highS))) (i `xor` 1)) + in recover ctx high m == Just (derivePubKey ctx k) + where + recovered ctx sigHex m = bytesToHex . exportPubKey ctx True <$> recover ctx (fromString sigHex) m + +-- * The formula + +formulaSpec :: SpecWith Ctx +formulaSpec = describe "the formula Q = r⁻¹(s·R − e·G)" $ do + it "gives R itself for r = 1, s = 1 and a zero hash" $ \ctx -> + recovered ctx (one ++ one ++ "00") zero `shouldBe` Just pointOne + it "takes the parity of y from the recovery id" $ \ctx -> + recovered ctx (one ++ one ++ "01") zero `shouldBe` Just ("03" ++ one) + it "reduces the hash modulo n" $ \ctx -> + recovered ctx (one ++ one ++ "00") order `shouldBe` Just pointOne + it "subtracts e·G" $ \ctx -> + recovered ctx (one ++ one ++ "00") one `shouldBe` Just pointOneMinusG + it "multiplies by s" $ \ctx -> do + recovered ctx (one ++ two ++ "00") zero `shouldBe` Just twicePointOne + recovered ctx (one ++ orderMinusOne ++ "00") zero `shouldBe` Just ("03" ++ one) + it "divides by r" $ \ctx -> + recovered ctx (two ++ one ++ "02") zero `shouldBe` Just halfPointOrderPlusTwo + it "uses r + n as the x coordinate for the ids 2 and 3" $ \ctx -> do + recovered ctx (two ++ two ++ "02") zero `shouldBe` Just ("02" ++ orderPlusTwo) + recovered ctx (two ++ two ++ "03") zero `shouldBe` Just ("03" ++ orderPlusTwo) + it "gives nothing when no point has the x coordinate" $ \ctx -> do + recovered ctx (five ++ one ++ "00") zero `shouldBe` Nothing + recovered ctx (one ++ one ++ "02") zero `shouldBe` Nothing + recovered ctx (fieldMinusOrderMinusOne ++ one ++ "02") zero `shouldBe` Nothing + it "gives nothing when r + n reaches the field size" $ \ctx -> + recovered ctx (fieldMinusOrder ++ one ++ "02") zero `shouldBe` Nothing + it "gives nothing when s·R − e·G is the point at infinity" $ \ctx -> do + -- R = G, s = 1 and e = 1: G - G. + recovered ctx (genX ++ one ++ "00") one `shouldBe` Nothing + -- With e = 2 instead: (G - 2G) / x = -(x⁻¹)·G. + recovered ctx (genX ++ one ++ "00") two `shouldBe` Just genNegatedOverX + where + recovered ctx sigHex msgHex = + bytesToHex . exportPubKey ctx True <$> recover ctx (fromString sigHex) (fromString msgHex) + +-- * Compact encoding + +compactSpec :: SpecWith Ctx +compactSpec = describe "compact encoding" $ do + it "imports and exports back the same signature" $ \ctx -> + property $ \(m :: Msg, k :: SecKey) -> + let s = signRecMsg ctx k m + (compact, i) = exportCompactRecSig ctx s + in importCompactRecSig ctx compact i == Just s + it "accepts the recovery ids 0 to 3 and rejects 4 and 255" $ \ctx -> do + forM_ [0 .. 3] $ \i -> importCompactRecSig ctx (fromString (one ++ one)) i `shouldSatisfy` isJust + importCompactRecSig ctx (fromString (one ++ one)) 4 `shouldBe` Nothing + importCompactRecSig ctx (fromString (one ++ one)) 255 `shouldBe` Nothing + it "accepts components of 1 and n - 1 and rejects 0 and n" $ \ctx -> do + importCompactRecSig ctx (fromString (one ++ one)) 0 `shouldSatisfy` isJust + importCompactRecSig ctx (fromString (orderMinusOne ++ orderMinusOne)) 0 `shouldSatisfy` isJust + importCompactRecSig ctx (fromString (order ++ one)) 0 `shouldBe` Nothing + importCompactRecSig ctx (fromString (one ++ order)) 0 `shouldBe` Nothing + importCompactRecSig ctx (fromString (zero ++ one)) 0 `shouldBe` Nothing + importCompactRecSig ctx (fromString (one ++ zero)) 0 `shouldBe` Nothing + it "imports a high-S signature" $ \ctx -> + importCompactRecSig ctx (fromString (satoshiR ++ satoshiHighS)) 0 `shouldSatisfy` isJust + it "converts to the signature without the id" $ \ctx -> do + bytesToHex (exportSig ctx (convertRecSig ctx (fromString (coreR ++ coreS ++ "01")))) `shouldBe` coreDer + convertRecSig ctx (fromString (coreR ++ coreS ++ "00")) + `shouldBe` convertRecSig ctx (fromString (coreR ++ coreS ++ "01")) + it "converts to a signature that verifies" $ \ctx -> + property $ \(m :: Msg, k :: SecKey) -> + verifySig ctx (derivePubKey ctx k) (convertRecSig ctx (signRecMsg ctx k m)) m + +-- * Signature values + +valueSpec :: SpecWith Ctx +valueSpec = describe "signature values" $ do + it "rebuild from their internal bytes" $ \ctx -> + property $ \(m :: Msg, k :: SecKey) -> let s = signRecMsg ctx k m in recSig s.get == Just s + it "reject internal bytes that are not a signature" $ \_ -> do + recSig (BS.replicate 65 0) `shouldBe` Nothing + recSig (BS.replicate 65 0xff) `shouldBe` Nothing + recSig (BS.replicate 64 1) `shouldBe` Nothing + recSig (BS.replicate 66 1) `shouldBe` Nothing + it "reject an internal recovery id above 3" $ \ctx -> do + -- libsecp256k1 keeps the id in the last byte of the representation. + let bytes = (signRecMsg ctx keyOne satoshiMsg).get + recSig (BS.init bytes `BS.snoc` 4) `shouldBe` Nothing + it "show r, s and the recovery id in hex" $ \ctx -> + show (signRecMsg ctx coreKey coreMsg) `shouldBe` quoted (coreR ++ coreS ++ "01") + it "read that encoding" $ \ctx -> do + read (quoted (coreR ++ coreS ++ "01")) `shouldBe` signRecMsg ctx coreKey coreMsg + (fromString (coreR ++ coreS ++ "01") :: RecSig) `shouldBe` signRecMsg ctx coreKey coreMsg + it "show and read" $ \ctx -> + property $ \(m :: Msg, k :: SecKey) -> showRead (signRecMsg ctx k m) + it "do not read an invalid signature" $ \_ -> do + (readMaybe (quoted (coreR ++ coreS)) :: Maybe RecSig) `shouldBe` Nothing + (readMaybe (quoted (coreR ++ coreS ++ "04")) :: Maybe RecSig) `shouldBe` Nothing + (readMaybe (quoted (zero ++ coreS ++ "01")) :: Maybe RecSig) `shouldBe` Nothing + (readMaybe (quoted (order ++ coreS ++ "01")) :: Maybe RecSig) `shouldBe` Nothing + (readMaybe (quoted (coreR ++ coreS ++ "0")) :: Maybe RecSig) `shouldBe` Nothing + evaluate (fromString (coreR ++ coreS) :: RecSig) `shouldThrow` anyErrorCall + +-- * Values built with the raw constructors of the Internal modules + +rawValueSpec :: SpecWith Ctx +rawValueSpec = describe "raw values from the Internal modules" $ do + it "a signature of 65 zero bytes recovers nothing, instead of aborting the process" $ \ctx -> + recover ctx (RecSig (BS.replicate 65 0)) satoshiMsg `shouldBe` Nothing + it "a zero secret key throws instead of signing" $ \ctx -> + evaluate (signRecMsg ctx (SecKey (BS.replicate 32 0)) satoshiMsg) `shouldThrow` anyErrorCall + it "values of the wrong length throw before reaching the library" $ \ctx -> do + evaluate (signRecMsg ctx (SecKey "a") satoshiMsg) `shouldThrow` anyErrorCall + evaluate (signRecMsg ctx keyOne (Msg "a")) `shouldThrow` anyErrorCall + evaluate (recover ctx (RecSig "a") satoshiMsg) `shouldThrow` anyErrorCall + evaluate (recover ctx (signRecMsg ctx keyOne satoshiMsg) (Msg "a")) `shouldThrow` anyErrorCall + evaluate (convertRecSig ctx (RecSig "a")) `shouldThrow` anyErrorCall + evaluate (exportCompactRecSig ctx (RecSig "a")) `shouldThrow` anyErrorCall + evaluate (importCompactRecSig ctx (CompactSig "a") 0) `shouldThrow` anyErrorCall + evaluate (length (show (RecSig "a"))) `shouldThrow` anyErrorCall + +-- * Derived instances + +instanceSpec :: SpecWith Ctx +instanceSpec = describe "derived instances" $ do + it "equal values hash equally, whichever way they were built" $ \ctx -> + property $ \(m :: Msg, k :: SecKey) -> + let s = signRecMsg ctx k m + (compact, i) = exportCompactRecSig ctx s + in hash s == hash (fromJust (importCompactRecSig ctx compact i)) + && hash s == hash (fromJust (recSig s.get)) + it "can be fully evaluated" $ \ctx -> + (signRecMsg ctx keyOne satoshiMsg `deepseq` ()) `shouldBe` () + +#else + +spec :: Spec +spec = + describe "public key recovery" $ + it "needs the recovery flag of the package" $ + pendingWith "the package was built with -f -recovery" + +#endif diff --git a/test/Crypto/Secp256k1Spec.hs b/test/Crypto/Secp256k1Spec.hs --- a/test/Crypto/Secp256k1Spec.hs +++ b/test/Crypto/Secp256k1Spec.hs @@ -1,248 +1,995 @@ -{-# LANGUAGE CPP #-} -module Crypto.Secp256k1Spec (spec) where - -import Control.Monad.Par -import qualified Control.Monad.Par as P -import Crypto.Secp256k1 -import qualified Data.ByteString as BS -import qualified Data.ByteString.Base16 as B16 -import qualified Data.ByteString.Char8 as B8 -import Data.Maybe (fromMaybe, isNothing) -import Data.String (fromString) -import Data.String.Conversions (cs) -import Test.Hspec -import Test.HUnit (Assertion, assertEqual) -import Test.QuickCheck - -spec :: Spec -spec = do - describe "signatures" $ do - it "signs message" $ - property signMsgTest - it "signs messages in parallel" $ - property signMsgParTest - it "detects bad signature" $ - property badSignatureTest - it "normalizes signatures" $ - property normalizeSigTest - describe "serialization" $ do - it "serializes public key" $ - property serializePubKeyTest - it "serializes public keys in parallel" $ - property parSerializePubKeyTest - it "serializes DER signature" $ - property serializeSigTest - it "serializes DER signatures in parallel" $ - property parSerializeSigTest - it "serializes compact signature" $ - property serializeCompactSigTest - it "serialize secret key" $ - property serializeSecKeyTest - it "shows and reads public key" $ - property (showRead :: PubKey -> Bool) - it "shows and reads secret key" $ - property (showRead :: SecKey -> Bool) - it "shows and reads tweak" $ - property (showReadTweak :: SecKey -> Bool) - it "shows and reads signature" $ - property (showReadSig :: (SecKey, Msg) -> Bool) - it "shows and reads message" $ - property (showRead :: Msg -> Bool) - it "reads public key from string" $ - property isStringPubKey - it "reads secret key from string" $ - property isStringSecKey - it "reads signature from string" $ - property isStringSig - it "reads message from string" $ - property isStringMsg - it "reads tweak from string" $ - property isStringTweak - describe "tweaks" $ do - it "add secret key" $ property tweakAddSecKeyTest - it "multiply secret key" $ property tweakMulSecKeyTest - it "add public key" $ property tweakAddPubKeyTest - it "multiply public key" $ property tweakMulPubKeyTest - it "combine public keys" $ property combinePubKeyTest - it "can't combine 0 public keys" $ property combinePubKeyEmptyListTest - it "negates tweak" $ property negateTweakTest - -hexToBytes :: String -> BS.ByteString -hexToBytes = fst . B16.decode . B8.pack - -isStringPubKey :: (PubKey, Bool) -> Bool -isStringPubKey (k, c) = k == fromString (cs hex) where - hex = B16.encode $ exportPubKey c k - -isStringSig :: (SecKey, Msg) -> Bool -isStringSig (k, m) = g == fromString (cs hex) where - g = signMsg k m - hex = B16.encode $ exportSig g - -isStringMsg :: Msg -> Bool -isStringMsg m = m == fromString (cs m') where - m' = B16.encode $ getMsg m - -isStringSecKey :: SecKey -> Bool -isStringSecKey k = k == fromString (cs hex) where - hex = B16.encode $ getSecKey k - -isStringTweak :: SecKey -> Bool -isStringTweak k = t == fromString (cs hex) where - t = fromMaybe e . tweak $ getSecKey k - hex = B16.encode $ getTweak t - e = error "Could not extract tweak from secret key" - -showReadTweak :: SecKey -> Bool -showReadTweak k = showRead t where - t = tweak $ getSecKey k - -showReadSig :: (SecKey, Msg) -> Bool -showReadSig (k, m) = showRead sig where - sig = signMsg k m - -showRead :: (Show a, Read a, Eq a) => a -> Bool -showRead x = read (show x) == x - -signMsgTest :: (Msg, SecKey) -> Bool -signMsgTest (fm, fk) = verifySig fp fg fm where - fp = derivePubKey fk - fg = signMsg fk fm - -signMsgParTest :: [(Msg, SecKey)] -> Bool -signMsgParTest xs = P.runPar $ do - ys <- mapM (P.spawnP . signMsgTest) xs - and <$> mapM P.get ys - -badSignatureTest :: (Msg, SecKey, PubKey) -> Bool -badSignatureTest (fm, fk, fp) = not $ verifySig fp fg fm where - fg = signMsg fk fm - -normalizeSigTest :: (Msg, SecKey) -> Bool -normalizeSigTest (fm, fk) = isNothing sig where - fg = signMsg fk fm - sig = normalizeSig fg - -serializePubKeyTest :: (PubKey, Bool) -> Bool -serializePubKeyTest (fp, b) = - case importPubKey $ exportPubKey b fp of - Just fp' -> fp == fp' - Nothing -> False - -parSerializePubKeyTest :: [(PubKey, Bool)] -> Bool -parSerializePubKeyTest ps = runPar $ do - as <- mapM (spawnP . serializePubKeyTest) ps - and <$> mapM get as - -serializeSigTest :: (Msg, SecKey) -> Bool -serializeSigTest (fm, fk) = - case importSig $ exportSig fg of - Just fg' -> fg == fg' - Nothing -> False - where - fg = signMsg fk fm - -parSerializeSigTest :: [(Msg, SecKey)] -> Bool -parSerializeSigTest ms = runPar $ do - as <- mapM (spawnP . serializeSigTest) ms - and <$> mapM get as - -serializeCompactSigTest :: (Msg, SecKey) -> Bool -serializeCompactSigTest (fm, fk) = - case importCompactSig $ exportCompactSig fg of - Just fg' -> fg == fg' - Nothing -> False - where - fg = signMsg fk fm - -serializeSecKeyTest :: SecKey -> Bool -serializeSecKeyTest fk = - case secKey $ getSecKey fk of - Just fk' -> fk == fk' - Nothing -> False - -tweakAddSecKeyTest :: Assertion -tweakAddSecKeyTest = - assertEqual "tweaked keys match" expected tweaked - where - tweaked = do - key <- secKey $ hexToBytes - "f65255094d7773ed8dd417badc9fc045c1f80fdc5b2d25172b031ce6933e039a" - twk <- tweak $ hexToBytes - "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00" - tweakAddSecKey key twk - expected = secKey $ hexToBytes - "ec1e3ce1cefa18a671d51125e2b249688d934b0e28f5d1665384d9b02f929059" - -tweakMulSecKeyTest :: Assertion -tweakMulSecKeyTest = - assertEqual "tweaked keys match" expected tweaked - where - tweaked = do - key <- secKey $ hexToBytes - "f65255094d7773ed8dd417badc9fc045c1f80fdc5b2d25172b031ce6933e039a" - twk <- tweak $ hexToBytes - "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00" - tweakMulSecKey key twk - expected = secKey $ hexToBytes - "a96f5962493acb179f60a86a9785fc7a30e0c39b64c09d24fe064d9aef15e4c0" - -tweakAddPubKeyTest :: Assertion -tweakAddPubKeyTest = - assertEqual "tweaked keys match" expected tweaked - where - tweaked = do - pub <- importPubKey $ hexToBytes - "04dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd4470512213d5ed790522c042dee8e85c4c0ec5f96800b72bc5940c8bc1c5e11e4fcbf" - twk <- tweak $ hexToBytes - "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00" - tweakAddPubKey pub twk - expected = importPubKey $ hexToBytes - "04441c3982b97576646e0df0c96736063df6b42f2ee566d13b9f6424302d1379e518fdc87a14c5435bff7a5db4552042cb4120c6b86a4bbd3d0643f3c14ad01368" - -tweakMulPubKeyTest :: Assertion -tweakMulPubKeyTest = - assertEqual "tweaked keys match" expected tweaked - where - tweaked = do - pub <- importPubKey $ hexToBytes - "04dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd4470512213d5ed790522c042dee8e85c4c0ec5f96800b72bc5940c8bc1c5e11e4fcbf" - twk <- tweak $ hexToBytes - "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00" - tweakMulPubKey pub twk - expected = importPubKey $ hexToBytes - "04f379dc99cdf5c83e433defa267fbb3377d61d6b779c06a0e4ce29ae3ff5353b12ae49c9d07e7368f2ba5a446c203255ce912322991a2d6a9d5d5761c61ed1845" - -combinePubKeyTest :: Assertion -combinePubKeyTest = - assertEqual "combined keys match" expected combined - where - combined = do - pub1 <- importPubKey $ hexToBytes - "04dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd4470512213d5ed790522c042dee8e85c4c0ec5f96800b72bc5940c8bc1c5e11e4fcbf" - pub2 <- importPubKey $ hexToBytes - "0487d82042d93447008dfe2af762068a1e53ff394a5bf8f68a045fa642b99ea5d153f577dd2dba6c7ae4cfd7b6622409d7edd2d76dd13a8092cd3af97b77bd2c77" - pub3 <- importPubKey $ hexToBytes - "049b101edcbe1ee37ff6b2318526a425b629e823d7d8d9154417880595a28000ee3febd908754b8ce4e491aa6fe488b41fb5d4bb3788e33c9ff95a7a9229166d59" - combinePubKeys [pub1, pub2, pub3] - expected = importPubKey $ hexToBytes - "043d9a7ec70011efc23c33a7e62d2ea73cca87797e3b659d93bea6aa871aebde56c3bc6134ca82e324b0ab9c0e601a6d2933afe7fb5d9f3aae900f5c5dc6e362c8" - -combinePubKeyEmptyListTest :: Assertion -combinePubKeyEmptyListTest = - assertEqual "empty pubkey list must return Nothing" expected combined - where - expected = Nothing - combined = combinePubKeys [] - -negateTweakTest :: Assertion -negateTweakTest = - assertEqual "can recover secret key 1 after adding tweak 1" oneKey subtracted - where - Just oneKey = secKey $ fst $ B16.decode $ B8.pack - "0000000000000000000000000000000000000000000000000000000000000001" - Just oneTwk = tweak $ fst $ B16.decode $ B8.pack - "0000000000000000000000000000000000000000000000000000000000000001" - Just minusOneTwk = tweakNegate oneTwk - Just twoKey = tweakAddSecKey oneKey oneTwk - Just subtracted = tweakAddSecKey twoKey minusOneTwk +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Crypto.Secp256k1Spec (spec) where + +import Control.DeepSeq (deepseq) +import Control.Exception (evaluate) +import Control.Monad.Par qualified as P +import Data.Bits (xor) +import Crypto.Secp256k1 +import Crypto.Secp256k1.Fixtures +import Crypto.Secp256k1.Internal.Base + ( CompactSig (CompactSig), + Msg (Msg), + PubKey (PubKey), + SchnorrSig (SchnorrSig), + SecKey (SecKey), + Sig (Sig), + Tweak (Tweak), + signMsgWith, + ) +import Data.ByteString qualified as BS +import Data.Hashable (hash) +import Data.Maybe (fromJust, isJust, isNothing) +import Data.String (fromString) +import Test.Hspec +import Test.QuickCheck +import Text.Read (readMaybe) + +spec :: Spec +spec = around withContext $ do + secretKeySpec + publicKeySpec + messageSpec + signingSpec + verificationSpec + derSpec + compactSpec + tweakSpec + combineSpec + schnorrSpec + xOnlySpec + taprootSpec + contextSpec + rawValueSpec + instanceSpec + +-- BIP-340 vector 0: secret key 3 signing 32 zero bytes with 32 zero bytes of +-- auxiliary randomness. +bip340Key0 :: SecKey +bip340Key0 = "0000000000000000000000000000000000000000000000000000000000000003" + +bip340Pub0, bip340Sig0 :: String +bip340Pub0 = "f9308a019258c31049344f85f89d5229b531c845836f99b08601f113bce036f9" +bip340Sig0 = + "e907831f80848d1069a5371b402410364bdf1c5f8307b0084c55f1ce2dca8215\ + \25f66a4a85ea8b71e482a74f382d2ce5ebeee8fdb2172f477df4900d310536c0" + +-- A BIP-340 test vector from +-- https://github.com/bitcoin/bips/blob/master/bip-0340/test-vectors.csv. +-- Vectors 15 to 18 sign messages that are not 32 bytes long, which 'Msg' +-- does not hold, so they are left out. +data BIP340Vector = BIP340Vector + { index :: Int, + comment :: String, + secretKey :: Maybe String, + publicKey :: String, + auxRand :: Maybe String, + message :: String, + signature :: String, + result :: Bool + } + +bip340Vectors :: [BIP340Vector] +bip340Vectors = + [ BIP340Vector + { index = 0, + comment = "", + secretKey = Just "0000000000000000000000000000000000000000000000000000000000000003", + publicKey = "f9308a019258c31049344f85f89d5229b531c845836f99b08601f113bce036f9", + auxRand = Just "0000000000000000000000000000000000000000000000000000000000000000", + message = "0000000000000000000000000000000000000000000000000000000000000000", + signature = "e907831f80848d1069a5371b402410364bdf1c5f8307b0084c55f1ce2dca821525f66a4a85ea8b71e482a74f382d2ce5ebeee8fdb2172f477df4900d310536c0", + result = True + }, + BIP340Vector + { index = 1, + comment = "", + secretKey = Just "b7e151628aed2a6abf7158809cf4f3c762e7160f38b4da56a784d9045190cfef", + publicKey = "dff1d77f2a671c5f36183726db2341be58feae1da2deced843240f7b502ba659", + auxRand = Just "0000000000000000000000000000000000000000000000000000000000000001", + message = "243f6a8885a308d313198a2e03707344a4093822299f31d0082efa98ec4e6c89", + signature = "6896bd60eeae296db48a229ff71dfe071bde413e6d43f917dc8dcf8c78de33418906d11ac976abccb20b091292bff4ea897efcb639ea871cfa95f6de339e4b0a", + result = True + }, + BIP340Vector + { index = 2, + comment = "", + secretKey = Just "c90fdaa22168c234c4c6628b80dc1cd129024e088a67cc74020bbea63b14e5c9", + publicKey = "dd308afec5777e13121fa72b9cc1b7cc0139715309b086c960e18fd969774eb8", + auxRand = Just "c87aa53824b4d7ae2eb035a2b5bbbccc080e76cdc6d1692c4b0b62d798e6d906", + message = "7e2d58d8b3bcdf1abadec7829054f90dda9805aab56c77333024b9d0a508b75c", + signature = "5831aaeed7b44bb74e5eab94ba9d4294c49bcf2a60728d8b4c200f50dd313c1bab745879a5ad954a72c45a91c3a51d3c7adea98d82f8481e0e1e03674a6f3fb7", + result = True + }, + BIP340Vector + { index = 3, + comment = "test fails if msg is reduced modulo p or n", + secretKey = Just "0b432b2677937381aef05bb02a66ecd012773062cf3fa2549e44f58ed2401710", + publicKey = "25d1dff95105f5253c4022f628a996ad3a0d95fbf21d468a1b33f8c160d8f517", + auxRand = Just "ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff", + message = "ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff", + signature = "7eb0509757e246f19449885651611cb965ecc1a187dd51b64fda1edc9637d5ec97582b9cb13db3933705b32ba982af5af25fd78881ebb32771fc5922efc66ea3", + result = True + }, + BIP340Vector + { index = 4, + comment = "", + secretKey = Nothing, + publicKey = "d69c3509bb99e412e68b0fe8544e72837dfa30746d8be2aa65975f29d22dc7b9", + auxRand = Nothing, + message = "4df3c3f68fcc83b27e9d42c90431a72499f17875c81a599b566c9889b9696703", + signature = "00000000000000000000003b78ce563f89a0ed9414f5aa28ad0d96d6795f9c6376afb1548af603b3eb45c9f8207dee1060cb71c04e80f593060b07d28308d7f4", + result = True + }, + BIP340Vector + { index = 5, + comment = "public key not on the curve", + secretKey = Nothing, + publicKey = "eefdea4cdb677750a420fee807eacf21eb9898ae79b9768766e4faa04a2d4a34", + auxRand = Nothing, + message = "243f6a8885a308d313198a2e03707344a4093822299f31d0082efa98ec4e6c89", + signature = "6cff5c3ba86c69ea4b7376f31a9bcb4f74c1976089b2d9963da2e5543e17776969e89b4c5564d00349106b8497785dd7d1d713a8ae82b32fa79d5f7fc407d39b", + result = False + }, + BIP340Vector + { index = 6, + comment = "has_even_y(R) is false", + secretKey = Nothing, + publicKey = "dff1d77f2a671c5f36183726db2341be58feae1da2deced843240f7b502ba659", + auxRand = Nothing, + message = "243f6a8885a308d313198a2e03707344a4093822299f31d0082efa98ec4e6c89", + signature = "fff97bd5755eeea420453a14355235d382f6472f8568a18b2f057a14602975563cc27944640ac607cd107ae10923d9ef7a73c643e166be5ebeafa34b1ac553e2", + result = False + }, + BIP340Vector + { index = 7, + comment = "negated message", + secretKey = Nothing, + publicKey = "dff1d77f2a671c5f36183726db2341be58feae1da2deced843240f7b502ba659", + auxRand = Nothing, + message = "243f6a8885a308d313198a2e03707344a4093822299f31d0082efa98ec4e6c89", + signature = "1fa62e331edbc21c394792d2ab1100a7b432b013df3f6ff4f99fcb33e0e1515f28890b3edb6e7189b630448b515ce4f8622a954cfe545735aaea5134fccdb2bd", + result = False + }, + BIP340Vector + { index = 8, + comment = "negated s value", + secretKey = Nothing, + publicKey = "dff1d77f2a671c5f36183726db2341be58feae1da2deced843240f7b502ba659", + auxRand = Nothing, + message = "243f6a8885a308d313198a2e03707344a4093822299f31d0082efa98ec4e6c89", + signature = "6cff5c3ba86c69ea4b7376f31a9bcb4f74c1976089b2d9963da2e5543e177769961764b3aa9b2ffcb6ef947b6887a226e8d7c93e00c5ed0c1834ff0d0c2e6da6", + result = False + }, + BIP340Vector + { index = 9, + comment = "sG - eP is infinite", + secretKey = Nothing, + publicKey = "dff1d77f2a671c5f36183726db2341be58feae1da2deced843240f7b502ba659", + auxRand = Nothing, + message = "243f6a8885a308d313198a2e03707344a4093822299f31d0082efa98ec4e6c89", + signature = "0000000000000000000000000000000000000000000000000000000000000000123dda8328af9c23a94c1feecfd123ba4fb73476f0d594dcb65c6425bd186051", + result = False + }, + BIP340Vector + { index = 10, + comment = "sG - eP is infinite", + secretKey = Nothing, + publicKey = "dff1d77f2a671c5f36183726db2341be58feae1da2deced843240f7b502ba659", + auxRand = Nothing, + message = "243f6a8885a308d313198a2e03707344a4093822299f31d0082efa98ec4e6c89", + signature = "00000000000000000000000000000000000000000000000000000000000000017615fbaf5ae28864013c099742deadb4dba87f11ac6754f93780d5a1837cf197", + result = False + }, + BIP340Vector + { index = 11, + comment = "sig[0:32] is not an X coordinate on the curve", + secretKey = Nothing, + publicKey = "dff1d77f2a671c5f36183726db2341be58feae1da2deced843240f7b502ba659", + auxRand = Nothing, + message = "243f6a8885a308d313198a2e03707344a4093822299f31d0082efa98ec4e6c89", + signature = "4a298dacae57395a15d0795ddbfd1dcb564da82b0f269bc70a74f8220429ba1d69e89b4c5564d00349106b8497785dd7d1d713a8ae82b32fa79d5f7fc407d39b", + result = False + }, + BIP340Vector + { index = 12, + comment = "sig[0:32] is equal to field size", + secretKey = Nothing, + publicKey = "dff1d77f2a671c5f36183726db2341be58feae1da2deced843240f7b502ba659", + auxRand = Nothing, + message = "243f6a8885a308d313198a2e03707344a4093822299f31d0082efa98ec4e6c89", + signature = "fffffffffffffffffffffffffffffffffffffffffffffffffffffffefffffc2f69e89b4c5564d00349106b8497785dd7d1d713a8ae82b32fa79d5f7fc407d39b", + result = False + }, + BIP340Vector + { index = 13, + comment = "sig[32:64] is equal to curve order", + secretKey = Nothing, + publicKey = "dff1d77f2a671c5f36183726db2341be58feae1da2deced843240f7b502ba659", + auxRand = Nothing, + message = "243f6a8885a308d313198a2e03707344a4093822299f31d0082efa98ec4e6c89", + signature = "6cff5c3ba86c69ea4b7376f31a9bcb4f74c1976089b2d9963da2e5543e177769fffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364141", + result = False + }, + BIP340Vector + { index = 14, + comment = "public key is not a valid X coordinate because it exceeds the field size", + secretKey = Nothing, + publicKey = "fffffffffffffffffffffffffffffffffffffffffffffffffffffffefffffc30", + auxRand = Nothing, + message = "243f6a8885a308d313198a2e03707344a4093822299f31d0082efa98ec4e6c89", + signature = "6cff5c3ba86c69ea4b7376f31a9bcb4f74c1976089b2d9963da2e5543e17776969e89b4c5564d00349106b8497785dd7d1d713a8ae82b32fa79d5f7fc407d39b", + result = False + } + ] + +-- A BIP-341 key path spending vector from +-- https://github.com/bitcoin/bips/blob/master/bip-0341/wallet-test-vectors.json: +-- the internal secret key, its x-only public key, the tweak, the tweaked +-- secret key, the output key (from the spent scriptPubKey), the signature +-- hash, and the signature without its hash type byte. The signatures were +-- made without auxiliary randomness. +data BIP341Vector = BIP341Vector + { internalKey :: String, + internalPub :: String, + tapTweak :: String, + tweakedKey :: String, + outputKey :: String, + sigHash :: String, + keyPathSig :: String + } + +bip341Vectors :: [BIP341Vector] +bip341Vectors = + [ BIP341Vector + { internalKey = "6b973d88838f27366ed61c9ad6367663045cb456e28335c109e30717ae0c6baa", + internalPub = "d6889cb081036e0faefa3a35157ad71086b123b2b144b649798b494c300a961d", + tapTweak = "b86e7be8f39bab32a6f2c0443abbc210f0edac0e2c53d501b36b64437d9c6c70", + tweakedKey = "2405b971772ad26915c8dcdf10f238753a9b837e5f8e6a86fd7c0cce5b7296d9", + outputKey = "53a1f6e454df1aa2776a2814a721372d6258050de330b3c6d10ee8f4e0dda343", + sigHash = "2514a6272f85cfa0f45eb907fcb0d121b808ed37c6ea160a5a9046ed5526d555", + keyPathSig = "ed7c1647cb97379e76892be0cacff57ec4a7102aa24296ca39af7541246d8ff14d38958d4cc1e2e478e4d4a764bbfd835b16d4e314b72937b29833060b87276c" + }, + BIP341Vector + { internalKey = "1e4da49f6aaf4e5cd175fe08a32bb5cb4863d963921255f33d3bc31e1343907f", + internalPub = "187791b6f712a8ea41c8ecdd0ee77fab3e85263b37e1ec18a3651926b3a6cf27", + tapTweak = "cbd8679ba636c1110ea247542cfbd964131a6be84f873f7f3b62a777528ed001", + tweakedKey = "ea260c3b10e60f6de018455cd0278f2f5b7e454be1999572789e6a9565d26080", + outputKey = "147c9c57132f6e7ecddba9800bb0c4449251c92a1e60371ee77557b6620f3ea3", + sigHash = "325a644af47e8a5a2591cda0ab0723978537318f10e6a63d4eed783b96a71a4d", + keyPathSig = "052aedffc554b41f52b521071793a6b88d6dbca9dba94cf34c83696de0c1ec35ca9c5ed4ab28059bd606a4f3a657eec0bb96661d42921b5f50a95ad33675b54f" + }, + BIP341Vector + { internalKey = "d3c7af07da2d54f7a7735d3d0fc4f0a73164db638b2f2f7c43f711f6d4aa7e64", + internalPub = "93478e9488f956df2396be2ce6c5cced75f900dfa18e7dabd2428aae78451820", + tapTweak = "6af9e28dbf9d6aaf027696e2598a5b3d056f5fd2355a7fd5a37a0e5008132d30", + tweakedKey = "97323385e57015b75b0339a549c56a948eb961555973f0951f555ae6039ef00d", + outputKey = "e4d810fd50586274face62b8a807eb9719cef49c04177cc6b76a9a4251d5450e", + sigHash = "bf013ea93474aa67815b1b6cc441d23b64fa310911d991e713cd34c7f5d46669", + keyPathSig = "ff45f742a876139946a149ab4d9185574b98dc919d2eb6754f8abaa59d18b025637a3aa043b91817739554f4ed2026cf8022dbd83e351ce1fabc272841d2510a" + }, + BIP341Vector + { internalKey = "f36bb07a11e469ce941d16b63b11b9b9120a84d9d87cff2c84a8d4affb438f4e", + internalPub = "e0dfe2300b0dd746a3f8674dfd4525623639042569d829c7f0eed9602d263e6f", + tapTweak = "b57bfa183d28eeb6ad688ddaabb265b4a41fbf68e5fed2c72c74de70d5a786f4", + tweakedKey = "a8e7aa924f0d58854185a490e6c41f6efb7b675c0f3331b7f14b549400b4d501", + outputKey = "91b64d5324723a985170e4dc5a0f84c041804f2cd12660fa5dec09fc21783605", + sigHash = "4f900a0bae3f1446fd48490c2958b5a023228f01661cda3496a11da502a7f7ef", + keyPathSig = "b4010dd48a617db09926f729e79c33ae0b4e94b79f04a1ae93ede6315eb3669de185a17d2b0ac9ee09fd4c64b678a0b61a0a86fa888a273c8511be83bfd6810f" + }, + BIP341Vector + { internalKey = "415cfe9c15d9cea27d8104d5517c06e9de48e2f986b695e4f5ffebf230e725d8", + internalPub = "55adf4e8967fbd2e29f20ac896e60c3b0f1d5b0efa9d34941b5958c7b0a0312d", + tapTweak = "6579138e7976dc13b6a92f7bfd5a2fc7684f5ea42419d43368301470f3b74ed9", + tweakedKey = "241c14f2639d0d7139282aa6abde28dd8a067baa9d633e4e7230287ec2d02901", + outputKey = "75169f4001aa68f15bbed28b218df1d0a62cbbcf1188c6665110c293c907b831", + sigHash = "15f25c298eb5cdc7eb1d638dd2d45c97c4c59dcaec6679cfc16ad84f30876b85", + keyPathSig = "a3785919a2ce3c4ce26f298c3d51619bc474ae24014bcdd31328cd8cfbab2eff3395fa0a16fe5f486d12f22a9cedded5ae74feb4bbe5351346508c5405bcfee0" + }, + BIP341Vector + { internalKey = "c7b0e81f0a9a0b0499e112279d718cca98e79a12e2f137c72ae5b213aad0d103", + internalPub = "ee4fe085983462a184015d1f782d6a5f8b9c2b60130aff050ce221ecf3786592", + tapTweak = "9e0517edc8259bb3359255400b23ca9507f2a91cd1e4250ba068b4eafceba4a9", + tweakedKey = "65b6000cd2bfa6b7cf736767a8955760e62b6649058cbc970b7c0871d786346b", + outputKey = "712447206d7a5238acc7ff53fbe94a3b64539ad291c7cdbc490b7577e4b17df5", + sigHash = "cd292de50313804dabe4685e83f923d2969577191a3e1d2882220dca88cbeb10", + keyPathSig = "ea0c6ba90763c2d3a296ad82ba45881abb4f426b3f87af162dd24d5109edc1cdd11915095ba47c3a9963dc1e6c432939872bc49212fe34c632cd3ab9fed429c4" + }, + BIP341Vector + { internalKey = "77863416be0d0665e517e1c375fd6f75839544eca553675ef7fdf4949518ebaa", + internalPub = "f9f400803e683727b14f463836e1e78e1c64417638aa066919291a225f0e8dd8", + tapTweak = "639f0281b7ac49e742cd25b7f188657626da1ad169209078e2761cefd91fd65e", + tweakedKey = "ec18ce6af99f43815db543f47b8af5ff5df3b2cb7315c955aa4a86e8143d2bf5", + outputKey = "77e30a5522dd9f894c3f8b8bd4c4b2cf82ca7da8a3ea6a239655c39c050ab220", + sigHash = "cccb739eca6c13a8a89e6e5cd317ffe55669bbda23f2fd37b0f18755e008edd2", + keyPathSig = "bbc9584a11074e83bc8c6759ec55401f0ae7b03ef290c3139814f545b58a9f8127258000874f44bc46db7646322107d4d86aec8e73b8719a61fff761d75b5dd9" + } + ] + +-- * Secret keys + +secretKeySpec :: SpecWith Ctx +secretKeySpec = describe "secret keys" $ do + it "accepts 1 and n - 1" $ \_ -> do + secKey (hexToBytes one) `shouldSatisfy` isJust + secKey (hexToBytes orderMinusOne) `shouldSatisfy` isJust + it "rejects 0, n, n + 1 and 2^256 - 1" $ \_ -> do + secKey (hexToBytes zero) `shouldBe` Nothing + secKey (hexToBytes order) `shouldBe` Nothing + secKey (hexToBytes orderPlusOne) `shouldBe` Nothing + secKey (hexToBytes allOnes) `shouldBe` Nothing + it "rejects 31 and 33 bytes" $ \_ -> do + secKey (BS.replicate 31 1) `shouldBe` Nothing + secKey (BS.replicate 33 1) `shouldBe` Nothing + it "keeps the bytes it was given" $ \_ -> + property $ \(k :: SecKey) -> secKey k.get == Just k + it "derives the generator from key 1" $ \ctx -> do + bytesToHex (exportPubKey ctx True (derivePubKey ctx keyOne)) + `shouldBe` genCompressed + bytesToHex (exportPubKey ctx False (derivePubKey ctx keyOne)) + `shouldBe` genUncompressed + it "derives the negated generator from key n - 1" $ \ctx -> + -- -G has the same x as G and an odd y, so the prefix is 03. + bytesToHex (exportPubKey ctx True (derivePubKey ctx (fromString orderMinusOne))) + `shouldBe` "0379be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798" + it "derives the historical public key" $ \ctx -> + bytesToHex (exportPubKey ctx False (derivePubKey ctx histKey)) `shouldBe` histPub + it "shows the key in hex" $ \_ -> + show keyOne `shouldBe` quoted one + it "shows and reads" $ \_ -> + property (showRead :: SecKey -> Bool) + it "reads from a string" $ \_ -> + property $ \(k :: SecKey) -> fromString (bytesToHex k.get) == k + it "does not read an invalid key" $ \_ -> do + (readMaybe (quoted zero) :: Maybe SecKey) `shouldBe` Nothing + (readMaybe (quoted order) :: Maybe SecKey) `shouldBe` Nothing + (readMaybe (quoted (drop 1 one)) :: Maybe SecKey) `shouldBe` Nothing + (readMaybe (quoted ("zz" ++ drop 2 one)) :: Maybe SecKey) `shouldBe` Nothing + evaluate (fromString order :: SecKey) `shouldThrow` anyErrorCall + +-- * Public keys + +publicKeySpec :: SpecWith Ctx +publicKeySpec = describe "public keys" $ do + it "imports the compressed, uncompressed and hybrid encodings of G" $ \ctx -> do + let g = derivePubKey ctx keyOne + importPubKey ctx (hexToBytes genCompressed) `shouldBe` Just g + importPubKey ctx (hexToBytes genUncompressed) `shouldBe` Just g + importPubKey ctx (hexToBytes genHybrid) `shouldBe` Just g + it "rejects malformed encodings" $ \ctx -> do + importPubKey ctx "" `shouldBe` Nothing + -- prefix 05 does not exist + importPubKey ctx (hexToBytes ("05" ++ drop 2 genCompressed)) `shouldBe` Nothing + -- x only, no prefix + importPubKey ctx (hexToBytes (drop 2 genCompressed)) `shouldBe` Nothing + -- x and y without a prefix + importPubKey ctx (hexToBytes (drop 2 genUncompressed)) `shouldBe` Nothing + -- uncompressed prefix on a compressed length + importPubKey ctx (hexToBytes ("04" ++ drop 2 genCompressed)) `shouldBe` Nothing + -- compressed prefix on an uncompressed length + importPubKey ctx (hexToBytes ("02" ++ drop 2 genUncompressed)) `shouldBe` Nothing + it "rejects points that are not on the curve" $ \ctx -> do + -- x = 5 has no point on secp256k1 (x^3 + 7 is not a square mod p). + importPubKey ctx (hexToBytes ("02" ++ take 62 zero ++ "05")) `shouldBe` Nothing + -- (1, 1) is not on the curve: 1 /= 1 + 7. + importPubKey ctx (hexToBytes ("04" ++ take 62 zero ++ "01" ++ take 62 zero ++ "01")) + `shouldBe` Nothing + it "exports and imports back the same key" $ \ctx -> + property $ \(k :: SecKey, compress :: Bool) -> + let p = derivePubKey ctx k + in importPubKey ctx (exportPubKey ctx compress p) == Just p + it "exports and imports in parallel" $ \ctx -> + property $ \(ks :: [(SecKey, Bool)]) -> P.runPar $ do + results <- mapM (P.spawnP . roundTrip ctx) ks + and <$> mapM P.get results + it "rebuilds a key from its internal bytes" $ \ctx -> + property $ \(k :: SecKey) -> let p = derivePubKey ctx k in pubKey p.get == Just p + it "rejects internal bytes that are not a point" $ \_ -> do + pubKey (BS.replicate 64 0) `shouldBe` Nothing + pubKey (BS.replicate 64 1) `shouldBe` Nothing + pubKey (BS.replicate 64 0xff) `shouldBe` Nothing + pubKey (BS.pack [1 .. 64]) `shouldBe` Nothing + pubKey (BS.replicate 63 1) `shouldBe` Nothing + it "shows the compressed encoding" $ \ctx -> + show (derivePubKey ctx keyOne) `shouldBe` quoted genCompressed + it "reads any encoding" $ \ctx -> do + let g = derivePubKey ctx keyOne + read (quoted genCompressed) `shouldBe` g + read (quoted genUncompressed) `shouldBe` g + read (quoted genHybrid) `shouldBe` g + (fromString genUncompressed :: PubKey) `shouldBe` g + it "shows and reads" $ \ctx -> + property $ \(k :: SecKey) -> showRead (derivePubKey ctx k) + it "does not read an invalid key" $ \_ -> do + (readMaybe (quoted (zero ++ zero)) :: Maybe PubKey) `shouldBe` Nothing + (readMaybe (quoted ("02" ++ take 62 zero ++ "05")) :: Maybe PubKey) `shouldBe` Nothing + (readMaybe (quoted (drop 2 genCompressed)) :: Maybe PubKey) `shouldBe` Nothing + evaluate (fromString (drop 2 genCompressed) :: PubKey) `shouldThrow` anyErrorCall + where + roundTrip ctx (k, compress) = + let p = derivePubKey ctx k + in importPubKey ctx (exportPubKey ctx compress p) == Just p + +-- * Messages + +messageSpec :: SpecWith Ctx +messageSpec = describe "messages" $ do + it "accepts 32 bytes and rejects other lengths" $ \_ -> do + msg (BS.replicate 32 7) `shouldSatisfy` isJust + msg (BS.replicate 31 7) `shouldBe` Nothing + msg (BS.replicate 33 7) `shouldBe` Nothing + msg "" `shouldBe` Nothing + it "shows and reads" $ \_ -> + property (showRead :: Msg -> Bool) + it "reads from a string, upper or lower case" $ \_ -> + property $ \(m :: Msg) -> + fromString (bytesToHex m.get) == m + && fromString (map toUpperHex (bytesToHex m.get)) == m + it "does not read an invalid message" $ \_ -> do + (readMaybe (quoted (drop 1 one)) :: Maybe Msg) `shouldBe` Nothing + -- A non-ASCII character is not a hex digit even when its low byte is one + -- (U+FF41, fullwidth 'a'). + (readMaybe (quoted (take 63 allOnes ++ "\xFF41")) :: Maybe Msg) `shouldBe` Nothing + evaluate (fromString (take 63 allOnes ++ "\xFF41") :: Msg) `shouldThrow` anyErrorCall + where + toUpperHex c = if c >= 'a' && c <= 'f' then toEnum (fromEnum c - 32) else c + +-- * Signing + +signingSpec :: SpecWith Ctx +signingSpec = describe "signing" $ do + it "produces the RFC 6979 vector for key 1 and sha256 'Satoshi Nakamoto'" $ \ctx -> do + bytesToHex (exportSig ctx (signMsg ctx keyOne satoshiMsg)) `shouldBe` satoshiDer + bytesToHex (exportCompactSig ctx (signMsg ctx keyOne satoshiMsg)).get + `shouldBe` satoshiR ++ satoshiS + it "produces Bitcoin Core's deterministic signature" $ \ctx -> do + bytesToHex (exportSig ctx (signMsg ctx coreKey coreMsg)) `shouldBe` coreDer + bytesToHex (exportSig ctx (signMsgLowR ctx coreKey coreMsg)) `shouldBe` coreDer + it "is deterministic" $ \ctx -> + property $ \(m :: Msg, k :: SecKey) -> signMsg ctx k m == signMsg ctx k m + it "verifies with the matching public key" $ \ctx -> + property $ \(m :: Msg, k :: SecKey) -> signsAndVerifies ctx (m, k) + it "verifies in parallel" $ \ctx -> + property $ \(xs :: [(Msg, SecKey)]) -> P.runPar $ do + results <- mapM (P.spawnP . signsAndVerifies ctx) xs + and <$> mapM P.get results + it "produces lower-S signatures" $ \ctx -> + property $ \(m :: Msg, k :: SecKey) -> isLowS ctx (signMsg ctx k m) + describe "with low r" $ do + it "leaves a signature alone when r is already low" $ \ctx -> do + bytesToHex (exportSig ctx (signMsg ctx keyOne lowRMsg)) `shouldBe` lowRDer + signMsgLowR ctx keyOne lowRMsg `shouldBe` signMsg ctx keyOne lowRMsg + it "grinds a high r down the way Bitcoin Core does" $ \ctx -> do + bytesToHex (exportSig ctx (signMsg ctx keyOne highRMsg)) `shouldBe` highRDer + bytesToHex (exportSig ctx (signMsgLowR ctx keyOne highRMsg)) `shouldBe` groundDer + it "always gives low r, lower s, at most 70 DER bytes, and verifies" $ \ctx -> + property $ \(m :: Msg, k :: SecKey) -> + let s = signMsgLowR ctx k m + in isLowR ctx s + && isLowS ctx s + && BS.length (exportSig ctx s) <= 70 + && verifySig ctx (derivePubKey ctx k) s m + it "equals plain signing whenever that already has low r" $ \ctx -> + property $ \(m :: Msg, k :: SecKey) -> + let s = signMsg ctx k m + in isLowR ctx s ==> signMsgLowR ctx k m == s + where + signsAndVerifies ctx (m, k) = + verifySig ctx (derivePubKey ctx k) (signMsg ctx k m) m + +-- * Verification + +verificationSpec :: SpecWith Ctx +verificationSpec = describe "verification" $ do + it "accepts the RFC 6979 vector from its DER encoding" $ \ctx -> + verifySig ctx (fromString genCompressed) (fromJust (importSig ctx (hexToBytes satoshiDer))) satoshiMsg + `shouldBe` True + it "accepts the historical vector" $ \ctx -> + verifySig + ctx + (fromString histPub) + ( fromJust . importSig ctx . hexToBytes $ + "3045022100f502bfa07af43e7ef265618b0d929a7619ee01d6150e37eb6eaaf2c8bd37fb22\ + \02206f0415ab0e9a977afd78b2c26ef39b3952096d319fd4b101c768ad6c132e3045" + ) + "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00" + `shouldBe` True + it "rejects a signature from another key" $ \ctx -> + property $ \(m :: Msg, k :: SecKey, k' :: SecKey) -> + k /= k' ==> not (verifySig ctx (derivePubKey ctx k') (signMsg ctx k m) m) + it "rejects a signature over another message" $ \ctx -> + property $ \(m :: Msg, m' :: Msg, k :: SecKey) -> + m /= m' ==> not (verifySig ctx (derivePubKey ctx k) (signMsg ctx k m) m') + it "rejects a signature with one bit flipped" $ \ctx -> + property $ \(m :: Msg, k :: SecKey) -> + let compact = (exportCompactSig ctx (signMsg ctx k m)).get + -- Flipping the lowest bit of a lower-S s keeps it below n. + flipped = BS.init compact `BS.snoc` (BS.last compact `xor` 1) + in case importCompactSig ctx (fromJust (compactSig flipped)) of + Nothing -> False + Just s -> not (verifySig ctx (derivePubKey ctx k) s m) + describe "lower-S form" $ do + it "rejects the high-S form of a valid signature" $ \ctx -> do + let high = fromString (satoshiR ++ satoshiHighS) :: Sig + isLowS ctx high `shouldBe` False + verifySig ctx (fromString genCompressed) high satoshiMsg `shouldBe` False + it "normalizes the high-S form to the signature that was made" $ \ctx -> do + let high = fromString (satoshiR ++ satoshiHighS) :: Sig + low = normalizeSig ctx high + low `shouldBe` signMsg ctx keyOne satoshiMsg + isLowS ctx low `shouldBe` True + verifySig ctx (fromString genCompressed) low satoshiMsg `shouldBe` True + it "leaves a lower-S signature unchanged" $ \ctx -> + property $ \(m :: Msg, k :: SecKey) -> + let s = signMsg ctx k m in normalizeSig ctx s == s + it "is idempotent" $ \ctx -> do + let high = fromString (satoshiR ++ satoshiHighS) :: Sig + normalizeSig ctx (normalizeSig ctx high) `shouldBe` normalizeSig ctx high + +-- * DER + +derSpec :: SpecWith Ctx +derSpec = describe "DER signatures" $ do + it "exports the RFC 6979 vector and imports it back" $ \ctx -> do + let s = signMsg ctx keyOne satoshiMsg + bytesToHex (exportSig ctx s) `shouldBe` satoshiDer + importSig ctx (hexToBytes satoshiDer) `shouldBe` Just s + it "exports and imports back the same signature" $ \ctx -> + property $ \(m :: Msg, k :: SecKey) -> + let s = signMsg ctx k m in importSig ctx (exportSig ctx s) == Just s + it "exports and imports in parallel" $ \ctx -> + property $ \(xs :: [(Msg, SecKey)]) -> P.runPar $ do + results <- mapM (P.spawnP . roundTrip ctx) xs + and <$> mapM P.get results + it "exports 70 bytes for low r and 71 bytes for high r" $ \ctx -> do + BS.length (exportSig ctx (signMsg ctx keyOne lowRMsg)) `shouldBe` 70 + BS.length (exportSig ctx (signMsg ctx keyOne highRMsg)) `shouldBe` 71 + it "imports a high-S signature" $ \ctx -> do + let high = fromString (satoshiR ++ satoshiHighS) :: Sig + importSig ctx (exportSig ctx high) `shouldBe` Just high + it "rejects an empty input" $ \ctx -> + importSig ctx "" `shouldBe` Nothing + it "rejects a component equal to n or zero" $ \ctx -> do + -- r = n (33 bytes with a zero pad), s = r of the vector. + importSig ctx (hexToBytes ("3046022100" ++ order ++ "022100" ++ satoshiR)) `shouldBe` Nothing + -- r = 0, s = r of the vector. 3 + 35 = 38 = 0x26 bytes. + importSig ctx (hexToBytes ("3026020100022100" ++ satoshiR)) `shouldBe` Nothing + -- r of the vector, s = 0. + importSig ctx (hexToBytes ("3026022100" ++ satoshiR ++ "020100")) `shouldBe` Nothing + it "rejects encodings that are not strict DER" $ \ctx -> do + -- Long-form length for a value below 128. + importSig ctx (hexToBytes ("308145" ++ drop 4 satoshiDer)) `shouldBe` Nothing + -- A byte after the sequence. + importSig ctx (hexToBytes (satoshiDer ++ "00")) `shouldBe` Nothing + -- A byte missing at the end. + importSig ctx (hexToBytes (take (length satoshiDer - 2) satoshiDer)) `shouldBe` Nothing + -- Wrong sequence tag. + importSig ctx (hexToBytes ("31" ++ drop 2 satoshiDer)) `shouldBe` Nothing + -- Negative r: the zero pad is removed although the first byte is 0x93. + importSig ctx (hexToBytes ("30440220" ++ satoshiR ++ "0220" ++ satoshiS)) `shouldBe` Nothing + -- Two zero pad bytes on r. + importSig ctx (hexToBytes ("3046022200" ++ "00" ++ satoshiR ++ "0220" ++ satoshiS)) `shouldBe` Nothing + where + roundTrip ctx (m, k) = let s = signMsg ctx k m in importSig ctx (exportSig ctx s) == Just s + +-- * Compact signatures + +compactSpec :: SpecWith Ctx +compactSpec = describe "compact signatures" $ do + it "exports the RFC 6979 vector and imports it back" $ \ctx -> do + let s = signMsg ctx keyOne satoshiMsg + bytesToHex (exportCompactSig ctx s).get `shouldBe` satoshiR ++ satoshiS + importCompactSig ctx (fromString (satoshiR ++ satoshiS)) `shouldBe` Just s + it "exports and imports back the same signature" $ \ctx -> + property $ \(m :: Msg, k :: SecKey) -> + let s = signMsg ctx k m in importCompactSig ctx (exportCompactSig ctx s) == Just s + it "accepts components of 1 and n - 1 and rejects 0 and n" $ \ctx -> do + importCompactSig ctx (fromString (one ++ one)) `shouldSatisfy` isJust + importCompactSig ctx (fromString (orderMinusOne ++ orderMinusOne)) `shouldSatisfy` isJust + importCompactSig ctx (fromString (order ++ one)) `shouldBe` Nothing + importCompactSig ctx (fromString (one ++ order)) `shouldBe` Nothing + importCompactSig ctx (fromString (zero ++ one)) `shouldBe` Nothing + importCompactSig ctx (fromString (one ++ zero)) `shouldBe` Nothing + it "only accepts 64 bytes as a compact signature" $ \_ -> do + compactSig (BS.replicate 64 1) `shouldSatisfy` isJust + compactSig (BS.replicate 63 1) `shouldBe` Nothing + compactSig (BS.replicate 65 1) `shouldBe` Nothing + it "shows and reads a compact signature" $ \_ -> do + show (fromString (satoshiR ++ satoshiS) :: CompactSig) `shouldBe` quoted (satoshiR ++ satoshiS) + (readMaybe (quoted (satoshiR ++ satoshiS)) :: Maybe CompactSig) + `shouldBe` Just (fromString (satoshiR ++ satoshiS)) + (readMaybe (quoted satoshiR) :: Maybe CompactSig) `shouldBe` Nothing + evaluate (fromString satoshiR :: CompactSig) `shouldThrow` anyErrorCall + describe "signature values" $ do + it "rebuild from their internal bytes" $ \ctx -> + property $ \(m :: Msg, k :: SecKey) -> let s = signMsg ctx k m in sig s.get == Just s + it "reject internal bytes that are not a signature" $ \_ -> do + sig (BS.replicate 64 0) `shouldBe` Nothing + sig (BS.replicate 64 0xff) `shouldBe` Nothing + sig (BS.replicate 63 1) `shouldBe` Nothing + it "show the compact encoding" $ \ctx -> + show (signMsg ctx keyOne satoshiMsg) `shouldBe` quoted (satoshiR ++ satoshiS) + it "read the compact encoding" $ \ctx -> do + read (quoted (satoshiR ++ satoshiS)) `shouldBe` signMsg ctx keyOne satoshiMsg + (fromString (satoshiR ++ satoshiS) :: Sig) `shouldBe` signMsg ctx keyOne satoshiMsg + it "show and read" $ \ctx -> + property $ \(m :: Msg, k :: SecKey) -> showRead (signMsg ctx k m) + it "do not read an invalid signature" $ \_ -> do + (readMaybe (quoted (zero ++ one)) :: Maybe Sig) `shouldBe` Nothing + (readMaybe (quoted (order ++ one)) :: Maybe Sig) `shouldBe` Nothing + (readMaybe (quoted satoshiDer) :: Maybe Sig) `shouldBe` Nothing + evaluate (fromString satoshiDer :: Sig) `shouldThrow` anyErrorCall + +-- * Tweaks + +tweakSpec :: SpecWith Ctx +tweakSpec = describe "tweaks" $ do + it "accepts 0 and n - 1 and rejects n and 2^256 - 1" $ \_ -> do + tweak (hexToBytes zero) `shouldSatisfy` isJust + tweak (hexToBytes orderMinusOne) `shouldSatisfy` isJust + tweak (hexToBytes order) `shouldBe` Nothing + tweak (hexToBytes allOnes) `shouldBe` Nothing + tweak (BS.replicate 31 0) `shouldBe` Nothing + it "shows and reads" $ \_ -> + property (showRead :: Tweak -> Bool) + it "does not read a tweak of n" $ \_ -> do + (readMaybe (quoted order) :: Maybe Tweak) `shouldBe` Nothing + evaluate (fromString order :: Tweak) `shouldThrow` anyErrorCall + it "reads from a string" $ \_ -> + property $ \(t :: Tweak) -> fromString (bytesToHex t.get) == t + it "adds to a secret key" $ \ctx -> + -- (key + tweak) mod n + tweakAddSecKey ctx histKey histTweak + `shouldBe` Just "ec1e3ce1cefa18a671d51125e2b249688d934b0e28f5d1665384d9b02f929059" + it "multiplies a secret key" $ \ctx -> + -- (key * tweak) mod n + tweakMulSecKey ctx histKey histTweak + `shouldBe` Just "a96f5962493acb179f60a86a9785fc7a30e0c39b64c09d24fe064d9aef15e4c0" + it "adds to a public key" $ \ctx -> + -- P + tweak * G + fmap (bytesToHex . exportPubKey ctx False) (tweakAddPubKey ctx (fromString histPub) histTweak) + `shouldBe` Just + "04441c3982b97576646e0df0c96736063df6b42f2ee566d13b9f6424302d1379e5\ + \18fdc87a14c5435bff7a5db4552042cb4120c6b86a4bbd3d0643f3c14ad01368" + it "multiplies a public key" $ \ctx -> + -- tweak * P + fmap (bytesToHex . exportPubKey ctx False) (tweakMulPubKey ctx (fromString histPub) histTweak) + `shouldBe` Just + "04f379dc99cdf5c83e433defa267fbb3377d61d6b779c06a0e4ce29ae3ff5353b1\ + \2ae49c9d07e7368f2ba5a446c203255ce912322991a2d6a9d5d5761c61ed1845" + it "tweaks the public key like the secret key" $ \ctx -> + property $ \(k :: SecKey, t :: Tweak) -> + fmap (derivePubKey ctx) (tweakAddSecKey ctx k t) == tweakAddPubKey ctx (derivePubKey ctx k) t + && fmap (derivePubKey ctx) (tweakMulSecKey ctx k t) == tweakMulPubKey ctx (derivePubKey ctx k) t + it "adding zero changes nothing" $ \ctx -> + property $ \(k :: SecKey) -> + tweakAddSecKey ctx k (fromString zero) == Just k + && tweakAddPubKey ctx (derivePubKey ctx k) (fromString zero) == Just (derivePubKey ctx k) + it "multiplying by zero fails" $ \ctx -> do + tweakMulSecKey ctx keyOne (fromString zero) `shouldBe` Nothing + tweakMulPubKey ctx (derivePubKey ctx keyOne) (fromString zero) `shouldBe` Nothing + it "adding the negation of the key fails" $ \ctx -> do + -- 1 + (n - 1) = 0 mod n + tweakAddSecKey ctx keyOne (fromString orderMinusOne) `shouldBe` Nothing + tweakAddPubKey ctx (derivePubKey ctx keyOne) (fromString orderMinusOne) `shouldBe` Nothing + it "negates modulo n" $ \ctx -> do + tweakNegate ctx (fromString one) `shouldBe` Just (fromString orderMinusOne) + tweakNegate ctx (fromString zero) `shouldBe` Just (fromString zero) + -- n - histTweak + tweakNegate ctx histTweak + `shouldBe` Just "0a3418277e7d5b471bff0694f9ed76dd3464c4ce323753b0d77e433663ab7341" + it "negating twice gives the tweak back" $ \ctx -> + property $ \(t :: Tweak) -> (tweakNegate ctx t >>= tweakNegate ctx) == Just t + it "adding a tweak and then its negation gives the key back" $ \ctx -> + property $ \(k :: SecKey, t :: Tweak) -> + let minus = fromJust (tweakNegate ctx t) + in (tweakAddSecKey ctx k t >>= \k' -> tweakAddSecKey ctx k' minus) == Just k + it "leaves its inputs unchanged" $ \ctx -> + property $ \(k :: SecKey, t :: Tweak) -> + let kBytes = BS.copy k.get + p = derivePubKey ctx k + pBytes = BS.copy p.get + tBytes = BS.copy t.get + in tweakAddSecKey ctx k t `seq` + tweakMulPubKey ctx p t `seq` + tweakNegate ctx t `seq` + (k.get == kBytes && p.get == pBytes && t.get == tBytes) + +-- * Combining public keys + +combineSpec :: SpecWith Ctx +combineSpec = describe "combining public keys" $ do + it "adds three historical keys" $ \ctx -> + fmap (bytesToHex . exportPubKey ctx False) + ( combinePubKeys + ctx + [ fromString histPub, + "0487d82042d93447008dfe2af762068a1e53ff394a5bf8f68a045fa642b99ea5d1\ + \53f577dd2dba6c7ae4cfd7b6622409d7edd2d76dd13a8092cd3af97b77bd2c77", + "049b101edcbe1ee37ff6b2318526a425b629e823d7d8d9154417880595a28000ee\ + \3febd908754b8ce4e491aa6fe488b41fb5d4bb3788e33c9ff95a7a9229166d59" + ] + ) + `shouldBe` Just + "043d9a7ec70011efc23c33a7e62d2ea73cca87797e3b659d93bea6aa871aebde56\ + \c3bc6134ca82e324b0ab9c0e601a6d2933afe7fb5d9f3aae900f5c5dc6e362c8" + it "adds G to itself" $ \ctx -> + -- 2 * G + fmap (bytesToHex . exportPubKey ctx True) (combinePubKeys ctx [fromString genCompressed, fromString genCompressed]) + `shouldBe` Just "02c6047f9441ed7d6d3045406e95c07cd85c778e4b8cef3ca7abac09b95c709ee5" + it "adds like the secret keys add" $ \ctx -> + property $ \(k1 :: SecKey, k2 :: SecKey) -> + combinePubKeys ctx [derivePubKey ctx k1, derivePubKey ctx k2] + == fmap (derivePubKey ctx) (tweakAddSecKey ctx k1 (fromString (bytesToHex k2.get))) + it "returns a single key unchanged" $ \ctx -> + property $ \(k :: SecKey) -> combinePubKeys ctx [derivePubKey ctx k] == Just (derivePubKey ctx k) + it "fails for no keys" $ \ctx -> + combinePubKeys ctx [] `shouldBe` Nothing + it "fails when the sum is the point at infinity" $ \ctx -> + property $ \(k :: SecKey) -> + let p = derivePubKey ctx k + minusP = fromJust (tweakMulPubKey ctx p (fromString orderMinusOne)) + in isNothing (combinePubKeys ctx [p, minusP]) + +-- * Contexts + +-- * Schnorr signatures + +schnorrSpec :: SpecWith Ctx +schnorrSpec = describe "Schnorr signatures" $ do + describe "BIP-340 vector" $ mapM_ bip340VectorSpec bip340Vectors + it "signs vector 0 without auxiliary randomness as with 32 zero bytes" $ \ctx -> + signSchnorr ctx bip340Key0 (fromString zero) `shouldBe` fromString bip340Sig0 + it "signs without randomness as with 32 zero bytes" $ \ctx -> + property $ \(m :: Msg, k :: SecKey) -> + signSchnorrWithAux ctx k m (BS.replicate 32 0) == Just (signSchnorr ctx k m) + it "verifies with the matching public key" $ \ctx -> + property $ \(m :: Msg, k :: SecKey) -> + verifySchnorr ctx (derivePubKey ctx k) (signSchnorr ctx k m) m + it "verifies with the negation of the public key" $ \ctx -> + property $ \(m :: Msg, k :: SecKey) -> + verifySchnorr ctx (negatePubKey ctx (derivePubKey ctx k)) (signSchnorr ctx k m) m + it "verifies a signature made with fresh randomness" $ \ctx -> + property $ \(m :: Msg, k :: SecKey) -> ioProperty $ do + s <- signSchnorrIO ctx k m + return (verifySchnorr ctx (derivePubKey ctx k) s m) + it "changes with the auxiliary randomness" $ \ctx -> + property $ \(m :: Msg, k :: SecKey) -> + signSchnorrWithAux ctx k m (BS.replicate 32 1) /= signSchnorrWithAux ctx k m (BS.replicate 32 2) + it "rejects auxiliary randomness that is not 32 bytes" $ \ctx -> do + signSchnorrWithAux ctx keyOne satoshiMsg (BS.replicate 31 0) `shouldBe` Nothing + signSchnorrWithAux ctx keyOne satoshiMsg (BS.replicate 33 0) `shouldBe` Nothing + it "rejects a signature from another key" $ \ctx -> + property $ \(m :: Msg, k :: SecKey, k' :: SecKey) -> + k /= k' ==> not (verifySchnorr ctx (derivePubKey ctx k') (signSchnorr ctx k m) m) + it "rejects a signature over another message" $ \ctx -> + property $ \(m :: Msg, m' :: Msg, k :: SecKey) -> + m /= m' ==> not (verifySchnorr ctx (derivePubKey ctx k) (signSchnorr ctx k m) m') + it "only accepts 64 bytes as a signature" $ \_ -> do + schnorrSig (BS.replicate 64 0) `shouldSatisfy` isJust + schnorrSig (BS.replicate 63 0) `shouldBe` Nothing + schnorrSig (BS.replicate 65 0) `shouldBe` Nothing + it "shows the signature in hex" $ \_ -> + show (fromString bip340Sig0 :: SchnorrSig) `shouldBe` quoted bip340Sig0 + it "shows and reads" $ \ctx -> + property $ \(m :: Msg, k :: SecKey) -> showRead (signSchnorr ctx k m) + it "reads from a string" $ \ctx -> + property $ \(m :: Msg, k :: SecKey) -> + let s = signSchnorr ctx k m in fromString (bytesToHex s.get) == s + it "does not read a signature of the wrong length" $ \_ -> do + (readMaybe (quoted (replicate 126 '0')) :: Maybe SchnorrSig) `shouldBe` Nothing + evaluate (fromString (replicate 126 '0') :: SchnorrSig) `shouldThrow` anyErrorCall + +-- For a vector with a secret key: the key gives the public key, and signing +-- with the given auxiliary randomness gives the signature. For every vector: +-- verification gives the expected result, where a public key that does not +-- import counts as a failed verification. +bip340VectorSpec :: BIP340Vector -> SpecWith Ctx +bip340VectorSpec v = it (show v.index ++ " " ++ v.comment) $ \ctx -> do + let m = fromString v.message :: Msg + s = fromString v.signature :: SchnorrSig + case (v.secretKey, v.auxRand) of + (Just key, Just aux) -> do + let k = fromString key :: SecKey + bytesToHex (exportXOnlyPubKey ctx (derivePubKey ctx k)) `shouldBe` v.publicKey + signSchnorrWithAux ctx k m (hexToBytes aux) `shouldBe` Just s + _ -> return () + maybe False (\p -> verifySchnorr ctx p s m) (importXOnlyPubKey ctx (hexToBytes v.publicKey)) + `shouldBe` v.result + +-- * X-only public keys + +xOnlySpec :: SpecWith Ctx +xOnlySpec = describe "x-only public keys" $ do + it "exports the x coordinate of G" $ \ctx -> + -- the compressed encoding of G without its 02 prefix + bytesToHex (exportXOnlyPubKey ctx (derivePubKey ctx keyOne)) `shouldBe` drop 2 genCompressed + it "exports the public key of BIP-340 vector 0" $ \ctx -> + bytesToHex (exportXOnlyPubKey ctx (derivePubKey ctx bip340Key0)) `shouldBe` bip340Pub0 + it "exports the x coordinate of any key" $ \ctx -> + property $ \(k :: SecKey) -> + let p = derivePubKey ctx k + in exportXOnlyPubKey ctx p == BS.drop 1 (exportPubKey ctx True p) + it "exports a key and its negation the same way" $ \ctx -> + property $ \(k :: SecKey) -> + let p = derivePubKey ctx k + in exportXOnlyPubKey ctx p == exportXOnlyPubKey ctx (negatePubKey ctx p) + it "imports G from its x coordinate" $ \ctx -> + fmap (bytesToHex . exportPubKey ctx True) (importXOnlyPubKey ctx (hexToBytes (drop 2 genCompressed))) + `shouldBe` Just genCompressed + it "imports the point with an even y coordinate" $ \ctx -> + property $ \(k :: SecKey) -> + let x = exportXOnlyPubKey ctx (derivePubKey ctx k) + in fmap (exportPubKey ctx True) (importXOnlyPubKey ctx x) == Just (BS.cons 0x02 x) + it "rejects an x coordinate that is not on the curve" $ \ctx -> do + importXOnlyPubKey ctx (hexToBytes fieldSize) `shouldBe` Nothing + -- BIP-340 vector 5 + importXOnlyPubKey ctx (hexToBytes "eefdea4cdb677750a420fee807eacf21eb9898ae79b9768766e4faa04a2d4a34") + `shouldBe` Nothing + it "rejects 31 and 33 bytes" $ \ctx -> do + importXOnlyPubKey ctx (BS.replicate 31 1) `shouldBe` Nothing + importXOnlyPubKey ctx (BS.replicate 33 1) `shouldBe` Nothing + +-- * Taproot tweaks + +taprootSpec :: SpecWith Ctx +taprootSpec = describe "Taproot tweaks" $ do + describe "BIP-341 key path input" $ mapM_ (uncurry bip341VectorSpec) (zip [0 :: Int ..] bip341Vectors) + it "tweaks the public key like the secret key" $ \ctx -> + property $ \(k :: SecKey, t :: Tweak) -> + fmap (derivePubKey ctx) (tweakAddXOnlySecKey ctx k t) == tweakAddXOnlyPubKey ctx (derivePubKey ctx k) t + it "tweaks a key and its negation alike" $ \ctx -> + property $ \(k :: SecKey, t :: Tweak) -> + let p = derivePubKey ctx k + in tweakAddXOnlyPubKey ctx p t == tweakAddXOnlyPubKey ctx (negatePubKey ctx p) t + it "signs for the tweaked output key with the tweaked secret key" $ \ctx -> + property $ \(m :: Msg, k :: SecKey, t :: Tweak) -> + let k' = fromJust (tweakAddXOnlySecKey ctx k t) + p' = fromJust (tweakAddXOnlyPubKey ctx (derivePubKey ctx k) t) + in verifySchnorr ctx p' (signSchnorr ctx k' m) m + it "adding zero gives the point with an even y coordinate" $ \ctx -> + property $ \(k :: SecKey) -> + let p = derivePubKey ctx k + in fmap (exportPubKey ctx True) (tweakAddXOnlyPubKey ctx p (fromString zero)) + == Just (BS.cons 0x02 (exportXOnlyPubKey ctx p)) + it "negates a secret key whose public key has an odd y coordinate" $ \ctx -> + -- Key n - 1 has the public key -G, whose y coordinate is odd, so the key + -- is negated to 1 before the zero tweak is added. + tweakAddXOnlySecKey ctx (fromString orderMinusOne) (fromString zero) `shouldBe` Just keyOne + it "fails when the result would be zero" $ \ctx -> do + -- G has an even y coordinate, so key 1 is not negated: 1 + (n - 1) = 0. + tweakAddXOnlySecKey ctx keyOne (fromString orderMinusOne) `shouldBe` Nothing + tweakAddXOnlyPubKey ctx (derivePubKey ctx keyOne) (fromString orderMinusOne) `shouldBe` Nothing + -- Key n - 1 is negated to 1 first, with the same result. + tweakAddXOnlySecKey ctx (fromString orderMinusOne) (fromString orderMinusOne) `shouldBe` Nothing + tweakAddXOnlyPubKey ctx (derivePubKey ctx (fromString orderMinusOne)) (fromString orderMinusOne) + `shouldBe` Nothing + +-- The internal key gives the internal public key. The tweak gives the tweaked +-- secret key and the output key, and they match. The tweaked key signs the +-- signature hash to the signature in the witness, which verifies against the +-- output key. +bip341VectorSpec :: Int -> BIP341Vector -> SpecWith Ctx +bip341VectorSpec i v = it (show i) $ \ctx -> do + let k = fromString v.internalKey :: SecKey + t = fromString v.tapTweak :: Tweak + k' = fromString v.tweakedKey :: SecKey + m = fromString v.sigHash :: Msg + s = fromString v.keyPathSig :: SchnorrSig + bytesToHex (exportXOnlyPubKey ctx (derivePubKey ctx k)) `shouldBe` v.internalPub + tweakAddXOnlySecKey ctx k t `shouldBe` Just k' + fmap (bytesToHex . exportXOnlyPubKey ctx) (tweakAddXOnlyPubKey ctx (derivePubKey ctx k) t) + `shouldBe` Just v.outputKey + signSchnorr ctx k' m `shouldBe` s + verifySchnorr ctx (fromJust (importXOnlyPubKey ctx (hexToBytes v.outputKey))) s m `shouldBe` True + +contextSpec :: SpecWith Ctx +contextSpec = describe "contexts" $ do + it "a clone signs and verifies like the original" $ \ctx -> do + clone <- cloneContext ctx + signMsg clone keyOne satoshiMsg `shouldBe` signMsg ctx keyOne satoshiMsg + verifySig clone (derivePubKey ctx keyOne) (signMsg ctx keyOne satoshiMsg) satoshiMsg `shouldBe` True + it "randomizing does not change signatures" $ \ctx -> do + let original = signMsg ctx keyOne satoshiMsg + randomizeContext ctx + signMsg ctx keyOne satoshiMsg `shouldBe` original + it "withContext gives a working context" $ \_ -> + withContext $ \ctx -> + bytesToHex (exportSig ctx (signMsg ctx keyOne satoshiMsg)) `shouldBe` satoshiDer + +-- * Values built with the raw constructors of the Internal module + +rawValueSpec :: SpecWith Ctx +rawValueSpec = describe "raw values from the Internal module" $ do + describe "a public key with a zero x coordinate" $ do + it "does not verify, instead of aborting the process" $ \ctx -> + property $ \(m :: Msg, k :: SecKey) -> + not (verifySig ctx zeroKey (signMsg ctx k m) m) + it "throws on export" $ \ctx -> + evaluate (exportPubKey ctx True zeroKey) `shouldThrow` anyErrorCall + it "throws on show" $ \_ -> + evaluate (length (show zeroKey)) `shouldThrow` anyErrorCall + it "fails to tweak" $ \ctx -> do + tweakAddPubKey ctx zeroKey (fromString one) `shouldBe` Nothing + tweakMulPubKey ctx zeroKey (fromString one) `shouldBe` Nothing + it "fails to combine" $ \ctx -> + combinePubKeys ctx [derivePubKey ctx keyOne, zeroKey] `shouldBe` Nothing + it "does not verify a Schnorr signature" $ \ctx -> + verifySchnorr ctx zeroKey (signSchnorr ctx keyOne satoshiMsg) satoshiMsg `shouldBe` False + it "throws on x-only export" $ \ctx -> + evaluate (exportXOnlyPubKey ctx zeroKey) `shouldThrow` anyErrorCall + it "fails to tweak as an x-only key" $ \ctx -> + tweakAddXOnlyPubKey ctx zeroKey (fromString one) `shouldBe` Nothing + it "a public key off the curve fails to combine" $ \ctx -> + combinePubKeys ctx [derivePubKey ctx keyOne, PubKey (BS.replicate 64 1)] `shouldBe` Nothing + it "a zero secret key throws instead of signing" $ \ctx -> do + evaluate (signMsg ctx (SecKey (BS.replicate 32 0)) satoshiMsg) `shouldThrow` anyErrorCall + evaluate (derivePubKey ctx (SecKey (BS.replicate 32 0))) `shouldThrow` anyErrorCall + evaluate (signSchnorr ctx (SecKey (BS.replicate 32 0)) satoshiMsg) `shouldThrow` anyErrorCall + it "a zero secret key fails to tweak as an x-only key" $ \ctx -> + tweakAddXOnlySecKey ctx (SecKey (BS.replicate 32 0)) (fromString one) `shouldBe` Nothing + it "a tweak of n fails" $ \ctx -> do + tweakAddSecKey ctx keyOne (Tweak (hexToBytes order)) `shouldBe` Nothing + tweakNegate ctx (Tweak (hexToBytes order)) `shouldBe` Nothing + tweakAddXOnlySecKey ctx keyOne (Tweak (hexToBytes order)) `shouldBe` Nothing + tweakAddXOnlyPubKey ctx (derivePubKey ctx keyOne) (Tweak (hexToBytes order)) `shouldBe` Nothing + it "values of the wrong length throw before reaching the library" $ \ctx -> do + evaluate (derivePubKey ctx (SecKey "a")) `shouldThrow` anyErrorCall + evaluate (signMsg ctx (SecKey "a") satoshiMsg) `shouldThrow` anyErrorCall + evaluate (signMsg ctx keyOne (Msg "a")) `shouldThrow` anyErrorCall + evaluate (verifySig ctx (derivePubKey ctx keyOne) (Sig "a") satoshiMsg) `shouldThrow` anyErrorCall + evaluate (verifySig ctx (PubKey "a") (signMsg ctx keyOne satoshiMsg) satoshiMsg) `shouldThrow` anyErrorCall + evaluate (verifySig ctx (derivePubKey ctx keyOne) (signMsg ctx keyOne satoshiMsg) (Msg "a")) `shouldThrow` anyErrorCall + evaluate (exportSig ctx (Sig "a")) `shouldThrow` anyErrorCall + evaluate (exportCompactSig ctx (Sig "a")) `shouldThrow` anyErrorCall + evaluate (importCompactSig ctx (CompactSig "a")) `shouldThrow` anyErrorCall + evaluate (normalizeSig ctx (Sig "a")) `shouldThrow` anyErrorCall + evaluate (isLowS ctx (Sig "a")) `shouldThrow` anyErrorCall + evaluate (exportPubKey ctx True (PubKey "a")) `shouldThrow` anyErrorCall + evaluate (tweakAddSecKey ctx keyOne (Tweak "a")) `shouldThrow` anyErrorCall + evaluate (tweakMulSecKey ctx (SecKey "a") (fromString one)) `shouldThrow` anyErrorCall + evaluate (tweakAddPubKey ctx (PubKey "a") (fromString one)) `shouldThrow` anyErrorCall + evaluate (tweakMulPubKey ctx (derivePubKey ctx keyOne) (Tweak "a")) `shouldThrow` anyErrorCall + evaluate (tweakNegate ctx (Tweak "a")) `shouldThrow` anyErrorCall + evaluate (combinePubKeys ctx [derivePubKey ctx keyOne, PubKey "a"]) `shouldThrow` anyErrorCall + evaluate (tweakAddSecKey ctx (SecKey "a") (fromString one)) `shouldThrow` anyErrorCall + evaluate (tweakMulSecKey ctx keyOne (Tweak "a")) `shouldThrow` anyErrorCall + evaluate (tweakAddPubKey ctx (derivePubKey ctx keyOne) (Tweak "a")) `shouldThrow` anyErrorCall + evaluate (tweakMulPubKey ctx (PubKey "a") (fromString one)) `shouldThrow` anyErrorCall + evaluate (signMsgWith ctx keyOne satoshiMsg (Just "a")) `shouldThrow` anyErrorCall + evaluate (signSchnorr ctx (SecKey "a") satoshiMsg) `shouldThrow` anyErrorCall + evaluate (signSchnorr ctx keyOne (Msg "a")) `shouldThrow` anyErrorCall + evaluate (verifySchnorr ctx (derivePubKey ctx keyOne) (SchnorrSig "a") satoshiMsg) `shouldThrow` anyErrorCall + evaluate (verifySchnorr ctx (PubKey "a") (signSchnorr ctx keyOne satoshiMsg) satoshiMsg) `shouldThrow` anyErrorCall + evaluate (verifySchnorr ctx (derivePubKey ctx keyOne) (signSchnorr ctx keyOne satoshiMsg) (Msg "a")) `shouldThrow` anyErrorCall + evaluate (exportXOnlyPubKey ctx (PubKey "a")) `shouldThrow` anyErrorCall + evaluate (tweakAddXOnlyPubKey ctx (PubKey "a") (fromString one)) `shouldThrow` anyErrorCall + evaluate (tweakAddXOnlyPubKey ctx (derivePubKey ctx keyOne) (Tweak "a")) `shouldThrow` anyErrorCall + evaluate (tweakAddXOnlySecKey ctx (SecKey "a") (fromString one)) `shouldThrow` anyErrorCall + evaluate (tweakAddXOnlySecKey ctx keyOne (Tweak "a")) `shouldThrow` anyErrorCall + where + zeroKey = PubKey (BS.replicate 64 0) + +-- * Derived instances + +instanceSpec :: SpecWith Ctx +instanceSpec = describe "derived instances" $ do + it "equal values hash equally, whichever way they were built" $ \ctx -> + property $ \(m :: Msg, k :: SecKey) -> + let p = derivePubKey ctx k + s = signMsg ctx k m + sc = signSchnorr ctx k m + in hash p == hash (fromJust (importPubKey ctx (exportPubKey ctx False p))) + && hash s == hash (fromJust (importSig ctx (exportSig ctx s))) + && hash k == hash (fromJust (secKey k.get)) + && hash sc == hash (fromJust (schnorrSig sc.get)) + it "can be fully evaluated" $ \ctx -> do + let p = derivePubKey ctx keyOne + s = signMsg ctx keyOne satoshiMsg + ((p, s, keyOne, satoshiMsg, histTweak, exportCompactSig ctx s, signSchnorr ctx keyOne satoshiMsg) `deepseq` ()) + `shouldBe` ()