communicate roster files

1 files changed, 19 insertions, 7 deletions

diff --git a/xmppServer.hs b/xmppServer.hs
index 80adaf21..e787f973 100644
--- a/xmppServer.hs
+++ b/xmppServer.hs
@@ -24,6 +24,7 @@ import Data.Map (Map)
 import Control.Exception ({-evaluate,-}handle,SomeException(..),bracketOnError,ErrorCall(..))
 import System.Posix.User (getUserEntryForID,userName)
 import qualified Data.ByteString.Lazy.Char8 as L
+import qualified ConfigFiles
 
 import UTmp (ProcessID,users)
 import LocalPeerCred
@@ -53,6 +54,7 @@ getConsolePids state = do --  return [("tty7", 23)] -- todo
     return $ map (\(_,tty,pid)->(lazyByteStringToText tty,pid)) us
 
 lazyByteStringToText = (foldr1 (<>) . map Text.decodeUtf8 . L.toChunks)
+textToLazyByteString s = L.fromChunks [Text.encodeUtf8 s]
 
 identifyTTY' ttypids uid inode = ttypid
  where ttypids' = map (\(tty,pid)->(L.fromChunks [Text.encodeUtf8 tty], pid)) ttypids
@@ -97,12 +99,22 @@ forClient state k fallback f = do
     mclient <- atomically $ do
         cs <- readTVar (clients state)
         return $ Map.lookup k cs
-    maybe (fallback k) (flip f k) mclient
+    maybe fallback f mclient
 
 tellClientHisName state k = forClient state k fallback go
  where
-    fallback k = localJID "nobody" "fallback"
-    go client k = localJID (clientUser client) (clientResource client)
+    fallback  = localJID "nobody" "fallback"
+    go client = localJID (clientUser client) (clientResource client)
+
+rosterGetStuff what state k = forClient state k (return [])
+    $ \client -> do
+    fmap (map lazyByteStringToText)
+        $ what (textToLazyByteString $ clientUser client)
+
+rosterGetBuddies = rosterGetStuff ConfigFiles.getBuddies
+rosterGetSolicited = rosterGetStuff ConfigFiles.getSolicited
+rosterGetOthers = rosterGetStuff ConfigFiles.getOthers
+rosterGetSubscribers = rosterGetStuff ConfigFiles.getSubscribers
 
 
 main = runResourceT $ do
@@ -124,10 +136,10 @@ main = runResourceT $ do
         , xmppTellClientNameOfPeer = peerKeyToResolvedName
         , xmppNewConnection = \k outchan -> return ()
         , xmppEOF = \k -> return ()
-        , xmppRosterBuddies = \k -> return []
-        , xmppRosterSubscribers = \k -> return []
-        , xmppRosterSolicited = \k -> return []
-        , xmppRosterOthers = \k -> return []
+        , xmppRosterBuddies = rosterGetBuddies state
+        , xmppRosterSubscribers = rosterGetSubscribers state
+        , xmppRosterSolicited = rosterGetSolicited state
+        , xmppRosterOthers = rosterGetOthers state
         , xmppSubscribeToRoster = \k -> return ()
         -- , xmppLookupClientJID = \k -> return $ "nobody@" <> hostname <> "/tty666"
         , xmppDeliverMessage = \fail msg -> do