From 512c97888c09cdf00837f7c5cabd3655c286458d Mon Sep 17 00:00:00 2001 From: Joe Crayne Date: Fri, 24 Jan 2020 20:06:26 -0500 Subject: QueryResponse: non-error ignored case Discarded. --- server/src/Network/QueryResponse.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/server/src/Network/QueryResponse.hs b/server/src/Network/QueryResponse.hs index 470b7ce7..6af1f355 100644 --- a/server/src/Network/QueryResponse.hs +++ b/server/src/Network/QueryResponse.hs @@ -65,13 +65,14 @@ resultToMaybe _ = Nothing -- | An inbound packet or condition raised while monitoring a connection. data Arrival err addr x = Terminated -- ^ Virtual message that signals EOF. + | Discarded -- ^ Message dropped or passed to another thread. | ParseError !err -- ^ A badly-formed message was received. | Arrival { arrivedFrom :: !addr , arrivedMsg :: !x } -- ^ Inbound message. -- | Three methods are required to implement a datagram based query\/response protocol. data TransportA err addr x y = Transport { -- | Blocks until an inbound packet is available. Then calls the provided - -- continuation with the packet and origin addres or an error condition. + -- continuation with the packet and origin address or an error condition. awaitMessage :: forall a. (Arrival err addr x -> IO a) -> STM (IO a) -- | Send an /y/ packet to the given destination /addr/. , sendMessage :: addr -> y -> IO () @@ -109,6 +110,7 @@ layerTransportM parse encode tr = tr { awaitMessage = \kont -> awaitMessage tr $ \case Terminated -> kont $ Terminated + Discarded -> kont $ Discarded ParseError e -> kont $ ParseError e Arrival addr x -> parse x addr >>= \case Left e -> kont $ ParseError e @@ -153,6 +155,7 @@ partitionTransportM parse encodex tr = do Left x -> atomically (writeTChan tchan (Just x)) >> join (atomically again) Right (y,yaddr) -> kont $ Arrival yaddr y ParseError e -> kont $ ParseError e + Discarded -> kont $ Discarded Terminated -> atomically (writeTChan tchan Nothing) >> kont Terminated , sendMessage = sendMessage tr } @@ -708,6 +711,7 @@ newtype Tagged x addr = Tagged x decorateAddr :: tag addr -> Arrival e addr x -> Arrival e (DSum tag Identity) x decorateAddr tag Terminated = Terminated +decorateAddr tag Discarded = Discarded decorateAddr tag (ParseError e) = ParseError e decorateAddr tag (Arrival addr x) = Arrival (tag ==> addr) x -- cgit v1.2.3