secp256k1-haskell 1.0.1 → 1.1.0

raw patch · 5 files changed

+202/−163 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• secp256k1-haskell.cabal +2/−2
• src/Crypto/Secp256k1/Internal/Base.hs +159/−142
• src/Crypto/Secp256k1/Internal/Context.hs +34/−18
• test/Crypto/Secp256k1/InternalSpec.hs +1/−1

@@ -4,6 +4,12 @@ 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). +## [1.1.0] - 2023-11-01++### Changed++- Use ForeignPtr to allow the garbage collector manage the context object (Ctx).+ ## [1.0.1] - 2023-09-20  ### Changed

@@ -1,11 +1,11 @@ cabal-version: 2.0 --- This file has been generated from package.yaml by hpack version 0.35.2.+-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack  name:           secp256k1-haskell-version:        1.0.1+version:        1.1.0 synopsis:       Bindings for secp256k1 description:    Sign and verify signatures using the secp256k1 library. category:       Crypto

@@ -73,6 +73,7 @@     peek,     poke,     pokeArray,+    withForeignPtr,   ) import GHC.Generics (Generic) import System.IO.Unsafe (unsafePerformIO)@@ -204,17 +205,18 @@ -- | Convert signature to a normalized lower-S form. 'Nothing' indicates that it -- was already normal. normalizeSig :: Ctx -> Sig -> Maybe Sig-normalizeSig (Ctx ctx) (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+normalizeSig (Ctx fctx) (Sig sig) =+  unsafePerformIO $ withForeignPtr fctx $ \ctx ->+    unsafeUseByteString sig $ \(sig_in, _) -> do+      sig_out <- mallocBytes 64+      ret <- ecdsaSignatureNormalize ctx sig_out sig_in+      if isSuccess ret+        then do+          bs <- unsafePackByteString (sig_out, 64)+          return (Just (Sig bs))+        else do+          free sig_out+          return Nothing  -- | 32-Byte 'ByteString' as 'Tweak'. tweak :: ByteString -> Maybe Tweak@@ -224,181 +226,195 @@  -- | Import DER-encoded public key. importPubKey :: Ctx -> ByteString -> Maybe PubKey-importPubKey (Ctx ctx) bs+importPubKey (Ctx fctx) bs   | BS.null bs = Nothing-  | otherwise = 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+  | otherwise =+      unsafePerformIO $ withForeignPtr fctx $ \ctx ->+        unsafeUseByteString bs $ \(input, len) -> do+          pub_key <- mallocBytes 64+          ret <- ecPubKeyParse ctx pub_key input len+          if isSuccess ret+            then do+              out <- unsafePackByteString (pub_key, 64)+              return (Just (PubKey out))+            else do+              free pub_key+              return Nothing  -- | Encode public key as DER. First argument 'True' for compressed output. exportPubKey :: Ctx -> Bool -> PubKey -> ByteString-exportPubKey (Ctx ctx) 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)+exportPubKey (Ctx fctx) compress (PubKey in_bs) =+  unsafePerformIO $ withForeignPtr fctx $ \ctx ->+    unsafeUseByteString in_bs $ \(in_ptr, _) ->+      alloca $ \len_ptr ->+        allocaBytes len $ \out_ptr -> do+          poke len_ptr $ fromIntegral len+          ret <- ecPubKeySerialize ctx out_ptr len_ptr in_ptr flags+          unless (isSuccess ret) $ error "could not serialize public key"+          final_len <- peek len_ptr+          packByteString (out_ptr, final_len)   where     len = if compress then 33 else 65     flags = if compress then compressed else uncompressed  exportCompactSig :: Ctx -> Sig -> CompactSig-exportCompactSig (Ctx ctx) (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+exportCompactSig (Ctx fctx) (Sig sig_bs) =+  unsafePerformIO $ withForeignPtr fctx $ \ctx ->+    unsafeUseByteString sig_bs $ \(sig_ptr, _) -> do+      out_ptr <- mallocBytes 64+      ret <- ecdsaSignatureSerializeCompact ctx out_ptr sig_ptr+      unless (isSuccess ret) $ do+        free out_ptr+        error "Could not obtain compact signature"+      out_bs <- unsafePackByteString (out_ptr, 64)+      return $ CompactSig out_bs  importCompactSig :: Ctx -> CompactSig -> Maybe Sig-importCompactSig (Ctx ctx) (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+importCompactSig (Ctx fctx) (CompactSig compact_sig) =+  unsafePerformIO $ withForeignPtr fctx $ \ctx ->+    unsafeUseByteString compact_sig $ \(compact_ptr, _) -> do+      out_sig <- mallocBytes 64+      ret <- ecdsaSignatureParseCompact ctx out_sig compact_ptr+      if isSuccess ret+        then do+          out_bs <- unsafePackByteString (out_sig, 64)+          return (Just (Sig out_bs))+        else do+          free out_sig+          return Nothing  -- | Import DER-encoded signature. importSig :: Ctx -> ByteString -> Maybe Sig-importSig (Ctx ctx) bs+importSig (Ctx fctx) bs   | BS.null bs = Nothing-  | otherwise = unsafePerformIO $-      unsafeUseByteString bs $ \(in_ptr, in_len) -> do-        out_sig <- mallocBytes 64-        ret <- ecdsaSignatureParseDer ctx out_sig in_ptr in_len-        if isSuccess ret-          then do-            out_bs <- unsafePackByteString (out_sig, 64)-            return (Just (Sig out_bs))-          else do-            free out_sig-            return Nothing+  | otherwise =+      unsafePerformIO $ withForeignPtr fctx $ \ctx ->+        unsafeUseByteString bs $ \(in_ptr, in_len) -> do+          out_sig <- mallocBytes 64+          ret <- ecdsaSignatureParseDer ctx out_sig in_ptr in_len+          if isSuccess ret+            then do+              out_bs <- unsafePackByteString (out_sig, 64)+              return (Just (Sig out_bs))+            else do+              free out_sig+              return Nothing  -- | Encode signature as strict DER. exportSig :: Ctx -> Sig -> ByteString-exportSig (Ctx ctx) (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)+exportSig (Ctx fctx) (Sig in_sig) =+  unsafePerformIO $ withForeignPtr fctx $ \ctx ->+    unsafeUseByteString in_sig $ \(in_ptr, _) ->+      alloca $ \out_len ->+        allocaBytes 72 $ \out_ptr -> do+          poke out_len 72+          ret <- ecdsaSignatureSerializeDer ctx out_ptr out_len in_ptr+          unless (isSuccess ret) $ error "could not serialize signature"+          final_len <- peek out_len+          packByteString (out_ptr, final_len)  -- | Verify message signature. 'True' means that the signature is correct. verifySig :: Ctx -> PubKey -> Sig -> Msg -> Bool-verifySig (Ctx ctx) (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+verifySig (Ctx fctx) (PubKey pub_key) (Sig sig) (Msg m) =+  unsafePerformIO $ withForeignPtr fctx $ \ctx ->+    unsafeUseByteString pub_key $ \(pub_key_ptr, _) ->+      unsafeUseByteString sig $ \(sig_ptr, _) ->+        unsafeUseByteString m $ \(msg_ptr, _) ->+          isSuccess <$> ecdsaVerify ctx sig_ptr msg_ptr pub_key_ptr  signMsg :: Ctx -> SecKey -> Msg -> Sig-signMsg (Ctx ctx) (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)+signMsg (Ctx fctx) (SecKey sec_key) (Msg m) =+  unsafePerformIO $ withForeignPtr fctx $ \ctx ->+    unsafeUseByteString sec_key $ \(sec_key_ptr, _) ->+      unsafeUseByteString m $ \(msg_ptr, _) -> do+        sig_ptr <- mallocBytes 64+        ret <- ecdsaSign ctx sig_ptr msg_ptr sec_key_ptr nullFunPtr nullPtr+        unless (isSuccess ret) $ do+          free sig_ptr+          error "could not sign message"+        Sig <$> unsafePackByteString (sig_ptr, 64)  derivePubKey :: Ctx -> SecKey -> PubKey-derivePubKey (Ctx ctx) (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)+derivePubKey (Ctx fctx) (SecKey sec_key) =+  unsafePerformIO $ withForeignPtr fctx $ \ctx ->+    unsafeUseByteString sec_key $ \(sec_key_ptr, _) -> do+      pub_key_ptr <- mallocBytes 64+      ret <- ecPubKeyCreate ctx pub_key_ptr sec_key_ptr+      unless (isSuccess ret) $ do+        free pub_key_ptr+        error "could not compute public key"+      PubKey <$> unsafePackByteString (pub_key_ptr, 64)  -- | Add tweak to secret key. tweakAddSecKey :: Ctx -> SecKey -> Tweak -> Maybe SecKey-tweakAddSecKey (Ctx ctx) (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+tweakAddSecKey (Ctx fctx) (SecKey sec_key) (Tweak t) =+  unsafePerformIO $ withForeignPtr fctx $ \ctx ->+    unsafeUseByteString new_bs $ \(sec_key_ptr, _) ->+      unsafeUseByteString t $ \(tweak_ptr, _) -> do+        ret <- ecSecKeyTweakAdd ctx sec_key_ptr tweak_ptr+        if isSuccess ret+          then return (Just (SecKey new_bs))+          else return Nothing   where     new_bs = BS.copy sec_key  -- | Multiply secret key by tweak. tweakMulSecKey :: Ctx -> SecKey -> Tweak -> Maybe SecKey-tweakMulSecKey (Ctx ctx) (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+tweakMulSecKey (Ctx fctx) (SecKey sec_key) (Tweak t) =+  unsafePerformIO $ withForeignPtr fctx $ \ctx ->+    unsafeUseByteString new_bs $ \(sec_key_ptr, _) ->+      unsafeUseByteString t $ \(tweak_ptr, _) -> do+        ret <- ecSecKeyTweakMul ctx sec_key_ptr tweak_ptr+        if isSuccess ret+          then return (Just (SecKey new_bs))+          else return Nothing   where     new_bs = BS.copy sec_key  -- | Add tweak to public key. Tweak is multiplied first by G to obtain a point. tweakAddPubKey :: Ctx -> PubKey -> Tweak -> Maybe PubKey-tweakAddPubKey (Ctx ctx) (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+tweakAddPubKey (Ctx fctx) (PubKey pub_key) (Tweak t) =+  unsafePerformIO $ withForeignPtr fctx $ \ctx ->+    unsafeUseByteString new_bs $ \(pub_key_ptr, _) ->+      unsafeUseByteString t $ \(tweak_ptr, _) -> do+        ret <- ecPubKeyTweakAdd ctx pub_key_ptr tweak_ptr+        if isSuccess ret+          then return (Just (PubKey new_bs))+          else return Nothing   where     new_bs = BS.copy pub_key  -- | Multiply public key by tweak. Tweak is multiplied first by G to obtain a -- point. tweakMulPubKey :: Ctx -> PubKey -> Tweak -> Maybe PubKey-tweakMulPubKey (Ctx ctx) (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+tweakMulPubKey (Ctx fctx) (PubKey pub_key) (Tweak t) =+  unsafePerformIO $ withForeignPtr fctx $ \ctx ->+    unsafeUseByteString new_bs $ \(pub_key_ptr, _) ->+      unsafeUseByteString t $ \(tweak_ptr, _) -> do+        ret <- ecPubKeyTweakMul ctx pub_key_ptr tweak_ptr+        if isSuccess ret+          then return (Just (PubKey new_bs))+          else return Nothing   where     new_bs = BS.copy pub_key  -- | Add multiple public keys together. combinePubKeys :: Ctx -> [PubKey] -> Maybe PubKey combinePubKeys _ [] = Nothing-combinePubKeys (Ctx ctx) pubs = unsafePerformIO $-  pointers [] pubs $ \ps ->-    allocaArray (length ps) $ \a -> do-      out <- mallocBytes 64-      pokeArray a ps-      ret <- ecPubKeyCombine ctx out a (fromIntegral $ length ps)-      if isSuccess ret-        then do-          bs <- unsafePackByteString (out, 64)-          return (Just (PubKey bs))-        else do-          free out-          return Nothing+combinePubKeys (Ctx fctx) pubs =+  unsafePerformIO $ withForeignPtr fctx $ \ctx ->+    pointers [] pubs $ \ps ->+      allocaArray (length ps) $ \a -> do+        out <- mallocBytes 64+        pokeArray a ps+        ret <- ecPubKeyCombine ctx out a (fromIntegral $ length ps)+        if isSuccess ret+          then do+            bs <- unsafePackByteString (out, 64)+            return (Just (PubKey bs))+          else do+            free out+            return Nothing   where     pointers ps [] f = f ps     pointers ps (PubKey pub_key : pub_keys) f =@@ -406,12 +422,13 @@         pointers (p : ps) pub_keys f  tweakNegate :: Ctx -> Tweak -> Maybe Tweak-tweakNegate (Ctx ctx) (Tweak t) = unsafePerformIO $-  unsafeUseByteString new $ \(out, _) -> do-    ret <- ecTweakNegate ctx out-    if isSuccess ret-      then return (Just (Tweak new))-      else return Nothing+tweakNegate (Ctx fctx) (Tweak t) =+  unsafePerformIO $ withForeignPtr fctx $ \ctx ->+    unsafeUseByteString new $ \(out, _) -> do+      ret <- ecTweakNegate ctx out+      if isSuccess ret+        then return (Just (Tweak new))+        else return Nothing   where     new = BS.copy t 

@@ -1,4 +1,3 @@-{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE NoFieldSelectors #-}  -- |@@ -12,38 +11,54 @@ -- exposed for hacking and experimentation. module Crypto.Secp256k1.Internal.Context where -import Control.Exception (bracket)+import Control.Exception (bracket, mask_) import Control.Monad (unless)-import Crypto.Secp256k1.Internal.ForeignTypes (CtxFlags, LCtx, Ret, Seed32, isSuccess)+import Crypto.Secp256k1.Internal.ForeignTypes+  ( CtxFlags,+    LCtx,+    Ret,+    Seed32,+    isSuccess,+  ) import Crypto.Secp256k1.Internal.Util (withRandomSeed) import Foreign (FunPtr, Ptr) import Foreign.C (CInt (..), CString, CUInt (..))+import Foreign.ForeignPtr+  ( FinalizerPtr,+    ForeignPtr,+    finalizeForeignPtr,+    newForeignPtr,+    withForeignPtr,+  )+import GHC.Conc (writeTVar) import System.IO.Unsafe (unsafePerformIO) -newtype Ctx = Ctx {get :: Ptr LCtx}+newtype Ctx = Ctx {get :: ForeignPtr LCtx}  randomizeContext :: Ctx -> IO ()-randomizeContext (Ctx ctx) = do+randomizeContext (Ctx fctx) = withForeignPtr fctx $ \ctx -> do   ret <- withRandomSeed $ contextRandomize ctx   unless (isSuccess ret) $ error "Could not randomize context"  createContext :: IO Ctx-createContext = Ctx <$> contextCreate signVerify+createContext = do+  ctx <- mask_ $ do+    pctx <- contextCreate signVerify+    Ctx <$> newForeignPtr contextDestroyFunPtr pctx+  randomizeContext ctx+  return ctx  cloneContext :: Ctx -> IO Ctx-cloneContext = fmap Ctx . contextClone . (.get)+cloneContext (Ctx fctx) =+  withForeignPtr fctx $ \ctx -> mask_ $ do+    ctx' <- contextClone ctx+    Ctx <$> newForeignPtr contextDestroyFunPtr ctx'  destroyContext :: Ctx -> IO ()-destroyContext = contextDestroy . (.get)+destroyContext (Ctx fctx)= finalizeForeignPtr fctx  withContext :: (Ctx -> IO a) -> IO a-withContext = bracket create destroy-  where-    create = do-      ctx <- createContext-      randomizeContext ctx-      return ctx-    destroy = destroyContext+withContext = (createContext >>=)  verify :: CtxFlags verify = 0x0101@@ -65,9 +80,10 @@     IO (Ptr LCtx)  foreign import ccall safe "secp256k1.h secp256k1_context_destroy"-  contextDestroy ::-    Ptr LCtx ->-    IO ()+  contextDestroy :: Ptr LCtx -> IO ()++foreign import ccall safe "secp256k1.h &secp256k1_context_destroy"+  contextDestroyFunPtr :: FunPtr (Ptr LCtx -> IO ())  foreign import ccall safe "secp256k1.h secp256k1_context_set_illegal_callback"   setIllegalCallback ::

@@ -19,7 +19,7 @@ import Data.ByteString.Base16 (decodeBase16) import Foreign import System.Entropy-import Test.HUnit (Assertion, assertBool, assertEqual)+import Test.HUnit (Assertion, assertBool, assertEqual, assertFailure) import Test.Hspec  spec :: Spec