haskoin-core 1.2.2 → 1.3.0

raw patch · 20 files changed

+351/−105 lines, 20 filesdep +ramdep −memorydep ~secp256k1-haskellPVP ok

version bump matches the API change (PVP)

Dependencies added: ram

Dependencies removed: memory

Dependency ranges changed: secp256k1-haskell

API changes (from Hackage documentation)

Files

• CHANGELOG.md +14/−0
• haskoin-core.cabal +7/−7
• src/Haskoin/Address.hs +184/−19
• src/Haskoin/Address/Bech32.hs +1/−1
• src/Haskoin/Address/CashAddr.hs +2/−0
• src/Haskoin/Block/Headers.hs +3/−3
• src/Haskoin/Script/Standard.hs +36/−12
• src/Haskoin/Transaction/Builder.hs +1/−4
• src/Haskoin/Transaction/Builder/Sign.hs +6/−10
• src/Haskoin/Transaction/Partial.hs +3/−3
• src/Haskoin/Util/Arbitrary/Address.hs +42/−12
• src/Haskoin/Util/Arbitrary/Script.hs +5/−1
• src/Haskoin/Util/Arbitrary/Transaction.hs +18/−5
• src/Haskoin/Util/Arbitrary/Util.hs +4/−5
• test/Haskoin/AddressSpec.hs +12/−10
• test/Haskoin/Crypto/KeysSpec.hs +3/−2
• test/Haskoin/Crypto/SignatureSpec.hs +2/−2
• test/Haskoin/NetworkSpec.hs +1/−1
• test/Haskoin/Transaction/PartialSpec.hs +1/−1
• test/Haskoin/TransactionSpec.hs +6/−7

@@ -5,6 +5,20 @@ The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/) and this project adheres to [Semantic Versioning](http://semver.org/spec/v2.0.0.html). +## [1.3.0] - 2026-08-12++### Changed++- Make script and address parsing more strict.+- Use smart constructors for addresses to avoid inconsistent or incorrect represtentations.++### Fixed++- Support Bitcoin Cash 256-bit pay-to-script-hash scripts and addresses.+- Make addresses of incorrect length invalid.+- Avoid decoding scripts as standard when hash or public key length incorrect.+- Fix secp256 library function names.+ ## [1.2.2] - 2025-05-08  ### Changed

@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.38.0.+-- This file has been generated from package.yaml by hpack version 0.39.6. -- -- see: https://github.com/sol/hpack  name:           haskoin-core-version:        1.2.2+version:        1.3.0 synopsis:       Bitcoin & Bitcoin Cash library for Haskell description:    Please see the README on GitHub at <https://github.com/jprupp/haskoin-core#readme> category:       Bitcoin, Finance, Network@@ -48,7 +48,7 @@  source-repository head   type: git-  location: git://github.com/jprupp/haskoin-core.git+  location: https://github.com/jprupp/haskoin-core.git  library   exposed-modules:@@ -121,13 +121,13 @@     , entropy >=0.4.1.5     , hashable >=1.3.0.0     , hspec >=2.7.1-    , memory >=0.15.0     , mtl >=2.2.2     , murmur3 >=1.0.3     , network >=3.1.1.1+    , ram >=0.22.0     , safe >=0.3.18     , scientific >=0.3.6.2-    , secp256k1-haskell >=1.2.0+    , secp256k1-haskell >=1.5.0     , split >=0.2.3.3     , string-conversions >=0.4.0.1     , text >=1.2.3.0@@ -182,13 +182,13 @@     , hspec >=2.7.1     , lens >=4.18.1     , lens-aeson >=1.1-    , memory >=0.15.0     , mtl >=2.2.2     , murmur3 >=1.0.3     , network >=3.1.1.1+    , ram >=0.22.0     , safe >=0.3.18     , scientific >=0.3.6.2-    , secp256k1-haskell >=1.2.0+    , secp256k1-haskell >=1.5.0     , split >=0.2.3.3     , string-conversions >=0.4.0.1     , text >=1.2.3.0

@@ -21,12 +21,33 @@ -- Base58, CashAddr, Bech32 address and WIF private key serialization support. module Haskoin.Address   ( -- * Addresses-    Address (..),+    Address+      ( PubKeyAddress,+        ScriptAddress,+        WitnessAddress,+        WitnessPubKeyAddress,+        WitnessScriptAddress,+        Script32Address,+        CashAddress+      ),     isPubKeyAddress,     isScriptAddress,     isWitnessAddress,     isWitnessPubKeyAddress,     isWitnessScriptAddress,+    isScript32Address,+    isCashAddress,+    pubKeyAddress,+    scriptAddress,+    witnessAddress,+    witnessPubKeyAddress,+    witnessScriptAddress,+    script32Address,+    cashAddress,+    addressHash160,+    addressHash256,+    addressVersion,+    addressBytes,     addrToText,     textToAddr,     bech32ToAddr,@@ -58,7 +79,7 @@ import Control.Applicative (Alternative ((<|>))) import Control.Arrow (second) import Control.DeepSeq (NFData)-import Control.Monad ((<=<))+import Control.Monad (guard, (<=<)) import Crypto.Secp256k1 import Data.Aeson (ToJSON (toJSON), Value, withText) import Data.Aeson.Encoding (Encoding, null_, text)@@ -66,7 +87,7 @@ import Data.Binary (Binary (..)) import Data.ByteString (ByteString) import Data.ByteString qualified as B-import Data.Bytes.Get (MonadGet (getByteString, getWord64be, getWord8), runGetS)+import Data.Bytes.Get (MonadGet (getByteString, getWord64be, getWord8), isEmpty, runGetS) import Data.Bytes.Put (MonadPut (putByteString, putWord64be, putWord8), runPutS) import Data.Bytes.Serial (Serial (..)) import Data.Hashable (Hashable)@@ -93,7 +114,7 @@       { -- | RIPEMD160 hash of public key's SHA256 hash         hash160 :: !Hash160       }-  | -- | pay to script hash+  | -- | pay to script hash (160-bit)     ScriptAddress       { -- | RIPEMD160 hash of script's SHA256 hash         hash160 :: !Hash160@@ -113,9 +134,22 @@       { version :: !Word8,         bytes :: !ByteString       }+  | -- | pay to script hash (256-bit)+    Script32Address+      { -- | HAS256 hash of script+        hash256 :: !Hash256+      }+  | -- | other CashAddr+    CashAddress+      { version :: !Word8,+        bytes :: !ByteString+      }   deriving     (Eq, Ord, Generic, Show, Read, Hashable, NFData) +-- | Binary serialization for 'Address' type is not standard.+-- Do not expect other other software to understand these.+-- Use text format or output scripts for exchange. instance Serial Address where   serialize (PubKeyAddress k) = do     putWord8 0x00@@ -134,6 +168,14 @@     putWord8 v     putWord64be (fromIntegral (B.length d))     putByteString d+  serialize (Script32Address s) = do+    putWord8 0x05+    serialize s+  serialize (CashAddress v d) = do+    putWord8 0x06+    putWord8 v+    putWord64be (fromIntegral (B.length d))+    putByteString d    deserialize =     getWord8 >>= \case@@ -145,6 +187,11 @@         WitnessAddress           <$> getWord8           <*> (getByteString . fromIntegral =<< getWord64be)+      0x05 -> Script32Address <$> deserialize+      0x06 -> do+        CashAddress+          <$> getWord8+          <*> (getByteString . fromIntegral =<< getWord64be)       b ->         fail . T.unpack $           "Could not decode address type byte: "@@ -163,7 +210,7 @@ isPubKeyAddress PubKeyAddress {} = True isPubKeyAddress _ = False --- | 'Address' pays to a script hash.+-- | 'Address' pays to a 160-bit script hash. isScriptAddress :: Address -> Bool isScriptAddress ScriptAddress {} = True isScriptAddress _ = False@@ -174,14 +221,112 @@ isWitnessPubKeyAddress WitnessPubKeyAddress {} = True isWitnessPubKeyAddress _ = False +-- | 'Address' pays to witness script hash. SegWit only. isWitnessScriptAddress :: Address -> Bool isWitnessScriptAddress WitnessScriptAddress {} = True isWitnessScriptAddress _ = False +-- | 'Address' is another type of SegWit address, not covered above. isWitnessAddress :: Address -> Bool isWitnessAddress WitnessAddress {} = True isWitnessAddress _ = False +-- | 'Address' pays to a 256-bit script hash.+isScript32Address :: Address -> Bool+isScript32Address Script32Address {} = True+isScript32Address _ = False++-- | 'Address' is another type of CashAddr, not covered above.+isCashAddress :: Address -> Bool+isCashAddress CashAddress {} = True+isCashAddress _ = False++-- | Smart constructor for P2PKH address.+pubKeyAddress :: Hash160 -> Address+pubKeyAddress = PubKeyAddress++-- | Smart constructor for P2SH address.+scriptAddress :: Hash160 -> Address+scriptAddress = ScriptAddress++-- | Smart constructor for P2WPKH address.+witnessPubKeyAddress :: Hash160 -> Address+witnessPubKeyAddress = WitnessPubKeyAddress++-- | Smart constructor for P2WSH address.+witnessScriptAddress :: Hash256 -> Address+witnessScriptAddress = WitnessScriptAddress++-- | Smart constructor for other SegWit address.+witnessAddress :: Word8 -> ByteString -> Maybe Address+witnessAddress v bs = do+  guard $ v <= 16+  guard $ B.length bs >= 2 && B.length bs <= 40+  case v of+    0 -> case B.length bs of+      20 -> do+        h <- eitherToMaybe $ runGetS deserialize bs+        return $ WitnessPubKeyAddress h+      32 -> do+        h <- eitherToMaybe $ runGetS deserialize bs+        return $ WitnessScriptAddress h+      _ -> Nothing+    _ -> return $ WitnessAddress v bs++-- | Smart constructor for P2SH32 address.+script32Address :: Hash256 -> Address+script32Address = Script32Address++-- | Smart constructor for CashAddr.+cashAddress :: Word8 -> ByteString -> Maybe Address+cashAddress v b = do+  guard $ v < 16+  guard $ B.length b `elem` [20, 24, 28, 32, 40, 48, 56, 64]+  case v of+    0 -> case B.length b of+      20 -> do+        h <- eitherToMaybe $ runGetS deserialize b+        return $ pubKeyAddress h+      _ -> return $ CashAddress v b+    1 -> case B.length b of+      20 -> do+        h <- eitherToMaybe $ runGetS deserialize b+        return $ scriptAddress h+      32 -> do+        h <- eitherToMaybe $ runGetS deserialize b+        return $ script32Address h+      _ -> return $ CashAddress v b+    _ -> return $ CashAddress v b++addressHash160 :: Address -> Maybe Hash160+addressHash160 (PubKeyAddress h) = Just h+addressHash160 (ScriptAddress h) = Just h+addressHash160 (WitnessPubKeyAddress h) = Just h+addressHash160 _ = Nothing++addressHash256 :: Address -> Maybe Hash256+addressHash256 (WitnessScriptAddress h) = Just h+addressHash256 (Script32Address h) = Just h+addressHash256 _ = Nothing++addressVersion :: Address -> Word8+addressVersion (PubKeyAddress _) = 0+addressVersion (ScriptAddress _) = 1+addressVersion (WitnessPubKeyAddress _) = 0+addressVersion (WitnessScriptAddress _) = 0+addressVersion (WitnessAddress v _) = v+addressVersion (Script32Address _) = 1+addressVersion (CashAddress v _) = v++addressBytes :: Address -> ByteString+addressBytes (PubKeyAddress h) = runPutS (serialize h)+addressBytes (ScriptAddress h) = runPutS (serialize h)+addressBytes (WitnessPubKeyAddress h) = runPutS (serialize h)+addressBytes (WitnessScriptAddress h) = runPutS (serialize h)+addressBytes (WitnessAddress _ b) = b+addressBytes (Script32Address h) = runPutS (serialize h)+addressBytes (CashAddress _ b) = runPutS (serialize b)+ instance MarshalJSON Network Address where   marshalValue net a = toJSON (addrToText net a)   marshalEncoding net = maybe null_ text . addrToText net@@ -212,6 +357,16 @@ addrToText net WitnessAddress {version = v, bytes = d} = do   hrp <- net.bech32Prefix   segwitEncode hrp v (B.unpack d)+addrToText net Script32Address {hash256 = h}+  | isNothing net.cashAddrPrefix =+      Nothing+  | otherwise =+      cashAddrEncode net 1 (runPutS $ serialize h)+addrToText net CashAddress {version = v, bytes = h}+  | isNothing net.cashAddrPrefix =+      Nothing+  | otherwise =+      cashAddrEncode net v h  -- | Parse 'Base58', 'Bech32' or 'CashAddr' address, depending on network. textToAddr :: Network -> Text -> Maybe Address@@ -222,9 +377,14 @@ cashToAddr net txt = do   (ver, bs) <- cashAddrDecode net txt   case ver of-    0 -> PubKeyAddress <$> eitherToMaybe (runGetS deserialize bs)-    1 -> ScriptAddress <$> eitherToMaybe (runGetS deserialize bs)-    _ -> Nothing+    0 -> case B.length bs of+      20 -> PubKeyAddress <$> eitherToMaybe (runGetS deserialize bs)+      _ -> return $ CashAddress ver bs+    1 -> case B.length bs of+      20 -> ScriptAddress <$> eitherToMaybe (runGetS deserialize bs)+      32 -> Script32Address <$> eitherToMaybe (runGetS deserialize bs)+      _ -> return $ CashAddress ver bs+    _ -> return $ CashAddress ver bs  bech32ToAddr :: Network -> Text -> Maybe Address bech32ToAddr net txt = do@@ -245,7 +405,9 @@ base58get net = do   pfx <- getWord8   addr <- deserialize-  f pfx addr+  isEmpty >>= \case+    True -> f pfx addr+    False -> fail "Address too long"   where     f x a       | x == net.addrPrefix = return $ PubKeyAddress a@@ -314,22 +476,24 @@  -- | Encode an output script from an address. Will fail if using a -- pay-to-witness address on a non-SegWit network.-addressToOutput :: Address -> ScriptOutput+addressToOutput :: Address -> Maybe ScriptOutput addressToOutput =   \case-    PubKeyAddress h -> PayPKHash h-    ScriptAddress h -> PayScriptHash h-    WitnessPubKeyAddress h -> PayWitnessPKHash h-    WitnessScriptAddress h -> PayWitnessScriptHash h-    WitnessAddress v d -> PayWitness v d+    PubKeyAddress h -> Just (PayPKHash h)+    ScriptAddress h -> Just (PayScriptHash h)+    WitnessPubKeyAddress h -> Just (PayWitnessPKHash h)+    WitnessScriptAddress h -> Just (PayWitnessScriptHash h)+    WitnessAddress v d -> Just (PayWitness v d)+    Script32Address h -> Just (PayScript32Hash h)+    CashAddress v a -> Nothing  -- | Get output script AST for an 'Address'.-addressToScript :: Ctx -> Address -> Script-addressToScript ctx = encodeOutput ctx . addressToOutput+addressToScript :: Ctx -> Address -> Maybe Script+addressToScript ctx addr = encodeOutput ctx <$> addressToOutput addr  -- | Encode address as output script in 'ByteString' form.-addressToScriptBS :: Ctx -> Address -> ByteString-addressToScriptBS ctx = runPutS . serialize . addressToScript ctx+addressToScriptBS :: Ctx -> Address -> Maybe ByteString+addressToScriptBS ctx addr = (runPutS . serialize) <$> addressToScript ctx addr  -- | Decode an output script into an 'Address' if it has such representation. scriptToAddress :: Ctx -> Script -> Either String Address@@ -355,6 +519,7 @@     PayWitnessPKHash h -> Just $ WitnessPubKeyAddress h     PayWitnessScriptHash h -> Just $ WitnessScriptAddress h     PayWitness v d -> Just $ WitnessAddress v d+    PayScript32Hash h -> Just $ Script32Address h     _ -> Nothing  -- | Infer the 'Address' of a 'ScriptInput'.

@@ -222,7 +222,7 @@         bits' = bits + frombits         result' =           [ (acc' .>>. b) .&. maxv-            | b <- [bits' - tobits, bits' - 2 * tobits .. 0]+          | b <- [bits' - tobits, bits' - 2 * tobits .. 0]           ]     maxv = (1 .<<. tobits) - 1 {-# INLINE convertBits #-}

@@ -25,6 +25,8 @@     cash32encodeType,     cash32decode,     cash32encode,+    decodeVersionByte,+    encodeVersionByte,   ) where 

@@ -915,9 +915,9 @@ mineBlock net seed h =   head     [ j-      | i <- (+ seed) <$> [0 .. maxBound],-        let j = h {nonce = i},-        isValidPOW net j+    | i <- (+ seed) <$> [0 .. maxBound],+      let j = h {nonce = i},+      isValidPOW net j     ]  -- | Generate and append new blocks (mining). Only practical in regtest network.

@@ -30,6 +30,7 @@     isPayWitness,     isPayWitnessPKHash,     isPayWitnessScriptHash,+    isPayScript32Hash,     isDataCarrier,     encodeOutput,     decodeOutput,@@ -98,6 +99,8 @@       { version :: !Word8,         bytes :: !ByteString       }+  | -- | pay to a script hash (256-bit)+    PayScript32Hash {hash256 :: !Hash256}   | -- | provably unspendable data carrier     DataCarrier {bytes :: !ByteString}   deriving (Eq, Show, Read, Generic, NFData)@@ -148,6 +151,11 @@ isPayWitness (PayWitness _ _) = True isPayWitness _ = False +-- | Is script paying to 256-bit script hash?+isPayScript32Hash :: ScriptOutput -> Bool+isPayScript32Hash (PayScript32Hash _) = True+isPayScript32Hash _ = False+ -- | Is script a data carrier output? isDataCarrier :: ScriptOutput -> Bool isDataCarrier (DataCarrier _) = True@@ -158,24 +166,37 @@ decodeOutput :: Ctx -> Script -> Either String ScriptOutput decodeOutput ctx s = case s.ops of   -- Pay to PubKey-  [OP_PUSHDATA bs _, OP_CHECKSIG] ->-    PayPK <$> unmarshal ctx bs+  [OP_PUSHDATA bs _, OP_CHECKSIG]+    | B.length bs == 33 || B.length bs == 65 ->+        PayPK <$> unmarshal ctx bs+    | otherwise ->+        Left "decodeOutput: public key must be 33 or 65 bytes long"   -- Pay to PubKey Hash-  [OP_DUP, OP_HASH160, OP_PUSHDATA bs _, OP_EQUALVERIFY, OP_CHECKSIG] ->-    PayPKHash <$> runGetS deserialize bs+  [OP_DUP, OP_HASH160, OP_PUSHDATA bs _, OP_EQUALVERIFY, OP_CHECKSIG]+    | B.length bs == 20 ->+        PayPKHash <$> runGetS deserialize bs+    | otherwise ->+        Left "decodeOutput: public key hash must be 20 bytes long"   -- Pay to Script Hash-  [OP_HASH160, OP_PUSHDATA bs _, OP_EQUAL] ->-    PayScriptHash <$> runGetS deserialize bs+  [OP_HASH160, OP_PUSHDATA bs _, OP_EQUAL]+    | B.length bs == 20 ->+        PayScriptHash <$> runGetS deserialize bs+    | otherwise ->+        Left "decodeOutput: script hash must be 20 bytes long"+  -- Pay to 256-bit Script Hash+  [OP_HASH256, OP_PUSHDATA bs _, OP_EQUAL]+    | B.length bs == 32 ->+        PayScript32Hash <$> runGetS deserialize bs+    | otherwise ->+        Left "decodeOutput: script hash must be 32 bytes long"   -- Pay to Witness   [OP_0, OP_PUSHDATA bs OPCODE]     | B.length bs == 20 ->         PayWitnessPKHash <$> runGetS deserialize bs     | B.length bs == 32 ->         PayWitnessScriptHash <$> runGetS deserialize bs-    | B.length bs /= 20 && B.length bs /= 32 ->-        Left-          "decodeOutput: invalid version 0 segwit \-          \(must be 20 or 32 bytes)"+    | otherwise ->+        Left "decodeOutput: version 0 segwit must be 20 or 32 bytes long"   -- Other Witness   [ver, OP_PUSHDATA bs _]     | Just wv <- opWitnessVersion ver,@@ -293,8 +314,11 @@       else Left "matchPayMulSig: Invalid M or N parameters"   _ -> Left "matchPayMulSig: script did not match output template"   where-    go (OP_PUSHDATA bs _ : xs) =-      liftM2 (:) (unmarshal ctx bs) (go xs)+    go (OP_PUSHDATA bs _ : xs)+      | B.length bs == 33 || B.length bs == 65 =+          liftM2 (:) (unmarshal ctx bs) (go xs)+      | otherwise =+          Left "matchPayMulSig: public key must be 33 or 65 bytes long"     go [] =       Right []     go _ =

@@ -210,11 +210,9 @@           -- We have reached the goal using this coin           if val + aTot >= goal (length acc + 1)             then -- If we want to continue searching for better solutions-               if continue                 then -- This solution is the first one or                 -- This solution is better than the previous one-                   if pTot == 0 || val + aTot < pTot                     then -- Continue searching for better solutions in the stream                       go [] 0 (coin : acc) (val + aTot)@@ -222,7 +220,6 @@                     -- solution                       return $ Just (ps, pTot - goal (length ps))                 else -- Otherwise, return this solution-                   return $                     Just (coin : acc, val + aTot - goal (length acc + 1))             else -- We have not yet reached the goal. Add the coin to the@@ -338,7 +335,7 @@     f (aTxt, v) =       maybeToEither ("buildAddrTx: Invalid address " <> cs aTxt) $ do         a <- textToAddr net aTxt-        let o = addressToOutput a+        o <- addressToOutput a         return (o, v)  -- | Build a transaction by providing a list of outpoints as inputs

@@ -60,16 +60,12 @@ -- script is required. data SigInput = SigInput   { -- | output script to spend-    -- ^ output script value     script :: !ScriptOutput,     -- | output script value-    -- ^ outpoint to spend     value :: !Word64,     -- | outpoint to spend-    -- ^ signature type     outpoint :: !OutPoint,     -- | signature type-    -- ^ redeem script     sighash :: !SigHash,     -- | redeem script     redeem :: !(Maybe RedeemScript)@@ -85,7 +81,7 @@         "sighash" .= h       ]         ++ [ "redeem" .= marshalValue ctx r-             | r <- maybeToList r+           | r <- maybeToList r            ]    marshalEncoding ctx (SigInput s v o h r) =@@ -217,13 +213,13 @@   where     zipKeys =       [ (prv, pub)-        | k <- keys,-          t <- [True, False],-          let prv = wrapSecKey t k,-          let pub = derivePublicKey ctx prv+      | k <- keys,+        t <- [True, False],+        let prv = wrapSecKey t k,+        let pub = derivePublicKey ctx prv       ]     keyByHash h = fmap fst . maybeToList . findKey h $ zipKeys-    findKey h = find $ (== h) . (.hash160) . pubKeyAddr ctx . snd+    findKey h = find $ (== Just h) . addressHash160 . pubKeyAddr ctx . snd  -- | Construct an input for a transaction given a signature, public key and data -- about the previous output.

@@ -74,7 +74,7 @@ import Data.String.Conversions (cs) import GHC.Generics (Generic) import GHC.Word (Word32, Word8)-import Haskoin.Address (Address (..), pubKeyAddr)+import Haskoin.Address (Address, pubKeyAddr, pubKeyAddress) import Haskoin.Crypto.Keys.Common import Haskoin.Crypto.Keys.Extended import Haskoin.Network.Common@@ -410,7 +410,7 @@     } completeSig ctx input (PayPKHash h)   | [(k, sig)] <- HashMap.toList input.partialSigs,-    PubKeyAddress h == pubKeyAddr ctx k =+    pubKeyAddress h == pubKeyAddr ctx k =       input         { finalScriptSig =             Just $@@ -442,7 +442,7 @@     scriptAppend (Script script1) (Script script2) = Script $ script1 <> script2 completeSig ctx input (PayWitnessPKHash h)   | [(k, sig)] <- HashMap.toList input.partialSigs,-    PubKeyAddress h == pubKeyAddr ctx k =+    pubKeyAddress h == pubKeyAddr ctx k =       input {finalScriptWitness = Just [sig, marshal ctx k]} completeSig ctx input (PayWitnessScriptHash h)   | Just witScript <- input.inputWitnessScript,

@@ -1,3 +1,5 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE TupleSections #-}  -- |@@ -10,6 +12,7 @@ module Haskoin.Util.Arbitrary.Address where  import qualified Data.ByteString as B+import Data.Maybe (isJust) import Haskoin.Address import Haskoin.Network.Constants import Haskoin.Network.Data@@ -18,12 +21,18 @@ import Test.QuickCheck  -- | Arbitrary pay-to-public-key-hash or pay-to-script-hash address.-arbitraryAddress :: Gen Address-arbitraryAddress = oneof [arbitraryPubKeyAddress, arbitraryScriptAddress]+arbitraryBitcoinCashAddress :: Gen Address+arbitraryBitcoinCashAddress =+  oneof+    [ arbitraryPubKeyAddress,+      arbitraryScriptAddress,+      arbitraryScript32Address,+      arbitraryCashAddress+    ]  -- | Arbitrary address including pay-to-witness-arbitraryAddressAll :: Gen Address-arbitraryAddressAll =+arbitraryBitcoinAddress :: Gen Address+arbitraryBitcoinAddress =   oneof     [ arbitraryPubKeyAddress,       arbitraryScriptAddress,@@ -32,29 +41,34 @@       arbitraryWitnessAddress     ] +arbitraryAddress :: Network -> Gen Address+arbitraryAddress net =+  if isJust net.cashAddrPrefix+    then arbitraryBitcoinCashAddress+    else arbitraryBitcoinAddress+ -- | Arbitrary valid combination of (Network, Address) arbitraryNetAddress :: Gen (Network, Address) arbitraryNetAddress = do   net <- arbitraryNetwork-  if net `elem` [bch, bchTest, bchTest4, bchRegTest]-    then (net,) <$> arbitraryAddress-    else (net,) <$> arbitraryAddressAll+  addr <- arbitraryAddress net+  return (net, addr)  -- | Arbitrary pay-to-public-key-hash address. arbitraryPubKeyAddress :: Gen Address-arbitraryPubKeyAddress = PubKeyAddress <$> arbitraryHash160+arbitraryPubKeyAddress = pubKeyAddress <$> arbitraryHash160  -- | Arbitrary pay-to-script-hash address. arbitraryScriptAddress :: Gen Address-arbitraryScriptAddress = ScriptAddress <$> arbitraryHash160+arbitraryScriptAddress = scriptAddress <$> arbitraryHash160  -- | Arbitrary pay-to-witness public key hash arbitraryWitnessPubKeyAddress :: Gen Address-arbitraryWitnessPubKeyAddress = WitnessPubKeyAddress <$> arbitraryHash160+arbitraryWitnessPubKeyAddress = witnessPubKeyAddress <$> arbitraryHash160  -- | Arbitrary pay-to-witness script hash arbitraryWitnessScriptAddress :: Gen Address-arbitraryWitnessScriptAddress = WitnessPubKeyAddress <$> arbitraryHash160+arbitraryWitnessScriptAddress = witnessPubKeyAddress <$> arbitraryHash160  arbitraryWitnessAddress :: Gen Address arbitraryWitnessAddress = do@@ -62,4 +76,20 @@   len <- choose (2, 40)   ws <- vectorOf len arbitrary   let bs = B.pack ws-  return $ WitnessAddress ver bs+  case witnessAddress ver bs of+    Just a -> return a+    Nothing -> error "Error generating arbitrary WitnessAddress"++arbitraryScript32Address :: Gen Address+arbitraryScript32Address = script32Address <$> arbitraryHash256++arbitraryCashAddress :: Gen Address+arbitraryCashAddress = do+  ver <- choose (0, 15)+  len <- choose (0, 7)+  let lbs = [20, 24, 28, 32, 40, 48, 56, 64] !! len+  ws <- vectorOf lbs arbitrary+  let bs = B.pack ws+  case cashAddress ver bs of+    Just a -> return a+    Nothing -> error "Error generating arbitrary CashAddress"

@@ -317,7 +317,11 @@  -- | Arbitrary 'ScriptOutput' of type 'PayScriptHash'. arbitrarySHOutput :: Gen ScriptOutput-arbitrarySHOutput = PayScriptHash . (.hash160) <$> arbitraryScriptAddress+arbitrarySHOutput = do+  address <- arbitraryScriptAddress+  case addressHash160 address of+    Just h -> return $ PayScriptHash h+    Nothing -> error "Could not get Hash160 from address"  -- | Arbitrary 'ScriptOutput' of type 'DataCarrier'. arbitraryDCOutput :: Gen ScriptOutput

@@ -15,6 +15,7 @@ import Data.ByteString qualified as BS import Data.Either (fromRight) import Data.List (nub, nubBy, permutations)+import Data.Maybe (fromMaybe) import Data.Word (Word64) import Haskoin.Address import Haskoin.Crypto (Ctx)@@ -158,7 +159,9 @@ arbitraryAnyInput net ctx pkh = do   (k, p) <- arbitraryKeyPair ctx   let out-        | pkh = PayPKHash (pubKeyAddr ctx p).hash160+        | pkh = case addressHash160 (pubKeyAddr ctx p) of+            Just h -> PayPKHash h+            Nothing -> error "Could not get Hash160 from address"         | otherwise = PayPK p   (val, op, sh) <- arbitraryInputStuff net   return (SigInput out val op sh Nothing, k)@@ -192,14 +195,18 @@         wrapKey <$> arbitraryPKHashSigInput net ctx,         arbitraryMSSigInput net ctx       ]-  let out = PayScriptHash (payToScriptAddress ctx rdm).hash160+  let out = case addressHash160 (payToScriptAddress ctx rdm) of+        Just h -> PayScriptHash h+        Nothing -> error "Could not get Hash160 from address"   return (SigInput out val op sh $ Just rdm, ks)  arbitraryWPKHSigInput :: Network -> Ctx -> Gen (SigInput, PrivateKey) arbitraryWPKHSigInput net ctx = do   (k, p) <- arbitraryKeyPair ctx   (val, op, sh) <- arbitraryInputStuff net-  let out = PayWitnessPKHash (pubKeyAddr ctx p).hash160+  let out = case addressHash160 (pubKeyAddr ctx p) of+        Just h -> PayWitnessPKHash h+        Nothing -> error "Could not get Hash160 from address"   return (SigInput out val op sh Nothing, k)  arbitraryWSHSigInput :: Network -> Ctx -> Gen (SigInput, [PrivateKey])@@ -210,7 +217,9 @@         wrapKey <$> arbitraryPKHashSigInput net ctx,         arbitraryMSSigInput net ctx       ]-  let out = PayWitnessScriptHash (payToWitnessScriptAddress ctx rdm).hash256+  let out = case addressHash256 (payToWitnessScriptAddress ctx rdm) of+        Just h -> PayWitnessScriptHash h+        Nothing -> error "Could not get Hash256 from address"   return (SigInput out val op sh $ Just rdm, ks)  -- | Arbitrary 'Tx' (empty 'TxIn'), 'SigInputs' and private keys that can be@@ -268,9 +277,13 @@       let pubKeys = map snd keys           prvKeys = take nPrv $ permutations (map fst keys) !! perm       let so = PayMulSig pubKeys m+      let h =+            fromMaybe+              (error "Could not get Hash160 from address")+              (addressHash160 (payToScriptAddress ctx so))       elements         [ (so, val, Nothing, prvKeys, m, n),-          ( PayScriptHash (payToScriptAddress ctx so).hash160,+          ( PayScriptHash h,             val,             Just so,             prvKeys,

@@ -232,17 +232,16 @@ testMarshalJson gen = do   prop ("MarshalJSON marshalValue/unmarshalValue identity for " <> name) $     forAll gen $-      \(s, a) -> a `shouldSatisfy` marshalJsonID s+      \(s, a) -> val s a `shouldBe` Just a   prop ("MarshalJSON marshalEncoding/unmarshalValue identity for " <> name) $     forAll gen $-      \(s, a) -> a `shouldSatisfy` marshalEncodingID s+      \(s, a) -> enc s a `shouldBe` Just a   where     name = show $ T.typeRep $ proxy gen     proxy :: Gen (s, a) -> Proxy a     proxy = const Proxy-    marshalJsonID s a =-      A.parseMaybe (unmarshalValue s) (marshalValue s a) == Just a-    marshalEncodingID s a = unmarshalJSON s (marshalJSON s a) == Just a+    val s a = A.parseMaybe (unmarshalValue s) (marshalValue s a)+    enc s a = unmarshalJSON s (marshalJSON s a)  toMap :: a -> Map.Map String a toMap = Map.singleton "object"

@@ -3,6 +3,7 @@  module Haskoin.AddressSpec (spec) where +import Control.Monad import Data.ByteString (ByteString) import Data.ByteString qualified as B import Data.Default (def)@@ -20,30 +21,31 @@ import Test.Hspec.QuickCheck import Test.QuickCheck -identityTests :: IdentityTests-identityTests =+identityTests :: Network -> IdentityTests+identityTests net =   def-    { readTests = [ReadBox arbitraryAddressAll],-      serialTests = [SerialBox arbitraryAddressAll],+    { readTests = [ReadBox (arbitraryAddress net)],+      serialTests = [SerialBox (arbitraryAddress net)],       marshalJsonTests = [MarshalJsonBox arbitraryNetAddress]     }  spec :: Spec spec = prepareContext $ \ctx -> do-  testIdentity identityTests+  forM_ allNets $ \net -> testIdentity $ identityTests net   describe "Address properties" $ do     prop "encodes and decodes base58 bytestring" $       forAll arbitraryBS $ \bs ->-        decodeBase58 (encodeBase58 bs) == Just bs+        decodeBase58 (encodeBase58 bs) `shouldBe` Just bs     prop "encodes and decodes base58 bytestring with checksum" $       forAll arbitraryBS $ \bs ->-        decodeBase58Check (encodeBase58Check bs) == Just bs+        decodeBase58Check (encodeBase58Check bs) `shouldBe` Just bs     prop "textToAddr . addrToText identity" $       forAll arbitraryNetAddress $ \(net, a) ->-        (textToAddr net =<< addrToText net a) == Just a+        (textToAddr net =<< addrToText net a) `shouldBe` Just a     prop "outputAddress . addressToOutput identity" $-      forAll arbitraryAddress $ \a ->-        outputAddress ctx (addressToOutput a) == Just a+      forAll arbitraryNetAddress $ \(net, a) ->+        not (isCashAddress a) ==>+          (outputAddress ctx =<< addressToOutput a) `shouldBe` Just a   describe "Address vectors" $ do     it "Passes Base58 vectors 1" $       mapM_ testVector vectors

@@ -139,7 +139,8 @@   | otherwise = do       -- Test Addr to Script       let addrM = textToAddr net a-          scriptM = encodeHex . marshal ctx . addressToOutput <$> addrM+          outputM = addressToOutput =<< addrM+          scriptM = encodeHex . marshal ctx <$> outputM       assertBool ("Valid Address " <> cs a) $ isJust addrM       assertEqual "Address matches payload" (Just payload) scriptM       let pubAsWifM = fromWif net a@@ -210,7 +211,7 @@ sigMsg :: [B.ByteString] sigMsg =   [ mconcat ["Very secret message ", C.pack (show (i :: Int)), ": 11"]-    | i <- [0 .. 15]+  | i <- [0 .. 15]   ]  testSignature :: Ctx -> Hash256 -> Assertion

@@ -250,7 +250,7 @@         "619c335025c7f4012e556c2a58b2506e30b8511b53ade95ea316fd8c3286feb9"     [op0, op1] = (.outpoint) <$> unsignedTx.inputs     sigIn0 = SigInput (PayPK pubKey0) 625000000 op0 sigHashAll Nothing-    WitnessPubKeyAddress h = pubKeyWitnessAddr ctx $ toPubKey ctx key1+    Just h = addressHash160 . pubKeyWitnessAddr ctx $ toPubKey ctx key1     sigIn1 = SigInput (PayWitnessPKHash h) 600000000 op1 sigHashAll Nothing     generatedSignedTx = signTx btc ctx unsignedTx [sigIn0, sigIn1] [key0, key1] @@ -291,7 +291,7 @@       secHexKey         "eb696a065ef48a2192da5b28b694f87544b30fae8327c4510137a922f32c6dcf"     op0 = (head unsignedTx.inputs).outpoint-    WitnessPubKeyAddress h = pubKeyWitnessAddr ctx $ toPubKey ctx key0+    Just h = addressHash160 . pubKeyWitnessAddr ctx $ toPubKey ctx key0     sigIn0 = SigInput (PayWitnessPKHash h) 1000000000 op0 sigHashAll Nothing     generatedSignedTx = signNestedWitnessTx btc ctx unsignedTx [sigIn0] [key0] 

@@ -101,7 +101,7 @@   where     f0 = bloomCreate 2 0.001 0 BloomUpdateAll     f1 = bloomInsert f0 $ marshal ctx p-    f2 = bloomInsert f1 $ runPutS $ serialize (pubKeyAddr ctx p).hash160+    f2 = bloomInsert f1 $ runPutS $ serialize $ fromJust $ addressHash160 $ pubKeyAddr ctx p     k = fromJust $ fromWif btc "5Kg1gnAjaLfKiwhhPpGS3QfRg2m6awQvaj98JCZBZQ5SuS2F15C"     p = derivePublicKey ctx k     bs = fromJust $ decodeHex "038fc16b080000000000000001"

@@ -400,7 +400,7 @@     prevTx =       testUtxo [prevOut]     prevOutScript =-      addressToScript ctx (pubKeyAddr ctx pubKey)+      fromJust $ addressToScript ctx (pubKeyAddr ctx pubKey)     prevOut =       TxOut         { value = 200000000,

@@ -72,9 +72,8 @@       forAll arbitraryTxHash $         \h -> fromString (cs $ txHashToHex h) == h     prop "building address tx" $-      forAll arbitraryNetwork $ \net ->-        forAll arbitraryAddress $-          forAll (arbitrarySatoshi net) . testBuildAddrTx net ctx+      forAll arbitraryNetAddress $ \(net, addr) ->+        forAll (arbitrarySatoshi net) $ testBuildAddrTx net ctx addr     prop "guess transaction size" $       forAll arbitraryNetwork $ \net ->         forAll (arbitraryAddrOnlyTxFull net ctx) (testGuessSize net ctx)@@ -226,11 +225,11 @@  -- Transaction Properties -- -testBuildAddrTx :: Network -> Ctx -> Address -> TestCoin -> Bool+testBuildAddrTx :: Network -> Ctx -> Address -> TestCoin -> IO () testBuildAddrTx net ctx a (TestCoin v)-  | isPubKeyAddress a = PayPKHash a.hash160 == out-  | isScriptAddress a = PayScriptHash a.hash160 == out-  | otherwise = undefined+  | isPubKeyAddress a = (PayPKHash <$> addressHash160 a) `shouldBe` Just out+  | isScriptAddress a = (PayScriptHash <$> addressHash160 a) `shouldBe` Just out+  | otherwise = discard   where     out = either error id $ do       tx <- buildAddrTx net ctx [] [(fromJust (addrToText net a), v)]