haskoin-store-data-1.11.0: test/Haskoin/Store/DataSpec.hs
{-# LANGUAGE RecordWildCards #-}
module Haskoin.Store.DataSpec (spec) where
import Control.Monad (forM_)
import Data.Aeson (Value)
import Data.Aeson qualified as A
import Data.Aeson.KeyMap qualified as KeyMap
import Data.ByteString qualified as B
import Data.ByteString.Lazy qualified as BL
import Data.Bytes.Put (runPutS)
import Data.Bytes.Serial (Serial, serialize)
import Data.HashMap.Strict qualified as HashMap
import Data.IntMap qualified as IntMap
import Data.Maybe (fromJust)
import Data.Serialize qualified as S
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8)
import Haskoin
import Haskoin.Store.Data
import Haskoin.Store.Gen
import Haskoin.Store.Laws
import Haskoin.Util.Arbitrary
import Test.Hspec
import Test.Hspec.QuickCheck (prop)
import Test.QuickCheck
spec :: Spec
spec = prepareContext $ \ctx -> do
describe "Binary encoding" $ do
binaryLaws (arbitrary :: Gen BlockRef)
binaryLaws (arbitrary :: Gen TxRef)
binaryLaws (arbitrary :: Gen BlockData)
binaryLaws (arbitrary :: Gen Spender)
binaryLaws (arbitrary :: Gen Prev)
binaryLaws (arbitrary :: Gen Except)
binaryLaws (arbitrary :: Gen EventStream)
binaryLaws (arbitraryTxData ctx)
binaryLaws (arbitrary :: Gen XPubSummary)
binaryLaws (arbitrary :: Gen HealthCheck)
binaryLaws (arbitrary :: Gen Event)
binaryLaws (arbitrary :: Gen TxId)
binaryLaws (arbitrary :: Gen PeerInfo)
binaryLaws (arbitrary :: Gen (GenericResult BlockData))
binaryLaws (arbitrary :: Gen (RawResult BlockData))
binaryLaws (arbitrary :: Gen (RawResultList BlockData))
-- also covered inside the types below, but each has its own cereal and
-- binary instances
binaryLaws (anyNet arbitraryBalance)
binaryLaws (anyNet arbitraryUnspent)
binaryLaws (anyNet arbitraryStoreInput)
binaryLaws (anyNet arbitraryStoreOutput)
binaryLaws (anyNet arbitraryDeriveType)
binaryLaws (anyNet (`arbitraryXPubSpec` ctx))
binaryLaws (anyNet arbitraryXPubBal)
binaryLaws (anyNet arbitraryXPubUnspent)
binaryLaws (anyNet arbitraryTransaction)
describe "JSON" $ do
jsonLaws (arbitrary :: Gen TxRef)
jsonLaws (arbitrary :: Gen BlockRef)
jsonLaws (arbitrary :: Gen Spender)
jsonLaws (arbitrary :: Gen XPubSummary)
jsonLaws (arbitrary :: Gen HealthCheck)
jsonLaws (arbitrary :: Gen Event)
jsonLaws (arbitrary :: Gen TxId)
jsonLaws (arbitrary :: Gen PeerInfo)
jsonLaws (arbitrary :: Gen (GenericResult XPubSummary))
jsonLaws (arbitrary :: Gen (RawResult BlockData))
jsonLaws (arbitrary :: Gen (RawResultList BlockData))
jsonLaws (arbitrary :: Gen Except)
jsonLaws (arbitrary :: Gen BinfoWallet)
jsonLaws (arbitrary :: Gen BinfoSymbol)
jsonLaws (arbitrary :: Gen BinfoBlockInfo)
jsonLaws (arbitrary :: Gen BinfoInfo)
jsonLaws (arbitrary :: Gen BinfoSpender)
jsonLaws (arbitrary :: Gen BinfoRate)
jsonLaws (arbitrary :: Gen BinfoTicker)
jsonLaws (arbitrary :: Gen BinfoTxId)
jsonLaws (arbitrary :: Gen BinfoShortBal)
jsonLaws (arbitrary :: Gen BinfoHistory)
jsonLaws (arbitrary :: Gen BinfoHeader)
jsonLaws (arbitrary :: Gen BinfoBlockInfos)
describe "binary of a network" $
prop "EventCommand" . forAll (elements allNets) $ \net ->
forAll (arbitraryEventCommand net ctx) $ \x ->
unmarshal (net, ctx) (marshal (net, ctx) x) === Right x
-- Balance, Unspent, StoreInput, StoreOutput and the inputs and outputs of
-- BinfoTx are encoded through their own instances inside these.
describe "JSON of a network" $ do
let withCtx = (,ctx)
marshalLaws id arbitraryXPubBal
marshalLaws id arbitraryXPubUnspent
marshalLaws id arbitraryBlockData
marshalLaws id arbitraryTransaction
marshalLaws withCtx (`arbitraryEventCommand` ctx)
marshalLaws withCtx (`arbitraryBinfoMultiAddr` ctx)
marshalLaws withCtx (`arbitraryBinfoBalance` ctx)
marshalLaws withCtx (`arbitraryBinfoBlock` ctx)
marshalLaws withCtx (`arbitraryBinfoTx` ctx)
marshalLaws withCtx (`arbitraryBinfoXPubPath` ctx)
marshalLaws withCtx (`arbitraryBinfoUnspent` ctx)
marshalLaws withCtx (`arbitraryBinfoRawAddr` ctx)
marshalLaws withCtx (`arbitraryBinfoMempool` ctx)
describe "Health check" $ do
let bare =
HealthCheck
{ blocks = BlockHealth 10 10 2,
lastBlock = TimeHealth 5 100,
lastTx = TimeHealth 5 100,
pendingTxs = MaxHealth 0 100,
peers = CountHealth 3 1,
network = "btc",
version = "1.9.0",
time = 1700000000,
redis = Nothing
}
without key = \case
A.Object o -> A.Object (KeyMap.delete key o)
v -> v
it "reads what a store wrote before there was a check of Redis" $ do
-- the check of Redis is the last byte, and its key in JSON
let old = B.init (runPutS (serialize bare {redis = Just True}))
S.decode old `shouldBe` Right bare
A.fromJSON (without "redis" (A.toJSON bare {redis = Just False})) `shouldBe` A.Success bare
it "is fit to serve without its Redis, and says that it is without" $ do
isOK bare {redis = Just False} `shouldBe` True
A.toJSON bare {redis = Just False} `shouldSatisfy` \case
A.Object o -> KeyMap.lookup "redis" o == Just (A.object ["ok" A..= False])
_ -> False
A.toJSON bare `shouldSatisfy` \case
A.Object o -> not (KeyMap.member "redis" o)
_ -> False
-- Other programs read these formats: they must not change by accident.
describe "Wire format" $ do
let txid = TxHash (sha256 B.empty)
txidHex = "55b852781b9995a44c939b64e441ae2724b96f99c8f4fb9a141cfc9842c4b0e3"
txidRaw = "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855"
burn = fromJust (textToAddr btc "1111111111111111111114oLvT2")
wire (BlockRef 100 2) "{\"height\":100,\"position\":2}" "01ffffff9bfffffffd"
wire (MemRef 1700000000) "{\"mempool\":1700000000}" "00ffffffff9aac0eff"
wire (Spender txid 3) ("{\"txid\":\"" <> txidHex <> "\",\"input\":3}") (txidRaw <> "00000003")
wire
(TxRef (BlockRef 100 2) txid)
("{\"block\":{\"height\":100,\"position\":2},\"txid\":\"" <> txidHex <> "\"}")
("01ffffff9bfffffffd" <> txidRaw)
it "Balance" $
marshalValue btc (Balance burn 1 2 3 4 5)
`shouldBe` json
"{\"address\":\"1111111111111111111114oLvT2\",\"confirmed\":1,\
\\"unconfirmed\":2,\"utxo\":3,\"txs\":4,\"received\":5}"
it "XPubSummary" $
A.toJSON XPubSummary {confirmed = 1, unconfirmed = 2, received = 3, utxo = 4, change = 5, external = 6}
`shouldBe` json
"{\"balance\":{\"confirmed\":1,\"unconfirmed\":2,\"received\":3,\"utxo\":4},\
\\"indices\":{\"change\":5,\"external\":6}}"
describe "Blockchain.info helpers" $ do
it "reads its request parameters" $ do
let h = TxHash (sha256 B.empty)
b = BlockHash (sha256 B.empty)
parseBinfoTxId (txHashToHex h) `shouldBe` Just (BinfoTxIdHash h)
parseBinfoTxId "8011147086339971" `shouldBe` Just (BinfoTxIdIndex 8011147086339971)
parseBinfoTxId "nonsense" `shouldBe` Nothing
parseBinfoBlockId (blockHashToHex b) `shouldBe` Just (BinfoBlockHash b)
parseBinfoBlockId "100" `shouldBe` Just (BinfoBlockIndex 100)
map parseBinfoFilter ["0", "1", "2", "3", "4", "5", "6", "7"]
`shouldBe` [ Just BinfoFilterAll,
Just BinfoFilterSent,
Just BinfoFilterReceived,
Just BinfoFilterMoved,
Nothing,
Just BinfoFilterConfirmed,
Just BinfoFilterAll,
Just BinfoFilterMempool
]
map parseBinfoDate ["09-11-2026", "09/11/2026", "2026-11-09"]
`shouldBe` [Just (BinfoDate 1794182400), Just (BinfoDate 1794182400), Nothing]
it "numbers a transaction by the first bits of its hash" $ do
let h = TxHash (sha256 B.empty)
encodeBinfoTxId False h `shouldBe` BinfoTxIdHash h
encodeBinfoTxId True h `shouldBe` BinfoTxIdIndex 8011147086339971
it "writes values as signed big-endian hexadecimal" $
map binfoHexValue [0, 1, 127, 128, 255, 256, 65535]
`shouldBe` ["00", "01", "7f", "0080", "00ff", "0100", "00ffff"]
it "reads addresses and xpubs separated by bars or commas" $
forAll (vectorOf 3 (arbitraryAddress btc)) $ \as ->
forAll (arbitraryXPubKey ctx) $ \x ->
let txt = mconcat [t <> sep | (a, sep) <- zip as ["|", ",", "|"], Just t <- [addrToText btc a]] <> xPubExport btc ctx x
in parseBinfoAddr btc ctx txt `shouldBe` Just (map BinfoAddr as <> [BinfoXpub x])
it "refuses anything that is neither an address nor an xpub" $
parseBinfoAddr btc ctx "nonsense" `shouldBe` Nothing
it "reads nothing from nothing" $
parseBinfoAddr btc ctx "" `shouldBe` Just []
it "gives the next indices of an xpub and counts only payments to it" $
forAll (arbitraryXPubSpec btc ctx) $ \x ->
forAll (vectorOf 3 (arbitraryAddress btc)) $ \as -> case as of
[a1, a2, a3] ->
let bal a r c = (zeroBalance a) {received = r, confirmed = c, txs = 1}
xbals =
[ XPubBal [0, 4] (bal a1 100 60),
XPubBal [0, 1] (bal a2 50 0),
XPubBal [1, 2] (bal a3 30 30)
]
in case toBinfoAddrs HashMap.empty (HashMap.singleton x xbals) (HashMap.singleton x 7) of
[BinfoXPubBalance {..}] ->
(external, change, received, balance, sent, txs) `shouldBe` (5, 3, 150, 90, 60, 7)
bs -> expectationFailure ("not the balance of one xpub: " <> show bs)
_ -> discard
describe "Balances" $
it "are null only when nothing ever touched the address" $
forAll (arbitraryBalance btc) $ \b ->
nullBalance b
=== (b.confirmed == 0 && b.unconfirmed == 0 && b.utxo == 0 && b.txs == 0 && b.received == 0)
.&&. nullBalance (zeroBalance b.address)
describe "Derivation types" $
it "are named legacy, compat and segwit, and read normal as legacy" $ do
map deriveTypeToText [DeriveNormal, DeriveP2SH, DeriveP2WPKH]
`shouldBe` ["legacy", "compat", "segwit"]
map textToDeriveType ["legacy", "normal", "compat", "segwit", "other", "Legacy"]
`shouldBe` map Just [DeriveNormal, DeriveNormal, DeriveP2SH, DeriveP2WPKH]
<> [Nothing, Nothing]
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
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 "computes the id, size, weight and witnesses of the transaction" $
forAll (arbitraryTxData ctx) $ \td ->
let t = toTransaction btc ctx td
len :: Tx -> Int
len = B.length . runPutS . serialize
witless = let Tx {..} = td.tx in Tx {witness = [], ..}
ws = take (length td.tx.inputs) (td.tx.witness <> repeat [])
in (t.txid, t.size, t.weight, map (.witness) t.inputs)
`shouldBe` ( txHash td.tx,
fromIntegral (len td.tx),
fromIntegral (len witless * 3 + len td.tx),
ws
)
-- an output has an address only where the network has that kind
forM_
[ ("a SegWit output an address on Bitcoin", btc, p2wpkh, "\"bc1qw508d6qejxtdg4y5r3zarvary0c5xw7kv8f3t4\""),
("a SegWit-shaped output no address on Bitcoin Cash", bch, p2wpkh, "null"),
("a 256-bit hash lock no address on Bitcoin", btc, hashLock, "null")
]
$ \(what, net, script, addr) ->
it ("gives " <> what) $
outputJson net script
`shouldBe` [ json
( "{\"address\":"
<> addr
<> ",\"pkscript\":\""
<> BL.fromStrict (encodeUtf8 script)
<> "\",\"value\":1000,\"spent\":false,\"spender\":null}"
)
]
where
z = sha256 B.empty
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
-- | A value has this JSON and these bytes.
wire :: (Show a, A.ToJSON a, Serial a) => a -> BL.ByteString -> Text -> Spec
wire x j h =
it (takeWhile (/= ' ') (show x)) $ do
A.toJSON x `shouldBe` json j
encodeHex (runPutS (serialize x)) `shouldBe` h
-- | Read a JSON literal.
json :: BL.ByteString -> Value
json = fromJust . A.decode