reflex-gadt-api 0.3.0.0 → 0.4.0.0

raw patch · 8 files changed

+645/−80 lines, 8 filesdep +bytestringdep +hspecdep ~aesondep ~aeson-gadt-thdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: bytestring, hspec

Dependency ranges changed: aeson, aeson-gadt-th, base, constraints-extras, reflex, text

API changes (from Hackage documentation)

Files

• ChangeLog.md +10/−0
• Readme.lhs +56/−5
• Readme.md +56/−5
• reflex-gadt-api.cabal +23/−3
• src/Reflex/Dom/GadtApi/Codec.hs +59/−0
• src/Reflex/Dom/GadtApi/WebSocket.hs +146/−39
• src/Reflex/Dom/GadtApi/XHR.hs +63/−28
• test/Main.hs +232/−0

@@ -1,5 +1,15 @@ # Revision history for reflex-gadt-api +## 0.4.0.0++* Add `Reflex.Dom.GadtApi.Codec`, exposing the pure `encodeApiRequest` and `serveApiRequest` codecs used by the transports; `serveApiRequest` gives servers a reusable untagged decode/interpret/encode step+* Add a test suite covering request tagging and correlation (in order, out of order, and multiple requests per frame), duplicate and unknown tags, malformed payloads and frames, and the codec helpers+* Enable `FlexibleContexts` for generated test instances, as required by the GHC 9.10 and 9.12 CI builds+* *Breaking*: `performWebSocketRequests` takes a `WebSocketClientConfig` (URL, subprotocols, close, and reconnect) and additionally returns a `WebSocketClientStatus` exposing connection open/error/close events, unparseable incoming messages, and responses that don't match any outstanding request. Note that outstanding requests still survive disconnects and reconnects+* *Breaking*: `tagRequests` additionally returns an event of responses whose tag matches no outstanding request; previously such responses were dropped silently+* *Breaking*: `performXhrRequests` and `apiRequestXhr` take an `XhrClientConfig` whose `configureRequest` hook can adjust the outgoing `XhrRequest` (e.g. to add headers or credentials)+* *Breaking*: transport-level failures are now reported instead of hanging: `XhrError` carries `Either XhrException XhrResponse`, so aborted requests and requests that could not be sent surface as errors; consequently `XhrError` no longer derives `Generic`+ ## 0.3.0.0  * *Breaking*: switch to a more useful xhr error response type. To retain the current behavior, you must convert `Either XhrResponse` to `Either Text`. See `Readme.lhs` for an example using `xhrErrorToText`.

@@ -1,14 +1,46 @@+<div align="center">+ reflex-gadt-api =============== -[![Haskell](https://img.shields.io/badge/language-Haskell-orange.svg)](https://haskell.org) [![Hackage](https://img.shields.io/hackage/v/reflex-gadt-api.svg)](https://hackage.haskell.org/package/reflex-gadt-api) [![Github CI](https://github.com/reflex-frp/reflex-gadt-api/workflows/Haskell%20CI/badge.svg)](https://github.com/reflex-frp/reflex-gadt-api/actions) [![BSD3 License](https://img.shields.io/badge/license-BSD3-blue.svg)](https://github.com/reflex-frp/reflex-gadt-api/blob/master/LICENSE)+**Type-safe, full-stack APIs for Reflex, defined once as a GADT.** +Describe your API as a [GADT](https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/gadt.html), derive its JSON wire format, and call it from your [reflex-dom](https://github.com/reflex-frp/reflex-dom) frontend over XHR or WebSockets, with request and response types checked from end to end. +[![Haskell](https://img.shields.io/badge/language-Haskell-orange.svg)](https://haskell.org) [![Hackage](https://img.shields.io/hackage/v/reflex-gadt-api.svg)](https://hackage.haskell.org/package/reflex-gadt-api) [![Github CI](https://github.com/reflex-frp/reflex-gadt-api/workflows/Haskell%20CI/badge.svg)](https://github.com/reflex-frp/reflex-gadt-api/actions) [![Obsidian](https://img.shields.io/badge/Obsidian-Systems-white)](https://obsidian.systems) [![BSD3 License](https://img.shields.io/badge/license-BSD3-blue.svg)](LICENSE) +</div>+ This package is designed to be used in full-stack Haskell applications where the API is defined as a GADT, the wire format is JSON, and the frontend is using reflex-dom(-core). reflex-gadt-api provides the basic FRP and encoding/decoding infrastructure to support this architecture. -To serialize the GADT API definition, we use [aeson-gadt-th](https://github.com/obsidiansystems/aeson-gadt-th) with a little help from [constraints-extras](https://github.com/obsidiansystems/constraints-extras).+Why define your API as a GADT?+------------------------------ +An ordinary Haskell data type can enumerate the requests an API accepts, but it can't capture what each request *returns*: every constructor of a plain `data Api = ...` has the same type, so a handler can only ever promise "some response," and the link between a particular request and its particular response type is lost.++A GADT (generalized algebraic data type) removes that restriction: each constructor may fix the type parameter to a different type. We use that parameter to record each request's **response type**:++    data DogApi a where+      DogApi_GetByName :: Text -> DogApi [Dog]+      DogApi_GetLastSeen :: DogApi (Maybe Dog)+      DogApi_ReportSighting :: Text -> Bool -> Maybe Text -> DogApi (Either Text ())++Now `DogApi_GetLastSeen` is a `DogApi (Maybe Dog)` and `DogApi_GetByName "Rex"` is a `DogApi [Dog]`: a constructor's arguments are the request, and its type index is the response. That single idea buys a lot:++- **A request and its response can't drift apart.** When the backend pattern matches on a request, GHC knows the exact response type in that branch, so a handler of type `forall a. DogApi a -> m a` is checked to return the right type for every endpoint, and to handle them all. Adding an endpoint means adding a constructor, and the compiler then points you at every place that must account for it.+- **The types are the contract, shared across the whole stack.** The API is just a datatype in a `common` library, so the *same* definition compiles into both the GHC backend and the (JavaScript) reflex-dom frontend. There is no separate schema or IDL, and no generated client to fall out of sync; client and server cannot disagree about a request's arguments or its response type, because they are the same type.+- **Endpoints compose.** Because requests are ordinary values, one API can embed another while preserving response types. The example below nests `DogApi` inside a `CatApi` that layers on authentication: `CatApi_DogApi :: Token -> DogApi a -> CatApi a`.+- **Responses arrive typed, not as raw JSON.** Sending `DogApi_GetLastSeen` gives you back a `Maybe Dog`, not a `Value` you have to re-parse by hand. This library automates the business of preserving that response type across JSON (de)serialization.++Putting it together+-------------------++- **The GADT** defines the requests and, through its type index, their response types.+- **Derived instances.** `deriveJSONGADT` (from [aeson-gadt-th](https://github.com/obsidiansystems/aeson-gadt-th)) derives the JSON wire format for the API, and `deriveArgDict` (from [constraints-extras](https://github.com/obsidiansystems/constraints-extras)) derives the machinery that recovers a request's `FromJSON` instance so its response can be decoded. (Once requests with different response types are mixed into a single event, that response type is existentially hidden; this is what brings it back.)+- **A transport** carries requests to the server and feeds typed responses back into your reflex app. Two are provided: `performXhrRequests` (one HTTP request per call) and `performWebSocketRequests` (a single, multiplexed socket). Each takes a configuration record — `XhrClientConfig` lets you adjust outgoing requests (for example, headers or credentials) and `WebSocketClientConfig` exposes connection knobs like subprotocols and automatic reconnection — and the WebSocket transport also returns a `WebSocketClientStatus` reporting connection lifecycle, unparseable incoming messages, and responses that match no outstanding request. On the server, `Reflex.Dom.GadtApi.Codec` provides the matching codecs and dispatcher (`encodeApiRequest`, `serveApiRequest`).++The rest of this document is a literate Haskell walkthrough that builds a small example app.+ Example Usage: -------------- @@ -146,15 +178,18 @@  ``` -The `Event` of responses comes, in this case, from a function that will take the requests emitted on the previous line and fetch responses to those requests. It produces an `Event` of responses. We can use either `Reflex.Dom.GadtApi.XHR.performXhrRequests` if we want to send requests using XHR or `Reflex.Dom.GadtApi.WebSocket.performWebSocketRequests` to use WebSockets.+The `Event` of responses comes, in this case, from a function that will take the requests emitted on the previous line and fetch responses to those requests. It produces an `Event` of responses. We can use either `Reflex.Dom.GadtApi.XHR.performXhrRequests` if we want to send requests using XHR or `Reflex.Dom.GadtApi.WebSocket.performWebSocketRequests` to use WebSockets. Both are configured through `def`-based records; here we only set the URL. The WebSocket transport additionally returns a `WebSocketClientStatus` value, ignored in this toy example; it exposes connection lifecycle events and protocol diagnostics such as unparseable messages and responses that match no outstanding request. ```haskell  >       responses <- case endpoint of >         Left xhr -> do->           r <- performXhrRequests xhr (requests :: Event t (RequesterData CatApi))+>           r <- performXhrRequests (def { _xhrClientConfig_url = xhr }) (requests :: Event t (RequesterData CatApi)) >           performEvent $ ffor r $ traverseRequesterData $ \x -> >             pure $ mapLeft xhrErrorToText x->         Right ws -> performWebSocketRequests ws (requests :: Event t (RequesterData CatApi))+>         Right ws -> do+>           (r, _status) <- performWebSocketRequests+>             (def { _webSocketClientConfig_url = ws }) (requests :: Event t (RequesterData CatApi))+>           pure r >   pure () >   where >     mapLeft f = \case@@ -333,3 +368,19 @@ ```  Go to the [example](example) directory to run this example (including the [backend](example/backend/src/Backend.md)).++About Obsidian Systems+----------------------++reflex-gadt-api is built and maintained by **[Obsidian Systems](https://obsidian.systems)**. We provide frontier engineering for high-assurance systems: we build production software in Haskell and Nix, and we're long-time stewards of open-source tooling like [Obelisk](https://github.com/obsidiansystems/obelisk), [Reflex](https://reflex-frp.org/), and [nix-thunk](https://github.com/obsidiansystems/nix-thunk).++If you're working with Reflex, full-stack Haskell, or Nix and want a partner to help design, build, or ship it, we'd love to hear from you.++- Website: <https://obsidian.systems>+- Blog: <https://blog.obsidian.systems>+- GitHub: <https://github.com/obsidiansystems>++License+-------++reflex-gadt-api is released under the [BSD-3-Clause License](LICENSE), © 2015 Obsidian Systems LLC.

@@ -1,14 +1,46 @@+<div align="center">+ reflex-gadt-api =============== -[![Haskell](https://img.shields.io/badge/language-Haskell-orange.svg)](https://haskell.org) [![Hackage](https://img.shields.io/hackage/v/reflex-gadt-api.svg)](https://hackage.haskell.org/package/reflex-gadt-api) [![Github CI](https://github.com/reflex-frp/reflex-gadt-api/workflows/Haskell%20CI/badge.svg)](https://github.com/reflex-frp/reflex-gadt-api/actions) [![BSD3 License](https://img.shields.io/badge/license-BSD3-blue.svg)](https://github.com/reflex-frp/reflex-gadt-api/blob/master/LICENSE)+**Type-safe, full-stack APIs for Reflex, defined once as a GADT.** +Describe your API as a [GADT](https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/gadt.html), derive its JSON wire format, and call it from your [reflex-dom](https://github.com/reflex-frp/reflex-dom) frontend over XHR or WebSockets, with request and response types checked from end to end. +[![Haskell](https://img.shields.io/badge/language-Haskell-orange.svg)](https://haskell.org) [![Hackage](https://img.shields.io/hackage/v/reflex-gadt-api.svg)](https://hackage.haskell.org/package/reflex-gadt-api) [![Github CI](https://github.com/reflex-frp/reflex-gadt-api/workflows/Haskell%20CI/badge.svg)](https://github.com/reflex-frp/reflex-gadt-api/actions) [![Obsidian](https://img.shields.io/badge/Obsidian-Systems-white)](https://obsidian.systems) [![BSD3 License](https://img.shields.io/badge/license-BSD3-blue.svg)](LICENSE) +</div>+ This package is designed to be used in full-stack Haskell applications where the API is defined as a GADT, the wire format is JSON, and the frontend is using reflex-dom(-core). reflex-gadt-api provides the basic FRP and encoding/decoding infrastructure to support this architecture. -To serialize the GADT API definition, we use [aeson-gadt-th](https://github.com/obsidiansystems/aeson-gadt-th) with a little help from [constraints-extras](https://github.com/obsidiansystems/constraints-extras).+Why define your API as a GADT?+------------------------------ +An ordinary Haskell data type can enumerate the requests an API accepts, but it can't capture what each request *returns*: every constructor of a plain `data Api = ...` has the same type, so a handler can only ever promise "some response," and the link between a particular request and its particular response type is lost.++A GADT (generalized algebraic data type) removes that restriction: each constructor may fix the type parameter to a different type. We use that parameter to record each request's **response type**:++    data DogApi a where+      DogApi_GetByName :: Text -> DogApi [Dog]+      DogApi_GetLastSeen :: DogApi (Maybe Dog)+      DogApi_ReportSighting :: Text -> Bool -> Maybe Text -> DogApi (Either Text ())++Now `DogApi_GetLastSeen` is a `DogApi (Maybe Dog)` and `DogApi_GetByName "Rex"` is a `DogApi [Dog]`: a constructor's arguments are the request, and its type index is the response. That single idea buys a lot:++- **A request and its response can't drift apart.** When the backend pattern matches on a request, GHC knows the exact response type in that branch, so a handler of type `forall a. DogApi a -> m a` is checked to return the right type for every endpoint, and to handle them all. Adding an endpoint means adding a constructor, and the compiler then points you at every place that must account for it.+- **The types are the contract, shared across the whole stack.** The API is just a datatype in a `common` library, so the *same* definition compiles into both the GHC backend and the (JavaScript) reflex-dom frontend. There is no separate schema or IDL, and no generated client to fall out of sync; client and server cannot disagree about a request's arguments or its response type, because they are the same type.+- **Endpoints compose.** Because requests are ordinary values, one API can embed another while preserving response types. The example below nests `DogApi` inside a `CatApi` that layers on authentication: `CatApi_DogApi :: Token -> DogApi a -> CatApi a`.+- **Responses arrive typed, not as raw JSON.** Sending `DogApi_GetLastSeen` gives you back a `Maybe Dog`, not a `Value` you have to re-parse by hand. This library automates the business of preserving that response type across JSON (de)serialization.++Putting it together+-------------------++- **The GADT** defines the requests and, through its type index, their response types.+- **Derived instances.** `deriveJSONGADT` (from [aeson-gadt-th](https://github.com/obsidiansystems/aeson-gadt-th)) derives the JSON wire format for the API, and `deriveArgDict` (from [constraints-extras](https://github.com/obsidiansystems/constraints-extras)) derives the machinery that recovers a request's `FromJSON` instance so its response can be decoded. (Once requests with different response types are mixed into a single event, that response type is existentially hidden; this is what brings it back.)+- **A transport** carries requests to the server and feeds typed responses back into your reflex app. Two are provided: `performXhrRequests` (one HTTP request per call) and `performWebSocketRequests` (a single, multiplexed socket). Each takes a configuration record — `XhrClientConfig` lets you adjust outgoing requests (for example, headers or credentials) and `WebSocketClientConfig` exposes connection knobs like subprotocols and automatic reconnection — and the WebSocket transport also returns a `WebSocketClientStatus` reporting connection lifecycle, unparseable incoming messages, and responses that match no outstanding request. On the server, `Reflex.Dom.GadtApi.Codec` provides the matching codecs and dispatcher (`encodeApiRequest`, `serveApiRequest`).++The rest of this document is a literate Haskell walkthrough that builds a small example app.+ Example Usage: -------------- @@ -146,15 +178,18 @@  ``` -The `Event` of responses comes, in this case, from a function that will take the requests emitted on the previous line and fetch responses to those requests. It produces an `Event` of responses. We can use either `Reflex.Dom.GadtApi.XHR.performXhrRequests` if we want to send requests using XHR or `Reflex.Dom.GadtApi.WebSocket.performWebSocketRequests` to use WebSockets.+The `Event` of responses comes, in this case, from a function that will take the requests emitted on the previous line and fetch responses to those requests. It produces an `Event` of responses. We can use either `Reflex.Dom.GadtApi.XHR.performXhrRequests` if we want to send requests using XHR or `Reflex.Dom.GadtApi.WebSocket.performWebSocketRequests` to use WebSockets. Both are configured through `def`-based records; here we only set the URL. The WebSocket transport additionally returns a `WebSocketClientStatus` value, ignored in this toy example; it exposes connection lifecycle events and protocol diagnostics such as unparseable messages and responses that match no outstanding request. ```haskell  >       responses <- case endpoint of >         Left xhr -> do->           r <- performXhrRequests xhr (requests :: Event t (RequesterData CatApi))+>           r <- performXhrRequests (def { _xhrClientConfig_url = xhr }) (requests :: Event t (RequesterData CatApi)) >           performEvent $ ffor r $ traverseRequesterData $ \x -> >             pure $ mapLeft xhrErrorToText x->         Right ws -> performWebSocketRequests ws (requests :: Event t (RequesterData CatApi))+>         Right ws -> do+>           (r, _status) <- performWebSocketRequests+>             (def { _webSocketClientConfig_url = ws }) (requests :: Event t (RequesterData CatApi))+>           pure r >   pure () >   where >     mapLeft f = \case@@ -333,3 +368,19 @@ ```  Go to the [example](example) directory to run this example (including the [backend](example/backend/src/Backend.md)).++About Obsidian Systems+----------------------++reflex-gadt-api is built and maintained by **[Obsidian Systems](https://obsidian.systems)**. We provide frontier engineering for high-assurance systems: we build production software in Haskell and Nix, and we're long-time stewards of open-source tooling like [Obelisk](https://github.com/obsidiansystems/obelisk), [Reflex](https://reflex-frp.org/), and [nix-thunk](https://github.com/obsidiansystems/nix-thunk).++If you're working with Reflex, full-stack Haskell, or Nix and want a partner to help design, build, or ship it, we'd love to hear from you.++- Website: <https://obsidian.systems>+- Blog: <https://blog.obsidian.systems>+- GitHub: <https://github.com/obsidiansystems>++License+-------++reflex-gadt-api is released under the [BSD-3-Clause License](LICENSE), © 2015 Obsidian Systems LLC.

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               reflex-gadt-api-version:            0.3.0.0+version:            0.4.0.0 synopsis:           Interact with a GADT API in your reflex-dom application. description:   This package is designed to be used in full-stack Haskell applications where the API is defined as a GADT and the frontend is using reflex-dom.@@ -13,7 +13,7 @@ copyright:          2020 Obsidian Systems LLC category:           FRP, API, network build-type:         Simple-extra-source-files:+extra-doc-files:   ChangeLog.md   Readme.md @@ -25,6 +25,7 @@       aeson               >=1.4.4  && <2.3     , aeson-gadt-th       >=0.2.4  && <0.3     , base                >=4.12   && <4.22+    , bytestring         >=0.10   && <0.13     , constraints-extras  >=0.3.0  && <0.5     , containers          >=0.6    && <0.8     , data-default        >=0.6    && <0.9@@ -37,6 +38,7 @@    exposed-modules:     Reflex.Dom.GadtApi+    Reflex.Dom.GadtApi.Codec     Reflex.Dom.GadtApi.WebSocket     Reflex.Dom.GadtApi.XHR @@ -65,6 +67,24 @@   main-is:          Readme.lhs   ghc-options:      -Wall -optL -q -main-is Readme.main +test-suite reflex-gadt-api-test+  type:               exitcode-stdio-1.0+  main-is:            Main.hs+  hs-source-dirs:     test+  build-depends:+      aeson               >=1.4.4  && <2.3+    , aeson-gadt-th       >=0.2.4  && <0.3+    , base                >=4.12   && <4.22+    , constraints-extras  >=0.3.0  && <0.5+    , bytestring         >=0.10   && <0.13+    , hspec               >=2.8    && <2.12+    , reflex              >=0.9    && <1+    , reflex-gadt-api+    , some                >=1      && <1.1+    , text                >=1.2    && <2.2+  default-language:  Haskell2010+  ghc-options:       -Wall+ source-repository head   type:     git-  location: git://github.com/reflex-frp/reflex-gadt-api.git+  location: https://github.com/reflex-frp/reflex-gadt-api.git

@@ -0,0 +1,59 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE QuantifiedConstraints #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE UndecidableInstances #-}++-- | Pure request\/response codecs and dispatch for a GADT API.+--+-- "Reflex.Dom.GadtApi.WebSocket" and "Reflex.Dom.GadtApi.XHR" use these+-- operations internally. Use them on a server, or in a new transport, to+-- keep the same wire format.+--+-- Client and server constraints are separate. A client encodes requests and+-- decodes responses. A server decodes requests and encodes responses.+module Reflex.Dom.GadtApi.Codec+  ( encodeApiRequest+  , serveApiRequest+  ) where++import Data.Aeson+import Data.Constraint.Extras+import Data.Some (Some (..))+import Data.Text (Text)+import qualified Data.Text as T++-- | Encode an API request as JSON, together with a decoder for its response.+--+-- The decoder uses the request to find the 'FromJSON' instance of the+-- response type. Mixed requests hide this type. The decoder makes it known+-- again. A payload that does not decode as the response type gives 'Left'+-- with the parser error.+encodeApiRequest+  :: forall api a. (Has FromJSON api, forall x. ToJSON (api x))+  => api a+  -> (Value, Value -> Either Text a)+encodeApiRequest r =+  ( toJSON r+  , \v -> case has @FromJSON r $ fromJSON v of+      Success x -> Right x+      Error e -> Left $ T.pack e+  )++-- | Decode an incoming request. Run the handler on it. Encode the response.+--+-- A request 'Value' that does not match a constructor of the API gives+-- 'Left' with the parser error. This function does not catch an exception+-- from the handler. The interpreter or the host application must handle+-- such exceptions.+serveApiRequest+  :: (Monad m, FromJSON (Some api), Has ToJSON api)+  => (forall a. api a -> m a)+  -> Value+  -> m (Either String Value)+serveApiRequest f v = case fromJSON v of+  Success (Some a) -> do+    rsp <- f a+    pure $ Right $ has @ToJSON a $ toJSON rsp+  Error e -> pure $ Left e

@@ -1,6 +1,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuantifiedConstraints #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecursiveDo #-}@@ -10,6 +11,8 @@ {-# LANGUAGE UndecidableInstances #-} module Reflex.Dom.GadtApi.WebSocket   ( performWebSocketRequests+  , WebSocketClientConfig (..)+  , WebSocketClientStatus (..)   , TaggedRequest (..)   , TaggedResponse (..)   , mkTaggedResponse@@ -20,8 +23,9 @@ import Control.Monad.Fix (MonadFix) import Data.Constraint.Extras import Data.Aeson+import Data.ByteString (ByteString) import Data.Default-import qualified Data.Text as T+import qualified Data.Set as Set import GHC.Generics import qualified Data.Map as Map import Data.Some@@ -31,6 +35,8 @@ import Reflex.Dom.Core (Prerender, prerender) import Reflex.Dom.WebSocket +import Reflex.Dom.GadtApi.Codec (encodeApiRequest, serveApiRequest)+ -- | A request tagged with an identifier data TaggedRequest = TaggedRequest Int Value   deriving Generic@@ -38,7 +44,7 @@ instance FromJSON TaggedRequest instance ToJSON TaggedRequest --- | A response tagged with an identifier matching the one in the 'TaggedRequest'. The identifier is the first argument.+-- | A response tagged with an identifier. The identifier matches the one in the 'TaggedRequest' and is the first argument. data TaggedResponse = TaggedResponse Int Value   deriving Generic @@ -47,51 +53,145 @@  type WebSocketEndpoint = Text --- | Opens a websockets connection, takes the output of a 'RequesterT' widget--- and issues that output as API requests over the socket. The result of this--- function can be fed back into the requester as responses. For example:+-- | Configuration for the websocket that 'performWebSocketRequests' manages.+-- These fields match the native 'Reflex.Dom.WebSocket.WebSocketConfig'+-- fields. The XHR transport has no matching fields. The two transports have+-- different capabilities.+data WebSocketClientConfig t = WebSocketClientConfig+  { _webSocketClientConfig_url :: WebSocketEndpoint+    -- ^ URL of the websocket+  , _webSocketClientConfig_reconnect :: Bool+    -- ^ Whether to connect again automatically after the connection closes.+    -- Requests sent while no connection is open stay in a queue. The queue+    -- is sent when a connection opens. Outstanding requests survive+    -- disconnects and reconnects. See 'WebSocketClientStatus'.+  , _webSocketClientConfig_protocols :: [Text]+    -- ^ Subprotocols to request when opening the connection+  , _webSocketClientConfig_close :: Event t (Word, Text)+    -- ^ Close the connection with this code and reason when this event+    -- fires+  }++-- | The default configuration uses the empty URL. It requests no+-- subprotocols and never closes the connection itself. It connects again+-- automatically. Set '_webSocketClientConfig_url' before you use it.+instance Reflex t => Default (WebSocketClientConfig t) where+  def = WebSocketClientConfig+    { _webSocketClientConfig_url = ""+    , _webSocketClientConfig_reconnect = True+    , _webSocketClientConfig_protocols = []+    , _webSocketClientConfig_close = never+    }++-- | Connection status and protocol diagnostics for the socket that+-- 'performWebSocketRequests' manages. The lifecycle events come from+-- 'Reflex.Dom.WebSocket.WebSocket': --+-- * '_webSocketClientStatus_open' fires each time a connection opens. This+--   includes connections after a reconnect.+-- * '_webSocketClientStatus_error' fires on a connection error. A close+--   event always follows it.+-- * '_webSocketClientStatus_close' fires each time a connection closes. It+--   carries the @wasClean@ flag, the status code, and the reason.+--+-- Outstanding requests are /not/ failed when the connection closes. They+-- stay pending until a matching response arrives. Requests sent while no+-- connection is open stay in a queue. The queue is sent when a connection+-- opens. A queued request that changes data can be sent again after a+-- reconnect. Set '_webSocketClientConfig_reconnect' to 'False' if your+-- application must not send the same change twice.+data WebSocketClientStatus t = WebSocketClientStatus+  { _webSocketClientStatus_open :: Event t ()+    -- ^ A connection opened+  , _webSocketClientStatus_error :: Event t ()+    -- ^ A connection error occurred. A close event always follows.+  , _webSocketClientStatus_close :: Event t (Bool, Word, Text)+    -- ^ The connection closed with @wasClean@, code, and reason+  , _webSocketClientStatus_unparseableMessage :: Event t ByteString+    -- ^ An incoming message that does not decode as a 'TaggedResponse'.+    -- The library cannot match such a message to a request. It reports the+    -- message here instead of a request error. If you share the socket with+    -- other traffic, use 'tagRequests'. Split the incoming messages+    -- yourself.+  , _webSocketClientStatus_unmatchedResponse :: Event t (Int, Value)+    -- ^ A well-formed 'TaggedResponse' with a tag that no outstanding+    -- request uses. The tag is unknown, or the response is a duplicate. The+    -- library cannot correlate such a response. It reports the response+    -- here.+  }++-- | Open one websocket connection. Send the output of a 'RequesterT' widget+-- as API requests on this socket. Integer tags multiplex the requests. Feed+-- the first result back into the requester as responses. The second result+-- reports connection and protocol problems. For example:+-- -- @ -- rec (appResult, requests) <- runRequesterT myApplication responses---     responses <- performWebSocketRequests myEndpoint requests+--     (responses, status) <- performWebSocketRequests (def { _webSocketClientConfig_url = myEndpoint }) requests -- @ --+-- See 'WebSocketClientStatus' for the lifecycle of outstanding requests+-- across disconnects and reconnects. performWebSocketRequests   :: forall req t m.-     ( Prerender t m, Applicative m+     ( Prerender t m, Monad m      , FromJSON (Some req)      , forall a. ToJSON (req a)      , Has FromJSON req      )-  => WebSocketEndpoint+  => WebSocketClientConfig t   -> Event t (RequesterData req)-  -> m (Event t (RequesterData (Either Text)))-performWebSocketRequests url req = fmap switchPromptlyDyn $ prerender (pure never) $ do-  rec w <- webSocket url $ def-        { _webSocketConfig_send = fmap encode <$> reqs+  -> m (Event t (RequesterData (Either Text)), WebSocketClientStatus t)+performWebSocketRequests cfg req = do+  d <- prerender (pure (never, statusNever)) $ do+    rec w <- webSocket (_webSocketClientConfig_url cfg) $ WebSocketConfig+          { _webSocketConfig_send = fmap encode <$> reqs+          , _webSocketConfig_close = _webSocketClientConfig_close cfg+          , _webSocketConfig_reconnect = _webSocketClientConfig_reconnect cfg+          , _webSocketConfig_protocols = _webSocketClientConfig_protocols cfg+          }+        let decoded = ffor (_webSocket_recv w) $ \msg -> case decodeStrict msg of+              Just r -> Right r+              Nothing -> Left msg+            rsp = fmapMaybe (either (const Nothing) Just) decoded+            unparseable = fmapMaybe (either Just (const Nothing)) decoded+        (reqs, rsps, unmatched) <- tagRequests req rsp+    pure (rsps, WebSocketClientStatus+      { _webSocketClientStatus_open = _webSocket_open w+      , _webSocketClientStatus_error = _webSocket_error w+      , _webSocketClientStatus_close = _webSocket_close w+      , _webSocketClientStatus_unparseableMessage = unparseable+      , _webSocketClientStatus_unmatchedResponse = unmatched+      })+  pure+    ( switchPromptlyDyn (fst <$> d)+    , WebSocketClientStatus+        { _webSocketClientStatus_open = switchPromptlyDyn (_webSocketClientStatus_open . snd <$> d)+        , _webSocketClientStatus_error = switchPromptlyDyn (_webSocketClientStatus_error . snd <$> d)+        , _webSocketClientStatus_close = switchPromptlyDyn (_webSocketClientStatus_close . snd <$> d)+        , _webSocketClientStatus_unparseableMessage = switchPromptlyDyn (_webSocketClientStatus_unparseableMessage . snd <$> d)+        , _webSocketClientStatus_unmatchedResponse = switchPromptlyDyn (_webSocketClientStatus_unmatchedResponse . snd <$> d)         }-      let rsp = fmapMaybe decodeStrict $ _webSocket_recv w-      (reqs, rsps) <- tagRequests req rsp-  pure rsps+    )+  where+    statusNever = WebSocketClientStatus never never never never never --- | Constructs a response for a given request, and handles the--- decoding/encoding and tagging steps internal to TaggedRequest and--- TaggedResponse.+-- | Construct a response for a request. This function does the decoding,+-- the encoding, and the tagging that 'TaggedRequest' and 'TaggedResponse'+-- need. mkTaggedResponse   :: (Monad m, FromJSON (Some f), Has ToJSON f)   => TaggedRequest   -> (forall a. f a -> m a)   -> m (Either String TaggedResponse)-mkTaggedResponse (TaggedRequest reqId v) f = case fromJSON v of-  Success (Some a) -> do-    rsp <- f a-    pure $ Right $ TaggedResponse reqId (has @ToJSON a $ toJSON rsp)-  Error err -> pure $ Left err+mkTaggedResponse (TaggedRequest reqId v) f =+  fmap (fmap (TaggedResponse reqId)) $ serveApiRequest f v --- | This function transforms a request 'Event' into an 'Event' of--- 'TaggedRequest's (the indexed wire format used to transmit requests). It--- expects to receive an 'Event' of 'TaggedResponse', the corresponding--- response wire format, which it will transform into an "untagged" response.+-- | Transform a request 'Event' into an 'Event' of 'TaggedRequest' values.+-- 'TaggedRequest' is the indexed wire format for requests. This function+-- expects an 'Event' of 'TaggedResponse' values. 'TaggedResponse' is the+-- response wire format. This function transforms them into untagged+-- responses. -- -- @ --   requests  --> |-------------| --> tagged requests@@ -101,12 +201,16 @@ --   responses <-- |-------------| <-- tagged responses -- @ ----- This function is provided so that you can use a single websocket for--- multiple purposes without reimplementing the functionality of--- 'performWebSocketRequests'. For instance, you might have a websocket split--- into two "channels," one for these tagged API requests and another for data--- being pushed from the server.+-- Use this function when one websocket serves multiple purposes. It gives+-- you the behavior of 'performWebSocketRequests' without a dedicated+-- socket. For example, split the socket into two channels. Use one channel+-- for these tagged requests. Use the other channel for data that the server+-- pushes. --+-- The third result reports 'TaggedResponse' values with a tag that no+-- outstanding request uses. The tag is unknown or duplicate. Such responses+-- are dropped from the response output. Outstanding requests survive+-- disconnects. They are answered when a matching response arrives. tagRequests   :: forall req t m.      ( Applicative m@@ -122,6 +226,7 @@   -> Event t TaggedResponse   -> m ( Event t [TaggedRequest]        , Event t (RequesterData (Either Text))+       , Event t (Int, Value)        ) tagRequests req rsp = do   rec (matchedReq, matchedRsp) <- matchResponsesWithRequests enc req $@@ -129,12 +234,14 @@       let wireReq = fmap (Map.elems . Map.mapMaybeWithKey (\t v -> case fromJSON v of             Success (r :: Value) -> Just $ TaggedRequest t r             _ -> Nothing)) matchedReq-  pure (wireReq, matchedRsp)+      outstanding <- foldDyn ($) Set.empty $ leftmost+        [ ffor matchedReq $ \m s -> Set.union s (Map.keysSet m)+        , ffor rsp $ \(TaggedResponse t _) s -> Set.delete t s+        ]+      let unmatched = flip push rsp $ \(TaggedResponse t v) -> do+            s <- sample $ current outstanding+            pure $ if Set.member t s then Nothing else Just (t, v)+  pure (wireReq, matchedRsp, unmatched)   where     enc :: forall a. req a -> (Value, Value -> Either Text a)-    enc r =-      ( toJSON r-      , \x -> case has @FromJSON r $ fromJSON x of-        Success s-> Right s-        Error e -> Left $ T.pack e-      )+    enc = encodeApiRequest

@@ -1,4 +1,3 @@-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-}@@ -11,24 +10,44 @@ import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Aeson import Data.Constraint.Extras (Has, has)+import Data.Default (Default (..)) import Data.Functor (void) import Data.Text (Text)-import GHC.Generics import Language.Javascript.JSaddle (MonadJSM) import Language.Javascript.JSaddle.Monad (runJSM, askJSM) import Reflex.Dom.Core  type ApiEndpoint = Text --- | Takes the output of a 'RequesterT' widget and issues that--- output as API requests. The result of this function can be--- fed back into the requester as responses. For example:+-- | Configuration for 'performXhrRequests' and 'apiRequestXhr'. --+-- 'Reflex.Dom.Xhr.postJson' builds each request as a JSON @POST@. Use+-- '_xhrClientConfig_configureRequest' to adjust the+-- 'Reflex.Dom.Xhr.XhrRequest' before the library sends it. For example, add+-- headers or credentials.+data XhrClientConfig = XhrClientConfig+  { _xhrClientConfig_url :: ApiEndpoint+    -- ^ URL that the requests are sent to+  , _xhrClientConfig_configureRequest :: XhrRequest Text -> XhrRequest Text+    -- ^ Adjust each outgoing 'XhrRequest' before it is sent+  }++-- | The default configuration uses the empty URL and does not change the+-- requests. Set '_xhrClientConfig_url' before you use it.+instance Default XhrClientConfig where+  def = XhrClientConfig+    { _xhrClientConfig_url = ""+    , _xhrClientConfig_configureRequest = id+    }++-- | Send the output of a 'RequesterT' widget as API requests. Feed the+-- result back into the requester as responses. For example:+-- -- @ -- rec (appResult, requests) <- runRequesterT myApplication responses---     responses <- performXhrRequests myApiEndpoint requests+--     responses <- performXhrRequests (def { _xhrClientConfig_url = myApiEndpoint }) requests -- @---+ performXhrRequests   :: forall t m api.      ( Has FromJSON api@@ -36,32 +55,45 @@      , Prerender t m      , Applicative m      )-  => ApiEndpoint+  => XhrClientConfig   -> Event t (RequesterData api)   -> m (Event t (RequesterData (Either XhrError)))-performXhrRequests apiUrl req = fmap switchPromptlyDyn $ prerender (pure never) $ do+performXhrRequests cfg req = fmap switchPromptlyDyn $ prerender (pure never) $ do   performEventAsync $ ffor req $ \r yield -> do     ctx <- askJSM     void $ liftIO $ forkIO $ flip runJSM ctx $-      liftIO . yield =<< apiRequestXhr apiUrl r+      liftIO . yield =<< apiRequestXhr cfg r +-- | A failed request. The record holds the request as it was sent. It also+-- holds the response, or the 'Reflex.Dom.Xhr.XhrException' that stopped the+-- request. 'XhrException_Aborted' shows an aborted request.+-- 'XhrException_Error' shows a request that could not be sent. data XhrError = XhrError   { _xhrError_request :: XhrRequest Text-  , _xhrError_response :: XhrResponse+  , _xhrError_response :: Either XhrException XhrResponse   }-  deriving (Generic)  xhrErrorToText :: XhrError -> Text xhrErrorToText e =-  let-    status = _xhrResponse_statusText . _xhrError_response $ e-    rsp = _xhrResponse_responseText . _xhrError_response $ e-  in status <> case rsp of-      Nothing -> ""-      Just r -> ": " <> r+  let url = _xhrRequest_url $ _xhrError_request e+  in case _xhrError_response e of+    Left XhrException_Aborted -> "Aborted: " <> url+    Left XhrException_Error -> "Request error: " <> url+    Right rsp ->+      let+        status = _xhrResponse_statusText rsp+        body = _xhrResponse_responseText rsp+      in status <> case body of+        Nothing -> ""+        Just b -> ": " <> b --- | Encodes an API request as JSON and issues an 'XhrRequest',--- and attempts to decode the response.+-- | Encode an API request as JSON. Send it with one 'XhrRequest'. Decode+-- the response.+--+-- Only a response that does not decode gives an 'XhrError'. This function+-- does not check the HTTP status of the response. A non-2xx response with a+-- body that decodes is a success. Read '_xhrError_response' to get the+-- status of a failed request. apiRequestXhr   :: forall api m.      ( MonadIO m@@ -69,10 +101,10 @@      , Has FromJSON api      , forall a. ToJSON (api a)      )-  => ApiEndpoint+  => XhrClientConfig   -> RequesterData api   -> m (RequesterData (Either XhrError))-apiRequestXhr apiUrl = traverseRequesterData $ \x ->+apiRequestXhr cfg = traverseRequesterData $ \x ->   has @FromJSON @api x $ mkRequest x   where     mkRequest@@ -81,9 +113,12 @@       -> m (Either XhrError b)     mkRequest req = do       response <- liftIO newEmptyMVar-      let request = postJson apiUrl req-      _ <- newXMLHttpRequest request $ liftIO . putMVar response-      xhrResp <- liftIO $ takeMVar response-      case decodeXhrResponse xhrResp of-        Nothing -> pure $ Left $ XhrError request xhrResp-        Just r -> pure $ Right r+      let request = _xhrClientConfig_configureRequest cfg $+            postJson (_xhrClientConfig_url cfg) req+      _ <- newXMLHttpRequestWithError request $ liftIO . putMVar response+      result <- liftIO $ takeMVar response+      pure $ case result of+        Left e -> Left $ XhrError request (Left e)+        Right xhrResp -> case decodeXhrResponse xhrResp of+          Nothing -> Left $ XhrError request (Right xhrResp)+          Just r -> Right r

@@ -0,0 +1,232 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE UndecidableInstances #-}+module Main (main) where++import Data.Aeson (FromJSON (..), ToJSON (..), Value (..), decodeStrict, encode, object, toJSON, (.=))+import Data.ByteString.Lazy (toStrict)+import Data.Aeson.GADT.TH (deriveJSONGADT)+import Data.Constraint.Extras.TH (deriveArgDict)+import Data.Either (isLeft)+import Data.Kind (Type)+import Data.List (isInfixOf)+import Data.Maybe (isNothing)+import Data.Text (Text)+import qualified Data.Text as Text+import GHC.Generics (Generic)+import Test.Hspec (describe, hspec, it, shouldBe, shouldSatisfy)++import Reflex+import Reflex.Pure+import Reflex.Dom.GadtApi.Codec (encodeApiRequest, serveApiRequest)+import Reflex.Dom.GadtApi.WebSocket++data DogApi :: Type -> Type where+  DogApi_GetName :: DogApi Text+  DogApi_Count :: DogApi Int+  DogApi_GetLast :: DogApi (Maybe Text)+  DogApi_Report :: Text -> DogApi (Either Text ())++deriveJSONGADT ''DogApi+deriveArgDict ''DogApi++newtype Token = Token { unToken :: Text }+  deriving (Generic)++instance ToJSON Token+instance FromJSON Token++data CatApi a where+  CatApi_Identify :: Text -> CatApi (Either Text Token)+  CatApi_DogApi :: Token -> DogApi a -> CatApi a++deriveJSONGADT ''CatApi+deriveArgDict ''CatApi++-- The wire format of a request is @("<Tag>", payload)@ (see aeson-gadt-th);+-- constructors with no arguments encode @()@ as the empty array.+tagged :: Text -> Value -> Value+tagged reqTag payload = toJSON (reqTag, payload)++handleDogApi :: DogApi a -> IO a+handleDogApi = \case+  DogApi_GetName -> pure "Rex"+  DogApi_Count -> pure 2+  DogApi_GetLast -> pure (Just "Fido")+  DogApi_Report _ -> pure (Right ())++handleCatApi :: CatApi a -> IO a+handleCatApi = \case+  CatApi_Identify name -> pure (Right (Token ("token-" <> name)))+  CatApi_DogApi _ inner -> handleDogApi inner++-- | A pure timeline: moments are 'Int's, and an 'Event' is just a function+-- of the moment. This lets us drive 'RequesterT' and 'tagRequests' end to+-- end, with real request tagging and correlation, without a host framework.+type T = Pure Int++-- | An event that fires with the given values at the given moments+occ :: [(Int, a)] -> Event T a+occ xs = Event (`lookup` xs)++-- | One client network: a 'RequesterT' widget with one 'requesting' call per+-- response type, wired through 'tagRequests'. Returns each requester's typed+-- response event, the outgoing wire requests, and unmatched responses.+buildClient+  :: Event T (DogApi Text)+  -> Event T (DogApi Int)+  -> Event T (DogApi (Maybe Text))+  -> Event T TaggedResponse+  -> Int+  -> ( Event T (Either Text Text)+     , Event T (Either Text Int)+     , Event T (Either Text (Maybe Text))+     , Event T [TaggedRequest]+     , Event T (Int, Value)+     )+buildClient eName eCount eLast rsp t0 =+  let widget = do+        wName <- requesting eName+        wCount <- requesting eCount+        wLast <- requesting eLast+        pure (wName, wCount, wLast)+      ((rName, rCount, rLast), reqs) = runRequesterT widget responses t0+      (wire, responses, unmatched) = tagRequests reqs rsp t0+  in (rName, rCount, rLast, wire, unmatched)++-- | Observation of an event at every listed moment+atEach :: [Int] -> Event T a -> [(Int, Maybe a)]+atEach ts e = fmap (\t -> (t, unEvent e t)) ts++main :: IO ()+main = hspec $ do+  describe "encodeApiRequest" $ do+    it "encodes the request and decodes a matching response" $ do+      let (v, dec) = encodeApiRequest DogApi_GetName+      v `shouldBe` tagged "DogApi_GetName" (toJSON ())+      dec (String "Rex") `shouldBe` Right "Rex"+    it "uses each request's own response dictionary" $ do+      let (_, decText) = encodeApiRequest DogApi_GetName+          (_, decInt) = encodeApiRequest DogApi_Count+          (_, decMaybe) = encodeApiRequest DogApi_GetLast+          (_, decEither) = encodeApiRequest (DogApi_Report "Fido")+      decText (String "Rex") `shouldBe` Right "Rex"+      decInt (Number 3) `shouldBe` Right 3+      decMaybe Null `shouldBe` Right Nothing+      decEither (object ["Left" .= ("no such dog" :: Text)]) `shouldBe` Right (Left "no such dog")+    it "reports responses that do not match the response type" $ do+      let (_, decInt) = encodeApiRequest DogApi_Count+      decInt (String "seven") `shouldSatisfy` isLeft+    it "supports nested APIs" $ do+      let (v, dec) = encodeApiRequest (CatApi_DogApi (Token "t") DogApi_Count)+      v `shouldBe` tagged "CatApi_DogApi" (toJSON (Token "t", tagged "DogApi_Count" (toJSON ())))+      dec (Number 3) `shouldBe` Right 3++  describe "serveApiRequest" $ do+    it "decodes, interprets, and encodes a request" $ do+      r <- serveApiRequest handleCatApi (tagged "CatApi_Identify" (toJSON ("felix" :: Text)))+      r `shouldBe` Right (object ["Right" .= object ["unToken" .= ("token-felix" :: Text)]])+    it "decodes nested requests with the inner response type" $ do+      r <- serveApiRequest handleCatApi+        (tagged "CatApi_DogApi" (toJSON (Token "t", tagged "DogApi_GetLast" (toJSON ()))))+      r `shouldBe` Right (String "Fido")+    it "rejects unknown request tags" $ do+      r <- serveApiRequest handleCatApi (tagged "CatApi_Nonsense" (toJSON ()))+      r `shouldSatisfy` \case+        Left e -> "CatApi_Nonsense" `isInfixOf` e+        Right _ -> False+    it "rejects malformed request payloads" $ do+      r <- serveApiRequest handleCatApi (tagged "CatApi_Identify" (toJSON (5 :: Int)))+      r `shouldSatisfy` isLeft++  describe "mkTaggedResponse" $ do+    it "interprets and re-tags a request" $ do+      r <- mkTaggedResponse+        (TaggedRequest 7 (tagged "DogApi_GetName" (toJSON ())))+        handleDogApi+      fmap encode r `shouldBe` Right (encode (TaggedResponse 7 (String "Rex")))+    it "rejects malformed request values" $ do+      r <- mkTaggedResponse (TaggedRequest 7 (Number 1)) handleDogApi+      fmap encode r `shouldSatisfy` isLeft++  describe "TaggedResponse wire format" $ do+    it "round-trips through JSON" $ do+      let rsp = TaggedResponse 1 (String "Rex")+      fmap encode (decodeStrict (toStrict (encode rsp)) :: Maybe TaggedResponse) `shouldBe` Just (encode rsp)+    it "does not decode malformed frames" $ do+      isNothing (decodeStrict "{" :: Maybe TaggedResponse) `shouldBe` True+      isNothing (decodeStrict "not json" :: Maybe TaggedResponse) `shouldBe` True++  describe "tagRequests" $ do+    it "issues sequentially tagged requests and correlates responses" $ do+      let (rName, _, _, wire, unmatched) =+            buildClient (occ [(1, DogApi_GetName)]) never never+              (occ [(2, TaggedResponse 1 (String "Rex"))]) 0+      fmap toJSON <$> unEvent wire 1 `shouldBe` Just [toJSON (1 :: Int, tagged "DogApi_GetName" (toJSON ()))]+      atEach [1 .. 3] rName `shouldBe` [(1, Nothing), (2, Just (Right "Rex")), (3, Nothing)]+      atEach [1 .. 3] unmatched `shouldBe` [(t, Nothing) | t <- [1 .. 3]]++    it "correlates out-of-order responses" $ do+      let (rName, rCount, _, _, unmatched) =+            buildClient (occ [(1, DogApi_GetName)]) (occ [(2, DogApi_Count)]) never+              (occ [ (3, TaggedResponse 2 (Number 7))+                   , (4, TaggedResponse 1 (String "Rex"))+                   ]) 0+      atEach [1 .. 4] rCount `shouldBe`+        [(1, Nothing), (2, Nothing), (3, Just (Right 7)), (4, Nothing)]+      atEach [1 .. 4] rName `shouldBe`+        [(1, Nothing), (2, Nothing), (3, Nothing), (4, Just (Right "Rex"))]+      atEach [1 .. 4] unmatched `shouldBe` [(t, Nothing) | t <- [1 .. 4]]++    it "tags multiple requests issued in the same frame" $ do+      let (rName, rCount, _, wire, _) =+            buildClient (occ [(1, DogApi_GetName)]) (occ [(1, DogApi_Count)]) never+              (occ [ (2, TaggedResponse 1 (Number 7))+                   , (3, TaggedResponse 2 (String "Rex"))+                   ]) 0+      fmap toJSON <$> unEvent wire 1 `shouldBe`+        Just [ toJSON (1 :: Int, tagged "DogApi_Count" (toJSON ()))+             , toJSON (2 :: Int, tagged "DogApi_GetName" (toJSON ())) ]+      atEach [1 .. 3] rCount `shouldBe` [(1, Nothing), (2, Just (Right 7)), (3, Nothing)]+      atEach [1 .. 3] rName `shouldBe` [(1, Nothing), (2, Nothing), (3, Just (Right "Rex"))]++    it "reports responses with unknown tags instead of dropping them" $ do+      let (rName, _, _, _, unmatched) =+            buildClient (occ [(1, DogApi_GetName)]) never never+              (occ [(2, TaggedResponse 99 (String "Rex"))]) 0+      atEach [1 .. 2] rName `shouldBe` [(1, Nothing), (2, Nothing)]+      atEach [1 .. 2] unmatched `shouldBe` [(1, Nothing), (2, Just (99, String "Rex"))]++    it "reports duplicate responses instead of dropping them" $ do+      let (rName, _, _, _, unmatched) =+            buildClient (occ [(1, DogApi_GetName)]) never never+              (occ [ (2, TaggedResponse 1 (String "Rex"))+                   , (3, TaggedResponse 1 (String "Rex again"))+                   ]) 0+      atEach [1 .. 3] rName `shouldBe`+        [(1, Nothing), (2, Just (Right "Rex")), (3, Nothing)]+      atEach [1 .. 3] unmatched `shouldBe`+        [(1, Nothing), (2, Nothing), (3, Just (1, String "Rex again"))]++    it "surfaces malformed payloads as request errors and retires the tag" $ do+      let (rName, _, _, _, unmatched) =+            buildClient (occ [(1, DogApi_GetName)]) never never+              (occ [ (2, TaggedResponse 1 (Number 7)) -- not Text+                   , (3, TaggedResponse 1 (String "late retry"))+                   ]) 0+      unEvent rName 1 `shouldBe` Nothing+      unEvent rName 2 `shouldSatisfy` \case+        Just (Left e) -> "Text" `isInfixOf` Text.unpack e+        _ -> False+      unEvent rName 3 `shouldBe` Nothing+      atEach [1 .. 3] unmatched `shouldBe`+        [(1, Nothing), (2, Nothing), (3, Just (1, String "late retry"))]