{-# 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) <- STM (Stanza, [Annotation]) -> IO (Stanza, [Annotation])
forall a. STM a -> IO a
atomically (STM (Stanza, [Annotation]) -> IO (Stanza, [Annotation]))
-> (TChan (Stanza, [Annotation]) -> STM (Stanza, [Annotation]))
-> TChan (Stanza, [Annotation])
-> IO (Stanza, [Annotation])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TChan (Stanza, [Annotation]) -> STM (Stanza, [Annotation])
forall a. TChan a -> STM a
readTChan (TChan (Stanza, [Annotation]) -> IO (Stanza, [Annotation]))
-> TChan (Stanza, [Annotation]) -> IO (Stanza, [Annotation])
forall a b. (a -> b) -> a -> b
$ Session -> TChan (Stanza, [Annotation])
stanzaCh Session
session
    case Stanza
stanza of
        PresenceS Presence
p -> Either (Annotated PresenceError) (Annotated Presence)
-> IO (Either (Annotated PresenceError) (Annotated Presence))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Annotated PresenceError) (Annotated Presence)
 -> IO (Either (Annotated PresenceError) (Annotated Presence)))
-> Either (Annotated PresenceError) (Annotated Presence)
-> IO (Either (Annotated PresenceError) (Annotated Presence))
forall a b. (a -> b) -> a -> b
$ Annotated Presence
-> Either (Annotated PresenceError) (Annotated Presence)
forall a b. b -> Either a b
Right (Presence
p, [Annotation]
as)
        PresenceErrorS PresenceError
e -> Either (Annotated PresenceError) (Annotated Presence)
-> IO (Either (Annotated PresenceError) (Annotated Presence))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Annotated PresenceError) (Annotated Presence)
 -> IO (Either (Annotated PresenceError) (Annotated Presence)))
-> Either (Annotated PresenceError) (Annotated Presence)
-> IO (Either (Annotated PresenceError) (Annotated Presence))
forall a b. (a -> b) -> a -> b
$ Annotated PresenceError
-> Either (Annotated PresenceError) (Annotated Presence)
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 = (Annotated PresenceError -> Either PresenceError Presence)
-> (Annotated Presence -> Either PresenceError Presence)
-> Either (Annotated PresenceError) (Annotated Presence)
-> Either PresenceError Presence
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (PresenceError -> Either PresenceError Presence
forall a b. a -> Either a b
Left (PresenceError -> Either PresenceError Presence)
-> (Annotated PresenceError -> PresenceError)
-> Annotated PresenceError
-> Either PresenceError Presence
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Annotated PresenceError -> PresenceError
forall a b. (a, b) -> a
fst) (Presence -> Either PresenceError Presence
forall a b. b -> Either a b
Right (Presence -> Either PresenceError Presence)
-> (Annotated Presence -> Presence)
-> Annotated Presence
-> Either PresenceError Presence
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Annotated Presence -> Presence
forall a b. (a, b) -> a
fst) (Either (Annotated PresenceError) (Annotated Presence)
 -> Either PresenceError Presence)
-> IO (Either (Annotated PresenceError) (Annotated Presence))
-> IO (Either PresenceError Presence)
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 -> Annotated Presence -> IO (Annotated Presence)
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 = Annotated Presence -> Presence
forall a b. (a, b) -> a
fst (Annotated Presence -> Presence)
-> IO (Annotated Presence) -> IO Presence
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Annotated Presence -> Bool) -> Session -> IO (Annotated Presence)
waitForPresenceA (Presence -> Bool
f (Presence -> Bool)
-> (Annotated Presence -> Presence) -> Annotated Presence -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Annotated Presence -> Presence
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 Presence -> (Presence -> Presence) -> Presence
forall s t. s -> (s -> t) -> t
& (Maybe Jid -> f (Maybe Jid)) -> Presence -> f Presence
forall s. IsStanza s => Lens s (Maybe Jid)
to ((Maybe Jid -> f (Maybe Jid)) -> Presence -> f Presence)
-> ((Jid -> f Jid) -> Maybe Jid -> f (Maybe Jid))
-> (Jid -> f Jid)
-> Presence
-> f Presence
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Jid -> f Jid) -> Maybe Jid -> f (Maybe Jid)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just (forall (f :: * -> *).
 Identical f =>
 (Jid -> f Jid) -> Presence -> f Presence)
-> (Jid -> Jid) -> Presence -> Presence
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
%~ Jid -> Jid
toBare
        PresenceType
_ -> Presence
p