summaryrefslogtreecommitdiff
path: root/Presence/Stanza/Types.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Presence/Stanza/Types.hs')
-rw-r--r--Presence/Stanza/Types.hs257
1 files changed, 0 insertions, 257 deletions
diff --git a/Presence/Stanza/Types.hs b/Presence/Stanza/Types.hs
deleted file mode 100644
index 7275c8ab..00000000
--- a/Presence/Stanza/Types.hs
+++ /dev/null
@@ -1,257 +0,0 @@
1{-# LANGUAGE FlexibleInstances #-}
2module Stanza.Types where
3
4import Control.Concurrent.STM
5import Data.Int
6import Data.Text
7import Data.XML.Types as XML
8
9import Connection (PeerAddress(..))
10import ConnectionKey (ClientAddress(..))
11import LockedChan
12import Nesting (Lang)
13
14type Stanza = StanzaWrap (LockedChan XML.Event)
15
16data StanzaWrap a = Stanza
17 { stanzaType :: StanzaType
18 , stanzaId :: Maybe Text
19 , stanzaTo :: Maybe Text
20 , stanzaFrom :: Maybe Text
21 , stanzaChan :: a
22 , stanzaClosers :: TVar (Maybe [XML.Event])
23 , stanzaInterrupt :: TMVar ()
24 , stanzaOrigin :: StanzaOrigin
25 }
26
27data StanzaOrigin = LocalPeer
28 | PeerOrigin PeerAddress (TChan Stanza)
29 | ClientOrigin ClientAddress (TChan Stanza)
30
31data StanzaType
32 = Unrecognized
33 | Ping
34 | Pong
35 | RequestResource (Maybe Text) (Maybe Text) -- ^ Client's name for this host followed by client's requested resource id.
36 | SetResource
37 | RequestItems (Maybe Text)
38 | Items
39 | RequestInfo (Maybe Text)
40 | Info
41 | SessionRequest
42 | UnrecognizedQuery Name
43 | RequestRoster
44 | Roster
45 | RosterEvent { rosterEventType :: RosterEventType
46 , rosterUser :: Text
47 , rosterContact :: Text }
48 | Error StanzaError XML.Event
49 | PresenceStatus { presenceShow :: JabberShow
50 , presencePriority :: Maybe Int8
51 , presenceStatus :: [(Lang,Text)]
52 , presenceWhiteList :: [Text]
53 -- ^ A custom extension extension we are using. When a
54 -- peer answers a presence probe, it also communicates
55 -- to the remote peer which remote users it believes
56 -- are subscribed to that presence.
57 --
58 -- This is communicated via a space-delimited list in
59 -- the nonstandard "whitelist" attribute for a
60 -- <{jabber:server}presence> tag.
61 --
62 -- TODO: Use this to update the buddies file so that a
63 -- client is made aware when a subscription was
64 -- canceled.
65 }
66
67 | PresenceInformError
68 | PresenceInformSubscription Bool
69 | PresenceRequestStatus
70 | PresenceRequestSubscription Bool
71 | Message { msgThread :: Maybe MessageThread
72 , msgLangMap :: [(Lang,LangSpecificMessage)]
73 , msgType :: MessageType
74 }
75 | NotifyClientVersion { versionName :: Text
76 , versionVersion :: Text }
77 | InternalEnableHack ClientHack
78 | InternalCacheId Text
79 deriving (Show,Eq)
80
81data MessageType
82 = NormalMsg -- ^ The message is a standalone message that is sent outside
83 -- the context of a one-to-one conversation or groupchat, and
84 -- to which it is expected that the recipient will reply.
85 -- Typically a receiving client will present a message of type
86 -- "normal" in an interface that enables the recipient to
87 -- reply, but without a conversation history. The default
88 -- value of the 'type' attribute is "normal".
89
90 | ChatMsg -- ^ The message is sent in the context of a one-to-one chat
91 -- session. Typically an interactive client will present a
92 -- message of type "chat" in an interface that enables one-to-one
93 -- chat between the two parties, including an appropriate
94 -- conversation history. Detailed recommendations regarding
95 -- one-to-one chat sessions are provided under Section 5.1.
96
97 | GroupChatMsg -- ^ The message is sent in the context of a multi-user chat
98 -- environment (similar to that of [IRC]). Typically a
99 -- receiving client will present a message of type
100 -- "groupchat" in an interface that enables many-to-many
101 -- chat between the parties, including a roster of parties
102 -- in the chatroom and an appropriate conversation history.
103 -- For detailed information about XMPP-based groupchat,
104 -- refer to [XEP‑0045].
105
106 | HeadlineMsg -- ^ The message provides an alert, a notification, or other
107 -- transient information to which no reply is expected (e.g.,
108 -- news headlines, sports updates, near-real-time market
109 -- data, or syndicated content). Because no reply to the
110 -- message is expected, typically a receiving client will
111 -- present a message of type "headline" in an interface that
112 -- appropriately differentiates the message from standalone
113 -- messages, chat messages, and groupchat messages (e.g., by
114 -- not providing the recipient with the ability to reply). If
115 -- the 'to' address is the bare JID, the receiving server
116 -- SHOULD deliver the message to all of the recipient's
117 -- available resources with non-negative presence priority
118 -- and MUST deliver the message to at least one of those
119 -- resources; if the 'to' address is a full JID and there is
120 -- a matching resource, the server MUST deliver the message
121 -- to that resource; otherwise the server MUST either
122 -- silently ignore the message or return an error (see
123 -- Section 8).
124
125 -- | ErrorMsg -- The message is generated by an entity that experiences an
126 -- error when processing a message received from another entity (for
127 -- details regarding stanza error syntax, refer to [XMPP‑CORE]). A client
128 -- that receives a message of type "error" SHOULD present an appropriate
129 -- interface informing the original sender regarding the nature of the
130 -- error.
131
132 deriving (Show,Read,Ord,Eq,Enum)
133
134
135data RosterEventType
136 = RequestedSubscription
137 | NewBuddy -- preceded by PresenceInformSubscription True
138 | RemovedBuddy -- preceded by PresenceInformSubscription False
139 | PendingSubscriber -- same as PresenceRequestSubscription
140 | NewSubscriber
141 | RejectSubscriber
142 deriving (Show,Read,Ord,Eq,Enum)
143
144data ClientHack = SimulatedChatErrors
145 deriving (Show,Read,Ord,Eq,Enum)
146
147
148data LangSpecificMessage =
149 LangSpecificMessage { msgBody :: Maybe Text
150 , msgSubject :: Maybe Text
151 }
152 deriving (Show,Eq)
153
154data MessageThread = MessageThread {
155 msgThreadParent :: Maybe Text,
156 msgThreadContent :: Text
157 }
158 deriving (Show,Eq)
159
160
161data JabberShow = Offline
162 | ExtendedAway
163 | Away
164 | DoNotDisturb
165 | Available
166 | Chatty
167 deriving (Show,Enum,Ord,Eq,Read)
168
169class StanzaFirstTag a where
170 -- Peek at the stanza open tag.
171 stanzaFirstTag :: StanzaWrap a -> IO XML.Event
172instance StanzaFirstTag (TChan XML.Event) where
173 stanzaFirstTag stanza = do
174 e <-atomically $ peekTChan (stanzaChan stanza)
175 return e
176instance StanzaFirstTag (LockedChan XML.Event) where
177 stanzaFirstTag stanza = do
178 e <-atomically $ peekLChan (stanzaChan stanza)
179 return e
180instance StanzaFirstTag XML.Event where
181 stanzaFirstTag stanza = return (stanzaChan stanza)
182
183data StanzaError
184 = BadRequest
185 | Conflict
186 | FeatureNotImplemented
187 | Forbidden
188 | Gone
189 | InternalServerError
190 | ItemNotFound
191 | JidMalformed
192 | NotAcceptable
193 | NotAllowed
194 | NotAuthorized
195 | PaymentRequired
196 | RecipientUnavailable
197 | Redirect
198 | RegistrationRequired
199 | RemoteServerNotFound
200 | RemoteServerTimeout
201 | ResourceConstraint
202 | ServiceUnavailable
203 | SubscriptionRequired
204 | UndefinedCondition
205 | UnexpectedRequest
206 deriving (Show,Enum,Ord,Eq)
207
208xep0086 :: StanzaError -> (Text, Int)
209xep0086 e = case e of
210 BadRequest -> ("modify", 400)
211 Conflict -> ("cancel", 409)
212 FeatureNotImplemented -> ("cancel", 501)
213 Forbidden -> ("auth", 403)
214 Gone -> ("modify", 302)
215 InternalServerError -> ("wait", 500)
216 ItemNotFound -> ("cancel", 404)
217 JidMalformed -> ("modify", 400)
218 NotAcceptable -> ("modify", 406)
219 NotAllowed -> ("cancel", 405)
220 NotAuthorized -> ("auth", 401)
221 PaymentRequired -> ("auth", 402)
222 RecipientUnavailable -> ("wait", 404)
223 Redirect -> ("modify", 302)
224 RegistrationRequired -> ("auth", 407)
225 RemoteServerNotFound -> ("cancel", 404)
226 RemoteServerTimeout -> ("wait", 504)
227 ResourceConstraint -> ("wait", 500)
228 ServiceUnavailable -> ("cancel", 503)
229 SubscriptionRequired -> ("auth", 407)
230 UndefinedCondition -> ("", 500)
231 UnexpectedRequest -> ("wait", 400)
232
233errorText :: StanzaError -> Text
234errorText e = case e of
235 BadRequest -> "Bad request"
236 Conflict -> "Conflict"
237 FeatureNotImplemented -> "This feature is not implemented"
238 Forbidden -> "Forbidden"
239 Gone -> "Recipient can no longer be contacted"
240 InternalServerError -> "Internal server error"
241 ItemNotFound -> "Item not found"
242 JidMalformed -> "JID Malformed"
243 NotAcceptable -> "Message was rejected"
244 NotAllowed -> "Not allowed"
245 NotAuthorized -> "Not authorized"
246 PaymentRequired -> "Payment is required"
247 RecipientUnavailable -> "Recipient is unavailable"
248 Redirect -> "Redirect"
249 RegistrationRequired -> "Registration required"
250 RemoteServerNotFound -> "Recipient's server not found"
251 RemoteServerTimeout -> "Remote server timeout"
252 ResourceConstraint -> "The server is low on resources"
253 ServiceUnavailable -> "The service is unavailable"
254 SubscriptionRequired -> "A subscription is required"
255 UndefinedCondition -> "Undefined condition"
256 UnexpectedRequest -> "Unexpected request"
257
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 16:02:15 +0000