-- Picklers and unpicklers convert Haskell data to XML and XML to Haskell data,
-- respectively. By convention, pickler/unpickler ("PU") function names start
-- with "xp".

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

{-# OPTIONS_HADDOCK hide #-}

module Network.Xmpp.Marshal where

import           Data.XML.Pickle
import           Data.XML.Types

import qualified Control.Exception as Ex
import           Data.Text (Text)
import qualified Data.Text as Text

import           Network.Xmpp.Types

xpNonemptyText :: PU Text NonemptyText
xpNonemptyText :: PU Text NonemptyText
xpNonemptyText = (Text
"xpNonemptyText" , Text
"") forall t a. (Text, Text) -> PU t a -> PU t a
<?+> forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap Text -> NonemptyText
Nonempty NonemptyText -> Text
fromNonempty PU Text Text
xpText

xpStreamElement :: PU [Node] (Either StreamErrorInfo XmppElement)
xpStreamElement :: PU [Node] (Either StreamErrorInfo XmppElement)
xpStreamElement = forall n t1 t2. PU n t1 -> PU n t2 -> PU n (Either t1 t2)
xpEither PU [Node] StreamErrorInfo
xpStreamError forall a b. (a -> b) -> a -> b
$ forall a t. (a -> Int) -> [PU t a] -> PU t a
xpAlt XmppElement -> Int
elemSel
    [ forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap Stanza -> XmppElement
XmppStanza     (\(XmppStanza     Stanza
x) -> Stanza
x) PU [Node] Stanza
xpStanza
    , forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap Element -> XmppElement
XmppNonza      (\(XmppNonza      Element
x) -> Element
x) PU [Node] Element
xpElemVerbatim
    ]
  where
    -- Selector for which pickler to execute above.
    elemSel :: XmppElement -> Int
    elemSel :: XmppElement -> Int
elemSel (XmppStanza     Stanza
_) = Int
0
    elemSel (XmppNonza      Element
_) = Int
1

xpStreamStanza :: PU [Node] (Either StreamErrorInfo Stanza)
xpStreamStanza :: PU [Node] (Either StreamErrorInfo Stanza)
xpStreamStanza = forall n t1 t2. PU n t1 -> PU n t2 -> PU n (Either t1 t2)
xpEither PU [Node] StreamErrorInfo
xpStreamError PU [Node] Stanza
xpStanza

xpExtendedAttrs :: PU [Attribute] [ExtendedAttribute]
xpExtendedAttrs :: PU [Attribute] [ExtendedAttribute]
xpExtendedAttrs = (Text
"xpAttrVerbatim" , Text
"") forall t a. (Text, Text) -> PU t a -> PU t a
<?+>
                    forall a b. (a -> b) -> (b -> a) -> PU a b
xpIso (forall a b. (a -> b) -> [a] -> [b]
map (\(Name
name, [Content]
cs) -> (Name
name, [Content] -> Text
flattenContents [Content]
cs)))
                          (forall a b. (a -> b) -> [a] -> [b]
map (\(Name
name, Text
c) -> (Name
name, [Text -> Content
ContentText Text
c])))
  where
    flattenContents :: [Content] -> Text
flattenContents = [Text] -> Text
Text.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Content] -> [Text]
filterContentText
    filterContentText :: [Content] -> [Text]
filterContentText = forall a b. (a -> b) -> [a] -> [b]
map (\Content
c -> case Content
c of
        ContentText Text
t -> Text
t
        ContentEntity{} -> forall a e. Exception e => e -> a
Ex.throw UnresolvedEntityException
UnresolvedEntityException )

xpStanza :: PU [Node] Stanza
xpStanza :: PU [Node] Stanza
xpStanza = (Text
"xpStanza" , Text
"") forall t a. (Text, Text) -> PU t a -> PU t a
<?+> forall a t. (a -> Int) -> [PU t a] -> PU t a
xpAlt Stanza -> Int
stanzaSel
    [ forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap IQRequest -> Stanza
IQRequestS     (\(IQRequestS     IQRequest
x) -> IQRequest
x) PU [Node] IQRequest
xpIQRequest
    , forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap IQResult -> Stanza
IQResultS      (\(IQResultS      IQResult
x) -> IQResult
x) PU [Node] IQResult
xpIQResult
    , forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap IQError -> Stanza
IQErrorS       (\(IQErrorS       IQError
x) -> IQError
x) PU [Node] IQError
xpIQError
    , forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap MessageError -> Stanza
MessageErrorS  (\(MessageErrorS  MessageError
x) -> MessageError
x) PU [Node] MessageError
xpMessageError
    , forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap Message -> Stanza
MessageS       (\(MessageS       Message
x) -> Message
x) PU [Node] Message
xpMessage
    , forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap PresenceError -> Stanza
PresenceErrorS (\(PresenceErrorS PresenceError
x) -> PresenceError
x) PU [Node] PresenceError
xpPresenceError
    , forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap Presence -> Stanza
PresenceS      (\(PresenceS      Presence
x) -> Presence
x) PU [Node] Presence
xpPresence
    ]
  where
    -- Selector for which pickler to execute above.
    stanzaSel :: Stanza -> Int
    stanzaSel :: Stanza -> Int
stanzaSel (IQRequestS     IQRequest
_) = Int
0
    stanzaSel (IQResultS      IQResult
_) = Int
1
    stanzaSel (IQErrorS       IQError
_) = Int
2
    stanzaSel (MessageErrorS  MessageError
_) = Int
3
    stanzaSel (MessageS       Message
_) = Int
4
    stanzaSel (PresenceErrorS PresenceError
_) = Int
5
    stanzaSel (PresenceS      Presence
_) = Int
6

xpMessage :: PU [Node] (Message)
xpMessage :: PU [Node] Message
xpMessage = (Text
"xpMessage" , Text
"") forall t a. (Text, Text) -> PU t a -> PU t a
<?+> forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap
    (\((MessageType
tp, Maybe Text
qid, Maybe Jid
from, Maybe Jid
to, Maybe LangTag
lang, [ExtendedAttribute]
attrs), [Element]
ext) -> Maybe Text
-> Maybe Jid
-> Maybe Jid
-> Maybe LangTag
-> MessageType
-> [Element]
-> [ExtendedAttribute]
-> Message
Message Maybe Text
qid Maybe Jid
from Maybe Jid
to Maybe LangTag
lang MessageType
tp [Element]
ext [ExtendedAttribute]
attrs)
    (\(Message Maybe Text
qid Maybe Jid
from Maybe Jid
to Maybe LangTag
lang MessageType
tp [Element]
ext [ExtendedAttribute]
attrs) -> ((MessageType
tp, Maybe Text
qid, Maybe Jid
from, Maybe Jid
to, Maybe LangTag
lang, [ExtendedAttribute]
attrs), [Element]
ext))
    (forall a n.
Name -> PU [Attribute] a -> PU [Node] n -> PU [Node] (a, n)
xpElem Name
"{jabber:client}message"
         (forall a a1 a2 a3 a4 a5 a6.
PU [a] a1
-> PU [a] a2
-> PU [a] a3
-> PU [a] a4
-> PU [a] a5
-> PU [a] a6
-> PU [a] (a1, a2, a3, a4, a5, a6)
xp6Tuple
             (forall a t. Eq a => a -> PU [t] a -> PU [t] a
xpDefault MessageType
Normal forall a b. (a -> b) -> a -> b
$ forall a. Name -> PU Text a -> PU [Attribute] a
xpAttr Name
"type" PU Text MessageType
xpMessageType)
             (forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
"id"   forall a. PU a a
xpId)
             (forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
"from" PU Text Jid
xpJid)
             (forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
"to"   PU Text Jid
xpJid)
             PU [Attribute] (Maybe LangTag)
xpLangTag
             PU [Attribute] [ExtendedAttribute]
xpExtendedAttrs
             -- TODO: NS?
         )
         (forall a b. PU [a] b -> PU [a] [b]
xpAll PU [Node] Element
xpElemVerbatim)
    )

xpPresence :: PU [Node] Presence
xpPresence :: PU [Node] Presence
xpPresence = (Text
"xpPresence" , Text
"") forall t a. (Text, Text) -> PU t a -> PU t a
<?+> forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap
    (\((Maybe Text
qid, Maybe Jid
from, Maybe Jid
to, Maybe LangTag
lang, PresenceType
tp, [ExtendedAttribute]
attr), [Element]
ext)
        -> Maybe Text
-> Maybe Jid
-> Maybe Jid
-> Maybe LangTag
-> PresenceType
-> [Element]
-> [ExtendedAttribute]
-> Presence
Presence Maybe Text
qid Maybe Jid
from Maybe Jid
to Maybe LangTag
lang PresenceType
tp [Element]
ext [ExtendedAttribute]
attr)
    (\(Presence Maybe Text
qid Maybe Jid
from Maybe Jid
to Maybe LangTag
lang PresenceType
tp [Element]
ext [ExtendedAttribute]
attr)
       -> ((Maybe Text
qid, Maybe Jid
from, Maybe Jid
to, Maybe LangTag
lang, PresenceType
tp, [ExtendedAttribute]
attr), [Element]
ext))
    (forall a n.
Name -> PU [Attribute] a -> PU [Node] n -> PU [Node] (a, n)
xpElem Name
"{jabber:client}presence"
         (forall a a1 a2 a3 a4 a5 a6.
PU [a] a1
-> PU [a] a2
-> PU [a] a3
-> PU [a] a4
-> PU [a] a5
-> PU [a] a6
-> PU [a] (a1, a2, a3, a4, a5, a6)
xp6Tuple
              (forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
"id"   forall a. PU a a
xpId)
              (forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
"from" PU Text Jid
xpJid)
              (forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
"to"   PU Text Jid
xpJid)
              PU [Attribute] (Maybe LangTag)
xpLangTag
              (forall a t. Eq a => a -> PU [t] a -> PU [t] a
xpDefault PresenceType
Available forall a b. (a -> b) -> a -> b
$ forall a. Name -> PU Text a -> PU [Attribute] a
xpAttr Name
"type" PU Text PresenceType
xpPresenceType)
              PU [Attribute] [ExtendedAttribute]
xpExtendedAttrs
         )
         (forall a b. PU [a] b -> PU [a] [b]
xpAll PU [Node] Element
xpElemVerbatim)
    )

xpIQRequest :: PU [Node] IQRequest
xpIQRequest :: PU [Node] IQRequest
xpIQRequest = (Text
"xpIQRequest" , Text
"") forall t a. (Text, Text) -> PU t a -> PU t a
<?+> forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap
    (\((Text
qid, Maybe Jid
from, Maybe Jid
to, Maybe LangTag
lang, IQRequestType
tp, [ExtendedAttribute]
attr),Element
body)
       -> Text
-> Maybe Jid
-> Maybe Jid
-> Maybe LangTag
-> IQRequestType
-> Element
-> [ExtendedAttribute]
-> IQRequest
IQRequest Text
qid Maybe Jid
from Maybe Jid
to Maybe LangTag
lang IQRequestType
tp Element
body [ExtendedAttribute]
attr)
    (\(IQRequest Text
qid Maybe Jid
from Maybe Jid
to Maybe LangTag
lang IQRequestType
tp Element
body [ExtendedAttribute]
attr)
        -> ((Text
qid, Maybe Jid
from, Maybe Jid
to, Maybe LangTag
lang, IQRequestType
tp, [ExtendedAttribute]
attr), Element
body))
    (forall a n.
Name -> PU [Attribute] a -> PU [Node] n -> PU [Node] (a, n)
xpElem Name
"{jabber:client}iq"
         (forall a a1 a2 a3 a4 a5 a6.
PU [a] a1
-> PU [a] a2
-> PU [a] a3
-> PU [a] a4
-> PU [a] a5
-> PU [a] a6
-> PU [a] (a1, a2, a3, a4, a5, a6)
xp6Tuple
             (forall a. Name -> PU Text a -> PU [Attribute] a
xpAttr        Name
"id"   forall a. PU a a
xpId)
             (forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
"from" PU Text Jid
xpJid)
             (forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
"to"   PU Text Jid
xpJid)
             PU [Attribute] (Maybe LangTag)
xpLangTag
             ((forall a. Name -> PU Text a -> PU [Attribute] a
xpAttr        Name
"type" PU Text IQRequestType
xpIQRequestType))
             PU [Attribute] [ExtendedAttribute]
xpExtendedAttrs
         )
         PU [Node] Element
xpElemVerbatim
    )

xpIQResult :: PU [Node] IQResult
xpIQResult :: PU [Node] IQResult
xpIQResult = (Text
"xpIQResult" , Text
"") forall t a. (Text, Text) -> PU t a -> PU t a
<?+> forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap
    (\((Text
qid, Maybe Jid
from, Maybe Jid
to, Maybe LangTag
lang, ()
_tp, [ExtendedAttribute]
attr),Maybe Element
body)
        -> Text
-> Maybe Jid
-> Maybe Jid
-> Maybe LangTag
-> Maybe Element
-> [ExtendedAttribute]
-> IQResult
IQResult Text
qid Maybe Jid
from Maybe Jid
to Maybe LangTag
lang Maybe Element
body [ExtendedAttribute]
attr)
    (\(IQResult Text
qid Maybe Jid
from Maybe Jid
to Maybe LangTag
lang Maybe Element
body [ExtendedAttribute]
attr)
        -> ((Text
qid, Maybe Jid
from, Maybe Jid
to, Maybe LangTag
lang, (), [ExtendedAttribute]
attr ), Maybe Element
body))
    (forall a n.
Name -> PU [Attribute] a -> PU [Node] n -> PU [Node] (a, n)
xpElem Name
"{jabber:client}iq"
         (forall a a1 a2 a3 a4 a5 a6.
PU [a] a1
-> PU [a] a2
-> PU [a] a3
-> PU [a] a4
-> PU [a] a5
-> PU [a] a6
-> PU [a] (a1, a2, a3, a4, a5, a6)
xp6Tuple
             (forall a. Name -> PU Text a -> PU [Attribute] a
xpAttr        Name
"id"   forall a. PU a a
xpId)
             (forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
"from" PU Text Jid
xpJid)
             (forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
"to"   PU Text Jid
xpJid)
             PU [Attribute] (Maybe LangTag)
xpLangTag
             ((Name -> Text -> PU [Attribute] ()
xpAttrFixed Name
"type" Text
"result"))
             PU [Attribute] [ExtendedAttribute]
xpExtendedAttrs
         )
         (forall t a. PU [t] a -> PU [t] (Maybe a)
xpOption PU [Node] Element
xpElemVerbatim)
    )

----------------------------------------------------------
-- Errors
----------------------------------------------------------

xpStanzaErrorCondition :: PU [Node] StanzaErrorCondition
xpStanzaErrorCondition :: PU [Node] StanzaErrorCondition
xpStanzaErrorCondition = (Text
"xpErrorCondition" , Text
"") forall t a. (Text, Text) -> PU t a -> PU t a
<?+> forall e a b t.
Show e =>
(a -> Either e b) -> (b -> a) -> PU t a -> PU t b
xpWrapEither
                   (\(StanzaErrorCondition
cond, (),Maybe NonemptyText
cont) -> case (StanzaErrorCondition
cond, Maybe NonemptyText
cont) of
                         (Gone Maybe NonemptyText
_, Maybe NonemptyText
x) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Maybe NonemptyText -> StanzaErrorCondition
Gone Maybe NonemptyText
x
                         (Redirect Maybe NonemptyText
_, Maybe NonemptyText
x) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Maybe NonemptyText -> StanzaErrorCondition
Redirect Maybe NonemptyText
x
                         (StanzaErrorCondition
x , Maybe NonemptyText
Nothing) -> forall a b. b -> Either a b
Right StanzaErrorCondition
x
                         (StanzaErrorCondition, Maybe NonemptyText)
_ -> forall a b. a -> Either a b
Left
                              (String
"Only Gone and Redirect may have character data"
                                 :: String)
                              )
                   (\StanzaErrorCondition
x -> case StanzaErrorCondition
x of
                         (Gone Maybe NonemptyText
t) -> (Maybe NonemptyText -> StanzaErrorCondition
Gone forall a. Maybe a
Nothing, (),  Maybe NonemptyText
t)
                         (Redirect Maybe NonemptyText
t) -> (Maybe NonemptyText -> StanzaErrorCondition
Redirect forall a. Maybe a
Nothing, () , Maybe NonemptyText
t)
                         StanzaErrorCondition
c -> (StanzaErrorCondition
c, (), forall a. Maybe a
Nothing))
    (forall name a n.
Text
-> PU Text name
-> PU [Attribute] a
-> PU [Node] n
-> PU [Node] (name, a, n)
xpElemByNamespace
        Text
"urn:ietf:params:xml:ns:xmpp-stanzas"
        PU Text StanzaErrorCondition
xpStanzaErrorConditionShape
        forall a. PU [a] ()
xpUnit
        (forall t a. PU [t] a -> PU [t] (Maybe a)
xpOption forall a b. (a -> b) -> a -> b
$ forall a. PU Text a -> PU [Node] a
xpContent PU Text NonemptyText
xpNonemptyText)
    )
  where
    -- Create the "shape" of the error condition. In case of Gone and Redirect
    -- the optional field is left empty and must be filled in by the caller
    xpStanzaErrorConditionShape :: PU Text StanzaErrorCondition
    xpStanzaErrorConditionShape :: PU Text StanzaErrorCondition
xpStanzaErrorConditionShape = (Text
"xpStanzaErrorCondition", Text
"") forall t a. (Text, Text) -> PU t a -> PU t a
<?>
            forall a b. (a -> b) -> (b -> a) -> PU a b
xpIso forall {a}. (Eq a, IsString a) => a -> StanzaErrorCondition
stanzaErrorConditionFromText
                  forall {a}. IsString a => StanzaErrorCondition -> a
stanzaErrorConditionToText
    stanzaErrorConditionToText :: StanzaErrorCondition -> a
stanzaErrorConditionToText StanzaErrorCondition
BadRequest = a
"bad-request"
    stanzaErrorConditionToText StanzaErrorCondition
Conflict = a
"conflict"
    stanzaErrorConditionToText StanzaErrorCondition
FeatureNotImplemented = a
"feature-not-implemented"
    stanzaErrorConditionToText StanzaErrorCondition
Forbidden = a
"forbidden"
    stanzaErrorConditionToText (Gone Maybe NonemptyText
_) = a
"gone"
    stanzaErrorConditionToText StanzaErrorCondition
InternalServerError = a
"internal-server-error"
    stanzaErrorConditionToText StanzaErrorCondition
ItemNotFound = a
"item-not-found"
    stanzaErrorConditionToText StanzaErrorCondition
JidMalformed = a
"jid-malformed"
    stanzaErrorConditionToText StanzaErrorCondition
NotAcceptable = a
"not-acceptable"
    stanzaErrorConditionToText StanzaErrorCondition
NotAllowed = a
"not-allowed"
    stanzaErrorConditionToText StanzaErrorCondition
NotAuthorized = a
"not-authorized"
    stanzaErrorConditionToText StanzaErrorCondition
PolicyViolation = a
"policy-violation"
    stanzaErrorConditionToText StanzaErrorCondition
RecipientUnavailable = a
"recipient-unavailable"
    stanzaErrorConditionToText (Redirect Maybe NonemptyText
_) = a
"redirect"
    stanzaErrorConditionToText StanzaErrorCondition
RegistrationRequired = a
"registration-required"
    stanzaErrorConditionToText StanzaErrorCondition
RemoteServerNotFound = a
"remote-server-not-found"
    stanzaErrorConditionToText StanzaErrorCondition
RemoteServerTimeout = a
"remote-server-timeout"
    stanzaErrorConditionToText StanzaErrorCondition
ResourceConstraint = a
"resource-constraint"
    stanzaErrorConditionToText StanzaErrorCondition
ServiceUnavailable = a
"service-unavailable"
    stanzaErrorConditionToText StanzaErrorCondition
SubscriptionRequired = a
"subscription-required"
    stanzaErrorConditionToText StanzaErrorCondition
UndefinedCondition = a
"undefined-condition"
    stanzaErrorConditionToText StanzaErrorCondition
UnexpectedRequest = a
"unexpected-request"
    stanzaErrorConditionFromText :: a -> StanzaErrorCondition
stanzaErrorConditionFromText a
"bad-request" = StanzaErrorCondition
BadRequest
    stanzaErrorConditionFromText a
"conflict" = StanzaErrorCondition
Conflict
    stanzaErrorConditionFromText a
"feature-not-implemented" = StanzaErrorCondition
FeatureNotImplemented
    stanzaErrorConditionFromText a
"forbidden" = StanzaErrorCondition
Forbidden
    stanzaErrorConditionFromText a
"gone" = Maybe NonemptyText -> StanzaErrorCondition
Gone forall a. Maybe a
Nothing
    stanzaErrorConditionFromText a
"internal-server-error" = StanzaErrorCondition
InternalServerError
    stanzaErrorConditionFromText a
"item-not-found" = StanzaErrorCondition
ItemNotFound
    stanzaErrorConditionFromText a
"jid-malformed" = StanzaErrorCondition
JidMalformed
    stanzaErrorConditionFromText a
"not-acceptable" = StanzaErrorCondition
NotAcceptable
    stanzaErrorConditionFromText a
"not-allowed" = StanzaErrorCondition
NotAllowed
    stanzaErrorConditionFromText a
"not-authorized" = StanzaErrorCondition
NotAuthorized
    stanzaErrorConditionFromText a
"policy-violation" = StanzaErrorCondition
PolicyViolation
    stanzaErrorConditionFromText a
"recipient-unavailable" = StanzaErrorCondition
RecipientUnavailable
    stanzaErrorConditionFromText a
"redirect" = Maybe NonemptyText -> StanzaErrorCondition
Redirect forall a. Maybe a
Nothing
    stanzaErrorConditionFromText a
"registration-required" = StanzaErrorCondition
RegistrationRequired
    stanzaErrorConditionFromText a
"remote-server-not-found" = StanzaErrorCondition
RemoteServerNotFound
    stanzaErrorConditionFromText a
"remote-server-timeout" = StanzaErrorCondition
RemoteServerTimeout
    stanzaErrorConditionFromText a
"resource-constraint" = StanzaErrorCondition
ResourceConstraint
    stanzaErrorConditionFromText a
"service-unavailable" = StanzaErrorCondition
ServiceUnavailable
    stanzaErrorConditionFromText a
"subscription-required" = StanzaErrorCondition
SubscriptionRequired
    stanzaErrorConditionFromText a
"undefined-condition" = StanzaErrorCondition
UndefinedCondition
    stanzaErrorConditionFromText a
"unexpected-request" = StanzaErrorCondition
UnexpectedRequest
    stanzaErrorConditionFromText a
_ = StanzaErrorCondition
UndefinedCondition



xpStanzaError :: PU [Node] StanzaError
xpStanzaError :: PU [Node] StanzaError
xpStanzaError = (Text
"xpStanzaError" , Text
"") forall t a. (Text, Text) -> PU t a -> PU t a
<?+> forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap
    (\((StanzaErrorType
tp, Maybe Text
_code), (StanzaErrorCondition
cond, Maybe (Maybe LangTag, NonemptyText)
txt, Maybe Element
ext)) -> StanzaErrorType
-> StanzaErrorCondition
-> Maybe (Maybe LangTag, NonemptyText)
-> Maybe Element
-> StanzaError
StanzaError StanzaErrorType
tp StanzaErrorCondition
cond Maybe (Maybe LangTag, NonemptyText)
txt Maybe Element
ext)
    (\(StanzaError StanzaErrorType
tp StanzaErrorCondition
cond Maybe (Maybe LangTag, NonemptyText)
txt Maybe Element
ext) -> ((StanzaErrorType
tp, forall a. Maybe a
Nothing), (StanzaErrorCondition
cond, Maybe (Maybe LangTag, NonemptyText)
txt, Maybe Element
ext)))
    (forall a n.
Name -> PU [Attribute] a -> PU [Node] n -> PU [Node] (a, n)
xpElem Name
"{jabber:client}error"
         (forall a b1 b2. PU [a] b1 -> PU [a] b2 -> PU [a] (b1, b2)
xp2Tuple
             (forall a. Name -> PU Text a -> PU [Attribute] a
xpAttr Name
"type" PU Text StanzaErrorType
xpStanzaErrorType)
             (forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttribute' Name
"code" forall a. PU a a
xpId))
         (forall a a1 a2 a3.
PU [a] a1 -> PU [a] a2 -> PU [a] a3 -> PU [a] (a1, a2, a3)
xp3Tuple
              PU [Node] StanzaErrorCondition
xpStanzaErrorCondition
              (forall t a. PU [t] a -> PU [t] (Maybe a)
xpOption forall a b. (a -> b) -> a -> b
$ forall a n.
Name -> PU [Attribute] a -> PU [Node] n -> PU [Node] (a, n)
xpElem Name
"{urn:ietf:params:xml:ns:xmpp-stanzas}text"
                   (forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
xmlLang PU Text LangTag
xpLang)
                   (forall a. PU Text a -> PU [Node] a
xpContent PU Text NonemptyText
xpNonemptyText)
              )
              (forall t a. PU [t] a -> PU [t] (Maybe a)
xpOption PU [Node] Element
xpElemVerbatim)
         )
    )

xpMessageError :: PU [Node] (MessageError)
xpMessageError :: PU [Node] MessageError
xpMessageError = (Text
"xpMessageError" , Text
"") forall t a. (Text, Text) -> PU t a -> PU t a
<?+> forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap
    (\((()
_, Maybe Text
qid, Maybe Jid
from, Maybe Jid
to, Maybe LangTag
lang, [ExtendedAttribute]
attr), (StanzaError
err, [Element]
ext)) ->
        Maybe Text
-> Maybe Jid
-> Maybe Jid
-> Maybe LangTag
-> StanzaError
-> [Element]
-> [ExtendedAttribute]
-> MessageError
MessageError Maybe Text
qid Maybe Jid
from Maybe Jid
to Maybe LangTag
lang StanzaError
err [Element]
ext [ExtendedAttribute]
attr)
    (\(MessageError Maybe Text
qid Maybe Jid
from Maybe Jid
to Maybe LangTag
lang StanzaError
err [Element]
ext [ExtendedAttribute]
attr) ->
        (((), Maybe Text
qid, Maybe Jid
from, Maybe Jid
to, Maybe LangTag
lang, [ExtendedAttribute]
attr), (StanzaError
err, [Element]
ext)))
    (forall a n.
Name -> PU [Attribute] a -> PU [Node] n -> PU [Node] (a, n)
xpElem Name
"{jabber:client}message"
         (forall a a1 a2 a3 a4 a5 a6.
PU [a] a1
-> PU [a] a2
-> PU [a] a3
-> PU [a] a4
-> PU [a] a5
-> PU [a] a6
-> PU [a] (a1, a2, a3, a4, a5, a6)
xp6Tuple
              (Name -> Text -> PU [Attribute] ()
xpAttrFixed   Name
"type" Text
"error")
              (forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
"id"   forall a. PU a a
xpId)
              (forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
"from" PU Text Jid
xpJid)
              (forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
"to"   PU Text Jid
xpJid)
              (forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
xmlLang PU Text LangTag
xpLang)
              PU [Attribute] [ExtendedAttribute]
xpExtendedAttrs
         )
         (forall a b1 b2. PU [a] b1 -> PU [a] b2 -> PU [a] (b1, b2)
xp2Tuple PU [Node] StanzaError
xpStanzaError (forall a b. PU [a] b -> PU [a] [b]
xpAll PU [Node] Element
xpElemVerbatim))
    )

xpPresenceError :: PU [Node] PresenceError
xpPresenceError :: PU [Node] PresenceError
xpPresenceError = (Text
"xpPresenceError" , Text
"") forall t a. (Text, Text) -> PU t a -> PU t a
<?+> forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap
    (\((Maybe Text
qid, Maybe Jid
from, Maybe Jid
to, Maybe LangTag
lang, ()
_, [ExtendedAttribute]
attr),(StanzaError
err, [Element]
ext)) ->
        Maybe Text
-> Maybe Jid
-> Maybe Jid
-> Maybe LangTag
-> StanzaError
-> [Element]
-> [ExtendedAttribute]
-> PresenceError
PresenceError Maybe Text
qid Maybe Jid
from Maybe Jid
to Maybe LangTag
lang StanzaError
err [Element]
ext [ExtendedAttribute]
attr)
    (\(PresenceError Maybe Text
qid Maybe Jid
from Maybe Jid
to Maybe LangTag
lang StanzaError
err [Element]
ext [ExtendedAttribute]
attr) ->
        ((Maybe Text
qid, Maybe Jid
from, Maybe Jid
to, Maybe LangTag
lang, (), [ExtendedAttribute]
attr), (StanzaError
err, [Element]
ext)))
    (forall a n.
Name -> PU [Attribute] a -> PU [Node] n -> PU [Node] (a, n)
xpElem Name
"{jabber:client}presence"
         (forall a a1 a2 a3 a4 a5 a6.
PU [a] a1
-> PU [a] a2
-> PU [a] a3
-> PU [a] a4
-> PU [a] a5
-> PU [a] a6
-> PU [a] (a1, a2, a3, a4, a5, a6)
xp6Tuple
              (forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
"id"   forall a. PU a a
xpId)
              (forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
"from" PU Text Jid
xpJid)
              (forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
"to"   PU Text Jid
xpJid)
              PU [Attribute] (Maybe LangTag)
xpLangTag
              (Name -> Text -> PU [Attribute] ()
xpAttrFixed Name
"type" Text
"error")
              PU [Attribute] [ExtendedAttribute]
xpExtendedAttrs
         )
         (forall a b1 b2. PU [a] b1 -> PU [a] b2 -> PU [a] (b1, b2)
xp2Tuple PU [Node] StanzaError
xpStanzaError (forall a b. PU [a] b -> PU [a] [b]
xpAll PU [Node] Element
xpElemVerbatim))
    )

xpIQError :: PU [Node] IQError
xpIQError :: PU [Node] IQError
xpIQError = (Text
"xpIQError" , Text
"") forall t a. (Text, Text) -> PU t a -> PU t a
<?+> forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap
    (\((Text
qid, Maybe Jid
from, Maybe Jid
to, Maybe LangTag
lang, ()
_tp, [ExtendedAttribute]
attr),(StanzaError
err, Maybe Element
body)) ->
        Text
-> Maybe Jid
-> Maybe Jid
-> Maybe LangTag
-> StanzaError
-> Maybe Element
-> [ExtendedAttribute]
-> IQError
IQError Text
qid Maybe Jid
from Maybe Jid
to Maybe LangTag
lang StanzaError
err Maybe Element
body [ExtendedAttribute]
attr)
    (\(IQError Text
qid Maybe Jid
from Maybe Jid
to Maybe LangTag
lang StanzaError
err Maybe Element
body [ExtendedAttribute]
attr) ->
        ((Text
qid, Maybe Jid
from, Maybe Jid
to, Maybe LangTag
lang, (), [ExtendedAttribute]
attr), (StanzaError
err, Maybe Element
body)))
    (forall a n.
Name -> PU [Attribute] a -> PU [Node] n -> PU [Node] (a, n)
xpElem Name
"{jabber:client}iq"
         (forall a a1 a2 a3 a4 a5 a6.
PU [a] a1
-> PU [a] a2
-> PU [a] a3
-> PU [a] a4
-> PU [a] a5
-> PU [a] a6
-> PU [a] (a1, a2, a3, a4, a5, a6)
xp6Tuple
              (forall a. Name -> PU Text a -> PU [Attribute] a
xpAttr        Name
"id"   forall a. PU a a
xpId)
              (forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
"from" PU Text Jid
xpJid)
              (forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
"to"   PU Text Jid
xpJid)
              PU [Attribute] (Maybe LangTag)
xpLangTag
              ((Name -> Text -> PU [Attribute] ()
xpAttrFixed Name
"type" Text
"error"))
              PU [Attribute] [ExtendedAttribute]
xpExtendedAttrs
         )
         (forall a b1 b2. PU [a] b1 -> PU [a] b2 -> PU [a] (b1, b2)
xp2Tuple PU [Node] StanzaError
xpStanzaError (forall t a. PU [t] a -> PU [t] (Maybe a)
xpOption PU [Node] Element
xpElemVerbatim))
    )

xpStreamError :: PU [Node] StreamErrorInfo
xpStreamError :: PU [Node] StreamErrorInfo
xpStreamError = (Text
"xpStreamError" , Text
"") forall t a. (Text, Text) -> PU t a -> PU t a
<?+> forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap
    (\((StreamErrorCondition
cond,() ,()), Maybe (Maybe LangTag, NonemptyText)
txt, Maybe Element
el) -> StreamErrorCondition
-> Maybe (Maybe LangTag, NonemptyText)
-> Maybe Element
-> StreamErrorInfo
StreamErrorInfo StreamErrorCondition
cond Maybe (Maybe LangTag, NonemptyText)
txt Maybe Element
el)
    (\(StreamErrorInfo StreamErrorCondition
cond Maybe (Maybe LangTag, NonemptyText)
txt Maybe Element
el) ->((StreamErrorCondition
cond,() ,()), Maybe (Maybe LangTag, NonemptyText)
txt, Maybe Element
el))
    (forall b. Name -> PU [Node] b -> PU [Node] b
xpElemNodes
         (Text -> Maybe Text -> Maybe Text -> Name
Name
              Text
"error"
              (forall a. a -> Maybe a
Just Text
"http://etherx.jabber.org/streams")
              (forall a. a -> Maybe a
Just Text
"stream")
         )
         (forall a a1 a2 a3.
PU [a] a1 -> PU [a] a2 -> PU [a] a3 -> PU [a] (a1, a2, a3)
xp3Tuple
              (forall name a n.
Text
-> PU Text name
-> PU [Attribute] a
-> PU [Node] n
-> PU [Node] (name, a, n)
xpElemByNamespace
                   Text
"urn:ietf:params:xml:ns:xmpp-streams"
                   PU Text StreamErrorCondition
xpStreamErrorCondition
                   forall a. PU [a] ()
xpUnit
                   forall a. PU [a] ()
xpUnit
              )
              (forall t a. PU [t] a -> PU [t] (Maybe a)
xpOption forall a b. (a -> b) -> a -> b
$ forall a n.
Name -> PU [Attribute] a -> PU [Node] n -> PU [Node] (a, n)
xpElem
                   Name
"{urn:ietf:params:xml:ns:xmpp-streams}text"
                   PU [Attribute] (Maybe LangTag)
xpLangTag
                   (forall a. PU Text a -> PU [Node] a
xpContent PU Text NonemptyText
xpNonemptyText)
              )
              (forall t a. PU [t] a -> PU [t] (Maybe a)
xpOption PU [Node] Element
xpElemVerbatim) -- Application specific error conditions
         )
    )

xpLangTag :: PU [Attribute] (Maybe LangTag)
xpLangTag :: PU [Attribute] (Maybe LangTag)
xpLangTag = forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
xmlLang PU Text LangTag
xpLang

xpLang :: PU Text LangTag
xpLang :: PU Text LangTag
xpLang = (Text
"xpLang", Text
"") forall t a. (Text, Text) -> PU t a -> PU t a
<?>
    forall a b. (a -> Either Text b) -> (b -> a) -> PU a b
xpPartial ( \Text
input -> case Text -> Maybe LangTag
langTagFromText Text
input of
                               Maybe LangTag
Nothing -> forall a b. a -> Either a b
Left Text
"Could not parse language tag."
                               Just LangTag
j -> forall a b. b -> Either a b
Right LangTag
j)
              LangTag -> Text
langTagToText

xmlLang :: Name
xmlLang :: Name
xmlLang = Text -> Maybe Text -> Maybe Text -> Name
Name Text
"lang" (forall a. a -> Maybe a
Just Text
"http://www.w3.org/XML/1998/namespace") (forall a. a -> Maybe a
Just Text
"xml")

-- Given a pickler and an object, produces an Element.
pickleElem :: PU [Node] a -> a -> Element
pickleElem :: forall a. PU [Node] a -> a -> Element
pickleElem PU [Node] a
p = forall t a. PU t a -> a -> t
pickle forall a b. (a -> b) -> a -> b
$ forall a. PU [Node] a -> PU Element a
xpNodeElem PU [Node] a
p

-- Given a pickler and an element, produces an object.
unpickleElem :: PU [Node] a -> Element -> Either UnpickleError a
unpickleElem :: forall a. PU [Node] a -> Element -> Either UnpickleError a
unpickleElem PU [Node] a
p Element
x = forall t a. PU t a -> t -> Either UnpickleError a
unpickle (forall a. PU [Node] a -> PU Element a
xpNodeElem PU [Node] a
p) Element
x

xpNodeElem :: PU [Node] a -> PU Element a
xpNodeElem :: forall a. PU [Node] a -> PU Element a
xpNodeElem = forall a b. PU [a] b -> PU a b
xpRoot forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PU [Node] a -> PU [Element] a
xpUnliftElems

mbl :: Maybe [a] -> [a]
mbl :: forall a. Maybe [a] -> [a]
mbl (Just [a]
l) = [a]
l
mbl Maybe [a]
Nothing = []

lmb :: [t] -> Maybe [t]
lmb :: forall t. [t] -> Maybe [t]
lmb [] = forall a. Maybe a
Nothing
lmb [t]
x = forall a. a -> Maybe a
Just [t]
x

xpStream :: PU [Node] (Text, Maybe Jid, Maybe Jid, Maybe Text, Maybe LangTag)
xpStream :: PU [Node] (Text, Maybe Jid, Maybe Jid, Maybe Text, Maybe LangTag)
xpStream = forall b. Name -> PU [Attribute] b -> PU [Node] b
xpElemAttrs
    (Text -> Maybe Text -> Maybe Text -> Name
Name Text
"stream" (forall a. a -> Maybe a
Just Text
"http://etherx.jabber.org/streams") (forall a. a -> Maybe a
Just Text
"stream"))
    (forall a a1 a2 a3 a4 a5.
PU [a] a1
-> PU [a] a2
-> PU [a] a3
-> PU [a] a4
-> PU [a] a5
-> PU [a] (a1, a2, a3, a4, a5)
xp5Tuple
         (forall a. Name -> PU Text a -> PU [Attribute] a
xpAttr Name
"version" forall a. PU a a
xpId)
         (forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
"from" PU Text Jid
xpJid)
         (forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
"to" PU Text Jid
xpJid)
         (forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
"id" forall a. PU a a
xpId)
         PU [Attribute] (Maybe LangTag)
xpLangTag
    )

-- Pickler/Unpickler for the stream features - TLS, SASL, and the rest.
xpStreamFeatures :: PU [Node] StreamFeatures
xpStreamFeatures :: PU [Node] StreamFeatures
xpStreamFeatures = (Text
"xpStreamFeatures",Text
"") forall t a. (Text, Text) -> PU t a -> PU t a
<?> forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap
    (\(Maybe Bool
tls, Maybe [Text]
sasl, Maybe Bool
ver, Bool
preAppr, Maybe Bool
session, [Element]
rest)
       -> Maybe Bool
-> [Text]
-> Maybe Bool
-> Bool
-> Maybe Bool
-> [Element]
-> StreamFeatures
StreamFeatures Maybe Bool
tls (forall a. Maybe [a] -> [a]
mbl Maybe [Text]
sasl) Maybe Bool
ver Bool
preAppr Maybe Bool
session [Element]
rest )
    (\(StreamFeatures Maybe Bool
tls [Text]
sasl Maybe Bool
ver Bool
preAppr Maybe Bool
session [Element]
rest)
     -> (Maybe Bool
tls, forall t. [t] -> Maybe [t]
lmb [Text]
sasl, Maybe Bool
ver, Bool
preAppr, Maybe Bool
session, [Element]
rest))
    (forall b. Name -> PU [Node] b -> PU [Node] b
xpElemNodes
         (Text -> Maybe Text -> Maybe Text -> Name
Name
             Text
"features"
             (forall a. a -> Maybe a
Just Text
"http://etherx.jabber.org/streams")
             (forall a. a -> Maybe a
Just Text
"stream")
         )
         (forall a a1 a2 a3 a4 a5 a6.
PU [a] a1
-> PU [a] a2
-> PU [a] a3
-> PU [a] a4
-> PU [a] a5
-> PU [a] a6
-> PU [a] (a1, a2, a3, a4, a5, a6)
xp6Tuple
              (forall t a. PU [t] a -> PU [t] (Maybe a)
xpOption PU [Node] Bool
pickleTlsFeature)
              (forall t a. PU [t] a -> PU [t] (Maybe a)
xpOption PU [Node] [Text]
pickleSaslFeature)
              (forall t a. PU [t] a -> PU [t] (Maybe a)
xpOption PU [Node] Bool
pickleRosterVer)
              PU [Node] Bool
picklePreApproval
              (forall t a. PU [t] a -> PU [t] (Maybe a)
xpOption PU [Node] Bool
pickleSessionFeature)
              (forall a b. PU [a] b -> PU [a] [b]
xpAll PU [Node] Element
xpElemVerbatim)
         )
    )
  where
    pickleTlsFeature :: PU [Node] Bool
    pickleTlsFeature :: PU [Node] Bool
pickleTlsFeature = (Text
"pickleTlsFeature", Text
"") forall t a. (Text, Text) -> PU t a -> PU t a
<?>
        forall b. Name -> PU [Node] b -> PU [Node] b
xpElemNodes Name
"{urn:ietf:params:xml:ns:xmpp-tls}starttls"
        (Name -> PU [Node] Bool
xpElemExists Name
"{urn:ietf:params:xml:ns:xmpp-tls}required")
    pickleSaslFeature :: PU [Node] [Text]
    pickleSaslFeature :: PU [Node] [Text]
pickleSaslFeature = (Text
"pickleSaslFeature", Text
"") forall t a. (Text, Text) -> PU t a -> PU t a
<?>
        forall b. Name -> PU [Node] b -> PU [Node] b
xpElemNodes Name
"{urn:ietf:params:xml:ns:xmpp-sasl}mechanisms"
        (forall a b. PU [a] b -> PU [a] [b]
xpAll forall a b. (a -> b) -> a -> b
$ forall b. Name -> PU [Node] b -> PU [Node] b
xpElemNodes
             Name
"{urn:ietf:params:xml:ns:xmpp-sasl}mechanism" (forall a. PU Text a -> PU [Node] a
xpContent forall a. PU a a
xpId))
    pickleRosterVer :: PU [Node] Bool
pickleRosterVer = forall b. Name -> PU [Node] b -> PU [Node] b
xpElemNodes Name
"{urn:xmpp:features:rosterver}ver" forall a b. (a -> b) -> a -> b
$
                           Name -> PU [Node] Bool
xpElemExists Name
"{urn:xmpp:features:rosterver}optional"
    picklePreApproval :: PU [Node] Bool
picklePreApproval = Name -> PU [Node] Bool
xpElemExists Name
"{urn:xmpp:features:pre-approval}sub"
    pickleSessionFeature :: PU [Node] Bool
    pickleSessionFeature :: PU [Node] Bool
pickleSessionFeature = (Text
"pickleSessionFeature", Text
"") forall t a. (Text, Text) -> PU t a -> PU t a
<?>
        forall b. Name -> PU [Node] b -> PU [Node] b
xpElemNodes Name
"{urn:ietf:params:xml:ns:xmpp-session}session"
        (Name -> PU [Node] Bool
xpElemExists Name
"{urn:ietf:params:xml:ns:xmpp-session}optional")


xpJid :: PU Text Jid
xpJid :: PU Text Jid
xpJid = (Text
"xpJid", Text
"") forall t a. (Text, Text) -> PU t a -> PU t a
<?>
        forall a b. (a -> Either Text b) -> (b -> a) -> PU a b
xpPartial ( \Text
input -> case Text -> Maybe Jid
jidFromText Text
input of
                                   Maybe Jid
Nothing -> forall a b. a -> Either a b
Left Text
"Could not parse JID."
                                   Just Jid
j -> forall a b. b -> Either a b
Right Jid
j)
                  Jid -> Text
jidToText

xpIQRequestType :: PU Text IQRequestType
xpIQRequestType :: PU Text IQRequestType
xpIQRequestType = (Text
"xpIQRequestType", Text
"") forall t a. (Text, Text) -> PU t a -> PU t a
<?>
        forall a b. (a -> Either Text b) -> (b -> a) -> PU a b
xpPartial ( \Text
input -> case forall {a}. (Eq a, IsString a) => a -> Maybe IQRequestType
iqRequestTypeFromText Text
input of
                                   Maybe IQRequestType
Nothing -> forall a b. a -> Either a b
Left Text
"Could not parse IQ request type."
                                   Just IQRequestType
j -> forall a b. b -> Either a b
Right IQRequestType
j)
                  forall {a}. IsString a => IQRequestType -> a
iqRequestTypeToText
  where
    iqRequestTypeFromText :: a -> Maybe IQRequestType
iqRequestTypeFromText a
"get" = forall a. a -> Maybe a
Just IQRequestType
Get
    iqRequestTypeFromText a
"set" = forall a. a -> Maybe a
Just IQRequestType
Set
    iqRequestTypeFromText a
_ = forall a. Maybe a
Nothing
    iqRequestTypeToText :: IQRequestType -> a
iqRequestTypeToText IQRequestType
Get = a
"get"
    iqRequestTypeToText IQRequestType
Set = a
"set"

xpMessageType :: PU Text MessageType
xpMessageType :: PU Text MessageType
xpMessageType = (Text
"xpMessageType", Text
"") forall t a. (Text, Text) -> PU t a -> PU t a
<?>
        forall a b. (a -> b) -> (b -> a) -> PU a b
xpIso forall {a}. (Eq a, IsString a) => a -> MessageType
messageTypeFromText
              forall {a}. IsString a => MessageType -> a
messageTypeToText
  where
    messageTypeFromText :: a -> MessageType
messageTypeFromText a
"chat" = MessageType
Chat
    messageTypeFromText a
"groupchat" = MessageType
GroupChat
    messageTypeFromText a
"headline" = MessageType
Headline
    messageTypeFromText a
"normal" = MessageType
Normal
    messageTypeFromText a
_ = MessageType
Normal
    messageTypeToText :: MessageType -> a
messageTypeToText MessageType
Chat = a
"chat"
    messageTypeToText MessageType
GroupChat = a
"groupchat"
    messageTypeToText MessageType
Headline = a
"headline"
    messageTypeToText MessageType
Normal = a
"normal"

xpPresenceType :: PU Text PresenceType
xpPresenceType :: PU Text PresenceType
xpPresenceType = (Text
"xpPresenceType", Text
"") forall t a. (Text, Text) -> PU t a -> PU t a
<?>
        forall a b. (a -> Either Text b) -> (b -> a) -> PU a b
xpPartial ( \Text
input -> case forall {a}. (Eq a, IsString a) => a -> Maybe PresenceType
presenceTypeFromText Text
input of
                                   Maybe PresenceType
Nothing -> forall a b. a -> Either a b
Left Text
"Could not parse presence type."
                                   Just PresenceType
j -> forall a b. b -> Either a b
Right PresenceType
j)
                  forall {a}. IsString a => PresenceType -> a
presenceTypeToText
  where
    presenceTypeFromText :: a -> Maybe PresenceType
presenceTypeFromText a
"" = forall a. a -> Maybe a
Just PresenceType
Available
    presenceTypeFromText a
"available" = forall a. a -> Maybe a
Just PresenceType
Available
    presenceTypeFromText a
"unavailable" = forall a. a -> Maybe a
Just PresenceType
Unavailable
    presenceTypeFromText a
"subscribe" = forall a. a -> Maybe a
Just PresenceType
Subscribe
    presenceTypeFromText a
"subscribed" = forall a. a -> Maybe a
Just PresenceType
Subscribed
    presenceTypeFromText a
"unsubscribe" = forall a. a -> Maybe a
Just PresenceType
Unsubscribe
    presenceTypeFromText a
"unsubscribed" = forall a. a -> Maybe a
Just PresenceType
Unsubscribed
    presenceTypeFromText a
"probe" = forall a. a -> Maybe a
Just PresenceType
Probe
    presenceTypeFromText a
_ = forall a. Maybe a
Nothing
    presenceTypeToText :: PresenceType -> a
presenceTypeToText PresenceType
Available = a
"available"
    presenceTypeToText PresenceType
Unavailable = a
"unavailable"
    presenceTypeToText PresenceType
Subscribe = a
"subscribe"
    presenceTypeToText PresenceType
Subscribed = a
"subscribed"
    presenceTypeToText PresenceType
Unsubscribe = a
"unsubscribe"
    presenceTypeToText PresenceType
Unsubscribed = a
"unsubscribed"
    presenceTypeToText PresenceType
Probe = a
"probe"

xpStanzaErrorType :: PU Text StanzaErrorType
xpStanzaErrorType :: PU Text StanzaErrorType
xpStanzaErrorType = (Text
"xpStanzaErrorType", Text
"") forall t a. (Text, Text) -> PU t a -> PU t a
<?>
        forall a b. (a -> Either Text b) -> (b -> a) -> PU a b
xpPartial ( \Text
input -> case forall {a}. (Eq a, IsString a) => a -> Maybe StanzaErrorType
stanzaErrorTypeFromText Text
input of
                                   Maybe StanzaErrorType
Nothing -> forall a b. a -> Either a b
Left Text
"Could not parse stanza error type."
                                   Just StanzaErrorType
j -> forall a b. b -> Either a b
Right StanzaErrorType
j)
                  forall {a}. IsString a => StanzaErrorType -> a
stanzaErrorTypeToText
  where
    stanzaErrorTypeFromText :: a -> Maybe StanzaErrorType
stanzaErrorTypeFromText a
"auth" = forall a. a -> Maybe a
Just StanzaErrorType
Auth
    stanzaErrorTypeFromText a
"cancel" = forall a. a -> Maybe a
Just StanzaErrorType
Cancel
    stanzaErrorTypeFromText a
"continue" = forall a. a -> Maybe a
Just StanzaErrorType
Continue
    stanzaErrorTypeFromText a
"modify" = forall a. a -> Maybe a
Just StanzaErrorType
Modify
    stanzaErrorTypeFromText a
"wait" = forall a. a -> Maybe a
Just StanzaErrorType
Wait
    stanzaErrorTypeFromText a
_ = forall a. Maybe a
Nothing
    stanzaErrorTypeToText :: StanzaErrorType -> a
stanzaErrorTypeToText StanzaErrorType
Auth = a
"auth"
    stanzaErrorTypeToText StanzaErrorType
Cancel = a
"cancel"
    stanzaErrorTypeToText StanzaErrorType
Continue = a
"continue"
    stanzaErrorTypeToText StanzaErrorType
Modify = a
"modify"
    stanzaErrorTypeToText StanzaErrorType
Wait = a
"wait"


xpStreamErrorCondition :: PU Text StreamErrorCondition
xpStreamErrorCondition :: PU Text StreamErrorCondition
xpStreamErrorCondition = (Text
"xpStreamErrorCondition", Text
"") forall t a. (Text, Text) -> PU t a -> PU t a
<?>
        forall a b. (a -> b) -> (b -> a) -> PU a b
xpIso forall {a}. (Eq a, IsString a) => a -> StreamErrorCondition
streamErrorConditionFromText
              forall {a}. IsString a => StreamErrorCondition -> a
streamErrorConditionToText
  where
    streamErrorConditionToText :: StreamErrorCondition -> a
streamErrorConditionToText StreamErrorCondition
StreamBadFormat              = a
"bad-format"
    streamErrorConditionToText StreamErrorCondition
StreamBadNamespacePrefix     = a
"bad-namespace-prefix"
    streamErrorConditionToText StreamErrorCondition
StreamConflict               = a
"conflict"
    streamErrorConditionToText StreamErrorCondition
StreamConnectionTimeout      = a
"connection-timeout"
    streamErrorConditionToText StreamErrorCondition
StreamHostGone               = a
"host-gone"
    streamErrorConditionToText StreamErrorCondition
StreamHostUnknown            = a
"host-unknown"
    streamErrorConditionToText StreamErrorCondition
StreamImproperAddressing     = a
"improper-addressing"
    streamErrorConditionToText StreamErrorCondition
StreamInternalServerError    = a
"internal-server-error"
    streamErrorConditionToText StreamErrorCondition
StreamInvalidFrom            = a
"invalid-from"
    streamErrorConditionToText StreamErrorCondition
StreamInvalidNamespace       = a
"invalid-namespace"
    streamErrorConditionToText StreamErrorCondition
StreamInvalidXml             = a
"invalid-xml"
    streamErrorConditionToText StreamErrorCondition
StreamNotAuthorized          = a
"not-authorized"
    streamErrorConditionToText StreamErrorCondition
StreamNotWellFormed          = a
"not-well-formed"
    streamErrorConditionToText StreamErrorCondition
StreamPolicyViolation        = a
"policy-violation"
    streamErrorConditionToText StreamErrorCondition
StreamRemoteConnectionFailed = a
"remote-connection-failed"
    streamErrorConditionToText StreamErrorCondition
StreamReset                  = a
"reset"
    streamErrorConditionToText StreamErrorCondition
StreamResourceConstraint     = a
"resource-constraint"
    streamErrorConditionToText StreamErrorCondition
StreamRestrictedXml          = a
"restricted-xml"
    streamErrorConditionToText StreamErrorCondition
StreamSeeOtherHost           = a
"see-other-host"
    streamErrorConditionToText StreamErrorCondition
StreamSystemShutdown         = a
"system-shutdown"
    streamErrorConditionToText StreamErrorCondition
StreamUndefinedCondition     = a
"undefined-condition"
    streamErrorConditionToText StreamErrorCondition
StreamUnsupportedEncoding    = a
"unsupported-encoding"
    streamErrorConditionToText StreamErrorCondition
StreamUnsupportedFeature     = a
"unsupported-feature"
    streamErrorConditionToText StreamErrorCondition
StreamUnsupportedStanzaType  = a
"unsupported-stanza-type"
    streamErrorConditionToText StreamErrorCondition
StreamUnsupportedVersion     = a
"unsupported-version"
    streamErrorConditionFromText :: a -> StreamErrorCondition
streamErrorConditionFromText a
"bad-format" = StreamErrorCondition
StreamBadFormat
    streamErrorConditionFromText a
"bad-namespace-prefix" = StreamErrorCondition
StreamBadNamespacePrefix
    streamErrorConditionFromText a
"conflict" = StreamErrorCondition
StreamConflict
    streamErrorConditionFromText a
"connection-timeout" = StreamErrorCondition
StreamConnectionTimeout
    streamErrorConditionFromText a
"host-gone" = StreamErrorCondition
StreamHostGone
    streamErrorConditionFromText a
"host-unknown" = StreamErrorCondition
StreamHostUnknown
    streamErrorConditionFromText a
"improper-addressing" = StreamErrorCondition
StreamImproperAddressing
    streamErrorConditionFromText a
"internal-server-error" = StreamErrorCondition
StreamInternalServerError
    streamErrorConditionFromText a
"invalid-from" = StreamErrorCondition
StreamInvalidFrom
    streamErrorConditionFromText a
"invalid-namespace" = StreamErrorCondition
StreamInvalidNamespace
    streamErrorConditionFromText a
"invalid-xml" = StreamErrorCondition
StreamInvalidXml
    streamErrorConditionFromText a
"not-authorized" = StreamErrorCondition
StreamNotAuthorized
    streamErrorConditionFromText a
"not-well-formed" = StreamErrorCondition
StreamNotWellFormed
    streamErrorConditionFromText a
"policy-violation" = StreamErrorCondition
StreamPolicyViolation
    streamErrorConditionFromText a
"remote-connection-failed" = StreamErrorCondition
StreamRemoteConnectionFailed
    streamErrorConditionFromText a
"reset" = StreamErrorCondition
StreamReset
    streamErrorConditionFromText a
"resource-constraint" = StreamErrorCondition
StreamResourceConstraint
    streamErrorConditionFromText a
"restricted-xml" = StreamErrorCondition
StreamRestrictedXml
    streamErrorConditionFromText a
"see-other-host" = StreamErrorCondition
StreamSeeOtherHost
    streamErrorConditionFromText a
"system-shutdown" = StreamErrorCondition
StreamSystemShutdown
    streamErrorConditionFromText a
"undefined-condition" = StreamErrorCondition
StreamUndefinedCondition
    streamErrorConditionFromText a
"unsupported-encoding" = StreamErrorCondition
StreamUnsupportedEncoding
    streamErrorConditionFromText a
"unsupported-feature" = StreamErrorCondition
StreamUnsupportedFeature
    streamErrorConditionFromText a
"unsupported-stanza-type" = StreamErrorCondition
StreamUnsupportedStanzaType
    streamErrorConditionFromText a
"unsupported-version" = StreamErrorCondition
StreamUnsupportedVersion
    streamErrorConditionFromText a
_ = StreamErrorCondition
StreamUndefinedCondition -- §4.9.2