summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Presence/XMPP.hs27
1 files changed, 20 insertions, 7 deletions
diff --git a/Presence/XMPP.hs b/Presence/XMPP.hs
index 7e513212..d0333f4a 100644
--- a/Presence/XMPP.hs
+++ b/Presence/XMPP.hs
@@ -74,15 +74,28 @@ xmlifyPresenceForClient (Presence jid stat) = do
74 shw Offline = "away" -- Is this right? 74 shw Offline = "away" -- Is this right?
75 75
76 76
77-- type Consumer i m r = forall o. ConduitM i o m r
78mawait :: Monad m => MaybeT (ConduitM i o m) i
79mawait = MaybeT await
80
81elementAttrs expected (EventBeginElement name attrs)
82 | nameLocalName name==expected
83 = return attrs
84elementAttrs _ _ = mzero
85
77 86
78fromClient :: MonadIO m => TChan Commands -> Sink XML.Event m () 87fromClient :: MonadIO m => TChan Commands -> Sink XML.Event m ()
79fromClient cmdChan = fix $ \loop -> do 88fromClient cmdChan = (>>return ()) . runMaybeT $ do
80 mb <- await 89 mawait >>= guard . (==EventBeginDocument)
81 maybe (return ()) 90 liftIO . L.putStrLn $ "client-in: begin-doc "
82 (\packet -> do 91 xml <- mawait
83 liftIO (L.putStrLn $ "client-in: " <++> bshow packet) 92 stream_attrs <- elementAttrs "stream" xml
84 loop) 93 liftIO . L.putStrLn $ "client-in: stream " <++> bshow stream_attrs
85 mb 94 fix $ \loop -> do
95 xml <- mawait
96 liftIO (L.putStrLn $ "client-in: " <++> bshow xml)
97 loop
98
86 99
87toClient :: MonadIO m => TChan Presence -> TChan Commands -> Source m XML.Event 100toClient :: MonadIO m => TChan Presence -> TChan Commands -> Source m XML.Event
88toClient pchan cmdChan = fix $ \loop -> do 101toClient pchan cmdChan = fix $ \loop -> do