{-# OPTIONS_HADDOCK hide #-}
module Network.Xmpp.Concurrent.Presence where

import Control.Applicative ((<$>))
import Control.Concurrent.STM
import Control.Lens.Prism (_Just)
import Lens.Family2 hiding (to)
import Lens.Family2.Stock hiding (_Just)
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
-> IO (Either (Annotated PresenceError) (Annotated Presence))
pullPresenceA Session
session = do
    (Stanza
stanza, [Annotation]
as) <- forall a. STM a -> IO a
atomically forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TChan a -> STM a
readTChan forall a b. (a -> b) -> a -> b
$ Session -> TChan (Stanza, [Annotation])
stanzaCh Session
session
    case Stanza
stanza of
        PresenceS Presence
p -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (Presence
p, [Annotation]
as)
        PresenceErrorS PresenceError
e -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (PresenceError
e, [Annotation]
as)
        Stanza
_ -> Session
-> IO (Either (Annotated PresenceError) (Annotated Presence))
pullPresenceA Session
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 :: Session -> IO (Either PresenceError Presence)
pullPresence Session
s = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session
-> IO (Either (Annotated PresenceError) (Annotated Presence))
pullPresenceA Session
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 :: (Annotated Presence -> Bool) -> Session -> IO (Annotated Presence)
waitForPresenceA Annotated Presence -> Bool
f Session
session = do
    Either (Annotated PresenceError) (Annotated Presence)
s <- Session
-> IO (Either (Annotated PresenceError) (Annotated Presence))
pullPresenceA Session
session
    case Either (Annotated PresenceError) (Annotated Presence)
s of
        Left Annotated PresenceError
_ -> (Annotated Presence -> Bool) -> Session -> IO (Annotated Presence)
waitForPresenceA Annotated Presence -> Bool
f Session
session
        Right Annotated Presence
m | Annotated Presence -> Bool
f Annotated Presence
m -> forall (m :: * -> *) a. Monad m => a -> m a
return Annotated Presence
m
                | Bool
otherwise -> (Annotated Presence -> Bool) -> Session -> IO (Annotated Presence)
waitForPresenceA Annotated Presence -> Bool
f Session
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 :: (Presence -> Bool) -> Session -> IO Presence
waitForPresence Presence -> Bool
f Session
s = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Annotated Presence -> Bool) -> Session -> IO (Annotated Presence)
waitForPresenceA (Presence -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) Session
s

-- | Send a presence stanza.
sendPresence :: Presence -> Session -> IO (Either XmppFailure ())
sendPresence :: Presence -> Session -> IO (Either XmppFailure ())
sendPresence Presence
p Session
session = Stanza -> Session -> IO (Either XmppFailure ())
sendStanza (Presence -> Stanza
PresenceS Presence
checkedP) Session
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 :: Presence
checkedP = case Presence -> PresenceType
presenceType Presence
p of
        PresenceType
Subscribe -> Presence
p forall s t. s -> (s -> t) -> t
& forall s. IsStanza s => Lens s (Maybe Jid)
to forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall s t a b. Setter s t a b -> (a -> b) -> s -> t
%~ Jid -> Jid
toBare
        PresenceType
_ -> Presence
p