diff --git a/haskoin-store-data.cabal b/haskoin-store-data.cabal --- a/haskoin-store-data.cabal +++ b/haskoin-store-data.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: haskoin-store-data -version: 1.6.3 +version: 1.7.0 synopsis: Data for Haskoin Store description: Please see the README on GitHub at category: Bitcoin, Finance, Network @@ -41,7 +41,7 @@ , data-default >=0.7.1.1 , deepseq >=1.4.4.0 , hashable >=1.3.0.0 - , haskoin-core >=1.0.0 + , haskoin-core >=1.6.0 , http-client >=0.6.4.1 , http-types >=0.12.3 , lens >=4.18.1 @@ -78,7 +78,7 @@ , data-default >=0.7.1.1 , deepseq >=1.4.4.0 , hashable >=1.3.0.0 - , haskoin-core >=1.0.0 + , haskoin-core >=1.6.0 , haskoin-store-data , hspec >=2.7.1 , http-client >=0.6.4.1 diff --git a/src/Haskoin/Store/Data.hs b/src/Haskoin/Store/Data.hs --- a/src/Haskoin/Store/Data.hs +++ b/src/Haskoin/Store/Data.hs @@ -253,7 +253,10 @@ parent <- deserialize index <- getWord32be chain <- deserialize - key <- PubKey <$> getByteString 64 + -- The internal form of libsecp256k1, as the key was stored; pubKey + -- checks that it is one, which the raw constructor of secp256k1-haskell + -- 1.x did not + key <- maybe (fail "XPubSpec: not a public key") return . pubKey =<< getByteString 64 deriv <- deserialize return XPubSpec {key = XPubKey {..}, deriv} @@ -529,7 +532,56 @@ instance Coin Unspent where coinValue = (.value) + coinInputKind = scriptInputKind . (.script) +-- | Kind of the input that spends an output with this script, for fee +-- estimation. Read from the script bytes, as no context is at hand to parse +-- public keys. A script hash or witness script hash does not tell what it +-- hides: they are taken for the most common single-key case, a nested +-- witness public key hash and a one-of-one witness multisig. Any other +-- script counts as a public key hash. +scriptInputKind :: ByteString -> InputKind +scriptInputKind s + | len == 25 && B.take 3 s == B.pack [0x76, 0xa9, 0x14] && B.drop 23 s == B.pack [0x88, 0xac] = + InputPKHash + | len == 23 && B.take 2 s == B.pack [0xa9, 0x14] && B.last s == 0x87 = + InputNestedWitnessPKHash + | len == 22 && B.take 2 s == B.pack [0x00, 0x14] = + InputWitnessPKHash + | len == 34 && B.take 2 s == B.pack [0x00, 0x20] = + InputWitnessMulSig 1 1 + | len == 34 && B.take 2 s == B.pack [0x51, 0x20] = + InputTaproot + | (len == 35 && B.head s == 0x21 || len == 67 && B.head s == 0x41) && B.last s == 0xac = + InputPK + | Right (Script ops) <- runGetS deserialize s, + Just (m, n) <- multisig ops = + InputMulSig m n + | otherwise = + InputPKHash + where + len = B.length s + multisig (op_m : rest) + | Just m <- op_int op_m, + (op_n : [OP_CHECKMULTISIG]) <- drop (length rest - 2) rest, + Just n <- op_int op_n, + keys <- take (length rest - 2) rest, + length keys == n, + all is_key keys, + m >= 1, + m <= n = + Just (m, n) + multisig _ = Nothing + -- OP_1 to OP_16, or a one-byte push for counts above 16 + op_int op = case scriptOpToInt op of + Right i -> Just i + Left _ -> case pushOpData op of + Just b | B.length b == 1 -> Just (fromIntegral (B.head b)) + _ -> Nothing + is_key op = case pushOpData op of + Just k -> B.length k == 33 || B.length k == 65 + Nothing -> False + instance MarshalJSON Network Unspent where marshalValue net u = A.object @@ -956,15 +1008,15 @@ put = serialize get = deserialize -toInput :: Ctx -> TxIn -> Maybe Prev -> WitnessStack -> StoreInput -toInput ctx i Nothing w = +toInput :: Network -> Ctx -> TxIn -> Maybe Prev -> WitnessStack -> StoreInput +toInput _ _ i Nothing w = StoreCoinbase { outpoint = i.outpoint, sequence = i.sequence, script = i.script, witness = w } -toInput ctx i (Just p) w = +toInput net ctx i (Just p) w = StoreInput { outpoint = i.outpoint, sequence = i.sequence, @@ -972,16 +1024,16 @@ pkscript = p.script, value = p.value, witness = w, - address = eitherToMaybe (scriptToAddressBS ctx p.script) + address = eitherToMaybe (scriptToAddressBS net ctx p.script) } -toOutput :: Ctx -> TxOut -> Maybe Spender -> StoreOutput -toOutput ctx o s = +toOutput :: Network -> Ctx -> TxOut -> Maybe Spender -> StoreOutput +toOutput net ctx o s = StoreOutput { value = o.value, script = o.script, spender = s, - address = eitherToMaybe (scriptToAddressBS ctx o.script) + address = eitherToMaybe (scriptToAddressBS net ctx o.script) } data TxData = TxData @@ -1031,8 +1083,11 @@ inputs = sum $ map (.value) $ IntMap.elems t.prevs outputs = sum $ map (.value) t.tx.outputs -toTransaction :: Ctx -> TxData -> Transaction -toTransaction ctx t = +-- | Build the API form of a stored transaction. The network decides which +-- output scripts have an address. A SegWit-shaped script has none on Bitcoin +-- Cash, for example. +toTransaction :: Network -> Ctx -> TxData -> Transaction +toTransaction net ctx t = Transaction { version = t.tx.version, locktime = t.tx.locktime, @@ -1066,8 +1121,8 @@ outs = zipWith g [0 ..] t.tx.outputs outv = sum $ map (.value) outs ws = take (length t.tx.inputs) $ t.tx.witness <> repeat [] - f n i = toInput ctx i (IntMap.lookup n t.prevs) (ws !! n) - g n o = toOutput ctx o $ IntMap.lookup n t.spenders + f n i = toInput net ctx i (IntMap.lookup n t.prevs) (ws !! n) + g n o = toOutput net ctx o $ IntMap.lookup n t.spenders fromTransaction :: Transaction -> TxData fromTransaction t = @@ -1232,8 +1287,10 @@ userAgent :: !ByteString, -- | network address address :: !String, - -- | version number - version :: !Word32, + -- | protocol version from the peer's version message. It is a signed + -- number, as in Bitcoin Core and haskoin-core, so a peer that sends + -- ffffffff has version -1. + version :: !Int32, -- | services field services :: !Word64, -- | will relay transactions @@ -1245,13 +1302,13 @@ serialize p = do putLengthBytes p.userAgent putLengthBytes $ T.encodeUtf8 $ T.pack p.address - putWord32be p.version + putInt32be p.version putWord64be p.services serialize p.relay deserialize = do userAgent <- getLengthBytes address <- T.unpack . T.decodeUtf8 <$> getLengthBytes - version <- getWord32be + version <- getInt32be services <- getWord64be relay <- deserialize return PeerInfo {..} @@ -1279,7 +1336,7 @@ mconcat [ "useragent" `A.pair` A.text (T.decodeUtf8 p.userAgent), "address" `A.pair` toEncoding p.address, - "version" `A.pair` A.word32 p.version, + "version" `A.pair` A.int32 p.version, "services" `A.pair` hexEncoding (runPutL $ serialize p.services), "relay" `A.pair` A.bool p.relay ] diff --git a/test/Haskoin/Store/DataSpec.hs b/test/Haskoin/Store/DataSpec.hs --- a/test/Haskoin/Store/DataSpec.hs +++ b/test/Haskoin/Store/DataSpec.hs @@ -3,6 +3,8 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} @@ -14,9 +16,14 @@ import Control.Arrow (second) import Control.Monad (forM_) -import Data.Aeson (FromJSON (..)) +import Data.Aeson (FromJSON (..), Value) +import Data.Aeson qualified as A import Data.ByteString qualified as B -import Data.Maybe (isJust) +import Data.ByteString.Lazy qualified as BL +import Data.Bytes.Put (runPutS) +import Data.Bytes.Serial (serialize) +import Data.IntMap qualified as IntMap +import Data.Maybe (fromJust, isJust) import Data.String.Conversions (cs) import Haskoin import Haskoin.Store.Data @@ -115,7 +122,80 @@ return (net, x) spec :: Spec -spec = forM_ allNets $ \net -> prepareContext (testIdentity . identityTests net) +spec = do + forM_ allNets $ \net -> prepareContext (testIdentity . identityTests net) + prepareContext $ \ctx -> describe "Coin instance of Unspent" $ + it "reads the input kind from the output script" $ + property $ + forAll (arbitraryScriptOutput btc ctx) $ \so -> + case encodeOutput ctx so of + Left _ -> discard + Right script -> + let u = + Unspent + { block = MemRef 0, + outpoint = OutPoint (TxHash z) 0, + value = 1, + script = runPutS (serialize script), + address = Nothing + } + in coinInputKind u `shouldBe` expectedKind so + prepareContext $ \ctx -> describe "toTransaction" $ do + -- The JSON of the only output of a transaction that pays 1000 satoshi + -- to a script given in hex. + let outputJson net scriptHex = + let script = fromJust (decodeHex scriptHex) + tx = Tx 2 [TxIn (OutPoint (TxHash z) 0) "" maxBound] [TxOut 1000 script] [] 0 + td = + TxData + { block = MemRef 0, + tx = tx, + prevs = IntMap.empty, + deleted = False, + rbf = False, + timestamp = 0, + spenders = IntMap.empty + } + in map (marshalValue net) (toTransaction net ctx td).outputs + -- Pay to witness public key hash, from the examples of BIP 173. + p2wpkh = "0014751e76e8199196d454941c45d1b3a323f1433bd6" + -- OP_HASH256, a push of 32 bytes, OP_EQUAL. + hashLock = "aa20bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb87" + it "gives a SegWit output its address on Bitcoin" $ + outputJson btc p2wpkh + `shouldBe` [ json + "{\"address\":\"bc1qw508d6qejxtdg4y5r3zarvary0c5xw7kv8f3t4\",\ + \\"pkscript\":\"0014751e76e8199196d454941c45d1b3a323f1433bd6\",\ + \\"value\":1000,\"spent\":false,\"spender\":null}" + ] + it "gives a SegWit-shaped output no address on Bitcoin Cash, which has no SegWit" $ + outputJson bch p2wpkh + `shouldBe` [ json + "{\"address\":null,\ + \\"pkscript\":\"0014751e76e8199196d454941c45d1b3a323f1433bd6\",\ + \\"value\":1000,\"spent\":false,\"spender\":null}" + ] + it "gives a 256-bit hash lock output no address on Bitcoin, which has no such address" $ + outputJson btc hashLock + `shouldBe` [ json + "{\"address\":null,\ + \\"pkscript\":\"aa20bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb87\",\ + \\"value\":1000,\"spent\":false,\"spender\":null}" + ] + where + z = sha256 B.empty + -- Read a JSON literal. + json :: BL.ByteString -> Value + json = fromJust . A.decode + expectedKind = \case + PayPK {} -> InputPK + PayPKHash {} -> InputPKHash + PayMulSig {keys, required} -> InputMulSig required (length keys) + PayScriptHash {} -> InputNestedWitnessPKHash + PayWitnessPKHash {} -> InputWitnessPKHash + PayWitnessScriptHash {} -> InputWitnessMulSig 1 1 + PayWitness 1 bs | B.length bs == 32 -> InputTaproot + _ -> InputPKHash instance Arbitrary BlockRef where arbitrary =