XMPP 0.0.3 → 0.0.4

raw patch · 8 files changed

+141/−24 lines, 8 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Network/XMPP.hs +4/−4
• Network/XMPP/Auth.hs +1/−2
• Network/XMPP/Presence.hs +53/−0
• Network/XMPP/Roster.hs +41/−0
• Network/XMPP/Stanzas.hs +26/−2
• Network/XMPP/XMLParse.hs +10/−11
• Network/XMPP/XMPPMonad.hs +3/−3
• XMPP.cabal +3/−2

@@ -3,27 +3,27 @@ -- -- > import Network -- > import Network.XMPP--- > +-- > -- > -- The bot's JID is "bot@example.com" -- > botUsername = "bot" -- > botServer = "example.com" -- > botPassword = "secret" -- > botResource = "bot"--- > +-- > -- > main :: IO () -- > main = withSocketsDo $ -- >   do -- >     -- Connect to server... -- >     c <- openStream botServer -- >     getStreamStart c--- > +-- > -- >     runXMPP c $ do -- >       -- ...authenticate... -- >       startAuth botUsername botServer botPassword botResource -- >       sendpresence -- >       -- ...and do something. -- >       run--- > +-- > -- > run :: XMPP () -- > run = do -- >   -- Wait for an incoming message...

@@ -10,9 +10,8 @@           -> String             -- ^Server (part after \@ in JID)           -> String             -- ^Password           -> String             -- ^Resource (unique identifier for this connection)-          -> Integer            -- ^Resource priority           -> XMPP Integer       -- ^Error number. Zero if authentication succeeded.-startAuth username server password resource priority = do+startAuth username server password resource = do   response <- sendIqWait server "get" [XML "query"                                        [("xmlns","jabber:iq:auth")]                                        [XML "username"

@@ -0,0 +1,53 @@+module Network.XMPP.Presence (+    Presence(..),+    Status(..),+    StatusType(..),+    doPresence+) where++import Network.XMPP+++data Presence = Available Status+              | Unavailable Status+              | Subscribe+              | Subscribed+              | Unsubscribe+              | Unsubscribed+              | Probe+              | Error++data Status = Status StatusType [String]++data StatusType = StatusOnline+                | StatusAway+                | StatusChat+                | StatusDND+                | StatusXA+                | StatusOffline+++-- | Parse presence stanza.+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+    in case stanzaType of+         Nothing -> Available (Status statusType statuses)+         Just "unavailable" -> Unavailable (Status StatusOffline statuses)+         Just "subscribe" -> Subscribe+         Just "subscribed" -> Subscribed+         Just "unsubscribe" -> Unsubscribe+         Just "unsubscribed" -> Unsubscribed+         Just "probe" -> Probe+         Just "error" -> Error+         _ -> Error++---+cdata' = getCdata . maybe (XML "" [] []) id

@@ -0,0 +1,41 @@+module Network.XMPP.Roster (+    RosterItem(..),+    Subscription(..),+    getRoster+) where++import Network.XMPP+++data RosterItem = RosterItem+    { itemName :: String+    , itemJid :: String+    , itemSubscription :: Subscription+    , itemGroups :: [String]+    } deriving Show++-- "There are nine possible subscription states"+-- It's horrible.+data Subscription = SBoth | SFrom | STo | SNone | SUnknown+                    deriving Show+++getRoster :: XMPP [RosterItem]+getRoster = do+    stanza <- sendIqWait "" "get" [XML "query" [("xmlns", "jabber:iq:roster")] []]+    let items = xmlPath' ["query", "item"] [stanza]+    return $ map getItem items+  where+    getItem item =+      let getAttr' attr = maybe "" id $ getAttr attr item++          name = getAttr' "name"+          jid = getAttr' "jid"+          groups = map cdata $ xmlPath' ["group"] [item]+          subs = case getAttr' "subscription" of+                   "to" -> STo+                   "from" -> SFrom+                   "both" -> SBoth+                   "none" -> SNone+                   _ -> SUnknown+      in RosterItem name jid subs groups

@@ -18,11 +18,15 @@                , handleVersion                , getErrorCode                , hasNodeName+               , getMessageStamp+               , getJidRes+               , cdata                )     where  import Network.XMPP.XMPPMonad import Network.XMPP.XMLParse+import Network.XMPP.JID import System.Random import Maybe @@ -104,8 +108,8 @@ --- Presence  -- |Send ordinary online presence.-sendPresence :: Integer -> XMPP ()-sendPresence priority = sendStanza $ XML "presence" [] [XML "priority" [] [CData $ show priority]]+sendPresence :: XMPP ()+sendPresence = sendStanza $ XML "presence" [] []  --- Stanza predicates @@ -196,3 +200,23 @@       Just "error" -> read $ maybe "-1" id (getAttr "code" errorNode) :: Integer       _ -> 0     where errorNode = maybe (XML [] [] []) id (xmlPath ["error"] stanza)++-- |Get the stamp of message, if has any.+getMessageStamp :: XMLElem -> Maybe String+getMessageStamp stanza =+    let xs = xmlPath' ["x"] [stanza]+        xs' = filter (attributeMatches "xmlns" (=="jabber:x:delay")) xs+        stamps = map (getAttr "stamp") xs'+    in case stamps of+         [stamp@(Just s)] -> stamp+         _ -> Nothing++-- |Get the jid and the resource of stanza.+getJidRes :: XMLElem -> (String, String)+getJidRes stanza =+    let sender = maybe "" id (getAttr "from" stanza)+    in (getBareJid sender, getResource sender)++-- |Small helper function.+cdata :: XMLElem -> String+cdata = maybe "" id . getCdata

@@ -1,7 +1,7 @@ -- |The difference between this XML parsers and all other XML parsers -- is that this one can parse an XML document that is only partially -- received, returning the parts that have arrived so far.-module Network.XMPP.XMLParse +module Network.XMPP.XMLParse     ( XMLElem(..)     , xmlPath     , getAttr@@ -196,18 +196,17 @@       return ()  -------------------------------------------------- |Default xmlPath doesn't find subtag2 if we have--- tag1/subtag1 and tag1/subtag2 in xml stanza.-xmlPath' :: [String] -> [XMLElem] -> Maybe XMLElem-xmlPath' [] [] = Nothing-xmlPath' [] els = Just $ head els+xmlPath' :: [String] -> [XMLElem] -> [XMLElem]+xmlPath' [] [] = []+xmlPath' [] els = els xmlPath' (name:names) elems =     let elems' = map filter_elem elems-        filter_elem (XML _ _ els) = filter (\stanza ->-                                      case stanza of-                                        (XML n _ _) -> name==n-                                        _ -> False) els-+        filter_elem (XML _ _ els) =+            filter (\stanza ->+                     case stanza of+                       (XML n _ _) -> name==n+                       _ -> False+                   ) els     in xmlPath' names (concat elems')  -----------------------------------------------

@@ -30,8 +30,8 @@ -- cooperative threading system: when it decides to wait for more -- input, it \"sleeps\", letting other \"threads\" run, until input -- matching a certain predicate arrives.-data XMPP a = -    XMPP { xmppFn :: XMPPConnection c => +data XMPP a =+    XMPP { xmppFn :: XMPPConnection c =>                      (c -> XMPPState -> IO (XMPPState, XMPPRes a)) } type XMPPState =     [(StanzaPredicate,          -- predicate@@ -64,7 +64,7 @@ modifyState fn = XMPP $ \_ state -> return (fn state, XMPPJust ())  instance MonadIO XMPP where-    liftIO iofn = XMPP $ \c state -> do +    liftIO iofn = XMPP $ \c state -> do                         iores <- iofn                         return (state, XMPPJust iores) 

@@ -1,5 +1,5 @@ Name:                XMPP-Version:             0.0.3+Version:             0.0.4 Synopsis:            XMPP library Category:            Network Description:         XMPP library@@ -15,7 +15,8 @@ Extra-Source-Files:  install.sh  Library-  Exposed-Modules:   Network.XMPP, Network.XMPP.MUC+  Exposed-Modules:   Network.XMPP, Network.XMPP.MUC, Network.XMPP.Roster,+                     Network.XMPP.Presence    Other-modules:     Network.XMPP.Auth, Network.XMPP.JID,                      Network.XMPP.Stanzas, Network.XMPP.TCPConnection,