network-simple-ws 0.1 → 0.2

raw patch · 4 files changed

+135/−50 lines, 4 filesdep +asyncsetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: async

API changes (from Hackage documentation)

Files

• Setup.hs +0/−4
• changelog.md +18/−0
• network-simple-ws.cabal +9/−6
• src/Network/Simple/WS.hs +108/−40

@@ -1,4 +0,0 @@-#! /usr/bin/env nix-shell-#! nix-shell ./shell.nix -i runghc-import Distribution.Simple-main = defaultMain

@@ -1,3 +1,21 @@+# Version 0.2++* /COMPILER ASSISTED BREAKING CHANGE:/ `send` and `recv` now use+  lazy `ByteString`s. ++* /COMPILER ASSISTED BREAKING CHANGE:/ `recv`'s close semantics have +  improved. See its documentation for details.++* Added `close`.++* Depend on `websockets >=0.12.6`.+++# Version 0.1.1++* Removed accidental `print`.++ # Version 0.1  * First release.

@@ -1,28 +1,31 @@+cabal-version: 2.4 name: network-simple-ws-version: 0.1+version: 0.2 synopsis: Simple interface to WebSockets. description: Simple interface to WebSockets.-homepage: https://github.com/k0001/network-simple-ws-bug-reports: https://github.com/k0001/network-simple-ws/issues-license: BSD3+homepage: https://hackage.haskell.org/package/network-simple-ws+bug-reports: https://github.com/k0001/network-simple/issues+license: BSD-3-Clause license-file: LICENSE author: Renzo Carbonara maintainer: renλren.zone copyright: Copyright (c) Renzo Carbonara 2018 category: Network build-type: Simple-cabal-version: >=1.8 extra-source-files: README.md changelog.md  source-repository head   type: git-  location: https://github.com/k0001/network-simple-ws+  location: https://github.com/k0001/network-simple+  subdir: network-simple-ws  library+  default-language:  Haskell2010   hs-source-dirs: src   ghc-options: -Wall -O2   exposed-modules: Network.Simple.WS   build-depends:+    async,     base >=4.7 && <5.0,     bytestring,     case-insensitive,

@@ -1,3 +1,5 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -12,9 +14,11 @@ -- intreresting from a client's point of view. Server side support will come -- later. module Network.Simple.WS- ( W.Connection- , send+ ( -- * Sending and receiving+   W.Connection  , recv+ , send+ , close    -- * Client side  , connect  , connectSOCKS5@@ -24,6 +28,8 @@  ) where  +import Control.Concurrent.Async (Async)+import qualified Control.Concurrent.Async as Async import Control.Monad.IO.Class (MonadIO, liftIO) import qualified Control.Exception.Safe as Ex import Data.Bifunctor (first)@@ -32,10 +38,12 @@ import qualified Data.ByteString.Lazy as BL import qualified Data.CaseInsensitive as CI import Data.Foldable (traverse_)-import Data.Function (fix)+import Data.Word+import GHC.IO.Exception as IO  import qualified Network.Simple.TCP as T import qualified Network.WebSockets as W+import qualified Network.WebSockets.Connection as W (pingThread) import qualified Network.WebSockets.Stream as W (Stream, makeStream, close)  --------------------------------------------------------------------------------@@ -57,23 +65,25 @@   -- (e.g., @[(\"Authorization\", \"Basic dXNlcjpwYXNzd29yZA==\")]@).   -> ((W.Connection, T.SockAddr) -> m r)   -- ^ Computation to run after establishing a WebSockets to the remote-  -- server. Takes the WebSockets connection and remote end address.+  -- server. Takes the WebSockets 'W.Connection' and remote end address.   -> m r connect hn sn res hds act = do   T.connect hn sn $ \(sock, saddr) -> do     Ex.bracket (streamFromSocket sock) (liftIO . W.close) $ \stream -> do       conn <- clientConnectionFromStream stream hn sn res hds-      liftIO (W.forkPingThread conn 30)-      act (conn, saddr)+      withAsync (W.pingThread conn 30 (pure ())) $ \_ ->+        act (conn, saddr)  -- | Like 'connect', but connects to the destination server through a SOCKS5 -- proxy. connectSOCKS5   :: (MonadIO m, Ex.MonadMask m)-  => T.HostName -- ^ SOCKS5 proxy server hostname or IP address.-  -> T.ServiceName -- ^ SOCKS5 proxy server service port name or number.+  => T.HostName+  -- ^ SOCKS5 proxy server hostname or IP address.+  -> T.ServiceName+  -- ^ SOCKS5 proxy server service port name or number.   -> T.HostName-  -- ^ Destination WebSocket server hostname or IP address. We connect to this+  -- ^ Destination WebSockets server hostname or IP address. We connect to this   -- host /through/ the SOCKS5 proxy specified in the previous arguments.   --   -- Note that if hostname resolution on this 'T.HostName' is necessary, it@@ -95,20 +105,21 @@  -> m r connectSOCKS5 phn psn dhn dsn res hds act = do   T.connectSOCKS5 phn psn dhn dsn $ \(sock, pa, da) -> do-    liftIO (print (pa, da))     Ex.bracket (streamFromSocket sock) (liftIO . W.close) $ \stream -> do       conn <- clientConnectionFromStream stream dhn dsn res hds-      liftIO (W.forkPingThread conn 30)-      act (conn, pa, da)+      withAsync (W.pingThread conn 30 (pure ())) $ \_ ->+        act (conn, pa, da) --- | Obtain a 'W.Connection' to the specified 'Uri' over the given 'W.Stream',+-- | Obtain a 'W.Connection' to the specified URI over the given 'W.Stream', -- connected to either a WebSockets server, or a Secure WebSockets server. clientConnectionFromStream   :: MonadIO m-  => W.Stream -- ^ Stream on which to establish the WebSockets connection.+  => W.Stream+  -- ^ Stream on which to establish the WebSockets connection.   -> T.HostName   -- ^ WebSockets server host name (e.g., @\"www.example.com\"@ or IP address).-  -> T.ServiceName -- ^ WebSockets server port (e.g., @\"443\"@ or @\"www\"@).+  -> T.ServiceName+  -- ^ WebSockets server port (e.g., @\"443\"@ or @\"www\"@).   -> B.ByteString   -- ^ WebSockets resource (e.g., @\"/foo\/qux?bar=wat&baz\"@).   --@@ -116,7 +127,8 @@   -> [(B.ByteString, B.ByteString)]   -- ^ Extra HTTP Headers   -- (e.g., @[(\"Authorization\", \"Basic dXNlcjpwYXNzd29yZA==\")]@).-  -> m W.Connection -- ^ Established WebSockets connection+  -> m W.Connection+  -- ^ Established WebSockets connection clientConnectionFromStream stream hn sn res hds = liftIO $ do   let res' :: String = '/' : dropWhile (=='/') (B8.unpack res)       hds' :: W.Headers = map (first CI.mk) hds@@ -137,36 +149,92 @@ streamFromSocket sock = liftIO $ do   W.makeStream (T.recv sock 4096) (traverse_ (T.sendLazy sock)) --- | Receive bytes from the remote end.+-- | Receive a single full WebSockets message from the remote end as a lazy+-- 'BL.ByteString' (potentially 'BL.empty'). ----- Returns a strict 'BL.ByteString'.+-- Throws 'IO.IOException' if there is an unexpected 'W.Connection' error. ----- Returns an empty string when the remote end gracefully closes the connection.+-- If the remote end requested the 'W.Connection' to be closed, then 'Left'+-- will be returned instead, with a close code and reason description.+--+-- * See https://datatracker.ietf.org/doc/html/rfc6455#section-7.4 for details+-- about the close codes.+--+-- * Do not use 'recv' after receiving a close request.+--+-- * If you receive a close request after after having sent a close request+-- yourself (see 'close'), then the WebSocket 'W.Connection' is+-- considered closed and you can proceed to close the underlying transport.+--+-- * If you didn't send a close request before, then you may continue to use+-- 'send', but you are expected to perform 'close' as soon as possible in order+-- to indicate a graceful closing of the connection. --- Note: The WebSockets protocol supports the silly idea of sending text, rather--- than bytes, over the socket. We don't support that. If necessary, users can--- find support for this in the `websockets` library.-recv :: MonadIO m => W.Connection -> m B.ByteString-{-# INLINABLE recv #-}-recv c = liftIO $ fix $ \k -> do-  ea <- Ex.try (W.receiveDataMessage c)-  case ea of-     Right (W.Binary bl) -> if BL.null bl then k else pure (BL.toStrict bl)-     Right (W.Text bl _) -> if BL.null bl then k else pure (BL.toStrict bl)-     Left (W.CloseRequest 1000 _) -> pure B.empty-     Left (W.CloseRequest 1001 _) -> pure B.empty-     Left e -> Ex.throw e+-- Note: The WebSockets protocol supports the silly idea of sending text+-- rather than bytes. We don't support that. If necessary, you can find support+-- for this in the `websockets` library.+recv :: MonadIO m+     => W.Connection+     -> m (Either (Word16, BL.ByteString) BL.ByteString)+recv conn = liftIO $ Ex.try (W.receiveDataMessage conn) >>= \case+  Right (W.Binary !bl) -> pure $ Right bl+  Right (W.Text !bl _) -> pure $ Right bl+  Left (W.CloseRequest !w !bl) -> pure $ Left (w, bl)+  Left W.ConnectionClosed ->+    Ex.throw $ ioe "recv" IO.ResourceVanished "Connection closed"+  Left (W.ParseException s) ->+    Ex.throw $ ioe "recv" IO.ProtocolError ("WebSocket parsing error: " <> s)+  Left (W.UnicodeException s) ->+    Ex.throw $ ioe "recv" IO.ProtocolError ("WebSocket UTF-8 error: " <> s) --- | Send bytes to the remote end.+-- | Send a lazy 'BL.ByteString' (potentially 'BL.empty') to the remote end as+-- a single WebSockets message, in potentially multiple frames. ----- Takes a lazy 'BL.ByteString'.+-- If there is an issue with the 'W.Connection', an exception originating from+-- the underlying 'W.Stream' will be thrown. --- Note: The WebSockets protocol supports the silly idea of sending text, rather--- than bytes, over the socket. We don't support that. If necessary, users can+-- Note: The WebSockets protocol supports the silly idea of sending text rather+-- than bytes. We don't support that. If necessary, users can -- find support for this in the `websockets` library. send :: MonadIO m => W.Connection -> BL.ByteString -> m ()-{-# INLINABLE send #-}-send c = \bl -> case BL.null bl of-  True -> pure ()-  False -> liftIO (W.sendDataMessage c (W.Binary bl))+send conn = liftIO . W.sendDataMessage conn . W.Binary +-- | Send a close request to the remote end.+--+-- After sending this request you should not use 'send' anymore, but you+-- should still continue to call 'recv' to process any pending incomming+-- messages. As soon as 'recv' returns 'Left', you can consider the WebSocket+-- 'W.Connection' closed and can proceed to close the underlying transport.+--+-- If there is an issue with the 'W.Connection', an exception originating from+-- the underlying 'W.Stream' will be thrown.+close :: MonadIO m+      => W.Connection+      -> Word16        -- ^ Close code.+      -> BL.ByteString -- ^ Reason for closing.+      -> m ()+close conn w bl = liftIO $ W.sendCloseCode conn w bl++-- | Like 'Async.async', but generalized to 'Ex.MonadMask' and 'MonadIO'.+withAsync+  :: (Ex.MonadMask m, MonadIO m)+  => IO a+  -> (Async a -> m b)+  -> m b+withAsync io = Ex.bracket+  (liftIO $ Async.asyncWithUnmask (\u -> u io))+  (liftIO . Async.uninterruptibleCancel)++-- | Construct a 'IO.IOError' relevant to this module.+ioe :: String  -- ^ Location+    -> IO.IOErrorType+    -> String  -- ^ Description+    -> IO.IOError+ioe l t s = IO.IOError+  { IO.ioe_type = t+  , IO.ioe_location = "Network.Simple.WS." <> l+  , IO.ioe_description = s+  , IO.ioe_errno = Nothing+  , IO.ioe_handle = Nothing+  , IO.ioe_filename = Nothing+  }