diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,6 +4,103 @@ 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). +## [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 diff --git a/cbits/illegal_callback.c b/cbits/illegal_callback.c new file mode 100644 --- /dev/null +++ b/cbits/illegal_callback.c @@ -0,0 +1,17 @@ +/* + * Illegal-argument callback installed on every context this package creates. + * + * The default callback of libsecp256k1 prints the message to stderr and calls + * abort(). That kills the whole Haskell process and cannot be caught. With + * this callback installed, the C function that received the illegal argument + * returns 0 instead, and the Haskell side turns that into Nothing, False or + * an ErrorCall exception. + * + * The error callback, which reports internal consistency failures of the + * library itself, keeps its default. Those indicate a broken build and + * should still abort. + */ +void secp256k1_haskell_illegal_callback(const char *message, void *data) { + (void)message; + (void)data; +} diff --git a/secp256k1-haskell.cabal b/secp256k1-haskell.cabal --- a/secp256k1-haskell.cabal +++ b/secp256k1-haskell.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: secp256k1-haskell -version: 1.7.0 +version: 2.0.0 synopsis: Bindings for secp256k1 description: Sign and verify signatures using the secp256k1 library. category: Crypto @@ -23,6 +23,11 @@ type: 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 @@ -36,8 +41,11 @@ 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 , base >=4.9 && <5 @@ -47,21 +55,27 @@ , entropy >=0.3.8 , hashable >=1.2.6 , string-conversions >=0.4 - , unliftio-core >=0.1.0 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 @@ -76,6 +90,7 @@ , mtl , secp256k1-haskell , string-conversions >=0.4 - , unliftio-core >=0.1.0 default-language: Haskell2010 + if flag(recovery) + cpp-options: -DRECOVERY build-tool-depends: hspec-discover:hspec-discover diff --git a/src/Crypto/Secp256k1.hs b/src/Crypto/Secp256k1.hs --- a/src/Crypto/Secp256k1.hs +++ b/src/Crypto/Secp256k1.hs @@ -1,46 +1,125 @@ {-# LANGUAGE DuplicateRecordFields #-} + +-- | ECDSA and BIP-340 Schnorr signatures on the secp256k1 curve, through +-- . +-- +-- == 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 ( -- * Context - Ctx (..), + Ctx, withContext, createContext, randomizeContext, cloneContext, -- * Messages - Msg (..), + Msg (get), msg, -- * Secret Keys - SecKey (..), + SecKey (get), secKey, derivePubKey, -- * Public Keys - PubKey (..), + PubKey (get), pubKey, importPubKey, exportPubKey, -- * Signatures - Sig (..), + Sig (get), sig, signMsg, + signMsgLowR, verifySig, normalizeSig, + isLowS, + isLowR, -- ** DER importSig, exportSig, -- ** Compact - CompactSig (..), + CompactSig (get), compactSig, exportCompactSig, importCompactSig, -- * Addition & Multiplication - Tweak (..), + Tweak (get), tweak, tweakAddSecKey, tweakMulSecKey, @@ -48,6 +127,22 @@ tweakMulPubKey, combinePubKeys, tweakNegate, + + -- * Schnorr Signatures (BIP-340) + SchnorrSig (get), + schnorrSig, + signSchnorr, + signSchnorrWithAux, + signSchnorrIO, + verifySchnorr, + + -- ** X-Only Public Keys + importXOnlyPubKey, + exportXOnlyPubKey, + + -- ** Taproot Tweaks (BIP-341) + tweakAddXOnlyPubKey, + tweakAddXOnlySecKey, ) where diff --git a/src/Crypto/Secp256k1/Internal/Base.hs b/src/Crypto/Secp256k1/Internal/Base.hs --- a/src/Crypto/Secp256k1/Internal/Base.hs +++ b/src/Crypto/Secp256k1/Internal/Base.hs @@ -1,16 +1,24 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE ImportQualifiedPost #-} -{-# LANGUAGE MultiParamTypeClasses #-} {-# 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 (bracket) -import Control.Monad (replicateM, unless, (<=<)) +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, @@ -28,34 +36,51 @@ ecdsaSignatureSerializeCompact, ecdsaSignatureSerializeDer, ecdsaVerify, + keyPairCreate, + keyPairSec, + keyPairXOnlyPub, + keyPairXOnlyTweakAdd, + schnorrSigSign32, + schnorrSigVerify, + xOnlyPubKeyFromPubKey, + xOnlyPubKeySerialize, + xOnlyPubKeyTweakAdd, ) -import Crypto.Secp256k1.Internal.Context (Ctx (..)) +import Crypto.Secp256k1.Internal.Context (Ctx (..), validationContext) import Crypto.Secp256k1.Internal.ForeignTypes - ( LCtx, + ( KeyPair96, + LCtx, + SchnorrSig64, + XOnlyPubKey64, compressed, isSuccess, uncompressed, ) import Crypto.Secp256k1.Internal.Util ( decodeHex, + fillOutput, packByteString, showsHex, - unsafePackByteString, 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 - ( Bits (bitSize), - Ptr, + ( Ptr, alloca, allocaArray, allocaBytes, - free, - mallocBytes, + castPtr, + fillBytes, nullFunPtr, nullPtr, peek, @@ -63,7 +88,9 @@ pokeArray, withForeignPtr, ) +import Foreign.C (CUChar) import GHC.Generics (Generic) +import System.Entropy (getEntropy) import System.IO.Unsafe (unsafePerformIO) import Test.QuickCheck ( Arbitrary (..), @@ -78,36 +105,81 @@ 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 $ pubKey =<< decodeHex str + maybe pfail return $ importPubKey validationContext =<< decodeHex str instance IsString PubKey where - fromString = fromMaybe e . (pubKey <=< decodeHex) + fromString = fromMaybe e . (importPubKey validationContext <=< decodeHex) where e = error "Could not decode public key from hex string" instance Show PubKey where - showsPrec _ = showsHex . (.get) + showsPrec _ = showsHex . exportPubKey validationContext True instance Read Msg where readPrec = parens $ do @@ -125,15 +197,15 @@ instance Read Sig where readPrec = parens $ do String str <- lexP - maybe pfail return $ sig =<< decodeHex str + maybe pfail return $ sigFromCompactBytes =<< decodeHex str instance IsString Sig where - fromString = fromMaybe e . (sig <=< decodeHex) + fromString = fromMaybe e . (sigFromCompactBytes <=< decodeHex) where e = error "Could not decode signature from hex string" instance Show Sig where - showsPrec _ = showsHex . (.get) + showsPrec _ = showsHex . (.get) . exportCompactSig validationContext instance Read SecKey where readPrec = parens $ do @@ -143,7 +215,7 @@ instance IsString SecKey where fromString = fromMaybe e . (secKey <=< decodeHex) where - e = error "Colud not decode secret key from hex string" + e = error "Could not decode secret key from hex string" instance Show SecKey where showsPrec _ = showsHex . (.get) @@ -161,79 +233,209 @@ instance Show Tweak where showsPrec _ = showsHex . (.get) --- | Import 64-byte 'ByteString' as 'Sig'. +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 + ] + +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 - | BS.length bs == 64 = Just (Sig bs) + | isCanonicalSig bs = Just (Sig bs) | otherwise = Nothing --- | Import 64-byte 'ByteString' as 'PubKey'. +-- | 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 - | BS.length bs == 64 = Just (PubKey bs) + | isCanonicalPubKey bs = Just (PubKey bs) | otherwise = Nothing --- | Import 32-byte 'ByteString' as 'Msg'. +-- | 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 32-byte 'ByteString' as 'SecKey'. +-- | 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 - | BS.length bs == 32 = Just (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 signature to a normalized lower-S form. 'Nothing' indicates that it --- was already normal. -normalizeSig :: Ctx -> Sig -> Maybe Sig -normalizeSig (Ctx fctx) (Sig sig) = +-- | 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 -> - 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 + 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) --- | 32-Byte 'ByteString' as 'Tweak'. -tweak :: ByteString -> Maybe Tweak -tweak bs - | BS.length bs == 32 = Just (Tweak bs) - | otherwise = Nothing +-- | 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)) --- | Import DER-encoded public key. +-- | 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) -> 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 + unsafeUseByteString bs $ \(input, len) -> + (fmap . fmap) PubKey . withOutput 64 $ \pub_key -> + isSuccess <$> ecPubKeyParse ctx pub_key input len --- | Encode public key as DER. First argument 'True' for compressed output. +-- | 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 -> - unsafeUseByteString in_bs $ \(in_ptr, _) -> + useFixedByteString "PubKey" 64 in_bs $ \(in_ptr, _) -> alloca $ \len_ptr -> allocaBytes len $ \out_ptr -> do poke len_ptr $ fromIntegral len @@ -242,57 +444,53 @@ final_len <- peek len_ptr packByteString (out_ptr, final_len) where - len = if compress then 33 else 65 + 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 -> - 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 + 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_sig) = +importCompactSig (Ctx fctx) (CompactSig compact) = do + guard (hasNonZeroComponents compact) unsafePerformIO $ withForeignPtr fctx $ \ctx -> - 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 + useFixedByteString "CompactSig" 64 compact $ \(compact_ptr, _) -> + (fmap . fmap) Sig . withOutput 64 $ \out_sig -> + isSuccess <$> ecdsaSignatureParseCompact ctx out_sig compact_ptr --- | Import DER-encoded signature. +-- | 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 fctx) bs +importSig ctx@(Ctx fctx) bs | BS.null bs = Nothing - | otherwise = - unsafePerformIO $ withForeignPtr fctx $ \ctx -> - 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 + | 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 --- | Encode signature as strict DER. +-- | 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 -> - unsafeUseByteString in_sig $ \(in_ptr, _) -> + useFixedByteString "Sig" 64 in_sig $ \(in_ptr, _) -> alloca $ \out_len -> allocaBytes 72 $ \out_ptr -> do poke out_len 72 @@ -301,135 +499,314 @@ final_len <- peek out_len packByteString (out_ptr, final_len) --- | Verify message signature. 'True' means that the signature is correct. +-- | 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. verifySig :: Ctx -> PubKey -> Sig -> Msg -> Bool -verifySig (Ctx fctx) (PubKey pub_key) (Sig sig) (Msg m) = +verifySig (Ctx fctx) (PubKey pub_key) (Sig sig_bs) (Msg m) = unsafePerformIO $ withForeignPtr fctx $ \ctx -> - unsafeUseByteString pub_key $ \(pub_key_ptr, _) -> - unsafeUseByteString sig $ \(sig_ptr, _) -> - unsafeUseByteString m $ \(msg_ptr, _) -> + 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. signMsg :: Ctx -> SecKey -> Msg -> Sig -signMsg (Ctx fctx) (SecKey sec_key) (Msg m) = +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 -> - 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) + 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. +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. derivePubKey :: Ctx -> SecKey -> PubKey derivePubKey (Ctx fctx) (SecKey sec_key) = unsafePerformIO $ withForeignPtr fctx $ \ctx -> - 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) + 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 tweak to secret key. +-- | 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. tweakAddSecKey :: Ctx -> SecKey -> Tweak -> Maybe SecKey tweakAddSecKey (Ctx fctx) (SecKey sec_key) (Tweak t) = unsafePerformIO $ withForeignPtr fctx $ \ctx -> - 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 + 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 secret key by tweak. +-- | 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 -> - 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 + 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 tweak to public key. Tweak is multiplied first by G to obtain a point. +-- | 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 -> - 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 + 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 public key by tweak. Tweak is multiplied first by G to obtain a --- point. +-- | 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 -> - 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 + 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 multiple public keys together. +-- | 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 = - unsafePerformIO $ withForeignPtr fctx $ \ctx -> - 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 +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 - pointers ps [] f = f ps - pointers ps (PubKey pub_key : pub_keys) f = - unsafeUseByteString pub_key $ \(p, _) -> - pointers (p : ps) pub_keys f + -- 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) = +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 -> - unsafeUseByteString new $ \(out, _) -> do - ret <- ecTweakNegate ctx out - if isSuccess ret - then return (Just (Tweak new)) - else return Nothing + 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 - new = BS.copy t + 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 = gen_msg + arbitrary = fromJust <$> (gen `suchThat` isJust) where - valid_bs = bs_gen `suchThat` isJust - bs_gen = msg . BS.pack <$> replicateM 32 arbitraryBoundedRandom - gen_msg = fromJust <$> valid_bs + gen = msg . BS.pack <$> replicateM 32 arbitraryBoundedRandom instance Arbitrary SecKey where - arbitrary = gen_key + arbitrary = fromJust <$> (gen `suchThat` isJust) where - valid_bs = bs_gen `suchThat` isJust - bs_gen = secKey . BS.pack <$> replicateM 32 arbitraryBoundedRandom - gen_key = fromJust <$> valid_bs + gen = secKey . BS.pack <$> replicateM 32 arbitraryBoundedRandom + +instance Arbitrary Tweak where + arbitrary = fromJust <$> (gen `suchThat` isJust) + where + gen = tweak . BS.pack <$> replicateM 32 arbitraryBoundedRandom diff --git a/src/Crypto/Secp256k1/Internal/BaseOps.hs b/src/Crypto/Secp256k1/Internal/BaseOps.hs --- a/src/Crypto/Secp256k1/Internal/BaseOps.hs +++ b/src/Crypto/Secp256k1/Internal/BaseOps.hs @@ -1,17 +1,20 @@ module Crypto.Secp256k1.Internal.BaseOps where import Crypto.Secp256k1.Internal.ForeignTypes - ( Compact64, + ( AuxRand32, + Compact64, + KeyPair96, LCtx, Msg32, NonceFun, PubKey64, Ret, + SchnorrSig64, SecKey32, - Seed32, SerFlags, Sig64, Tweak32, + XOnlyPubKey64, ) import Foreign (FunPtr, Ptr) import Foreign.C @@ -130,7 +133,7 @@ Ptr Tweak32 -> IO Ret -foreign import ccall unsafe "secp256k1.h secp256k1_ec_pubkey_tweak_add" +foreign import ccall safe "secp256k1.h secp256k1_ec_pubkey_tweak_add" ecPubKeyTweakAdd :: Ptr LCtx -> Ptr PubKey64 -> @@ -159,5 +162,85 @@ -- | pointer to array of public keys Ptr (Ptr PubKey64) -> -- | number of public keys - CInt -> + CSize -> + IO Ret + +-- The following functions belong to the @extrakeys@ and @schnorrsig@ modules +-- of libsecp256k1, enabled by default since version 0.2.0. + +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 + +foreign import ccall safe "secp256k1_extrakeys.h secp256k1_xonly_pubkey_serialize" + xOnlyPubKeySerialize :: + Ptr LCtx -> + -- | 32-byte output + Ptr CUChar -> + Ptr XOnlyPubKey64 -> + IO Ret + +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 + +foreign import ccall safe "secp256k1_extrakeys.h secp256k1_keypair_create" + keyPairCreate :: + Ptr LCtx -> + Ptr KeyPair96 -> + Ptr SecKey32 -> + IO Ret + +foreign import ccall safe "secp256k1_extrakeys.h secp256k1_keypair_sec" + keyPairSec :: + Ptr LCtx -> + Ptr SecKey32 -> + Ptr KeyPair96 -> + IO Ret + +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 + +foreign import ccall safe "secp256k1_extrakeys.h secp256k1_keypair_xonly_tweak_add" + keyPairXOnlyTweakAdd :: + Ptr LCtx -> + Ptr KeyPair96 -> + Ptr Tweak32 -> + IO Ret + +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 + +foreign import ccall safe "secp256k1_schnorrsig.h secp256k1_schnorrsig_verify" + schnorrSigVerify :: + Ptr LCtx -> + Ptr SchnorrSig64 -> + -- | message + Ptr CUChar -> + -- | message length + CSize -> + Ptr XOnlyPubKey64 -> IO Ret diff --git a/src/Crypto/Secp256k1/Internal/Context.hs b/src/Crypto/Secp256k1/Internal/Context.hs --- a/src/Crypto/Secp256k1/Internal/Context.hs +++ b/src/Crypto/Secp256k1/Internal/Context.hs @@ -1,7 +1,12 @@ {-# 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 (bracket, mask_) +import Control.Exception (mask_) import Control.Monad (unless) import Crypto.Secp256k1.Internal.ForeignTypes ( CtxFlags, @@ -11,48 +16,95 @@ isSuccess, ) import Crypto.Secp256k1.Internal.Util (withRandomSeed) -import Foreign (FunPtr, Ptr) +import Foreign (FunPtr, Ptr, nullPtr) import Foreign.C (CInt (..), CString, CUInt (..)) import Foreign.ForeignPtr - ( FinalizerPtr, - ForeignPtr, - finalizeForeignPtr, + ( ForeignPtr, newForeignPtr, withForeignPtr, ) -import GHC.Conc (writeTVar) 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_ $ do - pctx <- contextCreate signVerify - Ctx <$> newForeignPtr contextDestroyFunPtr pctx + 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_ $ do - ctx' <- contextClone ctx - Ctx <$> newForeignPtr contextDestroyFunPtr ctx' + 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 @@ -71,6 +123,9 @@ foreign import ccall safe "secp256k1.h &secp256k1_context_destroy" contextDestroyFunPtr :: FunPtr (Ptr LCtx -> IO ()) + +foreign import ccall safe "&secp256k1_haskell_illegal_callback" + illegalCallbackFunPtr :: FunPtr (CString -> Ptr a -> IO ()) foreign import ccall safe "secp256k1.h secp256k1_context_set_illegal_callback" setIllegalCallback :: diff --git a/src/Crypto/Secp256k1/Internal/ForeignTypes.hs b/src/Crypto/Secp256k1/Internal/ForeignTypes.hs --- a/src/Crypto/Secp256k1/Internal/ForeignTypes.hs +++ b/src/Crypto/Secp256k1/Internal/ForeignTypes.hs @@ -21,6 +21,14 @@ data RecSig65 +data XOnlyPubKey64 + +data KeyPair96 + +data SchnorrSig64 + +data AuxRand32 + type CtxFlags = CUInt type SerFlags = CUInt diff --git a/src/Crypto/Secp256k1/Internal/Recovery.hs b/src/Crypto/Secp256k1/Internal/Recovery.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Secp256k1/Internal/Recovery.hs @@ -0,0 +1,228 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE NoFieldSelectors #-} + +-- | Internal module. Everything is exported, including the raw 'RecSig' +-- constructor that "Crypto.Secp256k1.Recovery" hides, and there is no API +-- stability guarantee. This module is only built when the @recovery@ flag of +-- the package is on. +-- +-- A 'RecSig' built with the raw constructor skips validation. Every function +-- here still checks the length of its bytes before calling the C library and +-- raises an 'Control.Exception.ErrorCall' when the length is wrong, but it +-- does not check the content. A raw 'RecSig' with invalid content makes +-- functions return 'Nothing', a value that does not verify, or throw, never +-- abort or read outside a buffer. +module Crypto.Secp256k1.Internal.Recovery where + +import Control.DeepSeq (NFData) +import Control.Monad (guard, (<=<)) +import Crypto.Secp256k1.Internal.Base + ( CompactSig (..), + Msg (..), + PubKey (..), + SecKey (..), + Sig (..), + hasNonZeroComponents, + ) +import Crypto.Secp256k1.Internal.Context (Ctx (..), validationContext) +import Crypto.Secp256k1.Internal.ForeignTypes (isSuccess) +import Crypto.Secp256k1.Internal.RecoveryOps + ( ecdsaRecover, + ecdsaRecoverableSignatureConvert, + ecdsaRecoverableSignatureParseCompact, + ecdsaRecoverableSignatureSerializeCompact, + ecdsaSignRecoverable, + ) +import Crypto.Secp256k1.Internal.Util + ( decodeHex, + packByteString, + showsHex, + unsafeUseByteString, + useFixedByteString, + withOutput, + ) +import Data.ByteString (ByteString) +import Data.ByteString qualified as BS +import Data.Hashable (Hashable) +import Data.Maybe (fromMaybe) +import Data.String (IsString (..)) +import Data.Word (Word8) +import Foreign (alloca, allocaBytes, nullFunPtr, nullPtr, peek, withForeignPtr) +import GHC.Generics (Generic) +import System.IO.Unsafe (unsafePerformIO) +import Text.Read + ( Lexeme (String), + lexP, + parens, + pfail, + readPrec, + ) + +-- | ECDSA signature with a recovery id, in the internal representation of +-- libsecp256k1 (65 bytes). A valid 'RecSig' has both components in the range +-- 1 to n−1, where n is the order of the curve, and a recovery id of 0 to 3. +-- +-- The bytes in @get@ are opaque. They are not a standard encoding, and they +-- are not portable between platforms or library versions. Use +-- 'exportCompactRecSig' to serialize a signature and 'importCompactRecSig' to +-- parse one. 'recSig' only exists to rebuild a signature from the bytes of +-- @get@ on the same platform. +-- +-- 'Show', 'Read' and 'IsString' use hex of the 65-byte encoding that +-- 'exportCompactRecSig' gives: r and s as 32-byte big-endian numbers, then +-- the recovery id as one byte. +newtype RecSig = RecSig {get :: ByteString} + deriving (Eq, Generic, Hashable, NFData) + +instance Read RecSig where + readPrec = parens $ do + String str <- lexP + maybe pfail return $ recSigFromEncoding =<< decodeHex str + +instance IsString RecSig where + fromString = fromMaybe e . (recSigFromEncoding <=< decodeHex) + where + e = error "Could not decode recoverable signature from hex string" + +instance Show RecSig where + showsPrec _ = showsHex . recSigToEncoding + +-- | The 65-byte encoding of a signature: the compact encoding of r and s, +-- then the recovery id as one byte. Used by the 'Show' instance. +recSigToEncoding :: RecSig -> ByteString +recSigToEncoding rs = compact.get `BS.snoc` rec_id + where + (compact, rec_id) = exportCompactRecSig validationContext rs + +-- | Parse the 65-byte encoding of 'recSigToEncoding' without a +-- caller-provided context. Used by the 'Read' and 'IsString' instances. +recSigFromEncoding :: ByteString -> Maybe RecSig +recSigFromEncoding bs = do + guard (BS.length bs == 65) + importCompactRecSig validationContext (CompactSig (BS.take 64 bs)) (BS.last bs) + +-- | Import a recoverable signature from the bytes of its internal +-- representation, as found in the @get@ field of a 'RecSig' on the same +-- platform. 'Nothing' unless the bytes are the canonical representation of a +-- signature whose components are both in the range 1 to n−1, with a recovery +-- id of 0 to 3. Signatures from other sources go through +-- 'importCompactRecSig'. +recSig :: ByteString -> Maybe RecSig +recSig bs + | isCanonicalRecSig bs = Just (RecSig bs) + | otherwise = Nothing + +-- | Serialize the internal bytes to the compact encoding and the id, parse +-- those back and compare, as 'Crypto.Secp256k1.Internal.Base.isCanonicalSig' +-- does. Parsing checks that both components are below the curve order and +-- that the id is 0 to 3. Comparing the bytes rejects non-canonical forms, so +-- that each signature has one representation and 'Eq' is meaningful. Zero +-- components are rejected too, so that 'convertRecSig' always gives a valid +-- 'Sig'. +isCanonicalRecSig :: ByteString -> Bool +isCanonicalRecSig bs = + BS.length bs == 65 + && unsafePerformIO + ( withForeignPtr fctx $ \ctx -> + unsafeUseByteString bs $ \(rec_sig_ptr, _) -> + allocaBytes 64 $ \compact_ptr -> + alloca $ \rec_id_ptr -> do + ret <- + ecdsaRecoverableSignatureSerializeCompact + ctx + compact_ptr + rec_id_ptr + rec_sig_ptr + if not (isSuccess ret) + then return False + else do + rec_id <- peek rec_id_ptr + compact <- packByteString (compact_ptr, 64) + parsed <- withOutput 65 $ \out -> + isSuccess + <$> ecdsaRecoverableSignatureParseCompact ctx out compact_ptr rec_id + return (parsed == Just bs && hasNonZeroComponents compact) + ) + where + Ctx fctx = validationContext + +-- | Sign a message hash and keep the recovery id. The nonce comes from RFC +-- 6979, so the same key and hash always give the same signature, and r and s +-- are those of 'Crypto.Secp256k1.signMsg', in lower-S form. There is no low-R +-- grinding. Bitcoin Core does not grind when it signs a message with +-- @SignCompact@ either, so the signatures are the same as Bitcoin Core's. +signRecMsg :: Ctx -> SecKey -> Msg -> RecSig +signRecMsg (Ctx fctx) (SecKey sec_key) (Msg m) = + unsafePerformIO $ withForeignPtr fctx $ \ctx -> + useFixedByteString "SecKey" 32 sec_key $ \(sec_key_ptr, _) -> + useFixedByteString "Msg" 32 m $ \(msg_ptr, _) -> do + -- A null nonce function selects the RFC 6979 default. + out <- withOutput 65 $ \rec_sig_ptr -> + isSuccess + <$> ecdsaSignRecoverable ctx rec_sig_ptr msg_ptr sec_key_ptr nullFunPtr nullPtr + maybe (error "could not sign message") (return . RecSig) out + +-- | The public key that made a signature of a message hash. 'Nothing' when no +-- key comes out: no point has the x coordinate that r and the recovery id +-- give, or the computation reaches the point at infinity. +-- +-- A key that comes out verifies the signature for the hash, except for the +-- lower-S rule, which recovery does not apply: the high-S form of a +-- signature, with the parity bit of its recovery id flipped, recovers the +-- same key. Bitcoin Core accepts such message signatures too. Where the rule +-- matters, check 'Crypto.Secp256k1.isLowS' on 'convertRecSig'. The hash is +-- reduced modulo the curve order, as 'Crypto.Secp256k1.verifySig' does. +recover :: Ctx -> RecSig -> Msg -> Maybe PubKey +recover (Ctx fctx) (RecSig rec_sig) (Msg m) = + unsafePerformIO $ withForeignPtr fctx $ \ctx -> + useFixedByteString "RecSig" 65 rec_sig $ \(rec_sig_ptr, _) -> + useFixedByteString "Msg" 32 m $ \(msg_ptr, _) -> + (fmap . fmap) PubKey . withOutput 64 $ \pub_key_ptr -> + isSuccess <$> ecdsaRecover ctx pub_key_ptr rec_sig_ptr msg_ptr + +-- | The signature without its recovery id. For a signature from +-- 'signRecMsg', this is the signature that 'Crypto.Secp256k1.signMsg' gives. +convertRecSig :: Ctx -> RecSig -> Sig +convertRecSig (Ctx fctx) (RecSig rec_sig) = + unsafePerformIO $ withForeignPtr fctx $ \ctx -> + useFixedByteString "RecSig" 65 rec_sig $ \(rec_sig_ptr, _) -> do + out <- withOutput 64 $ \sig_ptr -> + isSuccess <$> ecdsaRecoverableSignatureConvert ctx sig_ptr rec_sig_ptr + maybe (error "could not convert recoverable signature") (return . Sig) out + +-- | Parse a signature from the compact encoding and its recovery id. +-- 'Nothing' unless both components are in the range 1 to n−1 and the id is 0 +-- to 3. The signature may be in high-S form. +importCompactRecSig :: Ctx -> CompactSig -> Word8 -> Maybe RecSig +importCompactRecSig (Ctx fctx) (CompactSig compact) rec_id = do + guard (rec_id <= 3) + -- libsecp256k1 accepts a zero component here and only refuses it in + -- 'recover'. It is rejected here so that 'convertRecSig' always gives a + -- valid 'Sig', as 'Crypto.Secp256k1.importCompactSig' does. + guard (hasNonZeroComponents compact) + unsafePerformIO $ withForeignPtr fctx $ \ctx -> + useFixedByteString "CompactSig" 64 compact $ \(compact_ptr, _) -> + (fmap . fmap) RecSig . withOutput 65 $ \out -> + isSuccess + <$> ecdsaRecoverableSignatureParseCompact ctx out compact_ptr (fromIntegral rec_id) + +-- | Serialize a signature to the compact encoding and its recovery id. The +-- header byte of a Bitcoin signed message is 27 plus the id, plus 4 for a +-- compressed key, which the caller adds. +exportCompactRecSig :: Ctx -> RecSig -> (CompactSig, Word8) +exportCompactRecSig (Ctx fctx) (RecSig rec_sig) = + unsafePerformIO $ withForeignPtr fctx $ \ctx -> + useFixedByteString "RecSig" 65 rec_sig $ \(rec_sig_ptr, _) -> + alloca $ \rec_id_ptr -> do + out <- withOutput 64 $ \compact_ptr -> + isSuccess + <$> ecdsaRecoverableSignatureSerializeCompact ctx compact_ptr rec_id_ptr rec_sig_ptr + case out of + Nothing -> error "could not serialize recoverable signature" + Just compact -> do + rec_id <- peek rec_id_ptr + return (CompactSig compact, fromIntegral rec_id) diff --git a/src/Crypto/Secp256k1/Internal/RecoveryOps.hs b/src/Crypto/Secp256k1/Internal/RecoveryOps.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Secp256k1/Internal/RecoveryOps.hs @@ -0,0 +1,65 @@ +-- | 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 (..)) + +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 + +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 + +foreign import ccall safe "secp256k1_recovery.h secp256k1_ecdsa_recoverable_signature_convert" + ecdsaRecoverableSignatureConvert :: + Ptr LCtx -> + -- | output + Ptr Sig64 -> + -- | input + Ptr RecSig65 -> + IO Ret + +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 + +foreign import ccall safe "secp256k1_recovery.h secp256k1_ecdsa_recover" + ecdsaRecover :: + Ptr LCtx -> + Ptr PubKey64 -> + Ptr RecSig65 -> + Ptr Msg32 -> + IO Ret diff --git a/src/Crypto/Secp256k1/Internal/Util.hs b/src/Crypto/Secp256k1/Internal/Util.hs --- a/src/Crypto/Secp256k1/Internal/Util.hs +++ b/src/Crypto/Secp256k1/Internal/Util.hs @@ -2,6 +2,7 @@ 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) @@ -9,7 +10,7 @@ import Data.ByteString.Base16 (decodeBase16, encodeBase16, parseBase16) import qualified Data.ByteString.Unsafe as BU import Data.String.Conversions (ConvertibleStrings, cs) -import Foreign (Ptr, castPtr) +import Foreign (Ptr, castPtr, copyBytes, free, mallocBytes) import Foreign.C (CSize (..)) import System.Entropy (getEntropy) @@ -31,6 +32,55 @@ 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 unsafePackByteString :: (Ptr a, CSize) -> IO ByteString unsafePackByteString (b, l) = diff --git a/src/Crypto/Secp256k1/Recovery.hs b/src/Crypto/Secp256k1/Recovery.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Secp256k1/Recovery.hs @@ -0,0 +1,72 @@ +-- | ECDSA public key recovery, through the @recovery@ module of +-- . +-- +-- Up to four public keys verify a given ECDSA signature (r, s) of a hash. A +-- recovery id of 0 to 3 says which one: R is the point whose x coordinate is +-- r, or r + n for the ids 2 and 3, and whose y coordinate is even for the +-- ids 0 and 2 and odd for 1 and 3. The key is then Q = r⁻¹(s·R − e·G), where +-- e is the hash as a number. 'signRecMsg' signs and keeps the id, and +-- 'recover' computes the key from a signature, its id and the hash. +-- +-- Bitcoin signed messages use this: a signature is 65 bytes, a header byte +-- followed by r and s, and the verifier recovers the key and compares its +-- address with the one given. The header byte is 27 plus the id, plus 4 for +-- a compressed key, and BIP 137 adds 8 or 12 more for a SegWit address. +-- 'exportCompactRecSig' and 'importCompactRecSig' convert between a 'RecSig' +-- and the r‖s bytes with the id; the header byte itself is left to the +-- caller. +-- +-- == Relation to the ECDSA functions +-- +-- 'signRecMsg' uses the same RFC 6979 nonce as 'Crypto.Secp256k1.signMsg', +-- so 'convertRecSig' of its result is the signature that +-- 'Crypto.Secp256k1.signMsg' gives, in lower-S form. There is no low-R +-- grinding, and Bitcoin Core does not grind either when it signs a message, +-- so message signatures are byte for byte the same as Bitcoin Core's. +-- +-- 'recover' does not apply the lower-S rule of 'Crypto.Secp256k1.verifySig'. +-- The high-S form of a signature, with the parity bit of its id flipped, +-- recovers the same key, and Bitcoin Core accepts such message signatures +-- too. Where the rule matters, check 'Crypto.Secp256k1.isLowS' on +-- 'convertRecSig'. +-- +-- The ids 2 and 3 only come out of 'signRecMsg' when r is below p − n, which +-- happens for about one signature in 2^128. 'importCompactRecSig' accepts +-- them and 'recover' handles them. +-- +-- == The recovery module of libsecp256k1 +-- +-- libsecp256k1 only has this module when it was built with +-- @--enable-module-recovery@, or @SECP256K1_ENABLE_MODULE_RECOVERY=ON@ with +-- CMake. That is off by default upstream, but on in the libraries that +-- Debian, Ubuntu, Fedora, Arch, Alpine, openSUSE, Homebrew and Nixpkgs ship. +-- This package binds it when its @recovery@ flag is on, which is the +-- default. With a library built without the module, the first program to +-- link fails with an undefined reference to @secp256k1_ecdsa_recover@. Build +-- the package with @-f -recovery@ then, and this module is not available. +-- +-- == Values +-- +-- 'RecSig' is built through 'signRecMsg', 'importCompactRecSig' or 'recSig', +-- which validate it, so a 'RecSig' always has both components in the range 1 +-- to n−1 and an id of 0 to 3. Its @get@ field gives the internal +-- representation of libsecp256k1, which is opaque and not portable. 'Show', +-- 'Read' and 'Data.String.IsString' use hex of r and s as 32-byte big-endian +-- numbers followed by the id as one byte. The raw constructor is in +-- "Crypto.Secp256k1.Internal.Recovery", which has no API stability +-- guarantee. +module Crypto.Secp256k1.Recovery + ( -- * Recoverable signatures + RecSig (get), + recSig, + signRecMsg, + recover, + convertRecSig, + + -- ** Compact + importCompactRecSig, + exportCompactRecSig, + ) +where + +import Crypto.Secp256k1.Internal.Recovery diff --git a/test/Crypto/Secp256k1/Fixtures.hs b/test/Crypto/Secp256k1/Fixtures.hs new file mode 100644 --- /dev/null +++ b/test/Crypto/Secp256k1/Fixtures.hs @@ -0,0 +1,128 @@ +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Fixtures and helpers shared by the specifications. +module Crypto.Secp256k1.Fixtures where + +import Crypto.Secp256k1 +import Data.Base16.Types (assertBase16, extractBase16) +import Data.ByteString qualified as BS +import Data.ByteString.Base16 (decodeBase16, encodeBase16') +import Data.ByteString.Char8 qualified as B8 +import Data.Maybe (fromJust) +import Data.String (fromString) + +-- * Fixtures +-- +-- Every expected value is a literal from an independent source: the secp256k1 +-- generator, the RFC 6979 vector for key 1 and sha256 "Satoshi Nakamoto", +-- Bitcoin Core's key_tests.cpp, or this package's historical vectors, all +-- recomputed with an independent implementation of the curve. + +zero, one, order, orderMinusOne, orderPlusOne, allOnes :: String +zero = "0000000000000000000000000000000000000000000000000000000000000000" +one = "0000000000000000000000000000000000000000000000000000000000000001" +order = "fffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364141" +orderMinusOne = "fffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364140" +orderPlusOne = "fffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364142" +allOnes = "ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff" + +-- Secret key 1. Its public key is the generator G. +keyOne :: SecKey +keyOne = fromString one + +-- The generator G in its three SEC1 encodings. y is even, so the compressed +-- prefix is 02 and the hybrid prefix is 06. +genCompressed, genUncompressed, genHybrid :: String +genCompressed = + "0279be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798" +genUncompressed = + "0479be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798\ + \483ada7726a3c4655da4fbfc0e1108a8fd17b448a68554199c47d08ffb10d4b8" +genHybrid = + "0679be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798\ + \483ada7726a3c4655da4fbfc0e1108a8fd17b448a68554199c47d08ffb10d4b8" + +-- RFC 6979 vector: key 1 signing sha256 "Satoshi Nakamoto". +satoshiMsg :: Msg +satoshiMsg = "a0dc65ffca799873cbea0ac274015b9526505daaaed385155425f7337704883e" + +satoshiR, satoshiS, satoshiHighS :: String +satoshiR = "934b1ea10a4b3c1757e2b0c017d0b6143ce3c9a7e6a4a49860d7a6ab210ee3d8" +satoshiS = "2442ce9d2b916064108014783e923ec36b49743e2ffa1c4496f01a512aafd9e5" +-- n - s +satoshiHighS = "dbbd3162d46e9f9bef7feb87c16dc13b4f6568a87f4e83f728e2443ba586675c" + +satoshiDer :: String +satoshiDer = "3045022100" ++ satoshiR ++ "0220" ++ satoshiS + +-- Bitcoin Core key_tests.cpp: the secret key of WIF +-- 5HxWvvfubhXpYYpS3tJkw6fq9jE9j18THftkZjHHfmFiWtmAbrj signing +-- sha256d "Very deterministic message". +coreKey :: SecKey +coreKey = "12b004fff7f4b69ef8650e767f18f11ede158148b425660723b9f9a66e61f747" + +coreMsg :: Msg +coreMsg = "5255683da567900bfd3e786ed8836a4e7763c221bf1ac20ece2a5171b9199e8a" + +coreDer :: String +coreDer = + "304402205dbbddda71772d95ce91cd2d14b592cfbc1dd0aabd6a394b6c2d377bbe59d31d\ + \022014ddda21494a4e221f0824f0b8b924c43fa43c0ad57dccdaa11f81a6bd4582f6" + +-- Key 1 signing sha256 "4". Plain RFC 6979 gives a high r (first byte d4), +-- so Bitcoin Core's grinding retries once with counter 1 as extra nonce data. +highRMsg :: Msg +highRMsg = "4b227777d4dd1fc61c6f884f48641d02b4d121d3fd328cb08b5531fcacdabf8a" + +highRDer, groundDer :: String +highRDer = + "3045022100d479c93a086bf5f4ae1fed7eaf2604a4da2007d851c5409961c81dd7f0600194\ + \02201cd7a196454152f5b8d19865d49b4fa71e314ebff9c59e2f7b2295bf80331be8" +groundDer = + "3044022020b11f7066dd4486e811ea4f1fee43b1538fcd5bedb64b52d01e56b13422430c\ + \022056cb81320c8439cee666af08788c08e60fda80216a25f52b38714191c8cd1b99" + +-- Key 1 signing sha256 "1". Plain RFC 6979 already gives a low r. +lowRMsg :: Msg +lowRMsg = "6b86b273ff34fce19d6b804eff5a3f5747ada4eaa22f1d49c01e52ddb7875b4b" + +lowRDer :: String +lowRDer = + "304402202d24f8d536fccf696a4edfa858e5d6fc89a11d25f72ef4f89de1577d53643c0a\ + \02200d25586b118d5d7f8b79a7805c885fa8588dfa9e6cc777edc11a7e33de844285" + +-- Historical vectors of this package. +histKey :: SecKey +histKey = "f65255094d7773ed8dd417badc9fc045c1f80fdc5b2d25172b031ce6933e039a" + +histTweak :: Tweak +histTweak = "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00" + +histPub :: String +histPub = + "04dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd44705\ + \12213d5ed790522c042dee8e85c4c0ec5f96800b72bc5940c8bc1c5e11e4fcbf" + +-- The field size p of secp256k1. It is not a valid x coordinate. +fieldSize :: String +fieldSize = "fffffffffffffffffffffffffffffffffffffffffffffffffffffffefffffc2f" + +-- * Helpers + +hexToBytes :: String -> BS.ByteString +hexToBytes = decodeBase16 . assertBase16 . B8.pack + +bytesToHex :: BS.ByteString -> String +bytesToHex = B8.unpack . extractBase16 . encodeBase16' + +showRead :: (Show a, Read a, Eq a) => a -> Bool +showRead x = read (show x) == x + +-- The hex literal, quoted the way 'show' quotes a string. +quoted :: String -> String +quoted s = "\"" ++ s ++ "\"" + +-- The negation of a public key: multiplication by n - 1. +negatePubKey :: Ctx -> PubKey -> PubKey +negatePubKey ctx p = fromJust (tweakMulPubKey ctx p (fromString orderMinusOne)) diff --git a/test/Crypto/Secp256k1/InternalSpec.hs b/test/Crypto/Secp256k1/InternalSpec.hs --- a/test/Crypto/Secp256k1/InternalSpec.hs +++ b/test/Crypto/Secp256k1/InternalSpec.hs @@ -19,7 +19,7 @@ import Data.ByteString.Base16 (decodeBase16) import Foreign import System.Entropy -import Test.HUnit (Assertion, assertBool, assertEqual, assertFailure) +import Test.HUnit (Assertion, assertBool, assertEqual) import Test.Hspec spec :: Spec @@ -348,7 +348,7 @@ ret <- ecPubKeyTweakAdd x p w tweaked <- serializeKey x p return (ret, tweaked) - assertBool "successful secret key tweak" $ isSuccess ret + assertBool "successful public key tweak" $ isSuccess ret assertEqual "tweaked keys match" expected tweaked where pub = @@ -376,7 +376,7 @@ ret <- ecPubKeyTweakMul x p w tweaked <- serializeKey x p return (ret, tweaked) - assertBool "successful secret key tweak" $ isSuccess ret + assertBool "successful public key tweak" $ isSuccess ret assertEqual "tweaked keys match" expected tweaked where pub = diff --git a/test/Crypto/Secp256k1/RecoverySpec.hs b/test/Crypto/Secp256k1/RecoverySpec.hs new file mode 100644 --- /dev/null +++ b/test/Crypto/Secp256k1/RecoverySpec.hs @@ -0,0 +1,334 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | ECDSA public key recovery. The module under test only exists when the +-- @recovery@ flag of the package is on, so the whole specification is behind +-- the same flag. This module avoids string gaps, because CPP would join +-- their lines. +module Crypto.Secp256k1.RecoverySpec (spec) where + +import Test.Hspec + +#ifdef RECOVERY + +import Control.DeepSeq (deepseq) +import Control.Exception (evaluate) +import Control.Monad (forM_) +import Control.Monad.Par qualified as P +import Crypto.Secp256k1 +import Crypto.Secp256k1.Fixtures +import Crypto.Secp256k1.Internal.Base (CompactSig (CompactSig), Msg (Msg), SecKey (SecKey)) +import Crypto.Secp256k1.Internal.Recovery (RecSig (RecSig)) +import Crypto.Secp256k1.Recovery +import Data.Bits (xor) +import Data.ByteString qualified as BS +import Data.Hashable (hash) +import Data.Maybe (fromJust, isJust) +import Data.String (fromString) +import Data.Word (Word8) +import Test.QuickCheck +import Text.Read (readMaybe) + +spec :: Spec +spec = around withContext $ describe "public key recovery" $ do + signingSpec + recoverySpec + formulaSpec + compactSpec + valueSpec + rawValueSpec + instanceSpec + +-- * Fixtures +-- +-- As in "Crypto.Secp256k1.Fixtures", every expected value is a literal from +-- an independent source, recomputed with an independent implementation of +-- the curve. + +-- Bitcoin Core key_tests.cpp: the SignCompact signature of coreKey over +-- coreMsg is 20 ++ coreR ++ coreS. The header byte 0x20 = 32 = 27 + 1 + 4 +-- says recovery id 1 and a compressed key. coreDer is 30440220 ++ coreR ++ +-- 0220 ++ coreS. +coreR, coreS :: String +coreR = "5dbbddda71772d95ce91cd2d14b592cfbc1dd0aabd6a394b6c2d377bbe59d31d" +coreS = "14ddda21494a4e221f0824f0b8b924c43fa43c0ad57dccdaa11f81a6bd4582f6" + +coreRecId :: Word8 +coreRecId = 1 + +-- The compressed public key of coreKey, and the key that recovery id 0 gives +-- for the same signature. +corePub, coreOtherPub :: String +corePub = "030b4c866585dd868a9d62348a9cd008d6a312937048fff31670e7e920cfc7a744" +coreOtherPub = "02818f8ef9ebd82871789a39ea0385398c267d3d6bb6f537166bd813135870c8ec" + +-- Bitcoin Core util_tests.cpp, message_sign: the key of the address +-- 15CRxFdyRpGZLW9w8HnHvVduizdL5jKNbs signs the message "Trust no one". +messageKey :: SecKey +messageKey = "d97f5108f11cda6eeebaaa420fef0726b1f898060b98489fa3098463c0032866" + +-- sha256d of the varstrings "Bitcoin Signed Message:\n" and "Trust no one". +messageHash :: Msg +messageHash = "aa8215d723ecd2f14867eeb7e19f192be7bc15a2352a24b991d4f5870cbaf6e8" + +-- The expected signature, base64 +-- IPojfrX2dfPnH26UegfbGQQLrdK844DlHq5157/P6h57WyuS/Qsl+h/WSVGDF4MUi4rWSswW38oimDYfNNUBUOk= +-- decoded: the header byte 0x20, recovery id 1 and a compressed key, then r +-- and s. +messageR, messageS :: String +messageR = "fa237eb5f675f3e71f6e947a07db19040badd2bce380e51eae75e7bfcfea1e7b" +messageS = "5b2b92fd0b25fa1fd64951831783148b8ad64acc16dfca2298361f34d50150e9" + +-- The compressed public key of messageKey. +messagePub :: String +messagePub = "03d2be3dddb497c7c4388cfcb941e14a222cf3e26fe5e2cc260da1821e60d26022" + +-- The RFC 6979 vector has recovery id 1. Recovery id 0 gives this other key. +satoshiOtherPub :: String +satoshiOtherPub = "0354d58835e07b996d6378eafa930ae9d2211e767381f1d52aedc67f48c8886f0b" + +-- Key 1 signing sha256 "4" (highRDer): r, s and recovery id 0. +highRR, highRS :: String +highRR = "d479c93a086bf5f4ae1fed7eaf2604a4da2007d851c5409961c81dd7f0600194" +highRS = "1cd7a196454152f5b8d19865d49b4fa71e314ebff9c59e2f7b2295bf80331be8" + +-- Values for the formula Q = r⁻¹(s·R − e·G). +two, five :: String +two = "0000000000000000000000000000000000000000000000000000000000000002" +-- 5³ + 7 = 132 is not a square modulo p, so no point has x = 5. +five = "0000000000000000000000000000000000000000000000000000000000000005" + +-- x = 1 is on the curve: 1 + 7 = 8 is a square modulo p. pointOne is the +-- point with x = 1 and an even y, so its compressed encoding is 02 ++ one and +-- that of its negation is 03 ++ one. +pointOne, pointOneMinusG, twicePointOne :: String +pointOne = "02" ++ one +pointOneMinusG = "02871e0c836ec675e07395aef58d72b646f77e0e33ce1622dfaa0fb8e131f3fe12" +twicePointOne = "03c7ffffffffffffffffffffffffffffffffffffffffffffffffffffff37fffd03" + +-- x = n + 2 is on the curve, x = n + 1 is not. +orderPlusTwo :: String +orderPlusTwo = "fffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364143" + +-- Half of the point with x = n + 2 and an even y. +halfPointOrderPlusTwo :: String +halfPointOrderPlusTwo = "02ad802f2145df548ce1fc418b851cb32669c5a6bb939e6caf744de90310f8f1ff" + +-- p − n and p − n − 1. With the recovery id 2, the first gives x = p, which +-- is outside the field, and the second x = p − 1, which is not on the curve. +fieldMinusOrder, fieldMinusOrderMinusOne :: String +fieldMinusOrder = "000000000000000000000000000000014551231950b75fc4402da1722fc9baee" +fieldMinusOrderMinusOne = "000000000000000000000000000000014551231950b75fc4402da1722fc9baed" + +-- The x coordinate of G, and the key −(x⁻¹)·G. +genX, genNegatedOverX :: String +genX = drop 2 genCompressed +genNegatedOverX = "028ff83d8cf12121491609c4939dc11c4aa35503508fe432dc5a5c1905608b9218" + +-- * Signing + +signingSpec :: SpecWith Ctx +signingSpec = describe "signing" $ do + it "produces Bitcoin Core's SignCompact signature of sha256d 'Very deterministic message'" $ \ctx -> + exportCompactRecSig ctx (signRecMsg ctx coreKey coreMsg) + `shouldBe` (fromString (coreR ++ coreS), coreRecId) + it "produces Bitcoin Core's signmessage signature of 'Trust no one'" $ \ctx -> + exportCompactRecSig ctx (signRecMsg ctx messageKey messageHash) + `shouldBe` (fromString (messageR ++ messageS), 1) + it "produces the RFC 6979 vector with recovery id 1" $ \ctx -> + exportCompactRecSig ctx (signRecMsg ctx keyOne satoshiMsg) + `shouldBe` (fromString (satoshiR ++ satoshiS), 1) + it "keeps a high r, as Bitcoin Core's message signing does" $ \ctx -> do + exportCompactRecSig ctx (signRecMsg ctx keyOne highRMsg) + `shouldBe` (fromString (highRR ++ highRS), 0) + convertRecSig ctx (signRecMsg ctx keyOne highRMsg) `shouldNotBe` signMsgLowR ctx keyOne highRMsg + it "signs with the r and s of signMsg" $ \ctx -> + property $ \(m :: Msg, k :: SecKey) -> convertRecSig ctx (signRecMsg ctx k m) == signMsg ctx k m + it "is deterministic" $ \ctx -> + property $ \(m :: Msg, k :: SecKey) -> signRecMsg ctx k m == signRecMsg ctx k m + it "gives a recovery id of 0 or 1" $ \ctx -> + -- The ids 2 and 3 need r below p - n, about one signature in 2^128. + property $ \(m :: Msg, k :: SecKey) -> + snd (exportCompactRecSig ctx (signRecMsg ctx k m)) `elem` [0, 1] + it "produces lower-S signatures" $ \ctx -> + property $ \(m :: Msg, k :: SecKey) -> isLowS ctx (convertRecSig ctx (signRecMsg ctx k m)) + it "signs and recovers in parallel" $ \ctx -> + property $ \(xs :: [(Msg, SecKey)]) -> P.runPar $ do + results <- mapM (P.spawnP . signsAndRecovers ctx) xs + and <$> mapM P.get results + where + signsAndRecovers ctx (m, k) = + recover ctx (signRecMsg ctx k m) m == Just (derivePubKey ctx k) + +-- * Recovery + +recoverySpec :: SpecWith Ctx +recoverySpec = describe "recovery" $ do + it "recovers the key of Bitcoin Core's SignCompact vector" $ \ctx -> + recovered ctx (coreR ++ coreS ++ "01") coreMsg `shouldBe` Just corePub + it "recovers another key with the other recovery id" $ \ctx -> + recovered ctx (coreR ++ coreS ++ "00") coreMsg `shouldBe` Just coreOtherPub + it "recovers the signer of Bitcoin Core's 'Trust no one' message" $ \ctx -> + recovered ctx (messageR ++ messageS ++ "01") messageHash `shouldBe` Just messagePub + it "recovers G from the RFC 6979 vector" $ \ctx -> do + recovered ctx (satoshiR ++ satoshiS ++ "01") satoshiMsg `shouldBe` Just genCompressed + recovered ctx (satoshiR ++ satoshiS ++ "00") satoshiMsg `shouldBe` Just satoshiOtherPub + it "recovers the signing key" $ \ctx -> + property $ \(m :: Msg, k :: SecKey) -> + recover ctx (signRecMsg ctx k m) m == Just (derivePubKey ctx k) + it "recovers a different key for another message" $ \ctx -> + property $ \(m :: Msg, m' :: Msg, k :: SecKey) -> + m /= m' ==> recover ctx (signRecMsg ctx k m) m' /= Just (derivePubKey ctx k) + it "recovers the same key from the high-S form with the parity bit flipped" $ \ctx -> do + -- The RFC 6979 vector with s replaced by n - s and the id 1 turned into 0. + recovered ctx (satoshiR ++ satoshiHighS ++ "00") satoshiMsg `shouldBe` Just genCompressed + recovered ctx (satoshiR ++ satoshiHighS ++ "01") satoshiMsg `shouldNotBe` Just genCompressed + it "does not apply the lower-S rule" $ \ctx -> + property $ \(m :: Msg, k :: SecKey) -> + let (compact, i) = exportCompactRecSig ctx (signRecMsg ctx k m) + (r, s) = BS.splitAt 32 compact.get + -- n - s, through the negation of a tweak. + highS = (fromJust (tweakNegate ctx (fromJust (tweak s)))).get + high = fromJust (importCompactRecSig ctx (fromJust (compactSig (r <> highS))) (i `xor` 1)) + in recover ctx high m == Just (derivePubKey ctx k) + where + recovered ctx sigHex m = bytesToHex . exportPubKey ctx True <$> recover ctx (fromString sigHex) m + +-- * The formula + +formulaSpec :: SpecWith Ctx +formulaSpec = describe "the formula Q = r⁻¹(s·R − e·G)" $ do + it "gives R itself for r = 1, s = 1 and a zero hash" $ \ctx -> + recovered ctx (one ++ one ++ "00") zero `shouldBe` Just pointOne + it "takes the parity of y from the recovery id" $ \ctx -> + recovered ctx (one ++ one ++ "01") zero `shouldBe` Just ("03" ++ one) + it "reduces the hash modulo n" $ \ctx -> + recovered ctx (one ++ one ++ "00") order `shouldBe` Just pointOne + it "subtracts e·G" $ \ctx -> + recovered ctx (one ++ one ++ "00") one `shouldBe` Just pointOneMinusG + it "multiplies by s" $ \ctx -> do + recovered ctx (one ++ two ++ "00") zero `shouldBe` Just twicePointOne + recovered ctx (one ++ orderMinusOne ++ "00") zero `shouldBe` Just ("03" ++ one) + it "divides by r" $ \ctx -> + recovered ctx (two ++ one ++ "02") zero `shouldBe` Just halfPointOrderPlusTwo + it "uses r + n as the x coordinate for the ids 2 and 3" $ \ctx -> do + recovered ctx (two ++ two ++ "02") zero `shouldBe` Just ("02" ++ orderPlusTwo) + recovered ctx (two ++ two ++ "03") zero `shouldBe` Just ("03" ++ orderPlusTwo) + it "gives nothing when no point has the x coordinate" $ \ctx -> do + recovered ctx (five ++ one ++ "00") zero `shouldBe` Nothing + recovered ctx (one ++ one ++ "02") zero `shouldBe` Nothing + recovered ctx (fieldMinusOrderMinusOne ++ one ++ "02") zero `shouldBe` Nothing + it "gives nothing when r + n reaches the field size" $ \ctx -> + recovered ctx (fieldMinusOrder ++ one ++ "02") zero `shouldBe` Nothing + it "gives nothing when s·R − e·G is the point at infinity" $ \ctx -> do + -- R = G, s = 1 and e = 1: G - G. + recovered ctx (genX ++ one ++ "00") one `shouldBe` Nothing + -- With e = 2 instead: (G - 2G) / x = -(x⁻¹)·G. + recovered ctx (genX ++ one ++ "00") two `shouldBe` Just genNegatedOverX + where + recovered ctx sigHex msgHex = + bytesToHex . exportPubKey ctx True <$> recover ctx (fromString sigHex) (fromString msgHex) + +-- * Compact encoding + +compactSpec :: SpecWith Ctx +compactSpec = describe "compact encoding" $ do + it "imports and exports back the same signature" $ \ctx -> + property $ \(m :: Msg, k :: SecKey) -> + let s = signRecMsg ctx k m + (compact, i) = exportCompactRecSig ctx s + in importCompactRecSig ctx compact i == Just s + it "accepts the recovery ids 0 to 3 and rejects 4 and 255" $ \ctx -> do + forM_ [0 .. 3] $ \i -> importCompactRecSig ctx (fromString (one ++ one)) i `shouldSatisfy` isJust + importCompactRecSig ctx (fromString (one ++ one)) 4 `shouldBe` Nothing + importCompactRecSig ctx (fromString (one ++ one)) 255 `shouldBe` Nothing + it "accepts components of 1 and n - 1 and rejects 0 and n" $ \ctx -> do + importCompactRecSig ctx (fromString (one ++ one)) 0 `shouldSatisfy` isJust + importCompactRecSig ctx (fromString (orderMinusOne ++ orderMinusOne)) 0 `shouldSatisfy` isJust + importCompactRecSig ctx (fromString (order ++ one)) 0 `shouldBe` Nothing + importCompactRecSig ctx (fromString (one ++ order)) 0 `shouldBe` Nothing + importCompactRecSig ctx (fromString (zero ++ one)) 0 `shouldBe` Nothing + importCompactRecSig ctx (fromString (one ++ zero)) 0 `shouldBe` Nothing + it "imports a high-S signature" $ \ctx -> + importCompactRecSig ctx (fromString (satoshiR ++ satoshiHighS)) 0 `shouldSatisfy` isJust + it "converts to the signature without the id" $ \ctx -> do + bytesToHex (exportSig ctx (convertRecSig ctx (fromString (coreR ++ coreS ++ "01")))) `shouldBe` coreDer + convertRecSig ctx (fromString (coreR ++ coreS ++ "00")) + `shouldBe` convertRecSig ctx (fromString (coreR ++ coreS ++ "01")) + it "converts to a signature that verifies" $ \ctx -> + property $ \(m :: Msg, k :: SecKey) -> + verifySig ctx (derivePubKey ctx k) (convertRecSig ctx (signRecMsg ctx k m)) m + +-- * Signature values + +valueSpec :: SpecWith Ctx +valueSpec = describe "signature values" $ do + it "rebuild from their internal bytes" $ \ctx -> + property $ \(m :: Msg, k :: SecKey) -> let s = signRecMsg ctx k m in recSig s.get == Just s + it "reject internal bytes that are not a signature" $ \_ -> do + recSig (BS.replicate 65 0) `shouldBe` Nothing + recSig (BS.replicate 65 0xff) `shouldBe` Nothing + recSig (BS.replicate 64 1) `shouldBe` Nothing + recSig (BS.replicate 66 1) `shouldBe` Nothing + it "reject an internal recovery id above 3" $ \ctx -> do + -- libsecp256k1 keeps the id in the last byte of the representation. + let bytes = (signRecMsg ctx keyOne satoshiMsg).get + recSig (BS.init bytes `BS.snoc` 4) `shouldBe` Nothing + it "show r, s and the recovery id in hex" $ \ctx -> + show (signRecMsg ctx coreKey coreMsg) `shouldBe` quoted (coreR ++ coreS ++ "01") + it "read that encoding" $ \ctx -> do + read (quoted (coreR ++ coreS ++ "01")) `shouldBe` signRecMsg ctx coreKey coreMsg + (fromString (coreR ++ coreS ++ "01") :: RecSig) `shouldBe` signRecMsg ctx coreKey coreMsg + it "show and read" $ \ctx -> + property $ \(m :: Msg, k :: SecKey) -> showRead (signRecMsg ctx k m) + it "do not read an invalid signature" $ \_ -> do + (readMaybe (quoted (coreR ++ coreS)) :: Maybe RecSig) `shouldBe` Nothing + (readMaybe (quoted (coreR ++ coreS ++ "04")) :: Maybe RecSig) `shouldBe` Nothing + (readMaybe (quoted (zero ++ coreS ++ "01")) :: Maybe RecSig) `shouldBe` Nothing + (readMaybe (quoted (order ++ coreS ++ "01")) :: Maybe RecSig) `shouldBe` Nothing + (readMaybe (quoted (coreR ++ coreS ++ "0")) :: Maybe RecSig) `shouldBe` Nothing + evaluate (fromString (coreR ++ coreS) :: RecSig) `shouldThrow` anyErrorCall + +-- * Values built with the raw constructors of the Internal modules + +rawValueSpec :: SpecWith Ctx +rawValueSpec = describe "raw values from the Internal modules" $ do + it "a signature of 65 zero bytes recovers nothing, instead of aborting the process" $ \ctx -> + recover ctx (RecSig (BS.replicate 65 0)) satoshiMsg `shouldBe` Nothing + it "a zero secret key throws instead of signing" $ \ctx -> + evaluate (signRecMsg ctx (SecKey (BS.replicate 32 0)) satoshiMsg) `shouldThrow` anyErrorCall + it "values of the wrong length throw before reaching the library" $ \ctx -> do + evaluate (signRecMsg ctx (SecKey "a") satoshiMsg) `shouldThrow` anyErrorCall + evaluate (signRecMsg ctx keyOne (Msg "a")) `shouldThrow` anyErrorCall + evaluate (recover ctx (RecSig "a") satoshiMsg) `shouldThrow` anyErrorCall + evaluate (recover ctx (signRecMsg ctx keyOne satoshiMsg) (Msg "a")) `shouldThrow` anyErrorCall + evaluate (convertRecSig ctx (RecSig "a")) `shouldThrow` anyErrorCall + evaluate (exportCompactRecSig ctx (RecSig "a")) `shouldThrow` anyErrorCall + evaluate (importCompactRecSig ctx (CompactSig "a") 0) `shouldThrow` anyErrorCall + evaluate (length (show (RecSig "a"))) `shouldThrow` anyErrorCall + +-- * Derived instances + +instanceSpec :: SpecWith Ctx +instanceSpec = describe "derived instances" $ do + it "equal values hash equally, whichever way they were built" $ \ctx -> + property $ \(m :: Msg, k :: SecKey) -> + let s = signRecMsg ctx k m + (compact, i) = exportCompactRecSig ctx s + in hash s == hash (fromJust (importCompactRecSig ctx compact i)) + && hash s == hash (fromJust (recSig s.get)) + it "can be fully evaluated" $ \ctx -> + (signRecMsg ctx keyOne satoshiMsg `deepseq` ()) `shouldBe` () + +#else + +spec :: Spec +spec = + describe "public key recovery" $ + it "needs the recovery flag of the package" $ + pendingWith "the package was built with -f -recovery" + +#endif diff --git a/test/Crypto/Secp256k1Spec.hs b/test/Crypto/Secp256k1Spec.hs --- a/test/Crypto/Secp256k1Spec.hs +++ b/test/Crypto/Secp256k1Spec.hs @@ -1,312 +1,995 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE OverloadedRecordDot #-} - -module Crypto.Secp256k1Spec (spec) where - -import Control.Arrow (first) -import Control.Monad.Par qualified as P -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.Either (fromRight) -import Data.Maybe (fromJust, fromMaybe, isJust, isNothing) -import Data.String (fromString) -import Data.String.Conversions (cs) -import Test.HUnit (Assertion, assertBool, assertEqual) -import Test.Hspec -import Test.QuickCheck - -spec :: Spec -spec = around withContext $ do - describe "signatures" $ do - it "signs message" $ \ctx -> - property $ signMsgTest ctx - it "signs messages in parallel" $ \ctx -> - property $ signMsgParTest ctx - it "detects bad signature" $ \ctx -> - property $ badSignatureTest ctx - it "normalizes signatures" $ \ctx -> - property $ normalizeSigTest ctx - describe "serialization" $ do - it "serializes public key" $ \ctx -> - property $ serializePubKeyTest ctx - it "serializes public keys in parallel" $ \ctx -> - property $ parSerializePubKeyTest ctx - it "serializes DER signature" $ \ctx -> - property $ serializeSigTest ctx - it "serializes DER signatures in parallel" $ \ctx -> - property $ parSerializeSigTest ctx - it "serializes compact signature" $ \ctx -> - property $ serializeCompactSigTest ctx - it "serialize secret key" $ \_ -> - property serializeSecKeyTest - it "shows and reads secret key" $ \_ -> - property (showRead :: SecKey -> Bool) - it "shows and reads tweak" $ \_ -> - property showReadTweak - it "shows and reads message" $ \_ -> - property (showRead :: Msg -> Bool) - it "shows and reads public key" $ \ctx -> - property $ showReadPubKey ctx - it "reads secret key from string" $ \_ -> - property isStringSecKey - it "reads message from string" $ \_ -> - property isStringMsg - it "reads tweak from string" $ \_ -> - property isStringTweak - describe "tweaks" $ do - it "add secret key" $ \ctx -> - property $ tweakAddSecKeyTest ctx - it "multiply secret key" $ \ctx -> - property $ tweakMulSecKeyTest ctx - it "add public key" $ \ctx -> - property $ tweakAddPubKeyTest ctx - it "multiply public key" $ \ctx -> - property $ tweakMulPubKeyTest ctx - it "combine public keys" $ \ctx -> - property $ combinePubKeyTest ctx - it "can't combine 0 public keys" $ \ctx -> - property $ combinePubKeyEmptyListTest ctx - it "negates tweak" $ \ctx -> - property $ negateTweakTest ctx - -hexToBytes :: String -> BS.ByteString -hexToBytes = decodeBase16 . assertBase16 . B8.pack - -isStringMsg :: Msg -> Bool -isStringMsg m = m == fromString (cs m') - where - m' = (extractBase16 . encodeBase16) m.get - -isStringSecKey :: SecKey -> Bool -isStringSecKey k = k == fromString (cs hex) - where - hex = (extractBase16 . encodeBase16) k.get - -isStringTweak :: SecKey -> Bool -isStringTweak k = t == fromString (cs hex) - where - t = (fromMaybe e . tweak) k.get - hex = (extractBase16 . encodeBase16) t.get - e = error "Could not extract tweak from secret key" - -showReadTweak :: SecKey -> Bool -showReadTweak k = showRead t - where - t = tweak k.get - -showReadPubKey :: Ctx -> SecKey -> Bool -showReadPubKey ctx k = - (read . show) p == p - where - p = derivePubKey ctx k - -showRead :: (Show a, Read a, Eq a) => a -> Bool -showRead x = read (show x) == x - -signMsgTest :: Ctx -> (Msg, SecKey) -> Bool -signMsgTest ctx (fm, fk) = verifySig ctx fp fg fm - where - fp = derivePubKey ctx fk - fg = signMsg ctx fk fm - -signMsgParTest :: Ctx -> [(Msg, SecKey)] -> Bool -signMsgParTest ctx xs = P.runPar $ do - ys <- mapM (P.spawnP . signMsgTest ctx) xs - and <$> mapM P.get ys - -badSignatureTest :: Ctx -> (Msg, SecKey, SecKey) -> Bool -badSignatureTest ctx (fm, fk, fk') = not $ verifySig ctx fp fg fm - where - fp = derivePubKey ctx fk' - fg = signMsg ctx fk fm - -normalizeSigTest :: Ctx -> (Msg, SecKey) -> Bool -normalizeSigTest ctx (fm, fk) = isNothing sig - where - fg = signMsg ctx fk fm - sig = normalizeSig ctx fg - -serializePubKeyTest :: Ctx -> (SecKey, Bool) -> Bool -serializePubKeyTest ctx (fk, b) = - case importPubKey ctx $ exportPubKey ctx b fp of - Just fp' -> fp == fp' - Nothing -> False - where - fp = derivePubKey ctx fk - -parSerializePubKeyTest :: Ctx -> [(SecKey, Bool)] -> Bool -parSerializePubKeyTest ctx ks = P.runPar $ do - as <- mapM (P.spawnP . serializePubKeyTest ctx) ks - and <$> mapM P.get as - where - ps = map (first (derivePubKey ctx)) ks - -serializeSigTest :: Ctx -> (Msg, SecKey) -> Bool -serializeSigTest ctx (fm, fk) = - case importSig ctx $ exportSig ctx fg of - Just fg' -> fg == fg' - Nothing -> False - where - fg = signMsg ctx fk fm - -parSerializeSigTest :: Ctx -> [(Msg, SecKey)] -> Bool -parSerializeSigTest ctx ms = P.runPar $ do - as <- mapM (P.spawnP . serializeSigTest ctx) ms - and <$> mapM P.get as - -serializeCompactSigTest :: Ctx -> (Msg, SecKey) -> Bool -serializeCompactSigTest ctx (fm, fk) = - case importCompactSig ctx $ exportCompactSig ctx fg of - Just fg' -> fg == fg' - Nothing -> False - where - fg = signMsg ctx fk fm - -serializeSecKeyTest :: SecKey -> Bool -serializeSecKeyTest fk = - case secKey fk.get of - Just fk' -> fk == fk' - Nothing -> False - -tweakAddSecKeyTest :: Ctx -> Assertion -tweakAddSecKeyTest ctx = - assertEqual "tweaked keys match" expected tweaked - where - tweaked = do - key <- - secKey $ - hexToBytes - "f65255094d7773ed8dd417badc9fc045c1f80fdc5b2d25172b031ce6933e039a" - twk <- - tweak $ - hexToBytes - "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00" - tweakAddSecKey ctx key twk - expected = - secKey $ - hexToBytes - "ec1e3ce1cefa18a671d51125e2b249688d934b0e28f5d1665384d9b02f929059" - -tweakMulSecKeyTest :: Ctx -> Assertion -tweakMulSecKeyTest ctx = - assertEqual "tweaked keys match" expected tweaked - where - tweaked = do - key <- - secKey $ - hexToBytes - "f65255094d7773ed8dd417badc9fc045c1f80fdc5b2d25172b031ce6933e039a" - twk <- - tweak $ - hexToBytes - "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00" - tweakMulSecKey ctx key twk - expected = - secKey $ - hexToBytes - "a96f5962493acb179f60a86a9785fc7a30e0c39b64c09d24fe064d9aef15e4c0" - -tweakAddPubKeyTest :: Ctx -> Assertion -tweakAddPubKeyTest ctx = do - assertBool "did not fail to decode" $ isJust tweaked - assertBool "is not empty" $ not $ maybe False BS.null tweaked - assertEqual "tweaked keys match" expected tweaked - where - tweaked = do - pub <- - importPubKey ctx $ - hexToBytes - "04dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd4470512213d5ed790522c042dee8e85c4c0ec5f96800b72bc5940c8bc1c5e11e4fcbf" - twk <- - tweak $ - hexToBytes - "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00" - key <- tweakAddPubKey ctx pub twk - return $ exportPubKey ctx True key - expected = do - key <- - importPubKey ctx $ - hexToBytes - "04441c3982b97576646e0df0c96736063df6b42f2ee566d13b9f6424302d1379e518fdc87a14c5435bff7a5db4552042cb4120c6b86a4bbd3d0643f3c14ad01368" - return $ exportPubKey ctx True key - -tweakMulPubKeyTest :: Ctx -> Assertion -tweakMulPubKeyTest ctx = do - assertBool "did not fail to decode" $ isJust tweaked - assertBool "is not empty" $ not $ maybe False BS.null tweaked - assertEqual "tweaked keys match" expected tweaked - where - tweaked = do - pub <- - importPubKey ctx $ - hexToBytes - "04dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd4470512213d5ed790522c042dee8e85c4c0ec5f96800b72bc5940c8bc1c5e11e4fcbf" - twk <- - tweak $ - hexToBytes - "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00" - key <- tweakMulPubKey ctx pub twk - return $ exportPubKey ctx True key - expected = do - key <- - importPubKey ctx $ - hexToBytes - "04f379dc99cdf5c83e433defa267fbb3377d61d6b779c06a0e4ce29ae3ff5353b12ae49c9d07e7368f2ba5a446c203255ce912322991a2d6a9d5d5761c61ed1845" - return $ exportPubKey ctx True key - -combinePubKeyTest :: Ctx -> Assertion -combinePubKeyTest ctx = do - assertBool "did not fail to decode" $ isJust combined - assertBool "is not empty" $ not $ maybe False BS.null combined - assertEqual "combined keys match" expected combined - where - combined = do - pub1 <- - importPubKey ctx $ - hexToBytes - "04dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd4470512213d5ed790522c042dee8e85c4c0ec5f96800b72bc5940c8bc1c5e11e4fcbf" - pub2 <- - importPubKey ctx $ - hexToBytes - "0487d82042d93447008dfe2af762068a1e53ff394a5bf8f68a045fa642b99ea5d153f577dd2dba6c7ae4cfd7b6622409d7edd2d76dd13a8092cd3af97b77bd2c77" - pub3 <- - importPubKey ctx $ - hexToBytes - "049b101edcbe1ee37ff6b2318526a425b629e823d7d8d9154417880595a28000ee3febd908754b8ce4e491aa6fe488b41fb5d4bb3788e33c9ff95a7a9229166d59" - key <- combinePubKeys ctx [pub1, pub2, pub3] - return $ exportPubKey ctx True key - expected = do - key <- - importPubKey ctx $ - hexToBytes - "043d9a7ec70011efc23c33a7e62d2ea73cca87797e3b659d93bea6aa871aebde56c3bc6134ca82e324b0ab9c0e601a6d2933afe7fb5d9f3aae900f5c5dc6e362c8" - return $ exportPubKey ctx True key - -combinePubKeyEmptyListTest :: Ctx -> Assertion -combinePubKeyEmptyListTest ctx = - assertEqual "empty pubkey list must return Nothing" expected combined - where - expected = Nothing - combined = do - key <- combinePubKeys ctx [] - return $ exportPubKey ctx True key - -negateTweakTest :: Ctx -> Assertion -negateTweakTest ctx = - assertEqual "can recover secret key 1 after adding tweak 1" oneKey subtracted - where - Just oneKey = - secKey . decodeBase16 . assertBase16 $ - B8.pack - "0000000000000000000000000000000000000000000000000000000000000001" - Just oneTwk = - tweak . decodeBase16 . assertBase16 $ - B8.pack - "0000000000000000000000000000000000000000000000000000000000000001" - Just minusOneTwk = tweakNegate ctx oneTwk - Just twoKey = tweakAddSecKey ctx oneKey oneTwk - Just subtracted = tweakAddSecKey ctx twoKey minusOneTwk +{-# 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` ()