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.1.4 +version: 0.1.5 synopsis: Bindings for secp256k1 description: Sign and verify signatures using the secp256k1 library. category: Crypto @@ -45,7 +45,7 @@ , deepseq >=1.4.8 && <1.5 , entropy >=0.3.8 && <0.5 , hashable >=1.4.2 && <1.5 - , hedgehog ==1.2.* + , hedgehog >=1.2 && <1.5 , memory >=0.14.15 && <1.0 , transformers >=0.4.0.0 && <1.0 default-language: Haskell2010 @@ -73,8 +73,9 @@ , either , entropy >=0.3.8 && <0.5 , hashable >=1.4.2 && <1.5 - , hedgehog ==1.2.* + , hedgehog >=1.2 && <1.5 , hspec + , hspec-api , libsecp256k1 , memory >=0.14.15 && <1.0 , monad-par diff --git a/src/Crypto/Secp256k1.hs b/src/Crypto/Secp256k1.hs --- a/src/Crypto/Secp256k1.hs +++ b/src/Crypto/Secp256k1.hs @@ -93,6 +93,7 @@ import Data.ByteString qualified as BS import Data.ByteString.Char8 qualified as B8 import Data.ByteString.Unsafe (unsafePackCStringLen, unsafePackMallocCStringLen) +import Data.Char (isAlphaNum, isSpace) import Data.Foldable (for_) import Data.Functor (($>)) import Data.Hashable (Hashable (..)) @@ -152,17 +153,15 @@ instance Show SecKey where - show SecKey{..} = unsafePerformIO . evalContT $ do - secKeyPtr <- ContT (withForeignPtr secKeyFPtr) - -- avoid allocating a new bytestring because we are only reading from this pointer - bs <- lift (Data.ByteString.Unsafe.unsafePackCStringLen (castPtr secKeyPtr, 32)) - pure $ "0x" <> B8.unpack (BA.convertToBase BA.Base16 bs) + show sk = B8.unpack $ encodeBase16 $ exportSecKey sk instance Read SecKey where - readsPrec i s = case s of - ('0' : 'x' : cs) -> case decodeBase16 $ B8.pack (Prelude.take 64 cs) of - Left e -> [] - Right a -> maybeToList $ (,Prelude.drop 64 cs) <$> importSecKey a - _ -> [] + readsPrec i cs = case decodeBase16 . B8.pack $ pre of + Left e -> [] + Right a -> case importSecKey a of + Nothing -> [] + Just x -> [(x, suf)] + where + (pre, suf) = Prelude.splitAt 64 (dropWhile isSpace cs) instance Eq SecKey where sk == sk' = unsafePerformIO . evalContT $ do skp <- ContT $ withForeignPtr (secKeyFPtr sk) @@ -184,16 +183,15 @@ instance Show PubKeyXY where - show pk = "0x" <> B8.unpack (BA.convertToBase BA.Base16 (exportPubKeyXY True pk)) + show pk = B8.unpack (encodeBase16 (exportPubKeyXY True pk)) instance Read PubKeyXY where - readsPrec i s = case s of - ('0' : 'x' : cs) -> maybeToList $ case cs of - ('0' : '2' : _) -> parseNextN 66 cs - ('0' : '3' : _) -> parseNextN 66 cs - ('0' : '4' : _) -> parseNextN 130 cs - _ -> Nothing - _ -> [] + readsPrec i cs = maybeToList $ case trimmed of + ('0' : '2' : _) -> parseNextN 66 trimmed + ('0' : '3' : _) -> parseNextN 66 trimmed + ('0' : '4' : _) -> parseNextN 130 trimmed + _ -> Nothing where + trimmed = dropWhile isSpace cs hush x = case x of Left _ -> Nothing Right a -> Just a @@ -223,13 +221,14 @@ instance Show PubKeyXO where - show pk = "0x" <> B8.unpack (BA.convertToBase BA.Base16 (exportPubKeyXO pk)) + show pk = B8.unpack (encodeBase16 (exportPubKeyXO pk)) instance Read PubKeyXO where - readsPrec i s = case s of - ('0' : 'x' : bytes) -> case decodeBase16 $ B8.pack (Prelude.take 64 bytes) of - Left e -> [] - Right a -> maybeToList $ (,Prelude.drop 64 bytes) <$> importPubKeyXO a - _ -> [] + readsPrec i s = case decodeBase16 . B8.pack $ pre of + Left e -> error s + Right a -> maybeToList $ (,suf) <$> importPubKeyXO a + where + trimmed = dropWhile isSpace s + (pre, suf) = Prelude.splitAt 64 trimmed instance Eq PubKeyXO where pk == pk' = unsafePerformIO . evalContT $ do pkp <- ContT . withForeignPtr . pubKeyXOFPtr $ pk @@ -266,7 +265,14 @@ instance Show Signature where - show sig = "0x" <> (B8.unpack . encodeBase16) (exportSignatureCompact sig) + show sig = (B8.unpack . encodeBase16) (exportSignatureCompact sig) +instance Read Signature where + readsPrec i cs = case decodeBase16 $ B8.pack token of + Left e -> [] + Right a -> maybeToList $ (,rest) <$> importSignature a + where + trimmed = dropWhile isSpace cs + (token, rest) = span isAlphaNum trimmed instance Eq Signature where sig == sig' = unsafePerformIO . evalContT $ do sigp <- ContT $ withForeignPtr (signatureFPtr sig) @@ -281,7 +287,14 @@ instance Show RecoverableSignature where - show recSig = "0x" <> (B8.unpack . encodeBase16) (exportRecoverableSignature recSig) + show recSig = (B8.unpack . encodeBase16) (exportRecoverableSignature recSig) +instance Read RecoverableSignature where + readsPrec i cs = case decodeBase16 $ B8.pack token of + Left e -> error . show $ trimmed + Right a -> maybeToList $ (,rest) <$> importRecoverableSignature a + where + trimmed = dropWhile isSpace cs + (token, rest) = span isAlphaNum trimmed instance Eq RecoverableSignature where rs == rs' = unsafePerformIO . evalContT $ do rsp <- ContT $ withForeignPtr (recoverableSignatureFPtr rs) @@ -297,6 +310,14 @@ instance Show Tweak where show (Tweak fptr) = show (SecKey $ castForeignPtr fptr) +instance Read Tweak where + readsPrec i cs = case decodeBase16 . B8.pack $ pre of + Left e -> [] + Right a -> case importTweak a of + Nothing -> [] + Just x -> [(x, suf)] + where + (pre, suf) = Prelude.splitAt 64 (dropWhile isSpace cs) instance Eq Tweak where diff --git a/test/Crypto/Secp256k1Prop.hs b/test/Crypto/Secp256k1Prop.hs --- a/test/Crypto/Secp256k1Prop.hs +++ b/test/Crypto/Secp256k1Prop.hs @@ -3,7 +3,9 @@ module Crypto.Secp256k1Prop where +import Control.Applicative (Applicative (liftA2), empty) import Control.Monad (when) +import Control.Monad.Trans.Class (lift) import Crypto.Secp256k1 import Crypto.Secp256k1.Gen import Data.ByteArray.Sized (sizedByteArray) @@ -11,7 +13,7 @@ import Data.Maybe (fromJust, isJust) import Data.Void import Hedgehog -import Hedgehog.Gen hiding (discard, maybe) +import Hedgehog.Gen hiding (discard, maybe, prune) import Hedgehog.Range (linear, singleton) import Text.Read (readMaybe) @@ -99,12 +101,22 @@ Just pk -> exportPubKeyXO pk === bs +prop_signatureReadInvertsShow :: Property +prop_signatureReadInvertsShow = property $ do + sk <- forAll secKeyGen + bs <- forAll (bytes $ singleton 32) + sig <- maybe failure pure $ ecdsaSign sk bs + case readMaybe (show sig) of + Nothing -> failure + Just x -> sig === x + + prop_signatureParseInvertsSerialize :: Property prop_signatureParseInvertsSerialize = property $ do sk <- forAll secKeyGen bs <- forAll $ bytes (singleton 32) - sig <- maybe failure pure (ecdsaSign sk bs) + sig <- maybe failure pure $ ecdsaSign sk bs exportDer <- forAll $ element [False, True] let export = if exportDer then exportSignatureDer else exportSignatureCompact @@ -116,6 +128,17 @@ Just x -> x === sig +prop_recoverableSignatureReadInvertsShow :: Property +prop_recoverableSignatureReadInvertsShow = property $ do + sk <- forAll secKeyGen + bs <- forAll $ bytes (singleton 32) + recSig <- maybe failure pure $ ecdsaSignRecoverable sk bs + let export = exportRecoverableSignature recSig + case importRecoverableSignature export of + Nothing -> failure + Just x -> x === recSig + + prop_recoverableSignatureParseInvertsSerialize :: Property prop_recoverableSignatureParseInvertsSerialize = property $ do sk <- forAll secKeyGen @@ -141,7 +164,8 @@ prop_ecdsaSignaturesProducedAreValid = property $ do sk <- forAll secKeyGen msg <- forAll $ bytes (singleton 32) - case ecdsaSign sk msg of + let sig = ecdsaSign sk msg + case sig of Nothing -> failure Just sig -> assert $ ecdsaVerify msg (derivePubKey sk) sig @@ -159,7 +183,7 @@ prop_ecdsaSignatureValidityPreservedOverSerialization = property $ do sk <- forAll secKeyGen msg <- forAll $ bytes (singleton 32) - let sig = fromJust $ ecdsaSign sk msg + sig <- maybe failure pure $ ecdsaSign sk msg useDer <- forAll enumBounded let export = if useDer @@ -260,7 +284,8 @@ pk <- forAll pubKeyXYGen when (pk == derivePubKey sk) discard msg <- forAll $ bytes (singleton 32) - case ecdsaSign sk msg of + let sig = ecdsaSign sk msg + case sig of Nothing -> failure Just sig -> assert . not $ ecdsaVerify msg pk sig @@ -274,6 +299,59 @@ case schnorrSign kp msg of Nothing -> failure Just sig -> assert . not $ schnorrVerify pk msg sig + + +newtype Wrapped a = Wrapped {secKey :: a} deriving (Show, Read, Eq) + + +derivedCompositeReadShowInvertTemplate :: (Eq a, Read a, Show a) => Gen a -> Property +derivedCompositeReadShowInvertTemplate gen = property $ do + a <- forAll gen + annotateShow a + annotateShow (length $ show a) + annotateShow (Wrapped a) + case readMaybe (show (Wrapped a)) of + Nothing -> failure + Just x -> x === Wrapped a + + +prop_derivedCompositeReadShowInvertSecKey :: Property +prop_derivedCompositeReadShowInvertSecKey = derivedCompositeReadShowInvertTemplate secKeyGen + + +prop_derivedCompositeReadShowInvertPubKeyXY :: Property +prop_derivedCompositeReadShowInvertPubKeyXY = derivedCompositeReadShowInvertTemplate pubKeyXYGen + + +prop_derivedCompositeReadShowInvertPubKeyXO :: Property +prop_derivedCompositeReadShowInvertPubKeyXO = derivedCompositeReadShowInvertTemplate pubKeyXOGen + + +prop_derivedCompositeReadShowInvertTweak :: Property +prop_derivedCompositeReadShowInvertTweak = derivedCompositeReadShowInvertTemplate tweakGen + + +prop_derivedCompositeReadShowInvertSignature :: Property +prop_derivedCompositeReadShowInvertSignature = derivedCompositeReadShowInvertTemplate $ choice [ecdsa, schnorr] + where + base = liftA2 (,) secKeyGen (bytes (singleton 32)) + ecdsa = base >>= maybe empty pure . uncurry ecdsaSign + schnorr = base >>= maybe empty pure . uncurry (schnorrSign . keyPairCreate) + + +prop_derivedCompositeReadShowInvertRecoverableSignature :: Property +prop_derivedCompositeReadShowInvertRecoverableSignature = derivedCompositeReadShowInvertTemplate $ do + sk <- secKeyGen + msg <- bytes (singleton 32) + maybe empty pure $ ecdsaSignRecoverable sk msg + + +prop_eqImportImpliesEqSecKey :: Property +prop_eqImportImpliesEqSecKey = property $ do + bs <- forAll $ bytes $ singleton 32 + k0 <- maybe discard pure $ importSecKey bs + k1 <- maybe discard pure $ importSecKey bs + k0 === k1 tests :: Group diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -6,14 +6,14 @@ import Hedgehog (checkSequential) import Hedgehog.Main import Spec qualified -import Test.Hspec.Formatters +import Test.Hspec.Api.Formatters.V1 import Test.Hspec.Runner (Config (..), defaultConfig, hspecWith) main :: IO () main = do setLocaleEncoding utf8 - hspecWith defaultConfig{configFormatter = Just progress} Spec.spec + hspecWith (useFormatter ("progress", progress) defaultConfig) Spec.spec defaultMain [ checkSequential Secp256k1Prop.tests ]