diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 diff --git a/haskoin-store-data.cabal b/haskoin-store-data.cabal --- a/haskoin-store-data.cabal +++ b/haskoin-store-data.cabal @@ -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 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 @@ -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 = 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 @@ -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 diff --git a/src/Haskoin/Store/WebCommon.hs b/src/Haskoin/Store/WebCommon.hs --- a/src/Haskoin/Store/WebCommon.hs +++ b/src/Haskoin/Store/WebCommon.hs @@ -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" ------------- 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 @@ -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 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 @@ -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 diff --git a/test/Haskoin/Store/WebCommonSpec.hs b/test/Haskoin/Store/WebCommonSpec.hs --- a/test/Haskoin/Store/WebCommonSpec.hs +++ b/test/Haskoin/Store/WebCommonSpec.hs @@ -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