summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorigrep <>2018-06-13 08:37:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2018-06-13 08:37:00 (GMT)
commit4867868cf382d5007c72ae1a94173a1777fe9e2d (patch)
treedbeab0a0e37e50e85aec17f5987d8a20f4e666c1
version 0.1.0.00.1.0.0
-rw-r--r--LICENSE13
-rw-r--r--README.md24
-rw-r--r--Setup.hs2
-rw-r--r--app/sample.hs32
-rw-r--r--src/Network/WebSockets/Client.hs122
-rw-r--r--test/Spec.hs1
-rw-r--r--wss-client.cabal58
7 files changed, 252 insertions, 0 deletions
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..4e6052b
--- /dev/null
+++ b/LICENSE
@@ -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.
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..06ae0de
--- /dev/null
+++ b/README.md
@@ -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
+```
+-->
+
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/app/sample.hs b/app/sample.hs
new file mode 100644
index 0000000..f2364cf
--- /dev/null
+++ b/app/sample.hs
@@ -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
diff --git a/src/Network/WebSockets/Client.hs b/src/Network/WebSockets/Client.hs
new file mode 100644
index 0000000..9827a07
--- /dev/null
+++ b/src/Network/WebSockets/Client.hs
@@ -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
diff --git a/test/Spec.hs b/test/Spec.hs
new file mode 100644
index 0000000..a824f8c
--- /dev/null
+++ b/test/Spec.hs
@@ -0,0 +1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
diff --git a/wss-client.cabal b/wss-client.cabal
new file mode 100644
index 0000000..1a43e94
--- /dev/null
+++ b/wss-client.cabal
@@ -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