secp256k1-haskell 1.7.0 → 2.0.0
raw patch · 16 files changed
+2833/−526 lines, 16 filesdep −unliftio-corePVP ok
version bump matches the API change (PVP)
Dependencies removed: unliftio-core
API changes (from Hackage documentation)
- Crypto.Secp256k1: CompactSig :: ByteString -> CompactSig
- Crypto.Secp256k1: Ctx :: ForeignPtr LCtx -> Ctx
- Crypto.Secp256k1: Msg :: ByteString -> Msg
- Crypto.Secp256k1: PubKey :: ByteString -> PubKey
- Crypto.Secp256k1: SecKey :: ByteString -> SecKey
- Crypto.Secp256k1: Sig :: ByteString -> Sig
- Crypto.Secp256k1: Tweak :: ByteString -> Tweak
- Crypto.Secp256k1: [get] :: Tweak -> ByteString
- Crypto.Secp256k1: newtype CompactSig
- Crypto.Secp256k1: newtype Msg
- Crypto.Secp256k1: newtype PubKey
- Crypto.Secp256k1: newtype SecKey
- Crypto.Secp256k1: newtype Sig
- Crypto.Secp256k1: newtype Tweak
+ Crypto.Secp256k1: data CompactSig
+ Crypto.Secp256k1: data Msg
+ Crypto.Secp256k1: data PubKey
+ Crypto.Secp256k1: data SchnorrSig
+ Crypto.Secp256k1: data SecKey
+ Crypto.Secp256k1: data Sig
+ Crypto.Secp256k1: data Tweak
+ Crypto.Secp256k1: exportXOnlyPubKey :: Ctx -> PubKey -> ByteString
+ Crypto.Secp256k1: importXOnlyPubKey :: Ctx -> ByteString -> Maybe PubKey
+ Crypto.Secp256k1: isLowR :: Ctx -> Sig -> Bool
+ Crypto.Secp256k1: isLowS :: Ctx -> Sig -> Bool
+ Crypto.Secp256k1: schnorrSig :: ByteString -> Maybe SchnorrSig
+ Crypto.Secp256k1: signMsgLowR :: Ctx -> SecKey -> Msg -> Sig
+ Crypto.Secp256k1: signSchnorr :: Ctx -> SecKey -> Msg -> SchnorrSig
+ Crypto.Secp256k1: signSchnorrIO :: MonadIO m => Ctx -> SecKey -> Msg -> m SchnorrSig
+ Crypto.Secp256k1: signSchnorrWithAux :: Ctx -> SecKey -> Msg -> ByteString -> Maybe SchnorrSig
+ Crypto.Secp256k1: tweakAddXOnlyPubKey :: Ctx -> PubKey -> Tweak -> Maybe PubKey
+ Crypto.Secp256k1: tweakAddXOnlySecKey :: Ctx -> SecKey -> Tweak -> Maybe SecKey
+ Crypto.Secp256k1: verifySchnorr :: Ctx -> PubKey -> SchnorrSig -> Msg -> Bool
+ Crypto.Secp256k1.Internal.Base: SchnorrSig :: ByteString -> SchnorrSig
+ Crypto.Secp256k1.Internal.Base: belowCurveOrder :: ByteString -> Bool
+ Crypto.Secp256k1.Internal.Base: curveOrder :: ByteString
+ Crypto.Secp256k1.Internal.Base: exportXOnlyPubKey :: Ctx -> PubKey -> ByteString
+ Crypto.Secp256k1.Internal.Base: hasNonZeroComponents :: ByteString -> Bool
+ Crypto.Secp256k1.Internal.Base: importXOnlyPubKey :: Ctx -> ByteString -> Maybe PubKey
+ Crypto.Secp256k1.Internal.Base: instance Control.DeepSeq.NFData Crypto.Secp256k1.Internal.Base.SchnorrSig
+ Crypto.Secp256k1.Internal.Base: instance Data.Hashable.Class.Hashable Crypto.Secp256k1.Internal.Base.SchnorrSig
+ Crypto.Secp256k1.Internal.Base: instance GHC.Classes.Eq Crypto.Secp256k1.Internal.Base.SchnorrSig
+ Crypto.Secp256k1.Internal.Base: instance GHC.Internal.Data.String.IsString Crypto.Secp256k1.Internal.Base.CompactSig
+ Crypto.Secp256k1.Internal.Base: instance GHC.Internal.Data.String.IsString Crypto.Secp256k1.Internal.Base.SchnorrSig
+ Crypto.Secp256k1.Internal.Base: instance GHC.Internal.Generics.Generic Crypto.Secp256k1.Internal.Base.SchnorrSig
+ Crypto.Secp256k1.Internal.Base: instance GHC.Internal.Read.Read Crypto.Secp256k1.Internal.Base.CompactSig
+ Crypto.Secp256k1.Internal.Base: instance GHC.Internal.Read.Read Crypto.Secp256k1.Internal.Base.SchnorrSig
+ Crypto.Secp256k1.Internal.Base: instance GHC.Internal.Show.Show Crypto.Secp256k1.Internal.Base.CompactSig
+ Crypto.Secp256k1.Internal.Base: instance GHC.Internal.Show.Show Crypto.Secp256k1.Internal.Base.SchnorrSig
+ Crypto.Secp256k1.Internal.Base: instance Test.QuickCheck.Arbitrary.Arbitrary Crypto.Secp256k1.Internal.Base.Tweak
+ Crypto.Secp256k1.Internal.Base: isCanonicalPubKey :: ByteString -> Bool
+ Crypto.Secp256k1.Internal.Base: isCanonicalSig :: ByteString -> Bool
+ Crypto.Secp256k1.Internal.Base: isLowR :: Ctx -> Sig -> Bool
+ Crypto.Secp256k1.Internal.Base: isLowS :: Ctx -> Sig -> Bool
+ Crypto.Secp256k1.Internal.Base: newtype SchnorrSig
+ Crypto.Secp256k1.Internal.Base: schnorrSig :: ByteString -> Maybe SchnorrSig
+ Crypto.Secp256k1.Internal.Base: sigFromCompactBytes :: ByteString -> Maybe Sig
+ Crypto.Secp256k1.Internal.Base: signMsgLowR :: Ctx -> SecKey -> Msg -> Sig
+ Crypto.Secp256k1.Internal.Base: signMsgWith :: Ctx -> SecKey -> Msg -> Maybe ByteString -> Sig
+ Crypto.Secp256k1.Internal.Base: signSchnorr :: Ctx -> SecKey -> Msg -> SchnorrSig
+ Crypto.Secp256k1.Internal.Base: signSchnorrIO :: MonadIO m => Ctx -> SecKey -> Msg -> m SchnorrSig
+ Crypto.Secp256k1.Internal.Base: signSchnorrInternal :: Ctx -> SecKey -> Msg -> Maybe ByteString -> SchnorrSig
+ Crypto.Secp256k1.Internal.Base: signSchnorrWithAux :: Ctx -> SecKey -> Msg -> ByteString -> Maybe SchnorrSig
+ Crypto.Secp256k1.Internal.Base: tweakAddXOnlyPubKey :: Ctx -> PubKey -> Tweak -> Maybe PubKey
+ Crypto.Secp256k1.Internal.Base: tweakAddXOnlySecKey :: Ctx -> SecKey -> Tweak -> Maybe SecKey
+ Crypto.Secp256k1.Internal.Base: verifyFreshSignature :: Ptr LCtx -> Ptr KeyPair96 -> Ptr SchnorrSig64 -> Ptr CUChar -> IO Bool
+ Crypto.Secp256k1.Internal.Base: verifySchnorr :: Ctx -> PubKey -> SchnorrSig -> Msg -> Bool
+ Crypto.Secp256k1.Internal.Base: withKeyPair :: Ptr LCtx -> ByteString -> (Ptr KeyPair96 -> IO a) -> IO (Maybe a)
+ Crypto.Secp256k1.Internal.Base: withXOnlyPubKey :: Ptr LCtx -> ByteString -> (Ptr XOnlyPubKey64 -> IO a) -> IO (Maybe a)
+ Crypto.Secp256k1.Internal.Base: zero32 :: ByteString
+ Crypto.Secp256k1.Internal.BaseOps: keyPairCreate :: Ptr LCtx -> Ptr KeyPair96 -> Ptr SecKey32 -> IO Ret
+ Crypto.Secp256k1.Internal.BaseOps: keyPairSec :: Ptr LCtx -> Ptr SecKey32 -> Ptr KeyPair96 -> IO Ret
+ Crypto.Secp256k1.Internal.BaseOps: keyPairXOnlyPub :: Ptr LCtx -> Ptr XOnlyPubKey64 -> Ptr CInt -> Ptr KeyPair96 -> IO Ret
+ Crypto.Secp256k1.Internal.BaseOps: keyPairXOnlyTweakAdd :: Ptr LCtx -> Ptr KeyPair96 -> Ptr Tweak32 -> IO Ret
+ Crypto.Secp256k1.Internal.BaseOps: schnorrSigSign32 :: Ptr LCtx -> Ptr SchnorrSig64 -> Ptr Msg32 -> Ptr KeyPair96 -> Ptr AuxRand32 -> IO Ret
+ Crypto.Secp256k1.Internal.BaseOps: schnorrSigVerify :: Ptr LCtx -> Ptr SchnorrSig64 -> Ptr CUChar -> CSize -> Ptr XOnlyPubKey64 -> IO Ret
+ Crypto.Secp256k1.Internal.BaseOps: xOnlyPubKeyFromPubKey :: Ptr LCtx -> Ptr XOnlyPubKey64 -> Ptr CInt -> Ptr PubKey64 -> IO Ret
+ Crypto.Secp256k1.Internal.BaseOps: xOnlyPubKeySerialize :: Ptr LCtx -> Ptr CUChar -> Ptr XOnlyPubKey64 -> IO Ret
+ Crypto.Secp256k1.Internal.BaseOps: xOnlyPubKeyTweakAdd :: Ptr LCtx -> Ptr PubKey64 -> Ptr XOnlyPubKey64 -> Ptr Tweak32 -> IO Ret
+ Crypto.Secp256k1.Internal.Context: illegalCallbackFunPtr :: FunPtr (CString -> Ptr a -> IO ())
+ Crypto.Secp256k1.Internal.Context: none :: CtxFlags
+ Crypto.Secp256k1.Internal.Context: validationContext :: Ctx
+ Crypto.Secp256k1.Internal.Context: wrapContext :: Ptr LCtx -> IO Ctx
+ Crypto.Secp256k1.Internal.ForeignTypes: data AuxRand32
+ Crypto.Secp256k1.Internal.ForeignTypes: data KeyPair96
+ Crypto.Secp256k1.Internal.ForeignTypes: data SchnorrSig64
+ Crypto.Secp256k1.Internal.ForeignTypes: data XOnlyPubKey64
+ Crypto.Secp256k1.Internal.Recovery: RecSig :: ByteString -> RecSig
+ Crypto.Secp256k1.Internal.Recovery: [get] :: RecSig -> ByteString
+ Crypto.Secp256k1.Internal.Recovery: convertRecSig :: Ctx -> RecSig -> Sig
+ Crypto.Secp256k1.Internal.Recovery: exportCompactRecSig :: Ctx -> RecSig -> (CompactSig, Word8)
+ Crypto.Secp256k1.Internal.Recovery: importCompactRecSig :: Ctx -> CompactSig -> Word8 -> Maybe RecSig
+ Crypto.Secp256k1.Internal.Recovery: instance Control.DeepSeq.NFData Crypto.Secp256k1.Internal.Recovery.RecSig
+ Crypto.Secp256k1.Internal.Recovery: instance Data.Hashable.Class.Hashable Crypto.Secp256k1.Internal.Recovery.RecSig
+ Crypto.Secp256k1.Internal.Recovery: instance GHC.Classes.Eq Crypto.Secp256k1.Internal.Recovery.RecSig
+ Crypto.Secp256k1.Internal.Recovery: instance GHC.Internal.Data.String.IsString Crypto.Secp256k1.Internal.Recovery.RecSig
+ Crypto.Secp256k1.Internal.Recovery: instance GHC.Internal.Generics.Generic Crypto.Secp256k1.Internal.Recovery.RecSig
+ Crypto.Secp256k1.Internal.Recovery: instance GHC.Internal.Read.Read Crypto.Secp256k1.Internal.Recovery.RecSig
+ Crypto.Secp256k1.Internal.Recovery: instance GHC.Internal.Show.Show Crypto.Secp256k1.Internal.Recovery.RecSig
+ Crypto.Secp256k1.Internal.Recovery: isCanonicalRecSig :: ByteString -> Bool
+ Crypto.Secp256k1.Internal.Recovery: newtype RecSig
+ Crypto.Secp256k1.Internal.Recovery: recSig :: ByteString -> Maybe RecSig
+ Crypto.Secp256k1.Internal.Recovery: recSigFromEncoding :: ByteString -> Maybe RecSig
+ Crypto.Secp256k1.Internal.Recovery: recSigToEncoding :: RecSig -> ByteString
+ Crypto.Secp256k1.Internal.Recovery: recover :: Ctx -> RecSig -> Msg -> Maybe PubKey
+ Crypto.Secp256k1.Internal.Recovery: signRecMsg :: Ctx -> SecKey -> Msg -> RecSig
+ Crypto.Secp256k1.Internal.RecoveryOps: ecdsaRecover :: Ptr LCtx -> Ptr PubKey64 -> Ptr RecSig65 -> Ptr Msg32 -> IO Ret
+ Crypto.Secp256k1.Internal.RecoveryOps: ecdsaRecoverableSignatureConvert :: Ptr LCtx -> Ptr Sig64 -> Ptr RecSig65 -> IO Ret
+ Crypto.Secp256k1.Internal.RecoveryOps: ecdsaRecoverableSignatureParseCompact :: Ptr LCtx -> Ptr RecSig65 -> Ptr Compact64 -> CInt -> IO Ret
+ Crypto.Secp256k1.Internal.RecoveryOps: ecdsaRecoverableSignatureSerializeCompact :: Ptr LCtx -> Ptr Compact64 -> Ptr CInt -> Ptr RecSig65 -> IO Ret
+ Crypto.Secp256k1.Internal.RecoveryOps: ecdsaSignRecoverable :: Ptr LCtx -> Ptr RecSig65 -> Ptr Msg32 -> Ptr SecKey32 -> FunPtr (NonceFun a) -> Ptr a -> IO Ret
+ Crypto.Secp256k1.Internal.Util: fillOutput :: Int -> (Ptr a -> IO ()) -> IO ByteString
+ Crypto.Secp256k1.Internal.Util: useFixedByteString :: String -> Int -> ByteString -> ((Ptr a, CSize) -> IO b) -> IO b
+ Crypto.Secp256k1.Internal.Util: withCopy :: String -> Int -> ByteString -> (Ptr a -> IO Bool) -> IO (Maybe ByteString)
+ Crypto.Secp256k1.Internal.Util: withOutput :: Int -> (Ptr a -> IO Bool) -> IO (Maybe ByteString)
+ Crypto.Secp256k1.Internal.Util: wrongLength :: String -> Int -> ByteString -> a
+ Crypto.Secp256k1.Recovery: convertRecSig :: Ctx -> RecSig -> Sig
+ Crypto.Secp256k1.Recovery: data RecSig
+ Crypto.Secp256k1.Recovery: exportCompactRecSig :: Ctx -> RecSig -> (CompactSig, Word8)
+ Crypto.Secp256k1.Recovery: importCompactRecSig :: Ctx -> CompactSig -> Word8 -> Maybe RecSig
+ Crypto.Secp256k1.Recovery: recSig :: ByteString -> Maybe RecSig
+ Crypto.Secp256k1.Recovery: recover :: Ctx -> RecSig -> Msg -> Maybe PubKey
+ Crypto.Secp256k1.Recovery: signRecMsg :: Ctx -> SecKey -> Msg -> RecSig
- Crypto.Secp256k1: normalizeSig :: Ctx -> Sig -> Maybe Sig
+ Crypto.Secp256k1: normalizeSig :: Ctx -> Sig -> Sig
- Crypto.Secp256k1.Internal.Base: [get] :: CompactSig -> ByteString
+ Crypto.Secp256k1.Internal.Base: [get] :: SchnorrSig -> ByteString
- Crypto.Secp256k1.Internal.Base: normalizeSig :: Ctx -> Sig -> Maybe Sig
+ Crypto.Secp256k1.Internal.Base: normalizeSig :: Ctx -> Sig -> Sig
- Crypto.Secp256k1.Internal.BaseOps: ecPubKeyCombine :: Ptr LCtx -> Ptr PubKey64 -> Ptr (Ptr PubKey64) -> CInt -> IO Ret
+ Crypto.Secp256k1.Internal.BaseOps: ecPubKeyCombine :: Ptr LCtx -> Ptr PubKey64 -> Ptr (Ptr PubKey64) -> CSize -> IO Ret
Files
- CHANGELOG.md +97/−0
- cbits/illegal_callback.c +17/−0
- secp256k1-haskell.cabal +20/−5
- src/Crypto/Secp256k1.hs +102/−7
- src/Crypto/Secp256k1/Internal/Base.hs +562/−185
- src/Crypto/Secp256k1/Internal/BaseOps.hs +87/−4
- src/Crypto/Secp256k1/Internal/Context.hs +67/−12
- src/Crypto/Secp256k1/Internal/ForeignTypes.hs +8/−0
- src/Crypto/Secp256k1/Internal/Recovery.hs +228/−0
- src/Crypto/Secp256k1/Internal/RecoveryOps.hs +65/−0
- src/Crypto/Secp256k1/Internal/Util.hs +51/−1
- src/Crypto/Secp256k1/Recovery.hs +72/−0
- test/Crypto/Secp256k1/Fixtures.hs +128/−0
- test/Crypto/Secp256k1/InternalSpec.hs +3/−3
- test/Crypto/Secp256k1/RecoverySpec.hs +334/−0
- test/Crypto/Secp256k1Spec.hs +992/−309
CHANGELOG.md view
@@ -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
+ cbits/illegal_callback.c view
@@ -0,0 +1,17 @@+/*+ * Illegal-argument callback installed on every context this package creates.+ *+ * The default callback of libsecp256k1 prints the message to stderr and calls+ * abort(). That kills the whole Haskell process and cannot be caught. With+ * this callback installed, the C function that received the illegal argument+ * returns 0 instead, and the Haskell side turns that into Nothing, False or+ * an ErrorCall exception.+ *+ * The error callback, which reports internal consistency failures of the+ * library itself, keeps its default. Those indicate a broken build and+ * should still abort.+ */+void secp256k1_haskell_illegal_callback(const char *message, void *data) {+ (void)message;+ (void)data;+}
secp256k1-haskell.cabal view
@@ -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
src/Crypto/Secp256k1.hs view
@@ -1,46 +1,125 @@ {-# LANGUAGE DuplicateRecordFields #-}++-- | ECDSA and BIP-340 Schnorr signatures on the secp256k1 curve, through+-- <https://github.com/bitcoin-core/secp256k1 libsecp256k1>.+--+-- == 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
src/Crypto/Secp256k1/Internal/Base.hs view
@@ -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
src/Crypto/Secp256k1/Internal/BaseOps.hs view
@@ -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
src/Crypto/Secp256k1/Internal/Context.hs view
@@ -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 ::
src/Crypto/Secp256k1/Internal/ForeignTypes.hs view
@@ -21,6 +21,14 @@ data RecSig65 +data XOnlyPubKey64++data KeyPair96++data SchnorrSig64++data AuxRand32+ type CtxFlags = CUInt type SerFlags = CUInt
+ src/Crypto/Secp256k1/Internal/Recovery.hs view
@@ -0,0 +1,228 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE OverloadedRecordDot #-}+{-# LANGUAGE NoFieldSelectors #-}++-- | Internal module. Everything is exported, including the raw 'RecSig'+-- constructor that "Crypto.Secp256k1.Recovery" hides, and there is no API+-- stability guarantee. This module is only built when the @recovery@ flag of+-- the package is on.+--+-- A 'RecSig' built with the raw constructor skips validation. Every function+-- here still checks the length of its bytes before calling the C library and+-- raises an 'Control.Exception.ErrorCall' when the length is wrong, but it+-- does not check the content. A raw 'RecSig' with invalid content makes+-- functions return 'Nothing', a value that does not verify, or throw, never+-- abort or read outside a buffer.+module Crypto.Secp256k1.Internal.Recovery where++import Control.DeepSeq (NFData)+import Control.Monad (guard, (<=<))+import Crypto.Secp256k1.Internal.Base+ ( CompactSig (..),+ Msg (..),+ PubKey (..),+ SecKey (..),+ Sig (..),+ hasNonZeroComponents,+ )+import Crypto.Secp256k1.Internal.Context (Ctx (..), validationContext)+import Crypto.Secp256k1.Internal.ForeignTypes (isSuccess)+import Crypto.Secp256k1.Internal.RecoveryOps+ ( ecdsaRecover,+ ecdsaRecoverableSignatureConvert,+ ecdsaRecoverableSignatureParseCompact,+ ecdsaRecoverableSignatureSerializeCompact,+ ecdsaSignRecoverable,+ )+import Crypto.Secp256k1.Internal.Util+ ( decodeHex,+ packByteString,+ showsHex,+ unsafeUseByteString,+ useFixedByteString,+ withOutput,+ )+import Data.ByteString (ByteString)+import Data.ByteString qualified as BS+import Data.Hashable (Hashable)+import Data.Maybe (fromMaybe)+import Data.String (IsString (..))+import Data.Word (Word8)+import Foreign (alloca, allocaBytes, nullFunPtr, nullPtr, peek, withForeignPtr)+import GHC.Generics (Generic)+import System.IO.Unsafe (unsafePerformIO)+import Text.Read+ ( Lexeme (String),+ lexP,+ parens,+ pfail,+ readPrec,+ )++-- | ECDSA signature with a recovery id, in the internal representation of+-- libsecp256k1 (65 bytes). A valid 'RecSig' has both components in the range+-- 1 to n−1, where n is the order of the curve, and a recovery id of 0 to 3.+--+-- The bytes in @get@ are opaque. They are not a standard encoding, and they+-- are not portable between platforms or library versions. Use+-- 'exportCompactRecSig' to serialize a signature and 'importCompactRecSig' to+-- parse one. 'recSig' only exists to rebuild a signature from the bytes of+-- @get@ on the same platform.+--+-- 'Show', 'Read' and 'IsString' use hex of the 65-byte encoding that+-- 'exportCompactRecSig' gives: r and s as 32-byte big-endian numbers, then+-- the recovery id as one byte.+newtype RecSig = RecSig {get :: ByteString}+ deriving (Eq, Generic, Hashable, NFData)++instance Read RecSig where+ readPrec = parens $ do+ String str <- lexP+ maybe pfail return $ recSigFromEncoding =<< decodeHex str++instance IsString RecSig where+ fromString = fromMaybe e . (recSigFromEncoding <=< decodeHex)+ where+ e = error "Could not decode recoverable signature from hex string"++instance Show RecSig where+ showsPrec _ = showsHex . recSigToEncoding++-- | The 65-byte encoding of a signature: the compact encoding of r and s,+-- then the recovery id as one byte. Used by the 'Show' instance.+recSigToEncoding :: RecSig -> ByteString+recSigToEncoding rs = compact.get `BS.snoc` rec_id+ where+ (compact, rec_id) = exportCompactRecSig validationContext rs++-- | Parse the 65-byte encoding of 'recSigToEncoding' without a+-- caller-provided context. Used by the 'Read' and 'IsString' instances.+recSigFromEncoding :: ByteString -> Maybe RecSig+recSigFromEncoding bs = do+ guard (BS.length bs == 65)+ importCompactRecSig validationContext (CompactSig (BS.take 64 bs)) (BS.last bs)++-- | Import a recoverable signature from the bytes of its internal+-- representation, as found in the @get@ field of a 'RecSig' on the same+-- platform. 'Nothing' unless the bytes are the canonical representation of a+-- signature whose components are both in the range 1 to n−1, with a recovery+-- id of 0 to 3. Signatures from other sources go through+-- 'importCompactRecSig'.+recSig :: ByteString -> Maybe RecSig+recSig bs+ | isCanonicalRecSig bs = Just (RecSig bs)+ | otherwise = Nothing++-- | Serialize the internal bytes to the compact encoding and the id, parse+-- those back and compare, as 'Crypto.Secp256k1.Internal.Base.isCanonicalSig'+-- does. Parsing checks that both components are below the curve order and+-- that the id is 0 to 3. Comparing the bytes rejects non-canonical forms, so+-- that each signature has one representation and 'Eq' is meaningful. Zero+-- components are rejected too, so that 'convertRecSig' always gives a valid+-- 'Sig'.+isCanonicalRecSig :: ByteString -> Bool+isCanonicalRecSig bs =+ BS.length bs == 65+ && unsafePerformIO+ ( withForeignPtr fctx $ \ctx ->+ unsafeUseByteString bs $ \(rec_sig_ptr, _) ->+ allocaBytes 64 $ \compact_ptr ->+ alloca $ \rec_id_ptr -> do+ ret <-+ ecdsaRecoverableSignatureSerializeCompact+ ctx+ compact_ptr+ rec_id_ptr+ rec_sig_ptr+ if not (isSuccess ret)+ then return False+ else do+ rec_id <- peek rec_id_ptr+ compact <- packByteString (compact_ptr, 64)+ parsed <- withOutput 65 $ \out ->+ isSuccess+ <$> ecdsaRecoverableSignatureParseCompact ctx out compact_ptr rec_id+ return (parsed == Just bs && hasNonZeroComponents compact)+ )+ where+ Ctx fctx = validationContext++-- | Sign a message hash and keep the recovery id. The nonce comes from RFC+-- 6979, so the same key and hash always give the same signature, and r and s+-- are those of 'Crypto.Secp256k1.signMsg', in lower-S form. There is no low-R+-- grinding. Bitcoin Core does not grind when it signs a message with+-- @SignCompact@ either, so the signatures are the same as Bitcoin Core's.+signRecMsg :: Ctx -> SecKey -> Msg -> RecSig+signRecMsg (Ctx fctx) (SecKey sec_key) (Msg m) =+ unsafePerformIO $ withForeignPtr fctx $ \ctx ->+ useFixedByteString "SecKey" 32 sec_key $ \(sec_key_ptr, _) ->+ useFixedByteString "Msg" 32 m $ \(msg_ptr, _) -> do+ -- A null nonce function selects the RFC 6979 default.+ out <- withOutput 65 $ \rec_sig_ptr ->+ isSuccess+ <$> ecdsaSignRecoverable ctx rec_sig_ptr msg_ptr sec_key_ptr nullFunPtr nullPtr+ maybe (error "could not sign message") (return . RecSig) out++-- | The public key that made a signature of a message hash. 'Nothing' when no+-- key comes out: no point has the x coordinate that r and the recovery id+-- give, or the computation reaches the point at infinity.+--+-- A key that comes out verifies the signature for the hash, except for the+-- lower-S rule, which recovery does not apply: the high-S form of a+-- signature, with the parity bit of its recovery id flipped, recovers the+-- same key. Bitcoin Core accepts such message signatures too. Where the rule+-- matters, check 'Crypto.Secp256k1.isLowS' on 'convertRecSig'. The hash is+-- reduced modulo the curve order, as 'Crypto.Secp256k1.verifySig' does.+recover :: Ctx -> RecSig -> Msg -> Maybe PubKey+recover (Ctx fctx) (RecSig rec_sig) (Msg m) =+ unsafePerformIO $ withForeignPtr fctx $ \ctx ->+ useFixedByteString "RecSig" 65 rec_sig $ \(rec_sig_ptr, _) ->+ useFixedByteString "Msg" 32 m $ \(msg_ptr, _) ->+ (fmap . fmap) PubKey . withOutput 64 $ \pub_key_ptr ->+ isSuccess <$> ecdsaRecover ctx pub_key_ptr rec_sig_ptr msg_ptr++-- | The signature without its recovery id. For a signature from+-- 'signRecMsg', this is the signature that 'Crypto.Secp256k1.signMsg' gives.+convertRecSig :: Ctx -> RecSig -> Sig+convertRecSig (Ctx fctx) (RecSig rec_sig) =+ unsafePerformIO $ withForeignPtr fctx $ \ctx ->+ useFixedByteString "RecSig" 65 rec_sig $ \(rec_sig_ptr, _) -> do+ out <- withOutput 64 $ \sig_ptr ->+ isSuccess <$> ecdsaRecoverableSignatureConvert ctx sig_ptr rec_sig_ptr+ maybe (error "could not convert recoverable signature") (return . Sig) out++-- | Parse a signature from the compact encoding and its recovery id.+-- 'Nothing' unless both components are in the range 1 to n−1 and the id is 0+-- to 3. The signature may be in high-S form.+importCompactRecSig :: Ctx -> CompactSig -> Word8 -> Maybe RecSig+importCompactRecSig (Ctx fctx) (CompactSig compact) rec_id = do+ guard (rec_id <= 3)+ -- libsecp256k1 accepts a zero component here and only refuses it in+ -- 'recover'. It is rejected here so that 'convertRecSig' always gives a+ -- valid 'Sig', as 'Crypto.Secp256k1.importCompactSig' does.+ guard (hasNonZeroComponents compact)+ unsafePerformIO $ withForeignPtr fctx $ \ctx ->+ useFixedByteString "CompactSig" 64 compact $ \(compact_ptr, _) ->+ (fmap . fmap) RecSig . withOutput 65 $ \out ->+ isSuccess+ <$> ecdsaRecoverableSignatureParseCompact ctx out compact_ptr (fromIntegral rec_id)++-- | Serialize a signature to the compact encoding and its recovery id. The+-- header byte of a Bitcoin signed message is 27 plus the id, plus 4 for a+-- compressed key, which the caller adds.+exportCompactRecSig :: Ctx -> RecSig -> (CompactSig, Word8)+exportCompactRecSig (Ctx fctx) (RecSig rec_sig) =+ unsafePerformIO $ withForeignPtr fctx $ \ctx ->+ useFixedByteString "RecSig" 65 rec_sig $ \(rec_sig_ptr, _) ->+ alloca $ \rec_id_ptr -> do+ out <- withOutput 64 $ \compact_ptr ->+ isSuccess+ <$> ecdsaRecoverableSignatureSerializeCompact ctx compact_ptr rec_id_ptr rec_sig_ptr+ case out of+ Nothing -> error "could not serialize recoverable signature"+ Just compact -> do+ rec_id <- peek rec_id_ptr+ return (CompactSig compact, fromIntegral rec_id)
+ src/Crypto/Secp256k1/Internal/RecoveryOps.hs view
@@ -0,0 +1,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
src/Crypto/Secp256k1/Internal/Util.hs view
@@ -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) =
+ src/Crypto/Secp256k1/Recovery.hs view
@@ -0,0 +1,72 @@+-- | ECDSA public key recovery, through the @recovery@ module of+-- <https://github.com/bitcoin-core/secp256k1 libsecp256k1>.+--+-- Up to four public keys verify a given ECDSA signature (r, s) of a hash. A+-- recovery id of 0 to 3 says which one: R is the point whose x coordinate is+-- r, or r + n for the ids 2 and 3, and whose y coordinate is even for the+-- ids 0 and 2 and odd for 1 and 3. The key is then Q = r⁻¹(s·R − e·G), where+-- e is the hash as a number. 'signRecMsg' signs and keeps the id, and+-- 'recover' computes the key from a signature, its id and the hash.+--+-- Bitcoin signed messages use this: a signature is 65 bytes, a header byte+-- followed by r and s, and the verifier recovers the key and compares its+-- address with the one given. The header byte is 27 plus the id, plus 4 for+-- a compressed key, and BIP 137 adds 8 or 12 more for a SegWit address.+-- 'exportCompactRecSig' and 'importCompactRecSig' convert between a 'RecSig'+-- and the r‖s bytes with the id; the header byte itself is left to the+-- caller.+--+-- == Relation to the ECDSA functions+--+-- 'signRecMsg' uses the same RFC 6979 nonce as 'Crypto.Secp256k1.signMsg',+-- so 'convertRecSig' of its result is the signature that+-- 'Crypto.Secp256k1.signMsg' gives, in lower-S form. There is no low-R+-- grinding, and Bitcoin Core does not grind either when it signs a message,+-- so message signatures are byte for byte the same as Bitcoin Core's.+--+-- 'recover' does not apply the lower-S rule of 'Crypto.Secp256k1.verifySig'.+-- The high-S form of a signature, with the parity bit of its id flipped,+-- recovers the same key, and Bitcoin Core accepts such message signatures+-- too. Where the rule matters, check 'Crypto.Secp256k1.isLowS' on+-- 'convertRecSig'.+--+-- The ids 2 and 3 only come out of 'signRecMsg' when r is below p − n, which+-- happens for about one signature in 2^128. 'importCompactRecSig' accepts+-- them and 'recover' handles them.+--+-- == The recovery module of libsecp256k1+--+-- libsecp256k1 only has this module when it was built with+-- @--enable-module-recovery@, or @SECP256K1_ENABLE_MODULE_RECOVERY=ON@ with+-- CMake. That is off by default upstream, but on in the libraries that+-- Debian, Ubuntu, Fedora, Arch, Alpine, openSUSE, Homebrew and Nixpkgs ship.+-- This package binds it when its @recovery@ flag is on, which is the+-- default. With a library built without the module, the first program to+-- link fails with an undefined reference to @secp256k1_ecdsa_recover@. Build+-- the package with @-f -recovery@ then, and this module is not available.+--+-- == Values+--+-- 'RecSig' is built through 'signRecMsg', 'importCompactRecSig' or 'recSig',+-- which validate it, so a 'RecSig' always has both components in the range 1+-- to n−1 and an id of 0 to 3. Its @get@ field gives the internal+-- representation of libsecp256k1, which is opaque and not portable. 'Show',+-- 'Read' and 'Data.String.IsString' use hex of r and s as 32-byte big-endian+-- numbers followed by the id as one byte. The raw constructor is in+-- "Crypto.Secp256k1.Internal.Recovery", which has no API stability+-- guarantee.+module Crypto.Secp256k1.Recovery+ ( -- * Recoverable signatures+ RecSig (get),+ recSig,+ signRecMsg,+ recover,+ convertRecSig,++ -- ** Compact+ importCompactRecSig,+ exportCompactRecSig,+ )+where++import Crypto.Secp256k1.Internal.Recovery
+ test/Crypto/Secp256k1/Fixtures.hs view
@@ -0,0 +1,128 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Fixtures and helpers shared by the specifications.+module Crypto.Secp256k1.Fixtures where++import Crypto.Secp256k1+import Data.Base16.Types (assertBase16, extractBase16)+import Data.ByteString qualified as BS+import Data.ByteString.Base16 (decodeBase16, encodeBase16')+import Data.ByteString.Char8 qualified as B8+import Data.Maybe (fromJust)+import Data.String (fromString)++-- * Fixtures+--+-- Every expected value is a literal from an independent source: the secp256k1+-- generator, the RFC 6979 vector for key 1 and sha256 "Satoshi Nakamoto",+-- Bitcoin Core's key_tests.cpp, or this package's historical vectors, all+-- recomputed with an independent implementation of the curve.++zero, one, order, orderMinusOne, orderPlusOne, allOnes :: String+zero = "0000000000000000000000000000000000000000000000000000000000000000"+one = "0000000000000000000000000000000000000000000000000000000000000001"+order = "fffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364141"+orderMinusOne = "fffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364140"+orderPlusOne = "fffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364142"+allOnes = "ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff"++-- Secret key 1. Its public key is the generator G.+keyOne :: SecKey+keyOne = fromString one++-- The generator G in its three SEC1 encodings. y is even, so the compressed+-- prefix is 02 and the hybrid prefix is 06.+genCompressed, genUncompressed, genHybrid :: String+genCompressed =+ "0279be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798"+genUncompressed =+ "0479be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798\+ \483ada7726a3c4655da4fbfc0e1108a8fd17b448a68554199c47d08ffb10d4b8"+genHybrid =+ "0679be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798\+ \483ada7726a3c4655da4fbfc0e1108a8fd17b448a68554199c47d08ffb10d4b8"++-- RFC 6979 vector: key 1 signing sha256 "Satoshi Nakamoto".+satoshiMsg :: Msg+satoshiMsg = "a0dc65ffca799873cbea0ac274015b9526505daaaed385155425f7337704883e"++satoshiR, satoshiS, satoshiHighS :: String+satoshiR = "934b1ea10a4b3c1757e2b0c017d0b6143ce3c9a7e6a4a49860d7a6ab210ee3d8"+satoshiS = "2442ce9d2b916064108014783e923ec36b49743e2ffa1c4496f01a512aafd9e5"+-- n - s+satoshiHighS = "dbbd3162d46e9f9bef7feb87c16dc13b4f6568a87f4e83f728e2443ba586675c"++satoshiDer :: String+satoshiDer = "3045022100" ++ satoshiR ++ "0220" ++ satoshiS++-- Bitcoin Core key_tests.cpp: the secret key of WIF+-- 5HxWvvfubhXpYYpS3tJkw6fq9jE9j18THftkZjHHfmFiWtmAbrj signing+-- sha256d "Very deterministic message".+coreKey :: SecKey+coreKey = "12b004fff7f4b69ef8650e767f18f11ede158148b425660723b9f9a66e61f747"++coreMsg :: Msg+coreMsg = "5255683da567900bfd3e786ed8836a4e7763c221bf1ac20ece2a5171b9199e8a"++coreDer :: String+coreDer =+ "304402205dbbddda71772d95ce91cd2d14b592cfbc1dd0aabd6a394b6c2d377bbe59d31d\+ \022014ddda21494a4e221f0824f0b8b924c43fa43c0ad57dccdaa11f81a6bd4582f6"++-- Key 1 signing sha256 "4". Plain RFC 6979 gives a high r (first byte d4),+-- so Bitcoin Core's grinding retries once with counter 1 as extra nonce data.+highRMsg :: Msg+highRMsg = "4b227777d4dd1fc61c6f884f48641d02b4d121d3fd328cb08b5531fcacdabf8a"++highRDer, groundDer :: String+highRDer =+ "3045022100d479c93a086bf5f4ae1fed7eaf2604a4da2007d851c5409961c81dd7f0600194\+ \02201cd7a196454152f5b8d19865d49b4fa71e314ebff9c59e2f7b2295bf80331be8"+groundDer =+ "3044022020b11f7066dd4486e811ea4f1fee43b1538fcd5bedb64b52d01e56b13422430c\+ \022056cb81320c8439cee666af08788c08e60fda80216a25f52b38714191c8cd1b99"++-- Key 1 signing sha256 "1". Plain RFC 6979 already gives a low r.+lowRMsg :: Msg+lowRMsg = "6b86b273ff34fce19d6b804eff5a3f5747ada4eaa22f1d49c01e52ddb7875b4b"++lowRDer :: String+lowRDer =+ "304402202d24f8d536fccf696a4edfa858e5d6fc89a11d25f72ef4f89de1577d53643c0a\+ \02200d25586b118d5d7f8b79a7805c885fa8588dfa9e6cc777edc11a7e33de844285"++-- Historical vectors of this package.+histKey :: SecKey+histKey = "f65255094d7773ed8dd417badc9fc045c1f80fdc5b2d25172b031ce6933e039a"++histTweak :: Tweak+histTweak = "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00"++histPub :: String+histPub =+ "04dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd44705\+ \12213d5ed790522c042dee8e85c4c0ec5f96800b72bc5940c8bc1c5e11e4fcbf"++-- The field size p of secp256k1. It is not a valid x coordinate.+fieldSize :: String+fieldSize = "fffffffffffffffffffffffffffffffffffffffffffffffffffffffefffffc2f"++-- * Helpers++hexToBytes :: String -> BS.ByteString+hexToBytes = decodeBase16 . assertBase16 . B8.pack++bytesToHex :: BS.ByteString -> String+bytesToHex = B8.unpack . extractBase16 . encodeBase16'++showRead :: (Show a, Read a, Eq a) => a -> Bool+showRead x = read (show x) == x++-- The hex literal, quoted the way 'show' quotes a string.+quoted :: String -> String+quoted s = "\"" ++ s ++ "\""++-- The negation of a public key: multiplication by n - 1.+negatePubKey :: Ctx -> PubKey -> PubKey+negatePubKey ctx p = fromJust (tweakMulPubKey ctx p (fromString orderMinusOne))
test/Crypto/Secp256k1/InternalSpec.hs view
@@ -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 =
+ test/Crypto/Secp256k1/RecoverySpec.hs view
@@ -0,0 +1,334 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE OverloadedRecordDot #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | ECDSA public key recovery. The module under test only exists when the+-- @recovery@ flag of the package is on, so the whole specification is behind+-- the same flag. This module avoids string gaps, because CPP would join+-- their lines.+module Crypto.Secp256k1.RecoverySpec (spec) where++import Test.Hspec++#ifdef RECOVERY++import Control.DeepSeq (deepseq)+import Control.Exception (evaluate)+import Control.Monad (forM_)+import Control.Monad.Par qualified as P+import Crypto.Secp256k1+import Crypto.Secp256k1.Fixtures+import Crypto.Secp256k1.Internal.Base (CompactSig (CompactSig), Msg (Msg), SecKey (SecKey))+import Crypto.Secp256k1.Internal.Recovery (RecSig (RecSig))+import Crypto.Secp256k1.Recovery+import Data.Bits (xor)+import Data.ByteString qualified as BS+import Data.Hashable (hash)+import Data.Maybe (fromJust, isJust)+import Data.String (fromString)+import Data.Word (Word8)+import Test.QuickCheck+import Text.Read (readMaybe)++spec :: Spec+spec = around withContext $ describe "public key recovery" $ do+ signingSpec+ recoverySpec+ formulaSpec+ compactSpec+ valueSpec+ rawValueSpec+ instanceSpec++-- * Fixtures+--+-- As in "Crypto.Secp256k1.Fixtures", every expected value is a literal from+-- an independent source, recomputed with an independent implementation of+-- the curve.++-- Bitcoin Core key_tests.cpp: the SignCompact signature of coreKey over+-- coreMsg is 20 ++ coreR ++ coreS. The header byte 0x20 = 32 = 27 + 1 + 4+-- says recovery id 1 and a compressed key. coreDer is 30440220 ++ coreR +++-- 0220 ++ coreS.+coreR, coreS :: String+coreR = "5dbbddda71772d95ce91cd2d14b592cfbc1dd0aabd6a394b6c2d377bbe59d31d"+coreS = "14ddda21494a4e221f0824f0b8b924c43fa43c0ad57dccdaa11f81a6bd4582f6"++coreRecId :: Word8+coreRecId = 1++-- The compressed public key of coreKey, and the key that recovery id 0 gives+-- for the same signature.+corePub, coreOtherPub :: String+corePub = "030b4c866585dd868a9d62348a9cd008d6a312937048fff31670e7e920cfc7a744"+coreOtherPub = "02818f8ef9ebd82871789a39ea0385398c267d3d6bb6f537166bd813135870c8ec"++-- Bitcoin Core util_tests.cpp, message_sign: the key of the address+-- 15CRxFdyRpGZLW9w8HnHvVduizdL5jKNbs signs the message "Trust no one".+messageKey :: SecKey+messageKey = "d97f5108f11cda6eeebaaa420fef0726b1f898060b98489fa3098463c0032866"++-- sha256d of the varstrings "Bitcoin Signed Message:\n" and "Trust no one".+messageHash :: Msg+messageHash = "aa8215d723ecd2f14867eeb7e19f192be7bc15a2352a24b991d4f5870cbaf6e8"++-- The expected signature, base64+-- IPojfrX2dfPnH26UegfbGQQLrdK844DlHq5157/P6h57WyuS/Qsl+h/WSVGDF4MUi4rWSswW38oimDYfNNUBUOk=+-- decoded: the header byte 0x20, recovery id 1 and a compressed key, then r+-- and s.+messageR, messageS :: String+messageR = "fa237eb5f675f3e71f6e947a07db19040badd2bce380e51eae75e7bfcfea1e7b"+messageS = "5b2b92fd0b25fa1fd64951831783148b8ad64acc16dfca2298361f34d50150e9"++-- The compressed public key of messageKey.+messagePub :: String+messagePub = "03d2be3dddb497c7c4388cfcb941e14a222cf3e26fe5e2cc260da1821e60d26022"++-- The RFC 6979 vector has recovery id 1. Recovery id 0 gives this other key.+satoshiOtherPub :: String+satoshiOtherPub = "0354d58835e07b996d6378eafa930ae9d2211e767381f1d52aedc67f48c8886f0b"++-- Key 1 signing sha256 "4" (highRDer): r, s and recovery id 0.+highRR, highRS :: String+highRR = "d479c93a086bf5f4ae1fed7eaf2604a4da2007d851c5409961c81dd7f0600194"+highRS = "1cd7a196454152f5b8d19865d49b4fa71e314ebff9c59e2f7b2295bf80331be8"++-- Values for the formula Q = r⁻¹(s·R − e·G).+two, five :: String+two = "0000000000000000000000000000000000000000000000000000000000000002"+-- 5³ + 7 = 132 is not a square modulo p, so no point has x = 5.+five = "0000000000000000000000000000000000000000000000000000000000000005"++-- x = 1 is on the curve: 1 + 7 = 8 is a square modulo p. pointOne is the+-- point with x = 1 and an even y, so its compressed encoding is 02 ++ one and+-- that of its negation is 03 ++ one.+pointOne, pointOneMinusG, twicePointOne :: String+pointOne = "02" ++ one+pointOneMinusG = "02871e0c836ec675e07395aef58d72b646f77e0e33ce1622dfaa0fb8e131f3fe12"+twicePointOne = "03c7ffffffffffffffffffffffffffffffffffffffffffffffffffffff37fffd03"++-- x = n + 2 is on the curve, x = n + 1 is not.+orderPlusTwo :: String+orderPlusTwo = "fffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364143"++-- Half of the point with x = n + 2 and an even y.+halfPointOrderPlusTwo :: String+halfPointOrderPlusTwo = "02ad802f2145df548ce1fc418b851cb32669c5a6bb939e6caf744de90310f8f1ff"++-- p − n and p − n − 1. With the recovery id 2, the first gives x = p, which+-- is outside the field, and the second x = p − 1, which is not on the curve.+fieldMinusOrder, fieldMinusOrderMinusOne :: String+fieldMinusOrder = "000000000000000000000000000000014551231950b75fc4402da1722fc9baee"+fieldMinusOrderMinusOne = "000000000000000000000000000000014551231950b75fc4402da1722fc9baed"++-- The x coordinate of G, and the key −(x⁻¹)·G.+genX, genNegatedOverX :: String+genX = drop 2 genCompressed+genNegatedOverX = "028ff83d8cf12121491609c4939dc11c4aa35503508fe432dc5a5c1905608b9218"++-- * Signing++signingSpec :: SpecWith Ctx+signingSpec = describe "signing" $ do+ it "produces Bitcoin Core's SignCompact signature of sha256d 'Very deterministic message'" $ \ctx ->+ exportCompactRecSig ctx (signRecMsg ctx coreKey coreMsg)+ `shouldBe` (fromString (coreR ++ coreS), coreRecId)+ it "produces Bitcoin Core's signmessage signature of 'Trust no one'" $ \ctx ->+ exportCompactRecSig ctx (signRecMsg ctx messageKey messageHash)+ `shouldBe` (fromString (messageR ++ messageS), 1)+ it "produces the RFC 6979 vector with recovery id 1" $ \ctx ->+ exportCompactRecSig ctx (signRecMsg ctx keyOne satoshiMsg)+ `shouldBe` (fromString (satoshiR ++ satoshiS), 1)+ it "keeps a high r, as Bitcoin Core's message signing does" $ \ctx -> do+ exportCompactRecSig ctx (signRecMsg ctx keyOne highRMsg)+ `shouldBe` (fromString (highRR ++ highRS), 0)+ convertRecSig ctx (signRecMsg ctx keyOne highRMsg) `shouldNotBe` signMsgLowR ctx keyOne highRMsg+ it "signs with the r and s of signMsg" $ \ctx ->+ property $ \(m :: Msg, k :: SecKey) -> convertRecSig ctx (signRecMsg ctx k m) == signMsg ctx k m+ it "is deterministic" $ \ctx ->+ property $ \(m :: Msg, k :: SecKey) -> signRecMsg ctx k m == signRecMsg ctx k m+ it "gives a recovery id of 0 or 1" $ \ctx ->+ -- The ids 2 and 3 need r below p - n, about one signature in 2^128.+ property $ \(m :: Msg, k :: SecKey) ->+ snd (exportCompactRecSig ctx (signRecMsg ctx k m)) `elem` [0, 1]+ it "produces lower-S signatures" $ \ctx ->+ property $ \(m :: Msg, k :: SecKey) -> isLowS ctx (convertRecSig ctx (signRecMsg ctx k m))+ it "signs and recovers in parallel" $ \ctx ->+ property $ \(xs :: [(Msg, SecKey)]) -> P.runPar $ do+ results <- mapM (P.spawnP . signsAndRecovers ctx) xs+ and <$> mapM P.get results+ where+ signsAndRecovers ctx (m, k) =+ recover ctx (signRecMsg ctx k m) m == Just (derivePubKey ctx k)++-- * Recovery++recoverySpec :: SpecWith Ctx+recoverySpec = describe "recovery" $ do+ it "recovers the key of Bitcoin Core's SignCompact vector" $ \ctx ->+ recovered ctx (coreR ++ coreS ++ "01") coreMsg `shouldBe` Just corePub+ it "recovers another key with the other recovery id" $ \ctx ->+ recovered ctx (coreR ++ coreS ++ "00") coreMsg `shouldBe` Just coreOtherPub+ it "recovers the signer of Bitcoin Core's 'Trust no one' message" $ \ctx ->+ recovered ctx (messageR ++ messageS ++ "01") messageHash `shouldBe` Just messagePub+ it "recovers G from the RFC 6979 vector" $ \ctx -> do+ recovered ctx (satoshiR ++ satoshiS ++ "01") satoshiMsg `shouldBe` Just genCompressed+ recovered ctx (satoshiR ++ satoshiS ++ "00") satoshiMsg `shouldBe` Just satoshiOtherPub+ it "recovers the signing key" $ \ctx ->+ property $ \(m :: Msg, k :: SecKey) ->+ recover ctx (signRecMsg ctx k m) m == Just (derivePubKey ctx k)+ it "recovers a different key for another message" $ \ctx ->+ property $ \(m :: Msg, m' :: Msg, k :: SecKey) ->+ m /= m' ==> recover ctx (signRecMsg ctx k m) m' /= Just (derivePubKey ctx k)+ it "recovers the same key from the high-S form with the parity bit flipped" $ \ctx -> do+ -- The RFC 6979 vector with s replaced by n - s and the id 1 turned into 0.+ recovered ctx (satoshiR ++ satoshiHighS ++ "00") satoshiMsg `shouldBe` Just genCompressed+ recovered ctx (satoshiR ++ satoshiHighS ++ "01") satoshiMsg `shouldNotBe` Just genCompressed+ it "does not apply the lower-S rule" $ \ctx ->+ property $ \(m :: Msg, k :: SecKey) ->+ let (compact, i) = exportCompactRecSig ctx (signRecMsg ctx k m)+ (r, s) = BS.splitAt 32 compact.get+ -- n - s, through the negation of a tweak.+ highS = (fromJust (tweakNegate ctx (fromJust (tweak s)))).get+ high = fromJust (importCompactRecSig ctx (fromJust (compactSig (r <> highS))) (i `xor` 1))+ in recover ctx high m == Just (derivePubKey ctx k)+ where+ recovered ctx sigHex m = bytesToHex . exportPubKey ctx True <$> recover ctx (fromString sigHex) m++-- * The formula++formulaSpec :: SpecWith Ctx+formulaSpec = describe "the formula Q = r⁻¹(s·R − e·G)" $ do+ it "gives R itself for r = 1, s = 1 and a zero hash" $ \ctx ->+ recovered ctx (one ++ one ++ "00") zero `shouldBe` Just pointOne+ it "takes the parity of y from the recovery id" $ \ctx ->+ recovered ctx (one ++ one ++ "01") zero `shouldBe` Just ("03" ++ one)+ it "reduces the hash modulo n" $ \ctx ->+ recovered ctx (one ++ one ++ "00") order `shouldBe` Just pointOne+ it "subtracts e·G" $ \ctx ->+ recovered ctx (one ++ one ++ "00") one `shouldBe` Just pointOneMinusG+ it "multiplies by s" $ \ctx -> do+ recovered ctx (one ++ two ++ "00") zero `shouldBe` Just twicePointOne+ recovered ctx (one ++ orderMinusOne ++ "00") zero `shouldBe` Just ("03" ++ one)+ it "divides by r" $ \ctx ->+ recovered ctx (two ++ one ++ "02") zero `shouldBe` Just halfPointOrderPlusTwo+ it "uses r + n as the x coordinate for the ids 2 and 3" $ \ctx -> do+ recovered ctx (two ++ two ++ "02") zero `shouldBe` Just ("02" ++ orderPlusTwo)+ recovered ctx (two ++ two ++ "03") zero `shouldBe` Just ("03" ++ orderPlusTwo)+ it "gives nothing when no point has the x coordinate" $ \ctx -> do+ recovered ctx (five ++ one ++ "00") zero `shouldBe` Nothing+ recovered ctx (one ++ one ++ "02") zero `shouldBe` Nothing+ recovered ctx (fieldMinusOrderMinusOne ++ one ++ "02") zero `shouldBe` Nothing+ it "gives nothing when r + n reaches the field size" $ \ctx ->+ recovered ctx (fieldMinusOrder ++ one ++ "02") zero `shouldBe` Nothing+ it "gives nothing when s·R − e·G is the point at infinity" $ \ctx -> do+ -- R = G, s = 1 and e = 1: G - G.+ recovered ctx (genX ++ one ++ "00") one `shouldBe` Nothing+ -- With e = 2 instead: (G - 2G) / x = -(x⁻¹)·G.+ recovered ctx (genX ++ one ++ "00") two `shouldBe` Just genNegatedOverX+ where+ recovered ctx sigHex msgHex =+ bytesToHex . exportPubKey ctx True <$> recover ctx (fromString sigHex) (fromString msgHex)++-- * Compact encoding++compactSpec :: SpecWith Ctx+compactSpec = describe "compact encoding" $ do+ it "imports and exports back the same signature" $ \ctx ->+ property $ \(m :: Msg, k :: SecKey) ->+ let s = signRecMsg ctx k m+ (compact, i) = exportCompactRecSig ctx s+ in importCompactRecSig ctx compact i == Just s+ it "accepts the recovery ids 0 to 3 and rejects 4 and 255" $ \ctx -> do+ forM_ [0 .. 3] $ \i -> importCompactRecSig ctx (fromString (one ++ one)) i `shouldSatisfy` isJust+ importCompactRecSig ctx (fromString (one ++ one)) 4 `shouldBe` Nothing+ importCompactRecSig ctx (fromString (one ++ one)) 255 `shouldBe` Nothing+ it "accepts components of 1 and n - 1 and rejects 0 and n" $ \ctx -> do+ importCompactRecSig ctx (fromString (one ++ one)) 0 `shouldSatisfy` isJust+ importCompactRecSig ctx (fromString (orderMinusOne ++ orderMinusOne)) 0 `shouldSatisfy` isJust+ importCompactRecSig ctx (fromString (order ++ one)) 0 `shouldBe` Nothing+ importCompactRecSig ctx (fromString (one ++ order)) 0 `shouldBe` Nothing+ importCompactRecSig ctx (fromString (zero ++ one)) 0 `shouldBe` Nothing+ importCompactRecSig ctx (fromString (one ++ zero)) 0 `shouldBe` Nothing+ it "imports a high-S signature" $ \ctx ->+ importCompactRecSig ctx (fromString (satoshiR ++ satoshiHighS)) 0 `shouldSatisfy` isJust+ it "converts to the signature without the id" $ \ctx -> do+ bytesToHex (exportSig ctx (convertRecSig ctx (fromString (coreR ++ coreS ++ "01")))) `shouldBe` coreDer+ convertRecSig ctx (fromString (coreR ++ coreS ++ "00"))+ `shouldBe` convertRecSig ctx (fromString (coreR ++ coreS ++ "01"))+ it "converts to a signature that verifies" $ \ctx ->+ property $ \(m :: Msg, k :: SecKey) ->+ verifySig ctx (derivePubKey ctx k) (convertRecSig ctx (signRecMsg ctx k m)) m++-- * Signature values++valueSpec :: SpecWith Ctx+valueSpec = describe "signature values" $ do+ it "rebuild from their internal bytes" $ \ctx ->+ property $ \(m :: Msg, k :: SecKey) -> let s = signRecMsg ctx k m in recSig s.get == Just s+ it "reject internal bytes that are not a signature" $ \_ -> do+ recSig (BS.replicate 65 0) `shouldBe` Nothing+ recSig (BS.replicate 65 0xff) `shouldBe` Nothing+ recSig (BS.replicate 64 1) `shouldBe` Nothing+ recSig (BS.replicate 66 1) `shouldBe` Nothing+ it "reject an internal recovery id above 3" $ \ctx -> do+ -- libsecp256k1 keeps the id in the last byte of the representation.+ let bytes = (signRecMsg ctx keyOne satoshiMsg).get+ recSig (BS.init bytes `BS.snoc` 4) `shouldBe` Nothing+ it "show r, s and the recovery id in hex" $ \ctx ->+ show (signRecMsg ctx coreKey coreMsg) `shouldBe` quoted (coreR ++ coreS ++ "01")+ it "read that encoding" $ \ctx -> do+ read (quoted (coreR ++ coreS ++ "01")) `shouldBe` signRecMsg ctx coreKey coreMsg+ (fromString (coreR ++ coreS ++ "01") :: RecSig) `shouldBe` signRecMsg ctx coreKey coreMsg+ it "show and read" $ \ctx ->+ property $ \(m :: Msg, k :: SecKey) -> showRead (signRecMsg ctx k m)+ it "do not read an invalid signature" $ \_ -> do+ (readMaybe (quoted (coreR ++ coreS)) :: Maybe RecSig) `shouldBe` Nothing+ (readMaybe (quoted (coreR ++ coreS ++ "04")) :: Maybe RecSig) `shouldBe` Nothing+ (readMaybe (quoted (zero ++ coreS ++ "01")) :: Maybe RecSig) `shouldBe` Nothing+ (readMaybe (quoted (order ++ coreS ++ "01")) :: Maybe RecSig) `shouldBe` Nothing+ (readMaybe (quoted (coreR ++ coreS ++ "0")) :: Maybe RecSig) `shouldBe` Nothing+ evaluate (fromString (coreR ++ coreS) :: RecSig) `shouldThrow` anyErrorCall++-- * Values built with the raw constructors of the Internal modules++rawValueSpec :: SpecWith Ctx+rawValueSpec = describe "raw values from the Internal modules" $ do+ it "a signature of 65 zero bytes recovers nothing, instead of aborting the process" $ \ctx ->+ recover ctx (RecSig (BS.replicate 65 0)) satoshiMsg `shouldBe` Nothing+ it "a zero secret key throws instead of signing" $ \ctx ->+ evaluate (signRecMsg ctx (SecKey (BS.replicate 32 0)) satoshiMsg) `shouldThrow` anyErrorCall+ it "values of the wrong length throw before reaching the library" $ \ctx -> do+ evaluate (signRecMsg ctx (SecKey "a") satoshiMsg) `shouldThrow` anyErrorCall+ evaluate (signRecMsg ctx keyOne (Msg "a")) `shouldThrow` anyErrorCall+ evaluate (recover ctx (RecSig "a") satoshiMsg) `shouldThrow` anyErrorCall+ evaluate (recover ctx (signRecMsg ctx keyOne satoshiMsg) (Msg "a")) `shouldThrow` anyErrorCall+ evaluate (convertRecSig ctx (RecSig "a")) `shouldThrow` anyErrorCall+ evaluate (exportCompactRecSig ctx (RecSig "a")) `shouldThrow` anyErrorCall+ evaluate (importCompactRecSig ctx (CompactSig "a") 0) `shouldThrow` anyErrorCall+ evaluate (length (show (RecSig "a"))) `shouldThrow` anyErrorCall++-- * Derived instances++instanceSpec :: SpecWith Ctx+instanceSpec = describe "derived instances" $ do+ it "equal values hash equally, whichever way they were built" $ \ctx ->+ property $ \(m :: Msg, k :: SecKey) ->+ let s = signRecMsg ctx k m+ (compact, i) = exportCompactRecSig ctx s+ in hash s == hash (fromJust (importCompactRecSig ctx compact i))+ && hash s == hash (fromJust (recSig s.get))+ it "can be fully evaluated" $ \ctx ->+ (signRecMsg ctx keyOne satoshiMsg `deepseq` ()) `shouldBe` ()++#else++spec :: Spec+spec =+ describe "public key recovery" $+ it "needs the recovery flag of the package" $+ pendingWith "the package was built with -f -recovery"++#endif
test/Crypto/Secp256k1Spec.hs view
@@ -1,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` ()