5 files changed, 18 insertions, 24 deletions

diff --git a/Control/Concurrent/STM/StatusCache.hs b/Control/Concurrent/STM/StatusCache.hs
index 3226978b..f6295aa0 100644
--- a/Control/Concurrent/STM/StatusCache.hs
+++ b/Control/Concurrent/STM/StatusCache.hs
@@ -58,6 +58,7 @@
 --
 -- As shown above, it is intended that this module be imported qualified.
 --
+{-# LANGUAGE DoAndIfThenElse #-}
 module Control.Concurrent.STM.StatusCache
     ( StatusCache
     , new
diff --git a/Presence/Server.hs b/Presence/Server.hs
index 6c2d1b5a..abf9f5e3 100644
--- a/Presence/Server.hs
+++ b/Presence/Server.hs
@@ -19,6 +19,7 @@
 --
 --  * interface tweaks
 --
+{-# LANGUAGE DoAndIfThenElse #-}
 module Server where
 
 import Data.ByteString (ByteString,hGetNonBlocking)
@@ -62,7 +63,7 @@ import Network.BSD
 import Debug.Trace
 import Data.Time.Clock (UTCTime,getCurrentTime,diffUTCTime)
 import Data.Time.Format (formatTime)
-import System.Locale (defaultTimeLocale)
+-- import System.Locale (defaultTimeLocale)
 
 todo = error "unimplemented"
 
@@ -519,27 +520,19 @@ newConnection server params conkey u h inout = do
 
     sendPing PingTimeOut = do
         {-
-        let me = connPingTimer newCon
-        utc <- getCurrentTime
-        let utc' = formatTime defaultTimeLocale "%s" utc
-        warn $ "TIMEOUT " <> bshow utc' <> " " <> bshow (pingIdle me, pingTimeOut me)
-        -}
         utc <- getCurrentTime
         let utc' = formatTime defaultTimeLocale "%s" utc
         warn $ "ping:TIMEOUT " <> bshow utc'
+        -}
         atomically (connClose newCon)
         eof
 
     sendPing PingIdle = do
         {-
-        let me = connPingTimer newCon
-        utc <- getCurrentTime
-        let utc' = formatTime defaultTimeLocale "%s" utc
-        warn $ "IDLE" <> bshow utc' <> " " <> bshow (pingIdle me, pingTimeOut me)
-        -}
         utc <- getCurrentTime
         let utc' = formatTime defaultTimeLocale "%s" utc
         -- warn $ "ping:IDLE " <> bshow utc'
+        -}
         atomically $ announce ((conkey,u),RequiresPing)
         handleEOF conkey u mvar newCon
 
diff --git a/Presence/XMPPServer.hs b/Presence/XMPPServer.hs
index 5a5cd9cc..6f117204 100644
--- a/Presence/XMPPServer.hs
+++ b/Presence/XMPPServer.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE FlexibleInstances #-} -- instance for TChan Event
+{-# LANGUAGE DoAndIfThenElse #-}
 module XMPPServer
     ( xmppServer
     , ConnectionKey(..)
diff --git a/presence.cabal b/presence.cabal
index 4acae871..30081d17 100644
--- a/presence.cabal
+++ b/presence.cabal
@@ -14,22 +14,16 @@ author: Joe Crayne
 data-dir: ""
  
 executable presence
-    build-depends: HList -any, async -any,
-                   base -any, binary -any, blaze-builder -any,
-                   blaze-builder-conduit -any, bytestring -any, bytestring-show -any,
-                   conduit -any, containers -any, cpu -any, data-default -any,
-                   deepseq -any, directory -any, filepath -any, hinotify -any,
-                   mtl -any, network -any, random -any, stm -any,
-                   template-haskell -any, text (>=0.11.2.0), transformers -any, unix -any,
-                   xml-conduit -any, xml-types -any, stm-delay -any
-    main-is: main.hs
+    build-depends: base -any, stm -any, text (>=0.11.2.0), xml-types -any, containers -any,
+                   network -any, time -any, transformers -any, resourcet -any, bytestring -any,
+                   mtl -any, mmorph -any, conduit -any, xml-conduit -any, void -any, random -any,
+                   data-default -any, blaze-builder-conduit -any, blaze-builder -any, unix -any,
+                   binary -any, directory -any, cpu -any, template-haskell -any, deepseq -any,
+                   filepath -any
+    main-is: xmppServer.hs
     buildable: True
     cpp-options: -DRENDERFLUSH
     c-sources: Presence/monitortty.c
     hs-source-dirs: . Presence
-    other-modules: Data.BitSyntax ByteStringOperators
-                   ConfigFiles FGConsole LocalPeerCred UTmp
-                   GetHostByAddr ServerC SocketLike XMPP XMPPTypes NestingXML
-                   Text.XML.Stream.Render Text.XML.Stream.Token
     ghc-prof-options: -DNOUTMP
  
diff --git a/xmppServer.hs b/xmppServer.hs
index 5771510a..fb056445 100644
--- a/xmppServer.hs
+++ b/xmppServer.hs
@@ -592,6 +592,8 @@ answerProbe state mto k chan = do
 
     -- only subscribed peers should get probe replies
     addrs <- subscribedPeers u
+    -- TODO: notify remote peer that they are unsubscribed?
+    --   reply <- makeInformSubscription "jabber:server" to from False
     when (k `elem` map PeerKey addrs) $ do
 
     replies <- runTraversableT $ do
@@ -891,6 +893,9 @@ peerInformSubscription state fail k stanza = do
             to <- stanzaTo stanza
             let (mu,to_h,to_r) = splitJID to
             mu
+    -- TODO muser = Nothing when wanted=False
+    -- should probably mean unsubscribed for all users.
+    -- This would allow us to answer anonymous probes with 'unsubscribed'.
     flip (maybe fail) muser $ \user -> do
     addrs <- resolvePeer from_h
     was_solicited <- removeFromRosterFile ConfigFiles.modifySolicited user from'' addrs