{-# 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 = Just to'
                                 , presenceType = Subscribe
                                 }

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

-- | End a subscription with an entity.
presenceUnsubscribe :: Jid -> Presence
presenceUnsubscribe :: Jid -> Presence
presenceUnsubscribe Jid
to' = Presence
presence { presenceTo = Just to'
                                   , 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 = Just to'
                                    , 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 = 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
messageID :: Maybe Text
messageTo :: Maybe Jid
messageLangTag :: Maybe LangTag
messageType :: MessageType
messagePayload :: [Element]
messageAttributes :: [ExtendedAttribute]
messageID :: Message -> Maybe Text
messageTo :: Message -> Maybe Jid
messageLangTag :: Message -> Maybe LangTag
messageType :: Message -> MessageType
messagePayload :: Message -> [Element]
messageAttributes :: Message -> [ExtendedAttribute]
..} [Element]
payload' =
    Message -> Maybe Message
forall a. a -> Maybe a
Just Message{ messageFrom :: Maybe Jid
messageFrom    = Maybe Jid
forall a. Maybe a
Nothing
                , messageID :: Maybe Text
messageID      = Maybe Text
forall a. Maybe a
Nothing
                , messageTo :: Maybe Jid
messageTo      = Jid -> Maybe Jid
forall a. a -> Maybe a
Just Jid
frm
                , messagePayload :: [Element]
messagePayload = [Element]
payload'
                , [ExtendedAttribute]
Maybe LangTag
MessageType
messageLangTag :: Maybe LangTag
messageType :: MessageType
messageAttributes :: [ExtendedAttribute]
messageLangTag :: Maybe LangTag
messageType :: MessageType
messageAttributes :: [ExtendedAttribute]
..
                }
answerMessage Message
_ [Element]
_ = Maybe Message
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 = Just 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 Maybe (Maybe LangTag, NonemptyText)
forall a. Maybe a
Nothing Maybe Element
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 Maybe Jid
forall a. Maybe a
Nothing Maybe Jid
from' Maybe LangTag
lang' (StanzaErrorCondition -> StanzaError
mkStanzaError StanzaErrorCondition
condition) Maybe Element
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 = Maybe Jid
forall a. Maybe a
Nothing
              , iqResultTo :: Maybe Jid
iqResultTo   = FoldLike (Maybe Jid) IQRequest IQRequest (Maybe Jid) (Maybe Jid)
-> IQRequest -> Maybe Jid
forall a s t b. FoldLike a s t a b -> s -> a
view FoldLike (Maybe Jid) IQRequest IQRequest (Maybe Jid) (Maybe Jid)
forall s. IsStanza s => Lens s (Maybe Jid)
Lens IQRequest (Maybe Jid)
from IQRequest
iqr
              , iqResultLangTag :: Maybe LangTag
iqResultLangTag = FoldLike
  (Maybe LangTag) IQRequest IQRequest (Maybe LangTag) (Maybe LangTag)
-> IQRequest -> Maybe LangTag
forall a s t b. FoldLike a s t a b -> s -> a
view FoldLike
  (Maybe LangTag) IQRequest IQRequest (Maybe LangTag) (Maybe LangTag)
forall s. IsStanza s => Lens s (Maybe LangTag)
Lens IQRequest (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