diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -6,6 +6,25 @@ ## [Unreleased] +## [1.11.0] - 2026-11-10 + +### Added + +- `EventCommand`: what a client sends over the WebSocket at `/events` to + choose the transactions it hears about. It watches addresses + (`EventWatch`, `EventUnwatch`), extended public keys with a type of + address (`EventWatchXPub`, `EventUnwatchXPub`), or what matches a Bloom + filter as in BIP 37 (`EventFilterLoad`, `EventFilterAdd`, + `EventFilterClear`); `EventAll` goes back to every transaction, and + `EventNone` to blocks alone. It has + `Marshal` for binary frames and `MarshalJSON` for text frames, both given + the network. A key is written in binary as in BIP 32, in the 78 bytes + that its text decodes to. Servers understand it from the release of + haskoin-store after 1.8.1. +- `apiEventsAfter` listens to the events that came after one that the + client names, so that a client that lost its connection misses nothing. + The server answers `ThingNotFound` when it no longer has that event. + ## [1.10.0] - 2026-11-10 ### Added diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -15,7 +15,7 @@ - `Haskoin.Store.WebCommon`: the requests of the API, one type per endpoint, with their paths and parameters. - `Haskoin.Store.WebClient`: `apiCall`, which sends a request and decodes - the answer. + the answer, and `apiEvents`, which listens to the events of a server. ## Example @@ -40,6 +40,40 @@ encoding too, so a server can answer a binary request with a binary error. The client reads the `Content-Type` of an error to tell which it got, and so works with servers of either kind. + +## Events + +`apiEvents` calls a function with each new block and each transaction that +enters or leaves the mempool, for as long as the function answers `True`. +After a lost connection, `apiEventsAfter` takes up from the last event +heard, so nothing is missed; if the server no longer has that event it +answers `ThingNotFound`, and the client reads what it follows again. + +Over the WebSocket at `/events` a client can also choose the transactions +it hears about. `EventCommand` is what it sends: addresses to watch, +extended public keys (one command for each type of address), or a Bloom +filter as in BIP 37. It has a binary encoding and a JSON one, for binary +and text frames. This package has no WebSocket client of its own; send the +encoded command with the one you use: + +```haskell +import Haskoin (marshalJSON) +import Haskoin.Store.Data (EventCommand (..)) + +-- a text frame: {"type":"watch","addresses":["bc1q…"]} +frame = marshalJSON (net, ctx) (EventWatch [addr]) +``` + +Blocks are always told. A connection that has sent no command hears of +every transaction, unless its URL says what to watch, or `quiet=true` for +blocks alone. + +The bytes of every type, for someone who writes a client in another +language, are in the "Binary format" section of +[`swagger.yaml`](https://github.com/jprupp/haskoin-store/blob/master/swagger.yaml) +in the haskoin-store repository. In short: integers are big-endian, a list +is its length as 64 bits and then its items, and the events of `/events` +are the one thing sent without a length. ## Building 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.10.0 +version: 1.11.0 synopsis: Data types and API client of Haskoin Store description: The types of the data that Haskoin Store serves (blocks, transactions, balances, unspent outputs, extended public keys, health checks, events and 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 @@ -87,6 +87,7 @@ MaxHealth (..), HealthCheck (..), Event (..), + EventCommand (..), Except (..), -- * Blockchain.info API @@ -137,7 +138,7 @@ import Control.Applicative (optional, (<|>)) import Control.DeepSeq (NFData) import Control.Exception (Exception) -import Control.Monad (guard, join, mzero, unless) +import Control.Monad (guard, join, mzero, unless, when) import Data.Aeson ( FromJSON (..), ToJSON (..), @@ -178,6 +179,7 @@ mapMaybe, maybeToList, ) +import Data.Sequence qualified as Seq import Data.Serialize (Serialize (..)) import Data.String.Conversions (cs) import Data.Text (Text) @@ -193,7 +195,7 @@ parseTimeM, ) import Data.Vector qualified as V -import Data.Word (Word32, Word64) +import Data.Word (Word32, Word64, Word8) import GHC.Generics (Generic) import Haskoin import Text.Read (readMaybe) @@ -1999,6 +2001,181 @@ i <- o .: "id" return $ EventBlock i _ -> fail $ "Could not recognize event type: " <> t + +-- | What a client says to the server over the WebSocket at @\/events@, to +-- choose the transactions it hears about. +-- +-- A wallet cares for its own transactions, and a busy mempool has thousands +-- of others, each an event that costs the client a request to find out it +-- was not for it. With these the server does the sorting: it knows the body +-- of every transaction as it comes in, and tells a client only of those that +-- touch what the client watches. It follows the three ways a wallet has of +-- saying what is its own: a list of addresses, an extended public key, and +-- the Bloom filter of BIP 37 that SPV clients send to a node, which hides +-- the addresses among false positives. +-- +-- A connection starts unfiltered and hears of every transaction, as it did +-- before these existed, unless the URL that opened it says otherwise. The +-- first of these commands, other than 'EventAll', turns it into a filtered +-- one, which hears of a transaction +-- when it matches the filter or pays to or spends from a watched address or +-- one derived from a watched key. Blocks are always reported: there are few, +-- and they are how a client knows that its transactions confirmed. +-- +-- There are no answers. As between a node and an SPV client, a command the +-- server cannot accept ends the connection, with the reason in the close +-- frame. +-- +-- In binary a command is one byte, the number given with each below, and +-- then what it carries ('Marshal'). In JSON it is an object with a @type@ +-- ('MarshalJSON'). A key is watched under one type of address; a wallet +-- that uses several sends a command for each. +data EventCommand + = -- | @0x00@, @{"type":"watch","addresses":[...]}@: watch these + -- addresses as well; a counted list in binary + EventWatch ![Address] + | -- | @0x01@, @{"type":"unwatch","addresses":[...]}@: stop watching + -- these addresses + EventUnwatch ![Address] + | -- | @0x02@, @{"type":"watch","xpub":"...","derive":"segwit"}@: watch + -- the addresses of this key as well, those in use and the gap after + -- them, which moves on as they get used; @derive@ may be left out for + -- legacy addresses; in binary the 78 bytes of the key as in BIP 32 and + -- a byte for the type, @00@ legacy, @01@ compat, @02@ segwit + EventWatchXPub !XPubSpec + | -- | @0x03@, @{"type":"unwatch","xpub":"...","derive":"segwit"}@: stop + -- watching this key + EventUnwatchXPub !XPubSpec + | -- | @0x04@, + -- @{"type":"filterload","filter":"hex","functions":n,"tweak":n,"flags":n}@: + -- set the Bloom filter of the connection, in place of the one it had; + -- in binary it is laid out as in the @filterload@ message of the + -- Bitcoin protocol + EventFilterLoad !BloomFilter + | -- | @0x05@, @{"type":"filteradd","data":"hex"}@: add an element of at + -- most 'maxFilterAddSize' bytes to the filter; bytes with their + -- length in binary + EventFilterAdd !ByteString + | -- | @0x06@, @{"type":"filterclear"}@: remove the filter; the addresses + -- and keys stay watched + EventFilterClear + | -- | @0x07@, @{"type":"all"}@: forget everything watched and the filter, + -- and hear of every transaction again + EventAll + | -- | @0x08@, @{"type":"none"}@: forget everything watched and the filter, + -- and hear of no transaction, only of blocks, until something is + -- watched + EventNone + deriving (Show, Eq, Generic, NFData) + +-- | The binary form, for binary frames. It takes the network and the +-- context because an extended public key is written as BIP 32 writes it, +-- in the 78 bytes that the Base58Check of its text decodes to, which every +-- wallet library has: the bytes that the database uses for a key are those +-- of one C library, and no client in another language could make them. +instance Marshal (Network, Ctx) EventCommand where + marshalPut s = \case + EventWatch as -> putWord8 0x00 >> putList serialize as + EventUnwatch as -> putWord8 0x01 >> putList serialize as + EventWatchXPub x -> putWord8 0x02 >> marshalPut s x.key >> serialize x.deriv + EventUnwatchXPub x -> putWord8 0x03 >> marshalPut s x.key >> serialize x.deriv + EventFilterLoad f -> putWord8 0x04 >> serialize f + EventFilterAdd d -> putWord8 0x05 >> putLengthBytes d + EventFilterClear -> putWord8 0x06 + EventAll -> putWord8 0x07 + EventNone -> putWord8 0x08 + marshalGet s = + getWord8 >>= \case + 0x00 -> EventWatch <$> getList deserialize + 0x01 -> EventUnwatch <$> getList deserialize + 0x02 -> EventWatchXPub <$> xpub + 0x03 -> EventUnwatchXPub <$> xpub + 0x04 -> EventFilterLoad <$> deserialize + 0x05 -> EventFilterAdd <$> (filterElement =<< getLengthBytes) + 0x06 -> return EventFilterClear + 0x07 -> return EventAll + 0x08 -> return EventNone + _ -> fail "Not an EventCommand" + where + xpub = do + key <- marshalGet s + deriv <- + getWord8 >>= \case + 0x00 -> return DeriveNormal + 0x01 -> return DeriveP2SH + 0x02 -> return DeriveP2WPKH + _ -> fail "Unknown derivation" + return XPubSpec {..} + +-- | An element for a Bloom filter, refused when longer than a node takes. +filterElement :: (MonadFail m) => ByteString -> m ByteString +filterElement d + | B.length d > maxFilterAddSize = fail "Filter element too long" + | otherwise = return d + +-- | The text of an address depends on the network, and that of an extended +-- public key needs the context of the library that checks it. +instance MarshalJSON (Network, Ctx) EventCommand where + marshalValue (net, ctx) = \case + EventWatch as -> addresses "watch" as + EventUnwatch as -> addresses "unwatch" as + EventWatchXPub x -> xpub "watch" x + EventUnwatchXPub x -> xpub "unwatch" x + EventFilterLoad f -> + A.object + [ "type" .= String "filterload", + "filter" .= encodeHex (B.pack (toList f.array)), + "functions" .= f.functions, + "tweak" .= f.tweak, + "flags" .= B.head (runPutS (serialize f.flags)) + ] + EventFilterAdd d -> + A.object ["type" .= String "filteradd", "data" .= encodeHex d] + EventFilterClear -> A.object ["type" .= String "filterclear"] + EventAll -> A.object ["type" .= String "all"] + EventNone -> A.object ["type" .= String "none"] + where + addresses t as = + A.object ["type" .= String t, "addresses" .= map (marshalValue net) as] + xpub t x = + A.object + [ "type" .= String t, + "xpub" .= marshalValue (net, ctx) x.key, + "derive" .= deriveTypeToText x.deriv + ] + + unmarshalValue (net, ctx) = + A.withObject "EventCommand" $ \o -> + o .: "type" >>= \case + "watch" -> watched o EventWatch EventWatchXPub + "unwatch" -> watched o EventUnwatch EventUnwatchXPub + "filterload" -> do + bytes <- hex =<< o .: "filter" + when (B.length bytes > maxBloomSize) $ fail "Filter too large" + functions <- o .: "functions" + when (functions > maxHashFuncs) $ fail "Too many hash functions" + tweak <- o .:? "tweak" .!= 0 + flags <- o .:? "flags" .!= (0 :: Word8) >>= flag + return . EventFilterLoad $ + BloomFilter {array = Seq.fromList (B.unpack bytes), ..} + "filteradd" -> fmap EventFilterAdd $ o .: "data" >>= hex >>= filterElement + "filterclear" -> return EventFilterClear + "all" -> return EventAll + "none" -> return EventNone + t -> fail $ "Could not recognize command type: " <> t + where + watched o as xs = + o .:? "xpub" >>= \case + Just v -> do + key <- unmarshalValue (net, ctx) v + name <- o .:? "derive" .!= "legacy" + deriv <- maybe (fail "Unknown derivation") return (textToDeriveType name) + return $ xs XPubSpec {..} + Nothing -> fmap as $ o .: "addresses" >>= mapM (unmarshalValue net) + hex = maybe (fail "Not hexadecimal") return . decodeHex + flag n + | n > 2 = fail "Unknown filter flags" + | otherwise = either fail return $ runGetS deserialize (B.singleton n) -- | Response that wraps a single value, encoded in JSON as @{\"result\": value}@. newtype GenericResult a = GenericResult {get :: a} diff --git a/src/Haskoin/Store/WebClient.hs b/src/Haskoin/Store/WebClient.hs --- a/src/Haskoin/Store/WebClient.hs +++ b/src/Haskoin/Store/WebClient.hs @@ -30,6 +30,7 @@ apiCall, apiBatch, apiEvents, + apiEventsAfter, -- * Blocks GetBlock (..), @@ -104,6 +105,7 @@ import Data.String.Conversions (cs) import Data.Text (Text) import Data.Text qualified as Text +import Haskoin.Block (blockHashToHex) import Haskoin.Crypto (Ctx) import Haskoin.Network import Haskoin.Store.Data qualified as Store @@ -204,14 +206,34 @@ -- -- > apiEvents def $ \event -> print event >> return True apiEvents :: ApiConfig -> (Store.Event -> IO Bool) -> IO (Either Store.Except ()) -apiEvents (ApiConfig net apiHost) handle = do +apiEvents conf = listenEvents conf Nothing + +-- | 'apiEvents' from an event on: the function is called with what came +-- after it. A client that lost its connection calls this with the last +-- event it heard, and misses nothing. +-- +-- The server keeps its last ten thousand events. When it no longer has the +-- one given, or never had it, the answer is 'Store.ThingNotFound': the +-- client cannot know what it missed, and has to read what it follows again +-- and listen with 'apiEvents'. A transaction has an event when it enters +-- the mempool and another if it leaves unconfirmed, both with its hash, and +-- the server starts after the first: some events may be told twice, none +-- is left out. In a fleet any server takes up from an event of another. +apiEventsAfter :: ApiConfig -> Store.Event -> (Store.Event -> IO Bool) -> IO (Either Store.Except ()) +apiEventsAfter conf = listenEvents conf . Just + +-- | The events of a server, from now or from after one of them. +listenEvents :: ApiConfig -> Maybe Store.Event -> (Store.Event -> IO Bool) -> IO (Either Store.Except ()) +listenEvents (ApiConfig net apiHost) after handle = do r <- try (try (HTTP.foldGetWith (binaryOpts mempty) step BS.empty url)) return $ case r of Left Stopped -> Right () Right (Left e) -> Left e Right (Right _) -> Right () where - url = apiHost <> net.name <> "/events" + url = apiHost <> net.name <> "/events" <> maybe "" (("?after=" <>) . cs . name) after + name (Store.EventBlock h) = blockHashToHex h + name (Store.EventTx h) = txHashToHex h -- an event is a byte that says what it is and a hash size = 33 step pending chunk = go (pending <> chunk) 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 @@ -22,6 +22,7 @@ import Haskoin.Store.Laws import Haskoin.Util.Arbitrary import Test.Hspec +import Test.Hspec.QuickCheck (prop) import Test.QuickCheck spec :: Spec @@ -81,6 +82,11 @@ 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 @@ -89,6 +95,7 @@ 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) diff --git a/test/Haskoin/Store/Gen.hs b/test/Haskoin/Store/Gen.hs --- a/test/Haskoin/Store/Gen.hs +++ b/test/Haskoin/Store/Gen.hs @@ -14,6 +14,7 @@ arbitraryStoreOutput, arbitraryTransaction, arbitraryXPubSpec, + arbitraryEventCommand, arbitraryDeriveType, arbitraryBalance, arbitraryUnspent, @@ -268,6 +269,21 @@ [ EventBlock <$> arbitraryBlockHash, EventTx <$> arbitraryTxHash ] + +-- | A command for the events of a network, of every kind. +arbitraryEventCommand :: Network -> Ctx -> Gen EventCommand +arbitraryEventCommand net ctx = + oneof + [ EventWatch <$> listOf (arbitraryAddress net), + EventUnwatch <$> listOf (arbitraryAddress net), + EventWatchXPub <$> arbitraryXPubSpec net ctx, + EventUnwatchXPub <$> arbitraryXPubSpec net ctx, + EventFilterLoad <$> arbitraryBloomFilter, + EventFilterAdd . B.pack <$> (choose (0, maxFilterAddSize) >>= vector), + return EventFilterClear, + return EventAll, + return EventNone + ] instance Arbitrary Except where arbitrary =