secp256k1-haskell 0.5.0 → 2.0.1
raw patch · 18 files changed
Files
- CHANGELOG.md +292/−19
- README.md +451/−4
- cbits/illegal_callback.c +17/−0
- secp256k1-haskell.cabal +47/−29
- src/Crypto/Secp256k1.hs +169/−429
- src/Crypto/Secp256k1/Internal.hs +0/−270
- src/Crypto/Secp256k1/Internal/Base.hs +837/−0
- src/Crypto/Secp256k1/Internal/BaseOps.hs +281/−0
- src/Crypto/Secp256k1/Internal/Context.hs +160/−0
- src/Crypto/Secp256k1/Internal/ForeignTypes.hs +87/−0
- src/Crypto/Secp256k1/Internal/Recovery.hs +228/−0
- src/Crypto/Secp256k1/Internal/RecoveryOps.hs +70/−0
- src/Crypto/Secp256k1/Internal/Util.hs +113/−0
- src/Crypto/Secp256k1/Recovery.hs +72/−0
- test/Crypto/Secp256k1/Fixtures.hs +128/−0
- test/Crypto/Secp256k1/InternalSpec.hs +351/−290
- test/Crypto/Secp256k1/RecoverySpec.hs +334/−0
- test/Crypto/Secp256k1Spec.hs +995/−248
CHANGELOG.md view
@@ -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.
README.md view
@@ -1,6 +1,453 @@-[](https://travis-ci.org/haskoin/secp256k1-haskell)+# secp256k1-haskell -# Haskell bindings for secp256k1+[](https://hackage.haskell.org/package/secp256k1-haskell)+[](https://github.com/jprupp/secp256k1-haskell/actions/workflows/ci.yml)+[](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).
+ cbits/illegal_callback.c view
@@ -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;+}
secp256k1-haskell.cabal view
@@ -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
src/Crypto/Secp256k1.hs view
@@ -1,445 +1,185 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-|-Module : Crypto.Secp256k1-License : UNLICENSE-Maintainer : Jean-Pierre Rupp <jprupp@protonmail.ch>-Stability : experimental-Portability : POSIX+{-# LANGUAGE DuplicateRecordFields #-} -Crytpographic functions from Bitcoin’s secp256k1 library.--}+-- | ECDSA and BIP-340 Schnorr signatures on the secp256k1 curve, through+-- <https://github.com/bitcoin-core/secp256k1 libsecp256k1>.+--+-- == 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
− src/Crypto/Secp256k1/Internal.hs
@@ -1,270 +0,0 @@-{-|-Module : Crypto.Secp256k1.Internal-License : UNLICENSE-Maintainer : Jean-Pierre Rupp <jprupp@protonmail.ch>-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
+ src/Crypto/Secp256k1/Internal/Base.hs view
@@ -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
+ src/Crypto/Secp256k1/Internal/BaseOps.hs view
@@ -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
+ src/Crypto/Secp256k1/Internal/Context.hs view
@@ -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
+ src/Crypto/Secp256k1/Internal/ForeignTypes.hs view
@@ -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
+ src/Crypto/Secp256k1/Internal/Recovery.hs view
@@ -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)
+ src/Crypto/Secp256k1/Internal/RecoveryOps.hs view
@@ -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
+ src/Crypto/Secp256k1/Internal/Util.hs view
@@ -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
+ src/Crypto/Secp256k1/Recovery.hs view
@@ -0,0 +1,72 @@+-- | ECDSA public key recovery, through the @recovery@ module of+-- <https://github.com/bitcoin-core/secp256k1 libsecp256k1>.+--+-- 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
+ test/Crypto/Secp256k1/Fixtures.hs view
@@ -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))
test/Crypto/Secp256k1/InternalSpec.hs view
@@ -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"
+ test/Crypto/Secp256k1/RecoverySpec.hs view
@@ -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
test/Crypto/Secp256k1Spec.hs view
@@ -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` ()