Browse Source

Merge remote-tracking branch 'remotes/nejla/master'

Conflicts:
	source/Network/Xmpp/Concurrent/Types.hs
master
Philipp Balzarek 14 years ago
parent
commit
498bfac762
  1. 2
      examples/EchoClient.hs
  2. 2
      source/Network/Xmpp.hs
  3. 2
      source/Network/Xmpp/Concurrent/Threads.hs
  4. 4
      source/Network/Xmpp/Concurrent/Types.hs
  5. 34
      source/Network/Xmpp/Sasl/StringPrep.hs
  6. 3
      source/Network/Xmpp/Stream.hs

2
examples/EchoClient.hs

@ -48,7 +48,7 @@ main = do
return () return ()
return () return ()
-- Pull message stanzas, verify that they originate from a `full' Xmpp -- Pull message stanzas, verify that they originate from a `full' XMPP
-- address, and, if so, `echo' the message back. -- address, and, if so, `echo' the message back.
echo :: Xmpp () echo :: Xmpp ()
echo = forever $ do echo = forever $ do

2
source/Network/Xmpp.hs

@ -191,7 +191,7 @@ connect address hostname = do
XmppStreamError StreamInvalidNamespace Nothing Nothing XmppStreamError StreamInvalidNamespace Nothing Nothing
toError (StreamInvalidStreamPrefix _prefix) = toError (StreamInvalidStreamPrefix _prefix) =
XmppStreamError StreamBadNamespacePrefix Nothing Nothing XmppStreamError StreamBadNamespacePrefix Nothing Nothing
-- TO: Catch remaining xmppStartStream errors. -- TODO: Catch remaining xmppStartStream errors.
toError (StreamWrongVersion _ver) = toError (StreamWrongVersion _ver) =
XmppStreamError StreamUnsupportedVersion Nothing Nothing XmppStreamError StreamUnsupportedVersion Nothing Nothing
toError (StreamWrongLangTag _) = toError (StreamWrongLangTag _) =

2
source/Network/Xmpp/Concurrent/Threads.hs

@ -200,7 +200,7 @@ startThreads = do
{ connectionClosedHandler = \_ -> return () { connectionClosedHandler = \_ -> return ()
} }
-- | Creates and initializes a new Xmpp session. -- | Creates and initializes a new concurrent session.
newSession :: IO Session newSession :: IO Session
newSession = do newSession = do
(mC, pC, sC, hand, outC, stopThreads', writeR, conS, rdr, eh) <- startThreads (mC, pC, sC, hand, outC, stopThreads', writeR, conS, rdr, eh) <- startThreads

4
source/Network/Xmpp/Concurrent/Types.hs

@ -19,7 +19,7 @@ import Network.Xmpp.Types
-- Map between the IQ request type and the "query" namespace pair, and the TChan -- Map between the IQ request type and the "query" namespace pair, and the TChan
-- for the IQ request and "sent" boolean pair. -- for the IQ request and "sent" boolean pair.
type IQHandlers = (Map.Map (IQRequestType, Text) (TChan IQRequestTicket) type IQHandlers = (Map.Map (IQRequestType, Text) (TChan IQRequestTicket)
, Map.Map StanzaId (TMVar (IQResponse)) , Map.Map StanzaId (TMVar IQResponse)
) )
-- Handlers to be run when the Xmpp session ends and when the Xmpp connection is -- Handlers to be run when the Xmpp session ends and when the Xmpp connection is
@ -65,6 +65,8 @@ instance Show Interrupt where show _ = "<Interrupt>"
instance Ex.Exception Interrupt instance Ex.Exception Interrupt
-- | Contains whether or not a reply has been sent, and the IQ request body to
-- reply to.
data IQRequestTicket = IQRequestTicket data IQRequestTicket = IQRequestTicket
{ sentRef :: (TVar Bool) { sentRef :: (TVar Bool)
, iqRequestBody :: IQRequest , iqRequestBody :: IQRequest

34
source/Network/Xmpp/Sasl/StringPrep.hs

@ -5,44 +5,24 @@ import Text.StringPrep
import qualified Data.Set as Set import qualified Data.Set as Set
import Data.Text(singleton) import Data.Text(singleton)
nonAsciiSpaces = Set.fromList [ '\x00A0','\x1680','\x2000','\x2001','\x2002' nonAsciiSpaces = Set.fromList [ '\x00A0', '\x1680', '\x2000', '\x2001', '\x2002'
, '\x2003', '\x2004','\x2005','\x2006','\x2007' , '\x2003', '\x2004', '\x2005', '\x2006', '\x2007'
, '\x2008','\x2009', '\x200A','\x200B' ,'\x202F' , '\x2008', '\x2009', '\x200A', '\x200B', '\x202F'
, '\x205F','\x3000'] , '\x205F', '\x3000'
]
toSpace x = if x `Set.member` nonAsciiSpaces then " " else singleton x toSpace x = if x `Set.member` nonAsciiSpaces then " " else singleton x
saslPrepQuery = Profile saslPrepQuery = Profile
[b1, toSpace] [b1, toSpace]
True True
[ c12 [c12, c21, c22, c3, c4, c5, c6, c7, c8, c9]
, c21
, c22
, c3
, c4
, c5
, c6
, c7
, c8
, c9
]
True True
saslPrepStore = Profile saslPrepStore = Profile
[b1, toSpace] [b1, toSpace]
True True
[ a1 [a1, c12, c21, c22, c3, c4, c5, c6, c7, c8, c9]
, c12
, c21
, c22
, c3
, c4
, c5
, c6
, c7
, c8
, c9
]
True True
normalizePassword = runStringPrep saslPrepStore normalizePassword = runStringPrep saslPrepStore

3
source/Network/Xmpp/Stream.hs

@ -122,8 +122,7 @@ xmppStream expectedTo = do
validateData (_, _, _, _, Nothing) = throwError $ StreamWrongLangTag Nothing validateData (_, _, _, _, Nothing) = throwError $ StreamWrongLangTag Nothing
validateData (ver, from, to, i, Just lang) validateData (ver, from, to, i, Just lang)
| ver /= "1.0" = throwError $ StreamWrongVersion (Just ver) | ver /= "1.0" = throwError $ StreamWrongVersion (Just ver)
| to /= expectedTo = throwError $ StreamWrongTo (Text.pack . show <$> to) | isJust to && to /= expectedTo = throwError $ StreamWrongTo (Text.pack . show <$> to)
-- | lang /= expectedLang = throwError $ StreamWrongLangTag lang
| otherwise = return (from, to, i, lang) | otherwise = return (from, to, i, lang)
xmppStreamFeatures :: StreamSink ServerFeatures xmppStreamFeatures :: StreamSink ServerFeatures
xmppStreamFeatures = do xmppStreamFeatures = do

Loading…
Cancel
Save