secp256k1-haskell 0.5.0 → 1.4.6
raw patch · 12 files changed
Files
- CHANGELOG.md +157/−19
- README.md +0/−6
- secp256k1-haskell.cabal +30/−28
- src/Crypto/Secp256k1.hs +44/−433
- src/Crypto/Secp256k1/Internal.hs +0/−270
- src/Crypto/Secp256k1/Internal/Base.hs +435/−0
- src/Crypto/Secp256k1/Internal/BaseOps.hs +163/−0
- src/Crypto/Secp256k1/Internal/Context.hs +100/−0
- src/Crypto/Secp256k1/Internal/ForeignTypes.hs +48/−0
- src/Crypto/Secp256k1/Internal/Util.hs +45/−0
- test/Crypto/Secp256k1/InternalSpec.hs +351/−290
- test/Crypto/Secp256k1Spec.hs +248/−184
CHANGELOG.md view
@@ -4,106 +4,244 @@ The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/) and this project adheres to [Semantic Versioning](http://semver.org/spec/v2.0.0.html). -## 0.5.0+## [1.4.6] - 2025-05-09++### Removed++- Removed more unnecessary file boilerplate.++## [1.4.5] - 2025-05-09++### Removed++- Removed unnecessary file boilerplate.++## [1.4.4] - 2025-05-09+ ### Changed++- Simplify author name.++## [1.4.3] - 2025-05-08++### Changed++- New home in github.com/jprupp rather than github.com/haskoin.++## [1.4.2] - 2024-12-10++### Changed++- Relax all upper-bound version restrictions in `package.yaml`.++## [1.4.1] - 2024-12-10++### Changed++- Relax version restriction on QuickCheck.++## [1.4.0] - 2024-08-28++### Removed++- Removed BIP-340 support. Fedora’s version of secp256k1 libraries do not have required symbols.++## [1.3.0] - 2024-08-28++### Added++- Added BIP-340 support.++## [1.2.0] - 2023-03-14++### Changed++- Make compatible with latest upstream LTS Haskell.++## [1.1.0] - 2023-11-01++### Changed++- Use ForeignPtr to allow the garbage collector manage the context object (Ctx).++## [1.0.1] - 2023-09-20++### Changed++- Reworked the structure of the Internal modules to allow having add-on packages for optional libsecp256k1 features.++## [1.0.0] - 2023-07-28++### Changed++- Context data structure must be created and passed explicitly.+- Field selectors are now short and duplicates are allowed.+- Use DuplicateRecordFields and OverloadedRecordDot language extensions.++## [0.6.1] - 2022-04-18++### Changed++- Bump version and LTS Haskell.+- Update dependencies.++## [0.6.0] - 2021-08-27++### Changed++- Remove all use of CPP.+- Depend on base16 instead of the old base16-bytestring package.+- Target ghc-9.0.1 compiler.++### Fixed++- Do not crash on bytestrings that are backed by null C pointers.++## [0.5.0] - 2020-10-16++### Changed+ - Include version boundaries and other changes submitted by Emily Pillmore. -## 0.4.0+## [0.4.0] - 2020-07-23+ ### Changed+ - Remove fragile ForeignPtr implementation in favor of just storing ByteStrings. - Reuse memory instead of copying when possible. -## 0.3.1+## [0.3.1] - 2020-07-03+ ### Fixed+ - Use unsafe calls in FFI. -## 0.3.0+## [0.3.0] - 2020-06-13+ ### Fixed+ - Compiles with all flags now. ### Added+ - Script to compile with all flags. ### Removed+ - Remove ECDH support. - Remove Schnorr support. - Remove Recovery support. -## 0.2.5+## [0.2.5] - 2020-06-13+ ### Changed+ - Reuse context aggressively. - Generate context in a single thread. ### Fixed+ - Memory deallocation bug. -## 0.2.4+## [0.2.4] - 2020-06-12+ ### Changed+ - Update Cabal and package version. -## 0.2.3+## [0.2.3] - 2020-06-07+ ### Changed+ - Return meaningful error upon encountering weird ret status from upstream code. ### Added+ - Test parallel signature creation and verification. -## 0.2.2+## [0.2.2] - 2020-04-14+ ### Removed+ - Hide tweak negation behind a flag for compatibilidy with Debian 9. ### Fixed+ - Correct code that was not compiling with some flags enabled. -## 0.2.1+## [0.2.1] - 2020-04-10+ ### Changed+ - Do not depend on hardcoded DER signatures in tests. -## 0.2.0+## [0.2.0] - 2020-04-10+ ### Added+ - Support for ECDH APIs. - Support for Schnorr APIs. ### Removed+ - Enabling key recovery APIs need a flag. -## 0.1.8+## [0.1.8] - 2020-01-15+ ### Added+ - Add missing `NFData` instances for some types. -## 0.1.7+## [0.1.7] - 2020-01-15+ ### Added+ - Add `NFData` instances for all types. -## 0.1.6+## [0.1.6] - 2019-12-26+ ### Added+ - Use `pkgconfig` for C library dependency. -## 0.1.5+## [0.1.5] - 2019-09-19+ ### Added+ - Flag for ECDH bindings. -## 0.1.4+## [0.1.4] - 2018-10-25+ ### Changed+ - Constrain imports to avoid clashes with a QuickCheck function. -## 0.1.3+## [0.1.3] - 2018-10-13+ ### Added+ - Hashable instances for various types. -## 0.1.2+## [0.1.2] - 2018-09-10+ ### Changed+ - Separate dependencies between library and tests. - Remove `hspec` default to prevent problems with Nix. ### Removed+ - Dependency to `cryptohash` not needed. -## 0.1.1+## [0.1.1] - 2018-09-10+ ### Changed+ - Update changelog to reflect name and version change. - Update to LTS Haskell 12.9. -## 0.1.0+## [0.1.0] - 2018-09-10+ ### Changed+ - Name of package change from `secp256k1` to `secp256k1-haskell` to avoid Nix conflicts.
− README.md
@@ -1,6 +0,0 @@-[](https://travis-ci.org/haskoin/secp256k1-haskell)--# Haskell bindings for secp256k1--This project contains Haskell bindings for the-[secp256k1](https://github.com/bitcoin-core/secp256k1) library.
secp256k1-haskell.cabal view
@@ -1,34 +1,36 @@-cabal-version: 1.24+cabal-version: 2.0 --- This file has been generated from package.yaml by hpack version 0.34.2.+-- This file has been generated from package.yaml by hpack version 0.38.0. -- -- see: https://github.com/sol/hpack name: secp256k1-haskell-version: 0.5.0+version: 1.4.6 synopsis: Bindings for secp256k1 description: Sign and verify signatures using the secp256k1 library. category: Crypto-homepage: http://github.com/haskoin/secp256k1-haskell#readme-bug-reports: https://github.com/haskoin/secp256k1-haskell.git/issues-author: Jean-Pierre Rupp+homepage: http://github.com/jprupp/secp256k1-haskell#readme+bug-reports: https://github.com/jprupp/secp256k1-haskell/issues+author: JP Rupp maintainer: jprupp@protonmail.ch-copyright: (c) 2017 Jean-Pierre Rupp license: MIT license-file: LICENSE build-type: Simple extra-source-files: CHANGELOG.md- README.md source-repository head type: git- location: https://github.com/haskoin/secp256k1-haskell.git+ location: https://github.com/jprupp/secp256k1-haskell library exposed-modules: Crypto.Secp256k1- Crypto.Secp256k1.Internal+ Crypto.Secp256k1.Internal.Base+ Crypto.Secp256k1.Internal.BaseOps+ Crypto.Secp256k1.Internal.Context+ Crypto.Secp256k1.Internal.ForeignTypes+ Crypto.Secp256k1.Internal.Util Paths_secp256k1_haskell autogen-modules: Paths_secp256k1_haskell@@ -37,16 +39,15 @@ pkgconfig-depends: libsecp256k1 build-depends:- QuickCheck >=2.9.2 && <2.15+ QuickCheck >=2.9.2 , base >=4.9 && <5- , base16-bytestring >=0.1.1.6 && <1.1- , bytestring >=0.10.8 && <0.11- , cereal >=0.5.4 && <0.6- , deepseq >=1.4.2 && <1.5- , entropy >=0.3.8 && <0.5- , hashable >=1.2.6 && <1.4- , string-conversions >=0.4 && <0.5- , unliftio-core >=0.1.0 && <0.3+ , base16 >=1.0+ , bytestring >=0.10.8+ , deepseq >=1.4.2+ , entropy >=0.3.8+ , hashable >=1.2.6+ , string-conversions >=0.4+ , unliftio-core >=0.1.0 default-language: Haskell2010 test-suite spec@@ -56,24 +57,25 @@ Crypto.Secp256k1.InternalSpec Crypto.Secp256k1Spec Paths_secp256k1_haskell+ autogen-modules:+ Paths_secp256k1_haskell hs-source-dirs: test ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: HUnit- , QuickCheck >=2.9.2 && <2.15+ , QuickCheck >=2.9.2 , base >=4.9 && <5- , base16-bytestring >=0.1.1.6 && <1.1- , bytestring >=0.10.8 && <0.11- , cereal >=0.5.4 && <0.6- , deepseq >=1.4.2 && <1.5- , entropy >=0.3.8 && <0.5- , hashable >=1.2.6 && <1.4+ , base16 >=1.0+ , bytestring >=0.10.8+ , deepseq >=1.4.2+ , entropy >=0.3.8+ , hashable >=1.2.6 , hspec , monad-par , mtl , secp256k1-haskell- , string-conversions >=0.4 && <0.5- , unliftio-core >=0.1.0 && <0.3+ , string-conversions >=0.4+ , unliftio-core >=0.1.0 default-language: Haskell2010 build-tool-depends: hspec-discover:hspec-discover
src/Crypto/Secp256k1.hs view
@@ -1,445 +1,56 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-|-Module : Crypto.Secp256k1-License : UNLICENSE-Maintainer : Jean-Pierre Rupp <jprupp@protonmail.ch>-Stability : experimental-Portability : POSIX--Crytpographic functions from Bitcoin’s secp256k1 library.--}+{-# LANGUAGE DuplicateRecordFields #-} module Crypto.Secp256k1- ( -- * Messages- Msg- , msg- , getMsg+ ( -- * Context+ Ctx (..),+ withContext,+ randomizeContext,+ createContext,+ cloneContext,+ destroyContext, + -- * Messages+ Msg (..),+ msg,+ -- * Secret Keys- , SecKey- , secKey- , getSecKey- , derivePubKey+ SecKey (..),+ secKey,+ derivePubKey, -- * Public Keys- , PubKey- , importPubKey- , exportPubKey+ PubKey (..),+ pubKey,+ importPubKey,+ exportPubKey, -- * Signatures- , Sig- , signMsg- , verifySig- , normalizeSig+ Sig (..),+ sig,+ signMsg,+ verifySig,+ normalizeSig,+ -- ** DER- , importSig- , exportSig+ importSig,+ exportSig,+ -- ** Compact- , CompactSig- , getCompactSig- , compactSig- , exportCompactSig- , importCompactSig+ CompactSig (..),+ compactSig,+ exportCompactSig,+ importCompactSig, -- * Addition & Multiplication- , Tweak- , tweak- , getTweak- , tweakAddSecKey- , tweakMulSecKey- , tweakAddPubKey- , tweakMulPubKey- , combinePubKeys- , tweakNegate- ) where--import Control.DeepSeq (NFData)-import Control.Monad (replicateM, unless, (<=<))-import Crypto.Secp256k1.Internal-import Data.ByteString (ByteString)-import qualified Data.ByteString as BS-import qualified Data.ByteString.Base16 as B16-import Data.Hashable (Hashable (..))-import Data.Maybe (fromJust, fromMaybe, isJust)-import Data.Serialize (Serialize (..), getByteString,- putByteString)-import Data.String (IsString (..))-import Data.String.Conversions (ConvertibleStrings, cs)-import Foreign (alloca, allocaArray, allocaBytes,- free, mallocBytes, nullFunPtr,- nullPtr, peek, poke, pokeArray)-import GHC.Generics (Generic)-import System.IO.Unsafe (unsafePerformIO)-import Test.QuickCheck (Arbitrary (..),- arbitraryBoundedRandom, suchThat)-import Text.Read (Lexeme (String), lexP, parens,- pfail, readPrec)--newtype PubKey = PubKey { getPubKey :: ByteString }- deriving (Eq, Generic, NFData)-newtype Msg = Msg { getMsg :: ByteString }- deriving (Eq, Generic, NFData)-newtype Sig = Sig { getSig :: ByteString }- deriving (Eq, Generic, NFData)-newtype SecKey = SecKey { getSecKey :: ByteString }- deriving (Eq, Generic, NFData)-newtype Tweak = Tweak { getTweak :: ByteString }- deriving (Eq, Generic, NFData)-newtype CompactSig = CompactSig { getCompactSig :: ByteString }- deriving (Eq, Generic, NFData)--instance Serialize PubKey where- put (PubKey bs) = putByteString bs- get = PubKey <$> getByteString 64--instance Serialize Msg where- put (Msg m) = putByteString m- get = Msg <$> getByteString 32--instance Serialize Sig where- put (Sig bs) = putByteString bs- get = Sig <$> getByteString 64--instance Serialize SecKey where- put (SecKey bs) = putByteString bs- get = SecKey <$> getByteString 32--instance Serialize Tweak where- put (Tweak bs) = putByteString bs- get = Tweak <$> getByteString 32--instance Serialize CompactSig where- put (CompactSig bs) = putByteString bs- get = CompactSig <$> getByteString 64--decodeHex :: ConvertibleStrings a ByteString => a -> Maybe ByteString-#if MIN_VERSION_base16_bytestring(1,0,0)-decodeHex str = case B16.decode $ cs str of- Right bs -> Just bs- Left _ -> Nothing-#else-decodeHex str = if BS.null r then Just bs else Nothing where- (bs, r) = B16.decode $ cs str-#endif--instance Read PubKey where- readPrec = do- String str <- lexP- maybe pfail return $ importPubKey =<< decodeHex str--instance Hashable PubKey where- i `hashWithSalt` k = i `hashWithSalt` exportPubKey True k--instance IsString PubKey where- fromString = fromMaybe e . (importPubKey <=< decodeHex) where- e = error "Could not decode public key from hex string"--instance Show PubKey where- showsPrec _ = shows . B16.encode . exportPubKey True--instance Read Msg where- readPrec = parens $ do- String str <- lexP- maybe pfail return $ msg =<< decodeHex str--instance Hashable Msg where- i `hashWithSalt` m = i `hashWithSalt` getMsg m--instance IsString Msg where- fromString = fromMaybe e . (msg <=< decodeHex) where- e = error "Could not decode message from hex string"--instance Show Msg where- showsPrec _ = shows . B16.encode . getMsg--instance Read Sig where- readPrec = parens $ do- String str <- lexP- maybe pfail return $ importSig =<< decodeHex str--instance IsString Sig where- fromString = fromMaybe e . (importSig <=< decodeHex) where- e = error "Could not decode signature from hex string"--instance Hashable Sig where- i `hashWithSalt` s = i `hashWithSalt` exportSig s--instance Show Sig where- showsPrec _ = shows . B16.encode . exportSig--instance Read SecKey where- readPrec = parens $ do- String str <- lexP- maybe pfail return $ secKey =<< decodeHex str--instance Hashable SecKey where- i `hashWithSalt` k = i `hashWithSalt` getSecKey k--instance IsString SecKey where- fromString = fromMaybe e . (secKey <=< decodeHex) where- e = error "Colud not decode secret key from hex string"--instance Show SecKey where- showsPrec _ = shows . B16.encode . getSecKey--instance Hashable Tweak where- i `hashWithSalt` t = i `hashWithSalt` getTweak t--instance Read Tweak where- readPrec = parens $ do- String str <- lexP- maybe pfail return $ tweak =<< decodeHex str--instance IsString Tweak where- fromString = fromMaybe e . (tweak <=< decodeHex) where- e = error "Could not decode tweak from hex string"--instance Show Tweak where- showsPrec _ = shows . B16.encode . getTweak---- | Import 32-byte 'ByteString' as 'Msg'.-msg :: ByteString -> Maybe Msg-msg bs- | BS.length bs == 32 = Just (Msg bs)- | otherwise = Nothing---- | Import 32-byte 'ByteString' as 'SecKey'.-secKey :: ByteString -> Maybe SecKey-secKey bs- | BS.length bs == 32 = Just (SecKey bs)- | otherwise = Nothing--compactSig :: ByteString -> Maybe CompactSig-compactSig bs- | BS.length bs == 64 = Just (CompactSig bs)- | otherwise = Nothing---- | Convert signature to a normalized lower-S form. 'Nothing' indicates that it--- was already normal.-normalizeSig :: Sig -> Maybe Sig-normalizeSig (Sig sig) = unsafePerformIO $- unsafeUseByteString sig $ \(sig_in, _) -> do- sig_out <- mallocBytes 64- ret <- ecdsaSignatureNormalize ctx sig_out sig_in- if isSuccess ret- then do- bs <- unsafePackByteString (sig_out, 64)- return (Just (Sig bs))- else do- free sig_out- return Nothing---- | 32-Byte 'ByteString' as 'Tweak'.-tweak :: ByteString -> Maybe Tweak-tweak bs- | BS.length bs == 32 = Just (Tweak bs)- | otherwise = Nothing---- | Import DER-encoded public key.-importPubKey :: ByteString -> Maybe PubKey-importPubKey bs = unsafePerformIO $- unsafeUseByteString bs $ \(input, len) -> do- pub_key <- mallocBytes 64- ret <- ecPubKeyParse ctx pub_key input len- if isSuccess ret- then do- out <- unsafePackByteString (pub_key, 64)- return (Just (PubKey out))- else do- free pub_key- return Nothing---- | Encode public key as DER. First argument 'True' for compressed output.-exportPubKey :: Bool -> PubKey -> ByteString-exportPubKey compress (PubKey in_bs) = unsafePerformIO $- unsafeUseByteString in_bs $ \(in_ptr, _) ->- alloca $ \len_ptr ->- allocaBytes len $ \out_ptr -> do- poke len_ptr $ fromIntegral len- ret <- ecPubKeySerialize ctx out_ptr len_ptr in_ptr flags- unless (isSuccess ret) $ error "could not serialize public key"- final_len <- peek len_ptr- packByteString (out_ptr, final_len)- where- len = if compress then 33 else 65- flags = if compress then compressed else uncompressed--exportCompactSig :: Sig -> CompactSig-exportCompactSig (Sig sig_bs) = unsafePerformIO $- unsafeUseByteString sig_bs $ \(sig_ptr, _) -> do- out_ptr <- mallocBytes 64- ret <- ecdsaSignatureSerializeCompact ctx out_ptr sig_ptr- unless (isSuccess ret) $ do- free out_ptr- error "Could not obtain compact signature"- out_bs <- unsafePackByteString (out_ptr, 64)- return $ CompactSig out_bs--importCompactSig :: CompactSig -> Maybe Sig-importCompactSig (CompactSig compact_sig) = unsafePerformIO $- unsafeUseByteString compact_sig $ \(compact_ptr, _) -> do- out_sig <- mallocBytes 64- ret <- ecdsaSignatureParseCompact ctx out_sig compact_ptr- if isSuccess ret- then do- out_bs <- unsafePackByteString (out_sig, 64)- return (Just (Sig out_bs))- else do- free out_sig- return Nothing---- | Import DER-encoded signature.-importSig :: ByteString -> Maybe Sig-importSig bs = unsafePerformIO $- unsafeUseByteString bs $ \(in_ptr, in_len) -> do- out_sig <- mallocBytes 64- ret <- ecdsaSignatureParseDer ctx out_sig in_ptr in_len- if isSuccess ret- then do- out_bs <- unsafePackByteString (out_sig, 64)- return (Just (Sig out_bs))- else do- free out_sig- return Nothing---- | Encode signature as strict DER.-exportSig :: Sig -> ByteString-exportSig (Sig in_sig) = unsafePerformIO $- unsafeUseByteString in_sig $ \(in_ptr, _) ->- alloca $ \out_len ->- allocaBytes 72 $ \out_ptr -> do- poke out_len 72- ret <- ecdsaSignatureSerializeDer ctx out_ptr out_len in_ptr- unless (isSuccess ret) $ error "could not serialize signature"- final_len <- peek out_len- packByteString (out_ptr, final_len)---- | Verify message signature. 'True' means that the signature is correct.-verifySig :: PubKey -> Sig -> Msg -> Bool-verifySig (PubKey pub_key) (Sig sig) (Msg m) = unsafePerformIO $- unsafeUseByteString pub_key $ \(pub_key_ptr, _) ->- unsafeUseByteString sig $ \(sig_ptr, _) ->- unsafeUseByteString m $ \(msg_ptr, _) ->- isSuccess <$> ecdsaVerify ctx sig_ptr msg_ptr pub_key_ptr--signMsg :: SecKey -> Msg -> Sig-signMsg (SecKey sec_key) (Msg m) = unsafePerformIO $- unsafeUseByteString sec_key $ \(sec_key_ptr, _) ->- unsafeUseByteString m $ \(msg_ptr, _) -> do- sig_ptr <- mallocBytes 64- ret <- ecdsaSign ctx sig_ptr msg_ptr sec_key_ptr nullFunPtr nullPtr- unless (isSuccess ret) $ do- free sig_ptr- error "could not sign message"- Sig <$> unsafePackByteString (sig_ptr, 64)--derivePubKey :: SecKey -> PubKey-derivePubKey (SecKey sec_key) = unsafePerformIO $- unsafeUseByteString sec_key $ \(sec_key_ptr, _) -> do- pub_key_ptr <- mallocBytes 64- ret <- ecPubKeyCreate ctx pub_key_ptr sec_key_ptr- unless (isSuccess ret) $ do- free pub_key_ptr- error "could not compute public key"- PubKey <$> unsafePackByteString (pub_key_ptr, 64)----- | Add tweak to secret key.-tweakAddSecKey :: SecKey -> Tweak -> Maybe SecKey-tweakAddSecKey (SecKey sec_key) (Tweak t) = unsafePerformIO $- unsafeUseByteString new_bs $ \(sec_key_ptr, _) ->- unsafeUseByteString t $ \(tweak_ptr, _) -> do- ret <- ecSecKeyTweakAdd ctx sec_key_ptr tweak_ptr- if isSuccess ret- then return (Just (SecKey new_bs))- else return Nothing- where- new_bs = BS.copy sec_key---- | Multiply secret key by tweak.-tweakMulSecKey :: SecKey -> Tweak -> Maybe SecKey-tweakMulSecKey (SecKey sec_key) (Tweak t) = unsafePerformIO $- unsafeUseByteString new_bs $ \(sec_key_ptr, _) ->- unsafeUseByteString t $ \(tweak_ptr, _) -> do- ret <- ecSecKeyTweakMul ctx sec_key_ptr tweak_ptr- if isSuccess ret- then return (Just (SecKey new_bs))- else return Nothing- where- new_bs = BS.copy sec_key---- | Add tweak to public key. Tweak is multiplied first by G to obtain a point.-tweakAddPubKey :: PubKey -> Tweak -> Maybe PubKey-tweakAddPubKey (PubKey pub_key) (Tweak t) = unsafePerformIO $- unsafeUseByteString new_bs $ \(pub_key_ptr, _) ->- unsafeUseByteString t $ \(tweak_ptr, _) -> do- ret <- ecPubKeyTweakAdd ctx pub_key_ptr tweak_ptr- if isSuccess ret- then return (Just (PubKey new_bs))- else return Nothing- where- new_bs = BS.copy pub_key---- | Multiply public key by tweak. Tweak is multiplied first by G to obtain a--- point.-tweakMulPubKey :: PubKey -> Tweak -> Maybe PubKey-tweakMulPubKey (PubKey pub_key) (Tweak t) = unsafePerformIO $- unsafeUseByteString new_bs $ \(pub_key_ptr, _) ->- unsafeUseByteString t $ \(tweak_ptr, _) -> do- ret <- ecPubKeyTweakMul ctx pub_key_ptr tweak_ptr- if isSuccess ret- then return (Just (PubKey new_bs))- else return Nothing- where- new_bs = BS.copy pub_key---- | Add multiple public keys together.-combinePubKeys :: [PubKey] -> Maybe PubKey-combinePubKeys [] = Nothing-combinePubKeys pubs = unsafePerformIO $- pointers [] pubs $ \ps ->- allocaArray (length ps) $ \a -> do- out <- mallocBytes 64- pokeArray a ps- ret <- ecPubKeyCombine ctx out a (fromIntegral $ length ps)- if isSuccess ret- then do- bs <- unsafePackByteString (out, 64)- return (Just (PubKey bs))- else do- free out- return Nothing- where- pointers ps [] f = f ps- pointers ps (PubKey pub_key : pub_keys) f =- unsafeUseByteString pub_key $ \(p, _) ->- pointers (p : ps) pub_keys f--tweakNegate :: Tweak -> Maybe Tweak-tweakNegate (Tweak t) = unsafePerformIO $- unsafeUseByteString new $ \(out, _) -> do- ret <- ecTweakNegate ctx out- if isSuccess ret- then return (Just (Tweak new))- else return Nothing- where- new = BS.copy t--instance Arbitrary Msg where- arbitrary = gen_msg- where- valid_bs = bs_gen `suchThat` isJust- bs_gen = msg . BS.pack <$> replicateM 32 arbitraryBoundedRandom- gen_msg = fromJust <$> valid_bs--instance Arbitrary SecKey where- arbitrary = gen_key where- valid_bs = bs_gen `suchThat` isJust- bs_gen = secKey . BS.pack <$> replicateM 32 arbitraryBoundedRandom- gen_key = fromJust <$> valid_bs+ Tweak (..),+ tweak,+ tweakAddSecKey,+ tweakMulSecKey,+ tweakAddPubKey,+ tweakMulPubKey,+ combinePubKeys,+ tweakNegate,+ )+where -instance Arbitrary PubKey where- arbitrary = derivePubKey <$> arbitrary+import Crypto.Secp256k1.Internal.Base+import Crypto.Secp256k1.Internal.Context
− src/Crypto/Secp256k1/Internal.hs
@@ -1,270 +0,0 @@-{-|-Module : Crypto.Secp256k1.Internal-License : UNLICENSE-Maintainer : Jean-Pierre Rupp <jprupp@protonmail.ch>-Stability : experimental-Portability : POSIX--The API for this module may change at any time. This is an internal module only-exposed for hacking and experimentation.--}-module Crypto.Secp256k1.Internal where--import Data.ByteString (ByteString)-import qualified Data.ByteString as BS-import qualified Data.ByteString.Unsafe as BU-import Foreign (FunPtr, Ptr, castPtr)-import Foreign.C (CInt (..), CSize (..), CString, CUChar,- CUInt (..))-import System.IO.Unsafe (unsafePerformIO)--data LCtx-data PubKey64-data Msg32-data Sig64-data Compact64-data Seed32-data SecKey32-data Tweak32--type CtxFlags = CUInt-type SerFlags = CUInt-type Ret = CInt--type NonceFun a =- Ptr CUChar ->- Ptr CUChar ->- Ptr CUChar ->- Ptr CUChar ->- Ptr a ->- CInt ->- IO CInt--type Ctx = Ptr LCtx--verify :: CtxFlags-verify = 0x0101--sign :: CtxFlags-sign = 0x0201--signVerify :: CtxFlags-signVerify = 0x0301--compressed :: SerFlags-compressed = 0x0102--uncompressed :: SerFlags-uncompressed = 0x0002--isSuccess :: Ret -> Bool-isSuccess 0 = False-isSuccess 1 = True-isSuccess n = error $ "isSuccess expected 0 or 1 but got " ++ show n--unsafeUseByteString :: ByteString -> ((Ptr a, CSize) -> IO b) -> IO b-unsafeUseByteString bs f =- BU.unsafeUseAsCStringLen bs $ \(b, l) ->- f (castPtr b, fromIntegral l)--useByteString :: ByteString -> ((Ptr a, CSize) -> IO b) -> IO b-useByteString bs f =- BS.useAsCStringLen bs $ \(b, l) ->- f (castPtr b, fromIntegral l)--unsafePackByteString :: (Ptr a, CSize) -> IO ByteString-unsafePackByteString (b, l) =- BU.unsafePackMallocCStringLen (castPtr b, fromIntegral l)--packByteString :: (Ptr a, CSize) -> IO ByteString-packByteString (b, l) =- BS.packCStringLen (castPtr b, fromIntegral l)--ctx :: Ctx-ctx = unsafePerformIO $ contextCreate signVerify-{-# NOINLINE ctx #-}--foreign import ccall safe- "secp256k1.h secp256k1_context_create"- contextCreate- :: CtxFlags- -> IO Ctx--foreign import ccall safe- "secp256k1.h secp256k1_context_clone"- contextClone- :: Ctx- -> IO Ctx--foreign import ccall safe- "secp256k1.h &secp256k1_context_destroy"- contextDestroy- :: FunPtr (Ctx -> IO ())--foreign import ccall safe- "secp256k1.h secp256k1_context_set_illegal_callback"- setIllegalCallback- :: Ctx- -> FunPtr (CString -> Ptr a -> IO ()) -- ^ message, data- -> Ptr a -- ^ data- -> IO ()--foreign import ccall safe- "secp256k1.h secp256k1_context_set_error_callback"- setErrorCallback- :: Ctx- -> FunPtr (CString -> Ptr a -> IO ()) -- ^ message, data- -> Ptr a -- ^ data- -> IO ()--foreign import ccall safe- "secp256k1.h secp256k1_ec_pubkey_parse"- ecPubKeyParse- :: Ctx- -> Ptr PubKey64- -> Ptr CUChar -- ^ encoded public key array- -> CSize -- ^ size of encoded public key array- -> IO Ret--foreign import ccall safe- "secp256k1.h secp256k1_ec_pubkey_serialize"- ecPubKeySerialize- :: Ctx- -> Ptr CUChar -- ^ array for encoded public key, must be large enough- -> Ptr CSize -- ^ size of encoded public key, will be updated- -> Ptr PubKey64- -> SerFlags- -> IO Ret--foreign import ccall safe- "secp256k1.h secp256k1_ecdsa_signature_parse_compact"- ecdsaSignatureParseCompact- :: Ctx- -> Ptr Sig64- -> Ptr Compact64- -> IO Ret---foreign import ccall safe- "secp256k1.h secp256k1_ecdsa_signature_parse_der"- ecdsaSignatureParseDer- :: Ctx- -> Ptr Sig64- -> Ptr CUChar -- ^ encoded DER signature- -> CSize -- ^ size of encoded signature- -> IO Ret--foreign import ccall safe- "secp256k1.h secp256k1_ecdsa_signature_serialize_der"- ecdsaSignatureSerializeDer- :: Ctx- -> Ptr CUChar -- ^ array for encoded signature, must be large enough- -> Ptr CSize -- ^ size of encoded signature, will be updated- -> Ptr Sig64- -> IO Ret--foreign import ccall safe- "secp256k1.h secp256k1_ecdsa_signature_serialize_compact"- ecdsaSignatureSerializeCompact- :: Ctx- -> Ptr Compact64- -> Ptr Sig64- -> IO Ret--foreign import ccall safe- "secp256k1.h secp256k1_ecdsa_verify"- ecdsaVerify- :: Ctx- -> Ptr Sig64- -> Ptr Msg32- -> Ptr PubKey64- -> IO Ret--foreign import ccall safe- "secp256k1.h secp256k1_ecdsa_signature_normalize"- ecdsaSignatureNormalize- :: Ctx- -> Ptr Sig64 -- ^ output- -> Ptr Sig64 -- ^ input- -> IO Ret--foreign import ccall safe- "secp256k1.h secp256k1_ecdsa_sign"- ecdsaSign- :: Ctx- -> Ptr Sig64- -> Ptr Msg32- -> Ptr SecKey32- -> FunPtr (NonceFun a)- -> Ptr a -- ^ nonce data- -> IO Ret--foreign import ccall safe- "secp256k1.h secp256k1_ec_seckey_verify"- ecSecKeyVerify- :: Ctx- -> Ptr SecKey32- -> IO Ret--foreign import ccall safe- "secp256k1.h secp256k1_ec_pubkey_create"- ecPubKeyCreate- :: Ctx- -> Ptr PubKey64- -> Ptr SecKey32- -> IO Ret--foreign import ccall safe- "secp256k1.h secp256k1_ec_privkey_tweak_add"- ecSecKeyTweakAdd- :: Ctx- -> Ptr SecKey32- -> Ptr Tweak32- -> IO Ret--foreign import ccall safe- "secp256k1.h secp256k1_ec_privkey_negate"- ecTweakNegate- :: Ctx- -> Ptr Tweak32- -> IO Ret--foreign import ccall unsafe- "secp256k1.h secp256k1_ec_pubkey_tweak_add"- ecPubKeyTweakAdd- :: Ctx- -> Ptr PubKey64- -> Ptr Tweak32- -> IO Ret--foreign import ccall safe- "secp256k1.h secp256k1_ec_privkey_tweak_mul"- ecSecKeyTweakMul- :: Ctx- -> Ptr SecKey32- -> Ptr Tweak32- -> IO Ret--foreign import ccall safe- "secp256k1.h secp256k1_ec_pubkey_tweak_mul"- ecPubKeyTweakMul- :: Ctx- -> Ptr PubKey64- -> Ptr Tweak32- -> IO Ret--foreign import ccall safe- "secp256k1.h secp256k1_context_randomize"- contextRandomize- :: Ctx- -> Ptr Seed32- -> IO Ret--foreign import ccall safe- "secp256k1.h secp256k1_ec_pubkey_combine"- ecPubKeyCombine- :: Ctx- -> Ptr PubKey64 -- ^ pointer to public key storage- -> Ptr (Ptr PubKey64) -- ^ pointer to array of public keys- -> CInt -- ^ number of public keys- -> IO Ret
+ src/Crypto/Secp256k1/Internal/Base.hs view
@@ -0,0 +1,435 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedRecordDot #-}+{-# LANGUAGE NoFieldSelectors #-}+module Crypto.Secp256k1.Internal.Base where++import Control.DeepSeq (NFData)+import Control.Exception (bracket)+import Control.Monad (replicateM, unless, (<=<))+import Crypto.Secp256k1.Internal.BaseOps+ ( ecPubKeyCombine,+ ecPubKeyCreate,+ ecPubKeyParse,+ ecPubKeySerialize,+ ecPubKeyTweakAdd,+ ecPubKeyTweakMul,+ ecSecKeyTweakAdd,+ ecSecKeyTweakMul,+ ecTweakNegate,+ ecdsaSign,+ ecdsaSignatureNormalize,+ ecdsaSignatureParseCompact,+ ecdsaSignatureParseDer,+ ecdsaSignatureSerializeCompact,+ ecdsaSignatureSerializeDer,+ ecdsaVerify,+ )+import Crypto.Secp256k1.Internal.Context (Ctx (..))+import Crypto.Secp256k1.Internal.ForeignTypes+ ( LCtx,+ compressed,+ isSuccess,+ uncompressed,+ )+import Crypto.Secp256k1.Internal.Util+ ( decodeHex,+ packByteString,+ showsHex,+ unsafePackByteString,+ unsafeUseByteString,+ )+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 Foreign+ ( Bits (bitSize),+ Ptr,+ alloca,+ allocaArray,+ allocaBytes,+ free,+ mallocBytes,+ nullFunPtr,+ nullPtr,+ peek,+ poke,+ pokeArray,+ withForeignPtr,+ )+import GHC.Generics (Generic)+import System.IO.Unsafe (unsafePerformIO)+import Test.QuickCheck+ ( Arbitrary (..),+ arbitraryBoundedRandom,+ suchThat,+ )+import Text.Read+ ( Lexeme (String),+ lexP,+ parens,+ pfail,+ readPrec,+ )++newtype PubKey = PubKey {get :: ByteString}+ deriving (Eq, Generic, Hashable, NFData)++newtype Msg = Msg {get :: ByteString}+ deriving (Eq, Generic, Hashable, NFData)++newtype Sig = Sig {get :: ByteString}+ deriving (Eq, Generic, Hashable, NFData)++newtype SecKey = SecKey {get :: ByteString}+ deriving (Eq, Generic, Hashable, NFData)++newtype Tweak = Tweak {get :: ByteString}+ deriving (Eq, Generic, Hashable, NFData)++newtype CompactSig = CompactSig {get :: ByteString}+ deriving (Eq, Generic, Hashable, NFData)++instance Read PubKey where+ readPrec = parens $ do+ String str <- lexP+ maybe pfail return $ pubKey =<< decodeHex str++instance IsString PubKey where+ fromString = fromMaybe e . (pubKey <=< decodeHex)+ where+ e = error "Could not decode public key from hex string"++instance Show PubKey where+ showsPrec _ = showsHex . (.get)++instance Read Msg where+ readPrec = parens $ do+ String str <- lexP+ maybe pfail return $ msg =<< decodeHex str++instance IsString Msg where+ fromString = fromMaybe e . (msg <=< decodeHex)+ where+ e = error "Could not decode message from hex string"++instance Show Msg where+ showsPrec _ = showsHex . (.get)++instance Read Sig where+ readPrec = parens $ do+ String str <- lexP+ maybe pfail return $ sig =<< decodeHex str++instance IsString Sig where+ fromString = fromMaybe e . (sig <=< decodeHex)+ where+ e = error "Could not decode signature from hex string"++instance Show Sig where+ showsPrec _ = showsHex . (.get)++instance Read SecKey where+ readPrec = parens $ do+ String str <- lexP+ maybe pfail return $ secKey =<< decodeHex str++instance IsString SecKey where+ fromString = fromMaybe e . (secKey <=< decodeHex)+ where+ e = error "Colud not decode secret key from hex string"++instance Show SecKey where+ showsPrec _ = showsHex . (.get)++instance Read Tweak where+ readPrec = parens $ do+ String str <- lexP+ maybe pfail return $ tweak =<< decodeHex str++instance IsString Tweak where+ fromString = fromMaybe e . (tweak <=< decodeHex)+ where+ e = error "Could not decode tweak from hex string"++instance Show Tweak where+ showsPrec _ = showsHex . (.get)++-- | Import 64-byte 'ByteString' as 'Sig'.+sig :: ByteString -> Maybe Sig+sig bs+ | BS.length bs == 64 = Just (Sig bs)+ | otherwise = Nothing++-- | Import 64-byte 'ByteString' as 'PubKey'.+pubKey :: ByteString -> Maybe PubKey+pubKey bs+ | BS.length bs == 64 = Just (PubKey bs)+ | otherwise = Nothing++-- | Import 32-byte 'ByteString' as 'Msg'.+msg :: ByteString -> Maybe Msg+msg bs+ | BS.length bs == 32 = Just (Msg bs)+ | otherwise = Nothing++-- | Import 32-byte 'ByteString' as 'SecKey'.+secKey :: ByteString -> Maybe SecKey+secKey bs+ | BS.length bs == 32 = Just (SecKey bs)+ | otherwise = Nothing++compactSig :: ByteString -> Maybe CompactSig+compactSig bs+ | BS.length bs == 64 = Just (CompactSig bs)+ | otherwise = Nothing++-- | Convert signature to a normalized lower-S form. 'Nothing' indicates that it+-- was already normal.+normalizeSig :: Ctx -> Sig -> Maybe Sig+normalizeSig (Ctx fctx) (Sig sig) =+ 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++-- | 32-Byte 'ByteString' as 'Tweak'.+tweak :: ByteString -> Maybe Tweak+tweak bs+ | BS.length bs == 32 = Just (Tweak bs)+ | otherwise = Nothing++-- | Import DER-encoded public key.+importPubKey :: 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++-- | Encode public key as DER. First argument 'True' for compressed output.+exportPubKey :: Ctx -> Bool -> PubKey -> ByteString+exportPubKey (Ctx fctx) compress (PubKey in_bs) =+ unsafePerformIO $ withForeignPtr fctx $ \ctx ->+ unsafeUseByteString in_bs $ \(in_ptr, _) ->+ alloca $ \len_ptr ->+ allocaBytes len $ \out_ptr -> do+ poke len_ptr $ fromIntegral len+ ret <- ecPubKeySerialize ctx out_ptr len_ptr in_ptr flags+ unless (isSuccess ret) $ error "could not serialize public key"+ final_len <- peek len_ptr+ packByteString (out_ptr, final_len)+ where+ len = if compress then 33 else 65+ flags = if compress then compressed else uncompressed++exportCompactSig :: 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++importCompactSig :: Ctx -> CompactSig -> Maybe Sig+importCompactSig (Ctx fctx) (CompactSig compact_sig) =+ 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++-- | Import DER-encoded signature.+importSig :: Ctx -> ByteString -> Maybe Sig+importSig (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++-- | Encode signature as strict DER.+exportSig :: Ctx -> Sig -> ByteString+exportSig (Ctx fctx) (Sig in_sig) =+ unsafePerformIO $ withForeignPtr fctx $ \ctx ->+ unsafeUseByteString in_sig $ \(in_ptr, _) ->+ alloca $ \out_len ->+ allocaBytes 72 $ \out_ptr -> do+ poke out_len 72+ ret <- ecdsaSignatureSerializeDer ctx out_ptr out_len in_ptr+ unless (isSuccess ret) $ error "could not serialize signature"+ final_len <- peek out_len+ packByteString (out_ptr, final_len)++-- | Verify message signature. 'True' means that the signature is correct.+verifySig :: Ctx -> PubKey -> Sig -> Msg -> Bool+verifySig (Ctx fctx) (PubKey pub_key) (Sig sig) (Msg m) =+ unsafePerformIO $ withForeignPtr fctx $ \ctx ->+ unsafeUseByteString pub_key $ \(pub_key_ptr, _) ->+ unsafeUseByteString sig $ \(sig_ptr, _) ->+ unsafeUseByteString m $ \(msg_ptr, _) ->+ isSuccess <$> ecdsaVerify ctx sig_ptr msg_ptr pub_key_ptr++signMsg :: Ctx -> SecKey -> Msg -> Sig+signMsg (Ctx fctx) (SecKey sec_key) (Msg m) =+ 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)++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)++-- | Add tweak to secret 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++-- | Multiply secret key by tweak.+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++-- | Add tweak to public key. Tweak is multiplied first by G to obtain a point.+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++-- | Multiply public key by tweak. Tweak is multiplied first by G to obtain a+-- point.+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++-- | Add multiple public keys together.+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+ where+ pointers ps [] f = f ps+ pointers ps (PubKey pub_key : pub_keys) f =+ unsafeUseByteString pub_key $ \(p, _) ->+ pointers (p : ps) pub_keys f++tweakNegate :: Ctx -> Tweak -> Maybe Tweak+tweakNegate (Ctx fctx) (Tweak t) =+ unsafePerformIO $ withForeignPtr fctx $ \ctx ->+ unsafeUseByteString new $ \(out, _) -> do+ ret <- ecTweakNegate ctx out+ if isSuccess ret+ then return (Just (Tweak new))+ else return Nothing+ where+ new = BS.copy t++instance Arbitrary Msg where+ arbitrary = gen_msg+ where+ valid_bs = bs_gen `suchThat` isJust+ bs_gen = msg . BS.pack <$> replicateM 32 arbitraryBoundedRandom+ gen_msg = fromJust <$> valid_bs++instance Arbitrary SecKey where+ arbitrary = gen_key+ where+ valid_bs = bs_gen `suchThat` isJust+ bs_gen = secKey . BS.pack <$> replicateM 32 arbitraryBoundedRandom+ gen_key = fromJust <$> valid_bs
+ src/Crypto/Secp256k1/Internal/BaseOps.hs view
@@ -0,0 +1,163 @@+module Crypto.Secp256k1.Internal.BaseOps where++import Crypto.Secp256k1.Internal.ForeignTypes+ ( Compact64,+ LCtx,+ Msg32,+ NonceFun,+ PubKey64,+ Ret,+ SecKey32,+ Seed32,+ SerFlags,+ Sig64,+ Tweak32,+ )+import Foreign (FunPtr, Ptr)+import Foreign.C+ ( CInt (..),+ CSize (..),+ CUChar,+ CUInt (..),+ )++foreign import ccall safe "secp256k1.h secp256k1_ec_pubkey_parse"+ ecPubKeyParse ::+ Ptr LCtx ->+ Ptr PubKey64 ->+ -- | encoded public key array+ Ptr CUChar ->+ -- | size of encoded public key array+ CSize ->+ IO Ret++foreign import ccall safe "secp256k1.h secp256k1_ec_pubkey_serialize"+ ecPubKeySerialize ::+ Ptr LCtx ->+ -- | array for encoded public key, must be large enough+ Ptr CUChar ->+ -- | size of encoded public key, will be updated+ Ptr CSize ->+ Ptr PubKey64 ->+ SerFlags ->+ IO Ret++foreign import ccall safe "secp256k1.h secp256k1_ecdsa_signature_parse_compact"+ ecdsaSignatureParseCompact ::+ Ptr LCtx ->+ Ptr Sig64 ->+ Ptr Compact64 ->+ IO Ret++foreign import ccall safe "secp256k1.h secp256k1_ecdsa_signature_parse_der"+ ecdsaSignatureParseDer ::+ Ptr LCtx ->+ Ptr Sig64 ->+ -- | encoded DER signature+ Ptr CUChar ->+ -- | size of encoded signature+ CSize ->+ IO Ret++foreign import ccall safe "secp256k1.h secp256k1_ecdsa_signature_serialize_der"+ ecdsaSignatureSerializeDer ::+ Ptr LCtx ->+ -- | array for encoded signature, must be large enough+ Ptr CUChar ->+ -- | size of encoded signature, will be updated+ Ptr CSize ->+ Ptr Sig64 ->+ IO Ret++foreign import ccall safe "secp256k1.h secp256k1_ecdsa_signature_serialize_compact"+ ecdsaSignatureSerializeCompact ::+ Ptr LCtx ->+ Ptr Compact64 ->+ Ptr Sig64 ->+ IO Ret++foreign import ccall safe "secp256k1.h secp256k1_ecdsa_verify"+ ecdsaVerify ::+ Ptr LCtx ->+ Ptr Sig64 ->+ Ptr Msg32 ->+ Ptr PubKey64 ->+ IO Ret++foreign import ccall safe "secp256k1.h secp256k1_ecdsa_signature_normalize"+ ecdsaSignatureNormalize ::+ Ptr LCtx ->+ -- | output+ Ptr Sig64 ->+ -- | input+ Ptr Sig64 ->+ IO Ret++foreign import ccall safe "secp256k1.h secp256k1_ecdsa_sign"+ ecdsaSign ::+ Ptr LCtx ->+ Ptr Sig64 ->+ Ptr Msg32 ->+ Ptr SecKey32 ->+ FunPtr (NonceFun a) ->+ -- | nonce data+ Ptr a ->+ IO Ret++foreign import ccall safe "secp256k1.h secp256k1_ec_seckey_verify"+ ecSecKeyVerify ::+ Ptr LCtx ->+ Ptr SecKey32 ->+ IO Ret++foreign import ccall safe "secp256k1.h secp256k1_ec_pubkey_create"+ ecPubKeyCreate ::+ Ptr LCtx ->+ Ptr PubKey64 ->+ Ptr SecKey32 ->+ IO Ret++foreign import ccall safe "secp256k1.h secp256k1_ec_privkey_tweak_add"+ ecSecKeyTweakAdd ::+ Ptr LCtx ->+ Ptr SecKey32 ->+ Ptr Tweak32 ->+ IO Ret++foreign import ccall safe "secp256k1.h secp256k1_ec_privkey_negate"+ ecTweakNegate ::+ Ptr LCtx ->+ Ptr Tweak32 ->+ IO Ret++foreign import ccall unsafe "secp256k1.h secp256k1_ec_pubkey_tweak_add"+ ecPubKeyTweakAdd ::+ Ptr LCtx ->+ Ptr PubKey64 ->+ Ptr Tweak32 ->+ IO Ret++foreign import ccall safe "secp256k1.h secp256k1_ec_privkey_tweak_mul"+ ecSecKeyTweakMul ::+ Ptr LCtx ->+ Ptr SecKey32 ->+ Ptr Tweak32 ->+ IO Ret++foreign import ccall safe "secp256k1.h secp256k1_ec_pubkey_tweak_mul"+ ecPubKeyTweakMul ::+ Ptr LCtx ->+ Ptr PubKey64 ->+ Ptr Tweak32 ->+ IO Ret++foreign import ccall safe "secp256k1.h secp256k1_ec_pubkey_combine"+ ecPubKeyCombine ::+ Ptr LCtx ->+ -- | pointer to public key storage+ Ptr PubKey64 ->+ -- | pointer to array of public keys+ Ptr (Ptr PubKey64) ->+ -- | number of public keys+ CInt ->+ IO Ret
+ src/Crypto/Secp256k1/Internal/Context.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE NoFieldSelectors #-}+module Crypto.Secp256k1.Internal.Context where++import Control.Exception (bracket, mask_)+import Control.Monad (unless)+import Crypto.Secp256k1.Internal.ForeignTypes+ ( CtxFlags,+ LCtx,+ Ret,+ Seed32,+ isSuccess,+ )+import Crypto.Secp256k1.Internal.Util (withRandomSeed)+import Foreign (FunPtr, Ptr)+import Foreign.C (CInt (..), CString, CUInt (..))+import Foreign.ForeignPtr+ ( FinalizerPtr,+ ForeignPtr,+ finalizeForeignPtr,+ newForeignPtr,+ withForeignPtr,+ )+import GHC.Conc (writeTVar)+import System.IO.Unsafe (unsafePerformIO)++newtype Ctx = Ctx {get :: ForeignPtr LCtx}++randomizeContext :: Ctx -> IO ()+randomizeContext (Ctx fctx) = withForeignPtr fctx $ \ctx -> do+ ret <- withRandomSeed $ contextRandomize ctx+ unless (isSuccess ret) $ error "Could not randomize context"++createContext :: IO Ctx+createContext = do+ ctx <- mask_ $ do+ pctx <- contextCreate signVerify+ Ctx <$> newForeignPtr contextDestroyFunPtr pctx+ randomizeContext ctx+ return ctx++cloneContext :: Ctx -> IO Ctx+cloneContext (Ctx fctx) =+ withForeignPtr fctx $ \ctx -> mask_ $ do+ ctx' <- contextClone ctx+ Ctx <$> newForeignPtr contextDestroyFunPtr ctx'++destroyContext :: Ctx -> IO ()+destroyContext (Ctx fctx)= finalizeForeignPtr fctx++withContext :: (Ctx -> IO a) -> IO a+withContext = (createContext >>=)++verify :: CtxFlags+verify = 0x0101++sign :: CtxFlags+sign = 0x0201++signVerify :: CtxFlags+signVerify = 0x0301++foreign import ccall safe "secp256k1.h secp256k1_context_create"+ contextCreate ::+ CtxFlags ->+ IO (Ptr LCtx)++foreign import ccall safe "secp256k1.h secp256k1_context_clone"+ contextClone ::+ Ptr LCtx ->+ IO (Ptr LCtx)++foreign import ccall safe "secp256k1.h secp256k1_context_destroy"+ contextDestroy :: Ptr LCtx -> IO ()++foreign import ccall safe "secp256k1.h &secp256k1_context_destroy"+ contextDestroyFunPtr :: FunPtr (Ptr LCtx -> IO ())++foreign import ccall safe "secp256k1.h secp256k1_context_set_illegal_callback"+ setIllegalCallback ::+ Ptr LCtx ->+ -- | message, data+ FunPtr (CString -> Ptr a -> IO ()) ->+ -- | data+ Ptr a ->+ IO ()++foreign import ccall safe "secp256k1.h secp256k1_context_set_error_callback"+ setErrorCallback ::+ Ptr LCtx ->+ -- | message, data+ FunPtr (CString -> Ptr a -> IO ()) ->+ -- | data+ Ptr a ->+ IO ()++foreign import ccall safe "secp256k1.h secp256k1_context_randomize"+ contextRandomize ::+ Ptr LCtx ->+ Ptr Seed32 ->+ IO Ret
+ src/Crypto/Secp256k1/Internal/ForeignTypes.hs view
@@ -0,0 +1,48 @@+module Crypto.Secp256k1.Internal.ForeignTypes where++import Foreign (Ptr)+import Foreign.C (CInt (..), CUChar, CUInt (..))++data LCtx++data PubKey64++data Msg32++data Sig64++data Seed32++data Compact64++data SecKey32++data Tweak32++data RecSig65++type CtxFlags = CUInt++type SerFlags = CUInt++type Ret = CInt++type NonceFun a =+ Ptr CUChar ->+ Ptr CUChar ->+ Ptr CUChar ->+ Ptr CUChar ->+ Ptr a ->+ CInt ->+ IO CInt++compressed :: SerFlags+compressed = 0x0102++uncompressed :: SerFlags+uncompressed = 0x0002++isSuccess :: Ret -> Bool+isSuccess 0 = False+isSuccess 1 = True+isSuccess n = error $ "isSuccess expected 0 or 1 but got " ++ show n
+ src/Crypto/Secp256k1/Internal/Util.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE FlexibleContexts #-}+module Crypto.Secp256k1.Internal.Util where++import Crypto.Secp256k1.Internal.ForeignTypes (Seed32)+import Data.Base16.Types (assertBase16, extractBase16)+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import Data.ByteString.Base16 (decodeBase16, encodeBase16, isBase16)+import qualified Data.ByteString.Unsafe as BU+import Data.String.Conversions (ConvertibleStrings, cs)+import Foreign (Ptr, castPtr)+import Foreign.C (CSize (..))+import System.Entropy (getEntropy)++decodeHex :: (ConvertibleStrings a ByteString) => a -> Maybe ByteString+decodeHex str =+ if isBase16 $ cs str+ then Just . decodeBase16 $ assertBase16 $ cs str+ else Nothing++showsHex :: ByteString -> ShowS+showsHex = shows . extractBase16 . encodeBase16++unsafeUseByteString :: ByteString -> ((Ptr a, CSize) -> IO b) -> IO b+unsafeUseByteString bs f =+ BU.unsafeUseAsCStringLen bs $ \(b, l) ->+ f (castPtr b, fromIntegral l)++useByteString :: ByteString -> ((Ptr a, CSize) -> IO b) -> IO b+useByteString bs f =+ BS.useAsCStringLen bs $ \(b, l) ->+ f (castPtr b, fromIntegral l)++unsafePackByteString :: (Ptr a, CSize) -> IO ByteString+unsafePackByteString (b, l) =+ BU.unsafePackMallocCStringLen (castPtr b, fromIntegral l)++packByteString :: (Ptr a, CSize) -> IO ByteString+packByteString (b, l) =+ BS.packCStringLen (castPtr b, fromIntegral l)++withRandomSeed :: (Ptr Seed32 -> IO a) -> IO a+withRandomSeed go = do+ bs <- getEntropy 32+ useByteString bs $ go . fst
test/Crypto/Secp256k1/InternalSpec.hs view
@@ -1,377 +1,438 @@ {-# LANGUAGE OverloadedStrings #-}+ module Crypto.Secp256k1.InternalSpec (spec) where -import Control.Monad-import Control.Monad.Trans-import Crypto.Secp256k1.Internal-import Data.ByteString (ByteString, packCStringLen,- useAsCStringLen, copy)-import qualified Data.ByteString.Base16 as B16-import Foreign-import System.Entropy-import Test.Hspec-import Test.HUnit (Assertion, assertBool, assertEqual)+import Control.Exception+import Control.Monad+import Control.Monad.Trans+import Crypto.Secp256k1.Internal.BaseOps+import Crypto.Secp256k1.Internal.Context+import Crypto.Secp256k1.Internal.ForeignTypes+import Crypto.Secp256k1.Internal.Util+import Data.Base16.Types (assertBase16)+import Data.ByteString+ ( ByteString,+ copy,+ packCStringLen,+ useAsCStringLen,+ )+import Data.ByteString.Base16 (decodeBase16)+import Foreign+import System.Entropy+import Test.HUnit (Assertion, assertBool, assertEqual, assertFailure)+import Test.Hspec spec :: Spec spec = do- describe "housekeeping" $ do- it "creates context" createContextTest- it "randomizes context" randomizeContextTest- it "clones context" cloneContextTest- describe "serialization" $ do- it "parses public key" ecPubkeyParseTest- it "serializes public key" ecPubKeySerializeTest- it "parses DER signature" ecdsaSignatureParseDerTest- it "serializes DER signature" ecdsaSignatureSerializeDerTest- describe "signatures" $ do- it "verifies signature" ecdsaVerifyTest- -- TODO:- -- , testCase "RFC6979 nonce function" nonce_function_rfc6979_test- it "signs message" ecdsaSignTest- describe "secret keys" $ do- it "verifies secret key" ecSecKeyVerifyTest- it "creates public key" ecPubkeyCreateTest- it "adds secret key" ecSecKeyTweakAddTest- it "multiplies secret key" ecSecKeyTweakMulTest- describe "public keys" $ do- it "adds public key" ecPubKeyTweakAddTest- it "multiplies public key" ecPubKeyTweakMulTest- it "combines public keys" ecPubKeyCombineTest+ describe "housekeeping" $ do+ it "creates context" createContextTest+ it "randomizes context" randomizeContextTest+ it "clones context" cloneContextTest+ describe "serialization" $ do+ it "parses public key" ecPubkeyParseTest+ it "serializes public key" ecPubKeySerializeTest+ it "parses DER signature" ecdsaSignatureParseDerTest+ it "serializes DER signature" ecdsaSignatureSerializeDerTest+ describe "signatures" $ do+ it "verifies signature" ecdsaVerifyTest+ -- TODO:+ -- , testCase "RFC6979 nonce function" nonce_function_rfc6979_test+ it "signs message" ecdsaSignTest+ describe "secret keys" $ do+ it "verifies secret key" ecSecKeyVerifyTest+ it "creates public key" ecPubkeyCreateTest+ it "adds secret key" ecSecKeyTweakAddTest+ it "multiplies secret key" ecSecKeyTweakMulTest+ describe "public keys" $ do+ it "adds public key" ecPubKeyTweakAddTest+ it "multiplies public key" ecPubKeyTweakMulTest+ it "combines public keys" ecPubKeyCombineTest +withCtxPtr :: CtxFlags -> (Ptr LCtx -> IO a) -> IO a+withCtxPtr f = bracket (contextCreate f) contextDestroy+ withEntropy :: (Ptr Seed32 -> IO a) -> IO a withEntropy f =- getEntropy 32 >>= \e ->+ getEntropy 32 >>= \e -> useByteString e $ \(s, _) -> f s createContextTest :: Assertion-createContextTest = do- context_ptr <- liftIO $ contextCreate signVerify- assertBool "context not null" $ context_ptr /= nullPtr+createContextTest = withCtxPtr signVerify $ \ctx -> do+ assertBool "context not null" $ ctx /= nullPtr randomizeContextTest :: Assertion-randomizeContextTest = do- ret <- liftIO $ contextCreate sign >>= \x ->- withEntropy (contextRandomize x)- assertBool "context randomized" $ isSuccess ret+randomizeContextTest = withCtxPtr sign $ \ctx -> do+ ret <- withEntropy (contextRandomize ctx)+ assertBool "context randomized" $ isSuccess ret cloneContextTest :: Assertion cloneContextTest = do- (x1, x2) <- liftIO $ do- x1 <- contextCreate signVerify- ret <- withEntropy $ contextRandomize x1- unless (isSuccess ret) $ error "failed to randomize context"- x2 <- contextClone x1- return (x1, x2)- assertBool "original context not null" $ x1 /= nullPtr- assertBool "cloned context not null" $ x2 /= nullPtr- assertBool "context ptrs different" $ x1 /= x2+ (x1, x2) <- liftIO $ do+ x1 <- contextCreate signVerify+ ret <- withEntropy $ contextRandomize x1+ unless (isSuccess ret) $ error "failed to randomize context"+ x2 <- contextClone x1+ return (x1, x2)+ assertBool "original context not null" $ x1 /= nullPtr+ assertBool "cloned context not null" $ x2 /= nullPtr+ assertBool "context ptrs different" $ x1 /= x2 ecPubkeyParseTest :: Assertion ecPubkeyParseTest = do- ret <- liftIO $ useAsCStringLen der $ \(i, il) -> do- x <- contextCreate verify- allocaBytes 64 $ \pubkey ->- ecPubKeyParse x pubkey (castPtr i) (fromIntegral il)- assertBool "parsed public key" (isSuccess ret)+ ret <- liftIO $ useAsCStringLen der $ \(i, il) -> do+ x <- contextCreate verify+ allocaBytes 64 $ \pubkey ->+ ecPubKeyParse x pubkey (castPtr i) (fromIntegral il)+ assertBool "parsed public key" (isSuccess ret) where- der = fst $ B16.decode- "03dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd44705"+ der =+ decodeBase16 $+ assertBase16+ "03dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd44705" ecPubKeySerializeTest :: Assertion ecPubKeySerializeTest = do- (ret, dec) <- liftIO $- useByteString der $ \(i, il) ->- allocaBytes 64 $ \k ->+ (ret, dec) <- liftIO $+ useByteString der $ \(i, il) ->+ allocaBytes 64 $ \k -> alloca $ \ol ->- allocaBytes 72 $ \o -> do- poke ol 72- x <- contextCreate verify- ret1 <- ecPubKeyParse x k i il- unless (isSuccess ret1) $ error "failed to parse pubkey"- ret2 <- ecPubKeySerialize x o ol k compressed- len <- fromIntegral <$> peek ol- decoded <- packCStringLen (castPtr o, len)- return (ret2, decoded)- assertBool "serialized public key successfully" $ isSuccess ret- assertEqual "public key matches" der dec+ allocaBytes 72 $ \o -> do+ poke ol 72+ x <- contextCreate verify+ ret1 <- ecPubKeyParse x k i il+ unless (isSuccess ret1) $ error "failed to parse pubkey"+ ret2 <- ecPubKeySerialize x o ol k compressed+ len <- fromIntegral <$> peek ol+ decoded <- packCStringLen (castPtr o, len)+ return (ret2, decoded)+ assertBool "serialized public key successfully" $ isSuccess ret+ assertEqual "public key matches" der dec where- der = fst $ B16.decode- "03dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd44705"+ der =+ decodeBase16 $+ assertBase16+ "03dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd44705" ecdsaSignatureParseDerTest :: Assertion ecdsaSignatureParseDerTest = do- ret <- liftIO $ useAsCStringLen der $ \(d, dl) -> allocaBytes 64 $ \s -> do- x <- contextCreate verify- ecdsaSignatureParseDer x s (castPtr d) (fromIntegral dl)- assertBool "parsed signature successfully" $ isSuccess ret+ ret <- liftIO $ useAsCStringLen der $ \(d, dl) -> allocaBytes 64 $ \s -> do+ x <- contextCreate verify+ ecdsaSignatureParseDer x s (castPtr d) (fromIntegral dl)+ assertBool "parsed signature successfully" $ isSuccess ret where- der = fst $ B16.decode- "3045022100f502bfa07af43e7ef265618b0d929a7619ee01d6150e37eb6eaaf2c8bd37\- \fb2202206f0415ab0e9a977afd78b2c26ef39b3952096d319fd4b101c768ad6c132e30\- \45"+ der =+ decodeBase16 $+ assertBase16+ "3045022100f502bfa07af43e7ef265618b0d929a7619ee01d6150e37eb6eaaf2c8bd37\+ \fb2202206f0415ab0e9a977afd78b2c26ef39b3952096d319fd4b101c768ad6c132e30\+ \45" -parseDer :: Ctx -> ByteString -> IO ByteString+parseDer :: Ptr LCtx -> ByteString -> IO ByteString parseDer x bs =- useAsCStringLen bs $ \(d, dl) ->+ useAsCStringLen bs $ \(d, dl) -> allocaBytes 64 $ \s -> do- ret <- ecdsaSignatureParseDer x s (castPtr d) (fromIntegral dl)- unless (isSuccess ret) $ error "could not parse DER"- packByteString (s, 64)+ ret <- ecdsaSignatureParseDer x s (castPtr d) (fromIntegral dl)+ unless (isSuccess ret) $ error "could not parse DER"+ packByteString (s, 64) ecdsaSignatureSerializeDerTest :: Assertion ecdsaSignatureSerializeDerTest = do- (ret, enc) <- liftIO $ do- x <- contextCreate verify- sig <- parseDer x der- alloca $ \ol ->- allocaBytes 72 $ \o ->- useByteString sig $ \(s, _) -> do- poke ol 72- ret <- ecdsaSignatureSerializeDer x o ol s- len <- fromIntegral <$> peek ol- enc <- packCStringLen (castPtr o, len)- return (ret, enc)- assertBool "serialization successful" $ isSuccess ret- assertEqual "signatures match" der enc+ (ret, enc) <- liftIO . bracket (contextCreate verify) contextDestroy $ \x -> do+ sig <- parseDer x der+ (ret, enc) <- alloca $ \ol ->+ allocaBytes 72 $ \o ->+ useByteString sig $ \(s, _) -> do+ poke ol 72+ ret <- ecdsaSignatureSerializeDer x o ol s+ len <- fromIntegral <$> peek ol+ enc <- packCStringLen (castPtr o, len)+ return (ret, enc)+ return (ret, enc)+ assertBool "serialization successful" $ isSuccess ret+ assertEqual "signatures match" der enc where- der = fst $ B16.decode- "3045022100f502bfa07af43e7ef265618b0d929a7619ee01d6150e37eb6eaaf2c8bd37\- \fb2202206f0415ab0e9a977afd78b2c26ef39b3952096d319fd4b101c768ad6c132e30\- \45"+ der =+ decodeBase16 $+ assertBase16+ "3045022100f502bfa07af43e7ef265618b0d929a7619ee01d6150e37eb6eaaf2c8bd37\+ \fb2202206f0415ab0e9a977afd78b2c26ef39b3952096d319fd4b101c768ad6c132e30\+ \45" ecdsaVerifyTest :: Assertion-ecdsaVerifyTest = do- ret <- liftIO $ do- x <- contextCreate verify- sig <- parseDer x der- pk <- useByteString pub $ \(p, pl) ->- allocaBytes 64 $ \k -> do- ret <- ecPubKeyParse x k p (fromIntegral pl)- unless (isSuccess ret) $ error "could not parse public key"- packByteString (k, 64)- useByteString msg $ \(m, _) ->- useByteString pk $ \(k, _) ->- useByteString sig $ \(s, _) ->- ecdsaVerify x s m k- assertBool "signature valid" $ isSuccess ret+ecdsaVerifyTest = withCtxPtr verify $ \ctx -> do+ ret <- liftIO $ do+ sig <- parseDer ctx der+ pk <- useByteString pub $ \(p, pl) ->+ allocaBytes 64 $ \k -> do+ ret <- ecPubKeyParse ctx k p (fromIntegral pl)+ unless (isSuccess ret) $ error "could not parse public key"+ packByteString (k, 64)+ useByteString msg $ \(m, _) ->+ useByteString pk $ \(k, _) ->+ useByteString sig $ \(s, _) ->+ ecdsaVerify ctx s m k+ assertBool "signature valid" $ isSuccess ret where- der = fst $ B16.decode- "3045022100f502bfa07af43e7ef265618b0d929a7619ee01d6150e37eb6eaaf2c8bd37\- \fb2202206f0415ab0e9a977afd78b2c26ef39b3952096d319fd4b101c768ad6c132e30\- \45"- pub = fst $ B16.decode- "04dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd447051221\- \3d5ed790522c042dee8e85c4c0ec5f96800b72bc5940c8bc1c5e11e4fcbf"- msg = fst $ B16.decode- "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00"+ der =+ decodeBase16 $+ assertBase16+ "3045022100f502bfa07af43e7ef265618b0d929a7619ee01d6150e37eb6eaaf2c8bd37\+ \fb2202206f0415ab0e9a977afd78b2c26ef39b3952096d319fd4b101c768ad6c132e30\+ \45"+ pub =+ decodeBase16 $+ assertBase16+ "04dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd447051221\+ \3d5ed790522c042dee8e85c4c0ec5f96800b72bc5940c8bc1c5e11e4fcbf"+ msg =+ decodeBase16 $+ assertBase16+ "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00" -signCtx :: IO Ctx-signCtx = contextCreate sign >>= \c ->+signCtx :: IO (Ptr LCtx)+signCtx =+ contextCreate sign >>= \c -> withEntropy (contextRandomize c) >>= \r ->- unless (isSuccess r) (error "failed to randomize context") >> return c+ unless (isSuccess r) (error "failed to randomize context") >> return c -createPubKey :: Ctx -> Ptr SecKey32 -> Ptr PubKey64 -> IO ()-createPubKey x k p = do- ret <- ecPubKeyCreate x p k- unless (isSuccess ret) $ error "failed to create public key"+withSignCtxPtr :: (Ptr LCtx -> IO a) -> IO a+withSignCtxPtr = bracket signCtx contextDestroy +createPubKey :: Ptr LCtx -> Ptr SecKey32 -> Ptr PubKey64 -> IO ()+createPubKey ctx k p = do+ ret <- ecPubKeyCreate ctx p k+ unless (isSuccess ret) $ error "failed to create public key"+ ecdsaSignTest :: Assertion ecdsaSignTest = do- der <- liftIO $ do- x <- signCtx- allocaBytes 64 $ \s ->- useByteString msg $ \(m, _) ->- useByteString key $ \(k, _) ->- alloca $ \ol ->+ der <- liftIO $ withSignCtxPtr $ \ctx -> do+ allocaBytes 64 $ \s ->+ useByteString msg $ \(m, _) ->+ useByteString key $ \(k, _) ->+ alloca $ \ol -> allocaBytes 72 $ \o -> do- poke ol 72- ret1 <- ecdsaSign x s m k nullFunPtr nullPtr- unless (isSuccess ret1) $ error "could not sign message"- ret2 <- ecdsaSignatureSerializeDer x o ol s- unless (isSuccess ret2) $ error "could not serialize signature"- len <- peek ol- packCStringLen (castPtr o, fromIntegral len)- ret <- liftIO $ do- pub <- allocaBytes 64 $ \p ->- useByteString key $ \(s, _) -> do- x <- signCtx- createPubKey x s p- packByteString (p, 64)- useByteString msg $ \(m, _) ->- useByteString pub $ \(p, _) -> do- x <- contextCreate verify- s' <- parseDer x der- useByteString s' $ \(s, _) -> ecdsaVerify x s m p- assertBool "signature matches" (isSuccess ret)+ poke ol 72+ ret1 <- ecdsaSign ctx s m k nullFunPtr nullPtr+ unless (isSuccess ret1) $ error "could not sign message"+ ret2 <- ecdsaSignatureSerializeDer ctx o ol s+ unless (isSuccess ret2) $ error "could not serialize signature"+ len <- peek ol+ packCStringLen (castPtr o, fromIntegral len)+ ret <- liftIO $ do+ pub <- withSignCtxPtr $ \ctx -> allocaBytes 64 $ \p ->+ useByteString key $ \(s, _) -> do+ createPubKey ctx s p+ packByteString (p, 64)+ withCtxPtr verify $ \ctx -> useByteString msg $ \(m, _) ->+ useByteString pub $ \(p, _) -> do+ s' <- parseDer ctx der+ useByteString s' $ \(s, _) -> ecdsaVerify ctx s m p+ assertBool "signature matches" (isSuccess ret) where- msg = fst $ B16.decode- "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00"- key = fst $ B16.decode- "f65255094d7773ed8dd417badc9fc045c1f80fdc5b2d25172b031ce6933e039a"-+ msg =+ decodeBase16 $+ assertBase16+ "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00"+ key =+ decodeBase16 $+ assertBase16+ "f65255094d7773ed8dd417badc9fc045c1f80fdc5b2d25172b031ce6933e039a" ecSecKeyVerifyTest :: Assertion-ecSecKeyVerifyTest = do- ret <- liftIO $ useByteString key $ \(k, _) -> do- x <- signCtx- ecSecKeyVerify x k- assertBool "valid secret key" $ isSuccess ret+ecSecKeyVerifyTest = withSignCtxPtr $ \ctx -> do+ ret <- liftIO $ useByteString key $ \(k, _) -> do+ ecSecKeyVerify ctx k+ assertBool "valid secret key" $ isSuccess ret where- key = fst $ B16.decode- "f65255094d7773ed8dd417badc9fc045c1f80fdc5b2d25172b031ce6933e039a"+ key =+ decodeBase16 $+ assertBase16+ "f65255094d7773ed8dd417badc9fc045c1f80fdc5b2d25172b031ce6933e039a" ecPubkeyCreateTest :: Assertion-ecPubkeyCreateTest = do- pk <- liftIO $- useByteString key $ \(s, _) ->- allocaBytes 64 $ \k -> do- x <- signCtx- createPubKey x s k+ecPubkeyCreateTest = withSignCtxPtr $ \ctx -> do+ pk <- liftIO $+ useByteString key $ \(s, _) ->+ allocaBytes 64 $ \k -> do+ createPubKey ctx s k allocaBytes 65 $ \o ->- alloca $ \ol -> do+ alloca $ \ol -> do poke ol 65- rets <- ecPubKeySerialize x o ol k uncompressed+ rets <- ecPubKeySerialize ctx o ol k uncompressed unless (isSuccess rets) $ error "failed to serialize public key" len <- fromIntegral <$> peek ol packCStringLen (castPtr o, len)- assertEqual "public key matches" pub pk+ assertEqual "public key matches" pub pk where- key = fst $ B16.decode- "f65255094d7773ed8dd417badc9fc045c1f80fdc5b2d25172b031ce6933e039a"- pub = fst $ B16.decode- "04dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd447051221\- \3d5ed790522c042dee8e85c4c0ec5f96800b72bc5940c8bc1c5e11e4fcbf"+ key =+ decodeBase16 $+ assertBase16+ "f65255094d7773ed8dd417badc9fc045c1f80fdc5b2d25172b031ce6933e039a"+ pub =+ decodeBase16 $+ assertBase16+ "04dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd447051221\+ \3d5ed790522c042dee8e85c4c0ec5f96800b72bc5940c8bc1c5e11e4fcbf" ecSecKeyTweakAddTest :: Assertion ecSecKeyTweakAddTest = do- (ret, tweaked) <- liftIO $- signCtx >>= \x ->- useByteString tweak $ \(w, _) ->+ (ret, tweaked) <-+ liftIO . withSignCtxPtr $ \ctx ->+ useByteString tweak $ \(w, _) -> useByteString key $ \(k, _) -> do- ret <- ecSecKeyTweakAdd x k w- tweaked <- packByteString (k, 32)- return (ret, tweaked)- assertBool "successful secret key tweak" $ isSuccess ret- assertEqual "tweaked keys match" expected tweaked+ ret <- ecSecKeyTweakAdd ctx k w+ tweaked <- packByteString (k, 32)+ return (ret, tweaked)+ assertBool "successful secret key tweak" $ isSuccess ret+ assertEqual "tweaked keys match" expected tweaked where- key = fst $ B16.decode- "f65255094d7773ed8dd417badc9fc045c1f80fdc5b2d25172b031ce6933e039a"- tweak = fst $ B16.decode- "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00"- expected = fst $ B16.decode- "ec1e3ce1cefa18a671d51125e2b249688d934b0e28f5d1665384d9b02f929059"+ key =+ decodeBase16 $+ assertBase16+ "f65255094d7773ed8dd417badc9fc045c1f80fdc5b2d25172b031ce6933e039a"+ tweak =+ decodeBase16 $+ assertBase16+ "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00"+ expected =+ decodeBase16 $+ assertBase16+ "ec1e3ce1cefa18a671d51125e2b249688d934b0e28f5d1665384d9b02f929059" ecSecKeyTweakMulTest :: Assertion ecSecKeyTweakMulTest = do- (ret, tweaked) <- liftIO $ do- x <- contextCreate sign- retr <- withEntropy $ contextRandomize x- unless (isSuccess retr) $ error "failed to randomize context"- useByteString tweak $ \(w, _) -> useByteString key $ \(k, _) -> do- ret <- ecSecKeyTweakMul x k w- tweaked <- packByteString (k, 32)- return (ret, tweaked)- assertBool "successful secret key tweak" $ isSuccess ret- assertEqual "tweaked keys match" expected tweaked+ (ret, tweaked) <- liftIO $ withSignCtxPtr $ \ctx -> do+ useByteString tweak $ \(w, _) -> useByteString key $ \(k, _) -> do+ ret <- ecSecKeyTweakMul ctx k w+ tweaked <- packByteString (k, 32)+ return (ret, tweaked)+ assertBool "successful secret key tweak" $ isSuccess ret+ assertEqual "tweaked keys match" expected tweaked where- key = fst $ B16.decode- "f65255094d7773ed8dd417badc9fc045c1f80fdc5b2d25172b031ce6933e039a"- tweak = fst $ B16.decode- "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00"- expected = fst $ B16.decode- "a96f5962493acb179f60a86a9785fc7a30e0c39b64c09d24fe064d9aef15e4c0"+ key =+ decodeBase16 $+ assertBase16+ "f65255094d7773ed8dd417badc9fc045c1f80fdc5b2d25172b031ce6933e039a"+ tweak =+ decodeBase16 $+ assertBase16+ "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00"+ expected =+ decodeBase16 $+ assertBase16+ "a96f5962493acb179f60a86a9785fc7a30e0c39b64c09d24fe064d9aef15e4c0" -serializeKey :: Ctx -> Ptr PubKey64 -> IO ByteString+serializeKey :: Ptr LCtx -> Ptr PubKey64 -> IO ByteString serializeKey x p = allocaBytes 72 $ \d -> alloca $ \dl -> do- poke dl 72- ret <- ecPubKeySerialize x d dl p uncompressed- unless (isSuccess ret) $ error "could not serialize public key"- len <- peek dl- packCStringLen (castPtr d, fromIntegral len)+ poke dl 72+ ret <- ecPubKeySerialize x d dl p uncompressed+ unless (isSuccess ret) $ error "could not serialize public key"+ len <- peek dl+ packCStringLen (castPtr d, fromIntegral len) -parseKey :: Ctx -> ByteString -> IO ByteString+parseKey :: Ptr LCtx -> ByteString -> IO ByteString parseKey x bs =- allocaBytes 64 $ \p ->+ allocaBytes 64 $ \p -> useByteString bs $ \(d, dl) -> do- ret <- ecPubKeyParse x p d dl- unless (isSuccess ret) $ error "could not parse public key"- packByteString (p, 64)+ ret <- ecPubKeyParse x p d dl+ unless (isSuccess ret) $ error "could not parse public key"+ packByteString (p, 64) ecPubKeyTweakAddTest :: Assertion ecPubKeyTweakAddTest = do- (ret, tweaked) <- liftIO $ do- x <- contextCreate verify- pk <- copy <$> parseKey x pub- useByteString tweak $ \(w, _) ->- useByteString pk $ \(p, _) -> do- ret <- ecPubKeyTweakAdd x p w- tweaked <- serializeKey x p- return (ret, tweaked)- assertBool "successful secret key tweak" $ isSuccess ret- assertEqual "tweaked keys match" expected tweaked+ (ret, tweaked) <- liftIO $ do+ x <- contextCreate verify+ pk <- copy <$> parseKey x pub+ useByteString tweak $ \(w, _) ->+ useByteString pk $ \(p, _) -> do+ ret <- ecPubKeyTweakAdd x p w+ tweaked <- serializeKey x p+ return (ret, tweaked)+ assertBool "successful secret key tweak" $ isSuccess ret+ assertEqual "tweaked keys match" expected tweaked where- pub = fst $ B16.decode- "04dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd447051221\- \3d5ed790522c042dee8e85c4c0ec5f96800b72bc5940c8bc1c5e11e4fcbf"- tweak = fst $ B16.decode- "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00"- expected = fst $ B16.decode- "04441c3982b97576646e0df0c96736063df6b42f2ee566d13b9f6424302d1379e518fd\- \c87a14c5435bff7a5db4552042cb4120c6b86a4bbd3d0643f3c14ad01368"+ pub =+ decodeBase16 $+ assertBase16+ "04dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd447051221\+ \3d5ed790522c042dee8e85c4c0ec5f96800b72bc5940c8bc1c5e11e4fcbf"+ tweak =+ decodeBase16 $+ assertBase16+ "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00"+ expected =+ decodeBase16 $+ assertBase16+ "04441c3982b97576646e0df0c96736063df6b42f2ee566d13b9f6424302d1379e518fd\+ \c87a14c5435bff7a5db4552042cb4120c6b86a4bbd3d0643f3c14ad01368" ecPubKeyTweakMulTest :: Assertion ecPubKeyTweakMulTest = do- (ret, tweaked) <- liftIO $ do- x <- contextCreate verify- pk <- copy <$> parseKey x pub- useByteString tweak $ \(w, _) ->- useByteString pk $ \(p, _) -> do- ret <- ecPubKeyTweakMul x p w- tweaked <- serializeKey x p- return (ret, tweaked)- assertBool "successful secret key tweak" $ isSuccess ret- assertEqual "tweaked keys match" expected tweaked+ (ret, tweaked) <- liftIO $ do+ x <- contextCreate verify+ pk <- copy <$> parseKey x pub+ useByteString tweak $ \(w, _) ->+ useByteString pk $ \(p, _) -> do+ ret <- ecPubKeyTweakMul x p w+ tweaked <- serializeKey x p+ return (ret, tweaked)+ assertBool "successful secret key tweak" $ isSuccess ret+ assertEqual "tweaked keys match" expected tweaked where- pub = fst $ B16.decode- "04dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd447051221\- \3d5ed790522c042dee8e85c4c0ec5f96800b72bc5940c8bc1c5e11e4fcbf"- tweak = fst $ B16.decode- "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00"- expected = fst $ B16.decode- "04f379dc99cdf5c83e433defa267fbb3377d61d6b779c06a0e4ce29ae3ff5353b12ae4\- \9c9d07e7368f2ba5a446c203255ce912322991a2d6a9d5d5761c61ed1845"+ pub =+ decodeBase16 $+ assertBase16+ "04dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd447051221\+ \3d5ed790522c042dee8e85c4c0ec5f96800b72bc5940c8bc1c5e11e4fcbf"+ tweak =+ decodeBase16 $+ assertBase16+ "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00"+ expected =+ decodeBase16 $+ assertBase16+ "04f379dc99cdf5c83e433defa267fbb3377d61d6b779c06a0e4ce29ae3ff5353b12ae4\+ \9c9d07e7368f2ba5a446c203255ce912322991a2d6a9d5d5761c61ed1845" ecPubKeyCombineTest :: Assertion ecPubKeyCombineTest = do- (ret, com) <- liftIO $- allocaBytes 64 $ \p1 ->- allocaBytes 64 $ \p2 ->+ (ret, com) <- liftIO $+ allocaBytes 64 $ \p1 ->+ allocaBytes 64 $ \p2 -> allocaBytes 64 $ \p3 ->- allocaArray 3 $ \a ->- allocaBytes 64 $ \p -> do- x <- contextCreate verify- parse x pub1 p1- parse x pub2 p2- parse x pub3 p3- pokeArray a [p1, p2, p3]- ret <- ecPubKeyCombine x p a 3- com <- serializeKey x p- return (ret, com)- assertBool "successful key combination" $ isSuccess ret- assertEqual "combined keys match" expected com+ allocaArray 3 $ \a ->+ allocaBytes 64 $ \p -> do+ x <- contextCreate verify+ parse x pub1 p1+ parse x pub2 p2+ parse x pub3 p3+ pokeArray a [p1, p2, p3]+ ret <- ecPubKeyCombine x p a 3+ com <- serializeKey x p+ return (ret, com)+ assertBool "successful key combination" $ isSuccess ret+ assertEqual "combined keys match" expected com where parse x pub p = useByteString pub $ \(d, dl) -> do- ret <- ecPubKeyParse x p d dl- unless (isSuccess ret) $ error "could not parse public key"- pub1 = fst $ B16.decode- "04dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd447051221\- \3d5ed790522c042dee8e85c4c0ec5f96800b72bc5940c8bc1c5e11e4fcbf"- pub2 = fst $ B16.decode- "0487d82042d93447008dfe2af762068a1e53ff394a5bf8f68a045fa642b99ea5d153f5\- \77dd2dba6c7ae4cfd7b6622409d7edd2d76dd13a8092cd3af97b77bd2c77"- pub3 = fst $ B16.decode- "049b101edcbe1ee37ff6b2318526a425b629e823d7d8d9154417880595a28000ee3feb\- \d908754b8ce4e491aa6fe488b41fb5d4bb3788e33c9ff95a7a9229166d59"- expected = fst $ B16.decode- "043d9a7ec70011efc23c33a7e62d2ea73cca87797e3b659d93bea6aa871aebde56c3bc\- \6134ca82e324b0ab9c0e601a6d2933afe7fb5d9f3aae900f5c5dc6e362c8"+ ret <- ecPubKeyParse x p d dl+ unless (isSuccess ret) $ error "could not parse public key"+ pub1 =+ decodeBase16 $+ assertBase16+ "04dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd447051221\+ \3d5ed790522c042dee8e85c4c0ec5f96800b72bc5940c8bc1c5e11e4fcbf"+ pub2 =+ decodeBase16 $+ assertBase16+ "0487d82042d93447008dfe2af762068a1e53ff394a5bf8f68a045fa642b99ea5d153f5\+ \77dd2dba6c7ae4cfd7b6622409d7edd2d76dd13a8092cd3af97b77bd2c77"+ pub3 =+ decodeBase16 $+ assertBase16+ "049b101edcbe1ee37ff6b2318526a425b629e823d7d8d9154417880595a28000ee3feb\+ \d908754b8ce4e491aa6fe488b41fb5d4bb3788e33c9ff95a7a9229166d59"+ expected =+ decodeBase16 $+ assertBase16+ "043d9a7ec70011efc23c33a7e62d2ea73cca87797e3b659d93bea6aa871aebde56c3bc\+ \6134ca82e324b0ab9c0e601a6d2933afe7fb5d9f3aae900f5c5dc6e362c8"
test/Crypto/Secp256k1Spec.hs view
@@ -1,248 +1,312 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE OverloadedRecordDot #-}+ module Crypto.Secp256k1Spec (spec) where -import Control.Monad.Par-import qualified Control.Monad.Par as P-import Crypto.Secp256k1-import qualified Data.ByteString as BS-import qualified Data.ByteString.Base16 as B16-import qualified Data.ByteString.Char8 as B8-import Data.Maybe (fromMaybe, isNothing)-import Data.String (fromString)-import Data.String.Conversions (cs)-import Test.Hspec-import Test.HUnit (Assertion, assertEqual)-import Test.QuickCheck+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 = do- describe "signatures" $ do- it "signs message" $- property signMsgTest- it "signs messages in parallel" $- property signMsgParTest- it "detects bad signature" $- property badSignatureTest- it "normalizes signatures" $- property normalizeSigTest- describe "serialization" $ do- it "serializes public key" $- property serializePubKeyTest- it "serializes public keys in parallel" $- property parSerializePubKeyTest- it "serializes DER signature" $- property serializeSigTest- it "serializes DER signatures in parallel" $- property parSerializeSigTest- it "serializes compact signature" $- property serializeCompactSigTest- it "serialize secret key" $- property serializeSecKeyTest- it "shows and reads public key" $- property (showRead :: PubKey -> Bool)- it "shows and reads secret key" $- property (showRead :: SecKey -> Bool)- it "shows and reads tweak" $- property (showReadTweak :: SecKey -> Bool)- it "shows and reads signature" $- property (showReadSig :: (SecKey, Msg) -> Bool)- it "shows and reads message" $- property (showRead :: Msg -> Bool)- it "reads public key from string" $- property isStringPubKey- it "reads secret key from string" $- property isStringSecKey- it "reads signature from string" $- property isStringSig- it "reads message from string" $- property isStringMsg- it "reads tweak from string" $- property isStringTweak- describe "tweaks" $ do- it "add secret key" $ property tweakAddSecKeyTest- it "multiply secret key" $ property tweakMulSecKeyTest- it "add public key" $ property tweakAddPubKeyTest- it "multiply public key" $ property tweakMulPubKeyTest- it "combine public keys" $ property combinePubKeyTest- it "can't combine 0 public keys" $ property combinePubKeyEmptyListTest- it "negates tweak" $ property negateTweakTest+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 = fst . B16.decode . B8.pack--isStringPubKey :: (PubKey, Bool) -> Bool-isStringPubKey (k, c) = k == fromString (cs hex) where- hex = B16.encode $ exportPubKey c k--isStringSig :: (SecKey, Msg) -> Bool-isStringSig (k, m) = g == fromString (cs hex) where- g = signMsg k m- hex = B16.encode $ exportSig g+hexToBytes = decodeBase16 . assertBase16 . B8.pack isStringMsg :: Msg -> Bool-isStringMsg m = m == fromString (cs m') where- m' = B16.encode $ getMsg m+isStringMsg m = m == fromString (cs m')+ where+ m' = (extractBase16 . encodeBase16) m.get isStringSecKey :: SecKey -> Bool-isStringSecKey k = k == fromString (cs hex) where- hex = B16.encode $ getSecKey k+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 $ getSecKey k- hex = B16.encode $ getTweak t+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 $ getSecKey k+showReadTweak k = showRead t+ where+ t = tweak k.get -showReadSig :: (SecKey, Msg) -> Bool-showReadSig (k, m) = showRead sig where- sig = signMsg k m+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 :: (Msg, SecKey) -> Bool-signMsgTest (fm, fk) = verifySig fp fg fm where- fp = derivePubKey fk- fg = signMsg fk fm+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 :: [(Msg, SecKey)] -> Bool-signMsgParTest xs = P.runPar $ do- ys <- mapM (P.spawnP . signMsgTest) xs- and <$> mapM P.get ys+signMsgParTest :: Ctx -> [(Msg, SecKey)] -> Bool+signMsgParTest ctx xs = P.runPar $ do+ ys <- mapM (P.spawnP . signMsgTest ctx) xs+ and <$> mapM P.get ys -badSignatureTest :: (Msg, SecKey, PubKey) -> Bool-badSignatureTest (fm, fk, fp) = not $ verifySig fp fg fm where- fg = signMsg fk fm+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 :: (Msg, SecKey) -> Bool-normalizeSigTest (fm, fk) = isNothing sig where- fg = signMsg fk fm- sig = normalizeSig fg+normalizeSigTest :: Ctx -> (Msg, SecKey) -> Bool+normalizeSigTest ctx (fm, fk) = isNothing sig+ where+ fg = signMsg ctx fk fm+ sig = normalizeSig ctx fg -serializePubKeyTest :: (PubKey, Bool) -> Bool-serializePubKeyTest (fp, b) =- case importPubKey $ exportPubKey b fp of- Just fp' -> fp == fp'- Nothing -> False+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 :: [(PubKey, Bool)] -> Bool-parSerializePubKeyTest ps = runPar $ do- as <- mapM (spawnP . serializePubKeyTest) ps- and <$> mapM get as+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 :: (Msg, SecKey) -> Bool-serializeSigTest (fm, fk) =- case importSig $ exportSig fg of- Just fg' -> fg == fg'- Nothing -> False+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 fk fm+ fg = signMsg ctx fk fm -parSerializeSigTest :: [(Msg, SecKey)] -> Bool-parSerializeSigTest ms = runPar $ do- as <- mapM (spawnP . serializeSigTest) ms- and <$> mapM get as+parSerializeSigTest :: Ctx -> [(Msg, SecKey)] -> Bool+parSerializeSigTest ctx ms = P.runPar $ do+ as <- mapM (P.spawnP . serializeSigTest ctx) ms+ and <$> mapM P.get as -serializeCompactSigTest :: (Msg, SecKey) -> Bool-serializeCompactSigTest (fm, fk) =- case importCompactSig $ exportCompactSig fg of- Just fg' -> fg == fg'- Nothing -> False+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 fk fm+ fg = signMsg ctx fk fm serializeSecKeyTest :: SecKey -> Bool serializeSecKeyTest fk =- case secKey $ getSecKey fk of- Just fk' -> fk == fk'- Nothing -> False+ case secKey fk.get of+ Just fk' -> fk == fk'+ Nothing -> False -tweakAddSecKeyTest :: Assertion-tweakAddSecKeyTest =- assertEqual "tweaked keys match" expected tweaked+tweakAddSecKeyTest :: Ctx -> Assertion+tweakAddSecKeyTest ctx =+ assertEqual "tweaked keys match" expected tweaked where tweaked = do- key <- secKey $ hexToBytes+ key <-+ secKey $+ hexToBytes "f65255094d7773ed8dd417badc9fc045c1f80fdc5b2d25172b031ce6933e039a"- twk <- tweak $ hexToBytes+ twk <-+ tweak $+ hexToBytes "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00"- tweakAddSecKey key twk- expected = secKey $ hexToBytes- "ec1e3ce1cefa18a671d51125e2b249688d934b0e28f5d1665384d9b02f929059"+ tweakAddSecKey ctx key twk+ expected =+ secKey $+ hexToBytes+ "ec1e3ce1cefa18a671d51125e2b249688d934b0e28f5d1665384d9b02f929059" -tweakMulSecKeyTest :: Assertion-tweakMulSecKeyTest =- assertEqual "tweaked keys match" expected tweaked+tweakMulSecKeyTest :: Ctx -> Assertion+tweakMulSecKeyTest ctx =+ assertEqual "tweaked keys match" expected tweaked where tweaked = do- key <- secKey $ hexToBytes+ key <-+ secKey $+ hexToBytes "f65255094d7773ed8dd417badc9fc045c1f80fdc5b2d25172b031ce6933e039a"- twk <- tweak $ hexToBytes+ twk <-+ tweak $+ hexToBytes "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00"- tweakMulSecKey key twk- expected = secKey $ hexToBytes- "a96f5962493acb179f60a86a9785fc7a30e0c39b64c09d24fe064d9aef15e4c0"+ tweakMulSecKey ctx key twk+ expected =+ secKey $+ hexToBytes+ "a96f5962493acb179f60a86a9785fc7a30e0c39b64c09d24fe064d9aef15e4c0" -tweakAddPubKeyTest :: Assertion-tweakAddPubKeyTest =- assertEqual "tweaked keys match" expected tweaked+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 $ hexToBytes+ pub <-+ importPubKey ctx $+ hexToBytes "04dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd4470512213d5ed790522c042dee8e85c4c0ec5f96800b72bc5940c8bc1c5e11e4fcbf"- twk <- tweak $ hexToBytes+ twk <-+ tweak $+ hexToBytes "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00"- tweakAddPubKey pub twk- expected = importPubKey $ hexToBytes- "04441c3982b97576646e0df0c96736063df6b42f2ee566d13b9f6424302d1379e518fdc87a14c5435bff7a5db4552042cb4120c6b86a4bbd3d0643f3c14ad01368"+ key <- tweakAddPubKey ctx pub twk+ return $ exportPubKey ctx True key+ expected = do+ key <-+ importPubKey ctx $+ hexToBytes+ "04441c3982b97576646e0df0c96736063df6b42f2ee566d13b9f6424302d1379e518fdc87a14c5435bff7a5db4552042cb4120c6b86a4bbd3d0643f3c14ad01368"+ return $ exportPubKey ctx True key -tweakMulPubKeyTest :: Assertion-tweakMulPubKeyTest =- assertEqual "tweaked keys match" expected tweaked+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 $ hexToBytes+ pub <-+ importPubKey ctx $+ hexToBytes "04dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd4470512213d5ed790522c042dee8e85c4c0ec5f96800b72bc5940c8bc1c5e11e4fcbf"- twk <- tweak $ hexToBytes+ twk <-+ tweak $+ hexToBytes "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00"- tweakMulPubKey pub twk- expected = importPubKey $ hexToBytes- "04f379dc99cdf5c83e433defa267fbb3377d61d6b779c06a0e4ce29ae3ff5353b12ae49c9d07e7368f2ba5a446c203255ce912322991a2d6a9d5d5761c61ed1845"+ key <- tweakMulPubKey ctx pub twk+ return $ exportPubKey ctx True key+ expected = do+ key <-+ importPubKey ctx $+ hexToBytes+ "04f379dc99cdf5c83e433defa267fbb3377d61d6b779c06a0e4ce29ae3ff5353b12ae49c9d07e7368f2ba5a446c203255ce912322991a2d6a9d5d5761c61ed1845"+ return $ exportPubKey ctx True key -combinePubKeyTest :: Assertion-combinePubKeyTest =- assertEqual "combined keys match" expected combined+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 $ hexToBytes+ pub1 <-+ importPubKey ctx $+ hexToBytes "04dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd4470512213d5ed790522c042dee8e85c4c0ec5f96800b72bc5940c8bc1c5e11e4fcbf"- pub2 <- importPubKey $ hexToBytes+ pub2 <-+ importPubKey ctx $+ hexToBytes "0487d82042d93447008dfe2af762068a1e53ff394a5bf8f68a045fa642b99ea5d153f577dd2dba6c7ae4cfd7b6622409d7edd2d76dd13a8092cd3af97b77bd2c77"- pub3 <- importPubKey $ hexToBytes+ pub3 <-+ importPubKey ctx $+ hexToBytes "049b101edcbe1ee37ff6b2318526a425b629e823d7d8d9154417880595a28000ee3febd908754b8ce4e491aa6fe488b41fb5d4bb3788e33c9ff95a7a9229166d59"- combinePubKeys [pub1, pub2, pub3]- expected = importPubKey $ hexToBytes- "043d9a7ec70011efc23c33a7e62d2ea73cca87797e3b659d93bea6aa871aebde56c3bc6134ca82e324b0ab9c0e601a6d2933afe7fb5d9f3aae900f5c5dc6e362c8"+ key <- combinePubKeys ctx [pub1, pub2, pub3]+ return $ exportPubKey ctx True key+ expected = do+ key <-+ importPubKey ctx $+ hexToBytes+ "043d9a7ec70011efc23c33a7e62d2ea73cca87797e3b659d93bea6aa871aebde56c3bc6134ca82e324b0ab9c0e601a6d2933afe7fb5d9f3aae900f5c5dc6e362c8"+ return $ exportPubKey ctx True key -combinePubKeyEmptyListTest :: Assertion-combinePubKeyEmptyListTest =- assertEqual "empty pubkey list must return Nothing" expected combined+combinePubKeyEmptyListTest :: Ctx -> Assertion+combinePubKeyEmptyListTest ctx =+ assertEqual "empty pubkey list must return Nothing" expected combined where expected = Nothing- combined = combinePubKeys []+ combined = do+ key <- combinePubKeys ctx []+ return $ exportPubKey ctx True key -negateTweakTest :: Assertion-negateTweakTest =- assertEqual "can recover secret key 1 after adding tweak 1" oneKey subtracted+negateTweakTest :: Ctx -> Assertion+negateTweakTest ctx =+ assertEqual "can recover secret key 1 after adding tweak 1" oneKey subtracted where- Just oneKey = secKey $ fst $ B16.decode $ B8.pack- "0000000000000000000000000000000000000000000000000000000000000001"- Just oneTwk = tweak $ fst $ B16.decode $ B8.pack- "0000000000000000000000000000000000000000000000000000000000000001"- Just minusOneTwk = tweakNegate oneTwk- Just twoKey = tweakAddSecKey oneKey oneTwk- Just subtracted = tweakAddSecKey twoKey minusOneTwk+ 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