mirror of
https://github.com/ilyakooo0/secp256k1-haskell.git
synced 2024-10-26 12:56:14 +03:00
Reuse context aggressively
This commit is contained in:
parent
747b3efa5e
commit
f8e9dfbed5
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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"
|
||||
|
Loading…
Reference in New Issue
Block a user