summaryrefslogtreecommitdiff
path: root/Mainline.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Mainline.hs')
-rw-r--r--Mainline.hs9
1 files changed, 4 insertions, 5 deletions
diff --git a/Mainline.hs b/Mainline.hs
index 291a196f..860372dc 100644
--- a/Mainline.hs
+++ b/Mainline.hs
@@ -419,11 +419,10 @@ showPacket f addr flow bs = L8.unpack $ L8.unlines es
419 419
420-- Add detailed printouts for every packet. 420-- Add detailed printouts for every packet.
421addVerbosity tr = 421addVerbosity tr =
422 tr { awaitMessage = do 422 tr { awaitMessage = \kont -> awaitMessage tr $ \m -> do
423 m <- awaitMessage tr
424 forM_ m $ mapM_ $ \(msg,addr) -> do 423 forM_ m $ mapM_ $ \(msg,addr) -> do
425 hPutStrLn stderr (showPacket id addr " --> " msg) 424 hPutStrLn stderr (showPacket id addr " --> " msg)
426 return m 425 kont m
427 , sendMessage = \addr msg -> do 426 , sendMessage = \addr msg -> do
428 hPutStrLn stderr (showPacket id addr " <-- " msg) 427 hPutStrLn stderr (showPacket id addr " <-- " msg)
429 sendMessage tr addr msg 428 sendMessage tr addr msg
@@ -566,7 +565,7 @@ newClient addr = do
566 -- recursive since 'updateRouting' does not invoke 'awaitMessage' which 565 -- recursive since 'updateRouting' does not invoke 'awaitMessage' which
567 -- which was modified by 'onInbound'. However, I'm going to avoid the 566 -- which was modified by 'onInbound'. However, I'm going to avoid the
568 -- mutual reference just to be safe. 567 -- mutual reference just to be safe.
569 outgoingClient = client { clientNet = net { awaitMessage = return Nothing } } 568 outgoingClient = client { clientNet = net { awaitMessage = ($ Nothing) } }
570 569
571 dispatch = DispatchMethods 570 dispatch = DispatchMethods
572 { classifyInbound = classify -- :: x -> MessageClass err meth tid 571 { classifyInbound = classify -- :: x -> MessageClass err meth tid
@@ -587,7 +586,7 @@ newClient addr = do
587 gen cnt = (TransactionId $ S.encode cnt, cnt+1) 586 gen cnt = (TransactionId $ S.encode cnt, cnt+1)
588 587
589 client = Client 588 client = Client
590 { clientNet = net 589 { clientNet = addHandler (handleMessage client) net
591 , clientDispatcher = dispatch 590 , clientDispatcher = dispatch
592 , clientErrorReporter = ignoreErrors -- printErrors stderr 591 , clientErrorReporter = ignoreErrors -- printErrors stderr
593 , clientPending = map_var 592 , clientPending = map_var