Introduced SchnorrSignature type with parsing and serialization functions.

resolves #8

Author: prolic

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
@@ -283,6 +286,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 +518,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,7 +744,7 @@ 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
@@ -713,17 +755,17 @@ schnorrSign KeyPair{..} bs
             -- 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
+                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

@@ -333,11 +333,21 @@ prop_derivedCompositeReadShowInvertTweak = derivedCompositeReadShowInvertTemplat
 
 
 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 = derivedCompositeReadShowInvertTemplate schnorrSignGen
+    where
+        schnorrSignGen = do
+            sk <- secKeyGen
+            msg <- bytes (singleton 32)
+            maybe empty pure $ schnorrSign (keyPairCreate sk) msg
 
 
 prop_derivedCompositeReadShowInvertRecoverableSignature :: Property
@@ -355,5 +365,40 @@ 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 = 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 $ schnorrSign 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 $ schnorrSign kp msg
+    sig2 <- maybe failure pure $ schnorrSign kp msg
+    sig1 === sig2
+
+
 tests :: Group
-tests = $$discover
+tests = $$discover