secp256k1-haskell 0.3.1 → 0.4.0
raw patch · 6 files changed
+438/−557 lines, 6 filesdep +unliftio
Dependencies added: unliftio
Files
- CHANGELOG.md +5/−0
- secp256k1-haskell.cabal +4/−2
- src/Crypto/Secp256k1.hs +212/−192
- src/Crypto/Secp256k1/Internal.hs +104/−216
- test/Crypto/Secp256k1/InternalSpec.hs +95/−143
- test/Crypto/Secp256k1Spec.hs +18/−4
CHANGELOG.md view
@@ -4,6 +4,11 @@ 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.4.0+### Changed+- Remove fragile ForeignPtr implementation in favor of just storing ByteStrings.+- Reuse memory instead of copying when possible.+ ## 0.3.1 ### Fixed - Use unsafe calls in FFI.
secp256k1-haskell.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: a6861180774adce26925996e63a710235483c286bdea253bdf7d3daa64862113+-- hash: 911c4f6cd260a60f86d8394bdda0aa90dc6cb66e94f5d2adf02a14f7b2d38047 name: secp256k1-haskell-version: 0.3.1+version: 0.4.0 synopsis: Bindings for secp256k1 description: Sign and verify signatures using the secp256k1 library. category: Crypto@@ -48,6 +48,7 @@ , entropy , hashable , string-conversions+ , unliftio default-language: Haskell2010 test-suite spec@@ -75,5 +76,6 @@ , mtl , secp256k1-haskell , string-conversions+ , unliftio default-language: Haskell2010 build-tool-depends: hspec-discover:hspec-discover
src/Crypto/Secp256k1.hs view
@@ -1,6 +1,8 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-| Module : Crypto.Secp256k1 License : UNLICENSE@@ -12,7 +14,7 @@ -} module Crypto.Secp256k1 ( -- * Messages- Msg+ Msg , msg , getMsg @@ -36,7 +38,9 @@ , importSig , exportSig -- ** Compact- , CompactSig(..)+ , CompactSig+ , getCompactSig+ , compactSig , exportCompactSig , importCompactSig @@ -52,52 +56,64 @@ , 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.ByteString.Short (fromShort, toShort) 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 (ForeignPtr, alloca, allocaArray,- allocaBytes, mallocForeignPtr,- nullPtr, peek, poke, pokeArray,- withForeignPtr)+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) -import Control.DeepSeq-import Crypto.Secp256k1.Internal--newtype PubKey = PubKey (ForeignPtr PubKey64)-newtype Msg = Msg (ForeignPtr Msg32)-newtype Sig = Sig (ForeignPtr Sig64)-newtype SecKey = SecKey (ForeignPtr SecKey32)-newtype Tweak = Tweak (ForeignPtr Tweak32)-newtype RecSig = RecSig (ForeignPtr RecSig65)+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 NFData PubKey where- rnf (PubKey p) = p `seq` ()+instance Serialize PubKey where+ put (PubKey bs) = putByteString bs+ get = PubKey <$> getByteString 64 -instance NFData Msg where- rnf (Msg p) = p `seq` ()+instance Serialize Msg where+ put (Msg m) = putByteString m+ get = Msg <$> getByteString 32 -instance NFData Sig where- rnf (Sig p) = p `seq` ()+instance Serialize Sig where+ put (Sig bs) = putByteString bs+ get = Sig <$> getByteString 64 -instance NFData SecKey where- rnf (SecKey p) = p `seq` ()+instance Serialize SecKey where+ put (SecKey bs) = putByteString bs+ get = SecKey <$> getByteString 32 -instance NFData Tweak where- rnf (Tweak p) = p `seq` ()+instance Serialize Tweak where+ put (Tweak bs) = putByteString bs+ get = Tweak <$> getByteString 32 -instance NFData RecSig where- rnf (RecSig p) = p `seq` ()+instance Serialize CompactSig where+ put (CompactSig bs) = putByteString bs+ get = CompactSig <$> getByteString 64 decodeHex :: ConvertibleStrings a ByteString => a -> Maybe ByteString decodeHex str = if BS.null r then Just bs else Nothing where@@ -178,229 +194,233 @@ instance Show Tweak where showsPrec _ = shows . B16.encode . getTweak -instance Eq PubKey where- fp1 == fp2 = getPubKey fp1 == getPubKey fp2--instance Eq Msg where- fm1 == fm2 = getMsg fm1 == getMsg fm2--instance Eq Sig where- fg1 == fg2 = exportCompactSig fg1 == exportCompactSig fg2--instance Eq SecKey where- fk1 == fk2 = getSecKey fk1 == getSecKey fk2--instance Eq Tweak where- ft1 == ft2 = getTweak ft1 == getTweak ft2- -- | Import 32-byte 'ByteString' as 'Msg'. msg :: ByteString -> Maybe Msg msg bs- | BS.length bs == 32 = unsafePerformIO $ do- fp <- mallocForeignPtr- withForeignPtr fp $ flip poke (Msg32 (toShort bs))- return $ Just $ Msg fp+ | 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 = unsafePerformIO $ do- fp <- mallocForeignPtr- ret <- withForeignPtr fp $ \p -> do- poke p (SecKey32 (toShort bs))- ecSecKeyVerify ctx p- if isSuccess ret- then return $ Just $ SecKey fp- else return Nothing+ | BS.length bs == 32 = Just (SecKey bs) | otherwise = Nothing --- | Convert signature to a normalized lower-S form. Boolean value 'True'--- indicates that the signature changed, 'False' indicates that it was already--- normal.-normalizeSig :: Sig -> (Sig, Bool)-normalizeSig (Sig fg) = unsafePerformIO $ do- fg' <- mallocForeignPtr- ret <- withForeignPtr fg $ \pg -> withForeignPtr fg' $ \pg' ->- ecdsaSignatureNormalize ctx pg' pg- return (Sig fg', isSuccess ret)+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 = unsafePerformIO $ do- fp <- mallocForeignPtr- withForeignPtr fp $ flip poke (Tweak32 (toShort bs))- return $ Just $ Tweak fp- | otherwise = Nothing---- | Get 32-byte secret key.-getSecKey :: SecKey -> ByteString-getSecKey (SecKey fk) =- fromShort $ getSecKey32 $ unsafePerformIO $ withForeignPtr fk peek---- Get 64-byte public key.-getPubKey :: PubKey -> ByteString-getPubKey (PubKey fp) =- fromShort $ getPubKey64 $ unsafePerformIO $ withForeignPtr fp peek---- | Get 32-byte message.-getMsg :: Msg -> ByteString-getMsg (Msg fm) =- fromShort $ getMsg32 $ unsafePerformIO $ withForeignPtr fm peek---- | Get 32-byte tweak.-getTweak :: Tweak -> ByteString-getTweak (Tweak ft) =- fromShort $ getTweak32 $ unsafePerformIO $ withForeignPtr ft peek+ | BS.length bs == 32 = Just (Tweak bs)+ | otherwise = Nothing -- | Import DER-encoded public key. importPubKey :: ByteString -> Maybe PubKey-importPubKey bs = unsafePerformIO $ useByteString bs $ \(b, l) -> do- fp <- mallocForeignPtr- ret <- withForeignPtr fp $ \p -> ecPubKeyParse ctx p b l- if isSuccess ret then return $ Just $ PubKey fp else return Nothing+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 pub) = unsafePerformIO $- withForeignPtr pub $ \p -> alloca $ \l -> allocaBytes z $ \o -> do- poke l (fromIntegral z)- ret <- ecPubKeySerialize ctx o l p c- unless (isSuccess ret) $ error "could not serialize public key"- n <- peek l- packByteString (o, n)+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- c = if compress then compressed else uncompressed- z = if compress then 33 else 65+ len = if compress then 33 else 65+ flags = if compress then compressed else uncompressed exportCompactSig :: Sig -> CompactSig-exportCompactSig (Sig fg) = unsafePerformIO $- withForeignPtr fg $ \pg -> alloca $ \pc -> do- ret <- ecdsaSignatureSerializeCompact ctx pc pg- unless (isSuccess ret) $ error "Could not obtain compact signature"- peek pc+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 c = unsafePerformIO $ alloca $ \pc -> do- poke pc c- fg <- mallocForeignPtr- ret <- withForeignPtr fg $ \pg -> ecdsaSignatureParseCompact ctx pg pc- if isSuccess ret then return $ Just $ Sig fg else return Nothing+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 $- useByteString bs $ \(b, l) -> do- fg <- mallocForeignPtr- ret <- withForeignPtr fg $ \g -> ecdsaSignatureParseDer ctx g b l- if isSuccess ret then return $ Just $ Sig fg else return Nothing+ 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 fg) = unsafePerformIO $- withForeignPtr fg $ \g -> alloca $ \l -> allocaBytes 72 $ \o -> do- poke l 72- ret <- ecdsaSignatureSerializeDer ctx o l g- unless (isSuccess ret) $ error "could not serialize signature"- n <- peek l- packByteString (o, n)+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 fp) (Sig fg) (Msg fm) = unsafePerformIO $- withForeignPtr fp $ \p -> withForeignPtr fg $ \g ->- withForeignPtr fm $ \m -> isSuccess <$> ecdsaVerify ctx g m p+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 fk) (Msg fm) = unsafePerformIO $- withForeignPtr fk $ \k -> withForeignPtr fm $ \m -> do- fg <- mallocForeignPtr- ret <- withForeignPtr fg $ \g -> ecdsaSign ctx g m k nullPtr nullPtr- unless (isSuccess ret) $ error "could not sign message"- return $ Sig fg+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 fk) = unsafePerformIO $ withForeignPtr fk $ \k -> do- fp <- mallocForeignPtr- ret <- withForeignPtr fp $ \p -> ecPubKeyCreate ctx p k- unless (isSuccess ret) $ error "could not compute public key"- return $ PubKey fp+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 fk) (Tweak ft) = unsafePerformIO $- withForeignPtr fk $ \k -> withForeignPtr ft $ \t -> do- fk' <- mallocForeignPtr- ret <- withForeignPtr fk' $ \k' -> do- key <- peek k- poke k' key- ecSecKeyTweakAdd ctx k' t- if isSuccess ret then return $ Just $ SecKey fk' else return Nothing+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 fk) (Tweak ft) = unsafePerformIO $- withForeignPtr fk $ \k -> withForeignPtr ft $ \t -> do- fk' <- mallocForeignPtr- ret <- withForeignPtr fk' $ \k' -> do- key <- peek k- poke k' key- ecSecKeyTweakMul ctx k' t- if isSuccess ret then return $ Just $ SecKey fk' else return Nothing+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 fp) (Tweak ft) = unsafePerformIO $- withForeignPtr fp $ \p -> withForeignPtr ft $ \t -> do- fp' <- mallocForeignPtr- ret <- withForeignPtr fp' $ \p' -> do- pub <- peek p- poke p' pub- ecPubKeyTweakAdd ctx p' t- if isSuccess ret then return $ Just $ PubKey fp' else return Nothing+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 fp) (Tweak ft) = unsafePerformIO $- withForeignPtr fp $ \p -> withForeignPtr ft $ \t -> do- fp' <- mallocForeignPtr- ret <- withForeignPtr fp' $ \p' -> do- pub <- peek p- poke p' pub- ecPubKeyTweakMul ctx p' t- if isSuccess ret then return $ Just $ PubKey fp' else return Nothing+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 ->+combinePubKeys pubs = unsafePerformIO $+ pointers [] pubs $ \ps -> allocaArray (length ps) $ \a -> do- pokeArray a ps- fp <- mallocForeignPtr- ret <- withForeignPtr fp $ \p ->- ecPubKeyCombine ctx p a (fromIntegral $ length ps)- if isSuccess ret- then return $ Just $ PubKey fp- else return Nothing+ 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 fp : pubs') f =- withForeignPtr fp $ \p -> pointers (p:ps) pubs' f+ pointers ps (PubKey pub_key : pub_keys) f =+ unsafeUseByteString pub_key $ \(p, _) ->+ pointers (p : ps) pub_keys f tweakNegate :: Tweak -> Maybe Tweak-tweakNegate (Tweak fk) = unsafePerformIO $ do- fnew <- mallocForeignPtr- peeked <- withForeignPtr fk peek- ret <- withForeignPtr fnew $ \n -> do- poke n peeked- ecTweakNegate ctx n- return $- if isSuccess ret- then Just (Tweak fnew)- else Nothing+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
src/Crypto/Secp256k1/Internal.hs view
@@ -1,7 +1,4 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE CPP #-} {-| Module : Crypto.Secp256k1.Internal License : UNLICENSE@@ -14,370 +11,261 @@ -} module Crypto.Secp256k1.Internal where -import Control.DeepSeq (NFData)-import Control.Monad (guard, unless)-import Data.ByteString (ByteString)-import qualified Data.ByteString as BS-import Data.ByteString.Short (ShortByteString, fromShort, toShort)-import Data.Serialize (Serialize (..))-import qualified Data.Serialize.Get as Get-import qualified Data.Serialize.Put as Put-import Data.Void (Void)-import Foreign (FunPtr, Ptr, Storable (..), alloca,- castPtr, copyArray)-import Foreign.C (CInt (..), CSize (..), CString, CUChar,- CUInt (..))-import GHC.Generics (Generic)-import System.Entropy (getEntropy)-import System.IO.Unsafe (unsafePerformIO)--data Ctx = Ctx--newtype PubKey64 = PubKey64 { getPubKey64 :: ShortByteString }- deriving (Read, Show, Eq, Ord, Generic, NFData)--newtype Msg32 = Msg32 { getMsg32 :: ShortByteString }- deriving (Read, Show, Eq, Ord, Generic, NFData)--newtype Sig64 = Sig64 { getSig64 :: ShortByteString }- deriving (Read, Show, Eq, Ord, Generic, NFData)--data CompactSig =- CompactSig- { getCompactSigR :: !ShortByteString- , getCompactSigS :: !ShortByteString- }- deriving (Show, Eq, Ord, Generic, NFData)--newtype RecSig65 = RecSig65 { getRecSig65 :: ShortByteString }- deriving (Read, Show, Eq, Ord, Generic, NFData)--newtype Seed32 = Seed32 { getSeed32 :: ShortByteString }- deriving (Read, Show, Eq, Ord, Generic, NFData)--newtype SecKey32 = SecKey32 { getSecKey32 :: ShortByteString }- deriving (Read, Show, Eq, Ord, Generic, NFData)--newtype Tweak32 = Tweak32 { getTweak32 :: ShortByteString }- deriving (Read, Show, Eq, Ord, Generic, NFData)--newtype Nonce32 = Nonce32 { getNonce32 :: ShortByteString }- deriving (Read, Show, Eq, Ord, Generic, NFData)+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) -newtype Algo16 = Algo16 { getAlgo16 :: ShortByteString }- deriving (Read, Show, Eq, Ord, Generic, NFData)+data LCtx+data PubKey64+data Msg32+data Sig64+data Compact64+data Seed32+data SecKey32+data Tweak32 -newtype CtxFlags = CtxFlags { getCtxFlags :: CUInt }- deriving (Read, Show, Eq, Ord, Generic, NFData)+type CtxFlags = CUInt+type SerFlags = CUInt+type Ret = CInt -newtype SerFlags = SerFlags { getSerFlags :: CUInt }- deriving (Read, Show, Eq, Ord, Generic, NFData)+type NonceFun a =+ Ptr CUChar ->+ Ptr CUChar ->+ Ptr CUChar ->+ Ptr CUChar ->+ Ptr a ->+ CInt ->+ IO CInt -newtype Ret = Ret { getRet :: CInt }- deriving (Read, Show, Eq, Ord, Generic, NFData)+type Ctx = Ptr LCtx verify :: CtxFlags-verify = CtxFlags 0x0101+verify = 0x0101 sign :: CtxFlags-sign = CtxFlags 0x0201+sign = 0x0201 signVerify :: CtxFlags-signVerify = CtxFlags 0x0301+signVerify = 0x0301 compressed :: SerFlags-compressed = SerFlags 0x0102+compressed = 0x0102 uncompressed :: SerFlags-uncompressed = SerFlags 0x0002--useByteString :: ByteString -> ((Ptr CUChar, CSize) -> IO a) -> IO a-useByteString bs f =- BS.useAsCStringLen bs $ \(b, l) -> f (castPtr b, fromIntegral l)--packByteString :: (Ptr CUChar, CSize) -> IO ByteString-packByteString (b, l) = BS.packCStringLen (castPtr b, fromIntegral l)--instance Storable PubKey64 where- sizeOf _ = 64- alignment _ = 1- peek p = PubKey64 . toShort <$> packByteString (castPtr p, 64)- poke p (PubKey64 k) = useByteString (fromShort k) $- \(b, _) -> copyArray (castPtr p) b 64--instance Storable Sig64 where- sizeOf _ = 64- alignment _ = 1- peek p = Sig64 . toShort <$> packByteString (castPtr p, 64)- poke p (Sig64 k) = useByteString (fromShort k) $- \(b, _) -> copyArray (castPtr p) b 64--instance Storable CompactSig where- sizeOf _ = 64- alignment _ = 1- peek p = do- bs <- BS.packCStringLen (castPtr p, 64)- let (r, s) = BS.splitAt 32 bs- guard $ BS.length r == 32- guard $ BS.length s == 32- return CompactSig { getCompactSigR = toShort r- , getCompactSigS = toShort s- }- poke p CompactSig{..} =- useByteString bs $ \(b, _) -> copyArray (castPtr p) b 64- where- bs = fromShort getCompactSigR `BS.append` fromShort getCompactSigS--instance Serialize CompactSig where- get = do- r <- Get.getByteString 32- s <- Get.getByteString 32- return CompactSig { getCompactSigR = toShort r- , getCompactSigS = toShort s- }- put (CompactSig r s) = do- Put.putShortByteString r- Put.putShortByteString s--instance Storable Msg32 where- sizeOf _ = 32- alignment _ = 1- peek p = Msg32 . toShort <$> packByteString (castPtr p, 32)- poke p (Msg32 k) = useByteString (fromShort k) $- \(b, _) -> copyArray (castPtr p) b 32--instance Storable Seed32 where- sizeOf _ = 32- alignment _ = 1- peek p = Seed32 . toShort <$> packByteString (castPtr p, 32)- poke p (Seed32 k) = useByteString (fromShort k) $- \(b, _) -> copyArray (castPtr p) b 32+uncompressed = 0x0002 -instance Storable SecKey32 where- sizeOf _ = 32- alignment _ = 1- peek p = SecKey32 . toShort <$> packByteString (castPtr p, 32)- poke p (SecKey32 k) = useByteString (fromShort k) $- \(b, _) -> copyArray (castPtr p) b 32+isSuccess :: Ret -> Bool+isSuccess 0 = False+isSuccess 1 = True+isSuccess n = error $ "isSuccess expected 0 or 1 but got " <> show n -instance Storable Tweak32 where- sizeOf _ = 32- alignment _ = 1- peek p = Tweak32 . toShort <$> packByteString (castPtr p, 32)- poke p (Tweak32 k) = useByteString (fromShort k) $- \(b, _) -> copyArray (castPtr p) b 32+unsafeUseByteString :: ByteString -> ((Ptr a, CSize) -> IO b) -> IO b+unsafeUseByteString bs f =+ BU.unsafeUseAsCStringLen bs $ \(b, l) ->+ f (castPtr b, fromIntegral l) -instance Storable Nonce32 where- sizeOf _ = 32- alignment _ = 1- peek p = Nonce32 . toShort <$> packByteString (castPtr p, 32)- poke p (Nonce32 k) = useByteString (fromShort k) $- \(b, _) -> copyArray (castPtr p) b 32+useByteString :: ByteString -> ((Ptr a, CSize) -> IO b) -> IO b+useByteString bs f =+ BS.useAsCStringLen bs $ \(b, l) ->+ f (castPtr b, fromIntegral l) -instance Storable Algo16 where- sizeOf _ = 16- alignment _ = 1- peek p = Algo16 . toShort <$> packByteString (castPtr p, 16)- poke p (Algo16 k) = useByteString (fromShort k) $- \(b, _) -> copyArray (castPtr p) b 16+unsafePackByteString :: (Ptr a, CSize) -> IO ByteString+unsafePackByteString (b, l) =+ BU.unsafePackMallocCStringLen (castPtr b, fromIntegral l) -isSuccess :: Ret -> Bool-isSuccess (Ret 0) = False-isSuccess (Ret 1) = True-isSuccess (Ret n) = error $ "isSuccess expected 0 or 1 but got " <> show n+packByteString :: (Ptr a, CSize) -> IO ByteString+packByteString (b, l) =+ BS.packCStringLen (castPtr b, fromIntegral l) +ctx :: Ctx+ctx = unsafePerformIO $ contextCreate signVerify {-# NOINLINE ctx #-}-ctx :: Ptr Ctx-ctx = unsafePerformIO $ do- x <- contextCreate signVerify- e <- getEntropy 32- ret <- alloca $ \s -> do- poke s (Seed32 (toShort e))- contextRandomize x s- unless (isSuccess ret) $ error "failed to randomize context"- return x -foreign import ccall unsafe+foreign import ccall safe "secp256k1.h secp256k1_context_create" contextCreate :: CtxFlags- -> IO (Ptr Ctx)+ -> IO Ctx -foreign import ccall unsafe+foreign import ccall safe "secp256k1.h secp256k1_context_clone" contextClone- :: Ptr Ctx- -> IO (Ptr Ctx)+ :: Ctx+ -> IO Ctx -foreign import ccall unsafe+foreign import ccall safe "secp256k1.h &secp256k1_context_destroy" contextDestroy- :: FunPtr (Ptr Ctx -> IO ())+ :: FunPtr (Ctx -> IO ()) -foreign import ccall unsafe+foreign import ccall safe "secp256k1.h secp256k1_context_set_illegal_callback" setIllegalCallback- :: Ptr Ctx+ :: Ctx -> FunPtr (CString -> Ptr a -> IO ()) -- ^ message, data -> Ptr a -- ^ data -> IO () -foreign import ccall unsafe+foreign import ccall safe "secp256k1.h secp256k1_context_set_error_callback" setErrorCallback- :: Ptr Ctx+ :: Ctx -> FunPtr (CString -> Ptr a -> IO ()) -- ^ message, data -> Ptr a -- ^ data -> IO () -foreign import ccall unsafe+foreign import ccall safe "secp256k1.h secp256k1_ec_pubkey_parse" ecPubKeyParse- :: Ptr Ctx+ :: Ctx -> Ptr PubKey64 -> Ptr CUChar -- ^ encoded public key array -> CSize -- ^ size of encoded public key array -> IO Ret -foreign import ccall unsafe+foreign import ccall safe "secp256k1.h secp256k1_ec_pubkey_serialize" ecPubKeySerialize- :: Ptr Ctx+ :: 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 unsafe+foreign import ccall safe "secp256k1.h secp256k1_ecdsa_signature_parse_compact" ecdsaSignatureParseCompact- :: Ptr Ctx+ :: Ctx -> Ptr Sig64- -> Ptr CompactSig+ -> Ptr Compact64 -> IO Ret -foreign import ccall unsafe+foreign import ccall safe "secp256k1.h secp256k1_ecdsa_signature_parse_der" ecdsaSignatureParseDer- :: Ptr Ctx+ :: Ctx -> Ptr Sig64 -> Ptr CUChar -- ^ encoded DER signature -> CSize -- ^ size of encoded signature -> IO Ret -foreign import ccall unsafe+foreign import ccall safe "secp256k1.h secp256k1_ecdsa_signature_serialize_der" ecdsaSignatureSerializeDer- :: Ptr Ctx+ :: 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 unsafe+foreign import ccall safe "secp256k1.h secp256k1_ecdsa_signature_serialize_compact" ecdsaSignatureSerializeCompact- :: Ptr Ctx- -> Ptr CompactSig+ :: Ctx+ -> Ptr Compact64 -> Ptr Sig64 -> IO Ret -foreign import ccall unsafe+foreign import ccall safe "secp256k1.h secp256k1_ecdsa_verify" ecdsaVerify- :: Ptr Ctx+ :: Ctx -> Ptr Sig64 -> Ptr Msg32 -> Ptr PubKey64 -> IO Ret -foreign import ccall unsafe+foreign import ccall safe "secp256k1.h secp256k1_ecdsa_signature_normalize" ecdsaSignatureNormalize- :: Ptr Ctx+ :: Ctx -> Ptr Sig64 -- ^ output -> Ptr Sig64 -- ^ input -> IO Ret -foreign import ccall unsafe+foreign import ccall safe "secp256k1.h secp256k1_ecdsa_sign" ecdsaSign- :: Ptr Ctx+ :: Ctx -> Ptr Sig64 -> Ptr Msg32 -> Ptr SecKey32- -> Ptr Void+ -> FunPtr (NonceFun a) -> Ptr a -- ^ nonce data -> IO Ret -foreign import ccall unsafe+foreign import ccall safe "secp256k1.h secp256k1_ec_seckey_verify" ecSecKeyVerify- :: Ptr Ctx+ :: Ctx -> Ptr SecKey32 -> IO Ret -foreign import ccall unsafe+foreign import ccall safe "secp256k1.h secp256k1_ec_pubkey_create" ecPubKeyCreate- :: Ptr Ctx+ :: Ctx -> Ptr PubKey64 -> Ptr SecKey32 -> IO Ret -foreign import ccall unsafe+foreign import ccall safe "secp256k1.h secp256k1_ec_privkey_tweak_add" ecSecKeyTweakAdd- :: Ptr Ctx+ :: Ctx -> Ptr SecKey32 -> Ptr Tweak32 -> IO Ret -foreign import ccall unsafe+foreign import ccall safe "secp256k1.h secp256k1_ec_privkey_negate" ecTweakNegate- :: Ptr Ctx+ :: Ctx -> Ptr Tweak32 -> IO Ret foreign import ccall unsafe "secp256k1.h secp256k1_ec_pubkey_tweak_add" ecPubKeyTweakAdd- :: Ptr Ctx+ :: Ctx -> Ptr PubKey64 -> Ptr Tweak32 -> IO Ret -foreign import ccall unsafe+foreign import ccall safe "secp256k1.h secp256k1_ec_privkey_tweak_mul" ecSecKeyTweakMul- :: Ptr Ctx+ :: Ctx -> Ptr SecKey32 -> Ptr Tweak32 -> IO Ret -foreign import ccall unsafe+foreign import ccall safe "secp256k1.h secp256k1_ec_pubkey_tweak_mul" ecPubKeyTweakMul- :: Ptr Ctx+ :: Ctx -> Ptr PubKey64 -> Ptr Tweak32 -> IO Ret -foreign import ccall unsafe+foreign import ccall safe "secp256k1.h secp256k1_context_randomize" contextRandomize- :: Ptr Ctx+ :: Ctx -> Ptr Seed32 -> IO Ret -foreign import ccall unsafe+foreign import ccall safe "secp256k1.h secp256k1_ec_pubkey_combine" ecPubKeyCombine- :: Ptr Ctx- -> Ptr PubKey64 -- ^ pointer to public key storage+ :: Ctx+ -> Ptr PubKey64 -- ^ pointer to public key storage -> Ptr (Ptr PubKey64) -- ^ pointer to array of public keys- -> CInt -- ^ number of public keys+ -> CInt -- ^ number of public keys -> IO Ret
test/Crypto/Secp256k1/InternalSpec.hs view
@@ -5,9 +5,8 @@ import Control.Monad.Trans import Crypto.Secp256k1.Internal import Data.ByteString (ByteString, packCStringLen,- useAsCStringLen)+ useAsCStringLen, copy) import qualified Data.ByteString.Base16 as B16-import Data.ByteString.Short (toShort) import Foreign import System.Entropy import Test.Hspec@@ -22,8 +21,6 @@ describe "serialization" $ do it "parses public key" ecPubkeyParseTest it "serializes public key" ecPubKeySerializeTest- it "handles storable public key" pubkeyStorableTest- it "handles storable signature" signatureStorableTest it "parses DER signature" ecdsaSignatureParseDerTest it "serializes DER signature" ecdsaSignatureSerializeDerTest describe "signatures" $ do@@ -44,8 +41,7 @@ withEntropy :: (Ptr Seed32 -> IO a) -> IO a withEntropy f = getEntropy 32 >>= \e ->- alloca $ \s ->- poke s (Seed32 (toShort e)) >> f s+ useByteString e $ \(s, _) -> f s createContextTest :: Assertion createContextTest = do@@ -74,7 +70,7 @@ ecPubkeyParseTest = do ret <- liftIO $ useAsCStringLen der $ \(i, il) -> do x <- contextCreate verify- alloca $ \pubkey ->+ allocaBytes 64 $ \pubkey -> ecPubKeyParse x pubkey (castPtr i) (fromIntegral il) assertBool "parsed public key" (isSuccess ret) where@@ -83,15 +79,16 @@ ecPubKeySerializeTest :: Assertion ecPubKeySerializeTest = do- (ret, dec) <- liftIO $ useAsCStringLen der $ \(i, il) ->- alloca $ \k -> alloca $ \ol -> allocaBytes 72 $ \o -> do+ (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 (castPtr i) (fromIntegral il)+ ret1 <- ecPubKeyParse x k i il unless (isSuccess ret1) $ error "failed to parse pubkey"- ret2 <- ecPubKeySerialize- x o ol k compressed+ ret2 <- ecPubKeySerialize x o ol k compressed len <- fromIntegral <$> peek ol decoded <- packCStringLen (castPtr o, len) return (ret2, decoded)@@ -101,56 +98,9 @@ der = fst $ B16.decode "03dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd44705" -pubkeyStorableTest :: Assertion-pubkeyStorableTest = do- (pk1, pk2, dec) <- liftIO $ useAsCStringLen der $ \(i, il) -> do- x <- contextCreate verify- pk1 <- alloca $ \pk -> do- ret <-- ecPubKeyParse x pk (castPtr i) (fromIntegral il)- unless (isSuccess ret) $ error "failed to parse pubkey"- peek pk- (pk2, dec) <- alloca $ \pk -> alloca $ \ol -> allocaBytes 72 $ \o -> do- poke ol 72- poke pk pk1- ret <-- ecPubKeySerialize x o ol pk compressed- unless (isSuccess ret) $ error "failed to serialize pubkey"- len <- fromIntegral <$> peek ol- dec <- packCStringLen (castPtr o, len)- pk2 <- peek pk- return (pk2, dec)- return (pk1, pk2, dec)- assertEqual "poke/peek public key" pk1 pk2- assertEqual "public key matches" der dec- where- der = fst $ B16.decode- "03dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd44705"--signatureStorableTest :: Assertion-signatureStorableTest = do- (sig, ret) <- liftIO $ do- x <- contextCreate verify- g <- alloca $ \pc -> alloca $ \pg -> do- poke pc cpt- ret <- ecdsaSignatureParseCompact x pg (castPtr pc)- unless (isSuccess ret) $ error "failed to parse signature"- peek pg- alloca $ \pc -> alloca $ \pg -> do- poke pg g- ret <- ecdsaSignatureSerializeCompact x pc pg- c <- peek pc- return (c, ret)- assertBool "successful serialization" (isSuccess ret)- assertEqual "signatures match" cpt sig- where- cpt = CompactSig- (toShort $ fst $ B16.decode "f502bfa07af43e7ef265618b0d929a7619ee01d6150e37eb6eaaf2c8bd37fb22")- (toShort $ fst $ B16.decode "6f0415ab0e9a977afd78b2c26ef39b3952096d319fd4b101c768ad6c132e3045")- ecdsaSignatureParseDerTest :: Assertion ecdsaSignatureParseDerTest = do- ret <- liftIO $ useAsCStringLen der $ \(d, dl) -> alloca $ \s -> 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@@ -160,22 +110,24 @@ \fb2202206f0415ab0e9a977afd78b2c26ef39b3952096d319fd4b101c768ad6c132e30\ \45" -parseDer :: Ptr Ctx -> ByteString -> IO Sig64-parseDer x bs = useAsCStringLen bs $ \(d, dl) -> alloca $ \s -> do+parseDer :: Ctx -> ByteString -> IO ByteString+parseDer x bs =+ useAsCStringLen bs $ \(d, dl) ->+ allocaBytes 64 $ \s -> do ret <- ecdsaSignatureParseDer x s (castPtr d) (fromIntegral dl) unless (isSuccess ret) $ error "could not parse DER"- peek s+ packByteString (s, 64) ecdsaSignatureSerializeDerTest :: Assertion ecdsaSignatureSerializeDerTest = do (ret, enc) <- liftIO $ do x <- contextCreate verify sig <- parseDer x der- alloca $ \s -> alloca $ \ol -> allocaBytes 72 $ \o -> do+ alloca $ \ol ->+ allocaBytes 72 $ \o ->+ useByteString sig $ \(s, _) -> do poke ol 72- poke s sig- ret <-- ecdsaSignatureSerializeDer x o ol s+ ret <- ecdsaSignatureSerializeDer x o ol s len <- fromIntegral <$> peek ol enc <- packCStringLen (castPtr o, len) return (ret, enc)@@ -192,15 +144,14 @@ ret <- liftIO $ do x <- contextCreate verify sig <- parseDer x der- pk <- useAsCStringLen pub $ \(p, pl) -> alloca $ \k -> do- ret <-- ecPubKeyParse x k (castPtr p) (fromIntegral pl)+ 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"- peek k- alloca $ \m -> alloca $ \k -> alloca $ \s -> do- poke m msg- poke k pk- poke s sig+ packByteString (k, 64)+ useByteString msg $ \(m, _) ->+ useByteString pk $ \(k, _) ->+ useByteString sig $ \(s, _) -> ecdsaVerify x s m k assertBool "signature valid" $ isSuccess ret where@@ -211,17 +162,16 @@ pub = fst $ B16.decode "04dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd447051221\ \3d5ed790522c042dee8e85c4c0ec5f96800b72bc5940c8bc1c5e11e4fcbf"- msg = Msg32 $ toShort $ fst $ B16.decode+ msg = fst $ B16.decode "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00" -signCtx :: IO (Ptr Ctx)+signCtx :: IO Ctx signCtx = contextCreate sign >>= \c -> withEntropy (contextRandomize c) >>= \r -> unless (isSuccess r) (error "failed to randomize context") >> return c -createPubKey :: Ptr Ctx -> Ptr SecKey32 -> Ptr PubKey64 -> SecKey32 -> IO ()-createPubKey x k p key = do- poke k key+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" @@ -229,63 +179,64 @@ ecdsaSignTest = do der <- liftIO $ do x <- signCtx- alloca $ \s -> alloca $ \m -> alloca $ \k -> alloca $ \ol ->+ allocaBytes 64 $ \s ->+ useByteString msg $ \(m, _) ->+ useByteString key $ \(k, _) ->+ alloca $ \ol -> allocaBytes 72 $ \o -> do poke ol 72- poke m msg- poke k key- ret1 <-- ecdsaSign x s m k nullPtr nullPtr+ 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- p <- alloca $ \p -> alloca $ \k -> do- x <- signCtx- createPubKey x k p key- return p- alloca $ \m -> alloca $ \s -> 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- g <- parseDer x der- poke m msg- poke s g- ecdsaVerify x s m p+ s' <- parseDer x der+ useByteString s' $ \(s, _) -> ecdsaVerify x s m p assertBool "signature matches" (isSuccess ret) where- msg = Msg32 $ toShort $ fst $ B16.decode+ msg = fst $ B16.decode "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00"- key = SecKey32 $ toShort $ fst $ B16.decode+ key = fst $ B16.decode "f65255094d7773ed8dd417badc9fc045c1f80fdc5b2d25172b031ce6933e039a" ecSecKeyVerifyTest :: Assertion ecSecKeyVerifyTest = do- ret <- liftIO $ alloca $ \k -> do- poke k key+ ret <- liftIO $ useByteString key $ \(k, _) -> do x <- signCtx ecSecKeyVerify x k assertBool "valid secret key" $ isSuccess ret where- key = SecKey32 $ toShort $ fst $ B16.decode+ key = fst $ B16.decode "f65255094d7773ed8dd417badc9fc045c1f80fdc5b2d25172b031ce6933e039a" ecPubkeyCreateTest :: Assertion ecPubkeyCreateTest = do- pk <- liftIO $ alloca $ \p -> alloca $ \k -> do+ pk <- liftIO $+ useByteString key $ \(s, _) ->+ allocaBytes 64 $ \k -> do x <- signCtx- createPubKey x k p key- allocaBytes 65 $ \o -> alloca $ \ol -> do+ createPubKey x s k+ allocaBytes 65 $ \o ->+ alloca $ \ol -> do poke ol 65- rets <- ecPubKeySerialize- x o ol p uncompressed+ rets <- ecPubKeySerialize x 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 where- key = SecKey32 $ toShort $ fst $ B16.decode+ key = fst $ B16.decode "f65255094d7773ed8dd417badc9fc045c1f80fdc5b2d25172b031ce6933e039a" pub = fst $ B16.decode "04dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd447051221\@@ -293,22 +244,21 @@ ecSecKeyTweakAddTest :: Assertion ecSecKeyTweakAddTest = do- (ret, tweaked) <- liftIO $ do- x <- signCtx- alloca $ \w -> alloca $ \k -> do- poke w tweak- poke k key- ret <- ecSecKeyTweakAdd x k w- tweaked <- peek k- return (ret, tweaked)+ (ret, tweaked) <- liftIO $+ signCtx >>= \x ->+ 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 where- key = SecKey32 $ toShort $ fst $ B16.decode+ key = fst $ B16.decode "f65255094d7773ed8dd417badc9fc045c1f80fdc5b2d25172b031ce6933e039a"- tweak = Tweak32 $ toShort $ fst $ B16.decode+ tweak = fst $ B16.decode "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00"- expected = SecKey32 $ toShort $ fst $ B16.decode+ expected = fst $ B16.decode "ec1e3ce1cefa18a671d51125e2b249688d934b0e28f5d1665384d9b02f929059" ecSecKeyTweakMulTest :: Assertion@@ -317,23 +267,21 @@ x <- contextCreate sign retr <- withEntropy $ contextRandomize x unless (isSuccess retr) $ error "failed to randomize context"- alloca $ \w -> alloca $ \k -> do- poke w tweak- poke k key+ useByteString tweak $ \(w, _) -> useByteString key $ \(k, _) -> do ret <- ecSecKeyTweakMul x k w- tweaked <- peek k+ tweaked <- packByteString (k, 32) return (ret, tweaked) assertBool "successful secret key tweak" $ isSuccess ret assertEqual "tweaked keys match" expected tweaked where- key = SecKey32 $ toShort $ fst $ B16.decode+ key = fst $ B16.decode "f65255094d7773ed8dd417badc9fc045c1f80fdc5b2d25172b031ce6933e039a"- tweak = Tweak32 $ toShort $ fst $ B16.decode+ tweak = fst $ B16.decode "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00"- expected = SecKey32 $ toShort $ fst $ B16.decode+ expected = fst $ B16.decode "a96f5962493acb179f60a86a9785fc7a30e0c39b64c09d24fe064d9aef15e4c0" -serializeKey :: Ptr Ctx -> Ptr PubKey64 -> IO ByteString+serializeKey :: Ctx -> Ptr PubKey64 -> IO ByteString serializeKey x p = allocaBytes 72 $ \d -> alloca $ \dl -> do poke dl 72 ret <- ecPubKeySerialize x d dl p uncompressed@@ -341,20 +289,21 @@ len <- peek dl packCStringLen (castPtr d, fromIntegral len) -parseKey :: Ptr Ctx -> ByteString -> IO PubKey64-parseKey x bs = alloca $ \p -> useAsCStringLen bs $ \(d, dl) -> do- ret <- ecPubKeyParse x p (castPtr d) (fromIntegral dl)+parseKey :: Ctx -> ByteString -> IO ByteString+parseKey x bs =+ allocaBytes 64 $ \p ->+ useByteString bs $ \(d, dl) -> do+ ret <- ecPubKeyParse x p d dl unless (isSuccess ret) $ error "could not parse public key"- peek p+ packByteString (p, 64) ecPubKeyTweakAddTest :: Assertion ecPubKeyTweakAddTest = do (ret, tweaked) <- liftIO $ do x <- contextCreate verify- pk <- parseKey x pub- alloca $ \w -> alloca $ \p -> do- poke w tweak- poke p pk+ pk <- copy <$> parseKey x pub+ useByteString tweak $ \(w, _) ->+ useByteString pk $ \(p, _) -> do ret <- ecPubKeyTweakAdd x p w tweaked <- serializeKey x p return (ret, tweaked)@@ -364,7 +313,7 @@ pub = fst $ B16.decode "04dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd447051221\ \3d5ed790522c042dee8e85c4c0ec5f96800b72bc5940c8bc1c5e11e4fcbf"- tweak = Tweak32 $ toShort $ fst $ B16.decode+ tweak = fst $ B16.decode "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00" expected = fst $ B16.decode "04441c3982b97576646e0df0c96736063df6b42f2ee566d13b9f6424302d1379e518fd\@@ -374,10 +323,9 @@ ecPubKeyTweakMulTest = do (ret, tweaked) <- liftIO $ do x <- contextCreate verify- pk <- parseKey x pub- alloca $ \w -> alloca $ \p -> do- poke w tweak- poke p pk+ pk <- copy <$> parseKey x pub+ useByteString tweak $ \(w, _) ->+ useByteString pk $ \(p, _) -> do ret <- ecPubKeyTweakMul x p w tweaked <- serializeKey x p return (ret, tweaked)@@ -387,7 +335,7 @@ pub = fst $ B16.decode "04dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd447051221\ \3d5ed790522c042dee8e85c4c0ec5f96800b72bc5940c8bc1c5e11e4fcbf"- tweak = Tweak32 $ toShort $ fst $ B16.decode+ tweak = fst $ B16.decode "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00" expected = fst $ B16.decode "04f379dc99cdf5c83e433defa267fbb3377d61d6b779c06a0e4ce29ae3ff5353b12ae4\@@ -395,8 +343,12 @@ ecPubKeyCombineTest :: Assertion ecPubKeyCombineTest = do- (ret, com) <- liftIO $ alloca $ \p1 -> alloca $ \p2 -> alloca $ \p3 ->- allocaArray 3 $ \a -> alloca $ \p -> do+ (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@@ -408,8 +360,8 @@ assertBool "successful key combination" $ isSuccess ret assertEqual "combined keys match" expected com where- parse x pub p = useAsCStringLen pub $ \(d, dl) -> do- ret <- ecPubKeyParse x p (castPtr d) (fromIntegral dl)+ 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\
test/Crypto/Secp256k1Spec.hs view
@@ -1,13 +1,13 @@ {-# LANGUAGE CPP #-} 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)-import qualified Data.Serialize as S+import Data.Maybe (fromMaybe, isNothing) import Data.String (fromString) import Data.String.Conversions (cs) import Test.Hspec@@ -28,8 +28,12 @@ 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" $@@ -115,9 +119,9 @@ fg = signMsg fk fm normalizeSigTest :: (Msg, SecKey) -> Bool-normalizeSigTest (fm, fk) = not norm && sig == fg where+normalizeSigTest (fm, fk) = isNothing sig where fg = signMsg fk fm- (sig, norm) = normalizeSig fg+ sig = normalizeSig fg serializePubKeyTest :: (PubKey, Bool) -> Bool serializePubKeyTest (fp, b) =@@ -125,6 +129,11 @@ Just fp' -> fp == fp' Nothing -> False +parSerializePubKeyTest :: [(PubKey, Bool)] -> Bool+parSerializePubKeyTest ps = runPar $ do+ as <- mapM (spawnP . serializePubKeyTest) ps+ and <$> mapM get as+ serializeSigTest :: (Msg, SecKey) -> Bool serializeSigTest (fm, fk) = case importSig $ exportSig fg of@@ -132,6 +141,11 @@ Nothing -> False where fg = signMsg fk fm++parSerializeSigTest :: [(Msg, SecKey)] -> Bool+parSerializeSigTest ms = runPar $ do+ as <- mapM (spawnP . serializeSigTest) ms+ and <$> mapM get as serializeCompactSigTest :: (Msg, SecKey) -> Bool serializeCompactSigTest (fm, fk) =