1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
|
{-# LANGUAGE FlexibleInstances #-}
module Stanza.Type where
import Control.Concurrent.STM
import Data.Int
import Data.Text
import Data.XML.Types as XML
import Connection (PeerAddress(..))
import ConnectionKey (ClientAddress(..))
import LockedChan
import Nesting (Lang)
type Stanza = StanzaWrap (LockedChan XML.Event)
data StanzaWrap a = Stanza
{ stanzaType :: StanzaType
, stanzaId :: Maybe Text
, stanzaTo :: Maybe Text
, stanzaFrom :: Maybe Text
, stanzaChan :: a
, stanzaClosers :: TVar (Maybe [XML.Event])
, stanzaInterrupt :: TMVar ()
, stanzaOrigin :: StanzaOrigin
}
data StanzaOrigin = LocalPeer
| PeerOrigin PeerAddress (TChan Stanza)
| ClientOrigin ClientAddress (TChan Stanza)
data StanzaType
= Unrecognized
| Ping
| Pong
| RequestResource (Maybe Text) (Maybe Text) -- ^ Client's name for this host followed by client's requested resource id.
| SetResource
| SessionRequest
| UnrecognizedQuery Name
| RequestRoster
| Roster
| RosterEvent { rosterEventType :: RosterEventType
, rosterUser :: Text
, rosterContact :: Text }
| Error StanzaError XML.Event
| PresenceStatus { presenceShow :: JabberShow
, presencePriority :: Maybe Int8
, presenceStatus :: [(Lang,Text)]
, presenceWhiteList :: [Text]
}
| PresenceInformError
| PresenceInformSubscription Bool
| PresenceRequestStatus
| PresenceRequestSubscription Bool
| Message { msgThread :: Maybe MessageThread
, msgLangMap :: [(Lang,LangSpecificMessage)]
}
| NotifyClientVersion { versionName :: Text
, versionVersion :: Text }
| InternalEnableHack ClientHack
| InternalCacheId Text
deriving (Show,Eq)
data RosterEventType
= RequestedSubscription
| NewBuddy -- preceded by PresenceInformSubscription True
| RemovedBuddy -- preceded by PresenceInformSubscription False
| PendingSubscriber -- same as PresenceRequestSubscription
| NewSubscriber
| RejectSubscriber
deriving (Show,Read,Ord,Eq,Enum)
data ClientHack = SimulatedChatErrors
deriving (Show,Read,Ord,Eq,Enum)
data LangSpecificMessage =
LangSpecificMessage { msgBody :: Maybe Text
, msgSubject :: Maybe Text
}
deriving (Show,Eq)
data MessageThread = MessageThread {
msgThreadParent :: Maybe Text,
msgThreadContent :: Text
}
deriving (Show,Eq)
data JabberShow = Offline
| ExtendedAway
| Away
| DoNotDisturb
| Available
| Chatty
deriving (Show,Enum,Ord,Eq,Read)
class StanzaFirstTag a where
stanzaFirstTag :: StanzaWrap a -> IO XML.Event
instance StanzaFirstTag (TChan XML.Event) where
stanzaFirstTag stanza = do
e <-atomically $ peekTChan (stanzaChan stanza)
return e
instance StanzaFirstTag (LockedChan XML.Event) where
stanzaFirstTag stanza = do
e <-atomically $ peekLChan (stanzaChan stanza)
return e
instance StanzaFirstTag XML.Event where
stanzaFirstTag stanza = return (stanzaChan stanza)
data StanzaError
= BadRequest
| Conflict
| FeatureNotImplemented
| Forbidden
| Gone
| InternalServerError
| ItemNotFound
| JidMalformed
| NotAcceptable
| NotAllowed
| NotAuthorized
| PaymentRequired
| RecipientUnavailable
| Redirect
| RegistrationRequired
| RemoteServerNotFound
| RemoteServerTimeout
| ResourceConstraint
| ServiceUnavailable
| SubscriptionRequired
| UndefinedCondition
| UnexpectedRequest
deriving (Show,Enum,Ord,Eq)
xep0086 :: StanzaError -> (Text, Int)
xep0086 e = case e of
BadRequest -> ("modify", 400)
Conflict -> ("cancel", 409)
FeatureNotImplemented -> ("cancel", 501)
Forbidden -> ("auth", 403)
Gone -> ("modify", 302)
InternalServerError -> ("wait", 500)
ItemNotFound -> ("cancel", 404)
JidMalformed -> ("modify", 400)
NotAcceptable -> ("modify", 406)
NotAllowed -> ("cancel", 405)
NotAuthorized -> ("auth", 401)
PaymentRequired -> ("auth", 402)
RecipientUnavailable -> ("wait", 404)
Redirect -> ("modify", 302)
RegistrationRequired -> ("auth", 407)
RemoteServerNotFound -> ("cancel", 404)
RemoteServerTimeout -> ("wait", 504)
ResourceConstraint -> ("wait", 500)
ServiceUnavailable -> ("cancel", 503)
SubscriptionRequired -> ("auth", 407)
UndefinedCondition -> ("", 500)
UnexpectedRequest -> ("wait", 400)
errorText :: StanzaError -> Text
errorText e = case e of
BadRequest -> "Bad request"
Conflict -> "Conflict"
FeatureNotImplemented -> "This feature is not implemented"
Forbidden -> "Forbidden"
Gone -> "Recipient can no longer be contacted"
InternalServerError -> "Internal server error"
ItemNotFound -> "Item not found"
JidMalformed -> "JID Malformed"
NotAcceptable -> "Message was rejected"
NotAllowed -> "Not allowed"
NotAuthorized -> "Not authorized"
PaymentRequired -> "Payment is required"
RecipientUnavailable -> "Recipient is unavailable"
Redirect -> "Redirect"
RegistrationRequired -> "Registration required"
RemoteServerNotFound -> "Recipient's server not found"
RemoteServerTimeout -> "Remote server timeout"
ResourceConstraint -> "The server is low on resources"
ServiceUnavailable -> "The service is unavailable"
SubscriptionRequired -> "A subscription is required"
UndefinedCondition -> "Undefined condition"
UnexpectedRequest -> "Unexpected request"
|
