packages feed

haskell-xmpp 1.0 → 1.0.1

raw patch · 16 files changed

+73/−65 lines, 16 filesdep ~HaXmlPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: HaXml

API changes (from Hackage documentation)

- Network.XMPP.UTF8: fromUTF8 :: String -> String
- Network.XMPP.UTF8: toUTF8 :: String -> String
+ Network.XMPP.Types: RosterItem :: JID -> SubscribtionType -> Maybe String -> [String] -> RosterItem
+ Network.XMPP.Types: data RosterItem
+ Network.XMPP.Types: groups :: RosterItem -> [String]
+ Network.XMPP.Types: jid :: RosterItem -> JID
+ Network.XMPP.Types: nickname :: RosterItem -> Maybe String
+ Network.XMPP.Types: subscribtion :: RosterItem -> SubscribtionType
+ Network.XMPP.UTF8: fromUTF8, toUTF8 :: String -> String
+ Network.XMPP.Utils: debugIO :: String -> IO ()
- Network.XMPP.JID: JID :: String -> String -> String -> JID
+ Network.XMPP.JID: JID :: Maybe String -> String -> Maybe String -> JID
- Network.XMPP.JID: name :: JID -> String
+ Network.XMPP.JID: name :: JID -> Maybe String
- Network.XMPP.JID: resource :: JID -> String
+ Network.XMPP.JID: resource :: JID -> Maybe String
- Network.XMPP.Stream: lookupAttr :: Eq a => a -> [(a, AttValue)] -> Maybe String
+ Network.XMPP.Stream: lookupAttr :: String -> [Attribute] -> Maybe String
- Network.XMPP.Stream: withNextM :: (XmppMessage -> a) -> StateT Stream IO a
+ Network.XMPP.Stream: withNextM :: (XmppMessage -> b) -> StateT Stream IO b
- Network.XMPP.Stream: withSelectM :: (XmppMessage -> Bool) -> (XmppMessage -> a) -> StateT Stream IO a
+ Network.XMPP.Stream: withSelectM :: (XmppMessage -> Bool) -> (XmppMessage -> b) -> StateT Stream IO b

Files

examples/Test.hs view
@@ -1,7 +1,6 @@ module Main where  import Control.Monad.Trans (liftIO)-import Data.List  import Network.XMPP import Network.XMPP.IQ@@ -9,25 +8,25 @@ import Network.XMPP.XEP.Version import Network.XMPP.Concurrent import Control.Monad-import qualified Text.XML.HaXml.Pretty as P (content)+-- import qualified Text.XML.HaXml.Pretty as P (content) import Text.XML.HaXml.Xtract.Parse (xtract)  iqVersionT1 :: XmppThreadT () iqVersionT1 = do   st <- readChanS -  liftIO $ putStrLn ("thread1 got message! ")+  liftIO $ putStrLn ("thread1 got next message.")   when (isVersionReq st) $ do                        -    writeChanS $ presAway "abcd"-    liftIO $ putStrLn ("thread1 SENT message!")+    writeChanS $ presAway "thread1"+    liftIO $ putStrLn ("thread1: it was version request. We sent away presence \"thread1\"")   iqVersionT1  iqVersionT2 :: XmppThreadT () iqVersionT2 = do   st <- readChanS -  liftIO $ putStrLn ("thread2 got message! ")+  liftIO $ putStrLn ("thread2 got next message.")   when (isVersionReq st) $ do                        -    writeChanS $ presAway "AAAAAAAA!!!!"-    liftIO $ putStrLn ("thread2 SENT message!")+    writeChanS $ presAway "thread2"+    liftIO $ putStrLn ("thread1: it was version request. We sent away presence \"thread2\"")   iqVersionT2    iqVersion :: XmppThreadT ()@@ -59,7 +58,7 @@          roster <- parseM          liftIO $ putStrLn $ show roster -}-         -- Set presence to defalt +         -- Set presence to default                               mucJoin (read "testing@conference.jabber.ru/testbot")          mucLeave (read "testing@conference.jabber.ru/testbot")
haskell-xmpp.cabal view
@@ -1,10 +1,10 @@ Name: haskell-xmpp-Version: 1.0+Version: 1.0.1 License: BSD3 License-File: LICENSE Author: Dmitry Astapov <dastapov@gmail.com>, pierre <k.pierre.k@gmail.com> Maintainer: Dmitry Astapov <dastapov@gmail.com>-Homepage: http://adept.linux.kiev.ua/repos/xmpp+Homepage: http://patch-tag.com/r/adept/haskell-xmpp/home Category: Network Copyright: (c) 2005-2011 Dmitry Astapov, k.pierre Stability: Stable@@ -30,9 +30,13 @@   description: Build examples   default: False +flag debug+  description: Enable debugging output+  default: False+ library   Hs-Source-Dirs: ./src-  Build-Depends: base > 3 && <=5, random, pretty, array, HaXml >= 1.20.2, mtl >= 1.0, network, html, polyparse, regex-compat, stm, utf8-string+  Build-Depends: base > 3 && <=5, random, pretty, array, HaXml >= 1.23.3, mtl >= 1.0, network, html, polyparse, regex-compat, stm, utf8-string   Exposed-modules: Network.XMPP                 , Network.XMPP.Sasl                 , Network.XMPP.Core@@ -53,12 +57,16 @@           , Network.XMPP.XEP.Version           , Network.XMPP.Concurrent   GHC-Options: -Wall -fno-warn-name-shadowing -fno-warn-orphans+  if flag(debug)+     CPP-Options: -DDEBUG  Executable haskell-xmpp-test-  Hs-Source-Dirs: ./examples+  Hs-Source-Dirs: ./src ./examples   if flag(examples)     build-depends: base > 3 && <=5   else     buildable: False+  if flag(debug)+     CPP-Options: -DDEBUG   Main-Is: Test.hs   GHC-Options: -Wall -fno-warn-name-shadowing -fno-warn-orphans
src/Network/XMPP/Concurrent.hs view
@@ -27,14 +27,8 @@ import Network.XMPP.Types import Control.Concurrent import Control.Concurrent.STM-import Control.Concurrent.STM.TChan-import Control.Monad.Trans (liftIO)-import Control.Monad import Control.Monad.State  import Control.Monad.Reader -import Data.Maybe-import Network.XMPP.XEP.Version -import Network.XMPP.IM.Presence     import Network.XMPP.Utils  import System.IO@@ -108,7 +102,7 @@ connPersist :: Handle -> IO () connPersist h = do   hPutStr h " "-  putStrLn "<space added>"+  debugIO "<space added>"   threadDelay 30000000   connPersist h
src/Network/XMPP/Helpers.hs view
@@ -24,6 +24,7 @@ import Network.BSD import Control.Concurrent (threadDelay, forkIO) import Control.Monad.Trans (liftIO)+import Network.XMPP.Utils  -- | Connect to XMPP server on specified host \/ port connectViaTcp :: String -- ^ Server (hostname) to connect to@@ -46,7 +47,7 @@      liftIO $ forkIO $ pinger h      return h   where dropHeaders h = do l <- hGetLine h-                           putStrLn $ "Got: " ++ l+                           debugIO $ "Got: " ++ l                            if words l /= [] then dropHeaders h                                             else return ()         pinger h = hPutStr h " " >> threadDelay (30 * 10^6) >> pinger h
src/Network/XMPP/IM/Presence.hs view
@@ -56,5 +56,8 @@            (Just 0) -- pPriority :: Maybe Integer            []       -- pExt :: [Content Posn] +mkPresenceD :: ShowType -> String -> Stanza mkPresenceD = mkPresence Default++mkPresenceU :: ShowType -> String -> Stanza mkPresenceU = mkPresence Unavailable
src/Network/XMPP/JID.hs view
@@ -23,21 +23,23 @@ import Text.Regex  -- | Jabber ID (JID) datatype-data JID = JID { name :: String+data JID = JID { name :: Maybe String                -- ^ Account name                , server :: String                -- ^ Server adress-               , resource :: String+               , resource :: Maybe String                -- ^ Resource name                }  instance Read JID where     -- Reads JID from string (name@server\/resource)-    readsPrec a str = case matchRegexAll regex str of                  -                        Just (_,_,after,(_:name:_:server:_:_:resource:_:[])) -> [((JID name server resource), after)]+    readsPrec _ str = case matchRegexAll regex str of                  +                        Just (_,_,after,(_:name:_:server:_:_:resource:_:[])) -> [((JID (toMaybe name) server (toMaybe resource)), after)]                         Just _ -> []                         Nothing -> []         where+          toMaybe "" = Nothing+          toMaybe s  = Just s           regex = mkRegex $                    "((([^@])+)@)?" ++                   "(([^/])+)" ++@@ -45,7 +47,8 @@  instance Show JID where     -- Shows JID-    show a = (if (name a) /= "" then (name a)++"@" else "") ++-             (server a)++-             (if (resource a) /= "" then "/"++(resource a) else "") +  show jid = concat [name', server jid, resource']+    where name' = maybe "" (++"@") (name jid)+          resource' = maybe "" (++"/") (resource jid)+
src/Network/XMPP/Print.hs view
@@ -35,7 +35,6 @@ import System.IO import Text.XML.HaXml hiding (tag) import qualified Text.XML.HaXml.Pretty as P-import Text.PrettyPrint.HughesPJ       import Network.XMPP.UTF8 import Network.XMPP.Types@@ -51,7 +50,7 @@ hPutXmpp :: Handle -> XmppMessage -> IO () hPutXmpp h msg =    do let str = renderXmpp msg-     putStrLn $ "Sending: " ++ str+     debugIO $ "Sending: " ++ str      hPutStr h $ toUTF8 str  -- | Render HaXML combinators into string, hacked for XMPP@@ -59,7 +58,7 @@ renderXmpp theXml =     case theXml of       -- stupid hack for <stream:stream> and </stream:stream>-      xml@(CElem (Elem "stream:stream" _ _) _) ->+      xml@(CElem (Elem (N "stream:stream") _ _) _) ->           (:) '<' $ takeWhile (/= '<') $ tail $ render $ P.content xml       xml ->           render $ P.content xml
src/Network/XMPP/Sasl.hs view
@@ -104,8 +104,8 @@   where   -- | Trim leading '=' and surrounding quotes (if any) from value   trim str = case dropWhile (=='=') str of-                  x@('\"':rest) -> read x-                  x             -> x+                  x@('\"':_) -> read x+                  x          -> x  saslDigestRspAuth chl =   let pairs = get_pairs $ B64.decode chl
src/Network/XMPP/Stanza.hs view
@@ -21,8 +21,6 @@  import Text.XML.HaXml.Xtract.Parse (xtract) -import Control.Monad.State- import Network.XMPP.Types import Network.XMPP.Print import Network.XMPP.Stream@@ -89,9 +87,9 @@ -- | Converts stanza to XML and outputs it  outStanza :: Stanza -> XmppStateT () outStanza s = case s of-                a@(Message _ _ _ _ _ _ _ _) -> outMessage a-                a@(Presence _ _ _ _ _ _ _ _) -> outPresence a-                a@(IQ _ _ _ _ _) -> outIQ a+                a@(Message{}) -> outMessage a+                a@(Presence{}) -> outPresence a+                a@(IQ{}) -> outIQ a  outMessage :: Stanza -> XmppStateT () outMessage (Message from' to' id' mtype' subject' body' thread' x') =
src/Network/XMPP/Stream.hs view
@@ -34,7 +34,6 @@   ) where  import Control.Monad.State-import Foreign hiding (new) import System.IO import Text.ParserCombinators.Poly.State (onFail) import Text.XML.HaXml.Lex (xmlLex)@@ -106,9 +105,9 @@      let (starter, rest) = xmlParseWith streamStart ls      case starter of           Left e -> error e-          Right (ElemTag "stream:stream" attrs) -> do modify (\stream -> stream { lexemes=rest })-                                                      return attrs-          Right x -> error $ "Unexpected element at the beginning of XMPP stream!"+          Right (ElemTag (N "stream:stream") attrs) -> do modify (\stream -> stream { lexemes=rest })+                                                          return attrs+          Right _ -> error $ "Unexpected element at the beginning of XMPP stream!"   where   streamStart = do ( processinginstruction >> return () ) `onFail` return ()                    elemOpenTag@@ -145,8 +144,9 @@      modify (\stream -> stream { idx = i+1 })      return i +lookupAttr :: String -> [Attribute] -> Maybe String lookupAttr k lst =-  do x <- lookup k lst+  do x <- lookup (N k) lst      case x of             AttValue [Left str] -> Just str             AttValue _          -> Nothing
src/Network/XMPP/Types.hs view
@@ -16,6 +16,7 @@   , StreamType(..)   , Stanza(..)   , MessageType(..), PresenceType(..), IQType(..), ShowType(..)+  , RosterItem(..)   , defaultStreamBlockSize   , isMessage, isPresence, isIQ   ) where@@ -27,7 +28,7 @@ import Text.XML.HaXml.Posn (Posn) import Text.XML.HaXml.Lex (Token)     -import Text.PrettyPrint.HughesPJ    (render, hcat)+import Text.PrettyPrint.HughesPJ (render) import qualified Text.XML.HaXml.Pretty as P (content)  import Network.XMPP.JID@@ -67,7 +68,7 @@                              -- ^ Entry's JID                              , subscribtion :: SubscribtionType                              -- ^ Subscribtion type -                             , name :: Maybe String+                             , nickname :: Maybe String                              -- ^ Entry's nickname                              , groups :: [String]                              -- ^ <group> elements@@ -212,13 +213,13 @@  -- | Utility functions                 isMessage :: Stanza -> Bool-isMessage (Message _ _ _ _ _ _ _ _) = True+isMessage Message{} = True isMessage _ = False  isPresence :: Stanza -> Bool-isPresence (Presence _ _ _ _ _ _ _ _) = True+isPresence Presence{} = True isPresence _ = False  isIQ :: Stanza -> Bool-isIQ (IQ _ _ _ _ _) = True+isIQ IQ{} = True isIQ _ = False
src/Network/XMPP/UTF8.hs view
@@ -49,5 +49,6 @@  import Codec.Binary.UTF8.String +fromUTF8, toUTF8 :: String -> String fromUTF8 = decodeString toUTF8 = encodeString
src/Network/XMPP/Utils.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module      :  Network.XMPP.Utils@@ -29,15 +30,15 @@   , mattr   , mattr'   , debug+  , debugIO   , literal -- from HaXML   ) where  import Control.Monad.State- import Text.XML.HaXml hiding (tag) import Text.XML.HaXml.Posn      import qualified Text.XML.HaXml.Pretty as P-import Text.PrettyPrint.HughesPJ    (render, hcat)+import Text.PrettyPrint.HughesPJ  (hcat) import Text.XML.HaXml.Xtract.Parse (xtract)      import Network.XMPP.Types@@ -51,7 +52,7 @@ toFilter x =  (\_ -> [x])  noelem = -    Elem "root" [] []+    Elem (N "root") [] []  strAttr s d = (s, literal d) sattr = strAttr@@ -71,9 +72,9 @@ isVal str cont = any (== str) . (getVals cont)  -- -getText cs@(CString _ s _)  = render . P.content $ cs-getText cs@(CRef _ _)       = render . P.content $ cs-getText x                   = error $ "Attempt to extract text from content that is not a string: " ++ render ( P.content x )+getText cs@(CString{})  = render . P.content $ cs+getText cs@(CRef{})     = render . P.content $ cs+getText x               = error $ "Attempt to extract text from content that is not a string: " ++ render ( P.content x )  getText_ = render . hcat . map P.content            @@ -81,10 +82,17 @@ mread a = Just $ read a  mattr s (Just a) = [ strAttr s (show a) ]-mattr s Nothing = []+mattr _ Nothing = []  mattr' s (Just a) = [ strAttr s a ]-mattr' s Nothing = []+mattr' _ Nothing = []  debug :: String -> XmppStateT ()+debugIO :: String -> IO ()+#ifdef DEBUG debug = liftIO . putStrLn+debugIO = putStrLn+#else+debug _ = return ()+debugIO _ = return ()+#endif
src/Network/XMPP/XEP/Delayed.hs view
@@ -16,11 +16,8 @@     isDelayed   ) where -import Network.XMPP.Stanza import Network.XMPP.Stream import Network.XMPP.Types-import Network.XMPP.Print    -import Network.XMPP.JID  import Text.XML.HaXml.Xtract.Parse (xtract) @@ -28,3 +25,4 @@ isDelayed :: Stanza -> Bool isDelayed (Message _ _ _ _ _ _ _ ext) =     any (== "jabber:x:delay") $ map (\x -> getText_ $ xtract id "/x/@xmlns" x) ext+isDelayed _ = False
src/Network/XMPP/XEP/MUC.hs view
@@ -20,7 +20,6 @@   ) where  import Network.XMPP.Stanza-import Network.XMPP.Stream import Network.XMPP.Types import Network.XMPP.Print     import Network.XMPP.JID
src/Network/XMPP/XEP/Version.hs view
@@ -16,15 +16,11 @@     , versionAnswer      ) where -import Network.XMPP.Stanza-import Network.XMPP.Stream import Network.XMPP.Types import Network.XMPP.Print    -import Network.XMPP.JID import Network.XMPP.Utils   import Text.XML.HaXml-import Text.XML.HaXml.Posn          -- | True, if stanza is a version request isVersionReq :: Stanza -> Bool               @@ -34,7 +30,7 @@  -- | Replies to version request versionAnswer :: String -> String -> String -> (Stanza -> [CFilter i])-versionAnswer name version os s@(IQ { }) =+versionAnswer name version os (IQ { }) =     [ ptag "query"                [ xmlns "jabber:iq:version" ]                [ ptag "name" [] [literal name],