secp256k1-haskell 1.0.0 → 1.0.1

raw patch · 11 files changed

+826/−709 lines, 11 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• README.md +0/−6
• secp256k1-haskell.cabal +6/−3
• src/Crypto/Secp256k1.hs +2/−418
• src/Crypto/Secp256k1/Internal.hs +0/−280
• src/Crypto/Secp256k1/Internal/Base.hs +430/−0
• src/Crypto/Secp256k1/Internal/BaseOps.hs +172/−0
• src/Crypto/Secp256k1/Internal/Context.hs +94/−0
• src/Crypto/Secp256k1/Internal/ForeignTypes.hs +57/−0
• src/Crypto/Secp256k1/Internal/Util.hs +55/−0
• test/Crypto/Secp256k1/InternalSpec.hs +4/−2

@@ -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.0.1] - 2023-09-20++### Changed++- Reworked the structure of the Internal modules to allow having add-on packages for optional libsecp256k1 features.+ ## [1.0.0] - 2023-07-28  ### Changed

@@ -1,6 +0,0 @@-[![Build Status](https://travis-ci.org/haskoin/secp256k1-haskell.svg?branch=master)](https://travis-ci.org/haskoin/secp256k1-haskell)--# Haskell bindings for secp256k1--This project contains Haskell bindings for the-[secp256k1](https://github.com/bitcoin-core/secp256k1) library.

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           secp256k1-haskell-version:        1.0.0+version:        1.0.1 synopsis:       Bindings for secp256k1 description:    Sign and verify signatures using the secp256k1 library. category:       Crypto@@ -19,7 +19,6 @@ build-type:     Simple extra-source-files:     CHANGELOG.md-    README.md  source-repository head   type: git@@ -28,7 +27,11 @@ library   exposed-modules:       Crypto.Secp256k1-      Crypto.Secp256k1.Internal+      Crypto.Secp256k1.Internal.Base+      Crypto.Secp256k1.Internal.BaseOps+      Crypto.Secp256k1.Internal.Context+      Crypto.Secp256k1.Internal.ForeignTypes+      Crypto.Secp256k1.Internal.Util       Paths_secp256k1_haskell   autogen-modules:       Paths_secp256k1_haskell

@@ -1,12 +1,3 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DuplicateRecordFields #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE ImportQualifiedPost #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedRecordDot #-}-{-# LANGUAGE NoFieldSelectors #-}- -- | -- Module      : Crypto.Secp256k1 -- License     : UNLICENSE@@ -68,412 +59,5 @@   ) where -import Control.DeepSeq (NFData)-import Control.Exception (bracket)-import Control.Monad (replicateM, unless, (<=<))-import Crypto.Secp256k1.Internal-import Data.Base16.Types (assertBase16, extractBase16)-import Data.ByteString (ByteString)-import Data.ByteString qualified as BS-import Data.ByteString.Base16 (decodeBase16, encodeBase16, isBase16)-import Data.Hashable (Hashable (..))-import Data.Maybe (fromJust, fromMaybe, isJust)-import Data.String (IsString (..))-import Data.String.Conversions (ConvertibleStrings, cs)-import Foreign-  ( Bits (bitSize),-    Ptr,-    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,-  )--newtype Ctx = Ctx {get :: Ptr LCtx}--newtype PubKey = PubKey {get :: ByteString}-  deriving (Eq, Generic, Hashable, NFData)--newtype Msg = Msg {get :: ByteString}-  deriving (Eq, Generic, Hashable, NFData)--newtype Sig = Sig {get :: ByteString}-  deriving (Eq, Generic, Hashable, NFData)--newtype SecKey = SecKey {get :: ByteString}-  deriving (Eq, Generic, Hashable, NFData)--newtype Tweak = Tweak {get :: ByteString}-  deriving (Eq, Generic, Hashable, NFData)--newtype CompactSig = CompactSig {get :: ByteString}-  deriving (Eq, Generic, Hashable, NFData)--decodeHex :: (ConvertibleStrings a ByteString) => a -> Maybe ByteString-decodeHex str =-  if isBase16 $ cs str-    then Just . decodeBase16 $ assertBase16 $ cs str-    else Nothing--instance Read PubKey where-  readPrec = parens $ do-    String str <- lexP-    maybe pfail return $ pubKey =<< decodeHex str--instance IsString PubKey where-  fromString = fromMaybe e . (pubKey <=< decodeHex)-    where-      e = error "Could not decode public key from hex string"--instance Show PubKey where-  showsPrec _ = shows . extractBase16 . encodeBase16 . (.get)--instance Read Msg where-  readPrec = parens $ do-    String str <- lexP-    maybe pfail return $ msg =<< decodeHex str--instance IsString Msg where-  fromString = fromMaybe e . (msg <=< decodeHex)-    where-      e = error "Could not decode message from hex string"--instance Show Sig where-  showsPrec _ = shows . extractBase16 . encodeBase16 . (.get)--instance Read Sig where-  readPrec = parens $ do-    String str <- lexP-    maybe pfail return $ sig =<< decodeHex str--instance IsString Sig where-  fromString = fromMaybe e . (sig <=< decodeHex)-    where-      e = error "Could not decode signature from hex string"--instance Show Msg where-  showsPrec _ = shows . extractBase16 . encodeBase16 . (.get)--instance Read SecKey where-  readPrec = parens $ do-    String str <- lexP-    maybe pfail return $ secKey =<< decodeHex str--instance IsString SecKey where-  fromString = fromMaybe e . (secKey <=< decodeHex)-    where-      e = error "Colud not decode secret key from hex string"--instance Show SecKey where-  showsPrec _ = shows . extractBase16 . encodeBase16 . (.get)--instance Read Tweak where-  readPrec = parens $ do-    String str <- lexP-    maybe pfail return $ tweak =<< decodeHex str--instance IsString Tweak where-  fromString = fromMaybe e . (tweak <=< decodeHex)-    where-      e = error "Could not decode tweak from hex string"--instance Show Tweak where-  showsPrec _ = shows . extractBase16 . encodeBase16 . (.get)--randomizeContext :: Ctx -> IO ()-randomizeContext (Ctx ctx) = do-  ret <- withRandomSeed $ contextRandomize ctx-  unless (isSuccess ret) $ error "Could not randomize context"--createContext :: IO Ctx-createContext = Ctx <$> contextCreate signVerify--cloneContext :: Ctx -> IO Ctx-cloneContext = fmap Ctx . contextClone . (.get)--destroyContext :: Ctx -> IO ()-destroyContext = contextDestroy . (.get)--withContext :: (Ctx -> IO a) -> IO a-withContext = bracket create destroy-  where-    create = do-      ctx <- createContext-      randomizeContext ctx-      return ctx-    destroy = destroyContext--sig :: ByteString -> Maybe Sig-sig bs-  | BS.length bs == 64 = Just (Sig bs)-  | otherwise = Nothing--pubKey :: ByteString -> Maybe PubKey-pubKey bs-  | BS.length bs == 64 = Just (PubKey bs)-  | otherwise = Nothing---- | Import 32-byte 'ByteString' as 'Msg'.-msg :: ByteString -> Maybe Msg-msg bs-  | 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 = Just (SecKey bs)-  | otherwise = Nothing--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 :: 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---- | 32-Byte 'ByteString' as 'Tweak'.-tweak :: ByteString -> Maybe Tweak-tweak bs-  | BS.length bs == 32 = Just (Tweak bs)-  | otherwise = Nothing---- | Import DER-encoded public key.-importPubKey :: Ctx -> ByteString -> Maybe PubKey-importPubKey (Ctx ctx) 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---- | 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)-  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--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---- | Import DER-encoded signature.-importSig :: Ctx -> ByteString -> Maybe Sig-importSig (Ctx ctx) 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---- | 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)---- | 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--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)--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)---- | 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-  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-  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-  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-  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-  where-    pointers ps [] f = f ps-    pointers ps (PubKey pub_key : pub_keys) f =-      unsafeUseByteString pub_key $ \(p, _) ->-        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-  where-    new = BS.copy t--instance Arbitrary Msg where-  arbitrary = gen_msg-    where-      valid_bs = bs_gen `suchThat` isJust-      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-      gen_key = fromJust <$> valid_bs+import Crypto.Secp256k1.Internal.Base+import Crypto.Secp256k1.Internal.Context

@@ -1,280 +0,0 @@-{-# LANGUAGE ImportQualifiedPost #-}---- |--- Module      : Crypto.Secp256k1.Internal--- License     : UNLICENSE--- Maintainer  : Jean-Pierre Rupp <jprupp@protonmail.ch>--- Stability   : experimental--- Portability : POSIX------ The API for this module may change at any time. This is an internal module only--- exposed for hacking and experimentation.-module Crypto.Secp256k1.Internal where--import Data.ByteString (ByteString)-import Data.ByteString qualified as BS-import Data.ByteString.Unsafe qualified as BU-import Foreign (FunPtr, Ptr, castPtr)-import Foreign.C-  ( CInt (..),-    CSize (..),-    CString,-    CUChar,-    CUInt (..),-  )-import GHC.Generics (Selector (selDecidedStrictness))-import System.Entropy (getEntropy)--data LCtx--data PubKey64--data Msg32--data Sig64--data Seed32--data Compact64--data SecKey32--data Tweak32--type CtxFlags = CUInt--type SerFlags = CUInt--type Ret = CInt--type NonceFun a =-  Ptr CUChar ->-  Ptr CUChar ->-  Ptr CUChar ->-  Ptr CUChar ->-  Ptr a ->-  CInt ->-  IO CInt--verify :: CtxFlags-verify = 0x0101--sign :: CtxFlags-sign = 0x0201--signVerify :: CtxFlags-signVerify = 0x0301--compressed :: SerFlags-compressed = 0x0102--uncompressed :: SerFlags-uncompressed = 0x0002--isSuccess :: Ret -> Bool-isSuccess 0 = False-isSuccess 1 = True-isSuccess n = error $ "isSuccess expected 0 or 1 but got " ++ show n--unsafeUseByteString :: ByteString -> ((Ptr a, CSize) -> IO b) -> IO b-unsafeUseByteString bs f =-  BU.unsafeUseAsCStringLen bs $ \(b, l) ->-    f (castPtr b, fromIntegral l)--useByteString :: ByteString -> ((Ptr a, CSize) -> IO b) -> IO b-useByteString bs f =-  BS.useAsCStringLen bs $ \(b, l) ->-    f (castPtr b, fromIntegral l)--unsafePackByteString :: (Ptr a, CSize) -> IO ByteString-unsafePackByteString (b, l) =-  BU.unsafePackMallocCStringLen (castPtr b, fromIntegral l)--packByteString :: (Ptr a, CSize) -> IO ByteString-packByteString (b, l) =-  BS.packCStringLen (castPtr b, fromIntegral l)--withRandomSeed :: (Ptr Seed32 -> IO a) -> IO a-withRandomSeed go = do-  bs <- getEntropy 32-  useByteString bs $ go . fst--foreign import ccall safe "secp256k1.h secp256k1_context_create"-  contextCreate ::-    CtxFlags ->-    IO (Ptr LCtx)--foreign import ccall safe "secp256k1.h secp256k1_context_clone"-  contextClone ::-    Ptr LCtx ->-    IO (Ptr LCtx)--foreign import ccall safe "secp256k1.h secp256k1_context_destroy"-  contextDestroy ::-    Ptr LCtx ->-    IO ()--foreign import ccall safe "secp256k1.h secp256k1_context_set_illegal_callback"-  setIllegalCallback ::-    Ptr LCtx ->-    -- | message, data-    FunPtr (CString -> Ptr a -> IO ()) ->-    -- | data-    Ptr a ->-    IO ()--foreign import ccall safe "secp256k1.h secp256k1_context_set_error_callback"-  setErrorCallback ::-    Ptr LCtx ->-    -- | message, data-    FunPtr (CString -> Ptr a -> IO ()) ->-    -- | data-    Ptr a ->-    IO ()--foreign import ccall safe "secp256k1.h secp256k1_ec_pubkey_parse"-  ecPubKeyParse ::-    Ptr LCtx ->-    Ptr PubKey64 ->-    -- | encoded public key array-    Ptr CUChar ->-    -- | size of encoded public key array-    CSize ->-    IO Ret--foreign import ccall safe "secp256k1.h secp256k1_ec_pubkey_serialize"-  ecPubKeySerialize ::-    Ptr LCtx ->-    -- | array for encoded public key, must be large enough-    Ptr CUChar ->-    -- | size of encoded public key, will be updated-    Ptr CSize ->-    Ptr PubKey64 ->-    SerFlags ->-    IO Ret--foreign import ccall safe "secp256k1.h secp256k1_ecdsa_signature_parse_compact"-  ecdsaSignatureParseCompact ::-    Ptr LCtx ->-    Ptr Sig64 ->-    Ptr Compact64 ->-    IO Ret--foreign import ccall safe "secp256k1.h secp256k1_ecdsa_signature_parse_der"-  ecdsaSignatureParseDer ::-    Ptr LCtx ->-    Ptr Sig64 ->-    -- | encoded DER signature-    Ptr CUChar ->-    -- | size of encoded signature-    CSize ->-    IO Ret--foreign import ccall safe "secp256k1.h secp256k1_ecdsa_signature_serialize_der"-  ecdsaSignatureSerializeDer ::-    Ptr LCtx ->-    -- | array for encoded signature, must be large enough-    Ptr CUChar ->-    -- | size of encoded signature, will be updated-    Ptr CSize ->-    Ptr Sig64 ->-    IO Ret--foreign import ccall safe "secp256k1.h secp256k1_ecdsa_signature_serialize_compact"-  ecdsaSignatureSerializeCompact ::-    Ptr LCtx ->-    Ptr Compact64 ->-    Ptr Sig64 ->-    IO Ret--foreign import ccall safe "secp256k1.h secp256k1_ecdsa_verify"-  ecdsaVerify ::-    Ptr LCtx ->-    Ptr Sig64 ->-    Ptr Msg32 ->-    Ptr PubKey64 ->-    IO Ret--foreign import ccall safe "secp256k1.h secp256k1_ecdsa_signature_normalize"-  ecdsaSignatureNormalize ::-    Ptr LCtx ->-    -- | output-    Ptr Sig64 ->-    -- | input-    Ptr Sig64 ->-    IO Ret--foreign import ccall safe "secp256k1.h secp256k1_ecdsa_sign"-  ecdsaSign ::-    Ptr LCtx ->-    Ptr Sig64 ->-    Ptr Msg32 ->-    Ptr SecKey32 ->-    FunPtr (NonceFun a) ->-    -- | nonce data-    Ptr a ->-    IO Ret--foreign import ccall safe "secp256k1.h secp256k1_ec_seckey_verify"-  ecSecKeyVerify ::-    Ptr LCtx ->-    Ptr SecKey32 ->-    IO Ret--foreign import ccall safe "secp256k1.h secp256k1_ec_pubkey_create"-  ecPubKeyCreate ::-    Ptr LCtx ->-    Ptr PubKey64 ->-    Ptr SecKey32 ->-    IO Ret--foreign import ccall safe "secp256k1.h secp256k1_ec_privkey_tweak_add"-  ecSecKeyTweakAdd ::-    Ptr LCtx ->-    Ptr SecKey32 ->-    Ptr Tweak32 ->-    IO Ret--foreign import ccall safe "secp256k1.h secp256k1_ec_privkey_negate"-  ecTweakNegate ::-    Ptr LCtx ->-    Ptr Tweak32 ->-    IO Ret--foreign import ccall unsafe "secp256k1.h secp256k1_ec_pubkey_tweak_add"-  ecPubKeyTweakAdd ::-    Ptr LCtx ->-    Ptr PubKey64 ->-    Ptr Tweak32 ->-    IO Ret--foreign import ccall safe "secp256k1.h secp256k1_ec_privkey_tweak_mul"-  ecSecKeyTweakMul ::-    Ptr LCtx ->-    Ptr SecKey32 ->-    Ptr Tweak32 ->-    IO Ret--foreign import ccall safe "secp256k1.h secp256k1_ec_pubkey_tweak_mul"-  ecPubKeyTweakMul ::-    Ptr LCtx ->-    Ptr PubKey64 ->-    Ptr Tweak32 ->-    IO Ret--foreign import ccall safe "secp256k1.h secp256k1_context_randomize"-  contextRandomize ::-    Ptr LCtx ->-    Ptr Seed32 ->-    IO Ret--foreign import ccall safe "secp256k1.h secp256k1_ec_pubkey_combine"-  ecPubKeyCombine ::-    Ptr LCtx ->-    -- | pointer to public key storage-    Ptr PubKey64 ->-    -- | pointer to array of public keys-    Ptr (Ptr PubKey64) ->-    -- | number of public keys-    CInt ->-    IO Ret

@@ -0,0 +1,430 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedRecordDot #-}+{-# LANGUAGE NoFieldSelectors #-}++-- |+-- Module      : Crypto.Secp256k1+-- License     : UNLICENSE+-- Maintainer  : Jean-Pierre Rupp <jprupp@protonmail.ch>+-- Stability   : experimental+-- Portability : POSIX+--+-- Crytpographic functions from Bitcoin’s secp256k1 library.+--+-- The API for this module may change at any time. This is an internal module only+-- exposed for hacking and experimentation.+module Crypto.Secp256k1.Internal.Base where++import Control.DeepSeq (NFData)+import Control.Exception (bracket)+import Control.Monad (replicateM, unless, (<=<))+import Crypto.Secp256k1.Internal.BaseOps+  ( ecPubKeyCombine,+    ecPubKeyCreate,+    ecPubKeyParse,+    ecPubKeySerialize,+    ecPubKeyTweakAdd,+    ecPubKeyTweakMul,+    ecSecKeyTweakAdd,+    ecSecKeyTweakMul,+    ecTweakNegate,+    ecdsaSign,+    ecdsaSignatureNormalize,+    ecdsaSignatureParseCompact,+    ecdsaSignatureParseDer,+    ecdsaSignatureSerializeCompact,+    ecdsaSignatureSerializeDer,+    ecdsaVerify,+  )+import Crypto.Secp256k1.Internal.Context (Ctx (..))+import Crypto.Secp256k1.Internal.ForeignTypes+  ( LCtx,+    compressed,+    isSuccess,+    uncompressed,+  )+import Crypto.Secp256k1.Internal.Util+  ( decodeHex,+    packByteString,+    showsHex,+    unsafePackByteString,+    unsafeUseByteString,+  )+import Data.ByteString (ByteString)+import Data.ByteString qualified as BS+import Data.Hashable (Hashable (..))+import Data.Maybe (fromJust, fromMaybe, isJust)+import Data.String (IsString (..))+import Foreign+  ( Bits (bitSize),+    Ptr,+    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,+  )++newtype PubKey = PubKey {get :: ByteString}+  deriving (Eq, Generic, Hashable, NFData)++newtype Msg = Msg {get :: ByteString}+  deriving (Eq, Generic, Hashable, NFData)++newtype Sig = Sig {get :: ByteString}+  deriving (Eq, Generic, Hashable, NFData)++newtype SecKey = SecKey {get :: ByteString}+  deriving (Eq, Generic, Hashable, NFData)++newtype Tweak = Tweak {get :: ByteString}+  deriving (Eq, Generic, Hashable, NFData)++newtype CompactSig = CompactSig {get :: ByteString}+  deriving (Eq, Generic, Hashable, NFData)++instance Read PubKey where+  readPrec = parens $ do+    String str <- lexP+    maybe pfail return $ pubKey =<< decodeHex str++instance IsString PubKey where+  fromString = fromMaybe e . (pubKey <=< decodeHex)+    where+      e = error "Could not decode public key from hex string"++instance Show PubKey where+  showsPrec _ = showsHex . (.get)++instance Read Msg where+  readPrec = parens $ do+    String str <- lexP+    maybe pfail return $ msg =<< decodeHex str++instance IsString Msg where+  fromString = fromMaybe e . (msg <=< decodeHex)+    where+      e = error "Could not decode message from hex string"++instance Show Msg where+  showsPrec _ = showsHex . (.get)++instance Read Sig where+  readPrec = parens $ do+    String str <- lexP+    maybe pfail return $ sig =<< decodeHex str++instance IsString Sig where+  fromString = fromMaybe e . (sig <=< decodeHex)+    where+      e = error "Could not decode signature from hex string"++instance Show Sig where+  showsPrec _ = showsHex . (.get)++instance Read SecKey where+  readPrec = parens $ do+    String str <- lexP+    maybe pfail return $ secKey =<< decodeHex str++instance IsString SecKey where+  fromString = fromMaybe e . (secKey <=< decodeHex)+    where+      e = error "Colud not decode secret key from hex string"++instance Show SecKey where+  showsPrec _ = showsHex . (.get)++instance Read Tweak where+  readPrec = parens $ do+    String str <- lexP+    maybe pfail return $ tweak =<< decodeHex str++instance IsString Tweak where+  fromString = fromMaybe e . (tweak <=< decodeHex)+    where+      e = error "Could not decode tweak from hex string"++instance Show Tweak where+  showsPrec _ = showsHex . (.get)++-- | Import 64-byte 'ByteString' as 'Sig'.+sig :: ByteString -> Maybe Sig+sig bs+  | BS.length bs == 64 = Just (Sig bs)+  | otherwise = Nothing++-- | Import 64-byte 'ByteString' as 'PubKey'.+pubKey :: ByteString -> Maybe PubKey+pubKey bs+  | BS.length bs == 64 = Just (PubKey bs)+  | otherwise = Nothing++-- | Import 32-byte 'ByteString' as 'Msg'.+msg :: ByteString -> Maybe Msg+msg bs+  | 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 = Just (SecKey bs)+  | otherwise = Nothing++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 :: 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++-- | 32-Byte 'ByteString' as 'Tweak'.+tweak :: ByteString -> Maybe Tweak+tweak bs+  | BS.length bs == 32 = Just (Tweak bs)+  | otherwise = Nothing++-- | Import DER-encoded public key.+importPubKey :: Ctx -> ByteString -> Maybe PubKey+importPubKey (Ctx ctx) 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++-- | 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)+  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++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++-- | Import DER-encoded signature.+importSig :: Ctx -> ByteString -> Maybe Sig+importSig (Ctx ctx) 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++-- | 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)++-- | 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++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)++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)++-- | 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+  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+  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+  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+  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+  where+    pointers ps [] f = f ps+    pointers ps (PubKey pub_key : pub_keys) f =+      unsafeUseByteString pub_key $ \(p, _) ->+        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+  where+    new = BS.copy t++instance Arbitrary Msg where+  arbitrary = gen_msg+    where+      valid_bs = bs_gen `suchThat` isJust+      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+      gen_key = fromJust <$> valid_bs

@@ -0,0 +1,172 @@+-- |+-- Module      : Crypto.Secp256k1.Internal.BaseOps+-- License     : UNLICENSE+-- Maintainer  : Jean-Pierre Rupp <jprupp@protonmail.ch>+-- Stability   : experimental+-- Portability : POSIX+--+-- The API for this module may change at any time. This is an internal module only+-- exposed for hacking and experimentation.+module Crypto.Secp256k1.Internal.BaseOps where++import Crypto.Secp256k1.Internal.ForeignTypes+  ( Compact64,+    LCtx,+    Msg32,+    NonceFun,+    PubKey64,+    Ret,+    SecKey32,+    Seed32,+    SerFlags,+    Sig64,+    Tweak32,+  )+import Foreign (FunPtr, Ptr)+import Foreign.C+  ( CInt (..),+    CSize (..),+    CUChar,+    CUInt (..),+  )++foreign import ccall safe "secp256k1.h secp256k1_ec_pubkey_parse"+  ecPubKeyParse ::+    Ptr LCtx ->+    Ptr PubKey64 ->+    -- | encoded public key array+    Ptr CUChar ->+    -- | size of encoded public key array+    CSize ->+    IO Ret++foreign import ccall safe "secp256k1.h secp256k1_ec_pubkey_serialize"+  ecPubKeySerialize ::+    Ptr LCtx ->+    -- | array for encoded public key, must be large enough+    Ptr CUChar ->+    -- | size of encoded public key, will be updated+    Ptr CSize ->+    Ptr PubKey64 ->+    SerFlags ->+    IO Ret++foreign import ccall safe "secp256k1.h secp256k1_ecdsa_signature_parse_compact"+  ecdsaSignatureParseCompact ::+    Ptr LCtx ->+    Ptr Sig64 ->+    Ptr Compact64 ->+    IO Ret++foreign import ccall safe "secp256k1.h secp256k1_ecdsa_signature_parse_der"+  ecdsaSignatureParseDer ::+    Ptr LCtx ->+    Ptr Sig64 ->+    -- | encoded DER signature+    Ptr CUChar ->+    -- | size of encoded signature+    CSize ->+    IO Ret++foreign import ccall safe "secp256k1.h secp256k1_ecdsa_signature_serialize_der"+  ecdsaSignatureSerializeDer ::+    Ptr LCtx ->+    -- | array for encoded signature, must be large enough+    Ptr CUChar ->+    -- | size of encoded signature, will be updated+    Ptr CSize ->+    Ptr Sig64 ->+    IO Ret++foreign import ccall safe "secp256k1.h secp256k1_ecdsa_signature_serialize_compact"+  ecdsaSignatureSerializeCompact ::+    Ptr LCtx ->+    Ptr Compact64 ->+    Ptr Sig64 ->+    IO Ret++foreign import ccall safe "secp256k1.h secp256k1_ecdsa_verify"+  ecdsaVerify ::+    Ptr LCtx ->+    Ptr Sig64 ->+    Ptr Msg32 ->+    Ptr PubKey64 ->+    IO Ret++foreign import ccall safe "secp256k1.h secp256k1_ecdsa_signature_normalize"+  ecdsaSignatureNormalize ::+    Ptr LCtx ->+    -- | output+    Ptr Sig64 ->+    -- | input+    Ptr Sig64 ->+    IO Ret++foreign import ccall safe "secp256k1.h secp256k1_ecdsa_sign"+  ecdsaSign ::+    Ptr LCtx ->+    Ptr Sig64 ->+    Ptr Msg32 ->+    Ptr SecKey32 ->+    FunPtr (NonceFun a) ->+    -- | nonce data+    Ptr a ->+    IO Ret++foreign import ccall safe "secp256k1.h secp256k1_ec_seckey_verify"+  ecSecKeyVerify ::+    Ptr LCtx ->+    Ptr SecKey32 ->+    IO Ret++foreign import ccall safe "secp256k1.h secp256k1_ec_pubkey_create"+  ecPubKeyCreate ::+    Ptr LCtx ->+    Ptr PubKey64 ->+    Ptr SecKey32 ->+    IO Ret++foreign import ccall safe "secp256k1.h secp256k1_ec_privkey_tweak_add"+  ecSecKeyTweakAdd ::+    Ptr LCtx ->+    Ptr SecKey32 ->+    Ptr Tweak32 ->+    IO Ret++foreign import ccall safe "secp256k1.h secp256k1_ec_privkey_negate"+  ecTweakNegate ::+    Ptr LCtx ->+    Ptr Tweak32 ->+    IO Ret++foreign import ccall unsafe "secp256k1.h secp256k1_ec_pubkey_tweak_add"+  ecPubKeyTweakAdd ::+    Ptr LCtx ->+    Ptr PubKey64 ->+    Ptr Tweak32 ->+    IO Ret++foreign import ccall safe "secp256k1.h secp256k1_ec_privkey_tweak_mul"+  ecSecKeyTweakMul ::+    Ptr LCtx ->+    Ptr SecKey32 ->+    Ptr Tweak32 ->+    IO Ret++foreign import ccall safe "secp256k1.h secp256k1_ec_pubkey_tweak_mul"+  ecPubKeyTweakMul ::+    Ptr LCtx ->+    Ptr PubKey64 ->+    Ptr Tweak32 ->+    IO Ret++foreign import ccall safe "secp256k1.h secp256k1_ec_pubkey_combine"+  ecPubKeyCombine ::+    Ptr LCtx ->+    -- | pointer to public key storage+    Ptr PubKey64 ->+    -- | pointer to array of public keys+    Ptr (Ptr PubKey64) ->+    -- | number of public keys+    CInt ->+    IO Ret

@@ -0,0 +1,94 @@+{-# LANGUAGE OverloadedRecordDot #-}+{-# LANGUAGE NoFieldSelectors #-}++-- |+-- Module      : Crypto.Secp256k1.Internal.Context+-- License     : UNLICENSE+-- Maintainer  : Jean-Pierre Rupp <jprupp@protonmail.ch>+-- Stability   : experimental+-- Portability : POSIX+--+-- The API for this module may change at any time. This is an internal module only+-- exposed for hacking and experimentation.+module Crypto.Secp256k1.Internal.Context where++import Control.Exception (bracket)+import Control.Monad (unless)+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 System.IO.Unsafe (unsafePerformIO)++newtype Ctx = Ctx {get :: Ptr LCtx}++randomizeContext :: Ctx -> IO ()+randomizeContext (Ctx ctx) = do+  ret <- withRandomSeed $ contextRandomize ctx+  unless (isSuccess ret) $ error "Could not randomize context"++createContext :: IO Ctx+createContext = Ctx <$> contextCreate signVerify++cloneContext :: Ctx -> IO Ctx+cloneContext = fmap Ctx . contextClone . (.get)++destroyContext :: Ctx -> IO ()+destroyContext = contextDestroy . (.get)++withContext :: (Ctx -> IO a) -> IO a+withContext = bracket create destroy+  where+    create = do+      ctx <- createContext+      randomizeContext ctx+      return ctx+    destroy = destroyContext++verify :: CtxFlags+verify = 0x0101++sign :: CtxFlags+sign = 0x0201++signVerify :: CtxFlags+signVerify = 0x0301++foreign import ccall safe "secp256k1.h secp256k1_context_create"+  contextCreate ::+    CtxFlags ->+    IO (Ptr LCtx)++foreign import ccall safe "secp256k1.h secp256k1_context_clone"+  contextClone ::+    Ptr LCtx ->+    IO (Ptr LCtx)++foreign import ccall safe "secp256k1.h secp256k1_context_destroy"+  contextDestroy ::+    Ptr LCtx ->+    IO ()++foreign import ccall safe "secp256k1.h secp256k1_context_set_illegal_callback"+  setIllegalCallback ::+    Ptr LCtx ->+    -- | message, data+    FunPtr (CString -> Ptr a -> IO ()) ->+    -- | data+    Ptr a ->+    IO ()++foreign import ccall safe "secp256k1.h secp256k1_context_set_error_callback"+  setErrorCallback ::+    Ptr LCtx ->+    -- | message, data+    FunPtr (CString -> Ptr a -> IO ()) ->+    -- | data+    Ptr a ->+    IO ()++foreign import ccall safe "secp256k1.h secp256k1_context_randomize"+  contextRandomize ::+    Ptr LCtx ->+    Ptr Seed32 ->+    IO Ret

@@ -0,0 +1,57 @@+-- |+-- Module      : Crypto.Secp256k1.Internal.ForeignTypes+-- License     : UNLICENSE+-- Maintainer  : Jean-Pierre Rupp <jprupp@protonmail.ch>+-- Stability   : experimental+-- Portability : POSIX+--+-- The API for this module may change at any time. This is an internal module only+-- exposed for hacking and experimentation.+module Crypto.Secp256k1.Internal.ForeignTypes where++import Foreign (Ptr)+import Foreign.C (CInt (..), CUChar, CUInt (..))++data LCtx++data PubKey64++data Msg32++data Sig64++data Seed32++data Compact64++data SecKey32++data Tweak32++data RecSig65++type CtxFlags = CUInt++type SerFlags = CUInt++type Ret = CInt++type NonceFun a =+  Ptr CUChar ->+  Ptr CUChar ->+  Ptr CUChar ->+  Ptr CUChar ->+  Ptr a ->+  CInt ->+  IO CInt++compressed :: SerFlags+compressed = 0x0102++uncompressed :: SerFlags+uncompressed = 0x0002++isSuccess :: Ret -> Bool+isSuccess 0 = False+isSuccess 1 = True+isSuccess n = error $ "isSuccess expected 0 or 1 but got " ++ show n

@@ -0,0 +1,55 @@+{-# LANGUAGE FlexibleContexts #-}++-- |+-- Module      : Crypto.Secp256k1.Internal.Util+-- License     : UNLICENSE+-- Maintainer  : Jean-Pierre Rupp <jprupp@protonmail.ch>+-- Stability   : experimental+-- Portability : POSIX+--+-- The API for this module may change at any time. This is an internal module only+-- exposed for hacking and experimentation.+module Crypto.Secp256k1.Internal.Util where++import Crypto.Secp256k1.Internal.ForeignTypes (Seed32)+import Data.Base16.Types (assertBase16, extractBase16)+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import Data.ByteString.Base16 (decodeBase16, encodeBase16, isBase16)+import qualified Data.ByteString.Unsafe as BU+import Data.String.Conversions (ConvertibleStrings, cs)+import Foreign (Ptr, castPtr)+import Foreign.C (CSize (..))+import System.Entropy (getEntropy)++decodeHex :: (ConvertibleStrings a ByteString) => a -> Maybe ByteString+decodeHex str =+  if isBase16 $ cs str+    then Just . decodeBase16 $ assertBase16 $ cs str+    else Nothing++showsHex :: ByteString -> ShowS+showsHex = shows . extractBase16 . encodeBase16++unsafeUseByteString :: ByteString -> ((Ptr a, CSize) -> IO b) -> IO b+unsafeUseByteString bs f =+  BU.unsafeUseAsCStringLen bs $ \(b, l) ->+    f (castPtr b, fromIntegral l)++useByteString :: ByteString -> ((Ptr a, CSize) -> IO b) -> IO b+useByteString bs f =+  BS.useAsCStringLen bs $ \(b, l) ->+    f (castPtr b, fromIntegral l)++unsafePackByteString :: (Ptr a, CSize) -> IO ByteString+unsafePackByteString (b, l) =+  BU.unsafePackMallocCStringLen (castPtr b, fromIntegral l)++packByteString :: (Ptr a, CSize) -> IO ByteString+packByteString (b, l) =+  BS.packCStringLen (castPtr b, fromIntegral l)++withRandomSeed :: (Ptr Seed32 -> IO a) -> IO a+withRandomSeed go = do+  bs <- getEntropy 32+  useByteString bs $ go . fst

@@ -5,7 +5,10 @@ import Control.Exception import Control.Monad import Control.Monad.Trans-import Crypto.Secp256k1.Internal+import Crypto.Secp256k1.Internal.BaseOps+import Crypto.Secp256k1.Internal.Context+import Crypto.Secp256k1.Internal.ForeignTypes+import Crypto.Secp256k1.Internal.Util import Data.Base16.Types (assertBase16) import Data.ByteString   ( ByteString,@@ -14,7 +17,6 @@     useAsCStringLen,   ) import Data.ByteString.Base16 (decodeBase16)-import Data.Either (fromRight) import Foreign import System.Entropy import Test.HUnit (Assertion, assertBool, assertEqual)