pontarius-xmpp 0.5.0 → 0.5.1

raw patch · 5 files changed

+84/−17 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +3/−0
• pontarius-xmpp.cabal +2/−7
• source/Network/Xmpp/Stream.hs +30/−10
• tests/Main.hs +2/−0
• tests/Tests/Stream.hs +47/−0

@@ -1,3 +1,6 @@+# 0.5.0 to 0.5.1+* Fixed input logger choking on long non-ascii messages+ # 0.4.5 to 0.5.0 * Support for the session element is now determined from stream features, the   establishSession option was removed

@@ -1,5 +1,5 @@ Name:          pontarius-xmpp-Version:       0.5.0+Version:       0.5.1 Cabal-Version: >= 1.9.2 Build-Type:    Custom License:       BSD3@@ -11,7 +11,6 @@ Stability:     alpha Homepage:      https://github.com/pontarius/pontarius-xmpp/ Bug-Reports:   https://github.com/pontarius/pontarius-xmpp/issues/-Package-URL:   http://www.jonkri.com/releases/pontarius-xmpp-0.4.3.tar.gz Synopsis:      An XMPP client library Description:   Pontarius XMPP is a work in progress implementation of RFC 6120                ("XMPP CORE"), RFC 6121 ("XMPP IM"), and RFC 6122 ("XMPP ADDR").@@ -157,6 +156,7 @@                , Tests.Arbitrary.Xmpp                , Tests.Parsers                , Tests.Picklers+               , Tests.Stream   ghc-options: -Wall -O2 -fno-warn-orphans  Test-Suite doctest@@ -209,8 +209,3 @@ Source-Repository head   Type: git   Location: git://github.com/pontarius/pontarius-xmpp.git--Source-Repository this-  Type: git-  Location: git://github.com/pontarius/pontarius-xmpp.git-  Tag: 0.4.2.2

@@ -31,6 +31,7 @@ import           Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text+import qualified Data.Text.Encoding.Error as Text import           Data.Void (Void) import           Data.XML.Pickle import           Data.XML.Types@@ -240,22 +241,41 @@   -- Creates a conduit from a StreamHandle-sourceStreamHandle :: (MonadIO m, MonadError XmppFailure m)+sourceStreamHandleRaw :: (MonadIO m, MonadError XmppFailure m)                       => StreamHandle -> ConduitM i ByteString m ()-sourceStreamHandle s = loopRead $ streamReceive s+sourceStreamHandleRaw s = forever . read $ streamReceive s   where-    loopRead rd = do+    read rd = do         bs' <- liftIO (rd 4096)         bs <- case bs' of             Left e -> throwError e             Right r -> return r-        if BS.null bs-            then return ()-            else do-               liftIO $ debugM "Pontarius.Xmpp" $ "in: " ++-                              (Text.unpack . Text.decodeUtf8 $ bs)-               yield bs-               loopRead rd+        yield bs++sourceStreamHandle :: (MonadIO m, MonadError XmppFailure m)+                      => StreamHandle -> ConduitM i ByteString m ()+sourceStreamHandle sh = sourceStreamHandleRaw sh $= logInput++logInput :: MonadIO m => ConduitM ByteString ByteString m ()+logInput = go Nothing+  where+    go mbDec = do+        mbBs <- await+        case mbBs of+         Nothing -> return ()+         Just bs -> do+           let decode = case mbDec of+                         Nothing -> Text.streamDecodeUtf8With Text.lenientDecode+                         Just d -> d+               (Text.Some out leftover cont) = decode bs+               cont' = if BS.null leftover+                       then Nothing+                       else Just cont+           unless (Text.null out) $+               liftIO $ debugM "Pontarius.Xmpp"+                                $ "in: " ++ Text.unpack out+           yield bs+           go cont'  -- We buffer sources because we don't want to lose data when multiple -- xml-entities are sent with the same packet and we don't want to eternally

@@ -4,8 +4,10 @@  import Tests.Parsers import Tests.Picklers+import Tests.Stream  main :: IO () main = defaultMain $ testGroup "root" [ parserTests                                       , picklerTests+                                      , streamTests                                       ]

@@ -0,0 +1,47 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module Tests.Stream where++import           Control.Monad.Trans+import           Data.Conduit+import qualified Data.Conduit.List as CL+import           Data.XML.Types+import           Test.Hspec+import           Test.Tasty+import           Test.Tasty.HUnit+import           Test.Tasty.Hspec+import           Test.Tasty.TH++import           Network.Xmpp.Stream++junk = [ EventBeginDocument+       , EventEndDocument+       , EventBeginDoctype "" Nothing+       , EventEndDoctype+       , EventInstruction $ Instruction "" ""+--       , EventBeginElement Name [(Name, [Content])]+       , EventEndElement "foo"+       , EventContent $ ContentText ""+       , EventComment ""+       , EventCDATA ""+       ]++beginElem = EventBeginElement "foo" []++case_ThrowOutJunk = hspec . describe "throwOutJunk" $ do+    it "drops everything but EvenBeginElement" $ do+        res <- CL.sourceList junk $$ throwOutJunk >> await+        res `shouldBe` Nothing+    it "keeps everything after (and including) EvenBeginElement" $ do+        res <- CL.sourceList (junk ++ [beginElem] ++ junk)+                             $$ throwOutJunk >> CL.consume+        res `shouldBe` (beginElem : junk)++case_LogInput = hspec . describe "logInput" $ do+    it "Can handle split UTF8 codepoints" $ do+        res <- CL.sourceList ["\209","\136"] $= logInput $$ CL.consume+        res `shouldBe` ["\209","\136"]++streamTests :: TestTree+streamTests = $testGroupGenerator