Skip to content

Commit 36c48c9

Browse files
committed
fixed issues with read/show inversion when types are part of derived instances
1 parent 869372c commit 36c48c9

File tree

7 files changed

+145
-43
lines changed

7 files changed

+145
-43
lines changed

libsecp256k1.cabal

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,7 @@ cabal-version: 1.12
55
-- see: https://github.com/sol/hpack
66

77
name: libsecp256k1
8-
version: 0.1.3
8+
version: 0.1.5
99
synopsis: Bindings for secp256k1
1010
description: Sign and verify signatures using the secp256k1 library.
1111
category: Crypto
@@ -45,7 +45,7 @@ library
4545
, deepseq >=1.4.8 && <1.5
4646
, entropy >=0.3.8 && <0.5
4747
, hashable >=1.4.2 && <1.5
48-
, hedgehog ==1.2.*
48+
, hedgehog >=1.2 && <1.5
4949
, memory >=0.14.15 && <1.0
5050
, transformers >=0.4.0.0 && <1.0
5151
default-language: Haskell2010
@@ -73,8 +73,9 @@ test-suite spec
7373
, either
7474
, entropy >=0.3.8 && <0.5
7575
, hashable >=1.4.2 && <1.5
76-
, hedgehog ==1.2.*
76+
, hedgehog >=1.2 && <1.5
7777
, hspec
78+
, hspec-api
7879
, libsecp256k1
7980
, memory >=0.14.15 && <1.0
8081
, monad-par

package.yaml

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
name: libsecp256k1
2-
version: 0.1.3
2+
version: 0.1.5
33
synopsis: Bindings for secp256k1
44
description: Sign and verify signatures using the secp256k1 library.
55
category: Crypto
@@ -19,7 +19,7 @@ dependencies:
1919
- deepseq >=1.4.8 && <1.5
2020
- entropy >= 0.3.8 && <0.5
2121
- hashable >=1.4.2 && <1.5
22-
- hedgehog >= 1.2 && <1.3
22+
- hedgehog >= 1.2 && <1.5
2323
- memory >= 0.14.15 && <1.0
2424
- transformers >= 0.4.0.0 && <1.0
2525
default-extensions:
@@ -39,6 +39,7 @@ tests:
3939
dependencies:
4040
- either
4141
- hspec
42+
- hspec-api
4243
- libsecp256k1
4344
- monad-par
4445
- HUnit

src/Crypto/Secp256k1.hs

Lines changed: 47 additions & 26 deletions
Original file line numberDiff line numberDiff line change
@@ -93,6 +93,7 @@ import Data.ByteString (ByteString)
9393
import Data.ByteString qualified as BS
9494
import Data.ByteString.Char8 qualified as B8
9595
import Data.ByteString.Unsafe (unsafePackCStringLen, unsafePackMallocCStringLen)
96+
import Data.Char (isAlphaNum, isSpace)
9697
import Data.Foldable (for_)
9798
import Data.Functor (($>))
9899
import Data.Hashable (Hashable (..))
@@ -152,17 +153,15 @@ newtype SecKey = SecKey {secKeyFPtr :: ForeignPtr Prim.Seckey32}
152153

153154

154155
instance Show SecKey where
155-
show SecKey{..} = unsafePerformIO . evalContT $ do
156-
secKeyPtr <- ContT (withForeignPtr secKeyFPtr)
157-
-- avoid allocating a new bytestring because we are only reading from this pointer
158-
bs <- lift (Data.ByteString.Unsafe.unsafePackCStringLen (castPtr secKeyPtr, 32))
159-
pure $ "0x" <> B8.unpack (BA.convertToBase BA.Base16 bs)
156+
show sk = B8.unpack $ encodeBase16 $ exportSecKey sk
160157
instance Read SecKey where
161-
readsPrec i s = case s of
162-
('0' : 'x' : cs) -> case decodeBase16 $ B8.pack (Prelude.take 64 cs) of
163-
Left e -> []
164-
Right a -> maybeToList $ (,Prelude.drop 64 cs) <$> importSecKey a
165-
_ -> []
158+
readsPrec i cs = case decodeBase16 . B8.pack $ pre of
159+
Left e -> []
160+
Right a -> case importSecKey a of
161+
Nothing -> []
162+
Just x -> [(x, suf)]
163+
where
164+
(pre, suf) = Prelude.splitAt 64 (dropWhile isSpace cs)
166165
instance Eq SecKey where
167166
sk == sk' = unsafePerformIO . evalContT $ do
168167
skp <- ContT $ withForeignPtr (secKeyFPtr sk)
@@ -184,16 +183,15 @@ newtype PubKeyXY = PubKeyXY {pubKeyXYFPtr :: ForeignPtr Prim.Pubkey64}
184183

185184

186185
instance Show PubKeyXY where
187-
show pk = "0x" <> B8.unpack (BA.convertToBase BA.Base16 (exportPubKeyXY True pk))
186+
show pk = B8.unpack (encodeBase16 (exportPubKeyXY True pk))
188187
instance Read PubKeyXY where
189-
readsPrec i s = case s of
190-
('0' : 'x' : cs) -> maybeToList $ case cs of
191-
('0' : '2' : _) -> parseNextN 66 cs
192-
('0' : '3' : _) -> parseNextN 66 cs
193-
('0' : '4' : _) -> parseNextN 130 cs
194-
_ -> Nothing
195-
_ -> []
188+
readsPrec i cs = maybeToList $ case trimmed of
189+
('0' : '2' : _) -> parseNextN 66 trimmed
190+
('0' : '3' : _) -> parseNextN 66 trimmed
191+
('0' : '4' : _) -> parseNextN 130 trimmed
192+
_ -> Nothing
196193
where
194+
trimmed = dropWhile isSpace cs
197195
hush x = case x of
198196
Left _ -> Nothing
199197
Right a -> Just a
@@ -223,13 +221,14 @@ newtype PubKeyXO = PubKeyXO {pubKeyXOFPtr :: ForeignPtr Prim.XonlyPubkey64}
223221

224222

225223
instance Show PubKeyXO where
226-
show pk = "0x" <> B8.unpack (BA.convertToBase BA.Base16 (exportPubKeyXO pk))
224+
show pk = B8.unpack (encodeBase16 (exportPubKeyXO pk))
227225
instance Read PubKeyXO where
228-
readsPrec i s = case s of
229-
('0' : 'x' : bytes) -> case decodeBase16 $ B8.pack (Prelude.take 64 bytes) of
230-
Left e -> []
231-
Right a -> maybeToList $ (,Prelude.drop 64 bytes) <$> importPubKeyXO a
232-
_ -> []
226+
readsPrec i s = case decodeBase16 . B8.pack $ pre of
227+
Left e -> error s
228+
Right a -> maybeToList $ (,suf) <$> importPubKeyXO a
229+
where
230+
trimmed = dropWhile isSpace s
231+
(pre, suf) = Prelude.splitAt 64 trimmed
233232
instance Eq PubKeyXO where
234233
pk == pk' = unsafePerformIO . evalContT $ do
235234
pkp <- ContT . withForeignPtr . pubKeyXOFPtr $ pk
@@ -266,7 +265,14 @@ newtype Signature = Signature {signatureFPtr :: ForeignPtr Prim.Sig64}
266265

267266

268267
instance Show Signature where
269-
show sig = "0x" <> (B8.unpack . encodeBase16) (exportSignatureCompact sig)
268+
show sig = (B8.unpack . encodeBase16) (exportSignatureCompact sig)
269+
instance Read Signature where
270+
readsPrec i cs = case decodeBase16 $ B8.pack token of
271+
Left e -> []
272+
Right a -> maybeToList $ (,rest) <$> importSignature a
273+
where
274+
trimmed = dropWhile isSpace cs
275+
(token, rest) = span isAlphaNum trimmed
270276
instance Eq Signature where
271277
sig == sig' = unsafePerformIO . evalContT $ do
272278
sigp <- ContT $ withForeignPtr (signatureFPtr sig)
@@ -281,7 +287,14 @@ newtype RecoverableSignature = RecoverableSignature {recoverableSignatureFPtr ::
281287

282288

283289
instance Show RecoverableSignature where
284-
show recSig = "0x" <> (B8.unpack . encodeBase16) (exportRecoverableSignature recSig)
290+
show recSig = (B8.unpack . encodeBase16) (exportRecoverableSignature recSig)
291+
instance Read RecoverableSignature where
292+
readsPrec i cs = case decodeBase16 $ B8.pack token of
293+
Left e -> error . show $ trimmed
294+
Right a -> maybeToList $ (,rest) <$> importRecoverableSignature a
295+
where
296+
trimmed = dropWhile isSpace cs
297+
(token, rest) = span isAlphaNum trimmed
285298
instance Eq RecoverableSignature where
286299
rs == rs' = unsafePerformIO . evalContT $ do
287300
rsp <- ContT $ withForeignPtr (recoverableSignatureFPtr rs)
@@ -297,6 +310,14 @@ newtype Tweak = Tweak {tweakFPtr :: ForeignPtr Prim.Tweak32}
297310

298311
instance Show Tweak where
299312
show (Tweak fptr) = show (SecKey $ castForeignPtr fptr)
313+
instance Read Tweak where
314+
readsPrec i cs = case decodeBase16 . B8.pack $ pre of
315+
Left e -> []
316+
Right a -> case importTweak a of
317+
Nothing -> []
318+
Just x -> [(x, suf)]
319+
where
320+
(pre, suf) = Prelude.splitAt 64 (dropWhile isSpace cs)
300321

301322

302323
instance Eq Tweak where

stack.yaml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
resolver: lts-21.25
1+
resolver: lts-22.13
22
nix:
33
packages:
44
- secp256k1

stack.yaml.lock

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,7 @@
66
packages: []
77
snapshots:
88
- completed:
9-
sha256: a81fb3877c4f9031e1325eb3935122e608d80715dc16b586eb11ddbff8671ecd
10-
size: 640086
11-
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/21/25.yaml
12-
original: lts-21.25
9+
sha256: 6f0bea3ba5b07360f25bc886e8cff8d847767557a492a6f7f6dcb06e3cc79ee9
10+
size: 712905
11+
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/22/13.yaml
12+
original: lts-22.13

test/Crypto/Secp256k1Prop.hs

Lines changed: 83 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -3,15 +3,17 @@
33

44
module Crypto.Secp256k1Prop where
55

6+
import Control.Applicative (Applicative (liftA2), empty)
67
import Control.Monad (when)
8+
import Control.Monad.Trans.Class (lift)
79
import Crypto.Secp256k1
810
import Crypto.Secp256k1.Gen
911
import Data.ByteArray.Sized (sizedByteArray)
1012
import Data.ByteString qualified as BS
1113
import Data.Maybe (fromJust, isJust)
1214
import Data.Void
1315
import Hedgehog
14-
import Hedgehog.Gen hiding (discard, maybe)
16+
import Hedgehog.Gen hiding (discard, maybe, prune)
1517
import Hedgehog.Range (linear, singleton)
1618
import Text.Read (readMaybe)
1719

@@ -99,12 +101,22 @@ prop_pubKeyXOSerializeInvertsParse = withDiscards 200 . property $ do
99101
Just pk -> exportPubKeyXO pk === bs
100102

101103

104+
prop_signatureReadInvertsShow :: Property
105+
prop_signatureReadInvertsShow = property $ do
106+
sk <- forAll secKeyGen
107+
bs <- forAll (bytes $ singleton 32)
108+
sig <- maybe failure pure $ ecdsaSign sk bs
109+
case readMaybe (show sig) of
110+
Nothing -> failure
111+
Just x -> sig === x
112+
113+
102114
prop_signatureParseInvertsSerialize :: Property
103115
prop_signatureParseInvertsSerialize = property $ do
104116
sk <- forAll secKeyGen
105117
bs <- forAll $ bytes (singleton 32)
106118

107-
sig <- maybe failure pure (ecdsaSign sk bs)
119+
sig <- maybe failure pure $ ecdsaSign sk bs
108120

109121
exportDer <- forAll $ element [False, True]
110122
let export = if exportDer then exportSignatureDer else exportSignatureCompact
@@ -116,6 +128,17 @@ prop_signatureParseInvertsSerialize = property $ do
116128
Just x -> x === sig
117129

118130

131+
prop_recoverableSignatureReadInvertsShow :: Property
132+
prop_recoverableSignatureReadInvertsShow = property $ do
133+
sk <- forAll secKeyGen
134+
bs <- forAll $ bytes (singleton 32)
135+
recSig <- maybe failure pure $ ecdsaSignRecoverable sk bs
136+
let export = exportRecoverableSignature recSig
137+
case importRecoverableSignature export of
138+
Nothing -> failure
139+
Just x -> x === recSig
140+
141+
119142
prop_recoverableSignatureParseInvertsSerialize :: Property
120143
prop_recoverableSignatureParseInvertsSerialize = property $ do
121144
sk <- forAll secKeyGen
@@ -141,7 +164,8 @@ prop_ecdsaSignaturesProducedAreValid :: Property
141164
prop_ecdsaSignaturesProducedAreValid = property $ do
142165
sk <- forAll secKeyGen
143166
msg <- forAll $ bytes (singleton 32)
144-
case ecdsaSign sk msg of
167+
let sig = ecdsaSign sk msg
168+
case sig of
145169
Nothing -> failure
146170
Just sig -> assert $ ecdsaVerify msg (derivePubKey sk) sig
147171

@@ -159,7 +183,7 @@ prop_ecdsaSignatureValidityPreservedOverSerialization :: Property
159183
prop_ecdsaSignatureValidityPreservedOverSerialization = property $ do
160184
sk <- forAll secKeyGen
161185
msg <- forAll $ bytes (singleton 32)
162-
let sig = fromJust $ ecdsaSign sk msg
186+
sig <- maybe failure pure $ ecdsaSign sk msg
163187
useDer <- forAll enumBounded
164188
let export =
165189
if useDer
@@ -260,7 +284,8 @@ prop_ecdsaSignaturesUnforgeable = property $ do
260284
pk <- forAll pubKeyXYGen
261285
when (pk == derivePubKey sk) discard
262286
msg <- forAll $ bytes (singleton 32)
263-
case ecdsaSign sk msg of
287+
let sig = ecdsaSign sk msg
288+
case sig of
264289
Nothing -> failure
265290
Just sig -> assert . not $ ecdsaVerify msg pk sig
266291

@@ -276,5 +301,58 @@ prop_schnorrSignaturesUnforgeable = property $ do
276301
Just sig -> assert . not $ schnorrVerify pk msg sig
277302

278303

304+
newtype Wrapped a = Wrapped {secKey :: a} deriving (Show, Read, Eq)
305+
306+
307+
derivedCompositeReadShowInvertTemplate :: (Eq a, Read a, Show a) => Gen a -> Property
308+
derivedCompositeReadShowInvertTemplate gen = property $ do
309+
a <- forAll gen
310+
annotateShow a
311+
annotateShow (length $ show a)
312+
annotateShow (Wrapped a)
313+
case readMaybe (show (Wrapped a)) of
314+
Nothing -> failure
315+
Just x -> x === Wrapped a
316+
317+
318+
prop_derivedCompositeReadShowInvertSecKey :: Property
319+
prop_derivedCompositeReadShowInvertSecKey = derivedCompositeReadShowInvertTemplate secKeyGen
320+
321+
322+
prop_derivedCompositeReadShowInvertPubKeyXY :: Property
323+
prop_derivedCompositeReadShowInvertPubKeyXY = derivedCompositeReadShowInvertTemplate pubKeyXYGen
324+
325+
326+
prop_derivedCompositeReadShowInvertPubKeyXO :: Property
327+
prop_derivedCompositeReadShowInvertPubKeyXO = derivedCompositeReadShowInvertTemplate pubKeyXOGen
328+
329+
330+
prop_derivedCompositeReadShowInvertTweak :: Property
331+
prop_derivedCompositeReadShowInvertTweak = derivedCompositeReadShowInvertTemplate tweakGen
332+
333+
334+
prop_derivedCompositeReadShowInvertSignature :: Property
335+
prop_derivedCompositeReadShowInvertSignature = derivedCompositeReadShowInvertTemplate $ choice [ecdsa, schnorr]
336+
where
337+
base = liftA2 (,) secKeyGen (bytes (singleton 32))
338+
ecdsa = base >>= maybe empty pure . uncurry ecdsaSign
339+
schnorr = base >>= maybe empty pure . uncurry (schnorrSign . keyPairCreate)
340+
341+
342+
prop_derivedCompositeReadShowInvertRecoverableSignature :: Property
343+
prop_derivedCompositeReadShowInvertRecoverableSignature = derivedCompositeReadShowInvertTemplate $ do
344+
sk <- secKeyGen
345+
msg <- bytes (singleton 32)
346+
maybe empty pure $ ecdsaSignRecoverable sk msg
347+
348+
349+
prop_eqImportImpliesEqSecKey :: Property
350+
prop_eqImportImpliesEqSecKey = property $ do
351+
bs <- forAll $ bytes $ singleton 32
352+
k0 <- maybe discard pure $ importSecKey bs
353+
k1 <- maybe discard pure $ importSecKey bs
354+
k0 === k1
355+
356+
279357
tests :: Group
280358
tests = $$discover

test/Main.hs

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,18 +1,19 @@
11
module Main where
22

3+
import Crypto.Secp256k1
34
import Crypto.Secp256k1Prop qualified as Secp256k1Prop
45
import GHC.IO.Encoding (setLocaleEncoding, utf8)
56
import Hedgehog (checkSequential)
67
import Hedgehog.Main
78
import Spec qualified
8-
import Test.Hspec.Formatters
9+
import Test.Hspec.Api.Formatters.V1
910
import Test.Hspec.Runner (Config (..), defaultConfig, hspecWith)
1011

1112

1213
main :: IO ()
1314
main = do
1415
setLocaleEncoding utf8
15-
hspecWith defaultConfig{configFormatter = Just progress} Spec.spec
16+
hspecWith (useFormatter ("progress", progress) defaultConfig) Spec.spec
1617
defaultMain
1718
[ checkSequential Secp256k1Prop.tests
1819
]

0 commit comments

Comments
 (0)