Transport modifier utility: onInbound.

1 files changed, 10 insertions, 0 deletions

diff --git a/src/Network/QueryResponse.hs b/src/Network/QueryResponse.hs
index 9262132f..5083a87c 100644
--- a/src/Network/QueryResponse.hs
+++ b/src/Network/QueryResponse.hs
@@ -191,6 +191,16 @@ layerTransport parse encode tr =
                 sendMessage tr addr msg
        }
 
+-- | Modify a 'Transport' to invoke an action upon every received packet.
+onInbound :: (addr -> x -> IO ()) -> Transport err addr x -> Transport err addr x
+onInbound f tr = tr
+    { awaitMessage = do
+        m <- awaitMessage tr
+        case m of
+            Just (Right (x, addr)) -> f addr x
+            Nothing                -> return ()
+        return m
+    }
 
 -- | To dipatch responses to our outbound queries, we require three primitives.
 -- See the 'transactionMethods' function to create these primitives out of a