- Add randomness to Schnorr signatures for BIP340 compliance.

- Updated schnorrSign to produce non-deterministic signatures using randomness.
- Introduced SchnorrSignature type with parsing and serialization functions.
- Updated tests and added random package dependency.

Author: prolic

libsecp256k1.cabal

@@ -47,6 +47,7 @@ library
     , 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
 

src/Crypto/Secp256k1.hs

@@ -25,6 +25,7 @@ module Crypto.Secp256k1 (
     KeyPair,
     Signature,
     RecoverableSignature,
+    SchnorrSignature,
     Tweak,
 
     -- * Parsing and Serialization
@@ -40,6 +41,8 @@ module Crypto.Secp256k1 (
     exportSignatureDer,
     importRecoverableSignature,
     exportRecoverableSignature,
+    importSchnorrSignature,
+    exportSchnorrSignature,
     importTweak,
 
     -- * ECDSA Operations
@@ -89,7 +92,7 @@ import Crypto.Secp256k1.Internal
 import Crypto.Secp256k1.Prim (flagsEcUncompressed)
 import Crypto.Secp256k1.Prim qualified as Prim
 import Data.ByteArray.Encoding qualified as BA
-import Data.ByteArray.Sized
+import Data.ByteArray.Sized hiding (take)
 import Data.ByteString (ByteString)
 import Data.ByteString qualified as BS
 import Data.ByteString.Char8 qualified as B8
@@ -140,6 +143,7 @@ import Foreign.Storable (Storable (..))
 import GHC.Generics (Generic)
 import GHC.IO.Handle.Text (memcpy)
 import System.IO.Unsafe (unsafePerformIO)
+import System.Random (newStdGen, randoms)
 import Text.Read (
     Lexeme (String),
     lexP,
@@ -283,6 +287,28 @@ instance NFData Signature where
     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}
 
@@ -493,6 +519,23 @@ exportRecoverableSignature RecoverableSignature{..} = unsafePerformIO . evalCont
         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
@@ -702,28 +745,30 @@ keyPairPubKeyXOTweakAdd KeyPair{..} Tweak{..} = unsafePerformIO . evalContT $ do
 
 -- | 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 -> ByteString -> Maybe SchnorrSignature
 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
+            gen <- newStdGen
+            let randomBytes = BS.pack $ take 32 $ randoms gen
+            BS.useAsCStringLen randomBytes $ \(randomPtr, _) -> do
+                ret <- Prim.schnorrsigSign ctx sigBuf msgHashPtr keyPairPtr (castPtr randomPtr)
+                if isSuccess ret
+                    then Just . SchnorrSignature <$> newForeignPtr finalizerFree sigBuf
+                    else free sigBuf $> Nothing
 
 
 -- | 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

test/Crypto/Secp256k1Prop.hs

@@ -129,6 +129,9 @@ prop_signatureParseInvertsSerialize = property $ do
         Just x -> x === sig
 
 
+        
+
+
 prop_recoverableSignatureReadInvertsShow :: Property
 prop_recoverableSignatureReadInvertsShow = property $ do
     sk <- forAll secKeyGen
@@ -333,11 +336,21 @@ prop_derivedCompositeReadShowInvertTweak = derivedCompositeReadShowInvertTemplat
 
 
 prop_derivedCompositeReadShowInvertSignature :: Property
-prop_derivedCompositeReadShowInvertSignature = derivedCompositeReadShowInvertTemplate $ choice [ecdsa, schnorr]
+prop_derivedCompositeReadShowInvertSignature = derivedCompositeReadShowInvertTemplate ecdsaSignGen
+    where
+        ecdsaSignGen = do
+            sk <- secKeyGen
+            msg <- bytes (singleton 32)
+            maybe empty pure $ ecdsaSign sk msg
+
+
+prop_derivedCompositeReadShowInvertSchnorrSignature :: Property
+prop_derivedCompositeReadShowInvertSchnorrSignature = derivedCompositeReadShowInvertTemplate schnorrSignGen
     where
-        base = liftA2 (,) secKeyGen (bytes (singleton 32))
-        ecdsa = base >>= maybe empty pure . uncurry ecdsaSign
-        schnorr = base >>= maybe empty pure . uncurry (schnorrSign . keyPairCreate)
+        schnorrSignGen = do
+            sk <- secKeyGen
+            msg <- bytes (singleton 32)
+            maybe empty pure $ schnorrSign (keyPairCreate sk) msg
 
 
 prop_derivedCompositeReadShowInvertRecoverableSignature :: Property
@@ -355,5 +368,39 @@ prop_eqImportImpliesEqSecKey = property $ do
     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 $ schnorrSign kp msg
+    let serialized = exportSchnorrSignature sig
+    annotateShow serialized
+    annotateShow (BS.length serialized)
+    let parsed = fromJust $ importSchnorrSignature serialized
+    parsed === sig
+
+
+prop_schnorrSignatureValidityPreservedOverSerialization :: Property
+prop_schnorrSignatureValidityPreservedOverSerialization = property $ do
+    sk <- forAll secKeyGen
+    msg <- forAll $ bytes (singleton 32)
+    let kp = keyPairCreate sk
+    sig <- maybe failure pure $ schnorrSign kp msg
+    let serialized = exportSchnorrSignature sig
+    let parsed = fromJust $ importSchnorrSignature serialized
+    assert $ schnorrVerify (fst $ keyPairPubKeyXO kp) msg parsed
+
+
+prop_schnorrSignatureNonDeterministic :: Property
+prop_schnorrSignatureNonDeterministic = property $ do
+    sk <- forAll secKeyGen
+    msg <- forAll $ bytes (singleton 32)
+    let kp = keyPairCreate sk
+    sig1 <- maybe failure pure $ schnorrSign kp msg
+    sig2 <- maybe failure pure $ schnorrSign kp msg
+    sig1 /== sig2
+
+
 tests :: Group
-tests = $$discover
+tests = $$discover