Verbosity switch.

1 files changed, 12 insertions, 10 deletions

diff --git a/Presence/XMPPServer.hs b/Presence/XMPPServer.hs
index 41d60a07..e78e4dd9 100644
--- a/Presence/XMPPServer.hs
+++ b/Presence/XMPPServer.hs
@@ -192,6 +192,7 @@ data XMPPServerParameters =
     , xmppPeerSubscriptionRequest :: IO () -> ConnectionKey -> Stanza -> TChan Stanza -> IO () 
     , xmppClientInformSubscription :: IO () -> ConnectionKey -> Stanza -> IO ()
     , xmppPeerInformSubscription :: IO () -> ConnectionKey -> Stanza -> IO ()
+    , xmppVerbosity :: IO Int
     }
 
 
@@ -1253,15 +1254,15 @@ forkConnection sv xmpp k laddr pingflag src snk stanzas = do
     msgids <- atomically $ newTVar []
     forkIO $ do
         -- mapM_ (atomically . Slotted.push slots Nothing) greetPeer
+        verbosity <- xmppVerbosity xmpp
         fix $ \loop -> do
             what <- atomically $ foldr1 orElse
                 [readTChan output >>= \stanza -> return $ do
-#ifndef PINGNOISE
-                    let notping f = case stanzaType stanza of Pong -> return ()
-                                                              _ -> f
-#else
-                    let notping f = f
-#endif
+                    let notping f
+                            | (verbosity==1) = case stanzaType stanza of Pong -> return ()
+                                                                         _ -> f
+                            | (verbosity>=2) = f
+                            | otherwise      = return ()
                     -- isempty <- atomically $ isEmptyTChan (stanzaChan stanza)
                     -- kwlog $ "queuing: "++show (isempty, stanzaId stanza)
                     notping $ do
@@ -1739,11 +1740,12 @@ monitor sv params xmpp = do
                          deliver replyto
                 _ -> return ()
         -- We need to clone in the case the stanza is passed on as for Message.
-#ifndef PINGNOISE
-        let notping f = case stanzaType stanza of Pong -> return ()
-                                                  _ -> f
+        verbosity <- xmppVerbosity xmpp
+        let notping f | (verbosity==1) = case stanzaType stanza of Pong -> return ()
+                                                                   _    -> f
+                      | (verbosity>=2) = f
+                      | otherwise      = return ()
         notping $ do
-#endif
         let typ = Strict8.pack $ c ++ "->"++(concat . take 1 . words $ show (stanzaType stanza))++" "
             c = case stanzaOrigin stanza of
                     LocalPeer -> "*"