1 files changed, 184 insertions, 0 deletions

diff --git a/Presence/Stanza/Types.hs b/Presence/Stanza/Types.hs
new file mode 100644
index 00000000..6b402f4d
--- /dev/null
+++ b/Presence/Stanza/Types.hs
@@ -0,0 +1,184 @@
+{-# LANGUAGE FlexibleInstances #-}
+module Stanza.Types 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"
+