haskoin-store-data 1.6.3 → 1.7.0

raw patch · 3 files changed

+160/−23 lines, 3 filesdep ~haskoin-corePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: haskoin-core

API changes (from Hackage documentation)

Files

• haskoin-store-data.cabal +3/−3
• src/Haskoin/Store/Data.hs +74/−17
• test/Haskoin/Store/DataSpec.hs +83/−3

@@ -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 <https://github.com/jprupp/haskoin-store#readme> 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

@@ -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         ]

@@ -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 =