libsecp256k1 0.2.1 → 0.3.0

raw patch · 3 files changed

+197/−39 lines, 3 filesdep +randomPVP ok

version bump matches the API change (PVP)

Dependencies added: random

API changes (from Hackage documentation)

Files

• libsecp256k1.cabal +3/−1
• src/Crypto/Secp256k1.hs +93/−28
• test/Crypto/Secp256k1Prop.hs +101/−10

@@ -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

@@ -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

@@ -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