packages feed

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 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` ()