You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
53 lines
2.3 KiB
53 lines
2.3 KiB
{-# OPTIONS_HADDOCK hide #-} |
|
module Network.Xmpp.Concurrent.Presence where |
|
|
|
import Control.Applicative ((<$>)) |
|
import Control.Concurrent.STM |
|
import Lens.Family2 hiding (to) |
|
import Lens.Family2.Stock |
|
import Network.Xmpp.Concurrent.Basic |
|
import Network.Xmpp.Concurrent.Types |
|
import Network.Xmpp.Lens |
|
import Network.Xmpp.Types |
|
|
|
-- | Read a presence stanza from the inbound stanza channel, discards any other |
|
-- stanzas. Returns the presence stanza with annotations. |
|
pullPresenceA :: Session -> IO (Either (Annotated PresenceError) |
|
(Annotated Presence)) |
|
pullPresenceA session = do |
|
(stanza, as) <- atomically . readTChan $ stanzaCh session |
|
case stanza of |
|
PresenceS p -> return $ Right (p, as) |
|
PresenceErrorS e -> return $ Left (e, as) |
|
_ -> pullPresenceA session |
|
|
|
-- | Read a presence stanza from the inbound stanza channel, discards any other |
|
-- stanzas. Returns the presence stanza. |
|
pullPresence :: Session -> IO (Either PresenceError Presence) |
|
pullPresence s = either (Left . fst) (Right . fst) <$> pullPresenceA s |
|
|
|
-- | Draw and discard stanzas from the inbound channel until a presence stanza matching the given predicate is found. Return the presence stanza with annotations. |
|
waitForPresenceA :: (Annotated Presence -> Bool) |
|
-> Session |
|
-> IO (Annotated Presence) |
|
waitForPresenceA f session = do |
|
s <- pullPresenceA session |
|
case s of |
|
Left _ -> waitForPresenceA f session |
|
Right m | f m -> return m |
|
| otherwise -> waitForPresenceA f session |
|
|
|
-- | Draw and discard stanzas from the inbound channel until a presence stanza matching the given predicate is found. Return the presence stanza with annotations. |
|
waitForPresence :: (Presence -> Bool) -> Session -> IO Presence |
|
waitForPresence f s = fst <$> waitForPresenceA (f . fst) s |
|
|
|
-- | Send a presence stanza. |
|
sendPresence :: Presence -> Session -> IO (Either XmppFailure ()) |
|
sendPresence p session = sendStanza (PresenceS checkedP) session |
|
where |
|
-- | RFC 6121 §3.1.1: When a user sends a presence subscription request to a |
|
-- potential instant messaging and presence contact, the value of the 'to' |
|
-- attribute MUST be a bare JID rather than a full JID |
|
checkedP = case presenceType p of |
|
Subscribe -> p & to . _Just %~ toBare |
|
_ -> p
|
|
|