Reuse context aggressively

This commit is contained in:
Jean-Pierre Rupp 2020-06-13 12:03:55 +01:00
parent 747b3efa5e
commit f8e9dfbed5
No known key found for this signature in database
GPG Key ID: 93391726EAFA0C5D
4 changed files with 45 additions and 54 deletions

View File

@ -4,9 +4,10 @@ All notable changes to this project will be documented in this file.
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).
## Unreleased
## 0.2.5
### Changed
- Minor Cabal file changes.
- Reuse context aggressively.
- Generate context in a single thread.
## 0.2.4
### Changed

View File

@ -4,11 +4,11 @@ cabal-version: 2.0
--
-- see: https://github.com/sol/hpack
--
-- hash: bd2e5c4ac3f84ef9b07d278afa099869aa61d825e272c7649cf67caebb87bfbb
-- hash: f64a6c7d68d58fab5fc141dd7bda78089fe9403dc39525641eba1ca0fd92593c
name: secp256k1-haskell
version: 0.2.4
synopsis: Bindings for secp256k1 library from Bitcoin Core
version: 0.2.5
synopsis: Bindings for secp256k1
description: Sign and verify signatures using the secp256k1 library.
category: Crypto
homepage: http://github.com/haskoin/secp256k1-haskell#readme

View File

@ -91,15 +91,13 @@ 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 (decode, encode)
import Data.String (IsString (..))
import Data.String.Conversions (ConvertibleStrings, cs)
import Foreign (ForeignPtr, alloca,
allocaArray, allocaBytes,
mallocForeignPtr,
mallocForeignPtr,
nullPtr, peek, poke, pokeArray,
withForeignPtr)
import Foreign.C.Types (CInt)
import System.IO.Unsafe (unsafePerformIO)
import Test.QuickCheck (Arbitrary (..),
arbitraryBoundedRandom, suchThat)
@ -317,7 +315,7 @@ msg bs
-- | Import 32-byte 'ByteString' as 'SecKey'.
secKey :: ByteString -> Maybe SecKey
secKey bs
| BS.length bs == 32 = withContext $ \ctx -> do
| BS.length bs == 32 = unsafePerformIO $ do
fp <- mallocForeignPtr
ret <- withForeignPtr fp $ \p -> do
poke p (SecKey32 (toShort bs))
@ -331,7 +329,7 @@ secKey bs
-- indicates that the signature changed, 'False' indicates that it was already
-- normal.
normalizeSig :: Sig -> (Sig, Bool)
normalizeSig (Sig fg) = withContext $ \ctx -> do
normalizeSig (Sig fg) = unsafePerformIO $ do
fg' <- mallocForeignPtr
ret <- withForeignPtr fg $ \pg -> withForeignPtr fg' $ \pg' ->
ecdsaSignatureNormalize ctx pg' pg
@ -368,14 +366,14 @@ getTweak (Tweak ft) =
-- | Import DER-encoded public key.
importPubKey :: ByteString -> Maybe PubKey
importPubKey bs = withContext $ \ctx -> useByteString bs $ \(b, l) -> do
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
-- | Encode public key as DER. First argument 'True' for compressed output.
exportPubKey :: Bool -> PubKey -> ByteString
exportPubKey compress (PubKey pub) = withContext $ \ctx ->
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
@ -387,14 +385,14 @@ exportPubKey compress (PubKey pub) = withContext $ \ctx ->
z = if compress then 33 else 65
exportCompactSig :: Sig -> CompactSig
exportCompactSig (Sig fg) = withContext $ \ctx ->
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
importCompactSig :: CompactSig -> Maybe Sig
importCompactSig c = withContext $ \ctx -> alloca $ \pc -> do
importCompactSig c = unsafePerformIO $ alloca $ \pc -> do
poke pc c
fg <- mallocForeignPtr
ret <- withForeignPtr fg $ \pg -> ecdsaSignatureParseCompact ctx pg pc
@ -402,7 +400,7 @@ importCompactSig c = withContext $ \ctx -> alloca $ \pc -> do
-- | Import DER-encoded signature.
importSig :: ByteString -> Maybe Sig
importSig bs = withContext $ \ctx ->
importSig bs = unsafePerformIO $
useByteString bs $ \(b, l) -> do
fg <- mallocForeignPtr
ret <- withForeignPtr fg $ \g -> ecdsaSignatureParseDer ctx g b l
@ -410,7 +408,7 @@ importSig bs = withContext $ \ctx ->
-- | Encode signature as strict DER.
exportSig :: Sig -> ByteString
exportSig (Sig fg) = withContext $ \ctx ->
exportSig (Sig fg) = unsafePerformIO $
withForeignPtr fg $ \g -> alloca $ \l -> allocaBytes 72 $ \o -> do
poke l 72
ret <- ecdsaSignatureSerializeDer ctx o l g
@ -420,12 +418,12 @@ exportSig (Sig fg) = withContext $ \ctx ->
-- | Verify message signature. 'True' means that the signature is correct.
verifySig :: PubKey -> Sig -> Msg -> Bool
verifySig (PubKey fp) (Sig fg) (Msg fm) = withContext $ \ctx ->
verifySig (PubKey fp) (Sig fg) (Msg fm) = unsafePerformIO $
withForeignPtr fp $ \p -> withForeignPtr fg $ \g ->
withForeignPtr fm $ \m -> isSuccess <$> ecdsaVerify ctx g m p
signMsg :: SecKey -> Msg -> Sig
signMsg (SecKey fk) (Msg fm) = withContext $ \ctx ->
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
@ -433,7 +431,7 @@ signMsg (SecKey fk) (Msg fm) = withContext $ \ctx ->
return $ Sig fg
derivePubKey :: SecKey -> PubKey
derivePubKey (SecKey fk) = withContext $ \ctx -> withForeignPtr fk $ \k -> do
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"
@ -442,7 +440,7 @@ derivePubKey (SecKey fk) = withContext $ \ctx -> withForeignPtr fk $ \k -> do
-- | Add tweak to secret key.
tweakAddSecKey :: SecKey -> Tweak -> Maybe SecKey
tweakAddSecKey (SecKey fk) (Tweak ft) = withContext $ \ctx ->
tweakAddSecKey (SecKey fk) (Tweak ft) = unsafePerformIO $
withForeignPtr fk $ \k -> withForeignPtr ft $ \t -> do
fk' <- mallocForeignPtr
ret <- withForeignPtr fk' $ \k' -> do
@ -453,7 +451,7 @@ tweakAddSecKey (SecKey fk) (Tweak ft) = withContext $ \ctx ->
-- | Multiply secret key by tweak.
tweakMulSecKey :: SecKey -> Tweak -> Maybe SecKey
tweakMulSecKey (SecKey fk) (Tweak ft) = withContext $ \ctx ->
tweakMulSecKey (SecKey fk) (Tweak ft) = unsafePerformIO $
withForeignPtr fk $ \k -> withForeignPtr ft $ \t -> do
fk' <- mallocForeignPtr
ret <- withForeignPtr fk' $ \k' -> do
@ -464,7 +462,7 @@ tweakMulSecKey (SecKey fk) (Tweak ft) = withContext $ \ctx ->
-- | 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) = withContext $ \ctx ->
tweakAddPubKey (PubKey fp) (Tweak ft) = unsafePerformIO $
withForeignPtr fp $ \p -> withForeignPtr ft $ \t -> do
fp' <- mallocForeignPtr
ret <- withForeignPtr fp' $ \p' -> do
@ -476,7 +474,7 @@ tweakAddPubKey (PubKey fp) (Tweak ft) = withContext $ \ctx ->
-- | 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) = withContext $ \ctx ->
tweakMulPubKey (PubKey fp) (Tweak ft) = unsafePerformIO $
withForeignPtr fp $ \p -> withForeignPtr ft $ \t -> do
fp' <- mallocForeignPtr
ret <- withForeignPtr fp' $ \p' -> do
@ -487,18 +485,16 @@ tweakMulPubKey (PubKey fp) (Tweak ft) = withContext $ \ctx ->
-- | Add multiple public keys together.
combinePubKeys :: [PubKey] -> Maybe PubKey
combinePubKeys pubs = withContext $ \ctx ->
if pubs == []
then return Nothing
else 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
combinePubKeys [] = Nothing
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
where
pointers ps [] f = f ps
pointers ps (PubKey fp : pubs') f =
@ -692,19 +688,17 @@ instance Arbitrary Msg where
arbitrary = gen_msg
where
valid_bs = bs_gen `suchThat` isJust
bs_gen = (msg . BS.pack) <$> replicateM 32 arbitraryBoundedRandom
bs_gen = msg . BS.pack <$> replicateM 32 arbitraryBoundedRandom
gen_msg = fromJust <$> valid_bs
instance Arbitrary SecKey where
arbitrary = gen_key where
valid_bs = bs_gen `suchThat` isJust
bs_gen = (secKey . BS.pack) <$> replicateM 32 arbitraryBoundedRandom
bs_gen = secKey . BS.pack <$> replicateM 32 arbitraryBoundedRandom
gen_key = fromJust <$> valid_bs
instance Arbitrary PubKey where
arbitrary = do
key <- arbitrary
return $ derivePubKey key
arbitrary = derivePubKey <$> arbitrary
#ifdef SCHNORR
instance Arbitrary XOnlyPubKey where

View File

@ -23,15 +23,13 @@ import Data.Serialize (Serialize (..))
import qualified Data.Serialize.Get as Get
import qualified Data.Serialize.Put as Put
import Data.Void (Void)
import Data.Word (Word8)
import Foreign (ForeignPtr, FunPtr, Ptr, Storable (..),
alloca, castPtr, copyArray,
newForeignPtr, withForeignPtr)
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 (unsafeDupablePerformIO, unsafePerformIO)
import System.IO.Unsafe (unsafePerformIO)
data Ctx = Ctx
@ -263,18 +261,16 @@ isSuccess (Ret 0) = False
isSuccess (Ret 1) = True
isSuccess (Ret n) = error $ "isSuccess expected 0 or 1 but got " <> show n
{-# NOINLINE fctx #-}
fctx :: ForeignPtr Ctx
fctx = unsafePerformIO $ do
{-# NOINLINE ctx #-}
ctx :: Ptr Ctx
ctx = unsafePerformIO $ do
x <- contextCreate signVerify
e <- getEntropy 32
ret <- alloca $ \s -> poke s (Seed32 (toShort e)) >> contextRandomize x s
ret <- alloca $ \s -> do
poke s (Seed32 (toShort e))
contextRandomize x s
unless (isSuccess ret) $ error "failed to randomize context"
newForeignPtr contextDestroy x
{-# INLINE withContext #-}
withContext :: (Ptr Ctx -> IO a) -> a
withContext f = unsafeDupablePerformIO (withForeignPtr fctx f)
return x
foreign import ccall
"secp256k1.h secp256k1_context_create"