haskoin-store-data 1.11.0 → 2.0.0

raw patch · 9 files changed

+216/−625 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +29/−0
• README.md +15/−20
• haskoin-store-data.cabal +3/−3
• src/Haskoin/Store/Data.hs +23/−516
• src/Haskoin/Store/WebClient.hs +50/−51
• src/Haskoin/Store/WebCommon.hs +79/−6
• test/Haskoin/Store/DataSpec.hs +2/−24
• test/Haskoin/Store/Gen.hs +0/−3
• test/Haskoin/Store/WebCommonSpec.hs +15/−2

@@ -6,6 +6,35 @@  ## [Unreleased] +## [2.0.0] - 2026-11-12++The API speaks JSON only. The binary encoding of the API is gone, from the+types, the client and the documentation. Servers from haskoin-store 1.10+answer in JSON only, and clients of earlier versions, which ask for binary,+do not work with them.++### Removed++- The binary instances (`Serial`, `Serialize`, `Binary`) of the types that+  only the API used: `Transaction`, `StoreInput`, `StoreOutput`,+  `PeerInfo`, `XPubUnspent`, `XPubSummary`, the health checks, `Event`,+  `Except`, `TxId`, `GenericResult`, `RawResult`, `RawResultList` and+  `SerialList`. The types that the server keeps in its database and its+  caches keep theirs.+- `Marshal (Network, Ctx) EventCommand`: commands over the WebSocket of+  `/events` are JSON in text frames.+- `EventStream`. `GetEvents` answers `SerialList Event`; read the events+  with `apiEvents`, as before.++### Changed++- `apiCall` and `apiBatch` ask for JSON and read it with the new class+  `ApiResponse`, which every response type has and `ApiResource` now+  requires in place of `Serial`.+- `apiEvents` and `apiEventsAfter` read the events as lines of JSON.+- `PostBox` holds the text of a request body. `PostTx` sends the+  transaction in hex, as `text/plain`.+ ## [1.11.0] - 2026-11-10  ### Added

@@ -11,10 +11,11 @@ - `Haskoin.Store.Data`: the types that the server answers with (blocks,   transactions, balances, unspent outputs, extended public keys, health   checks, events, and the Blockchain.info compatible formats), with their-  JSON and binary encodings.+  JSON. The types that the server keeps in its database also have a binary+  encoding, for the server's own use. - `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+- `Haskoin.Store.WebClient`: `apiCall`, which sends a request and reads   the answer, and `apiEvents`, which listens to the events of a server.  ## Example@@ -33,13 +34,9 @@ ```  The client appends the name of the network to the host, as in the layout of-api.haskoin.com. The binary encoding is used on the wire, as it is smaller and-faster to decode than JSON.+api.haskoin.com. The API speaks JSON, and so does the client. -Errors come back as `Left` an `Except`. From version 1.10 they have a binary-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.+Errors come back as `Left` an `Except`.  ## Events @@ -52,9 +49,8 @@ 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:+filter as in BIP 37, each a JSON object sent in a text frame. This package+has no WebSocket client of its own; send the command with the one you use:  ```haskell import Haskoin (marshalJSON)@@ -68,12 +64,10 @@ 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+The JSON of every type, for someone who writes a client in another+language, is in [`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.+in the haskoin-store repository.  ## Building @@ -86,16 +80,17 @@ stack test ``` -The tests check every type by law: binary encodings round-trip and agree-between Serial, cereal and binary, JSON round-trips, the fast encoders write-the same JSON as `toJSON`, and the wire format of the basic types is pinned.+The tests check every type by law: JSON round-trips, the fast encoders+write the same JSON as `toJSON`, the client reads what the server writes,+the binary encodings of the database round-trip and agree between Serial,+cereal and binary, and the format of the basic types is pinned.  ## Versions  Up to 1.8.1, this package was released from the [haskoin-store](https://github.com/jprupp/haskoin-store) repository with the same version number as the server. It now has its own releases; a server-speaks the wire format of the haskoin-store-data version it depends on.+speaks the format of the haskoin-store-data version it depends on.  ## License 

@@ -5,12 +5,12 @@ -- see: https://github.com/sol/hpack  name:           haskoin-store-data-version:        1.11.0+version:        2.0.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-                the Blockchain.info compatible formats), with their JSON and binary-                encodings, and a client for its REST API. Use it to talk to a Haskoin Store+                the Blockchain.info compatible formats), with their JSON, and a client+                for its REST API. Use it to talk to a Haskoin Store                 server from Haskell. category:       Bitcoin, Finance, Network homepage:       https://github.com/jprupp/haskoin-store-data#readme

@@ -14,9 +14,9 @@ -- -- Most types have three encodings: ----- * binary ('Serial' and 'Binary'/'Serialize' instances), used in the database---   and in binary API responses;--- * JSON ('ToJSON' and 'FromJSON' instances), used in JSON API responses;+-- * binary ('Serial' and 'Binary'/'Serialize' instances), for the types that+--   the server keeps in its database and its caches, and only for those;+-- * JSON ('ToJSON' and 'FromJSON' instances), the encoding of the API; -- * for types that contain addresses, JSON functions that take the 'Network' --   (the @marshal@ functions of 'MarshalJSON'), since the text form of an --   address depends on the network.@@ -78,7 +78,6 @@     SerialList (..),     RawResult (..),     RawResultList (..),-    EventStream (..),     PeerInfo (..),     Healthy (..),     BlockHealth (..),@@ -138,7 +137,7 @@ import Control.Applicative (optional, (<|>)) import Control.DeepSeq (NFData) import Control.Exception (Exception)-import Control.Monad (guard, join, mzero, unless, when)+import Control.Monad (guard, join, mzero, when) import Data.Aeson   ( FromJSON (..),     ToJSON (..),@@ -815,50 +814,6 @@       }   deriving (Show, Read, Eq, Ord, Generic, Hashable, NFData) -instance Serial StoreInput where-  serialize StoreCoinbase {..} = do-    putWord8 0x00-    serialize outpoint-    putWord32be sequence-    putLengthBytes script-    putList putLengthBytes witness-  serialize StoreInput {..} = do-    putWord8 0x01-    serialize outpoint-    putWord32be sequence-    putLengthBytes script-    putLengthBytes pkscript-    putWord64be value-    putList putLengthBytes witness-    putMaybe serialize address--  deserialize =-    getWord8 >>= \case-      0x00 -> do-        outpoint <- deserialize-        sequence <- getWord32be-        script <- getLengthBytes-        witness <- getList getLengthBytes-        return StoreCoinbase {..}-      0x01 -> do-        outpoint <- deserialize-        sequence <- getWord32be-        script <- getLengthBytes-        pkscript <- getLengthBytes-        value <- getWord64be-        witness <- getList getLengthBytes-        address <- getMaybe deserialize-        return StoreInput {..}-      x -> fail $ "Unknown input id: " <> cs (show x)--instance Serialize StoreInput where-  put = serialize-  get = deserialize--instance Binary StoreInput where-  put = serialize-  get = deserialize- -- | Whether a transaction is a coinbase: it has one input, which spends the null outpoint. isCoinbaseTx :: Tx -> Bool isCoinbaseTx = all ((== nullOutPoint) . (.outpoint)) . (.inputs)@@ -999,27 +954,6 @@   }   deriving (Show, Read, Eq, Ord, Generic, Hashable, NFData) -instance Serial StoreOutput where-  serialize o = do-    putWord64be o.value-    putLengthBytes o.script-    putMaybe serialize o.spender-    putMaybe serialize o.address-  deserialize = do-    value <- getWord64be-    script <- getLengthBytes-    spender <- getMaybe deserialize-    address <- getMaybe deserialize-    return StoreOutput {..}--instance Serialize StoreOutput where-  put = serialize-  get = deserialize--instance Binary StoreOutput where-  put = serialize-  get = deserialize- instance MarshalJSON Network StoreOutput where   marshalValue net o =     A.object@@ -1258,43 +1192,6 @@   }   deriving (Show, Eq, Ord, Generic, Hashable, NFData) -instance Serial Transaction where-  serialize t = do-    serialize t.block-    putWord32be t.version-    putWord32be t.locktime-    putList serialize t.inputs-    putList serialize t.outputs-    serialize t.deleted-    serialize t.rbf-    putWord64be t.timestamp-    serialize t.txid-    putWord32be t.size-    putWord32be t.weight-    putWord64be t.fee-  deserialize = do-    block <- deserialize-    version <- getWord32be-    locktime <- getWord32be-    inputs <- getList deserialize-    outputs <- getList deserialize-    deleted <- deserialize-    rbf <- deserialize-    timestamp <- getWord64be-    txid <- deserialize-    size <- getWord32be-    weight <- getWord32be-    fee <- getWord64be-    return Transaction {..}--instance Serialize Transaction where-  put = serialize-  get = deserialize--instance Binary Transaction where-  put = serialize-  get = deserialize- -- | The transaction without the information added by the store. transactionData :: Transaction -> Tx transactionData t =@@ -1379,29 +1276,6 @@   }   deriving (Show, Eq, Ord, Generic, NFData) -instance Serial PeerInfo where-  serialize p = do-    putLengthBytes p.userAgent-    putLengthBytes $ T.encodeUtf8 $ T.pack p.address-    putInt32be p.version-    putWord64be p.services-    serialize p.relay-  deserialize = do-    userAgent <- getLengthBytes-    address <- T.unpack . T.decodeUtf8 <$> getLengthBytes-    version <- getInt32be-    services <- getWord64be-    relay <- deserialize-    return PeerInfo {..}--instance Serialize PeerInfo where-  put = serialize-  get = deserialize--instance Binary PeerInfo where-  put = serialize-  get = deserialize- instance ToJSON PeerInfo where   toJSON p =     A.object@@ -1493,23 +1367,6 @@   }   deriving (Show, Eq, Ord, Generic, NFData) -instance Serial XPubUnspent where-  serialize u = do-    putList putWord32be u.path-    serialize u.unspent-  deserialize = do-    path <- getList getWord32be-    unspent <- deserialize-    return XPubUnspent {..}--instance Serialize XPubUnspent where-  put = serialize-  get = deserialize--instance Binary XPubUnspent where-  put = serialize-  get = deserialize- instance MarshalJSON Network XPubUnspent where   marshalValue net u =     A.object@@ -1547,31 +1404,6 @@   }   deriving (Eq, Show, Generic, NFData) -instance Serial XPubSummary where-  serialize s = do-    putWord64be s.confirmed-    putWord64be s.unconfirmed-    putWord64be s.received-    putWord64be s.utxo-    putWord32be s.external-    putWord32be s.change-  deserialize = do-    confirmed <- getWord64be-    unconfirmed <- getWord64be-    received <- getWord64be-    utxo <- getWord64be-    external <- getWord32be-    change <- getWord32be-    return XPubSummary {..}--instance Binary XPubSummary where-  put = serialize-  get = deserialize--instance Serialize XPubSummary where-  put = serialize-  get = deserialize- instance ToJSON XPubSummary where   toJSON s =     A.object@@ -1636,29 +1468,6 @@   }   deriving (Show, Eq, Generic, NFData) -instance Serial BlockHealth where-  serialize h = do-    serialize (isOK h)-    putWord32be h.headers-    putWord32be h.blocks-    putInt32be h.max-  deserialize = do-    k <- deserialize-    headers <- getWord32be-    blocks <- getWord32be-    max <- getInt32be-    let h = BlockHealth {..}-    unless (k == isOK h) $ fail "Inconsistent health check"-    return h--instance Serialize BlockHealth where-  put = serialize-  get = deserialize--instance Binary BlockHealth where-  put = serialize-  get = deserialize- instance Healthy BlockHealth where   isOK x =     h - b <= x.max@@ -1695,27 +1504,6 @@   }   deriving (Show, Eq, Generic, NFData) -instance Serial TimeHealth where-  serialize h = do-    serialize (isOK h)-    putInt64be h.age-    putInt64be h.max-  deserialize = do-    k <- deserialize-    age <- getInt64be-    max <- getInt64be-    let t = TimeHealth {..}-    unless (k == isOK t) $ fail "Inconsistent health check"-    return t--instance Binary TimeHealth where-  put = serialize-  get = deserialize--instance Serialize TimeHealth where-  put = serialize-  get = deserialize- instance Healthy TimeHealth where   isOK TimeHealth {..} =     age <= max@@ -1744,27 +1532,6 @@   }   deriving (Show, Eq, Generic, NFData) -instance Serial CountHealth where-  serialize h = do-    serialize (isOK h)-    putInt64be h.count-    putInt64be h.min-  deserialize = do-    k <- deserialize-    count <- getInt64be-    min <- getInt64be-    let c = CountHealth {..}-    unless (k == isOK c) $ fail "Inconsistent health check"-    return c--instance Serialize CountHealth where-  put = serialize-  get = deserialize--instance Binary CountHealth where-  put = serialize-  get = deserialize- instance Healthy CountHealth where   isOK CountHealth {..} = min <= count @@ -1792,27 +1559,6 @@   }   deriving (Show, Eq, Generic, NFData) -instance Serial MaxHealth where-  serialize h = do-    serialize $ isOK h-    putInt64be h.count-    putInt64be h.max-  deserialize = do-    k <- deserialize-    count <- getInt64be-    max <- getInt64be-    let h = MaxHealth {..}-    unless (k == isOK h) $ fail "Inconsistent health check"-    return h--instance Binary MaxHealth where-  put = serialize-  get = deserialize--instance Serialize MaxHealth where-  put = serialize-  get = deserialize- instance Healthy MaxHealth where   isOK MaxHealth {..} = count <= max @@ -1841,8 +1587,7 @@ -- knowing and not worth taking the store out of service for, so it has a -- field of its own, and @\/health@ answers 203 instead of 200. ----- The field is the last thing in the binary encoding, and may be missing--- there and in JSON, where it reads as 'Nothing'. So the output of a store+-- The field may be missing in the JSON, where it reads as 'Nothing'. So the output of a store -- from before the field can still be read, and a client from before it -- reads the output of a new store. data HealthCheck = HealthCheck@@ -1868,52 +1613,6 @@   }   deriving (Show, Eq, Generic, NFData) -instance Serial HealthCheck where-  serialize h = do-    serialize $ isOK h-    serialize h.blocks-    serialize h.lastBlock-    serialize h.lastTx-    serialize h.pendingTxs-    serialize h.peers-    putLengthBytes $ T.encodeUtf8 $ T.pack h.network-    putLengthBytes $ T.encodeUtf8 $ T.pack h.version-    putWord64be h.time-    putWord8 $ case h.redis of-      Nothing -> 0x00-      Just False -> 0x01-      Just True -> 0x02-  deserialize = do-    k <- deserialize-    blocks <- deserialize-    lastBlock <- deserialize-    lastTx <- deserialize-    pendingTxs <- deserialize-    peers <- deserialize-    network <- T.unpack . T.decodeUtf8 <$> getLengthBytes-    version <- T.unpack . T.decodeUtf8 <$> getLengthBytes-    time <- getWord64be-    redis <--      isEmpty >>= \case-        True -> return Nothing-        False ->-          getWord8 >>= \case-            0x00 -> return Nothing-            0x01 -> return (Just False)-            0x02 -> return (Just True)-            _ -> fail "Cannot decode the health of Redis"-    let h = HealthCheck {..}-    unless (k == isOK h) $ fail "Inconsistent health check"-    return h--instance Binary HealthCheck where-  put = serialize-  get = deserialize--instance Serialize HealthCheck where-  put = serialize-  get = deserialize- instance Healthy HealthCheck where   isOK h =     and@@ -1962,23 +1661,6 @@     EventTx !TxHash   deriving (Show, Eq, Generic, NFData) -instance Serial Event where-  serialize (EventBlock bh) = putWord8 0x00 >> serialize bh-  serialize (EventTx th) = putWord8 0x01 >> serialize th-  deserialize =-    getWord8 >>= \case-      0x00 -> EventBlock <$> deserialize-      0x01 -> EventTx <$> deserialize-      _ -> fail "Not an Event"--instance Serialize Event where-  put = serialize-  get = deserialize--instance Binary Event where-  put = serialize-  get = deserialize- instance ToJSON Event where   toJSON (EventTx h) =     A.object ["type" .= String "tx", "id" .= h]@@ -2026,87 +1708,41 @@ -- 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+-- A command is a JSON 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+  = -- | @{"type":"watch","addresses":[...]}@: watch these addresses as+    -- well     EventWatch ![Address]-  | -- | @0x01@, @{"type":"unwatch","addresses":[...]}@: stop watching+  | -- | @{"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+  | -- | @{"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     EventWatchXPub !XPubSpec-  | -- | @0x03@, @{"type":"unwatch","xpub":"...","derive":"segwit"}@: stop+  | -- | @{"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+  | -- | @{"type":"filterload","filter":"hex","functions":n,"tweak":n,"flags":n}@:+    -- set the Bloom filter of the connection, in place of the one it had     EventFilterLoad !BloomFilter-  | -- | @0x05@, @{"type":"filteradd","data":"hex"}@: add an element of at-    -- most 'maxFilterAddSize' bytes to the filter; bytes with their-    -- length in binary+  | -- | @{"type":"filteradd","data":"hex"}@: add an element of at most+    -- 'maxFilterAddSize' bytes to the filter     EventFilterAdd !ByteString-  | -- | @0x06@, @{"type":"filterclear"}@: remove the filter; the addresses+  | -- | @{"type":"filterclear"}@: remove the filter; the addresses     -- and keys stay watched     EventFilterClear-  | -- | @0x07@, @{"type":"all"}@: forget everything watched and the filter,+  | -- | @{"type":"all"}@: forget everything watched and the filter,     -- and hear of every transaction again     EventAll-  | -- | @0x08@, @{"type":"none"}@: forget everything watched and the filter,+  | -- | @{"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@@ -2182,18 +1818,6 @@   deriving stock (Show, Eq, Generic)   deriving anyclass (NFData) -instance (Serial a) => Serial (GenericResult a) where-  serialize (GenericResult x) = serialize x-  deserialize = GenericResult <$> deserialize--instance (Serial a) => Serialize (GenericResult a) where-  put = serialize-  get = deserialize--instance (Serial a) => Binary (GenericResult a) where-  put = serialize-  get = deserialize- instance (ToJSON a) => ToJSON (GenericResult a) where   toJSON (GenericResult b) = A.object ["result" .= b]   toEncoding (GenericResult b) = A.pairs ("result" `A.pair` toEncoding b)@@ -2208,18 +1832,6 @@   deriving stock (Show, Eq, Generic)   deriving anyclass (NFData) -instance (Serial a) => Serial (RawResult a) where-  serialize (RawResult x) = serialize x-  deserialize = RawResult <$> deserialize--instance (Serial a) => Serialize (RawResult a) where-  put = serialize-  get = deserialize--instance (Serial a) => Binary (RawResult a) where-  put = serialize-  get = deserialize- instance (Serial a) => ToJSON (RawResult a) where   toJSON (RawResult b) =     A.object ["result" .= String (encodeHex $ runPutS $ serialize b)]@@ -2235,7 +1847,7 @@               =<< decodeHex res       maybe mzero (return . RawResult) m --- | List response. In binary, a length followed by the items.+-- | List response, a JSON array. newtype SerialList a = SerialList {get :: [a]}   deriving stock (Show, Eq, Generic)   deriving anyclass (NFData)@@ -2246,10 +1858,6 @@ instance Monoid (SerialList a) where   mempty = SerialList mempty -instance (Serial a) => Serial (SerialList a) where-  serialize (SerialList ls) = putList serialize ls-  deserialize = SerialList <$> getList deserialize- instance (ToJSON a) => ToJSON (SerialList a) where   toJSON (SerialList ls) = toJSON ls   toEncoding (SerialList ls) = A.list toEncoding ls@@ -2258,56 +1866,11 @@   parseJSON = fmap SerialList . parseJSON  -- | List of values in their peer-to-peer serialization, encoded in JSON as a--- list of hex strings. In binary it is the number of values and then the--- values, like every other list of the API. Before version 1.10 it was the--- values alone, one after the other, which only a reader that knew where--- the body ended could take apart.+-- list of hex strings. newtype RawResultList a = RawResultList {get :: [a]}   deriving stock (Show, Eq, Generic)   deriving anyclass (NFData) -instance (Serial a) => Serial (RawResultList a) where-  serialize (RawResultList xs) = putList serialize xs-  deserialize = RawResultList <$> getList deserialize---- | The events of a server as @\/events@ sends them in binary: one after--- the other, for as long as the connection is open, with no count before--- them, since there is no telling how many will come. Decoding reads--- events until the input ends, so it is for a piece of the stream that--- holds whole events; 'Haskoin.Store.WebClient.apiEvents' reads the stream--- as it comes.------ The endpoint used to be declared as a t'SerialList' of events, which has--- a count before it that the server never sent.-newtype EventStream = EventStream {get :: [Event]}-  deriving stock (Show, Eq, Generic)-  deriving anyclass (NFData)--instance Serial EventStream where-  serialize (EventStream es) = mapM_ serialize es-  deserialize = EventStream <$> go-    where-      go =-        isEmpty >>= \case-          True -> return []-          False -> (:) <$> deserialize <*> go--instance Serialize EventStream where-  put = serialize-  get = deserialize--instance Binary EventStream where-  put = serialize-  get = deserialize--instance (Serial a) => Serialize (RawResultList a) where-  put = serialize-  get = deserialize--instance (Serial a) => Binary (RawResultList a) where-  put = serialize-  get = deserialize- instance Semigroup (RawResultList a) where   (RawResultList a) <> (RawResultList b) = RawResultList $ a <> b @@ -2337,18 +1900,6 @@   deriving stock (Show, Eq, Generic)   deriving anyclass (NFData) -instance Serial TxId where-  serialize (TxId h) = serialize h-  deserialize = TxId <$> deserialize--instance Serialize TxId where-  put = serialize-  get = deserialize--instance Binary TxId where-  put = serialize-  get = deserialize- instance ToJSON TxId where   toJSON (TxId h) = A.object ["txid" .= h]   toEncoding (TxId h) = A.pairs ("txid" `A.pair` toEncoding h)@@ -2380,50 +1931,6 @@   deriving (Show, Eq, Ord, Generic, NFData)  instance Exception Except---- | An error in the binary encoding: one byte that says which, followed by--- the message of those that have one, as UTF-8 with its length, or by the--- transactions of a 'TxIndexConflict'.------ Errors used to be JSON whatever the client asked for, because this--- instance did not exist. A client that asks for binary now gets every--- answer in binary, and needs no JSON decoder for the one case that it--- hopes not to meet.-instance Serial Except where-  serialize = \case-    ThingNotFound -> putWord8 0x00-    ServerError -> putWord8 0x01-    BadRequest -> putWord8 0x02-    UserError m -> putWord8 0x03 >> message m-    StringError m -> putWord8 0x04 >> message m-    TxIndexConflict ts -> putWord8 0x05 >> putList serialize ts-    ServerTimeout -> putWord8 0x06-    RequestTooLarge -> putWord8 0x07-    BehindFleet -> putWord8 0x08-    where-      message = putLengthBytes . T.encodeUtf8 . T.pack-  deserialize =-    getWord8 >>= \case-      0x00 -> return ThingNotFound-      0x01 -> return ServerError-      0x02 -> return BadRequest-      0x03 -> UserError <$> message-      0x04 -> StringError <$> message-      0x05 -> TxIndexConflict <$> getList deserialize-      0x06 -> return ServerTimeout-      0x07 -> return RequestTooLarge-      0x08 -> return BehindFleet-      _ -> fail "Not an error of the API"-    where-      message = getLengthBytes >>= either (fail . show) (return . T.unpack) . T.decodeUtf8'--instance Serialize Except where-  put = serialize-  get = deserialize--instance Binary Except where-  put = serialize-  get = deserialize  instance ToJSON Except where   toJSON e =

@@ -9,8 +9,8 @@ -- Client for the REST API of Haskoin Store. -- -- Build a request value, such as 'GetAddrBalance', and pass it to 'apiCall'.--- The response type follows from the request type. Requests and responses use--- the compact binary encoding of the API. A call returns the error that the+-- The response type follows from the request type. Responses are read from+-- the JSON of the API ('ApiResponse'). A call returns the error that the -- server answered with, as 'Store.Except', or the response. -- -- @@@ -22,8 +22,6 @@ -- -- Requests that take long lists of addresses, transactions or blocks can be -- split into several calls with 'apiBatch'.--- The client always uses the binary encoding, which is smaller and faster than--- JSON and decodes straight into the types of "Haskoin.Store.Data". module Haskoin.Store.WebClient   ( -- * Calls     ApiConfig (..),@@ -96,15 +94,15 @@ import Control.Exception import Control.Lens ((.~), (?~), (^.)) import Data.Aeson qualified as A+import Data.Aeson.Types qualified as A import Data.ByteString qualified as BS-import Data.Bytes.Get-import Data.Bytes.Put-import Data.Bytes.Serial+import Data.ByteString.Lazy qualified as BSL import Data.Default (Default, def) import Data.Monoid (Endo (..), appEndo) import Data.String.Conversions (cs) import Data.Text (Text) import Data.Text qualified as Text+import Data.Text.Encoding qualified as Text import Haskoin.Block (blockHashToHex) import Haskoin.Crypto (Ctx) import Haskoin.Network@@ -112,11 +110,11 @@ import Haskoin.Store.WebCommon import Haskoin.Transaction import Haskoin.Util-import Network.HTTP.Client (Request (..))+import Network.HTTP.Client (Request (..), RequestBody (..)) import Network.HTTP.Types (StdMethod (..)) import Network.HTTP.Types.Status import Network.Wreq qualified as HTTP-import Network.Wreq.Types (ResponseChecker)+import Network.Wreq.Types (Payload (..), ResponseChecker) import Numeric.Natural (Natural)  -- | Configuration specifying the Network and the Host for API calls.@@ -167,10 +165,10 @@     Right args ->       let url = apiHost <> net.name <> cs (queryPath net ctx res)        in case resourceMethod $ asProxy res of-            GET -> getBinary args url+            GET -> getJSON net ctx args url             POST ->               case resourceBody res of-                Just (PostBox val) -> postBinary args url val+                Just (PostBox body) -> postJSON net ctx args url body                 _ -> return . Left $ Store.StringError "Could not post resource"             _ -> return . Left $ Store.StringError "Unsupported HTTP method" @@ -225,7 +223,7 @@ -- | 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))+  r <- try (try (HTTP.foldGetWith (jsonOpts mempty) step BS.empty url))   return $ case r of     Left Stopped -> Right ()     Right (Left e) -> Left e@@ -234,15 +232,17 @@     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+    -- one event a line; a chunk may end in the middle of one     step pending chunk = go (pending <> chunk)-    go bytes-      | BS.length bytes < size = return bytes-      | otherwise = do-          let (one, rest) = BS.splitAt size bytes-          continue <- either (\_ -> return False) handle (runGetS deserialize one)-          if continue then go rest else throwIO Stopped+    go bytes = case BS.elemIndex 10 bytes of+      Nothing -> return bytes+      Just i -> do+        let (line, rest) = (BS.take i bytes, BS.drop (i + 1) bytes)+        continue <-+          if BS.all (`BS.elem` " \r\t") line+            then return True+            else maybe (return False) handle (A.decodeStrict line)+        if continue then go rest else throwIO Stopped  -- | Thrown inside 'apiEvents' to leave the stream when the caller has -- heard enough.@@ -323,46 +323,49 @@ applyOpt :: Text -> [Text] -> Endo HTTP.Options applyOpt p t = Endo $ HTTP.param p .~ [Text.intercalate "," t] --- | Make a @GET@ request and decode the binary response.-getBinary ::-  (Serial a) =>+-- | Make a @GET@ request and read the JSON response.+getJSON ::+  (ApiResponse a) =>+  Network ->+  Ctx ->   Endo HTTP.Options ->   String ->   IO (Either Store.Except a)-getBinary opts url = do-  resE <- try $ HTTP.getWith (binaryOpts opts) url-  return $ do-    res <- resE-    return . runGetL deserialize $ res ^. HTTP.responseBody+getJSON net ctx opts url = do+  r <- try (HTTP.getWith (jsonOpts opts) url)+  return (r >>= readResponse net ctx) --- | Make a @POST@ request with a binary body and decode the binary response.-postBinary ::-  (Serial a, Serial r) =>+-- | Make a @POST@ request with a body of text and read the JSON response.+postJSON ::+  (ApiResponse a) =>+  Network ->+  Ctx ->   Endo HTTP.Options ->   String ->-  a ->-  IO (Either Store.Except r)-postBinary opts url body = do-  resE <- try $ HTTP.postWith (binaryOpts opts) url (runPutL (serialize body))-  return $ do-    res <- resE-    return . runGetL deserialize $ res ^. HTTP.responseBody+  Text ->+  IO (Either Store.Except a)+postJSON net ctx opts url body = do+  r <- try (HTTP.postWith (jsonOpts opts) url (Raw "text/plain" (RequestBodyBS (Text.encodeUtf8 body))))+  return (r >>= readResponse net ctx) --- | Request binary responses, and turn error responses into exceptions.-binaryOpts :: Endo HTTP.Options -> HTTP.Options-binaryOpts opts =+-- | Read a response from the JSON of its body.+readResponse :: (ApiResponse a) => Network -> Ctx -> HTTP.Response BSL.ByteString -> Either Store.Except a+readResponse net ctx res =+  case A.eitherDecode (res ^. HTTP.responseBody) >>= A.parseEither (parseResponse net ctx) of+    Left e -> Left (Store.StringError ("Could not read the response: " <> e))+    Right a -> Right a++-- | Ask for JSON, and turn error responses into exceptions.+jsonOpts :: Endo HTTP.Options -> HTTP.Options+jsonOpts opts =   appEndo (opts <> accept <> stat) HTTP.defaults   where-    accept = Endo $ HTTP.header "Accept" .~ ["application/octet-stream"]+    accept = Endo $ HTTP.header "Accept" .~ ["application/json"]     stat = Endo $ HTTP.checkResponse ?~ checkStatus  -- | Throw the error in the body of an unsuccessful response as 'Store.Except'. -- A health check that answers 503 is not an error: its body says what is -- wrong.------ The error is decoded as its @Content-Type@ says: binary from a server--- that answers a binary request with a binary error, and JSON from one of--- before version 1.10 of this package, which sent every error as JSON. checkStatus :: ResponseChecker checkStatus req res   | statusIsSuccessful status = return ()@@ -370,14 +373,10 @@   | otherwise = do       body <- res ^. HTTP.responseBody       throwIO $-        case decoded body of+        case A.decodeStrict body of           Just except -> except :: Store.Except           Nothing -> Store.StringError "could not decode error"   where-    binary = "application/octet-stream" `BS.isPrefixOf` (res ^. HTTP.responseHeader "Content-Type")-    decoded body-      | binary = either (const Nothing) Just (runGetS deserialize body)-      | otherwise = A.decodeStrict body     code = res ^. HTTP.responseStatus . HTTP.statusCode     message = res ^. HTTP.responseStatus . HTTP.statusMessage     status = mkStatus code message

@@ -23,6 +23,7 @@ -- are the same ones the client builds requests from. module Haskoin.Store.WebCommon   ( ApiResource (..),+    ApiResponse (..),     PostBox (..),     ParamBox (..),     ProxyBox (..),@@ -90,7 +91,11 @@  import Control.Applicative ((<|>)) import Control.Monad (guard)+import Data.Aeson qualified as A+import Data.Aeson.Types qualified as A+import Data.Bytes.Put (runPutS) import Data.Bytes.Serial+import Data.Foldable (toList) import Data.Default (Default, def) import Data.Proxy (Proxy (..)) import Data.String.Conversions (cs)@@ -108,6 +113,7 @@ import Haskoin.Network.Data import Haskoin.Store.Data qualified as Store import Haskoin.Transaction+import Haskoin.Util (MarshalJSON (..), encodeHex) import Network.HTTP.Types (StdMethod (..)) import Numeric.Natural (Natural) import Text.Read (readMaybe)@@ -117,8 +123,8 @@ -------------------  -- | An endpoint of the API. The request type @a@ determines the response type--- @b@.-class (Serial b) => ApiResource a b | a -> b where+-- @b@, which the client reads from its JSON ('ApiResponse').+class (ApiResponse b) => ApiResource a b | a -> b where   -- | HTTP method; 'GET' by default.   resourceMethod :: Proxy a -> StdMethod   resourceMethod _ = GET@@ -141,9 +147,74 @@   resourceBody :: a -> Maybe PostBox   resourceBody = const Nothing --- | Request body of any serializable type.-data PostBox = forall s. (Serial s) => PostBox !s+-- | Body of a request, as the text that is sent: a transaction to publish+-- goes in hex.+newtype PostBox = PostBox Text +-- | How the client reads a response from its JSON.+--+-- The API speaks JSON only. Many responses hold addresses, whose text+-- depends on the network ('MarshalJSON'), so the reader is given the+-- network and the context, and a type that needs neither ignores them.+-- A class of its own, rather than @MarshalJSON (Network, Ctx)@, lets each+-- response say which of its JSON instances to use, without new instances+-- on the data types.+class ApiResponse b where+  -- | Read a response from its JSON.+  parseResponse :: Network -> Ctx -> A.Value -> A.Parser b++instance ApiResponse Store.BlockData where+  parseResponse net _ = unmarshalValue net++instance ApiResponse Store.Transaction where+  parseResponse net _ = unmarshalValue net++instance ApiResponse Store.Balance where+  parseResponse net _ = unmarshalValue net++instance ApiResponse Store.Unspent where+  parseResponse net _ = unmarshalValue net++instance ApiResponse Store.XPubBal where+  parseResponse net _ = unmarshalValue net++instance ApiResponse Store.XPubUnspent where+  parseResponse net _ = unmarshalValue net++instance ApiResponse Store.TxRef where+  parseResponse _ _ = A.parseJSON++instance ApiResponse Store.XPubSummary where+  parseResponse _ _ = A.parseJSON++instance ApiResponse Store.PeerInfo where+  parseResponse _ _ = A.parseJSON++instance ApiResponse Store.HealthCheck where+  parseResponse _ _ = A.parseJSON++instance ApiResponse Store.TxId where+  parseResponse _ _ = A.parseJSON++instance ApiResponse Store.Event where+  parseResponse _ _ = A.parseJSON++instance ApiResponse TxHash where+  parseResponse _ _ = A.parseJSON++instance (A.FromJSON a) => ApiResponse (Store.GenericResult a) where+  parseResponse _ _ = A.parseJSON++instance (Serial a) => ApiResponse (Store.RawResult a) where+  parseResponse _ _ = A.parseJSON++instance (Serial a) => ApiResponse (Store.RawResultList a) where+  parseResponse _ _ = A.parseJSON++instance (ApiResponse a) => ApiResponse (Store.SerialList a) where+  parseResponse net ctx =+    A.withArray "list" $ fmap Store.SerialList . mapM (parseResponse net ctx) . toList+ -- | Parameter value of any type. data ParamBox = forall p. (Eq p, Param p) => ParamBox !p @@ -387,13 +458,15 @@ instance ApiResource PostTx Store.TxId where   resourceMethod _ = POST   resourcePath _ _ = "/transactions"-  resourceBody (PostTx tx) = Just $ PostBox tx+  resourceBody (PostTx tx) = Just . PostBox . encodeHex . runPutS $ serialize tx  instance ApiResource GetMempool (Store.SerialList TxHash) where   resourcePath _ _ = "/mempool"   queryParams (GetMempool l o) = ([], noMaybeBox l <> noDefBox o) -instance ApiResource GetEvents Store.EventStream where+-- | The events are lines of JSON with no end: read them with+-- 'Haskoin.Store.WebClient.apiEvents', not as one response.+instance ApiResource GetEvents (Store.SerialList Store.Event) where   resourcePath _ _ = "/events"  -------------

@@ -13,7 +13,6 @@ 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@@ -22,39 +21,26 @@ 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+  -- only the types that the server keeps in its database and caches have+  -- a binary encoding: the API speaks JSON   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)@@ -82,11 +68,6 @@     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@@ -122,9 +103,6 @@           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

@@ -244,9 +244,6 @@ instance (Arbitrary a) => Arbitrary (RawResultList a) where   arbitrary = RawResultList <$> arbitrary -instance Arbitrary EventStream where-  arbitrary = EventStream <$> arbitrary- arbitraryXPubBal :: Network -> Gen XPubBal arbitraryXPubBal net = XPubBal <$> arbitrary <*> arbitraryBalance net 

@@ -9,8 +9,10 @@ import Data.Text (Text) import Data.Word (Word64) import Haskoin-import Haskoin.Store.Data (DeriveType (..))-import Haskoin.Store.Gen (arbitraryDeriveType)+import Data.Aeson qualified as A+import Data.Aeson.Types qualified as A+import Haskoin.Store.Data (DeriveType (..), SerialList (..), TxRef)+import Haskoin.Store.Gen (arbitraryDeriveType, arbitraryTransaction) import Haskoin.Store.WebCommon import Haskoin.Util.Arbitrary import Test.Hspec@@ -35,6 +37,17 @@     roundTrip ctx (const (NoTx <$> arbitrary))     roundTrip ctx (const (listOf arbitraryBlockHash))     roundTrip ctx (const (listOf arbitraryTxHash))++  -- the client reads what the server writes: lists in the JSON of the+  -- network, and the rest in plain JSON+  describe "Responses" $ do+    prop "a list of transactions" . forAll (elements allNets) $ \net ->+      forAll (listOf (arbitraryTransaction net)) $ \xs ->+        A.parseEither (parseResponse net ctx) (A.toJSON (map (marshalValue net) xs))+          === Right (SerialList xs)+    prop "a list of references" . forAll (listOf arbitrary) $ \xs ->+      A.parseEither (parseResponse btc ctx) (A.toJSON (xs :: [TxRef]))+        === Right (SerialList xs)    describe "Start of a page" $ do     it "is a transaction hash, a height up to 1230768000, or a later time" $ do