haskoin-store-data 1.9.0 → 1.10.0

raw patch · 8 files changed

+184/−9 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +36/−0
• README.md +5/−0
• haskoin-store-data.cabal +1/−1
• src/Haskoin/Store/Data.hs +85/−4
• src/Haskoin/Store/WebClient.hs +48/−2
• src/Haskoin/Store/WebCommon.hs +1/−1
• test/Haskoin/Store/DataSpec.hs +2/−0
• test/Haskoin/Store/Gen.hs +6/−1

@@ -6,6 +6,42 @@  ## [Unreleased] +## [1.10.0] - 2026-11-10++### Added++- Errors have a binary encoding: `Except` has `Serial`, `Serialize` and+  `Binary` instances. It is one byte that says which error, followed by the+  message of `UserError` and `StringError`, as UTF-8 with its length, or+  by the transactions of `TxIndexConflict`. Until now a server answered an+  error in JSON whatever the client had asked for, so a client that spoke+  binary needed a JSON decoder for that one case.+- `apiCall` and `apiBatch` decode an error as the `Content-Type` of the+  response says: binary from a server that sends binary errors, JSON from+  an older one. A client built with this version works with both.++- `apiEvents` listens to the events of a server and calls a function with+  each as it comes. `apiCall` could not: it waits for a whole response, and+  that one has no end.++### Changed++- Breaking, version 1.10.0, on the wire: `RawResultList`, the answer of+  `/transactions/raw`, `/block/{block}/transactions/raw` and+  `/block/height/{height}/raw`, starts with the number of its values, like+  every other list. It was the values alone, one after the other. A client+  and a server have to be of the same side of this change for those three+  endpoints.+- Breaking, version 1.10.0: the response of `GetEvents` is an+  `EventStream`, events one after the other with no count, which is what+  servers have always sent. It was declared as a `SerialList`, whose count+  was never there.+- Breaking, version 1.10.0: `Except` has a `BehindFleet` constructor, for+  the 503 of a server that is one of a fleet and does not have the block+  that the fleet answers from. In JSON it is `"error": "behind-fleet"`, as+  such servers already answered. Code that matches every constructor of+  `Except` has to add it.+ ## [1.9.0] - 2026-11-10  ### Changed

@@ -36,6 +36,11 @@ api.haskoin.com. The binary encoding is used on the wire, as it is smaller and faster to decode than JSON. +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.+ ## Building  The package builds with [Stack](https://haskellstack.org) and needs

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           haskoin-store-data-version:        1.9.0+version:        1.10.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

@@ -78,6 +78,7 @@     SerialList (..),     RawResult (..),     RawResultList (..),+    EventStream (..),     PeerInfo (..),     Healthy (..),     BlockHealth (..),@@ -2080,21 +2081,48 @@   parseJSON = fmap SerialList . parseJSON  -- | List of values in their peer-to-peer serialization, encoded in JSON as a--- list of hex strings.+-- 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. newtype RawResultList a = RawResultList {get :: [a]}   deriving stock (Show, Eq, Generic)   deriving anyclass (NFData)  instance (Serial a) => Serial (RawResultList a) where-  serialize (RawResultList xs) =-    mapM_ serialize xs-  deserialize = RawResultList <$> go+  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@@ -2169,10 +2197,57 @@     ServerTimeout   | -- | the request asks for too much (413)     RequestTooLarge+  | -- | the server is one of a fleet and does not have the block that the+    -- fleet answers from; another server of the fleet does (503)+    BehindFleet   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 =     A.object $@@ -2210,6 +2285,10 @@           [ "error" .= String "request-too-large",             "message" .= String "Request body too large"           ]+        BehindFleet ->+          [ "error" .= String "behind-fleet",+            "message" .= String "This server is behind the other servers of its fleet"+          ]  instance FromJSON Except where   parseJSON =@@ -2234,6 +2313,8 @@           return ServerTimeout         String "request-too-large" ->           return RequestTooLarge+        String "behind-fleet" ->+          return BehindFleet         _ -> mzero  ---------------------------------------

@@ -29,6 +29,7 @@     ApiConfig (..),     apiCall,     apiBatch,+    apiEvents,      -- * Blocks     GetBlock (..),@@ -94,6 +95,7 @@ import Control.Exception import Control.Lens ((.~), (?~), (^.)) import Data.Aeson qualified as A+import Data.ByteString qualified as BS import Data.Bytes.Get import Data.Bytes.Put import Data.Bytes.Serial@@ -191,6 +193,42 @@         Left e -> return (Left e)         Right b -> go (acc <> b) rs +-- | Listen to the events of a server: new blocks and changes of the+-- mempool. A function is called with each event as it comes, and says+-- whether to go on. This returns when the function says no, when the+-- server ends the stream, which it does to a client that falls too far+-- behind, or with the error that the server answered.+--+-- 'apiCall' cannot do this: it waits for a whole response, and this one+-- has no end.+--+-- > apiEvents def $ \event -> print event >> return True+apiEvents :: ApiConfig -> (Store.Event -> IO Bool) -> IO (Either Store.Except ())+apiEvents (ApiConfig net apiHost) 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"+    -- an event is a byte that says what it is and a hash+    size = 33+    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++-- | Thrown inside 'apiEvents' to leave the stream when the caller has+-- heard enough.+data Stopped = Stopped+  deriving (Show)++instance Exception Stopped+ -- | Requests that can be split into several smaller ones whose results are -- concatenated. class (ApiResource a b, Monoid b) => Batchable a b where@@ -299,17 +337,25 @@ -- | 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 ()   | isHealthPath && code == 503 = return () -- Ignore health checks   | otherwise = do-      e <- A.decodeStrict <$> res ^. HTTP.responseBody+      body <- res ^. HTTP.responseBody       throwIO $-        case e of+        case decoded 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

@@ -393,7 +393,7 @@   resourcePath _ _ = "/mempool"   queryParams (GetMempool l o) = ([], noMaybeBox l <> noDefBox o) -instance ApiResource GetEvents (Store.SerialList Store.Event) where+instance ApiResource GetEvents Store.EventStream where   resourcePath _ _ = "/events"  -------------

@@ -32,6 +32,8 @@     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)

@@ -243,6 +243,9 @@ 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 @@ -275,7 +278,9 @@         UserError <$> arbitrary,         StringError <$> arbitrary,         TxIndexConflict <$> listOf1 arbitraryTxHash,-        return ServerTimeout+        return ServerTimeout,+        return RequestTooLarge,+        return BehindFleet       ]  ---------------------------------------