1 files changed, 24 insertions, 4 deletions

diff --git a/xmppServer.hs b/xmppServer.hs
index 30d6b2c4..8fdb4f78 100644
--- a/xmppServer.hs
+++ b/xmppServer.hs
@@ -206,16 +206,19 @@ tellClientHisName state k = forClient state k fallback go
 
 toMapUnit xs = Map.fromList $ map (,()) xs
 
+resolveAllPeers :: [Text] -> IO (Map SockAddr ())
 resolveAllPeers hosts = fmap (toMapUnit . concat) $ Prelude.mapM (fmap (take 1) . resolvePeer) hosts
 
+configText what u =
+        fmap (map lazyByteStringToText)
+            $ what (textToLazyByteString u)
+
 rosterGetStuff
   :: (L.ByteString -> IO [L.ByteString])
      -> PresenceState -> ConnectionKey -> IO [Text]
 rosterGetStuff what state k = forClient state k (return [])
     $ \client -> do
-    jids <- 
-        fmap (map lazyByteStringToText)
-            $ what (textToLazyByteString $ clientUser client)
+    jids <- configText what (clientUser client)
     let hosts = map ((\(_,h,_)->h) . splitJID) jids
     addrs <- resolveAllPeers hosts 
     peers <- atomically $ readTVar (associatedPeers state)
@@ -417,7 +420,24 @@ informClientPresence state k stanza = do
         mb <- fmap (Map.lookup k) $ readTVar (clients state)
         flip (maybe $ return ()) mb $ \cstate -> do
         writeTVar (clientStatus cstate) $ Just dup
-    -- TODO: inform subscribers
+    forClient state k (return ()) $ \client -> do
+    jids <- configText ConfigFiles.getSubscribers (clientUser client)
+    let hosts = map ((\(_,h,_)->h) . splitJID) jids
+    addrs <- fmap Map.keys $ resolveAllPeers hosts 
+    ktc <- atomically $ readTVar (keyToChan state)
+    let connected = mapMaybe (flip Map.lookup ktc . PeerKey) addrs
+    forM_ connected $ \con -> do
+    let from' = unsplitJID ( Just $ clientUser client
+                           , addrToText $ auxAddr con
+                           , Just $ clientResource client)
+    mto <- runTraversableT $ do
+            to <- liftT $ stanzaTo stanza
+            (to',_) <- liftMT $ rewriteJIDForPeer to
+            return to'
+    dup <- cloneStanza stanza
+    sendModifiedStanzaToPeer dup { stanzaFrom = Just from'
+                                 , stanzaTo = mto }
+                             (connChan con)
 
 informPeerPresence state k stanza = do
     -- Presence must indicate full JID with resource...