{-# LANGUAGE RecordWildCards #-}

{-# OPTIONS_HADDOCK hide #-}

-- | Stanza related functions and constants
--

module Network.Xmpp.Stanza where

import Data.XML.Types
import Network.Xmpp.Types
import Network.Xmpp.Lens

-- | Request subscription with an entity.
presenceSubscribe :: Jid -> Presence
presenceSubscribe :: Jid -> Presence
presenceSubscribe Jid
to' = Presence
presence { presenceTo :: Maybe Jid
presenceTo = forall a. a -> Maybe a
Just Jid
to'
                                 , presenceType :: PresenceType
presenceType = PresenceType
Subscribe
                                 }

-- | Approve a subscripton of an entity.
presenceSubscribed :: Jid -> Presence
presenceSubscribed :: Jid -> Presence
presenceSubscribed Jid
to' = Presence
presence { presenceTo :: Maybe Jid
presenceTo = forall a. a -> Maybe a
Just Jid
to'
                                  , presenceType :: PresenceType
presenceType = PresenceType
Subscribed
                                  }

-- | End a subscription with an entity.
presenceUnsubscribe :: Jid -> Presence
presenceUnsubscribe :: Jid -> Presence
presenceUnsubscribe Jid
to' = Presence
presence { presenceTo :: Maybe Jid
presenceTo = forall a. a -> Maybe a
Just Jid
to'
                                   , presenceType :: PresenceType
presenceType = PresenceType
Unsubscribe
                                   }

-- | Deny a not-yet approved or terminate a previously approved subscription of
-- an entity
presenceUnsubscribed :: Jid -> Presence
presenceUnsubscribed :: Jid -> Presence
presenceUnsubscribed Jid
to' = Presence
presence { presenceTo :: Maybe Jid
presenceTo = forall a. a -> Maybe a
Just Jid
to'
                                    , presenceType :: PresenceType
presenceType = PresenceType
Unsubscribed
                                    }

-- | Signal to the server that the client is available for communication.
presenceOnline :: Presence
presenceOnline :: Presence
presenceOnline = Presence
presence

-- | Signal to the server that the client is no longer available for
-- communication.
presenceOffline :: Presence
presenceOffline :: Presence
presenceOffline = Presence
presence {presenceType :: PresenceType
presenceType = PresenceType
Unavailable}

-- | Produce an answer message with the given payload, setting "from" to the
-- "to" attributes in the original message. Produces a 'Nothing' value of the
-- provided message message has no "from" attribute. Sets the "from" attribute
-- to 'Nothing' to let the server assign one.
answerMessage :: Message -> [Element] -> Maybe Message
answerMessage :: Message -> [Element] -> Maybe Message
answerMessage Message{messageFrom :: Message -> Maybe Jid
messageFrom = Just Jid
frm, [ExtendedAttribute]
[Element]
Maybe Text
Maybe Jid
Maybe LangTag
MessageType
messageAttributes :: Message -> [ExtendedAttribute]
messagePayload :: Message -> [Element]
messageType :: Message -> MessageType
messageLangTag :: Message -> Maybe LangTag
messageTo :: Message -> Maybe Jid
messageID :: Message -> Maybe Text
messageAttributes :: [ExtendedAttribute]
messagePayload :: [Element]
messageType :: MessageType
messageLangTag :: Maybe LangTag
messageTo :: Maybe Jid
messageID :: Maybe Text
..} [Element]
payload' =
    forall a. a -> Maybe a
Just Message{ messageFrom :: Maybe Jid
messageFrom    = forall a. Maybe a
Nothing
                , messageID :: Maybe Text
messageID      = forall a. Maybe a
Nothing
                , messageTo :: Maybe Jid
messageTo      = forall a. a -> Maybe a
Just Jid
frm
                , messagePayload :: [Element]
messagePayload = [Element]
payload'
                , [ExtendedAttribute]
Maybe LangTag
MessageType
messageAttributes :: [ExtendedAttribute]
messageType :: MessageType
messageLangTag :: Maybe LangTag
messageAttributes :: [ExtendedAttribute]
messageType :: MessageType
messageLangTag :: Maybe LangTag
..
                }
answerMessage Message
_ [Element]
_ = forall a. Maybe a
Nothing

-- | Add a recipient to a presence notification.
presTo :: Presence -> Jid -> Presence
presTo :: Presence -> Jid -> Presence
presTo Presence
pres Jid
to' = Presence
pres{presenceTo :: Maybe Jid
presenceTo = forall a. a -> Maybe a
Just Jid
to'}

-- | Create a StanzaError with @condition@ and the 'associatedErrorType'. Leave
-- the error text and the application specific condition empty
mkStanzaError :: StanzaErrorCondition -- ^ condition
              -> StanzaError
mkStanzaError :: StanzaErrorCondition -> StanzaError
mkStanzaError StanzaErrorCondition
condition = StanzaErrorType
-> StanzaErrorCondition
-> Maybe (Maybe LangTag, NonemptyText)
-> Maybe Element
-> StanzaError
StanzaError (StanzaErrorCondition -> StanzaErrorType
associatedErrorType StanzaErrorCondition
condition)
                                      StanzaErrorCondition
condition forall a. Maybe a
Nothing forall a. Maybe a
Nothing

-- | Create an IQ error response to an IQ request using the given condition. The
-- error type is derived from the condition using 'associatedErrorType' and
-- both text and the application specific condition are left empty
iqError :: StanzaErrorCondition -> IQRequest -> IQError
iqError :: StanzaErrorCondition -> IQRequest -> IQError
iqError StanzaErrorCondition
condition (IQRequest Text
iqid Maybe Jid
from' Maybe Jid
_to Maybe LangTag
lang' IQRequestType
_tp Element
_bd [ExtendedAttribute]
_attr) =
    Text
-> Maybe Jid
-> Maybe Jid
-> Maybe LangTag
-> StanzaError
-> Maybe Element
-> [ExtendedAttribute]
-> IQError
IQError Text
iqid forall a. Maybe a
Nothing Maybe Jid
from' Maybe LangTag
lang' (StanzaErrorCondition -> StanzaError
mkStanzaError StanzaErrorCondition
condition) forall a. Maybe a
Nothing []


-- | Create an IQ Result matching an IQ request
iqResult ::  Maybe Element -> IQRequest -> IQResult
iqResult :: Maybe Element -> IQRequest -> IQResult
iqResult Maybe Element
pl IQRequest
iqr = IQResult
              { iqResultID :: Text
iqResultID   = IQRequest -> Text
iqRequestID IQRequest
iqr
              , iqResultFrom :: Maybe Jid
iqResultFrom = forall a. Maybe a
Nothing
              , iqResultTo :: Maybe Jid
iqResultTo   = forall a s t b. FoldLike a s t a b -> s -> a
view forall s. IsStanza s => Lens s (Maybe Jid)
from IQRequest
iqr
              , iqResultLangTag :: Maybe LangTag
iqResultLangTag = forall a s t b. FoldLike a s t a b -> s -> a
view forall s. IsStanza s => Lens s (Maybe LangTag)
lang IQRequest
iqr
              , iqResultPayload :: Maybe Element
iqResultPayload = Maybe Element
pl
              , iqResultAttributes :: [ExtendedAttribute]
iqResultAttributes = []
              }

-- | The RECOMMENDED error type associated with an error condition. The
-- following conditions allow for multiple types
--
-- * 'FeatureNotImplemented': 'Cancel' or 'Modify' (returns 'Cancel')
--
-- * 'PolicyViolation': 'Modify' or 'Wait' ('Modify')
--
-- * 'RemoteServerTimeout': 'Wait' or unspecified other ('Wait')
--
-- * 'UndefinedCondition': Any condition ('Cancel')
associatedErrorType :: StanzaErrorCondition -> StanzaErrorType
associatedErrorType :: StanzaErrorCondition -> StanzaErrorType
associatedErrorType StanzaErrorCondition
BadRequest            = StanzaErrorType
Modify
associatedErrorType StanzaErrorCondition
Conflict              = StanzaErrorType
Cancel
associatedErrorType StanzaErrorCondition
FeatureNotImplemented = StanzaErrorType
Cancel -- Or Modify
associatedErrorType StanzaErrorCondition
Forbidden             = StanzaErrorType
Auth
associatedErrorType Gone{}                = StanzaErrorType
Cancel
associatedErrorType StanzaErrorCondition
InternalServerError   = StanzaErrorType
Cancel
associatedErrorType StanzaErrorCondition
ItemNotFound          = StanzaErrorType
Cancel
associatedErrorType StanzaErrorCondition
JidMalformed          = StanzaErrorType
Modify
associatedErrorType StanzaErrorCondition
NotAcceptable         = StanzaErrorType
Modify
associatedErrorType StanzaErrorCondition
NotAllowed            = StanzaErrorType
Cancel
associatedErrorType StanzaErrorCondition
NotAuthorized         = StanzaErrorType
Auth
associatedErrorType StanzaErrorCondition
PolicyViolation       = StanzaErrorType
Modify -- Or Wait
associatedErrorType StanzaErrorCondition
RecipientUnavailable  = StanzaErrorType
Wait
associatedErrorType Redirect{}            = StanzaErrorType
Modify
associatedErrorType StanzaErrorCondition
RegistrationRequired  = StanzaErrorType
Auth
associatedErrorType StanzaErrorCondition
RemoteServerNotFound  = StanzaErrorType
Cancel
associatedErrorType StanzaErrorCondition
RemoteServerTimeout   = StanzaErrorType
Wait -- Possibly Others
associatedErrorType StanzaErrorCondition
ResourceConstraint    = StanzaErrorType
Wait
associatedErrorType StanzaErrorCondition
ServiceUnavailable    = StanzaErrorType
Cancel
associatedErrorType StanzaErrorCondition
SubscriptionRequired  = StanzaErrorType
Auth
associatedErrorType StanzaErrorCondition
UndefinedCondition    = StanzaErrorType
Cancel -- This can be anything
associatedErrorType StanzaErrorCondition
UnexpectedRequest     = StanzaErrorType
Modify