quiet debug prints

3 files changed, 26 insertions, 27 deletions

diff --git a/Presence/AdaptServer.hs b/Presence/AdaptServer.hs
index 3b57266c..eca4cb1e 100644
--- a/Presence/AdaptServer.hs
+++ b/Presence/AdaptServer.hs
@@ -15,7 +15,7 @@ adaptStartCon start sock st = do
     return (HCons rsRef st')
 
 adaptDoCon showlex (dropTill,lex,parse) g st bs cont = do
-    putStrLn $ "packet: " ++ show bs
+    -- putStrLn $ "packet: " ++ show bs
     let (HCons rsRef st') = st
     rs <- readIORef rsRef
 
@@ -27,11 +27,11 @@ adaptDoCon showlex (dropTill,lex,parse) g st bs cont = do
           case e of
               Left err -> if null rs'
                             then contR "" ()
-                            else trace ("parse error "++show (err,bs,showlex lexemes,showlex rs')) $ do
+                            else -- trace ("parse error "++show (err,bs,showlex lexemes,showlex rs')) $ do
                                     contR rem ()
               Right e -> do
                 -- writeIORef rsRef rs'
-                g st' e (\() -> do { putStrLn ("LOOP "++showlex rs'); loop (dropTill rem rs') rs' })
+                g st' e (\() -> do { {- putStrLn ("LOOP "++showlex rs'); -} loop (dropTill rem rs') rs' })
         loop rem [] = contR "" ()
     let buf = rs <++> bs
     when (L.length buf < 8192)
diff --git a/Presence/Server.hs b/Presence/Server.hs
index a9bd4112..b611fae8 100644
--- a/Presence/Server.hs
+++ b/Presence/Server.hs
@@ -60,8 +60,8 @@ doServer
      -> IO Socket
 -}
 doServer port g startCon = do
-    -- doServer' AF_INET port g startCon
     doServer' AF_INET6 port g startCon
+    -- doServer' AF_INET port g startCon
 
 doServer' family port g startCon = runServer2 port (runConn2 g)
  where
@@ -88,7 +88,7 @@ doServer' family port g startCon = runServer2 port (runConn2 g)
         setSocketOption sock ReuseAddr 1
         case family of
           AF_INET  -> bindSocket sock (SockAddrInet port iNADDR_ANY)
-          AF_INET6 -> bindSocket sock (SockAddrInet6 port 0 iN6ADDR_ANY 8)
+          AF_INET6 -> bindSocket sock (SockAddrInet6 port 0 iN6ADDR_ANY 0)
         listen sock 2
         forkIO $ do
             mainLoop sock (ConnId 0) go
diff --git a/Presence/XMPPServer.hs b/Presence/XMPPServer.hs
index c9decd6c..58dcf430 100644
--- a/Presence/XMPPServer.hs
+++ b/Presence/XMPPServer.hs
@@ -242,7 +242,7 @@ startCon session_factory sock st  = do
                     --  a resource is bound.
                     r <- xmlifyPresenceForClient presence
                     hPutStrLn h r
-                    L.putStrLn $ "\nOUT:\n" <++> r
+                    L.putStrLn $ "\nOUT client:\n" <++> r
                 Right (Send r) ->
                     hPutStrLn h r
             loop
@@ -361,14 +361,14 @@ doCon st elem cont = do
             hsend r = do
                 atomically $ writeTChan cmdChan (Send r)
                 -- hPutStrLn h r
-                L.putStrLn $ "\nOUT:\n" <++> r
+                L.putStrLn $ "\nOUT client:\n" <++> r
         -- host <- fmap pack $ getHostName -- Assume localhost for client session JID
         host <- do
             jid <- getJID session
             names <- getNamesForPeer (peer jid)
             return (head names)
         
-        putStrLn $ (Prelude.show $ hang (text "\nIN:") 2 $ pp elem) ++ "\n"
+        putStrLn $ (Prelude.show $ hang (text "\nIN client:") 2 $ pp elem) ++ "\n"
 
         case elem of
             OpenTag _ -> 
@@ -479,33 +479,33 @@ listenForXmppClients session_factory port st = do
 startPeer session_factory sock st = do
     let h = hOccursFst st :: Handle 
     name <- fmap bshow $ getPeerName sock
-    L.putStrLn $ "REMOTE-IN: connected " <++> name
-    let quit = L.putStrLn $ "REMOTE-IN: disconnected " <++> name
+    L.putStrLn $ "IN peer: connected " <++> name
+    let quit = L.putStrLn $ "IN peer: disconnected " <++> name
     session <- newSession session_factory sock h
     return ( session .*. ConnectionFinalizer quit .*. st )
 
 doPeer st elem cont = do
     let session = hHead st
-    L.putStrLn $ "REMOTE-IN: received " <++> bshow elem
+    L.putStrLn $ "IN peer: " <++> bshow elem
     case elem of
       Element e@(Elem (N "presence") attrs content) -> do
         let jid = fmap pack (lookup (N "from") attrs >>= unattr)
             typ = fmap pack (lookup (N "type") attrs >>= unattr)
         case (jid,typ) of
           (Just jid,Just "unavailable") -> do
-            L.putStrLn $ "INBOUND PRESENCE! Offline jid=" <++> jid
+            L.putStrLn $ "IN peer: PRESENCE! Offline jid=" <++> jid
             -- parseAddressJID -- convert peer reported user@address to JID data structure
             peer_jid <- parseAddressJID jid
             announcePresence session (Presence peer_jid Offline)
           (Just jid,Just typ) -> 
             -- possible probe, ignored for now
-            L.putStrLn $ "INBOUND PRESENCE! "<++>typ<++>" jid="<++>jid
+            L.putStrLn $ "IN peer: PRESENCE! "<++>typ<++>" jid="<++>jid
           (Just jid,Nothing) -> do
             let string (CString _ s _) = [s]
                 stat = listToMaybe . Prelude.concatMap string . tagcontent "show" $ content
             -- Available or Away.
             names <- parseAddressJID jid >>= getNamesForPeer  . peer
-            L.putStrLn $ "INBOUND PRESENCE! "<++>bshow (stat,names)<++>" avail/away jid=" <++> jid
+            L.putStrLn $ "IN peer: PRESENCE! "<++>bshow (stat,names)<++>" avail/away jid=" <++> jid
             -- todo: announcePresence
       _ -> return () -- putStrLn $ "inbound unhandled: "++show v
     cont ()
@@ -553,16 +553,16 @@ sendMessage cons msg peer = do
     let newEntry = do
           chan <- atomically newTChan
           t <- forkIO $ connect_to_server chan peer
-          L.putStrLn $ "remote-map new: " <++> showPeer peer
+          -- L.putStrLn $ "remote-map new: " <++> showPeer peer
           return (True,(chan,t))
     (is_new,entry) <- maybe newEntry
           ( \(chan,t) -> do 
                         st <- threadStatus t
                         let running = do
-                                L.putStrLn $ "remote-map, thread running: " <++> showPeer peer
+                                -- L.putStrLn $ "remote-map, thread running: " <++> showPeer peer
                                 return (False,(chan,t))
                             died = do
-                                L.putStrLn $ "remote-map, thread died("<++>bshow st<++>"): " <++> showPeer peer
+                                -- L.putStrLn $ "remote-map, thread died("<++>bshow st<++>"): " <++> showPeer peer
                                 newEntry 
                         case st of 
                           ThreadRunning   -> running
@@ -571,7 +571,7 @@ sendMessage cons msg peer = do
                           ThreadFinished  -> died
                         )
           found
-    L.putStrLn $ "sendMessage ->"<++>showPeer peer<++>": "<++>bshow msg
+    -- L.putStrLn $ "sendMessage ->"<++>showPeer peer<++>": "<++>bshow msg
     atomically $ writeTChan (fst entry) msg
     when is_new . atomically $
         readTVar cons >>= writeTVar cons . Map.insert peer entry
@@ -609,23 +609,23 @@ connect_to_server chan peer = (>> return ()) . runMaybeT $ do
         h <- socketToHandle sock ReadWriteMode
         hSetBuffering h NoBuffering
         hPutStrLn h "<stream>"
-        L.putStrLn $ "REMOTE-OUT: <stream>"
+        L.putStrLn $ "OUT peer: <stream>"
         cache <- fmap Map.assocs . readIORef $ cached
         writeIORef cached Map.empty -- hint garbage collector: we're done with this
         forM_ cache $ \(jid,st) -> do
             r <- xmlifyPresenceForPeer sock (Presence jid st)
             hPutStrLn h r
-            L.putStrLn $ "REMOTE-OUT (cache):\n" <++> r <++> "\n"
+            L.putStrLn $ "OUT peer: (cache)\n" <++> r <++> "\n"
         fix $ \loop -> do
             event <- atomically $ readTChan chan
             case event of
               OutBoundPresence p -> do
                 r <- xmlifyPresenceForPeer sock p
                 hPutStrLn h r
-                L.putStrLn $ "REMOTE-OUT:\n" <++> r <++> "\n"
+                L.putStrLn $ "OUT peer:\n" <++> r <++> "\n"
             loop
         hPutStrLn h "</stream>"
-        L.putStrLn $ "REMOTE-OUT: </stream>"
+        L.putStrLn $ "OUT peer: </stream>"
 
 
 splitJID :: ByteString -> (Maybe ByteString,ByteString,Maybe ByteString)
@@ -653,7 +653,7 @@ parseAddressJID jid = do
         hints = Just $ defaultHints { addrFlags = [ {- AI_NUMERICHOST, -} AI_CANONNAME ] }
         peer_string' = unpack . strip_brackets $ peer_string
     peer <- do
-        putStrLn $ "getAddrInfo 2 " ++ Prelude.show ( Just (unpack peer_string))
+        -- putStrLn $ "getAddrInfo 2 " ++ Prelude.show ( Just (unpack peer_string))
         info <- getAddrInfo hints (Just peer_string') Nothing -- (Just "xmpp-server")
         let info0 = head info
         return . RemotePeer . addrAddress $ info0
@@ -667,7 +667,7 @@ parseHostNameJID jid = do
         if peer_string=="localhost"
           then return LocalHost
           else do
-            putStrLn $ "getAddrInfo 3 " ++ Prelude.show ( Just (unpack peer_string))
+            -- putStrLn $ "getAddrInfo 3 " ++ Prelude.show ( Just (unpack peer_string))
             info <- getAddrInfo hints (Just (unpack peer_string)) Nothing -- (Just "xmpp-server")
             let info0 = head info
                 cname = addrCanonName info0
@@ -737,14 +737,13 @@ seekRemotePeers config chan = do
         event <- atomically $ readTChan chan
         case event of
             p@(Presence jid stat) -> do
-              L.putStrLn $ "seekRemotePeers: " <++> L.show jid <++> " " <++> bshow stat
+              -- L.putStrLn $ "seekRemotePeers: " <++> L.show jid <++> " " <++> bshow stat
               runMaybeT $ do
                   u <- MaybeT . return $ name jid
                   subscribers <- liftIO $ do
                     subs <- getSubscribers config u
                     mapM parseHostNameJID subs
-                  liftIO . L.putStrLn $ "subscribers: " <++> bshow subscribers
-                  -- parseJID -- get subscriber list reported user@hostname to JID data structure
+                  -- liftIO . L.putStrLn $ "subscribers: " <++> bshow subscribers
                   let peers = Set.map peer (Set.fromList subscribers)
                   forM_ (Set.toList peers) $ \peer -> do
                     when (is_remote peer) $