diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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. diff --git a/README.md b/README.md deleted file mode 100644 --- a/README.md +++ /dev/null @@ -1,6 +0,0 @@ -[![Build Status](https://travis-ci.org/haskoin/secp256k1-haskell.svg?branch=master)](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. diff --git a/secp256k1-haskell.cabal b/secp256k1-haskell.cabal --- a/secp256k1-haskell.cabal +++ b/secp256k1-haskell.cabal @@ -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 diff --git a/src/Crypto/Secp256k1.hs b/src/Crypto/Secp256k1.hs --- a/src/Crypto/Secp256k1.hs +++ b/src/Crypto/Secp256k1.hs @@ -1,445 +1,56 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-| -Module : Crypto.Secp256k1 -License : UNLICENSE -Maintainer : Jean-Pierre Rupp -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 diff --git a/src/Crypto/Secp256k1/Internal.hs b/src/Crypto/Secp256k1/Internal.hs deleted file mode 100644 --- a/src/Crypto/Secp256k1/Internal.hs +++ /dev/null @@ -1,270 +0,0 @@ -{-| -Module : Crypto.Secp256k1.Internal -License : UNLICENSE -Maintainer : Jean-Pierre Rupp -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 diff --git a/src/Crypto/Secp256k1/Internal/Base.hs b/src/Crypto/Secp256k1/Internal/Base.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Secp256k1/Internal/Base.hs @@ -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 diff --git a/src/Crypto/Secp256k1/Internal/BaseOps.hs b/src/Crypto/Secp256k1/Internal/BaseOps.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Secp256k1/Internal/BaseOps.hs @@ -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 diff --git a/src/Crypto/Secp256k1/Internal/Context.hs b/src/Crypto/Secp256k1/Internal/Context.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Secp256k1/Internal/Context.hs @@ -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 diff --git a/src/Crypto/Secp256k1/Internal/ForeignTypes.hs b/src/Crypto/Secp256k1/Internal/ForeignTypes.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Secp256k1/Internal/ForeignTypes.hs @@ -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 diff --git a/src/Crypto/Secp256k1/Internal/Util.hs b/src/Crypto/Secp256k1/Internal/Util.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Secp256k1/Internal/Util.hs @@ -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 diff --git a/test/Crypto/Secp256k1/InternalSpec.hs b/test/Crypto/Secp256k1/InternalSpec.hs --- a/test/Crypto/Secp256k1/InternalSpec.hs +++ b/test/Crypto/Secp256k1/InternalSpec.hs @@ -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" diff --git a/test/Crypto/Secp256k1Spec.hs b/test/Crypto/Secp256k1Spec.hs --- a/test/Crypto/Secp256k1Spec.hs +++ b/test/Crypto/Secp256k1Spec.hs @@ -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