XMPP client now receives roster on request.

1 files changed, 13 insertions, 5 deletions

diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index 025f957f..0996ffab 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -988,13 +988,13 @@ sensibleDefaults = Options
     , ip6bt     = True
     , ip6tox    = True
     , dhtkey    = Nothing
-    , verbosity = 0
+    , verbosity = 1
     }
 
 -- bt=<port>,tox=<port>
 -- -4
 parseArgs :: [String] -> Options -> Options
-parseArgs []          opts         = opts
+parseArgs []                  opts = opts
 parseArgs ("--dhtkey":k:args) opts = parseArgs args opts
     { dhtkey = decodeSecret $ B.pack k }
 parseArgs ("-4":args) opts         = parseArgs args opts
@@ -1329,7 +1329,7 @@ main = do
         srv <- streamServer (withSession session) (SockAddrUnix "dht.sock")
         return ( do atomically $ readTVar signalQuit >>= check
                     quitListening srv
-               , readTVar signalQuit
+               , readTVar signalQuit >>= check
                )
 
 
@@ -1359,8 +1359,14 @@ main = do
     -- XMPP stanza handling
     runResourceT $ do
         sv    <- xmppServer (presenceHooks state (verbosity opts))
+        -- We now have a server object but it's not ready to use until
+        -- we put it into the 'server' field of our /state/ record.
 
-        fork $ liftIO $ do
+        liftIO $ do
+        atomically $ putTMVar (server state) sv -- Okay, now it's ready. :)
+                                                -- FIXME: This is error prone.
+
+        forkIO $ do
             myThreadId >>= flip labelThread "XMPP.stanzas"
             let console = cwPresenceChan $ consoleWriter state
             fix $ \loop -> do
@@ -1371,9 +1377,11 @@ main = do
                          (checkQuit >> return (return ()))
             what
 
+        hPutStrLn stderr "Started XMPP server."
+
         -- Wait for DHT and XMPP threads to finish.
         -- Use ResourceT to clean-up XMPP server.
-        liftIO waitForSignal
+        waitForSignal
 
     stopAnnouncer announcer
     quitBt