diff --git a/libsecp256k1.cabal b/libsecp256k1.cabal --- a/libsecp256k1.cabal +++ b/libsecp256k1.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: libsecp256k1 -version: 0.0.1 +version: 0.0.2 synopsis: Bindings for secp256k1 description: Sign and verify signatures using the secp256k1 library. category: Crypto @@ -28,6 +28,7 @@ library exposed-modules: Crypto.Secp256k1 + Crypto.Secp256k1.Internal Crypto.Secp256k1.Prim Paths_libsecp256k1 autogen-modules: @@ -37,16 +38,11 @@ pkgconfig-depends: libsecp256k1 build-depends: - QuickCheck >=2.9.2 && <2.15 - , base >=4.9 && <5 - , base16 >=0.3.0.1 + base >=4.9 && <5 , bytestring >=0.10.8 && <0.12 - , cereal >=0.5.4 && <0.6 - , deepseq >=1.4.2 && <1.5 - , entropy >=0.3.8 && <0.5 - , hashable >=1.2.6 && <1.5 - , string-conversions ==0.4.* - , unliftio-core >=0.1.0 && <0.3 + , cryptonite + , memory + , transformers default-language: Haskell2010 test-suite spec @@ -61,19 +57,14 @@ ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: HUnit - , QuickCheck >=2.9.2 && <2.15 , base >=4.9 && <5 - , base16 >=0.3.0.1 , bytestring >=0.10.8 && <0.12 - , cereal >=0.5.4 && <0.6 - , deepseq >=1.4.2 && <1.5 - , entropy >=0.3.8 && <0.5 - , hashable >=1.2.6 && <1.5 + , cryptonite , hspec + , memory , monad-par , mtl , secp256k1-haskell - , string-conversions ==0.4.* - , unliftio-core >=0.1.0 && <0.3 + , transformers default-language: Haskell2010 build-tool-depends: hspec-discover:hspec-discover diff --git a/src/Crypto/Secp256k1.hs b/src/Crypto/Secp256k1.hs --- a/src/Crypto/Secp256k1.hs +++ b/src/Crypto/Secp256k1.hs @@ -1,8 +1,16 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -fno-show-valid-hole-fits #-} -- | -- Module : Crypto.Secp256k1 @@ -13,84 +21,123 @@ -- -- Crytpographic functions from Bitcoin’s secp256k1 library. module Crypto.Secp256k1 ( - -- * Messages - Msg, - msg, - getMsg, - - -- * Secret Keys + -- * Core Types SecKey, - secKey, - getSecKey, - derivePubKey, + PubKeyXY, + PubKeyXO, + KeyPair, + Signature, + RecoverableSignature, + Tweak, - -- * Public Keys - PubKey, - importPubKey, - exportPubKey, + -- * Parsing and Serialization + importSecKey, + importPubKeyXY, + exportPubKeyXY, + importPubKeyXO, + exportPubKeyXO, + importSignature, + exportSignatureCompact, + exportSignatureDer, + importRecoverableSignature, + exportRecoverableSignature, + importTweak, - -- * Signatures - Sig, - signMsg, - verifySig, - normalizeSig, + -- * ECDSA Operations + ecdsaVerify, + ecdsaSign, + ecdsaSignRecoverable, + ecdsaRecover, - -- ** DER - importSig, - exportSig, + -- * Conversions + recSigToSig, + derivePubKey, + keyPairCreate, + keyPairPubKeyXY, + keyPairPubKeyXO, + xyToXO, - -- ** Compact - CompactSig, - getCompactSig, - compactSig, - exportCompactSig, - importCompactSig, + -- * Tweaks + ecSecKeyTweakAdd, + ecSecKeyTweakMul, + keyPairPubKeyXOTweakAdd, + pubKeyCombine, + pubKeyNegate, + secKeyNegate, + pubKeyTweakAdd, + pubKeyTweakMul, + pubKeyXOTweakAdd, + pubKeyXOTweakAddCheck, - -- * Addition & Multiplication - Tweak, - tweak, - getTweak, - tweakAddSecKey, - tweakMulSecKey, - tweakAddPubKey, - tweakMulPubKey, - combinePubKeys, + -- * Schnorr Operations + schnorrSign, + SchnorrExtra (..), + schnorrSignCustom, + schnorrVerify, + + -- * Other + taggedSha256, + ecdh, ) where -import Control.DeepSeq (NFData) import Control.Monad (replicateM, unless, (<=<)) +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Cont (ContT (..), evalContT) +import Crypto.Secp256k1.Internal +import Crypto.Secp256k1.Prim (flagsEcUncompressed) import qualified Crypto.Secp256k1.Prim as Prim +import Data.ByteArray.Sized import Data.ByteString (ByteString) import qualified Data.ByteString as BS -import qualified Data.ByteString.Base16 as B16 -import Data.Hashable (Hashable (..)) + +-- import qualified Data.ByteString.Base16 as B16 +import Data.ByteString.Unsafe (unsafePackCStringLen, unsafePackMallocCStringLen) +import Data.Functor (($>)) + +-- import Data.Hashable (Hashable (..)) import Data.Maybe (fromJust, fromMaybe, isJust) -import Data.Serialize ( - Serialize (..), - getByteString, - putByteString, - ) import Data.String (IsString (..)) -import Data.String.Conversions (ConvertibleStrings, cs) + +-- import Data.String.Conversions (ConvertibleStrings, cs) + +import Crypto.Hash (Digest, SHA256, digestFromByteString) +import Data.Foldable (for_) import Foreign ( + Bits (..), + ForeignPtr, + FunPtr, + Ptr, + Storable, + Word8, alloca, allocaArray, allocaBytes, + castForeignPtr, + castPtr, + finalizerFree, free, + freeHaskellFunPtr, + malloc, mallocBytes, + newForeignPtr, + newForeignPtr_, nullFunPtr, nullPtr, peek, + peekByteOff, + peekElemOff, + plusPtr, poke, pokeArray, + pokeByteOff, + pokeElemOff, + sizeOf, + withForeignPtr, ) +import Foreign.C (CInt (..), CSize (..)) import GHC.Generics (Generic) +import GHC.IO.Handle.Text (memcpy) import System.IO.Unsafe (unsafePerformIO) -import Test.QuickCheck ( - Arbitrary (..), - arbitraryBoundedRandom, - suchThat, - ) import Text.Read ( Lexeme (String), lexP, @@ -100,411 +147,548 @@ ) -newtype PubKey = PubKey {getPubKey :: ByteString} - deriving (Eq, Generic, NFData) -newtype Msg = Msg {getMsg :: ByteString} - deriving (Eq, Generic, NFData) -newtype Sig = Sig {getSig :: ByteString} - deriving (Eq, Generic, NFData) -newtype SecKey = SecKey {getSecKey :: ByteString} - deriving (Eq, Generic, NFData) -newtype Tweak = Tweak {getTweak :: ByteString} - deriving (Eq, Generic, NFData) -newtype CompactSig = CompactSig {getCompactSig :: ByteString} - deriving (Eq, Generic, NFData) - - -instance Serialize PubKey where - put (PubKey bs) = putByteString bs - get = PubKey <$> getByteString 64 - - -instance Serialize Msg where - put (Msg m) = putByteString m - get = Msg <$> getByteString 32 - - -instance Serialize Sig where - put (Sig bs) = putByteString bs - get = Sig <$> getByteString 64 - - -instance Serialize SecKey where - put (SecKey bs) = putByteString bs - get = SecKey <$> getByteString 32 - - -instance Serialize Tweak where - put (Tweak bs) = putByteString bs - get = Tweak <$> getByteString 32 +newtype SecKey = SecKey {secKeyFPtr :: ForeignPtr Prim.Seckey32} +newtype PubKeyXY = PubKeyXY {pubKeyXYFPtr :: ForeignPtr Prim.Pubkey64} +newtype PubKeyXO = PubKeyXO {pubKeyXOFPtr :: ForeignPtr Prim.XonlyPubkey64} +newtype KeyPair = KeyPair {keyPairFPtr :: ForeignPtr Prim.Keypair96} +newtype Signature = Signature {signatureFPtr :: ForeignPtr Prim.Sig64} +newtype RecoverableSignature = RecoverableSignature {recoverableSignatureFPtr :: ForeignPtr Prim.RecSig65} +newtype Tweak = Tweak {tweakFPtr :: ForeignPtr Prim.Tweak32} -instance Serialize CompactSig where - put (CompactSig bs) = putByteString bs - get = CompactSig <$> getByteString 64 +-- | Preinitialized context for signing and verification +ctx :: Prim.Ctx +ctx = unsafePerformIO $ Prim.contextCreate (Prim.flagsContextSign .|. Prim.flagsContextVerify) +{-# NOINLINE ctx #-} -decodeHex :: ConvertibleStrings a ByteString => a -> Maybe ByteString -decodeHex str = case B16.decodeBase16 $ cs str of - Right bs -> Just bs - Left _ -> Nothing +-- | Parses 'SecKey', will be @Nothing@ if the @ByteString@ corresponds to 0{32} or is not 32 bytes in length +importSecKey :: ByteString -> Maybe SecKey +importSecKey bs + | BS.length bs /= 32 = Nothing + | otherwise = unsafePerformIO $ do + unsafeUseByteString bs $ \(ptr, len) -> do + ret <- Prim.ecSecKeyVerify ctx ptr + if isSuccess ret + then do + newPtr <- mallocBytes 32 + memcpy newPtr ptr 32 + Just . SecKey <$> newForeignPtr finalizerFree newPtr + else pure Nothing -instance Read PubKey where - readPrec = do - String str <- lexP - maybe pfail return $ importPubKey =<< decodeHex str +-- | Parses a 33 or 65 byte 'PubKeyXY', all other lengths will result in @Nothing@ +importPubKeyXY :: ByteString -> Maybe PubKeyXY +importPubKeyXY bs = unsafePerformIO $ + unsafeUseByteString bs $ \(input, len) -> do + pubkeyOutputBuf <- mallocBytes 64 + if len == 33 || len == 65 + then do + ret <- Prim.ecPubkeyParse ctx (castPtr pubkeyOutputBuf) input len + if isSuccess ret + then Just . PubKeyXY <$> newForeignPtr finalizerFree (castPtr pubkeyOutputBuf) + else free pubkeyOutputBuf $> Nothing + else pure Nothing -instance Hashable PubKey where - i `hashWithSalt` k = i `hashWithSalt` exportPubKey True k +-- | Serialize 'PubKeyXY'. First argument @True@ for compressed output (33 bytes), @False@ for uncompressed (65 bytes). +exportPubKeyXY :: Bool -> PubKeyXY -> ByteString +exportPubKeyXY compress (PubKeyXY fptr) = unsafePerformIO $ do + let flags = if compress then Prim.flagsEcCompressed else Prim.flagsEcUncompressed + let sz = if compress then 33 else 65 + buf <- mallocBytes sz + alloca $ \written -> do + -- always succeeds so we don't need to check + _ret <- withForeignPtr fptr $ \ptr -> Prim.ecPubkeySerialize ctx buf written ptr flags + len <- peek written + unsafePackMallocCStringLen (castPtr buf, fromIntegral len) -instance IsString PubKey where - fromString = fromMaybe e . (importPubKey <=< decodeHex) - where - e = error "Could not decode public key from hex string" +-- | Parses 'PubKeyXO' from @ByteString@, will be @Nothing@ if the pubkey corresponds to the Point at Infinity or the +-- the @ByteString@ is not 32 bytes long +importPubKeyXO :: ByteString -> Maybe PubKeyXO +importPubKeyXO bs + | BS.length bs /= 32 = Nothing + | otherwise = unsafePerformIO $ do + outBuf <- mallocBytes 64 + unsafeUseByteString bs $ \(ptr, _) -> do + ret <- Prim.xonlyPubkeyParse ctx outBuf ptr + if isSuccess ret + then Just . PubKeyXO <$> newForeignPtr finalizerFree outBuf + else pure Nothing -instance Show PubKey where - showsPrec _ = shows . B16.encodeBase16 . exportPubKey True +-- | Serializes 'PubKeyXO' to 32 byte @ByteString@ +exportPubKeyXO :: PubKeyXO -> ByteString +exportPubKeyXO (PubKeyXO pkFPtr) = unsafePerformIO $ do + outBuf <- mallocBytes 32 + _ret <- withForeignPtr pkFPtr $ Prim.xonlyPubkeySerialize ctx outBuf + unsafePackByteString (outBuf, 32) -instance Read Msg where - readPrec = parens $ do - String str <- lexP - maybe pfail return $ msg =<< decodeHex str +-- | Parses 'Signature' from DER (71 | 72 | 73 bytes) or Compact (64 bytes) representations. +importSignature :: ByteString -> Maybe Signature +importSignature bs = unsafePerformIO $ + unsafeUseByteString bs $ \(inBuf, len) -> do + outBuf <- mallocBytes 64 + ret <- + if + -- compact + | len == 64 -> Prim.ecdsaSignatureParseCompact ctx outBuf inBuf + -- der + | len >= 71 && len <= 73 -> Prim.ecdsaSignatureParseDer ctx outBuf inBuf len + -- invalid + | otherwise -> pure 0 + if isSuccess ret + then Just . Signature <$> newForeignPtr finalizerFree (castPtr outBuf) + else free outBuf $> Nothing -instance Hashable Msg where - i `hashWithSalt` m = i `hashWithSalt` getMsg m +-- | Serializes 'Signature' to Compact (64 byte) representation +exportSignatureCompact :: Signature -> ByteString +exportSignatureCompact (Signature fptr) = unsafePerformIO $ do + outBuf <- mallocBytes 64 + -- always succeeds + _ret <- withForeignPtr fptr $ Prim.ecdsaSignatureSerializeCompact ctx outBuf + unsafePackByteString (outBuf, 64) -instance IsString Msg where - fromString = fromMaybe e . (msg <=< decodeHex) - where - e = error "Could not decode message from hex string" +-- | Serializes 'Signature' to DER (71 | 72 bytes) representation +exportSignatureDer :: Signature -> ByteString +exportSignatureDer (Signature fptr) = unsafePerformIO $ do + -- as of Q4'2015 73 byte sigs became nonstandard so we will never create one that big + outBuf <- mallocBytes 72 + alloca $ \written -> do + -- always succeeds + _ret <- withForeignPtr fptr $ Prim.ecdsaSignatureSerializeDer ctx outBuf written + len <- peek written + unsafePackByteString (outBuf, len) -instance Show Msg where - showsPrec _ = shows . B16.encodeBase16 . getMsg +-- | Parses 'RecoverableSignature' from Compact (65 byte) representation +importRecoverableSignature :: ByteString -> Maybe RecoverableSignature +importRecoverableSignature bs + | BS.length bs /= 65 = Nothing + | otherwise = unsafePerformIO . evalContT $ do + outBuf <- lift (mallocBytes 65) + (ptr, len) <- ContT (unsafeUseByteString bs) + recId <- lift (peekByteOff @Word8 ptr 64) + let recIdCInt = fromIntegral recId + ret <- lift (Prim.ecdsaRecoverableSignatureParseCompact ctx outBuf ptr recIdCInt) + lift $ + if isSuccess ret + then Just . RecoverableSignature <$> newForeignPtr finalizerFree outBuf + else free outBuf $> Nothing -instance Read Sig where - readPrec = parens $ do - String str <- lexP - maybe pfail return $ importSig =<< decodeHex str +-- | Serializes 'RecoverableSignature' to Compact (65 byte) representation +exportRecoverableSignature :: RecoverableSignature -> ByteString +exportRecoverableSignature RecoverableSignature{..} = unsafePerformIO . evalContT $ do + recSigPtr <- ContT (withForeignPtr recoverableSignatureFPtr) + lift $ do + outBuf <- mallocBytes 65 + recIdPtr <- malloc + _ret <- Prim.ecdsaRecoverableSignatureSerializeCompact ctx outBuf recIdPtr recSigPtr + recId <- peek recIdPtr + unsafePackByteString (outBuf, 65) -instance IsString Sig where - fromString = fromMaybe e . (importSig <=< decodeHex) - where - e = error "Could not decode signature from hex string" +-- | Parses 'Tweak' from 32 byte @ByteString@. If the @ByteString@ is an invalid 'SecKey' then this will yield @Nothing@ +importTweak :: ByteString -> Maybe Tweak +importTweak = fmap (Tweak . castForeignPtr . secKeyFPtr) . importSecKey -instance Hashable Sig where - i `hashWithSalt` s = i `hashWithSalt` exportSig s +-- | Verify message signature. 'True' means that the signature is correct. +ecdsaVerify :: ByteString -> PubKeyXY -> Signature -> Bool +ecdsaVerify msgHash (PubKeyXY pkFPtr) (Signature sigFPtr) = unsafePerformIO $ + evalContT $ do + pkPtr <- ContT (withForeignPtr pkFPtr) + sigPtr <- ContT (withForeignPtr sigFPtr) + (msgHashPtr, n) <- ContT (unsafeUseByteString msgHash) + lift $ isSuccess <$> Prim.ecdsaVerify ctx sigPtr msgHashPtr pkPtr -instance Show Sig where - showsPrec _ = shows . B16.encodeBase16 . exportSig +-- | Signs @ByteString@ with 'SecKey' only if @ByteString@ is 32 bytes. +ecdsaSign :: SecKey -> ByteString -> Maybe Signature +ecdsaSign (SecKey skFPtr) msgHash + | BS.length msgHash /= 32 = Nothing + | otherwise = unsafePerformIO $ + evalContT $ do + skPtr <- ContT (withForeignPtr skFPtr) + (msgHashPtr, _) <- ContT (unsafeUseByteString msgHash) + sigBuf <- lift $ mallocBytes 64 + ret <- lift $ Prim.ecdsaSign ctx sigBuf msgHashPtr skPtr Prim.nonceFunctionDefault nullPtr + lift $ + if isSuccess ret + then Just . Signature <$> newForeignPtr finalizerFree sigBuf + else free sigBuf $> Nothing -instance Read SecKey where - readPrec = parens $ do - String str <- lexP - maybe pfail return $ secKey =<< decodeHex str +-- | Signs @ByteString@ with 'SecKey' only if @ByteString@ is 32 bytes. Retains ability to compute 'PubKeyXY' from the +-- 'RecoverableSignature' and the original message (@ByteString@) +ecdsaSignRecoverable :: SecKey -> ByteString -> Maybe RecoverableSignature +ecdsaSignRecoverable SecKey{..} bs + | BS.length bs /= 32 = Nothing + | otherwise = unsafePerformIO . evalContT $ do + (msgHashPtr, _) <- ContT (unsafeUseByteString bs) + secKeyPtr <- ContT (withForeignPtr secKeyFPtr) + lift $ do + recSigBuf <- mallocBytes 65 + ret <- Prim.ecdsaSignRecoverable ctx recSigBuf msgHashPtr secKeyPtr Prim.nonceFunctionDefault nullPtr + if isSuccess ret + then Just . RecoverableSignature <$> newForeignPtr finalizerFree recSigBuf + else free recSigBuf $> Nothing -instance Hashable SecKey where - i `hashWithSalt` k = i `hashWithSalt` getSecKey k +-- | Computes 'PubKeyXY' from 'RecoverableSignature' and the original message that was signed (must be 32 bytes). +ecdsaRecover :: RecoverableSignature -> ByteString -> Maybe PubKeyXY +ecdsaRecover RecoverableSignature{..} msgHash + | BS.length msgHash /= 32 = Nothing + | otherwise = unsafePerformIO . evalContT $ do + recSigPtr <- ContT (withForeignPtr recoverableSignatureFPtr) + (msgHashPtr, _) <- ContT (unsafeUseByteString msgHash) + lift $ do + pubKeyBuf <- mallocBytes 64 + ret <- Prim.ecdsaRecover ctx pubKeyBuf recSigPtr msgHashPtr + if isSuccess ret + then Just . PubKeyXY <$> newForeignPtr finalizerFree pubKeyBuf + else free pubKeyBuf $> Nothing -instance IsString SecKey where - fromString = fromMaybe e . (secKey <=< decodeHex) - where - e = error "Colud not decode secret key from hex string" +-- | Forgets the recovery id of a signature +recSigToSig :: RecoverableSignature -> Signature +recSigToSig RecoverableSignature{..} = unsafePerformIO . evalContT $ do + recSigPtr <- ContT (withForeignPtr recoverableSignatureFPtr) + lift $ do + sigBuf <- mallocBytes 64 + _ret <- Prim.ecdsaRecoverableSignatureConvert ctx sigBuf recSigPtr + Signature <$> newForeignPtr finalizerFree sigBuf -instance Show SecKey where - showsPrec _ = shows . B16.encodeBase16 . getSecKey +-- | Use 'SecKey' to compute the corresponding 'PubKeyXY' +derivePubKey :: SecKey -> PubKeyXY +derivePubKey (SecKey skFPtr) = unsafePerformIO $ do + outBuf <- mallocBytes 64 + ret <- withForeignPtr skFPtr $ Prim.ecPubkeyCreate ctx outBuf + unless (isSuccess ret) $ do + free outBuf + error "Bug: Invalid SecKey Constructed" + PubKeyXY <$> newForeignPtr finalizerFree outBuf -instance Hashable Tweak where - i `hashWithSalt` t = i `hashWithSalt` getTweak t +-- | Compute a shared secret using ECDH and SHA256. This algorithm uses your own 'SecKey', your counterparty's 'PubKeyXY' +-- and results in a 32 byte SHA256 Digest. +ecdh :: SecKey -> PubKeyXY -> Digest SHA256 +ecdh SecKey{..} PubKeyXY{..} = unsafePerformIO . evalContT $ do + outBuf <- lift (mallocBytes 32) + sk <- ContT (withForeignPtr secKeyFPtr) + pk <- ContT (withForeignPtr pubKeyXYFPtr) + ret <- lift (Prim.ecdh ctx outBuf pk sk Prim.ecdhHashFunctionSha256 nullPtr) + if isSuccess ret + then do + bs <- lift $ unsafePackByteString (outBuf, 32) + let Just digest = digestFromByteString bs + pure digest + else lift (free outBuf) *> error "Bug: Invalid Scalar or Overflow" -instance Read Tweak where - readPrec = parens $ do - String str <- lexP - maybe pfail return $ tweak =<< decodeHex str +-- -- | Add 'Tweak' to 'SecKey'. +ecSecKeyTweakAdd :: SecKey -> Tweak -> Maybe SecKey +ecSecKeyTweakAdd SecKey{..} Tweak{..} = unsafePerformIO . evalContT $ do + skPtr <- ContT (withForeignPtr secKeyFPtr) + skOut <- lift (mallocBytes 32) + lift (memcpy skOut skPtr 32) + twkPtr <- ContT (withForeignPtr tweakFPtr) + ret <- lift (Prim.ecSeckeyTweakAdd ctx skOut twkPtr) + lift $ + if isSuccess ret + then Just . SecKey <$> newForeignPtr finalizerFree skOut + else free skOut $> Nothing -instance IsString Tweak where - fromString = fromMaybe e . (tweak <=< decodeHex) - where - e = error "Could not decode tweak from hex string" +-- | Multiply 'SecKey' by 'Tweak'. +ecSecKeyTweakMul :: SecKey -> Tweak -> Maybe SecKey +ecSecKeyTweakMul SecKey{..} Tweak{..} = unsafePerformIO . evalContT $ do + skPtr <- ContT (withForeignPtr secKeyFPtr) + skOut <- lift (mallocBytes 32) + lift (memcpy skOut skPtr 32) + twkPtr <- ContT (withForeignPtr tweakFPtr) + ret <- lift (Prim.ecSeckeyTweakMul ctx skOut twkPtr) + lift $ + if isSuccess ret + then Just . SecKey <$> newForeignPtr finalizerFree skOut + else free skOut $> Nothing -instance Show Tweak where - showsPrec _ = shows . B16.encodeBase16 . getTweak +-- | Compute 'KeyPair' structure from 'SecKey' +keyPairCreate :: SecKey -> KeyPair +keyPairCreate SecKey{..} = unsafePerformIO $ do + keyPairBuf <- mallocBytes 96 + ret <- withForeignPtr secKeyFPtr $ Prim.keypairCreate ctx keyPairBuf + unless (isSuccess ret) $ do + free keyPairBuf + error "Bug: Invalid SecKey Constructed" + KeyPair <$> newForeignPtr finalizerFree keyPairBuf --- | Import 32-byte 'ByteString' as 'Msg'. -msg :: ByteString -> Maybe Msg -msg bs - | BS.length bs == 32 = Just (Msg bs) - | otherwise = Nothing +-- | Project 'PubKeyXY' from 'KeyPair' +keyPairPubKeyXY :: KeyPair -> PubKeyXY +keyPairPubKeyXY KeyPair{..} = unsafePerformIO $ do + pubKeyBuf <- mallocBytes 64 + ret <- withForeignPtr keyPairFPtr $ Prim.keypairPub ctx pubKeyBuf + unless (isSuccess ret) $ do + free pubKeyBuf + error "Bug: Invalid KeyPair Constructed" + PubKeyXY <$> newForeignPtr finalizerFree pubKeyBuf --- | Import 32-byte 'ByteString' as 'SecKey'. -secKey :: ByteString -> Maybe SecKey -secKey bs - | BS.length bs == 32 = Just (SecKey bs) - | otherwise = Nothing +-- | Project 'SecKey' from 'KeyPair' +keyPairSecKey :: KeyPair -> SecKey +keyPairSecKey KeyPair{..} = unsafePerformIO $ do + secKeyBuf <- mallocBytes 32 + ret <- withForeignPtr keyPairFPtr $ Prim.keypairSec ctx secKeyBuf + unless (isSuccess ret) $ do + free secKeyBuf + error "Bug: Invalid KeyPair Constructed" + SecKey <$> newForeignPtr finalizerFree secKeyBuf -compactSig :: ByteString -> Maybe CompactSig -compactSig bs - | BS.length bs == 64 = Just (CompactSig bs) - | otherwise = Nothing +-- | Project 'PubKeyXO' from 'KeyPair' as well as parity bit. @True@ indicates that the public key is the same as it +-- would be if you had serialized the 'PubKeyXO' and it was prefixed with 'Prim.flagsTagPubkeyOdd'. @False@ indicates +-- it would be prefixed by 'Prim.flagsTagPubkeyEven' +keyPairPubKeyXO :: KeyPair -> (PubKeyXO, Bool) +keyPairPubKeyXO KeyPair{..} = unsafePerformIO $ do + pubKeyBuf <- mallocBytes 64 + parityPtr <- malloc + ret <- withForeignPtr keyPairFPtr $ Prim.keypairXonlyPub ctx pubKeyBuf parityPtr + unless (isSuccess ret) $ do + free pubKeyBuf + free parityPtr + error "Bug: Invalid KeyPair Constructed" + parity <- peek parityPtr + negated <- case parity of + 0 -> pure False + 1 -> pure True + _ -> do + free pubKeyBuf + free parityPtr + error "Bug: Invalid pk_parity result from Prim" + (,negated) . PubKeyXO <$> newForeignPtr finalizerFree pubKeyBuf --- | Convert signature to a normalized lower-S form. 'Nothing' indicates that it --- was already normal. -normalizeSig :: Sig -> Maybe Sig -normalizeSig (Sig sig) = unsafePerformIO $ - Prim.unsafeUseByteString sig $ \(sig_in, _) -> do - sig_out <- mallocBytes 64 - ret <- Prim.ecdsaSignatureNormalize Prim.ctx sig_out sig_in - if Prim.isSuccess ret - then do - bs <- Prim.unsafePackByteString (sig_out, 64) - return (Just (Sig bs)) - else do - free sig_out - return Nothing +-- | Tweak a 'KeyPair' with a 'Tweak'. If the resulting 'KeyPair' is invalid (0, Infinity), then the result is @Nothing@ +keyPairPubKeyXOTweakAdd :: KeyPair -> Tweak -> Maybe KeyPair +keyPairPubKeyXOTweakAdd KeyPair{..} Tweak{..} = unsafePerformIO . evalContT $ do + keyPairPtr <- ContT (withForeignPtr keyPairFPtr) + tweakPtr <- ContT (withForeignPtr tweakFPtr) + lift $ do + keyPairOut <- (mallocBytes 96) + _ <- (memcpy keyPairOut keyPairPtr 96) + ret <- Prim.keypairXonlyTweakAdd ctx keyPairOut tweakPtr + if isSuccess ret + then Just . KeyPair <$> newForeignPtr finalizerFree keyPairOut + else free keyPairOut $> Nothing --- | 32-Byte 'ByteString' as 'Tweak'. -tweak :: ByteString -> Maybe Tweak -tweak bs - | BS.length bs == 32 = Just (Tweak bs) - | otherwise = Nothing +-- | Compute a schnorr signature using a 'KeyPair'. The @ByteString@ must be 32 bytes long to get a @Just@ out of this +-- function +schnorrSign :: KeyPair -> ByteString -> Maybe Signature +schnorrSign KeyPair{..} bs + | BS.length bs /= 32 = Nothing + | otherwise = unsafePerformIO . evalContT $ do + (msgHashPtr, _) <- ContT (unsafeUseByteString bs) + keyPairPtr <- ContT (withForeignPtr keyPairFPtr) + lift $ do + sigBuf <- mallocBytes 64 + -- TODO: provide randomness here instead of supplying a null pointer + ret <- Prim.schnorrsigSign ctx sigBuf msgHashPtr keyPairPtr nullPtr + if isSuccess ret + then Just . Signature <$> newForeignPtr finalizerFree sigBuf + else free sigBuf $> Nothing --- | Import DER-encoded public key. -importPubKey :: ByteString -> Maybe PubKey -importPubKey bs - | BS.null bs = Nothing - | otherwise = unsafePerformIO $ - Prim.unsafeUseByteString bs $ \(input, len) -> do - pub_key <- mallocBytes 64 - ret <- Prim.ecPubkeyParse Prim.ctx pub_key input len - if Prim.isSuccess ret - then do - out <- Prim.unsafePackByteString (pub_key, 64) - return (Just (PubKey out)) - else do - free pub_key - return Nothing +-- | Extra parameters object for alternative nonce generation +data SchnorrExtra a = Storable a => + SchnorrExtra + { schnorrExtraNonceFunHardened :: ByteString -> SecKey -> PubKeyXO -> ByteString -> a -> Maybe (SizedByteArray 32 ByteString) + , schnorrExtraData :: a + } --- | Encode public key as DER. First argument 'True' for compressed output. -exportPubKey :: Bool -> PubKey -> ByteString -exportPubKey compress (PubKey in_bs) = unsafePerformIO $ - Prim.unsafeUseByteString in_bs $ \(in_ptr, _) -> - alloca $ \len_ptr -> - allocaBytes len $ \out_ptr -> do - poke len_ptr $ fromIntegral len - ret <- Prim.ecPubkeySerialize Prim.ctx out_ptr len_ptr in_ptr flags - unless (Prim.isSuccess ret) $ error "could not serialize public key" - final_len <- peek len_ptr - Prim.packByteString (out_ptr, final_len) +-- | Compute a schnorr signature with an alternative scheme for generating nonces, it is not recommended you use this +-- unless you know what you are doing. Instead, favor the usage of 'schnorrSign' +schnorrSignCustom :: forall a. KeyPair -> ByteString -> SchnorrExtra a -> Maybe Signature +schnorrSignCustom KeyPair{..} msg SchnorrExtra{..} = unsafePerformIO . evalContT $ do + (msgPtr, msgLen) <- ContT (unsafeUseByteString msg) + keyPairPtr <- ContT (withForeignPtr keyPairFPtr) + lift $ do + sigBuf <- mallocBytes 64 + -- convert fn into funptr + funptr <- mkNonceFunHardened primFn + -- allocate memory for extra data ptr + dataptr <- malloc + -- copy data to new pointer + poke dataptr schnorrExtraData + -- allocate extraparams structure + extraPtr <- mallocBytes (4 + sizeOf funptr + sizeOf dataptr) + -- fill magic + pokeByteOff extraPtr 0 (0xDA :: Word8) + pokeByteOff extraPtr 1 (0x6F :: Word8) + pokeByteOff extraPtr 2 (0xB3 :: Word8) + pokeByteOff extraPtr 3 (0x8C :: Word8) + -- fill funptr + pokeByteOff extraPtr 4 funptr + -- fill dataptr + pokeByteOff extraPtr (4 + sizeOf funptr) dataptr + ret <- Prim.schnorrsigSignCustom ctx sigBuf msgPtr msgLen keyPairPtr extraPtr + freeHaskellFunPtr funptr + free dataptr + free extraPtr + if isSuccess ret + then Just . Signature <$> newForeignPtr finalizerFree sigBuf + else free sigBuf $> Nothing where - len = if compress then 33 else 65 - flags = if compress then Prim.compressed else Prim.uncompressed - - -exportCompactSig :: Sig -> CompactSig -exportCompactSig (Sig sig_bs) = unsafePerformIO $ - Prim.unsafeUseByteString sig_bs $ \(sig_ptr, _) -> do - out_ptr <- mallocBytes 64 - ret <- Prim.ecdsaSignatureSerializeCompact Prim.ctx out_ptr sig_ptr - unless (Prim.isSuccess ret) $ do - free out_ptr - error "Could not obtain compact signature" - out_bs <- Prim.unsafePackByteString (out_ptr, 64) - return $ CompactSig out_bs - - -importCompactSig :: CompactSig -> Maybe Sig -importCompactSig (CompactSig compact_sig) = unsafePerformIO $ - Prim.unsafeUseByteString compact_sig $ \(compact_ptr, _) -> do - out_sig <- mallocBytes 64 - ret <- Prim.ecdsaSignatureParseCompact Prim.ctx out_sig compact_ptr - if Prim.isSuccess ret - then do - out_bs <- Prim.unsafePackByteString (out_sig, 64) - return (Just (Sig out_bs)) - else do - free out_sig - return Nothing - - --- | Import DER-encoded signature. -importSig :: ByteString -> Maybe Sig -importSig bs - | BS.null bs = Nothing - | otherwise = unsafePerformIO $ - Prim.unsafeUseByteString bs $ \(in_ptr, in_len) -> do - out_sig <- mallocBytes 64 - ret <- Prim.ecdsaSignatureParseDer Prim.ctx out_sig in_ptr in_len - if Prim.isSuccess ret - then do - out_bs <- Prim.unsafePackByteString (out_sig, 64) - return (Just (Sig out_bs)) - else do - free out_sig - return Nothing - - --- | Encode signature as strict DER. -exportSig :: Sig -> ByteString -exportSig (Sig in_sig) = unsafePerformIO $ - Prim.unsafeUseByteString in_sig $ \(in_ptr, _) -> - alloca $ \out_len -> - allocaBytes 72 $ \out_ptr -> do - poke out_len 72 - ret <- Prim.ecdsaSignatureSerializeDer Prim.ctx out_ptr out_len in_ptr - unless (Prim.isSuccess ret) $ error "could not serialize signature" - final_len <- peek out_len - Prim.packByteString (out_ptr, final_len) + primFn :: Storable a => Prim.NonceFunHardened a + primFn outBuf msgPtr msgLen sk xopk algo algolen dataPtr = do + msg <- unsafePackByteString (msgPtr, msgLen) + sk <- SecKey <$> newForeignPtr_ (castPtr sk) + xopk <- PubKeyXO <$> newForeignPtr_ (castPtr xopk) + algo <- unsafePackByteString (algo, algolen) + extra <- peek dataPtr + case schnorrExtraNonceFunHardened msg sk xopk algo extra of + Nothing -> pure 0 + Just bs -> evalContT $ do + (hashPtr, _) <- ContT (unsafeUseByteString (unSizedByteArray bs)) + lift (memcpy outBuf hashPtr 32) + pure 1 --- | Verify message signature. 'True' means that the signature is correct. -verifySig :: PubKey -> Sig -> Msg -> Bool -verifySig (PubKey pub_key) (Sig sig) (Msg m) = unsafePerformIO $ - Prim.unsafeUseByteString pub_key $ \(pub_key_ptr, _) -> - Prim.unsafeUseByteString sig $ \(sig_ptr, _) -> - Prim.unsafeUseByteString m $ \(msg_ptr, _) -> - Prim.isSuccess <$> Prim.ecdsaVerify Prim.ctx sig_ptr msg_ptr pub_key_ptr +-- | Verify the authenticity of a schnorr signature. @True@ means the 'Signature' is correct. +schnorrVerify :: PubKeyXO -> ByteString -> Signature -> Bool +schnorrVerify PubKeyXO{..} bs Signature{..} = unsafePerformIO . evalContT $ do + pubKeyPtr <- ContT (withForeignPtr pubKeyXOFPtr) + signaturePtr <- ContT (withForeignPtr signatureFPtr) + (msgPtr, msgLen) <- ContT (unsafeUseByteString bs) + lift $ isSuccess <$> Prim.schnorrsigSignVerify ctx signaturePtr msgPtr msgLen pubKeyPtr -signMsg :: SecKey -> Msg -> Sig -signMsg (SecKey sec_key) (Msg m) = unsafePerformIO $ - Prim.unsafeUseByteString sec_key $ \(sec_key_ptr, _) -> - Prim.unsafeUseByteString m $ \(msg_ptr, _) -> do - sig_ptr <- mallocBytes 64 - ret <- Prim.ecdsaSign Prim.ctx sig_ptr msg_ptr sec_key_ptr nullFunPtr nullPtr - unless (Prim.isSuccess ret) $ do - free sig_ptr - error "could not sign message" - Sig <$> Prim.unsafePackByteString (sig_ptr, 64) +-- | Generate a tagged sha256 digest as specified in BIP340 +taggedSha256 :: ByteString -> ByteString -> Digest SHA256 +taggedSha256 tag msg = unsafePerformIO . evalContT $ do + (tagBuf, tagLen) <- ContT (unsafeUseByteString tag) + (msgBuf, msgLen) <- ContT (unsafeUseByteString msg) + lift $ do + hashBuf <- mallocBytes 32 + ret <- Prim.taggedSha256 ctx hashBuf tagBuf tagLen msgBuf msgLen + unless (isSuccess ret) $ do + free hashBuf + error "Bug: Invalid use of C Lib" + bs <- unsafePackByteString (hashBuf, 32) + let Just digest = digestFromByteString bs + pure digest -derivePubKey :: SecKey -> PubKey -derivePubKey (SecKey sec_key) = unsafePerformIO $ - Prim.unsafeUseByteString sec_key $ \(sec_key_ptr, _) -> do - pub_key_ptr <- mallocBytes 64 - ret <- Prim.ecPubkeyCreate Prim.ctx pub_key_ptr sec_key_ptr - unless (Prim.isSuccess ret) $ do - free pub_key_ptr - error "could not compute public key" - PubKey <$> Prim.unsafePackByteString (pub_key_ptr, 64) +-- | Combine a list of 'PubKeyXY's into a single 'PubKeyXY'. This will result in @Nothing@ if the group operation results +-- in the Point at Infinity +pubKeyCombine :: [PubKeyXY] -> Maybe PubKeyXY +pubKeyCombine keys = unsafePerformIO $ do + let n = length keys + keysBuf <- mallocBytes (64 * n) + for_ (zip [0 ..] keys) $ \(i, PubKeyXY{..}) -> + withForeignPtr pubKeyXYFPtr $ pokeElemOff keysBuf i + outBuf <- mallocBytes 64 + ret <- Prim.ecPubkeyCombine ctx outBuf keysBuf (fromIntegral n) + if isSuccess ret + then Just . PubKeyXY <$> newForeignPtr finalizerFree outBuf + else free outBuf $> Nothing --- | Add tweak to secret key. -tweakAddSecKey :: SecKey -> Tweak -> Maybe SecKey -tweakAddSecKey (SecKey sec_key) (Tweak t) = unsafePerformIO $ - Prim.unsafeUseByteString new_bs $ \(sec_key_ptr, _) -> - Prim.unsafeUseByteString t $ \(tweak_ptr, _) -> do - ret <- Prim.ecSeckeyTweakAdd Prim.ctx sec_key_ptr tweak_ptr - if Prim.isSuccess ret - then return (Just (SecKey new_bs)) - else return Nothing - where - new_bs = BS.copy sec_key +-- | Negate a 'PubKeyXY' +pubKeyNegate :: PubKeyXY -> PubKeyXY +pubKeyNegate PubKeyXY{..} = unsafePerformIO $ do + outBuf <- mallocBytes 64 + withForeignPtr pubKeyXYFPtr $ flip (memcpy outBuf) 64 + _ret <- Prim.ecPubkeyNegate ctx outBuf + PubKeyXY <$> newForeignPtr finalizerFree outBuf --- | Multiply secret key by tweak. -tweakMulSecKey :: SecKey -> Tweak -> Maybe SecKey -tweakMulSecKey (SecKey sec_key) (Tweak t) = unsafePerformIO $ - Prim.unsafeUseByteString new_bs $ \(sec_key_ptr, _) -> - Prim.unsafeUseByteString t $ \(tweak_ptr, _) -> do - ret <- Prim.ecSeckeyTweakMul Prim.ctx sec_key_ptr tweak_ptr - if Prim.isSuccess ret - then return (Just (SecKey new_bs)) - else return Nothing - where - new_bs = BS.copy sec_key +-- | Add 'Tweak' to 'PubKeyXY'. This will result in @Nothing@ if the group operation results in the Point at Infinity +pubKeyTweakAdd :: PubKeyXY -> Tweak -> Maybe PubKeyXY +pubKeyTweakAdd PubKeyXY{..} Tweak{..} = unsafePerformIO . evalContT $ do + pubKeyPtr <- ContT (withForeignPtr pubKeyXYFPtr) + tweakPtr <- ContT (withForeignPtr tweakFPtr) + lift $ do + pubKeyOutBuf <- mallocBytes 64 + memcpy pubKeyOutBuf pubKeyPtr 64 + ret <- Prim.ecPubkeyTweakAdd ctx pubKeyOutBuf tweakPtr + if isSuccess ret + then Just . PubKeyXY <$> newForeignPtr finalizerFree pubKeyOutBuf + else free pubKeyOutBuf $> Nothing --- | Add tweak to public key. Tweak is multiplied first by G to obtain a point. -tweakAddPubKey :: PubKey -> Tweak -> Maybe PubKey -tweakAddPubKey (PubKey pub_key) (Tweak t) = unsafePerformIO $ - Prim.unsafeUseByteString new_bs $ \(pub_key_ptr, _) -> - Prim.unsafeUseByteString t $ \(tweak_ptr, _) -> do - ret <- Prim.ecPubkeyTweakAdd Prim.ctx pub_key_ptr tweak_ptr - if Prim.isSuccess ret - then return (Just (PubKey new_bs)) - else return Nothing - where - new_bs = BS.copy pub_key +-- | Multiply 'PubKeyXY' by 'Tweak'. This will result in @Nothing@ if the group operation results in the Point at Infinity +pubKeyTweakMul :: PubKeyXY -> Tweak -> Maybe PubKeyXY +pubKeyTweakMul PubKeyXY{..} Tweak{..} = unsafePerformIO . evalContT $ do + pubKeyPtr <- ContT (withForeignPtr pubKeyXYFPtr) + tweakPtr <- ContT (withForeignPtr tweakFPtr) + lift $ do + pubKeyOutBuf <- mallocBytes 64 + memcpy pubKeyOutBuf pubKeyPtr 64 + ret <- Prim.ecPubkeyTweakMul ctx pubKeyOutBuf tweakPtr + if isSuccess ret + then Just . PubKeyXY <$> newForeignPtr finalizerFree pubKeyOutBuf + else free pubKeyOutBuf $> Nothing --- | Multiply public key by tweak. Tweak is multiplied first by G to obtain a --- point. -tweakMulPubKey :: PubKey -> Tweak -> Maybe PubKey -tweakMulPubKey (PubKey pub_key) (Tweak t) = unsafePerformIO $ - Prim.unsafeUseByteString new_bs $ \(pub_key_ptr, _) -> - Prim.unsafeUseByteString t $ \(tweak_ptr, _) -> do - ret <- Prim.ecPubkeyTweakMul Prim.ctx pub_key_ptr tweak_ptr - if Prim.isSuccess ret - then return (Just (PubKey new_bs)) - else return Nothing - where - new_bs = BS.copy pub_key +-- | Negate a 'SecKey' +secKeyNegate :: SecKey -> SecKey +secKeyNegate SecKey{..} = unsafePerformIO $ do + outBuf <- mallocBytes 32 + withForeignPtr secKeyFPtr $ flip (memcpy outBuf) 32 + _ret <- Prim.ecSeckeyNegate ctx outBuf + SecKey <$> newForeignPtr finalizerFree outBuf --- | Add multiple public keys together. -combinePubKeys :: [PubKey] -> Maybe PubKey -combinePubKeys [] = Nothing -combinePubKeys pubs = unsafePerformIO $ - pointers [] pubs $ \ps -> - allocaArray (length ps) $ \a -> do - out <- mallocBytes 64 - pokeArray a ps - ret <- Prim.ecPubkeyCombine Prim.ctx out a (fromIntegral $ length ps) - if Prim.isSuccess ret - then do - bs <- Prim.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 = - Prim.unsafeUseByteString pub_key $ \(p, _) -> - pointers (p : ps) pub_keys f +-- | Convert 'PubKeyXY' to 'PubKeyXO'. See 'keyPairPubKeyXO' for more information on how to interpret the parity bit. +xyToXO :: PubKeyXY -> (PubKeyXO, Bool) +xyToXO PubKeyXY{..} = unsafePerformIO $ do + outBuf <- mallocBytes 64 + parityPtr <- malloc + ret <- withForeignPtr pubKeyXYFPtr $ Prim.xonlyPubkeyFromPubkey ctx outBuf parityPtr + unless (isSuccess ret) $ do + free outBuf + error "Bug: Couldn't convert xy to xo" + parity <- peek parityPtr + negated <- case parity of + 0 -> pure False + 1 -> pure True + _ -> free outBuf *> error "Bug: Invalid pk_parity from Prim" + (,negated) . PubKeyXO <$> newForeignPtr finalizerFree outBuf -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 +-- | Add 'Tweak' to 'PubKeyXO'. This will result in @Nothing@ if the group operation results in the Point at Infinity +pubKeyXOTweakAdd :: PubKeyXO -> Tweak -> Maybe PubKeyXY +pubKeyXOTweakAdd PubKeyXO{..} Tweak{..} = unsafePerformIO . evalContT $ do + pubKeyXOPtr <- ContT (withForeignPtr pubKeyXOFPtr) + tweakPtr <- ContT (withForeignPtr tweakFPtr) + lift $ do + outBuf <- mallocBytes 64 + ret <- Prim.xonlyPubkeyTweakAdd ctx outBuf pubKeyXOPtr tweakPtr + if isSuccess ret + then Just . PubKeyXY <$> newForeignPtr finalizerFree outBuf + else free outBuf $> Nothing -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 +-- | Check that a 'PubKeyXO' is the result of the specified tweak operation. @True@ means it was. +pubKeyXOTweakAddCheck :: PubKeyXO -> Bool -> PubKeyXO -> Tweak -> Bool +pubKeyXOTweakAddCheck PubKeyXO{pubKeyXOFPtr = tweakedFPtr} parity PubKeyXO{pubKeyXOFPtr = origFPtr} Tweak{..} = + unsafePerformIO . evalContT $ do + tweakedPtr <- ContT (withForeignPtr tweakedFPtr) + origPtr <- ContT (withForeignPtr origFPtr) + tweakPtr <- ContT (withForeignPtr tweakFPtr) + let parityInt = if parity then 1 else 0 + lift $ isSuccess <$> Prim.xonlyPubkeyTweakAddCheck ctx tweakedPtr parityInt origPtr tweakPtr -instance Arbitrary PubKey where - arbitrary = derivePubKey <$> arbitrary +foreign import ccall "wrapper" + mkNonceFunHardened :: Prim.NonceFunHardened a -> IO (FunPtr (Prim.NonceFunHardened a)) diff --git a/src/Crypto/Secp256k1/Internal.hs b/src/Crypto/Secp256k1/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Secp256k1/Internal.hs @@ -0,0 +1,36 @@ +module Crypto.Secp256k1.Internal where + +import Crypto.Secp256k1.Prim +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Unsafe as BU +import Foreign (Ptr, castPtr) +import Foreign.C (CSize) + + +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) + + +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/Prim.hs b/src/Crypto/Secp256k1/Prim.hs --- a/src/Crypto/Secp256k1/Prim.hs +++ b/src/Crypto/Secp256k1/Prim.hs @@ -1,4 +1,6 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE RankNTypes #-} @@ -16,7 +18,7 @@ import Data.ByteString (ByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Unsafe as BU -import Foreign (FunPtr, Ptr, castPtr) +import Foreign (Bits (..), FunPtr, Ptr, castPtr) import Foreign.C ( CInt (..), CSize (..), @@ -28,68 +30,176 @@ import System.IO.Unsafe (unsafePerformIO) -type Ctx = Ptr LCtx -type CtxFlags = CUInt -type SerFlags = CUInt +-- | Return type of C Lib functions type Ret = CInt -verify :: CtxFlags -verify = 0x0101 +type ContextFlags = CUInt +type CompressionFlags = CUInt +type PubkeyFlags = CUInt -sign :: CtxFlags -sign = 0x0201 +-- * Flags -signVerify :: CtxFlags -signVerify = 0x0301 +-- ** Flag Types -compressed :: SerFlags -compressed = 0x0102 +-- $flagTypes All flags' lower 8 bits indicate what they're for. Do not use directly. -uncompressed :: SerFlags -uncompressed = 0x0002 +-- | Mask to isolate the type of flags +flagsTypeMask :: CUInt +flagsTypeMask = (1 `shiftL` 8) - 1 +{-# DEPRECATED flagsTypeMask "Do not use Flag Types directly" #-} -isSuccess :: Ret -> Bool -isSuccess 0 = False -isSuccess 1 = True -isSuccess n = error $ "isSuccess expected 0 or 1 but got " ++ show n +-- | This bit indicates that the flags are to be used to initialize context +flagsTypeContext :: ContextFlags +flagsTypeContext = 1 `shiftL` 0 +{-# DEPRECATED flagsTypeContext "Do not use Flag Types directly" #-} -unsafeUseByteString :: ByteString -> ((Ptr a, CSize) -> IO b) -> IO b -unsafeUseByteString bs f = - BU.unsafeUseAsCStringLen bs $ \(b, l) -> - f (castPtr b, fromIntegral l) +-- | This bit indicates that the flags are to be used to assess compression +flagsTypeCompression :: CompressionFlags +flagsTypeCompression = 1 `shiftL` 1 +{-# DEPRECATED flagsTypeCompression "Do not use Flag Types directly" #-} -useByteString :: ByteString -> ((Ptr a, CSize) -> IO b) -> IO b -useByteString bs f = - BS.useAsCStringLen bs $ \(b, l) -> - f (castPtr b, fromIntegral l) +-- ** Flag Operations -unsafePackByteString :: (Ptr a, CSize) -> IO ByteString -unsafePackByteString (b, l) = - BU.unsafePackMallocCStringLen (castPtr b, fromIntegral l) +-- $flagOperations +-- The higher bits contain the actual data. Do not use directly. */ -packByteString :: (Ptr a, CSize) -> IO ByteString -packByteString (b, l) = - BS.packCStringLen (castPtr b, fromIntegral l) +-- | This bit indicates that the context should be initialized for verification +flagsBitContextVerify :: ContextFlags +flagsBitContextVerify = 1 `shiftL` 8 +{-# DEPRECATED flagsBitContextVerify "Do not use Flag Operations directly" #-} -ctx :: Ctx -ctx = unsafePerformIO $ contextCreate signVerify -{-# NOINLINE ctx #-} +-- | This bit indicates that the context should be initialized for signing +flagsBitContextSign :: ContextFlags +flagsBitContextSign = 1 `shiftL` 9 +{-# DEPRECATED flagsBitContextSign "Do not use Flag Operations directly" #-} +-- | This bit indicates that the context should be initialized for declassification +flagsBitContextDeclassify :: ContextFlags +flagsBitContextDeclassify = 1 `shiftL` 10 +{-# DEPRECATED flagsBitContextDeclassify "Do not use Flag Operations directly" #-} + + +-- | This bit indicates that things should be serialized in a compressed format +flagsBitCompression :: CompressionFlags +flagsBitCompression = 1 `shiftL` 8 +{-# DEPRECATED flagsBitCompression "Do not use Flag Operations directly" #-} + + +-- ** Composite Flags + + +-- *** Context Initialization Flags + + +-- $ciFlags +-- Flags to pass to 'contextCreate', 'contextPreallocatedSize', and 'contextPreallocatedCreate'. + + +-- | Initialize context for verification +flagsContextVerify :: ContextFlags +flagsContextVerify = flagsTypeContext .|. flagsBitContextVerify + + +-- | Initialize context for signing +flagsContextSign :: ContextFlags +flagsContextSign = flagsTypeContext .|. flagsBitContextSign + + +-- | Initialize context for declassifying +flagsContextDeclassify :: ContextFlags +flagsContextDeclassify = flagsTypeContext .|. flagsBitContextDeclassify + + +-- | Initialize context for primitive operations +flagsContextNone :: ContextFlags +flagsContextNone = flagsTypeContext + + +-- *** Pubkey Serialization Flags + + +-- $psFlags +-- Flags to pass to 'ecPubkeySerialize'. + + +-- | Serialize EC keys compressed +flagsEcCompressed :: CompressionFlags +flagsEcCompressed = flagsTypeCompression .|. flagsBitCompression + + +-- | Serialize EC keys uncompressed +flagsEcUncompressed :: CompressionFlags +flagsEcUncompressed = flagsTypeCompression + + +-- *** Pubkey Tags + + +-- $pkTags +-- Prefix byte used to tag various encoded curvepoints for specific purposes + + +-- | Pubkey is even +flagsTagPubkeyEven :: PubkeyFlags +flagsTagPubkeyEven = 0x02 + + +-- | Pubkey is odd +flagsTagPubkeyOdd :: PubkeyFlags +flagsTagPubkeyOdd = 0x03 + + +-- | Pubkey is uncompressed +flagsTagPubkeyUncompressed :: PubkeyFlags +flagsTagPubkeyUncompressed = 0x04 + + +-- | Pubkey is even and uncompressed +flagsTagPubkeyHybridEven :: PubkeyFlags +flagsTagPubkeyHybridEven = flagsTagPubkeyEven .|. flagsTagPubkeyUncompressed + + +-- | Pubkey is odd and uncompressed +flagsTagPubkeyHybridOdd :: PubkeyFlags +flagsTagPubkeyHybridOdd = flagsTagPubkeyOdd .|. flagsTagPubkeyUncompressed + + -- * Context Operations +-- | Opaque data structure that holds context information (precomputed tables etc.). +-- +-- The purpose of context structures is to cache large precomputed data tables +-- that are expensive to construct, and also to maintain the randomization data +-- for blinding. +-- +-- Do not create a new context object for each operation, as construction is +-- far slower than all other API calls (~100 times slower than an ECDSA +-- verification). +-- +-- A constructed context can safely be used from multiple threads +-- simultaneously, but API calls that take a non-const pointer to a context +-- need exclusive access to it. In particular this is the case for +-- 'contextDestroy', 'contextPreallocatedDestroy', +-- and 'contextRandomize'. +-- +-- Regarding randomization, either do it once at creation time (in which case +-- you do not need any locking for the other calls), or use a read-write lock. +type Ctx = Ptr LCtx + + -- | Updates the context randomization to protect against side-channel leakage. -- -- While secp256k1 code is written to be constant-time no matter what secret @@ -146,7 +256,7 @@ foreign import ccall safe "secp256k1.h secp256k1_context_create" contextCreate :: -- | __Input:__ which parts of the context to initialize. - CtxFlags -> + ContextFlags -> -- | __Returns:__ a newly created context object. IO Ctx @@ -171,7 +281,7 @@ -- $preallocated --- functions in this secion are intended for settings in which it +-- Functions in this secion are intended for settings in which it -- is not possible or desirable to rely on dynamic memory allocation. It provides -- functions for creating, cloning, and destroying secp256k1 context objects in a -- contiguous fixed-size block of memory provided by the caller. @@ -340,8 +450,10 @@ -- USE_EXTERNAL_DEFAULT_CALLBACKS is defined, which is the case if the build -- has been configured with @--enable-external-default-callbacks@. Then the -- following two symbols must be provided to link against: --- - void secp256k1_default_illegal_callback_fn(const char* message, void* data); --- - void secp256k1_default_error_callback_fn(const char* message, void* data); +-- +-- - @void secp256k1_default_illegal_callback_fn(const char* message, void* data);@ +-- - @void secp256k1_default_error_callback_fn(const char* message, void* data);@ +-- -- The library can call these default handlers even before a proper callback data -- pointer could have been set using 'contextSetIllegalCallback' or -- 'contextSetErrorCallback', e.g., when the creation of a context @@ -393,8 +505,8 @@ -- | An implementation of SHA256 hash function that applies to compressed public key. -- Populates the output parameter with 32 bytes. -foreign import ccall safe "secp256k1.h &secp256k1_ecdh_hash_sha256" - ecdhHashSha256 :: FunPtr (EcdhHashFun a) +foreign import ccall safe "secp256k1.h &secp256k1_ecdh_hash_function_sha256" + ecdhHashFunctionSha256 :: FunPtr (EcdhHashFun a) -- * ECDSA @@ -462,35 +574,35 @@ -- | Serialize an ECDSA signature in compact format (64 bytes + recovery id). foreign import ccall safe "secp256k1.h secp256k1_ecdsa_recoverable_signature_serialize_compact" ecdsaRecoverableSignatureSerializeCompact :: - -- Args: ctx: a secp256k1 context object + -- | a secp256k1 context object Ctx -> - -- Out: output64: a pointer to a 64-byte array of the compact signature (cannot be NULL) + -- | __Output:__ a pointer to a 64-byte array of the compact signature (cannot be NULL) Ptr (Bytes 64) -> - -- recid: a pointer to an integer to hold the recovery id (can be NULL). + -- | __Output:__ a pointer to an integer to hold the recovery id (can be NULL). Ptr CInt -> - -- In: sig: a pointer to an initialized signature object (cannot be NULL) + -- | __Input:__ a pointer to an initialized signature object (cannot be NULL) Ptr RecSig65 -> - -- Returns: 1 + -- | __Returns:__ 1 IO Ret -- | Create a recoverable ECDSA signature. foreign import ccall safe "secp256k1.h secp256k1_ecdsa_sign_recoverable" ecdsaSignRecoverable :: - -- Args: ctx: pointer to a context object, initialized for signing (cannot be NULL) + -- | pointer to a context object, initialized for signing (cannot be NULL) Ctx -> - -- Out: sig: pointer to an array where the signature will be placed (cannot be NULL) + -- | __Output:__ pointer to an array where the signature will be placed (cannot be NULL) Ptr RecSig65 -> - -- In: msghash32: the 32-byte message hash being signed (cannot be NULL) + -- | __Input:__ the 32-byte message hash being signed (cannot be NULL) Ptr Msg32 -> - -- seckey: pointer to a 32-byte secret key (cannot be NULL) + -- | __Input:__ pointer to a 32-byte secret key (cannot be NULL) Ptr Seckey32 -> - -- noncefp: pointer to a nonce generation function. If NULL, 'nonceFunctionDefault' is used + -- | __Input:__ pointer to a nonce generation function. If NULL, 'nonceFunctionDefault' is used FunPtr (NonceFun a) -> - -- ndata: pointer to arbitrary data used by the nonce generation function (can be NULL) + -- | __Input:__ pointer to arbitrary data used by the nonce generation function (can be NULL) Ptr a -> - -- Returns: 1: signature created - -- 0: the nonce generation function failed, or the secret key was invalid. + -- | __Returns:__ 1: signature created + -- 0: the nonce generation function failed, or the secret key was invalid. IO Ret @@ -618,7 +730,7 @@ -- | __Output:__ a pointer to a signature object Ptr Sig64 -> -- | __Input:__ a pointer to the 64-byte array to parse - Ptr Compact64 -> + Ptr (Bytes 64) -> -- | __Returns:__ 1 when the signature could be parsed, 0 otherwise. IO Ret @@ -653,7 +765,7 @@ -- | __Input:__ a secp256k1 context object Ctx -> -- | __Output:__ a pointer to a 64-byte array to store the compact serialization - Ptr Compact64 -> + Ptr (Bytes 64) -> -- | __Input:__ a pointer to an initialized signature object Ptr Sig64 -> -- | __Returns:__ 1 @@ -774,7 +886,7 @@ Ptr Pubkey64 -> -- | __Input:__ 'compressed' if serialization should be in -- compressed format, otherwise 'uncompressed'. - SerFlags -> + CompressionFlags -> -- Returns: 1 always. IO Ret @@ -933,22 +1045,21 @@ -- -- This is the same as calling 'keypairPub' and then -- 'xonlyPubkeyFromPubkey'. --- --- Returns: 0 if the arguments are invalid. 1 otherwise. --- Args: ctx: pointer to a context object (cannot be NULL) --- Out: pubkey: pointer to an xonly_pubkey object. If 1 is returned, it is set --- to the keypair public key after converting it to an --- xonly_pubkey. If not, it's set to an invalid value (cannot be --- NULL). --- pk_parity: pointer to an integer that will be set to the pk_parity --- argument of 'xonlyPubkeyFromPubkey' (can be NULL). --- In: keypair: pointer to a keypair (cannot be NULL) foreign import ccall safe "secp256k1.h secp256k1_keypair_xonly_pub" keypairXonlyPub :: + -- | pointer to a context object (cannot be NULL) Ctx -> + -- | __Output:__ pointer to an xonly_pubkey object. If 1 is returned, it is set + -- to the keypair public key after converting it to an + -- xonly_pubkey. If not, it's set to an invalid value (cannot be + -- NULL). Ptr XonlyPubkey64 -> + -- pk_parity: pointer to an integer that will be set to the pk_parity + -- argument of 'xonlyPubkeyFromPubkey' (can be NULL). Ptr CInt -> + -- In: keypair: pointer to a keypair (cannot be NULL) Ptr Keypair96 -> + -- Returns: 0 if the arguments are invalid. 1 otherwise. IO Ret @@ -958,25 +1069,20 @@ -- Calling this function and then 'keypairPub' results in the same -- public key as calling 'keypairXonlyPub' and then -- 'xonlyPubkeyTweakAdd'. --- --- Returns: 0 if the arguments are invalid or the resulting keypair would be --- invalid (only when the tweak is the negation of the keypair's --- secret key). 1 otherwise. --- --- Args: ctx: pointer to a context object initialized for verification --- (cannot be NULL) --- In/Out: keypair: pointer to a keypair to apply the tweak to. Will be set to --- an invalid value if this function returns 0 (cannot be --- NULL). --- In: tweak32: pointer to a 32-byte tweak. If the tweak is invalid according --- to 'ecSeckeyVerify', this function returns 0. For --- uniformly random 32-byte arrays the chance of being invalid --- is negligible (around 1 in 2^128) (cannot be NULL). foreign import ccall safe "secp256k1.h secp256k1_keypair_xonly_tweak_add" keypairXonlyTweakAdd :: + -- | pointer to a context object initialized for verification + -- (cannot be NULL) Ctx -> + -- | __Mutates:__ pointer to a keypair to apply the tweak to. Will be set to + -- an invalid value if this function returns 0 (cannot be NULL). Ptr Keypair96 -> + -- | __Input:__ pointer to a 32-byte tweak. If the tweak is invalid according + -- to 'ecSeckeyVerify', this function returns 0. For uniformly random 32-byte + -- arrays the chance of being invalid is negligible (around 1 in 2^128) (cannot be NULL). Ptr Tweak32 -> + -- | __Returns:__ 0 if the arguments are invalid or the resulting keypair would be + -- invalid (only when the tweak is the negation of the keypair's secret key). 1 otherwise. IO Ret @@ -1047,10 +1153,7 @@ Ptr (Bytes n) -> -- | __Input:__ length of the message CSize -> - -- | __Input:__ 32 bytes of fresh randomness. While recommended to provide - -- this, it is only supplemental to security and can be NULL. See - -- BIP-340 "Default Signing" for a full explanation of this - -- argument and for guidance if randomness is expensive. + -- | __Input:__ pointer to an initialized keypair (cannot be NULL) Ptr Keypair96 -> -- | __Input:__ pointer to a extraparams object (can be NULL) Ptr SchnorrExtra -> @@ -1060,7 +1163,7 @@ -- | Verify a Schnorr signature. foreign import ccall safe "secp256k1.h secp256k1_schnorrsig_verify" - schnorrSigSignVerify :: + schnorrsigSignVerify :: -- | a secp256k1 context object, initialized for verification. Ctx -> -- | __Input:__ pointer to the 64-byte signature to verify (cannot be NULL) @@ -1126,7 +1229,7 @@ -- | __Output:__ pointer to an x-only public key object for placing the -- converted public key (cannot be NULL) Ptr XonlyPubkey64 -> - -- __Mutates:__ pointer to an integer that will be set to 1 if the point + -- __Output:__ pointer to an integer that will be set to 1 if the point -- encoded by xonly_pubkey is the negation of the pubkey and -- set to 0 otherwise. (can be NULL) Ptr CInt -> @@ -1199,7 +1302,7 @@ -- | Checks that a tweaked pubkey is the result of calling --- 'xonlyPubkeyTweakAdd' with internal_pubkey and tweak32. +-- 'xonlyPubkeyTweakAdd' with the pubkey and tweak. -- -- The tweaked pubkey is represented by its 32-byte x-only serialization and -- its pk_parity, which can both be obtained by converting the result of @@ -1214,11 +1317,11 @@ -- (cannot be NULL) Ctx -> -- | __Input:__ pointer to a serialized xonly_pubkey (cannot be NULL) - Ptr (Bytes 32) -> + Ptr XonlyPubkey64 -> -- | __Input:__ the parity of the tweaked pubkey (whose serialization -- is passed in as tweaked_pubkey32). This must match the -- pk_parity value that is returned when calling - -- 'XonlyPubkey64' with the tweaked pubkey, or + -- 'xonlyPubkey' with the tweaked pubkey, or -- this function will fail. CInt -> -- | __Input__ pointer to an x-only public key object to apply the @@ -1293,7 +1396,6 @@ data Msg32 data RecSig65 data Sig64 -data Compact64 data Seed32 data Seckey32 data Tweak32