Build haskell-bitcoin/libsecp256k1-haskell with haskell-bitcoin/bitcoin

Author: tochicool

.gitignore

@@ -22,3 +22,4 @@ cabal.project.local~
 .ghc.environment.*
 TAGS
 tags
+.vscode

bitcoin.cabal

@@ -211,12 +211,12 @@ benchmark benchmark
     , entropy >=0.4.1.5
     , hashable >=1.3.0.0
     , hspec >=2.7.1
+    , libsecp256k1 >=0.1.0
     , memory >=0.15.0
     , murmur3 >=1.0.3
     , network >=3.1.1.1
     , safe >=0.3.18
     , scientific >=0.3.6.2
-    , secp256k1-haskell >=0.4.0
     , split >=0.2.3.3
     , string-conversions >=0.4.0.1
     , text >=1.2.3.0

src/Bitcoin/Crypto/Signature.hs

@@ -22,6 +22,7 @@ import Crypto.Secp256k1
 import Data.Binary (Binary (..))
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as BS
+import Data.ByteString.Short (fromShort)
 import Data.Bytes.Get
 import Data.Bytes.Put
 import Data.Bytes.Serial
@@ -31,15 +32,15 @@ import Numeric (showHex)
 
 
 -- | Sign a 256-bit hash using secp256k1 elliptic curve.
-signHash :: SecKey -> Hash256 -> Signature
+signHash :: SecKey -> Hash256 -> Maybe Signature
 signHash k = ecdsaSign k . fromShort . getHash256
 
 
 -- | Verify an ECDSA signature for a 256-bit hash.
 verifyHashSig :: Hash256 -> Signature -> PubKeyXY -> Bool
-verifyHashSig h s p = verifySig p norm (hashToMsg h)
+verifyHashSig h s p = ecdsaVerify (fromShort $ getHash256 h) p norm
   where
-    norm = fromMaybe s (normalizeSig s)
+    norm = fromMaybe s (normalizeSignature s)
 
 
 -- | Deserialize an ECDSA signature as commonly encoded in Bitcoin.
@@ -64,23 +65,23 @@ getSig = do
 
 -- | Serialize an ECDSA signature for Bitcoin use.
 putSig :: MonadPut m => Signature -> m ()
-putSig s = putByteString $ exportSig s
+putSig s = putByteString $ exportSignatureDer s
 
 
 -- | Is canonical half order.
 isCanonicalHalfOrder :: Signature -> Bool
-isCanonicalHalfOrder = isNothing . normalizeSig
+isCanonicalHalfOrder = isNothing . normalizeSignature
 
 
 -- | Decode signature strictly.
 decodeStrictSig :: ByteString -> Maybe Signature
 decodeStrictSig bs = do
-    g <- importSig bs
+    g <- importSignatureDer bs
     -- <http://www.secg.org/sec1-v2.pdf Section 4.1.4>
     -- 4.1.4.1 (r and s can not be zero)
-    let compact = exportCompactSig g
+    let compact = exportSignatureCompact g
     let zero = BS.replicate 32 0
-    guard $ BS.take 32 (getCompactSig compact) /= zero
-    guard $ BS.take 32 (BS.drop 32 (getCompactSig compact)) /= zero
+    guard $ BS.take 32 compact /= zero
+    guard $ BS.take 32 (BS.drop 32 compact) /= zero
     guard $ isCanonicalHalfOrder g
     return g

src/Bitcoin/Keys/Common.hs

@@ -15,16 +15,16 @@ module Bitcoin.Keys.Common (
     -- * Public & Private Keys
     PubKeyI (..),
     SecKeyI (..),
-    exportPubKey,
-    importPubKey,
+    exportPubKeyXY,
+    importPubKeyXY,
     wrapPubKey,
     derivePubKeyI,
     wrapSecKey,
     fromMiniKey,
     tweakPubKey,
     tweakSecKey,
-    getSecKey,
-    secKey,
+    exportSecKey,
+    importSecKey,
 
     -- ** Private Key Wallet Import Format (WIF)
     fromWif,
@@ -55,7 +55,7 @@ import GHC.Generics (Generic)
 
 -- | Elliptic curve public key type with expected serialized compression flag.
 data PubKeyI = PubKeyI
-    { pubKeyPoint :: !PubKey
+    { pubKeyPoint :: !PubKeyXY
     , pubKeyCompressed :: !Bool
     }
     deriving (Generic, Eq, Show, Read, Hashable, NFData)
@@ -84,14 +84,14 @@ instance Serial PubKeyI where
         c = do
             bs <- getByteString 33
             maybe (fail "Could not decode public key") return $
-                PubKeyI <$> importPubKey bs <*> pure True
+                PubKeyI <$> importPubKeyXY bs <*> pure True
         u = do
             bs <- getByteString 65
             maybe (fail "Could not decode public key") return $
-                PubKeyI <$> importPubKey bs <*> pure False
+                PubKeyI <$> importPubKeyXY bs <*> pure False
 
 
-    serialize pk = putByteString $ exportPubKey (pubKeyCompressed pk) (pubKeyPoint pk)
+    serialize pk = putByteString $ exportPubKeyXY (pubKeyCompressed pk) (pubKeyPoint pk)
 
 
 instance Serialize PubKeyI where
@@ -105,7 +105,7 @@ instance Binary PubKeyI where
 
 
 -- | Wrap a public key from secp256k1 library adding information about compression.
-wrapPubKey :: Bool -> PubKey -> PubKeyI
+wrapPubKey :: Bool -> PubKeyXY -> PubKeyI
 wrapPubKey c p = PubKeyI p c
 
 
@@ -116,8 +116,8 @@ derivePubKeyI (SecKeyI d c) = PubKeyI (derivePubKey d) c
 
 
 -- | Tweak a public key.
-tweakPubKey :: PubKey -> Hash256 -> Maybe PubKey
-tweakPubKey p h = tweakAddPubKey p =<< tweak (runPutS (serialize h))
+tweakPubKey :: PubKeyXY -> Hash256 -> Maybe PubKeyXY
+tweakPubKey p h = pubKeyTweakAdd p =<< importTweak (runPutS (serialize h))
 
 
 -- | Elliptic curve private key type with expected public key compression
@@ -138,14 +138,14 @@ wrapSecKey c d = SecKeyI d c
 
 -- | Tweak a private key.
 tweakSecKey :: SecKey -> Hash256 -> Maybe SecKey
-tweakSecKey key h = tweakAddSecKey key =<< tweak (runPutS (serialize h))
+tweakSecKey key h = secKeyTweakAdd key =<< importTweak (runPutS (serialize h))
 
 
 -- | Decode Casascius mini private keys (22 or 30 characters).
 fromMiniKey :: ByteString -> Maybe SecKeyI
 fromMiniKey bs = do
     guard checkShortKey
-    wrapSecKey False <$> secKey (runPutS (serialize (sha256 bs)))
+    wrapSecKey False <$> importSecKey (runPutS (serialize (sha256 bs)))
   where
     checkHash = runPutS $ serialize $ sha256 $ bs `BS.append` "?"
     checkShortKey = BS.length bs `elem` [22, 30] && BS.head checkHash == 0x00
@@ -159,11 +159,11 @@ fromWif net wif = do
     guard (BS.head bs == getSecretPrefix net)
     case BS.length bs of
         -- Uncompressed format
-        33 -> wrapSecKey False <$> secKey (BS.tail bs)
+        33 -> wrapSecKey False <$> importSecKey (BS.tail bs)
         -- Compressed format
         34 -> do
             guard $ BS.last bs == 0x01
-            wrapSecKey True <$> secKey (BS.tail $ BS.init bs)
+            wrapSecKey True <$> importSecKey (BS.tail $ BS.init bs)
         -- Bad length
         _ -> Nothing
 
@@ -173,5 +173,5 @@ toWif :: Network -> SecKeyI -> Base58
 toWif net (SecKeyI k c) =
     encodeBase58Check . BS.cons (getSecretPrefix net) $
         if c
-            then getSecKey k `BS.snoc` 0x01
-            else getSecKey k
+            then exportSecKey k `BS.snoc` 0x01
+            else exportSecKey k

src/Bitcoin/Keys/Extended.hs

@@ -205,7 +205,7 @@ data XPubKey = XPubKey
     -- ^ derivation index
     , xPubChain :: !ChainCode
     -- ^ chain code
-    , xPubKey :: !PubKey
+    , xPubKey :: !PubKeyXY
     -- ^ public key of this node
     }
     deriving (Generic, Eq, Show, Read, NFData, Hashable)
@@ -244,7 +244,7 @@ makeXPrvKey bs =
     XPrvKey 0 (Fingerprint 0) 0 c k
   where
     (p, c) = split512 $ hmac512 "Bitcoin seed" bs
-    k = fromMaybe err (secKey (runPutS (serialize p)))
+    k = fromMaybe err (importSecKey (runPutS (serialize p)))
     err = throw $ DerivationException "Invalid seed"
 
 
@@ -277,7 +277,7 @@ prvSubKey xkey child
     | otherwise = error "Invalid child derivation index"
   where
     pK = xPubKey $ deriveXPubKey xkey
-    m = B.append (exportPubKey True pK) (runPutS (serialize child))
+    m = B.append (exportPubKeyXY True pK) (runPutS (serialize child))
     (a, c) = split512 $ hmac512 (runPutS $ serialize $ xPrvChain xkey) m
     k = fromMaybe err $ tweakSecKey (xPrvKey xkey) a
     err = throw $ DerivationException "Invalid prvSubKey derivation"
@@ -297,7 +297,7 @@ pubSubKey xKey child
         XPubKey (xPubDepth xKey + 1) (xPubFP xKey) child c pK
     | otherwise = error "Invalid child derivation index"
   where
-    m = B.append (exportPubKey True (xPubKey xKey)) (runPutS $ serialize child)
+    m = B.append (exportPubKeyXY True (xPubKey xKey)) (runPutS $ serialize child)
     (a, c) = split512 $ hmac512 (runPutS $ serialize $ xPubChain xKey) m
     pK = fromMaybe err $ tweakPubKey (xPubKey xKey) a
     err = throw $ DerivationException "Invalid pubSubKey derivation"
@@ -359,7 +359,7 @@ xPrvID = xPubID . deriveXPubKey
 
 -- | Computes the key identifier of an extended public key.
 xPubID :: XPubKey -> Hash160
-xPubID = ripemd160 . runPutS . serialize . sha256 . exportPubKey True . xPubKey
+xPubID = ripemd160 . runPutS . serialize . sha256 . exportPubKeyXY True . xPubKey
 
 
 -- | Computes the key fingerprint of an extended private key.
@@ -477,15 +477,15 @@ hardSubKeys k = map (\i -> (hardSubKey k i, i)) . cycleIndex
 
 
 -- | Derive a standard address from an extended public key and an index.
-deriveAddr :: XPubKey -> KeyIndex -> (Address, PubKey)
+deriveAddr :: XPubKey -> KeyIndex -> (Address, PubKeyXY)
 deriveAddr k i =
     (xPubAddr key, xPubKey key)
   where
     key = pubSubKey k i
 
 
 -- | Derive a SegWit P2WPKH address from an extended public key and an index.
-deriveWitnessAddr :: XPubKey -> KeyIndex -> (Address, PubKey)
+deriveWitnessAddr :: XPubKey -> KeyIndex -> (Address, PubKeyXY)
 deriveWitnessAddr k i =
     (xPubWitnessAddr key, xPubKey key)
   where
@@ -494,7 +494,7 @@ deriveWitnessAddr k i =
 
 -- | Derive a backwards-compatible SegWit P2SH-P2WPKH address from an extended
 -- public key and an index.
-deriveCompatWitnessAddr :: XPubKey -> KeyIndex -> (Address, PubKey)
+deriveCompatWitnessAddr :: XPubKey -> KeyIndex -> (Address, PubKeyXY)
 deriveCompatWitnessAddr k i =
     (xPubCompatWitnessAddr key, xPubKey key)
   where
@@ -503,7 +503,7 @@ deriveCompatWitnessAddr k i =
 
 -- | Cyclic list of all addresses derived from a public key starting from an
 -- offset index.
-deriveAddrs :: XPubKey -> KeyIndex -> [(Address, PubKey, KeyIndex)]
+deriveAddrs :: XPubKey -> KeyIndex -> [(Address, PubKeyXY, KeyIndex)]
 deriveAddrs k =
     map f . cycleIndex
   where
@@ -512,7 +512,7 @@ deriveAddrs k =
 
 -- | Cyclic list of all SegWit P2WPKH addresses derived from a public key
 -- starting from an offset index.
-deriveWitnessAddrs :: XPubKey -> KeyIndex -> [(Address, PubKey, KeyIndex)]
+deriveWitnessAddrs :: XPubKey -> KeyIndex -> [(Address, PubKeyXY, KeyIndex)]
 deriveWitnessAddrs k =
     map f . cycleIndex
   where
@@ -521,7 +521,7 @@ deriveWitnessAddrs k =
 
 -- | Cyclic list of all backwards-compatible SegWit P2SH-P2WPKH addresses
 -- derived from a public key starting from an offset index.
-deriveCompatWitnessAddrs :: XPubKey -> KeyIndex -> [(Address, PubKey, KeyIndex)]
+deriveCompatWitnessAddrs :: XPubKey -> KeyIndex -> [(Address, PubKeyXY, KeyIndex)]
 deriveCompatWitnessAddrs k =
     map f . cycleIndex
   where
@@ -1026,14 +1026,14 @@ applyPath path key =
 {- Helpers for derivation paths and addresses -}
 
 -- | Derive an address from a given parent path.
-derivePathAddr :: XPubKey -> SoftPath -> KeyIndex -> (Address, PubKey)
+derivePathAddr :: XPubKey -> SoftPath -> KeyIndex -> (Address, PubKeyXY)
 derivePathAddr key path = deriveAddr (derivePubPath path key)
 
 
 -- | Cyclic list of all addresses derived from a given parent path and starting
 -- from the given offset index.
 derivePathAddrs ::
-    XPubKey -> SoftPath -> KeyIndex -> [(Address, PubKey, KeyIndex)]
+    XPubKey -> SoftPath -> KeyIndex -> [(Address, PubKeyXY, KeyIndex)]
 derivePathAddrs key path = deriveAddrs (derivePubPath path key)
 
 

src/Bitcoin/Script/SigHash.hs

@@ -44,6 +44,7 @@ import Data.Bytes.Serial
 import Data.Hashable
 import Data.Maybe
 import Data.Scientific
+import qualified Data.Text as T
 import Data.Word
 import GHC.Generics (Generic)
 
@@ -276,7 +277,7 @@ txSigHashSegwitV0 _ tx out v i sh =
 -- transaction inputs are of type 'TxSignature'.
 data TxSignature
     = TxSignature
-        { txSignature :: !Sig
+        { txSignature :: !Signature
         , txSignatureSigHash :: !SigHash
         }
     | TxSignatureEmpty

src/Bitcoin/Transaction/Builder.hs

@@ -311,7 +311,7 @@ countMulSig ::
     Script ->
     Word64 ->
     Int ->
-    [PubKey] ->
+    [PubKeyXY] ->
     [TxSignature] ->
     Int
 countMulSig net tx out val i =
@@ -320,7 +320,7 @@ countMulSig net tx out val i =
     h = txSigHash net tx out val i
 
 
-countMulSig' :: (SigHash -> Hash256) -> [PubKey] -> [TxSignature] -> Int
+countMulSig' :: (SigHash -> Hash256) -> [PubKeyXY] -> [TxSignature] -> Int
 countMulSig' _ [] _ = 0
 countMulSig' _ _ [] = 0
 countMulSig' h (_ : pubs) (TxSignatureEmpty : sigs) = countMulSig' h pubs sigs

src/Bitcoin/Transaction/Builder/Sign.hs

@@ -108,7 +108,7 @@ signInput ::
     SecKeyI ->
     Either String Tx
 signInput net tx i (sigIn@(SigInput so val _ _ rdmM), nest) key = do
-    let sig = makeSignature net tx i sigIn key
+    sig <- maybe (Left "cannot sign input") return $ makeSignature net tx i sigIn key
     si <- buildInput net tx i so val rdmM sig $ derivePubKeyI key
     w <- updatedWitnessData tx i so si
     return
@@ -246,9 +246,9 @@ parseExistingSigs net tx so i = insSigs <> witSigs
 
 
 -- | Produce a structured representation of a deterministic (RFC-6979) signature over an input.
-makeSignature :: Network -> Tx -> Int -> SigInput -> SecKeyI -> TxSignature
+makeSignature :: Network -> Tx -> Int -> SigInput -> SecKeyI -> Maybe TxSignature
 makeSignature net tx i (SigInput so val _ sh rdmM) key =
-    TxSignature (signHash (secKeyData key) m) sh
+    TxSignature <$> signHash (secKeyData key) m <*> pure sh
   where
     m = makeSigHash net tx i so val sh rdmM
 

src/Bitcoin/Transaction/Partial.hs

@@ -358,10 +358,14 @@ onPrevTxOut net signer tx ix input prevTxData =
         { partialSigs = newSigs <> partialSigs input
         }
   where
-    newSigs = HM.mapWithKey sigForInput sigKeys
+    newSigs = HM.foldMapWithKey sigForInput sigKeys
     sigForInput thePubKey theSecKey =
-        encodeTxSig . makeSignature net tx ix theSigInput $
-            SecKeyI theSecKey (pubKeyCompressed thePubKey)
+        maybe
+            mempty
+            (HM.singleton thePubKey . encodeTxSig)
+            ( makeSignature net tx ix theSigInput $
+                SecKeyI theSecKey (pubKeyCompressed thePubKey)
+            )
 
     theSigInput =
         SigInput