add serialization tests

Author: ProofOfKeags

hie.yaml

@@ -1,7 +1,6 @@
 cradle:
-  cabal:
-    - path: "src"
-      component: "lib:libsecp256k1"
-
-    - path: "test"
+  stack:
+    - path: "./"
+      component: "libsecp256k1:lib"
+    - path: "./test"
       component: "libsecp256k1:test:spec"

libsecp256k1.cabal

@@ -1,4 +1,4 @@
-cabal-version: 2.0
+cabal-version: 1.12
 
 -- This file has been generated from package.yaml by hpack version 0.34.4.
 --
@@ -28,10 +28,10 @@ source-repository head
 library
   exposed-modules:
       Crypto.Secp256k1
+      Crypto.Secp256k1.Gen
       Crypto.Secp256k1.Internal
       Crypto.Secp256k1.Prim
-      Paths_libsecp256k1
-  autogen-modules:
+  other-modules:
       Paths_libsecp256k1
   hs-source-dirs:
       src
@@ -40,16 +40,21 @@ library
   build-depends:
       base >=4.9 && <5
     , bytestring >=0.10.8 && <0.12
-    , memory
-    , transformers
+    , entropy >=0.3.8 && <0.5
+    , hedgehog
+    , memory >=0.14.15 && <1.0
+    , transformers >=0.4.0.0 && <1.0
   default-language: Haskell2010
 
 test-suite spec
   type: exitcode-stdio-1.0
-  main-is: Spec.hs
+  main-is: Main.hs
   other-modules:
       Crypto.Secp256k1.PrimSpec
+      Crypto.Secp256k1Prop
       Crypto.Secp256k1Spec
+      Spec
+      Util
       Paths_libsecp256k1
   hs-source-dirs:
       test
@@ -58,11 +63,10 @@ test-suite spec
       HUnit
     , base >=4.9 && <5
     , bytestring >=0.10.8 && <0.12
+    , entropy >=0.3.8 && <0.5
+    , hedgehog
     , hspec
-    , memory
-    , monad-par
-    , mtl
-    , secp256k1-haskell
-    , transformers
+    , libsecp256k1
+    , memory >=0.14.15 && <1.0
+    , transformers >=0.4.0.0 && <1.0
   default-language: Haskell2010
-  build-tool-depends: hspec-discover:hspec-discover

package.yaml

@@ -15,35 +15,24 @@ extra-source-files:
   - README.md
 dependencies:
   - base >=4.9 && <5
-  # - base16 >=0.3.0.1
   - bytestring >=0.10.8 && <0.12
-  # - cereal >=0.5.4 && <0.6
-  - memory
-  # - deepseq >=1.4.2 && <1.5
-  # - entropy >=0.3.8 && <0.5
-  # - hashable >=1.2.6 && <1.5
-  # - QuickCheck >=2.9.2 && <2.15
-  # - string-conversions >=0.4 && <0.5
-  - transformers
+  - entropy >= 0.3.8 && <0.5
+  - hedgehog
+  - memory >= 0.14.15 && <1.0
+  - transformers >= 0.4.0.0 && <1.0
 library:
   source-dirs: src
-  generated-exposed-modules:
-    - Paths_libsecp256k1
   pkg-config-dependencies:
     - libsecp256k1
 tests:
   spec:
-    main: Spec.hs
+    main: Main.hs
     source-dirs: test
     ghc-options:
       - -threaded
       - -rtsopts
       - -with-rtsopts=-N
-    verbatim:
-      build-tool-depends: hspec-discover:hspec-discover
     dependencies:
       - hspec
-      - secp256k1-haskell
-      - monad-par
-      - mtl
+      - libsecp256k1
       - HUnit

src/Crypto/Secp256k1.hs

@@ -1,8 +1,6 @@
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE RankNTypes #-}
@@ -32,6 +30,7 @@ module Crypto.Secp256k1 (
 
     -- * Parsing and Serialization
     importSecKey,
+    exportSecKey,
     importPubKeyXY,
     exportPubKeyXY,
     importPubKeyXO,
@@ -86,6 +85,7 @@ import Control.Monad.Trans.Cont (ContT (..), evalContT)
 import Crypto.Secp256k1.Internal
 import Crypto.Secp256k1.Prim (flagsEcUncompressed)
 import qualified Crypto.Secp256k1.Prim as Prim
+import qualified Data.ByteArray.Encoding as BA
 import Data.ByteArray.Sized
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as BS
@@ -100,6 +100,7 @@ import Data.String (IsString (..))
 
 -- import Data.String.Conversions (ConvertibleStrings, cs)
 
+import qualified Data.ByteString.Char8 as B8
 import Data.Foldable (for_)
 import Data.Memory.PtrMethods (memCompare)
 import Foreign (
@@ -147,7 +148,16 @@ import Text.Read (
  )
 
 
+-- | Secret Key
 newtype SecKey = SecKey {secKeyFPtr :: ForeignPtr Prim.Seckey32}
+
+
+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)
 instance Eq SecKey where
     sk == sk' = unsafePerformIO . evalContT $ do
         skp <- ContT $ withForeignPtr (secKeyFPtr sk)
@@ -160,7 +170,14 @@ instance Ord SecKey where
         lift (memCompare (castPtr skp) (castPtr skp') 32)
 
 
+-- | Public Key with both X and Y coordinates
 newtype PubKeyXY = PubKeyXY {pubKeyXYFPtr :: ForeignPtr Prim.Pubkey64}
+
+
+instance Show PubKeyXY where
+    show pk = "0x" <> B8.unpack (BA.convertToBase BA.Base16 (exportPubKeyXY True pk))
+
+
 instance Eq PubKeyXY where
     pk == pk' = unsafePerformIO . evalContT $ do
         pkp <- ContT . withForeignPtr . pubKeyXYFPtr $ pk
@@ -175,7 +192,14 @@ instance Ord PubKeyXY where
         pure $ compare res 0
 
 
+-- | Public Key with only an X coordinate.
 newtype PubKeyXO = PubKeyXO {pubKeyXOFPtr :: ForeignPtr Prim.XonlyPubkey64}
+
+
+instance Show PubKeyXO where
+    show pk = "0x" <> B8.unpack (BA.convertToBase BA.Base16 (exportPubKeyXO pk))
+
+
 instance Eq PubKeyXO where
     pk == pk' = unsafePerformIO . evalContT $ do
         pkp <- ContT . withForeignPtr . pubKeyXOFPtr $ pk
@@ -190,31 +214,45 @@ instance Ord PubKeyXO where
         pure $ compare res 0
 
 
+-- | Structure containing information equivalent to 'SecKey' and 'PubKeyXY'
 newtype KeyPair = KeyPair {keyPairFPtr :: ForeignPtr Prim.Keypair96}
+
+
 instance Eq KeyPair where
     kp == kp' = unsafePerformIO . evalContT $ do
         kpp <- ContT $ withForeignPtr (keyPairFPtr kp)
         kpp' <- ContT $ withForeignPtr (keyPairFPtr kp')
         (EQ ==) <$> lift (memCompare (castPtr kpp) (castPtr kpp') 32)
 
 
+-- | Structure containing Signature (R,S) data.
 newtype Signature = Signature {signatureFPtr :: ForeignPtr Prim.Sig64}
+
+
+instance Show Signature where
+    show sig = "0x" <> B8.unpack (BA.convertToBase BA.Base16 (exportSignatureCompact sig))
 instance Eq Signature where
     sig == sig' = unsafePerformIO . evalContT $ do
         sigp <- ContT $ withForeignPtr (signatureFPtr sig)
         sigp' <- ContT $ withForeignPtr (signatureFPtr sig')
         (EQ ==) <$> lift (memCompare (castPtr sigp) (castPtr sigp') 32)
 
 
+-- | Structure containing Signature AND recovery ID
 newtype RecoverableSignature = RecoverableSignature {recoverableSignatureFPtr :: ForeignPtr Prim.RecSig65}
+
+
 instance Eq RecoverableSignature where
     rs == rs' = unsafePerformIO . evalContT $ do
         rsp <- ContT $ withForeignPtr (recoverableSignatureFPtr rs)
         rsp' <- ContT $ withForeignPtr (recoverableSignatureFPtr rs')
         (EQ ==) <$> lift (memCompare (castPtr rsp) (castPtr rsp') 32)
 
 
+-- | Isomorphic to 'SecKey' but specifically used for tweaking (EC Group operations) other keys
 newtype Tweak = Tweak {tweakFPtr :: ForeignPtr Prim.Tweak32}
+
+
 instance Eq Tweak where
     sk == sk' = unsafePerformIO . evalContT $ do
         skp <- ContT $ withForeignPtr (tweakFPtr sk)
@@ -248,29 +286,39 @@ importSecKey bs
                 else pure Nothing
 
 
+exportSecKey :: SecKey -> ByteString
+exportSecKey SecKey{..} = unsafePerformIO . evalContT $ do
+    secKeyPtr <- ContT (withForeignPtr secKeyFPtr)
+    lift $ packByteString (secKeyPtr, 32)
+
+
 -- | Parses a 33 or 65 byte 'PubKeyXY', all other lengths will result in @Nothing@
 importPubKeyXY :: ByteString -> Maybe PubKeyXY
-importPubKeyXY bs = unsafePerformIO $
-    unsafeUseByteString bs $ \(input, len) -> do
-        pubkeyOutputBuf <- mallocBytes 64
+importPubKeyXY bs = unsafePerformIO . evalContT $ do
+    (input, len) <- ContT (unsafeUseByteString bs)
+    lift $ do
         if len == 33 || len == 65
             then do
-                ret <- Prim.ecPubkeyParse ctx (castPtr pubkeyOutputBuf) input len
+                pubkeyOutputBuf <- mallocBytes 64
+                ret <- Prim.ecPubkeyParse ctx pubkeyOutputBuf input len
                 if isSuccess ret
-                    then Just . PubKeyXY <$> newForeignPtr finalizerFree (castPtr pubkeyOutputBuf)
+                    then Just . PubKeyXY <$> newForeignPtr finalizerFree pubkeyOutputBuf
                     else free pubkeyOutputBuf $> Nothing
             else pure Nothing
 
 
 -- | Serialize 'PubKeyXY'. First argument @True@ for compressed output (33 bytes), @False@ for uncompressed (65 bytes).
 exportPubKeyXY :: Bool -> PubKeyXY -> ByteString
-exportPubKeyXY compress (PubKeyXY fptr) = unsafePerformIO $ do
+exportPubKeyXY compress PubKeyXY{..} = unsafePerformIO . evalContT $ do
     let flags = if compress then Prim.flagsEcCompressed else Prim.flagsEcUncompressed
     let sz = if compress then 33 else 65
-    buf <- mallocBytes sz
-    alloca $ \written -> do
+    ptr <- ContT (withForeignPtr pubKeyXYFPtr)
+    written <- ContT alloca
+    lift $ do
+        poke written (fromIntegral sz)
+        buf <- mallocBytes sz
         -- always succeeds so we don't need to check
-        _ret <- withForeignPtr fptr $ \ptr -> Prim.ecPubkeySerialize ctx buf written ptr flags
+        _ret <- Prim.ecPubkeySerialize ctx buf written ptr flags
         len <- peek written
         unsafePackMallocCStringLen (castPtr buf, fromIntegral len)
 
@@ -286,7 +334,7 @@ importPubKeyXO bs
             ret <- Prim.xonlyPubkeyParse ctx outBuf ptr
             if isSuccess ret
                 then Just . PubKeyXO <$> newForeignPtr finalizerFree outBuf
-                else pure Nothing
+                else free outBuf $> Nothing
 
 
 -- | Serializes 'PubKeyXO' to 32 byte @ByteString@
@@ -307,11 +355,11 @@ importSignature bs = unsafePerformIO $
                     -- compact
                     | len == 64 -> Prim.ecdsaSignatureParseCompact ctx outBuf inBuf
                     -- der
-                    | len >= 71 && len <= 73 -> Prim.ecdsaSignatureParseDer ctx outBuf inBuf len
+                    | len >= 69 && len <= 73 -> Prim.ecdsaSignatureParseDer ctx outBuf inBuf len
                     -- invalid
                     | otherwise -> pure 0
         if isSuccess ret
-            then Just . Signature <$> newForeignPtr finalizerFree (castPtr outBuf)
+            then Just . Signature <$> newForeignPtr finalizerFree outBuf
             else free outBuf $> Nothing
 
 
@@ -330,6 +378,7 @@ exportSignatureDer (Signature fptr) = unsafePerformIO $ do
     -- as of Q4'2015 73 byte sigs became nonstandard so we will never create one that big
     outBuf <- mallocBytes 72
     alloca $ \written -> do
+        poke written 72
         -- always succeeds
         _ret <- withForeignPtr fptr $ Prim.ecdsaSignatureSerializeDer ctx outBuf written
         len <- peek written
@@ -383,16 +432,16 @@ ecdsaVerify msgHash (PubKeyXY pkFPtr) (Signature sigFPtr) = unsafePerformIO $
 ecdsaSign :: SecKey -> ByteString -> Maybe Signature
 ecdsaSign (SecKey skFPtr) msgHash
     | BS.length msgHash /= 32 = Nothing
-    | otherwise = unsafePerformIO $
-        evalContT $ do
-            skPtr <- ContT (withForeignPtr skFPtr)
-            (msgHashPtr, _) <- ContT (unsafeUseByteString msgHash)
-            sigBuf <- lift $ mallocBytes 64
-            ret <- lift $ Prim.ecdsaSign ctx sigBuf msgHashPtr skPtr Prim.nonceFunctionDefault nullPtr
-            lift $
-                if isSuccess ret
-                    then Just . Signature <$> newForeignPtr finalizerFree sigBuf
-                    else free sigBuf $> Nothing
+    | otherwise = unsafePerformIO . evalContT $ do
+        skPtr <- ContT (withForeignPtr skFPtr)
+        (msgHashPtr, _) <- ContT (unsafeUseByteString msgHash)
+        lift $ do
+            sigBuf <- mallocBytes 64
+            entropy <- mallocBytes 32
+            ret <- Prim.ecdsaSign ctx sigBuf msgHashPtr skPtr Prim.nonceFunctionRfc6979 entropy
+            if isSuccess ret
+                then Just . Signature <$> newForeignPtr finalizerFree sigBuf
+                else free sigBuf $> Nothing
 
 
 -- | Signs @ByteString@ with 'SecKey' only if @ByteString@ is 32 bytes. Retains ability to compute 'PubKeyXY' from the
@@ -553,8 +602,8 @@ keyPairPubKeyXOTweakAdd KeyPair{..} Tweak{..} = unsafePerformIO . evalContT $ do
     keyPairPtr <- ContT (withForeignPtr keyPairFPtr)
     tweakPtr <- ContT (withForeignPtr tweakFPtr)
     lift $ do
-        keyPairOut <- (mallocBytes 96)
-        _ <- (memcpy keyPairOut keyPairPtr 96)
+        keyPairOut <- mallocBytes 96
+        _ <- memcpy keyPairOut keyPairPtr 96
         ret <- Prim.keypairXonlyTweakAdd ctx keyPairOut tweakPtr
         if isSuccess ret
             then Just . KeyPair <$> newForeignPtr finalizerFree keyPairOut

src/Crypto/Secp256k1/Gen.hs

@@ -0,0 +1,30 @@
+module Crypto.Secp256k1.Gen where
+
+import Crypto.Secp256k1 (KeyPair, PubKeyXO, PubKeyXY, SecKey, Tweak, derivePubKey, importSecKey, importTweak, keyPairCreate, xyToXO)
+import Hedgehog (MonadGen)
+import Hedgehog.Gen (bytes, discard)
+import Hedgehog.Range (singleton)
+
+
+secKeyGen :: MonadGen m => m SecKey
+secKeyGen = do
+    bs <- bytes (singleton 32)
+    maybe discard pure (importSecKey bs)
+
+
+pubKeyXYGen :: MonadGen m => m PubKeyXY
+pubKeyXYGen = derivePubKey <$> secKeyGen
+
+
+pubKeyXOGen :: MonadGen m => m PubKeyXO
+pubKeyXOGen = fst . xyToXO <$> pubKeyXYGen
+
+
+keyPairGen :: MonadGen m => m KeyPair
+keyPairGen = keyPairCreate <$> secKeyGen
+
+
+tweakGen :: MonadGen m => m Tweak
+tweakGen = do
+    bs <- bytes (singleton 32)
+    maybe discard pure (importTweak bs)