diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,9 @@ +- 0.12.3.0 (2018-01-02) + * Fix error thrown from runClient functions + * Bump `QuickCheck` dependency to 2.10 + * Bump `entropy` dependency to 0.4 + * Bump `binary` dependency to 0.10 + - 0.12.2.0 (2017-07-28) * Don't use LambdaCase, we want to support older GHC versions diff --git a/src/Network/WebSockets/Stream.hs b/src/Network/WebSockets/Stream.hs --- a/src/Network/WebSockets/Stream.hs +++ b/src/Network/WebSockets/Stream.hs @@ -12,12 +12,12 @@ , close ) where -import qualified Data.Binary.Get as BIN import Control.Concurrent.MVar (MVar, newEmptyMVar, newMVar, putMVar, takeMVar, withMVar) import Control.Exception (onException, throwIO) -import Control.Monad (forM_, when) +import Control.Monad (forM_) import qualified Data.Attoparsec.ByteString as Atto +import qualified Data.Binary.Get as BIN import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import Data.IORef (IORef, atomicModifyIORef', @@ -79,23 +79,27 @@ Open buf -> (Closed buf, ()) Closed buf -> (Closed buf, ()) - assertNotClosed :: IORef StreamState -> IO a -> IO a - assertNotClosed ref io = do + -- Throw a 'ConnectionClosed' is the connection is not 'Open'. + assertOpen :: IORef StreamState -> IO () + assertOpen ref = do state <- readIORef ref case state of Closed _ -> throwIO ConnectionClosed - Open _ -> io + Open _ -> return () receive' :: IORef StreamState -> MVar () -> IO (Maybe B.ByteString) - receive' ref lock = withMVar lock $ \() -> assertNotClosed ref $ do + receive' ref lock = withMVar lock $ \() -> do + assertOpen ref mbBs <- onException receive (closeRef ref) case mbBs of Nothing -> closeRef ref >> return Nothing Just bs -> return (Just bs) send' :: IORef StreamState -> MVar () -> (Maybe BL.ByteString -> IO ()) - send' ref lock mbBs = withMVar lock $ \() -> assertNotClosed ref $ do - when (mbBs == Nothing) (closeRef ref) + send' ref lock mbBs = withMVar lock $ \() -> do + case mbBs of + Nothing -> closeRef ref + Just _ -> assertOpen ref onException (send mbBs) (closeRef ref) diff --git a/tests/haskell/Network/WebSockets/Server/Tests.hs b/tests/haskell/Network/WebSockets/Server/Tests.hs --- a/tests/haskell/Network/WebSockets/Server/Tests.hs +++ b/tests/haskell/Network/WebSockets/Server/Tests.hs @@ -7,7 +7,7 @@ -------------------------------------------------------------------------------- -import Control.Applicative ((<$>)) +import Control.Applicative ((<$>), (<|>)) import Control.Concurrent (forkIO, killThread, threadDelay) import Control.Exception (SomeException, catch, handle) @@ -39,7 +39,7 @@ [ testCase "simple server/client" testSimpleServerClient , testCase "bulk server/client" testBulkServerClient , testCase "onPong" testOnPong - , testCase "ipv6 server" testIPv6Server + , testCase "ipv6 server" testIpv6Server ] @@ -49,18 +49,17 @@ -------------------------------------------------------------------------------- --- | sets the TRAVIS environment variable to "true". -skipTravis :: Assertion -> Assertion -skipTravis assertion = do +-- | This is a bit ugly but it seems CI services don't support ipv6 in 2018. +skipIpv6Incompatible :: Assertion -> Assertion +skipIpv6Incompatible assertion = do env <- getEnvironment - case lookup "TRAVIS" env of + case lookup "TRAVIS" env <|> lookup "CIRCLECI" env of Just "true" -> return () _ -> assertion -------------------------------------------------------------------------------- --- | IPV6 is currently NOT supported on travis -testIPv6Server :: Assertion -testIPv6Server = skipTravis $ +testIpv6Server :: Assertion +testIpv6Server = skipIpv6Incompatible $ testServerClient "::1" $ \conn -> mapM_ (sendTextData conn) -------------------------------------------------------------------------------- diff --git a/websockets.cabal b/websockets.cabal --- a/websockets.cabal +++ b/websockets.cabal @@ -1,5 +1,5 @@ Name: websockets -Version: 0.12.2.0 +Version: 0.12.3.0 Synopsis: A sensible and clean way to write WebSocket-capable servers in Haskell. @@ -43,6 +43,10 @@ Extra-source-files: CHANGELOG +Source-repository head + Type: git + Location: https://github.com/jaspervdj/websockets + Flag Example Description: Build the example server Default: False @@ -78,7 +82,7 @@ attoparsec >= 0.10 && < 0.14, base >= 4.4 && < 5, base64-bytestring >= 0.1 && < 1.1, - binary >= 0.8.1 && < 0.9, + binary >= 0.8.1 && < 0.10, blaze-builder >= 0.3 && < 0.5, bytestring >= 0.9 && < 0.11, case-insensitive >= 0.3 && < 1.3, @@ -88,7 +92,7 @@ SHA >= 1.5 && < 1.7, streaming-commons >= 0.1 && < 0.2, text >= 0.10 && < 1.3, - entropy >= 0.2.1 && < 0.4 + entropy >= 0.2.1 && < 0.5 Test-suite websockets-tests Type: exitcode-stdio-1.0 @@ -123,10 +127,11 @@ Network.WebSockets.Tests Network.WebSockets.Tests.Util Network.WebSockets.Types + Paths_websockets Build-depends: HUnit >= 1.2 && < 1.7, - QuickCheck >= 2.7 && < 2.10, + QuickCheck >= 2.7 && < 2.11, test-framework >= 0.4 && < 0.9, test-framework-hunit >= 0.2 && < 0.4, test-framework-quickcheck2 >= 0.2 && < 0.4, @@ -134,7 +139,7 @@ attoparsec >= 0.10 && < 0.14, base >= 4 && < 5, base64-bytestring >= 0.1 && < 1.1, - binary >= 0.8.1 && < 0.9, + binary >= 0.8.1 && < 0.10, blaze-builder >= 0.3 && < 0.5, bytestring >= 0.9 && < 0.11, case-insensitive >= 0.3 && < 1.3, @@ -144,7 +149,7 @@ SHA >= 1.5 && < 1.7, streaming-commons >= 0.1 && < 0.2, text >= 0.10 && < 1.3, - entropy >= 0.2.1 && < 0.4 + entropy >= 0.2.1 && < 0.5 Executable websockets-example If !flag(Example) @@ -160,7 +165,7 @@ attoparsec >= 0.10 && < 0.14, base >= 4 && < 5, base64-bytestring >= 0.1 && < 1.1, - binary >= 0.8.1 && < 0.9, + binary >= 0.8.1 && < 0.10, blaze-builder >= 0.3 && < 0.5, bytestring >= 0.9 && < 0.11, case-insensitive >= 0.3 && < 1.3, @@ -169,12 +174,7 @@ random >= 1.0 && < 1.2, SHA >= 1.5 && < 1.7, text >= 0.10 && < 1.3, - entropy >= 0.2.1 && < 0.4 - -Source-repository head - Type: git - Location: https://github.com/jaspervdj/websockets - + entropy >= 0.2.1 && < 0.5 Executable websockets-autobahn If !flag(Example) @@ -184,13 +184,16 @@ Main-is: server.hs Ghc-options: -Wall -threaded -O2 -rtsopts "-with-rtsopts=-N" + Other-modules: + Paths_websockets + Build-depends: websockets, -- Copied from regular dependencies... attoparsec >= 0.10 && < 0.14, base >= 4 && < 5, base64-bytestring >= 0.1 && < 1.1, - binary >= 0.8.1 && < 0.9, + binary >= 0.8.1 && < 0.10, blaze-builder >= 0.3 && < 0.5, bytestring >= 0.9 && < 0.11, case-insensitive >= 0.3 && < 1.3, @@ -199,7 +202,7 @@ random >= 1.0 && < 1.2, SHA >= 1.5 && < 1.7, text >= 0.10 && < 1.3, - entropy >= 0.2.1 && < 0.4 + entropy >= 0.2.1 && < 0.5 Benchmark bench-mask Type: exitcode-stdio-1.0 @@ -216,7 +219,7 @@ attoparsec >= 0.10 && < 0.14, base >= 4 && < 5, base64-bytestring >= 0.1 && < 1.1, - binary >= 0.8.1 && < 0.9, + binary >= 0.8.1 && < 0.10, blaze-builder >= 0.3 && < 0.5, bytestring >= 0.9 && < 0.11, case-insensitive >= 0.3 && < 1.3, @@ -225,4 +228,4 @@ random >= 1.0 && < 1.2, SHA >= 1.5 && < 1.7, text >= 0.10 && < 1.3, - entropy >= 0.2.1 && < 0.4 + entropy >= 0.2.1 && < 0.5