diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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. diff --git a/secp256k1-haskell.cabal b/secp256k1-haskell.cabal --- a/secp256k1-haskell.cabal +++ b/secp256k1-haskell.cabal @@ -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 diff --git a/src/Crypto/Secp256k1.hs b/src/Crypto/Secp256k1.hs --- a/src/Crypto/Secp256k1.hs +++ b/src/Crypto/Secp256k1.hs @@ -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 diff --git a/src/Crypto/Secp256k1/Internal.hs b/src/Crypto/Secp256k1/Internal.hs --- a/src/Crypto/Secp256k1/Internal.hs +++ b/src/Crypto/Secp256k1/Internal.hs @@ -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 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 @@ -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\ diff --git a/test/Crypto/Secp256k1Spec.hs b/test/Crypto/Secp256k1Spec.hs --- a/test/Crypto/Secp256k1Spec.hs +++ b/test/Crypto/Secp256k1Spec.hs @@ -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) =