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.2.1 +version: 0.3.0 synopsis: Bindings for secp256k1 description: Sign and verify signatures using the secp256k1 library. category: Crypto @@ -47,6 +47,7 @@ , hashable >=1.4.2 && <1.5 , hedgehog >=1.2 && <1.5 , memory >=0.14.15 && <1.0 + , random >=1.2.1.2 && <1.3 , transformers >=0.4.0.0 && <1.0 default-language: Haskell2010 @@ -79,5 +80,6 @@ , libsecp256k1 , memory >=0.14.15 && <1.0 , monad-par + , random >=1.2.1.2 && <1.3 , transformers >=0.4.0.0 && <1.0 default-language: Haskell2010 diff --git a/src/Crypto/Secp256k1.hs b/src/Crypto/Secp256k1.hs --- a/src/Crypto/Secp256k1.hs +++ b/src/Crypto/Secp256k1.hs @@ -25,6 +25,7 @@ KeyPair, Signature, RecoverableSignature, + SchnorrSignature, Tweak, -- * Parsing and Serialization @@ -40,6 +41,8 @@ exportSignatureDer, importRecoverableSignature, exportRecoverableSignature, + importSchnorrSignature, + exportSchnorrSignature, importTweak, -- * ECDSA Operations @@ -73,6 +76,8 @@ -- * Schnorr Operations schnorrSign, + schnorrSignDeterministic, + schnorrSignNondeterministic, schnorrVerify, -- * Other @@ -140,6 +145,7 @@ import GHC.Generics (Generic) import GHC.IO.Handle.Text (memcpy) import System.IO.Unsafe (unsafePerformIO) +import System.Random (StdGen, newStdGen, randoms, randomIO) import Text.Read ( Lexeme (String), lexP, @@ -283,6 +289,28 @@ rnf Signature{..} = seq signatureFPtr () +-- | Structure containing Schnorr Signature +newtype SchnorrSignature = SchnorrSignature {schnorrSignatureFPtr :: ForeignPtr Prim.Sig64} + + +instance Show SchnorrSignature where + show sig = (B8.unpack . encodeBase16) (exportSchnorrSignature sig) +instance Read SchnorrSignature where + readsPrec i cs = case decodeBase16 $ B8.pack token of + Left e -> [] + Right a -> maybeToList $ (,rest) <$> importSchnorrSignature a + where + trimmed = dropWhile isSpace cs + (token, rest) = span isAlphaNum trimmed +instance Eq SchnorrSignature where + sig == sig' = unsafePerformIO . evalContT $ do + sigp <- ContT $ withForeignPtr (schnorrSignatureFPtr sig) + sigp' <- ContT $ withForeignPtr (schnorrSignatureFPtr sig') + (EQ ==) <$> lift (memCompare (castPtr sigp) (castPtr sigp') 64) +instance NFData SchnorrSignature where + rnf SchnorrSignature{..} = seq schnorrSignatureFPtr () + + -- | Structure containing Signature AND recovery ID newtype RecoverableSignature = RecoverableSignature {recoverableSignatureFPtr :: ForeignPtr Prim.RecSig65} @@ -417,15 +445,16 @@ -- | Parses 'Signature' from Compact (64 bytes) representation. importSignatureCompact :: ByteString -> Maybe Signature -importSignatureCompact bs = unsafePerformIO $ - unsafeUseByteString bs $ \(inBuf, len) -> do +importSignatureCompact bs = unsafePerformIO + $ unsafeUseByteString bs + $ \(inBuf, len) -> do outBuf <- mallocBytes 64 ret <- if len == 64 - -- compact - then Prim.ecdsaSignatureParseCompact ctx outBuf inBuf - -- invalid - else pure 0 + then -- compact + Prim.ecdsaSignatureParseCompact ctx outBuf inBuf + else -- invalid + pure 0 if isSuccess ret then Just . Signature <$> newForeignPtr finalizerFree outBuf else free outBuf $> Nothing @@ -433,8 +462,9 @@ -- | Parses 'Signature' from DER representation. importSignatureDer :: ByteString -> Maybe Signature -importSignatureDer bs = unsafePerformIO $ - unsafeUseByteString bs $ \(inBuf, len) -> do +importSignatureDer bs = unsafePerformIO + $ unsafeUseByteString bs + $ \(inBuf, len) -> do outBuf <- mallocBytes 64 ret <- Prim.ecdsaSignatureParseDer ctx outBuf inBuf len if isSuccess ret @@ -474,8 +504,8 @@ recId <- lift (peekByteOff @Word8 ptr 64) let recIdCInt = fromIntegral recId ret <- lift (Prim.ecdsaRecoverableSignatureParseCompact ctx outBuf ptr recIdCInt) - lift $ - if isSuccess ret + lift + $ if isSuccess ret then Just . RecoverableSignature <$> newForeignPtr finalizerFree outBuf else free outBuf $> Nothing @@ -493,6 +523,23 @@ unsafePackByteString (outBuf, 65) +-- | Parses 'SchnorrSignature' from Schnorr (64 byte) representation +importSchnorrSignature :: ByteString -> Maybe SchnorrSignature +importSchnorrSignature bs + | BS.length bs /= 64 = Nothing + | otherwise = unsafePerformIO $ do + outBuf <- mallocBytes 64 + unsafeUseByteString bs $ \(ptr, _) -> do + memcpy outBuf ptr 64 + Just . SchnorrSignature <$> newForeignPtr finalizerFree outBuf + + +-- | Serializes 'SchnorrSignature' to Schnorr (64 byte) representation +exportSchnorrSignature :: SchnorrSignature -> ByteString +exportSchnorrSignature (SchnorrSignature fptr) = unsafePerformIO $ + withForeignPtr fptr $ \ptr -> BS.packCStringLen (castPtr ptr, 64) + + -- | 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 @@ -500,8 +547,9 @@ -- | Verify message signature. 'True' means that the signature is correct. ecdsaVerify :: ByteString -> PubKeyXY -> Signature -> Bool -ecdsaVerify msgHash (PubKeyXY pkFPtr) (Signature sigFPtr) = unsafePerformIO $ - evalContT $ do +ecdsaVerify msgHash (PubKeyXY pkFPtr) (Signature sigFPtr) = unsafePerformIO + $ evalContT + $ do pkPtr <- ContT (withForeignPtr pkFPtr) sigPtr <- ContT (withForeignPtr sigFPtr) (msgHashPtr, n) <- ContT (unsafeUseByteString msgHash) @@ -610,8 +658,8 @@ lift (memcpy skOut skPtr 32) twkPtr <- ContT (withForeignPtr tweakFPtr) ret <- lift (Prim.ecSeckeyTweakAdd ctx skOut twkPtr) - lift $ - if isSuccess ret + lift + $ if isSuccess ret then Just . SecKey <$> newForeignPtr finalizerFree skOut else free skOut $> Nothing @@ -624,8 +672,8 @@ lift (memcpy skOut skPtr 32) twkPtr <- ContT (withForeignPtr tweakFPtr) ret <- lift (Prim.ecSeckeyTweakMul ctx skOut twkPtr) - lift $ - if isSuccess ret + lift + $ if isSuccess ret then Just . SecKey <$> newForeignPtr finalizerFree skOut else free skOut $> Nothing @@ -700,30 +748,47 @@ else free keyPairOut $> 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 +-- | Compute a schnorr signature using a 'KeyPair'. The @ByteString@ must be 32 bytes long to get +-- a @Just@ out of this function. Optionally takes a 'StdGen' for deterministic signing. +schnorrSign :: Maybe StdGen -> KeyPair -> ByteString -> Maybe SchnorrSignature +schnorrSign mGen 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 + ret <- case mGen of + Just gen -> do + let randomBytes = BS.pack $ Prelude.take 32 $ randoms gen + BS.useAsCStringLen randomBytes $ \(ptr, _) -> + Prim.schnorrsigSign ctx sigBuf msgHashPtr keyPairPtr (castPtr ptr) + Nothing -> + Prim.schnorrsigSign ctx sigBuf msgHashPtr keyPairPtr nullPtr if isSuccess ret - then Just . Signature <$> newForeignPtr finalizerFree sigBuf - else free sigBuf $> Nothing + then Just . SchnorrSignature <$> newForeignPtr finalizerFree sigBuf + else do + free sigBuf + return Nothing +-- | Compute a deterministic schnorr signature using a 'KeyPair'. +schnorrSignDeterministic :: KeyPair -> ByteString -> Maybe SchnorrSignature +schnorrSignDeterministic = schnorrSign Nothing + + +-- | Compute a non-deterministic schnorr signature using a 'KeyPair'. +schnorrSignNondeterministic :: KeyPair -> ByteString -> IO (Maybe SchnorrSignature) +schnorrSignNondeterministic kp bs = newStdGen >>= \gen -> pure $ schnorrSign (Just gen) kp bs + + -- | 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 +schnorrVerify :: PubKeyXO -> ByteString -> SchnorrSignature -> Bool +schnorrVerify PubKeyXO{..} bs SchnorrSignature{..} = unsafePerformIO . evalContT $ do pubKeyPtr <- ContT (withForeignPtr pubKeyXOFPtr) - signaturePtr <- ContT (withForeignPtr signatureFPtr) + schnorrSignaturePtr <- ContT (withForeignPtr schnorrSignatureFPtr) (msgPtr, msgLen) <- ContT (unsafeUseByteString bs) - lift $ isSuccess <$> Prim.schnorrsigSignVerify ctx signaturePtr msgPtr msgLen pubKeyPtr + lift $ isSuccess <$> Prim.schnorrsigSignVerify ctx schnorrSignaturePtr msgPtr msgLen pubKeyPtr -- | Generate a tagged sha256 digest as specified in BIP340 diff --git a/test/Crypto/Secp256k1Prop.hs b/test/Crypto/Secp256k1Prop.hs --- a/test/Crypto/Secp256k1Prop.hs +++ b/test/Crypto/Secp256k1Prop.hs @@ -5,6 +5,7 @@ import Control.Applicative (Applicative (liftA2), empty) import Control.Monad (when) +import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Class (lift) import Crypto.Secp256k1 import Crypto.Secp256k1.Gen @@ -16,6 +17,7 @@ import Hedgehog.Gen hiding (discard, maybe, prune) import Hedgehog.Range (linear, singleton) import Text.Read (readMaybe) +import System.Random (StdGen, mkStdGen) prop_secKeyReadInvertsShow :: Property @@ -260,11 +262,19 @@ sk <- forAll secKeyGen msg <- forAll $ bytes (singleton 32) let kp = keyPairCreate sk - case schnorrSign kp msg of - Nothing -> failure - Just sig -> assert $ schnorrVerify (fst $ keyPairPubKeyXO kp) msg sig + sig <- maybe failure pure $ schnorrSignDeterministic kp msg + assert $ schnorrVerify (fst $ keyPairPubKeyXO kp) msg sig +prop_schnorrSignaturesProducedAreValidNonDeterministic :: Property +prop_schnorrSignaturesProducedAreValidNonDeterministic = property $ do + sk <- forAll secKeyGen + msg <- forAll $ bytes (singleton 32) + let kp = keyPairCreate sk + sig <- liftIO $ maybe (error "Failed to sign") pure =<< schnorrSignNondeterministic kp msg + assert $ schnorrVerify (fst $ keyPairPubKeyXO kp) msg sig + + prop_pubKeyCombineTweakIdentity :: Property prop_pubKeyCombineTweakIdentity = property $ do sk <- forAll secKeyGen @@ -297,11 +307,20 @@ let kp = keyPairCreate sk pk <- forAll pubKeyXOGen msg <- forAll $ bytes (singleton 32) - case schnorrSign kp msg of - Nothing -> failure - Just sig -> assert . not $ schnorrVerify pk msg sig + sig <- maybe failure pure $ schnorrSignDeterministic kp msg + assert . not $ schnorrVerify pk msg sig +prop_schnorrSignaturesUnforgeableNonDeterministic :: Property +prop_schnorrSignaturesUnforgeableNonDeterministic = property $ do + sk <- forAll secKeyGen + let kp = keyPairCreate sk + pk <- forAll pubKeyXOGen + msg <- forAll $ bytes (singleton 32) + sig <- liftIO $ maybe (error "Failed to sign") pure =<< schnorrSignNondeterministic kp msg + assert . not $ schnorrVerify pk msg sig + + newtype Wrapped a = Wrapped {secKey :: a} deriving (Show, Read, Eq) @@ -333,13 +352,29 @@ prop_derivedCompositeReadShowInvertSignature :: Property -prop_derivedCompositeReadShowInvertSignature = derivedCompositeReadShowInvertTemplate $ choice [ecdsa, schnorr] +prop_derivedCompositeReadShowInvertSignature = derivedCompositeReadShowInvertTemplate ecdsaSignGen where - base = liftA2 (,) secKeyGen (bytes (singleton 32)) - ecdsa = base >>= maybe empty pure . uncurry ecdsaSign - schnorr = base >>= maybe empty pure . uncurry (schnorrSign . keyPairCreate) + ecdsaSignGen = do + sk <- secKeyGen + msg <- bytes (singleton 32) + maybe empty pure $ ecdsaSign sk msg +prop_derivedCompositeReadShowInvertSchnorrSignature :: Property +prop_derivedCompositeReadShowInvertSchnorrSignature = property $ do + sk <- forAll secKeyGen + let kp = keyPairCreate sk + msg <- forAll $ bytes (singleton 32) + sig <- maybe failure pure $ schnorrSignDeterministic kp msg + let a = sig + annotateShow a + annotateShow (length $ show a) + annotateShow (Wrapped a) + case readMaybe (show (Wrapped a)) of + Nothing -> failure + Just x -> x === Wrapped a + + prop_derivedCompositeReadShowInvertRecoverableSignature :: Property prop_derivedCompositeReadShowInvertRecoverableSignature = derivedCompositeReadShowInvertTemplate $ do sk <- secKeyGen @@ -353,6 +388,62 @@ k0 <- maybe discard pure $ importSecKey bs k1 <- maybe discard pure $ importSecKey bs k0 === k1 + + +prop_schnorrSignatureParseInvertsSerialize :: Property +prop_schnorrSignatureParseInvertsSerialize = property $ do + sk <- forAll secKeyGen + msg <- forAll $ bytes (singleton 32) + let kp = keyPairCreate sk + sig <- maybe failure pure $ schnorrSignDeterministic kp msg + let serialized = exportSchnorrSignature sig + annotateShow serialized + annotateShow (BS.length serialized) + let parsed = importSchnorrSignature serialized + parsed === Just sig + + +prop_schnorrSignatureValidityPreservedOverSerialization :: Property +prop_schnorrSignatureValidityPreservedOverSerialization = property $ do + sk <- forAll secKeyGen + msg <- forAll $ bytes (singleton 32) + let kp = keyPairCreate sk + sig <- maybe failure pure $ schnorrSignDeterministic kp msg + let serialized = exportSchnorrSignature sig + let parsed = importSchnorrSignature serialized + parsed === Just sig + assert $ schnorrVerify (fst $ keyPairPubKeyXO kp) msg sig + + +prop_schnorrSignatureDeterministic :: Property +prop_schnorrSignatureDeterministic = property $ do + sk <- forAll secKeyGen + msg <- forAll $ bytes (singleton 32) + let kp = keyPairCreate sk + sig1 <- maybe failure pure $ schnorrSignDeterministic kp msg + sig2 <- maybe failure pure $ schnorrSignDeterministic kp msg + sig1 === sig2 + + +prop_schnorrSignatureNonDeterministic :: Property +prop_schnorrSignatureNonDeterministic = property $ do + sk <- forAll secKeyGen + msg <- forAll $ bytes (singleton 32) + let kp = keyPairCreate sk + sig1 <- liftIO $ maybe (error "Failed to sign") pure =<< schnorrSignNondeterministic kp msg + sig2 <- liftIO $ maybe (error "Failed to sign") pure =<< schnorrSignNondeterministic kp msg + sig1 /== sig2 + + +prop_schnorrSignWithStdGen :: Property +prop_schnorrSignWithStdGen = property $ do + sk <- forAll secKeyGen + msg <- forAll $ bytes (singleton 32) + let kp = keyPairCreate sk + stdGen <- forAll $ mkStdGen <$> integral (linear 0 maxBound) + sig1 <- maybe failure pure $ schnorrSign (Just stdGen) kp msg + sig2 <- maybe failure pure $ schnorrSign (Just stdGen) kp msg + sig1 === sig2 tests :: Group