wss-client (empty) → 0.1.0.0
raw patch · 7 files changed
+252/−0 lines, 7 filesdep +QuickCheckdep +basedep +bytestringsetup-changed
Dependencies added: QuickCheck, base, bytestring, hspec, http-client, http-client-tls, network-uri, websockets, wss-client
Files
- LICENSE +13/−0
- README.md +24/−0
- Setup.hs +2/−0
- app/sample.hs +32/−0
- src/Network/WebSockets/Client.hs +122/−0
- test/Spec.hs +1/−0
- wss-client.cabal +58/−0
+ LICENSE view
@@ -0,0 +1,13 @@+Copyright 2018 Yuji Yamamoto++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.
+ README.md view
@@ -0,0 +1,24 @@+# wss-client++A-little-higher-level WebSocket client library. +Thanks to [http-client](https://hackage.haskell.org/package/http-client) and [http-client-tls](https://hackage.haskell.org/package/http-client-tls), this package supports `HTTP_PROXY` environment variable and TLS.++## TODO++- Support non-TLS connection via an HTTP proxy server (I have to modify the [websockets](https://hackage.haskell.org/package/websockets) package to do that).+- Add APIs to modify config of both http-client and websockets.+- Test with a mock server.++<!-- Uncomment after uploading on Hackage.++## Example++An example program is here: [app/sample.hs](app/sample.hs). +Build the executable by enabling build-sample flag:++```bash+stack unpack wss-client+stack install wss-client --flag wss-client:build-sample+```+-->+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/sample.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++-- | Sample application of wss-client.+-- A simple command like wscat.+++import Control.Monad (forever, unless)+import Control.Concurrent (forkIO, killThread)+import qualified Data.ByteString.Char8 as B+import System.Environment (getArgs)+import qualified Network.WebSockets.Client as WS+++main :: IO ()+main = do+ url <- head <$> getArgs+ WS.withClient url $ \conn -> do+ tid <- forkIO $ forever $ do+ msg <- WS.receiveData conn+ B.putStrLn msg++ let loop = do+ line <- B.getLine+ unless (B.null line || line == "\r")+ $ WS.sendTextData conn line+ >> loop++ loop+ WS.sendClose conn $ B.pack "Bye!"+ killThread tid
+ src/Network/WebSockets/Client.hs view
@@ -0,0 +1,122 @@+-- | A-little-bit-higher-level WebSocket client library.+--+-- Thanks to [http-client](https://hackage.haskell.org/package/http-client) and [http-client-tls](https://hackage.haskell.org/package/http-client-tls), functions in this module support @HTTP_PROXY@ environment variable and TLS.+--+-- __NOTE__: Currently, non-TLS connection via an HTTP proxy server+-- is NOT supported.++module Network.WebSockets.Client+ ( withClient++ -- * Re-export from Network.WebSockets+ , WS.Connection++ -- ** Sending and receiving messages+ , WS.receive+ , WS.receiveDataMessage+ , WS.receiveData+ , WS.send+ , WS.sendDataMessage+ , WS.sendDataMessages+ , WS.sendTextData+ , WS.sendTextDatas+ , WS.sendBinaryData+ , WS.sendBinaryDatas+ , WS.sendClose+ , WS.sendCloseCode+ , WS.sendPing++ -- ** WebSocket message types+ , WS.Message (..)+ , WS.ControlMessage (..)+ , WS.DataMessage (..)+ , WS.WebSocketsData (..)++ -- ** Exceptions+ , WS.HandshakeException (..)+ , WS.ConnectionException (..)++ -- ** Utilities+ , WS.forkPingThread+ ) where+++import qualified Control.Exception as E+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BSL+import qualified Network.HTTP.Client as Http+import qualified Network.HTTP.Client.Internal as Http+import Network.HTTP.Client.TLS (tlsManagerSettings)+import qualified Network.WebSockets as WS+import qualified Network.WebSockets.Stream as WS+import Network.URI (parseURI, URI(..), URIAuth(..))++-- | The main entrypoint to connect by the WebSocket protocol.+-- This function automatically closes the created connection+-- after exiting the action.+--+-- If @HTTP_PROXY@ environment variable is set,+-- The connection is automatically made via the HTTP proxy server+-- specified by the variable.+--+-- __NOTE__: Currently, non-TLS connection via an HTTP proxy server+-- is NOT supported.+withClient+ :: String -- ^ Endpoint URL (e.g. wss:\/\/example.com\/path).+ -> (WS.Connection -> IO a) -- ^ Action using the 'WS.Connection'+ -> IO a+withClient url action = do+ man <- Http.newManager tlsManagerSettings+ withWsClientFromManager man url action+++withWsClientFromManager+ :: Http.Manager -> String -> (WS.Connection -> IO a) -> IO a+withWsClientFromManager man rawUrl action = do+ (isSecure, host, path) <- parseWsUrl rawUrl++ let httpUrl = (if isSecure then "https://" else "http://") ++ host ++ path+ req <- Http.parseRequest $ "GET " ++ httpUrl++ Http.withConnection req man $ \httpConn -> do+ E.bracket+ ( do+ let r = do+ bs <- Http.connectionRead httpConn+ return $ if BS.null bs then Nothing else Just bs++ w = maybe (Http.connectionClose httpConn)+ (Http.connectionWrite httpConn . BSL.toStrict)+ WS.makeStream r w+ )+ WS.close+ ( \stream -> do+ -- TODO: configure WS.ConnectionOptions+ WS.runClientWithStream stream+ host+ path+ WS.defaultConnectionOptions+ []+ action+ )+++parseWsUrl :: String -> IO (Bool, String, String)+parseWsUrl raw = do+ uri <- noteInvalidUrl "Invalid URL given" $ parseURI raw+ auth <- noteInvalidUrl "No authroity specified" $ uriAuthority uri+ host <- dieWhenEmpty "No host specified" $ uriRegName auth+ let wss = "wss:"+ scheme' = uriScheme uri+ scheme = if null scheme' then wss else scheme'+ isSecure = scheme == wss+ path = uriPath uri ++ uriQuery uri ++ uriFragment uri+ return (isSecure, host, if null path then "/" else path)+ where+ noteInvalidUrl :: String -> Maybe a -> IO a+ noteInvalidUrl msg =+ maybe (E.throwIO $ Http.InvalidUrlException raw msg) return++ dieWhenEmpty :: String -> String -> IO String+ dieWhenEmpty msg "" = E.throwIO $ Http.InvalidUrlException raw msg+ dieWhenEmpty _ s = return s
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ wss-client.cabal view
@@ -0,0 +1,58 @@+name: wss-client+version: 0.1.0.0+synopsis: A-little-higher-level WebSockets client.+description: A-little-higher-level WebSockets client. Based on http-client and http-client-tls.+homepage: https://github.com/iij-ii/wss-client+license: Apache-2.0+license-file: LICENSE+author: Yuji Yamamoto+maintainer: yuji-yamamoto@iij.ad.jp+copyright: 2018 Yuji Yamamoto+category: Network+build-type: Simple+extra-source-files: README.md+cabal-version: >=1.10++flag build-sample+ description: Build sample file.+ default: False+ manual: True++library+ hs-source-dirs: src+ exposed-modules: Network.WebSockets.Client+ build-depends: base >= 4.7 && < 5+ , bytestring+ , http-client >= 0.5.13+ , http-client-tls+ , network-uri+ , websockets >= 0.12.0 && < 0.13+ default-language: Haskell2010++executable wss-client-sample+ if flag(build-sample)+ buildable: True+ else+ buildable: False+ hs-source-dirs: app+ main-is: sample.hs+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends: base+ , wss-client+ , bytestring+ default-language: Haskell2010++test-suite wss-client-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ build-depends: base+ , wss-client+ , hspec+ , QuickCheck+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/iij-ii/wss-client