From 4798838f20f61f37f1b21fc54722873d844770a9 Mon Sep 17 00:00:00 2001 From: Jon Kristensen Date: Thu, 5 Jul 2012 17:07:45 +0200 Subject: [PATCH 1/4] minor documentation/formatting changes --- examples/EchoClient.hs | 2 +- source/Network/Xmpp.hs | 2 +- source/Network/Xmpp/Concurrent/Threads.hs | 2 +- source/Network/Xmpp/Concurrent/Types.hs | 10 ++++--- source/Network/Xmpp/Sasl/StringPrep.hs | 34 +++++------------------ 5 files changed, 16 insertions(+), 34 deletions(-) diff --git a/examples/EchoClient.hs b/examples/EchoClient.hs index 0b1c14d..d60ebba 100644 --- a/examples/EchoClient.hs +++ b/examples/EchoClient.hs @@ -48,7 +48,7 @@ main = do 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. echo :: Xmpp () echo = forever $ do diff --git a/source/Network/Xmpp.hs b/source/Network/Xmpp.hs index d3924ac..8b55f2d 100644 --- a/source/Network/Xmpp.hs +++ b/source/Network/Xmpp.hs @@ -189,7 +189,7 @@ connect address hostname = do XmppStreamError StreamInvalidNamespace Nothing Nothing toError (StreamInvalidStreamPrefix _prefix) = XmppStreamError StreamBadNamespacePrefix Nothing Nothing - -- TO: Catch remaining xmppStartStream errors. + -- TODO: Catch remaining xmppStartStream errors. toError (StreamWrongVersion _ver) = XmppStreamError StreamUnsupportedVersion Nothing Nothing toError (StreamWrongLangTag _) = diff --git a/source/Network/Xmpp/Concurrent/Threads.hs b/source/Network/Xmpp/Concurrent/Threads.hs index aa1a47a..e67d3d2 100644 --- a/source/Network/Xmpp/Concurrent/Threads.hs +++ b/source/Network/Xmpp/Concurrent/Threads.hs @@ -199,7 +199,7 @@ startThreads = do { connectionClosedHandler = \_ -> return () } --- | Creates and initializes a new Xmpp session. +-- | Creates and initializes a new concurrent session. newSession :: IO Session newSession = do (mC, pC, sC, hand, outC, stopThreads', writeR, conS, rdr, eh) <- startThreads diff --git a/source/Network/Xmpp/Concurrent/Types.hs b/source/Network/Xmpp/Concurrent/Types.hs index 6772df1..b9acb65 100644 --- a/source/Network/Xmpp/Concurrent/Types.hs +++ b/source/Network/Xmpp/Concurrent/Types.hs @@ -18,7 +18,7 @@ import Network.Xmpp.Types -- Map between the IQ request type and the "query" namespace pair, and the TChan -- 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) ) @@ -65,7 +65,9 @@ instance Show Interrupt where show _ = "" instance Ex.Exception Interrupt +-- | Contains whether or not a reply has been sent, and the IQ request body to +-- reply to. data IQRequestTicket = IQRequestTicket - { sentRef :: (TVar Bool) - , iqRequestBody :: IQRequest - } + { sentRef :: (TVar Bool) + , iqRequestBody :: IQRequest + } \ No newline at end of file diff --git a/source/Network/Xmpp/Sasl/StringPrep.hs b/source/Network/Xmpp/Sasl/StringPrep.hs index 0f20298..07442aa 100644 --- a/source/Network/Xmpp/Sasl/StringPrep.hs +++ b/source/Network/Xmpp/Sasl/StringPrep.hs @@ -5,44 +5,24 @@ import Text.StringPrep import qualified Data.Set as Set import Data.Text(singleton) -nonAsciiSpaces = Set.fromList [ '\x00A0','\x1680','\x2000','\x2001','\x2002' - , '\x2003', '\x2004','\x2005','\x2006','\x2007' - , '\x2008','\x2009', '\x200A','\x200B' ,'\x202F' - , '\x205F','\x3000'] +nonAsciiSpaces = Set.fromList [ '\x00A0', '\x1680', '\x2000', '\x2001', '\x2002' + , '\x2003', '\x2004', '\x2005', '\x2006', '\x2007' + , '\x2008', '\x2009', '\x200A', '\x200B', '\x202F' + , '\x205F', '\x3000' + ] toSpace x = if x `Set.member` nonAsciiSpaces then " " else singleton x saslPrepQuery = Profile [b1, toSpace] True - [ c12 - , c21 - , c22 - , c3 - , c4 - , c5 - , c6 - , c7 - , c8 - , c9 - ] + [c12, c21, c22, c3, c4, c5, c6, c7, c8, c9] True saslPrepStore = Profile [b1, toSpace] True - [ a1 - , c12 - , c21 - , c22 - , c3 - , c4 - , c5 - , c6 - , c7 - , c8 - , c9 - ] + [a1, c12, c21, c22, c3, c4, c5, c6, c7, c8, c9] True normalizePassword = runStringPrep saslPrepStore From f9324a0c72f9d5d04770939f0715f7027e735d14 Mon Sep 17 00:00:00 2001 From: Jon Kristensen Date: Fri, 6 Jul 2012 16:08:12 +0200 Subject: [PATCH 2/4] accept missing to header from server Interoperability Note: It is possible that implementations based on [RFC3920] will not include the 'to' address on stream headers; an entity SHOULD be liberal in accepting such stream headers. --- source/Network/Xmpp/Stream.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/source/Network/Xmpp/Stream.hs b/source/Network/Xmpp/Stream.hs index b91088e..98c6e52 100644 --- a/source/Network/Xmpp/Stream.hs +++ b/source/Network/Xmpp/Stream.hs @@ -122,7 +122,7 @@ xmppStream expectedTo = do validateData (_, _, _, _, Nothing) = throwError $ StreamWrongLangTag Nothing validateData (ver, from, to, i, Just lang) | 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) xmppStreamFeatures :: StreamSink ServerFeatures From 31633cfbdec64f43aff8881d92a647532d8f4ae4 Mon Sep 17 00:00:00 2001 From: Jon Kristensen Date: Fri, 6 Jul 2012 17:02:45 +0200 Subject: [PATCH 3/4] remove any expectations for received xml:lang tag the way i understand rfc 6120, clients will not have any assumptions about the received xml:lang tag --- source/Network/Xmpp/Stream.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/source/Network/Xmpp/Stream.hs b/source/Network/Xmpp/Stream.hs index 98c6e52..a20494a 100644 --- a/source/Network/Xmpp/Stream.hs +++ b/source/Network/Xmpp/Stream.hs @@ -120,11 +120,10 @@ xmppStream expectedTo = do Right r -> validateData r validateData (_, _, _, _, Nothing) = throwError $ StreamWrongLangTag Nothing - validateData (ver, from, to, i, Just lang) + validateData (ver, from, to, i, lang) | ver /= "1.0" = throwError $ StreamWrongVersion (Just ver) | 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, fromJust lang) xmppStreamFeatures :: StreamSink ServerFeatures xmppStreamFeatures = do e <- lift $ elements =$ CL.head From 354335fd9d1611b104a7364820f89e00e718ff48 Mon Sep 17 00:00:00 2001 From: Jon Kristensen Date: Fri, 6 Jul 2012 17:31:40 +0200 Subject: [PATCH 4/4] minor correction --- source/Network/Xmpp/Stream.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/source/Network/Xmpp/Stream.hs b/source/Network/Xmpp/Stream.hs index a20494a..2ead3b6 100644 --- a/source/Network/Xmpp/Stream.hs +++ b/source/Network/Xmpp/Stream.hs @@ -120,10 +120,10 @@ xmppStream expectedTo = do Right r -> validateData r validateData (_, _, _, _, Nothing) = throwError $ StreamWrongLangTag Nothing - validateData (ver, from, to, i, lang) + validateData (ver, from, to, i, Just lang) | ver /= "1.0" = throwError $ StreamWrongVersion (Just ver) | isJust to && to /= expectedTo = throwError $ StreamWrongTo (Text.pack . show <$> to) - | otherwise = return (from, to, i, fromJust lang) + | otherwise = return (from, to, i, lang) xmppStreamFeatures :: StreamSink ServerFeatures xmppStreamFeatures = do e <- lift $ elements =$ CL.head