libsecp256k1 0.1.4 → 0.1.5
raw patch · 4 files changed
+136/−36 lines, 4 filesdep +hspec-apidep ~hedgehog
Dependencies added: hspec-api
Dependency ranges changed: hedgehog
Files
- libsecp256k1.cabal +4/−3
- src/Crypto/Secp256k1.hs +47/−26
- test/Crypto/Secp256k1Prop.hs +83/−5
- test/Main.hs +2/−2
libsecp256k1.cabal view
@@ -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
src/Crypto/Secp256k1.hs view
@@ -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
test/Crypto/Secp256k1Prop.hs view
@@ -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
test/Main.hs view
@@ -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 ]