diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,15 @@ +- 0.12.4.0 (2018-03-13) + * Remove `blaze-builder` dependency + * Bump `streaming-commons` dependency to 0.2 + * Bump `QuickCheck` dependency to 2.11 + * Fix compatibility with old GHC versions + * Re-export more functions from `Network.WebSockets` + - `sendDataMessages` + - `sendBinaryDatas` + - `sendCloseCode` + * Don't crash when sending the empty list of messages + * Add `SemiGroup` instance for `SizeLimit` + - 0.12.3.1 (2018-01-10) * Bump CHANGELOG with IPv6 warning * Run all autobahn tests during CI diff --git a/src/Network/WebSockets.hs b/src/Network/WebSockets.hs --- a/src/Network/WebSockets.hs +++ b/src/Network/WebSockets.hs @@ -34,10 +34,13 @@ , receiveData , send , sendDataMessage + , sendDataMessages , sendTextData , sendTextDatas , sendBinaryData + , sendBinaryDatas , sendClose + , sendCloseCode , sendPing -- * HTTP Types diff --git a/src/Network/WebSockets/Client.hs b/src/Network/WebSockets/Client.hs --- a/src/Network/WebSockets/Client.hs +++ b/src/Network/WebSockets/Client.hs @@ -11,7 +11,7 @@ -------------------------------------------------------------------------------- -import qualified Blaze.ByteString.Builder as Builder +import qualified Data.ByteString.Builder as Builder import Control.Exception (bracket, finally, throwIO) import Control.Monad (void) import Data.IORef (newIORef) diff --git a/src/Network/WebSockets/Connection.hs b/src/Network/WebSockets/Connection.hs --- a/src/Network/WebSockets/Connection.hs +++ b/src/Network/WebSockets/Connection.hs @@ -43,7 +43,7 @@ -------------------------------------------------------------------------------- -import qualified Blaze.ByteString.Builder as Builder +import qualified Data.ByteString.Builder as Builder import Control.Applicative ((<$>)) import Control.Concurrent (forkIO, threadDelay) @@ -309,6 +309,7 @@ -------------------------------------------------------------------------------- sendAll :: Connection -> [Message] -> IO () +sendAll _ [] = return () sendAll conn msgs = do when (any isCloseMessage msgs) $ writeIORef (connectionSentClose conn) True diff --git a/src/Network/WebSockets/Connection/Options.hs b/src/Network/WebSockets/Connection/Options.hs --- a/src/Network/WebSockets/Connection/Options.hs +++ b/src/Network/WebSockets/Connection/Options.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -------------------------------------------------------------------------------- module Network.WebSockets.Connection.Options ( ConnectionOptions (..) @@ -109,10 +110,16 @@ instance Monoid SizeLimit where mempty = NoSizeLimit +#if !MIN_VERSION_base(4,11,0) mappend NoSizeLimit y = y mappend x NoSizeLimit = x mappend (SizeLimit x) (SizeLimit y) = SizeLimit (min x y) - +#else +instance Semigroup SizeLimit where + (<>) NoSizeLimit y = y + (<>) x NoSizeLimit = x + (<>) (SizeLimit x) (SizeLimit y) = SizeLimit (min x y) +#endif -------------------------------------------------------------------------------- atMostSizeLimit :: Int64 -> SizeLimit -> Bool diff --git a/src/Network/WebSockets/Extensions/Description.hs b/src/Network/WebSockets/Extensions/Description.hs --- a/src/Network/WebSockets/Extensions/Description.hs +++ b/src/Network/WebSockets/Extensions/Description.hs @@ -14,7 +14,7 @@ import qualified Data.Attoparsec.ByteString as A import qualified Data.Attoparsec.ByteString.Char8 as AC8 import qualified Data.ByteString as B -import Data.Monoid (mconcat, (<>)) +import Data.Monoid (mconcat, mappend) import Prelude type ExtensionParam = (B.ByteString, Maybe B.ByteString) @@ -48,10 +48,10 @@ encodeExtensionDescription :: ExtensionDescription -> B.ByteString encodeExtensionDescription ExtensionDescription {..} = - extName <> mconcat (map encodeParam extParams) + mconcat (extName : map encodeParam extParams) where - encodeParam (key, Nothing) = ";" <> key - encodeParam (key, Just val) = ";" <> key <> "=" <> val + encodeParam (key, Nothing) = ";" `mappend` key + encodeParam (key, Just val) = ";" `mappend` key `mappend` "=" `mappend` val type ExtensionDescriptions = [ExtensionDescription] diff --git a/src/Network/WebSockets/Http.hs b/src/Network/WebSockets/Http.hs --- a/src/Network/WebSockets/Http.hs +++ b/src/Network/WebSockets/Http.hs @@ -31,8 +31,8 @@ -------------------------------------------------------------------------------- -import qualified Blaze.ByteString.Builder as Builder -import qualified Blaze.ByteString.Builder.Char.Utf8 as Builder +import qualified Data.ByteString.Builder as Builder +import qualified Data.ByteString.Builder.Extra as Builder import Control.Applicative (pure, (*>), (<$>), (<*), (<*>)) import Control.Exception (Exception) @@ -114,21 +114,21 @@ -------------------------------------------------------------------------------- encodeRequestHead :: RequestHead -> Builder.Builder encodeRequestHead (RequestHead path headers _) = - Builder.copyByteString "GET " `mappend` - Builder.copyByteString path `mappend` - Builder.copyByteString " HTTP/1.1" `mappend` - Builder.fromByteString "\r\n" `mappend` + Builder.byteStringCopy "GET " `mappend` + Builder.byteStringCopy path `mappend` + Builder.byteStringCopy " HTTP/1.1" `mappend` + Builder.byteString "\r\n" `mappend` mconcat (map header headers) `mappend` - Builder.copyByteString "\r\n" + Builder.byteStringCopy "\r\n" where - header (k, v) = mconcat $ map Builder.copyByteString + header (k, v) = mconcat $ map Builder.byteStringCopy [CI.original k, ": ", v, "\r\n"] -------------------------------------------------------------------------------- encodeRequest :: Request -> Builder.Builder encodeRequest (Request head' body) = - encodeRequestHead head' `mappend` Builder.copyByteString body + encodeRequestHead head' `mappend` Builder.byteStringCopy body -------------------------------------------------------------------------------- @@ -151,22 +151,22 @@ -- | Encode an HTTP upgrade response encodeResponseHead :: ResponseHead -> Builder.Builder encodeResponseHead (ResponseHead code msg headers) = - Builder.copyByteString "HTTP/1.1 " `mappend` - Builder.fromString (show code) `mappend` - Builder.fromChar ' ' `mappend` - Builder.fromByteString msg `mappend` - Builder.fromByteString "\r\n" `mappend` + Builder.byteStringCopy "HTTP/1.1 " `mappend` + Builder.stringUtf8 (show code) `mappend` + Builder.charUtf8 ' ' `mappend` + Builder.byteString msg `mappend` + Builder.byteString "\r\n" `mappend` mconcat (map header headers) `mappend` - Builder.copyByteString "\r\n" + Builder.byteStringCopy "\r\n" where - header (k, v) = mconcat $ map Builder.copyByteString + header (k, v) = mconcat $ map Builder.byteStringCopy [CI.original k, ": ", v, "\r\n"] -------------------------------------------------------------------------------- encodeResponse :: Response -> Builder.Builder encodeResponse (Response head' body) = - encodeResponseHead head' `mappend` Builder.copyByteString body + encodeResponseHead head' `mappend` Builder.byteStringCopy body -------------------------------------------------------------------------------- diff --git a/src/Network/WebSockets/Hybi13.hs b/src/Network/WebSockets/Hybi13.hs --- a/src/Network/WebSockets/Hybi13.hs +++ b/src/Network/WebSockets/Hybi13.hs @@ -17,7 +17,7 @@ -------------------------------------------------------------------------------- -import qualified Blaze.ByteString.Builder as B +import qualified Data.ByteString.Builder as B import Control.Applicative (pure, (<$>)) import Control.Arrow (first) import Control.Exception (throwIO) @@ -122,9 +122,9 @@ -------------------------------------------------------------------------------- encodeFrame :: Maybe Mask -> Frame -> B.Builder -encodeFrame mask f = B.fromWord8 byte0 `mappend` - B.fromWord8 byte1 `mappend` len `mappend` maskbytes `mappend` - B.fromLazyByteString (maskPayload mask payload) +encodeFrame mask f = B.word8 byte0 `mappend` + B.word8 byte1 `mappend` len `mappend` maskbytes `mappend` + B.lazyByteString (maskPayload mask payload) where byte0 = fin .|. rsv1 .|. rsv2 .|. rsv3 .|. opcode @@ -154,8 +154,8 @@ len' = BL.length payload (lenflag, len) | len' < 126 = (fromIntegral len', mempty) - | len' < 0x10000 = (126, B.fromWord16be (fromIntegral len')) - | otherwise = (127, B.fromWord64be (fromIntegral len')) + | len' < 0x10000 = (126, B.word16BE (fromIntegral len')) + | otherwise = (127, B.word64BE (fromIntegral len')) -------------------------------------------------------------------------------- diff --git a/src/Network/WebSockets/Hybi13/Demultiplex.hs b/src/Network/WebSockets/Hybi13/Demultiplex.hs --- a/src/Network/WebSockets/Hybi13/Demultiplex.hs +++ b/src/Network/WebSockets/Hybi13/Demultiplex.hs @@ -13,8 +13,8 @@ -------------------------------------------------------------------------------- -import Blaze.ByteString.Builder (Builder) -import qualified Blaze.ByteString.Builder as B +import Data.ByteString.Builder (Builder) +import qualified Data.ByteString.Builder as B import Control.Exception (Exception) import Data.Binary.Get (getWord16be, runGet) import qualified Data.ByteString.Lazy as BL @@ -136,7 +136,7 @@ where size = BL.length pl - plb = B.fromLazyByteString pl + plb = B.lazyByteString pl text x = DataMessage rsv1 rsv2 rsv3 (Text x Nothing) binary x = DataMessage rsv1 rsv2 rsv3 (Binary x) @@ -151,7 +151,7 @@ where size1 = size0 + BL.length pl b' = b `mappend` plb - plb = B.fromLazyByteString pl + plb = B.lazyByteString pl demultiplex _ _ _ = (DemultiplexError (CloseRequest 1002 "Protocol Error"), emptyDemultiplexState) diff --git a/src/Network/WebSockets/Hybi13/Mask.hs b/src/Network/WebSockets/Hybi13/Mask.hs --- a/src/Network/WebSockets/Hybi13/Mask.hs +++ b/src/Network/WebSockets/Hybi13/Mask.hs @@ -15,7 +15,8 @@ -------------------------------------------------------------------------------- -import qualified Blaze.ByteString.Builder as Builder +import qualified Data.ByteString.Builder as Builder +import qualified Data.ByteString.Builder.Extra as Builder import Data.Binary.Get (Get, getWord32host) import qualified Data.ByteString.Internal as B import qualified Data.ByteString.Lazy as BL @@ -48,7 +49,7 @@ -------------------------------------------------------------------------------- -- | Encode a mask encodeMask :: Mask -> Builder.Builder -encodeMask = Builder.fromStorable . unMask +encodeMask = Builder.word32Host . unMask -------------------------------------------------------------------------------- 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 @@ -29,7 +29,6 @@ -------------------------------------------------------------------------------- import Network.WebSockets -import Network.WebSockets.Connection import Network.WebSockets.Tests.Util diff --git a/tests/haskell/Network/WebSockets/Tests.hs b/tests/haskell/Network/WebSockets/Tests.hs --- a/tests/haskell/Network/WebSockets/Tests.hs +++ b/tests/haskell/Network/WebSockets/Tests.hs @@ -7,7 +7,7 @@ -------------------------------------------------------------------------------- -import qualified Blaze.ByteString.Builder as Builder +import qualified Data.ByteString.Builder as Builder import Control.Applicative ((<$>)) import Control.Concurrent (forkIO) import Control.Exception (try) @@ -16,6 +16,7 @@ import qualified Data.ByteString.Lazy as BL import Data.List (intersperse) import Data.Maybe (catMaybes) +import Data.Monoid (mempty, mconcat) import Network.WebSockets import qualified Network.WebSockets.Hybi13 as Hybi13 import Network.WebSockets.Hybi13.Demultiplex diff --git a/websockets.cabal b/websockets.cabal --- a/websockets.cabal +++ b/websockets.cabal @@ -1,5 +1,5 @@ Name: websockets -Version: 0.12.3.1 +Version: 0.12.4.0 Synopsis: A sensible and clean way to write WebSocket-capable servers in Haskell. @@ -80,17 +80,17 @@ Build-depends: attoparsec >= 0.10 && < 0.14, - base >= 4.4 && < 5, + base >= 4.6 && < 5, base64-bytestring >= 0.1 && < 1.1, binary >= 0.8.1 && < 0.10, - blaze-builder >= 0.3 && < 0.5, bytestring >= 0.9 && < 0.11, + bytestring-builder < 0.11, case-insensitive >= 0.3 && < 1.3, containers >= 0.3 && < 0.6, network >= 2.3 && < 2.7, random >= 1.0 && < 1.2, SHA >= 1.5 && < 1.7, - streaming-commons >= 0.1 && < 0.2, + streaming-commons >= 0.1 && < 0.3, text >= 0.10 && < 1.3, entropy >= 0.2.1 && < 0.5 @@ -131,7 +131,7 @@ Build-depends: HUnit >= 1.2 && < 1.7, - QuickCheck >= 2.7 && < 2.11, + QuickCheck >= 2.7 && < 2.12, test-framework >= 0.4 && < 0.9, test-framework-hunit >= 0.2 && < 0.4, test-framework-quickcheck2 >= 0.2 && < 0.4, @@ -140,14 +140,14 @@ base >= 4 && < 5, base64-bytestring >= 0.1 && < 1.1, binary >= 0.8.1 && < 0.10, - blaze-builder >= 0.3 && < 0.5, bytestring >= 0.9 && < 0.11, + bytestring-builder < 0.11, case-insensitive >= 0.3 && < 1.3, containers >= 0.3 && < 0.6, network >= 2.3 && < 2.7, random >= 1.0 && < 1.2, SHA >= 1.5 && < 1.7, - streaming-commons >= 0.1 && < 0.2, + streaming-commons >= 0.1 && < 0.3, text >= 0.10 && < 1.3, entropy >= 0.2.1 && < 0.5 @@ -166,8 +166,8 @@ base >= 4 && < 5, base64-bytestring >= 0.1 && < 1.1, binary >= 0.8.1 && < 0.10, - blaze-builder >= 0.3 && < 0.5, bytestring >= 0.9 && < 0.11, + bytestring-builder < 0.11, case-insensitive >= 0.3 && < 1.3, containers >= 0.3 && < 0.6, network >= 2.3 && < 2.7, @@ -194,8 +194,8 @@ base >= 4 && < 5, base64-bytestring >= 0.1 && < 1.1, binary >= 0.8.1 && < 0.10, - blaze-builder >= 0.3 && < 0.5, bytestring >= 0.9 && < 0.11, + bytestring-builder < 0.11, case-insensitive >= 0.3 && < 1.3, containers >= 0.3 && < 0.6, network >= 2.3 && < 2.7, @@ -220,8 +220,8 @@ base >= 4 && < 5, base64-bytestring >= 0.1 && < 1.1, binary >= 0.8.1 && < 0.10, - blaze-builder >= 0.3 && < 0.5, bytestring >= 0.9 && < 0.11, + bytestring-builder < 0.11, case-insensitive >= 0.3 && < 1.3, containers >= 0.3 && < 0.6, network >= 2.3 && < 2.7,