diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/README.md b/README.md deleted file mode 100644 --- a/README.md +++ /dev/null @@ -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. diff --git a/secp256k1-haskell.cabal b/secp256k1-haskell.cabal --- a/secp256k1-haskell.cabal +++ b/secp256k1-haskell.cabal @@ -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 diff --git a/src/Crypto/Secp256k1.hs b/src/Crypto/Secp256k1.hs --- a/src/Crypto/Secp256k1.hs +++ b/src/Crypto/Secp256k1.hs @@ -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 diff --git a/src/Crypto/Secp256k1/Internal.hs b/src/Crypto/Secp256k1/Internal.hs deleted file mode 100644 --- a/src/Crypto/Secp256k1/Internal.hs +++ /dev/null @@ -1,280 +0,0 @@ -{-# LANGUAGE ImportQualifiedPost #-} - --- | --- Module : Crypto.Secp256k1.Internal --- License : UNLICENSE --- Maintainer : Jean-Pierre Rupp --- 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 diff --git a/src/Crypto/Secp256k1/Internal/Base.hs b/src/Crypto/Secp256k1/Internal/Base.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Secp256k1/Internal/Base.hs @@ -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 +-- 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 diff --git a/src/Crypto/Secp256k1/Internal/BaseOps.hs b/src/Crypto/Secp256k1/Internal/BaseOps.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Secp256k1/Internal/BaseOps.hs @@ -0,0 +1,172 @@ +-- | +-- Module : Crypto.Secp256k1.Internal.BaseOps +-- License : UNLICENSE +-- Maintainer : Jean-Pierre Rupp +-- 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 diff --git a/src/Crypto/Secp256k1/Internal/Context.hs b/src/Crypto/Secp256k1/Internal/Context.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Secp256k1/Internal/Context.hs @@ -0,0 +1,94 @@ +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE NoFieldSelectors #-} + +-- | +-- Module : Crypto.Secp256k1.Internal.Context +-- License : UNLICENSE +-- Maintainer : Jean-Pierre Rupp +-- 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 diff --git a/src/Crypto/Secp256k1/Internal/ForeignTypes.hs b/src/Crypto/Secp256k1/Internal/ForeignTypes.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Secp256k1/Internal/ForeignTypes.hs @@ -0,0 +1,57 @@ +-- | +-- Module : Crypto.Secp256k1.Internal.ForeignTypes +-- License : UNLICENSE +-- Maintainer : Jean-Pierre Rupp +-- 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 diff --git a/src/Crypto/Secp256k1/Internal/Util.hs b/src/Crypto/Secp256k1/Internal/Util.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Secp256k1/Internal/Util.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE FlexibleContexts #-} + +-- | +-- Module : Crypto.Secp256k1.Internal.Util +-- License : UNLICENSE +-- Maintainer : Jean-Pierre Rupp +-- 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 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,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)