dmq-node: localMsgNotification - do not enforce protocol invariants

Author: coot

dmq-node/src/DMQ/NodeToClient/LocalMsgNotification.hs

@@ -1,4 +1,7 @@
-module DMQ.NodeToClient.LocalMsgNotification where
+module DMQ.NodeToClient.LocalMsgNotification
+  ( localMsgNotificationServer
+  , LocalMsgNotificationProtocolError (..)
+  ) where
 
 import Control.Concurrent.Class.MonadSTM
 import Control.Monad.Class.MonadThrow
@@ -23,19 +26,10 @@ instance Exception LocalMsgNotificationProtocolError where
   displayException ProtocolErrorUnexpectedNonBlockingRequest =
     "The client issued a non-blocking request when a blocking request was expected."
 
-
 -- | Local Message Notification server application
 --
--- enforced protocol invariants:
---
--- * non-blocking requests are only accepted when the server has no more messages,
---   client is aware of this from previous replies
--- * dually, blocking requests are only accepted when the server has more
---   messages.
--- * the first request must be blocking
---
 localMsgNotificationServer
-  :: forall m msg msgid idx a. (MonadSTM m, MonadThrow m)
+  :: forall m msg msgid idx a. (MonadSTM m {-, MonadThrow m -})
   => Tracer m (TraceMessageNotificationServer msg)
   -> m a
   -> Word16
@@ -51,7 +45,7 @@ localMsgNotificationServer tracer mdone maxMsgs0
     maxMsgs = fromIntegral maxMsgs0
 
     serverIdle :: idx -> HasMore -> ServerIdle m msg a
-    serverIdle !lastIdx hasMore = ServerIdle { msgRequestHandler, msgDoneHandler }
+    serverIdle !lastIdx _hasMore = ServerIdle { msgRequestHandler, msgDoneHandler }
       where
         msgRequestHandler :: forall blocking.
                              SingBlockingStyle blocking
@@ -67,8 +61,8 @@ localMsgNotificationServer tracer mdone maxMsgs0
                 in (lastIdx', hasMore', msgs)
           case blocking of
             SingBlocking
-              | HasMore <- hasMore ->
-                  throwIO ProtocolErrorUnexpectedBlockingRequest
+              -- | HasMore <- hasMore ->
+              --     throwIO ProtocolErrorUnexpectedBlockingRequest
               | otherwise -> do
                   (lastIdx', hasMore', msgs) <- atomically do
                     snapshot <- mempoolGetSnapshot
@@ -81,8 +75,8 @@ localMsgNotificationServer tracer mdone maxMsgs0
                                        hasMore'
                                        (serverIdle lastIdx' hasMore')
             SingNonBlocking
-              | DoesNotHaveMore <- hasMore ->
-                  throwIO ProtocolErrorUnexpectedNonBlockingRequest
+              -- | DoesNotHaveMore <- hasMore ->
+              --     throwIO ProtocolErrorUnexpectedNonBlockingRequest
               | otherwise -> do
                   snapshot <- atomically mempoolGetSnapshot
                   let (lastIdx', hasMore', msgs) = process snapshot