diff --git a/libsecp256k1.cabal b/libsecp256k1.cabal index a14ac14..06ea1e6 100644 --- a/libsecp256k1.cabal +++ b/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 @@ -79,5 +80,6 @@ test-suite spec , 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/package.yaml b/package.yaml index 5d82d92..1ee59f8 100644 --- a/package.yaml +++ b/package.yaml @@ -21,6 +21,7 @@ dependencies: - 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-extensions: - ImportQualifiedPost diff --git a/src/Crypto/Secp256k1.hs b/src/Crypto/Secp256k1.hs index 7346308..878f9e9 100644 --- a/src/Crypto/Secp256k1.hs +++ b/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 @@ -73,6 +76,8 @@ module Crypto.Secp256k1 ( -- * Schnorr Operations schnorrSign, + schnorrSignDeterministic, + schnorrSignNondeterministic, schnorrVerify, -- * Other @@ -140,6 +145,7 @@ import Foreign.Storable (Storable (..)) 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 @@ 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 +521,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 @@ -700,30 +745,47 @@ keyPairPubKeyXOTweakAdd KeyPair{..} Tweak{..} = unsafePerformIO . evalContT $ do 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 index 231cf3d..7819f10 100644 --- a/test/Crypto/Secp256k1Prop.hs +++ b/test/Crypto/Secp256k1Prop.hs @@ -5,6 +5,7 @@ module Crypto.Secp256k1Prop where 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 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,9 +262,17 @@ prop_schnorrSignaturesProducedAreValid = property $ do 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 @@ -297,9 +307,18 @@ prop_schnorrSignaturesUnforgeable = property $ do 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,11 +352,27 @@ 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 = 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 @@ -355,5 +390,61 @@ 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 $ 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 -tests = $$discover \ No newline at end of file +tests = $$discover