XMPP 0.1.1 → 0.1.2

raw patch · 5 files changed

+114/−42 lines, 5 filesdep ~parsecPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: parsec

API changes (from Hackage documentation)

Files

• Network/XMPP/JID.hs +3/−0
• Network/XMPP/MUC.hs +76/−19
• Network/XMPP/Roster.hs +16/−11
• Network/XMPP/Stanzas.hs +17/−10
• XMPP.cabal +2/−2

@@ -1,5 +1,8 @@ module Network.XMPP.JID where +-- TODO: do type alias for jid?+-- type JID = String+ -- |Get username part of JID, i.e. the part before the \@ sign. -- Return @\"\"@ if the JID contains no \@ sign. getUsername :: String -> String

@@ -57,49 +57,85 @@                     ("type","chat")]                    [XML "body" [] [CData body]] ---- Subject  getMessageSubject :: XMLElem -> Maybe String getMessageSubject =-    getCdata . maybe (XML [] [] []) id . xmlPath ["subject"]+    cdata' . xmlPath ["subject"] ---- Occupants+setGroupchatSubject :: String -- ^JID of chat room+                    -> String -- ^Subject+                    -> XMPP ()+setGroupchatSubject room subject =+    sendStanza $ XML "message"+                   [("to",room),("type","groupchat")]+                   [XML "subject" [] [CData subject]] --- | Occupant data strucuture.++-- |Groupchat occupant. data Occupant   = Occupant     { occRole :: Role     , occAffiliation :: Affiliation     , occNick :: String     , occJid :: Maybe String+    , occStatus :: Status     }  data Role = RModerator | RParticipant | RNone | RVisitor-data Affiliation = AOwner | AAdmin | AMember | ANone+          deriving (Eq, Show)+data Affiliation = AOwner | AAdmin | AMember | ANone | AOutcast+                 deriving (Eq, Show) --- | Create occupant from stanza.--- TODO: kick/ban/change status//change nick/etc parse-doOccupant :: XMLElem -> Occupant-doOccupant stanza =-    Occupant role aff nick jid+-- |Groupchat presence. Leave, Kick and Ban are role change too of+-- course, but it separated for simplicity sake.+data GroupchatPresence+    = Leave+    | Kick (Maybe String) -- ^Kick reason+    | Ban (Maybe String) -- ^Ban reason+    | NickChange String -- ^New nick+    | RoleChange (Maybe String) -- ^Role change (also show/status+                                -- change) with reason.++-- |Create groupchat presence from stanza.+doGroupchatPresence :: XMLElem -> (GroupchatPresence, Occupant)+doGroupchatPresence stanza =+    (presence, Occupant role aff nick jid status)   where     items = xmlPath' ["x", "item"] [stanza]     item | length items == 0 = XML [] [] []          | otherwise         = head items     role = case getAttr "role" item of-             Just "moderator"   -> RModerator-             Just "participant" -> RParticipant-             Just "visitor"     -> RVisitor-             _                  -> RNone+      Just "moderator"   -> RModerator+      Just "participant" -> RParticipant+      Just "visitor"     -> RVisitor+      _                  -> RNone     aff = case getAttr "affiliation" item of-            Just "owner"  -> AOwner-            Just "admin"  -> AAdmin-            Just "member" -> AMember-            _             -> ANone+      Just "owner"   -> AOwner+      Just "admin"   -> AAdmin+      Just "member"  -> AMember+      Just "outcast" -> AOutcast+      _              -> ANone+    presence = case getAttr "type" stanza of+      Just "unavailable" -> off_presence+      -- TODO: type=error?+      _                  -> RoleChange reason+    off_presence = case status_code of+      Just "301" -> Ban reason+      Just "303" -> NickChange new_nick+      Just "307" -> Kick reason+      -- TODO: parse more status codes?+      _          -> Leave+    reason = cdata' $ xmlPath ["reason"] item+    status = doStatus stanza     nick = snd $ getJidRes stanza+    new_nick = maybe "" id $ getAttr "nick" item     jid = getAttr "jid" item+    status_node = xmlPath' ["x", "status"] [stanza]+    status_code | length status_node == 0 = Nothing+                | otherwise               = getAttr "code"+                                            $ head status_node --- | Handler for groupchat events (join/leave/kicks/bans/etc).+-- |Handler for groupchat events (join/leave/kicks/bans/etc). isGroupchatPresence :: StanzaPredicate isGroupchatPresence stanza =     (isPresence stanza) && (not $ null xs')@@ -108,3 +144,24 @@     xs' = filter             (attributeMatches "xmlns" (=="http://jabber.org/protocol/muc#user"))             xs+++type Nick = String+type JID = String+-- |Do admin actions in groupchat.+adminGroupchat :: Either Nick JID -- ^Nickname or JID+               -> String -- ^JID of chat room+               -> String -- ^Role or affiliation argument+               -> (Maybe String) -- ^Reason+               -> XMPP ()+adminGroupchat nickOrJid room arg mReason =+    sendIq room "set"+               [XML "query"+                        [("xmlns","http://jabber.org/protocol/muc#admin")]+                        [item]]+    >> return ()+  where+    item = case nickOrJid of+             Left nick -> XML "item" [("nick",nick),("role",arg)] reason+             Right jid -> XML "item" [("jid",jid),("affiliation",arg)] reason+    reason = maybe [] (\r -> [XML "reason" [] [CData r]]) mReason

@@ -5,7 +5,8 @@     Presence(..),     Status(..),     StatusType(..),-    doPresence+    doPresence,+    doStatus ) where  import Network.XMPP.XMPPMonad@@ -61,6 +62,7 @@               | Probe               | Error +-- | TODO: xml:lang for multiple statuses. data Status = Status StatusType [String]  data StatusType = StatusOnline@@ -75,15 +77,9 @@ doPresence :: XMLElem -> Presence doPresence stanza =     let stanzaType = getAttr "type" stanza-        statuses = map cdata $ xmlPath' ["status"] [stanza]-        statusType = case cdata' $ xmlPath ["show"] stanza of-                       Just "away" -> StatusAway-                       Just "chat" -> StatusChat-                       Just "dnd" -> StatusDND-                       Just "xa" -> StatusXA-                       _ -> StatusOnline+        status@(Status _ statuses) = doStatus stanza     in case stanzaType of-         Nothing -> Available (Status statusType statuses)+         Nothing -> Available status          Just "unavailable" -> Unavailable (Status StatusOffline statuses)          Just "subscribe" -> Subscribe          Just "subscribed" -> Subscribed@@ -93,5 +89,14 @@          Just "error" -> Error          _ -> Error -----cdata' = getCdata . maybe (XML "" [] []) id+-- | Read stanza status.+doStatus :: XMLElem -> Status+doStatus stanza = Status statusType statuses+  where+    statuses = map cdata $ xmlPath' ["status"] [stanza]+    statusType = case cdata' $ xmlPath ["show"] stanza of+                   Just "away" -> StatusAway+                   Just "chat" -> StatusChat+                   Just "dnd" -> StatusDND+                   Just "xa" -> StatusXA+                   _ -> StatusOnline

@@ -15,12 +15,15 @@                , iqXmlns                , iqGet                , iqSet+               , iqError+               , iqResult                , handleVersion                , getErrorCode                , hasNodeName                , getMessageStamp                , getJidRes                , cdata+               , cdata'                )     where @@ -108,15 +111,6 @@ --- Presence  -- |Send ordinary online presence.--- If status is not ommited, then it should be one of the valid "show"--- instances of the RFC3921 (first String in tuple), and if there--- should be description of the status (status text) then the second--- parameter in the tuple must be defined.--- TODO: xml:lang--- "The <status/> element MUST NOT possess any attributes, with the--- exception of the 'xml:lang' attribute. Multiple instances of the--- <status/> element MAY be included but only if each instance--- possesses an 'xml:lang' attribute with a distinct language value." sendPresence :: Maybe (String, [String]) -> Maybe Integer -> XMPP () sendPresence status priority =     sendStanza $ XML "presence" [] (status'++priority')@@ -168,6 +162,7 @@ isFrom jid = attributeMatches "from" (==jid)  -- |Return true if the stanza is an IQ stanza in the given namespace.+-- FIXME: query node not nessesary the first node in the iq stanza. iqXmlns :: String -> StanzaPredicate iqXmlns xmlns (XML "iq" _ els) =     case listToMaybe [x | x <- els, case x of@@ -187,6 +182,14 @@ iqSet :: String -> StanzaPredicate iqSet xmlns = (attributeMatches "type" (=="set")) `conj` (iqXmlns xmlns) +-- |Return true if the stanza is a \"error\" request in the given namespace.+iqError :: String -> StanzaPredicate+iqError xmlns = (attributeMatches "type" (=="error")) `conj` (iqXmlns xmlns)++-- |Return true if the stanza is a \"result\" request in the given namespace.+iqResult :: String -> StanzaPredicate+iqResult xmlns = (attributeMatches "type" (=="result")) `conj` (iqXmlns xmlns)+ --- Handlers for common requests  -- |Establish a handler for answering to version requests with the@@ -233,6 +236,10 @@     let sender = maybe "" id (getAttr "from" stanza)     in (getBareJid sender, getResource sender) --- |Small helper function.+-- |Get cdata from xmlelem. cdata :: XMLElem -> String cdata = maybe "" id . getCdata++-- |Get maybe cdata from maybe xmlelem.+cdata' :: Maybe XMLElem -> Maybe String+cdata' = getCdata . maybe (XML [] [] []) id

@@ -1,5 +1,5 @@ Name:                XMPP-Version:             0.1.1+Version:             0.1.2 Synopsis:            XMPP library Category:            Network Description:         XMPP library@@ -25,4 +25,4 @@                      Network.XMPP.Roster    Build-depends:     base >= 4.0 && < 5, haskell98, random, utf8-string,-                     network, parsec, mtl, hsdns >= 1.4.1+                     network, parsec >= 2.0 && < 3, mtl, hsdns >= 1.4.1