ws-chans (empty) → 0.1.0.0
raw patch · 7 files changed
+280/−0 lines, 7 filesdep +HUnitdep +QuickCheckdep +asyncsetup-changed
Dependencies added: HUnit, QuickCheck, async, base, http-types, network, quickcheck-instances, test-framework, test-framework-quickcheck2, text, unagi-chan, wai, wai-websockets, warp, websockets, ws-chans
Files
- LICENSE +30/−0
- README.md +26/−0
- Setup.hs +2/−0
- src/Network/WebSockets/Chan/Unagi.hs +115/−0
- test/Network/WebSockets/Chan/UnagiSpec.hs +50/−0
- test/Spec.hs +7/−0
- ws-chans.cabal +50/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Author name here (c) 2017++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Author name here nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,26 @@+# ws-chans++[](https://travis-ci.org/shmish111/ws-chans)++Websockets represent a channel between a client and a server. `ws-chans` carries this concept deeper into your code by setting up an `Control.Concurrent.Chan.Unagi.InChan` and an `Control.Concurrent.Chan.Unagi.OutChan` as an interface to a websocket server. To send a message to the server you simply write a message to the `InChan`. To receive a message from the server you read from the `OutChan`.++The tests are probably the best place to look at some example usage but basically:++```haskell+import Control.Monad (forM, forever)+import Data.Text (Text)+import Network.WebSockets.Chan.Unagi as Unagi++example :: IO [Text]+example = do+ (ic, oc, cic) <- Unagi.newChans "localhost" 8080 "" :: IO (Unagi.InChan Text, Unagi.OutChan Text, Unagi.InChan Text)+ Unagi.writeList2Chan ic msgs+ res <- forM msgs (\_ -> Unagi.readChan oc)+ Unagi.writeChan cic ("finished" :: Text)+ return res+```++`newChans` returns a tuple of:+* an `InChan` which you write messages to, these will be sent to the websocket server+* an `OutChan` which you read messages from, these are messages that have come from the websocket server+* an `InChan` for closing the connection. This should have the same type as the first `InChan`. When you write a message to this `InChan` it will tell the server that you wish to close the connection. See the source code and [Network.WebSockets.sendClose](https://hackage.haskell.org/package/websockets-0.10.0.0/docs/Network-WebSockets.html#v:sendClose) for more information on how this works.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Network/WebSockets/Chan/Unagi.hs view
@@ -0,0 +1,115 @@+module Network.WebSockets.Chan.Unagi+ ( module Control.Concurrent.Chan.Unagi+ , newChans+ ) where++import Control.Concurrent.Async (Concurrently (..),+ runConcurrently)+import qualified Control.Concurrent.Async as A+import Control.Concurrent.Chan.Unagi+import qualified Control.Concurrent.Chan.Unagi as Unagi+import Control.Exception (SomeException (..), catch,+ finally, fromException, throw)+import Control.Monad (forever)+import qualified Network.Socket as S+import qualified Network.WebSockets as WS++type WSChan a b = (InChan a, OutChan b, InChan a)++newChans+ :: (WS.WebSocketsData a, WS.WebSocketsData b)+ => String -> Int -> String -> IO (WSChan a b)+newChans host port path = do+ (ic, sc) <- Unagi.newChan+ (rc, oc) <- Unagi.newChan+ (cic, coc) <- Unagi.newChan+ _ <-+ A.async $+ runRetryClientWith 10 host port path WS.defaultConnectionOptions [] $+ clientApp rc sc coc+ return (ic, oc, cic)++receiveData+ :: (WS.WebSocketsData b)+ => WS.Connection -> InChan b -> IO ()+receiveData conn ic =+ forever $ do+ msg <- WS.receiveData conn+ Unagi.writeChan ic msg++sendData+ :: (WS.WebSocketsData a)+ => WS.Connection -> OutChan a -> IO ()+sendData conn oc =+ forever $ do+ msg <- Unagi.readChan oc+ WS.sendBinaryData conn msg++sendClose+ :: (WS.WebSocketsData a)+ => WS.Connection -> OutChan a -> IO ()+sendClose conn coc = do+ msg <- Unagi.readChan coc+ putStrLn "closing client"+ WS.sendClose conn msg++clientApp+ :: (WS.WebSocketsData a, WS.WebSocketsData b)+ => InChan b -> OutChan a -> OutChan a -> WS.Connection -> IO ()+clientApp ic oc coc conn = do+ res <-+ runConcurrently $+ (,,) <$> Concurrently (receiveData conn ic) <*>+ Concurrently (sendData conn oc) <*>+ Concurrently (sendClose conn coc)+ print res+ return ()++runRetryClientWith+ :: Int+ -> String -- ^ Host+ -> Int -- ^ Port+ -> String -- ^ Path+ -> WS.ConnectionOptions -- ^ Options+ -> WS.Headers -- ^ Custom headers to send+ -> WS.ClientApp a -- ^ Client application+ -> IO a+runRetryClientWith retries host port path opts customHeaders app = do+ let hints =+ S.defaultHints {S.addrFamily = S.AF_INET, S.addrSocketType = S.Stream}+ -- Correct host and path.+ fullHost =+ if port == 80+ then host+ else host ++ ":" ++ show port+ path' =+ if null path+ then "/"+ else path+ addrInfos <- S.getAddrInfo (Just hints) (Just host) (Just $ show port)+ sock <- S.socket S.AF_INET S.Stream S.defaultProtocol+ S.setSocketOption sock S.NoDelay 1+ -- Connect WebSocket and run client+ finally+ ((S.connect sock (S.addrAddress $ head addrInfos) >>+ WS.runClientWithSocket sock fullHost path' opts customHeaders app) `catch`+ handler)+ (S.close sock)+ where+ handler e = do+ print e+ case fe e of+ (Just (WS.CloseRequest _ _)) -> throw e+ _ ->+ if retries > 0+ then runRetryClientWith+ (retries - 1)+ host+ port+ path+ opts+ customHeaders+ app+ else throw e+ fe :: SomeException -> Maybe WS.ConnectionException+ fe = fromException
+ test/Network/WebSockets/Chan/UnagiSpec.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.WebSockets.Chan.UnagiSpec where++import Control.Monad (forM, forever)+import Data.Text (Text)+import Network.HTTP.Types.Status (status400)+import Network.Wai (Application, responseLBS)+import qualified Network.Wai.Handler.Warp as Warp+import qualified Network.Wai.Handler.WebSockets as WSH+import Network.WebSockets (ServerApp)+import qualified Network.WebSockets as WS+import Network.WebSockets.Chan.Unagi as Unagi+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.QuickCheck (Property)+import Test.QuickCheck.Instances ()+import Test.QuickCheck.Monadic (assert, monadicIO, run)++app :: Application+app = WSH.websocketsOr WS.defaultConnectionOptions wsApp backupApp+ where+ wsApp :: ServerApp+ wsApp pending_conn = do+ conn <- WS.acceptRequest pending_conn+ forever $ do+ msg <- WS.receiveData conn :: IO Text+ WS.sendBinaryData conn msg+ backupApp :: Application+ backupApp _ respond =+ respond $ responseLBS status400 [] "Not a WebSocket request"++sendAndReceiveAction msgs =+ Warp.withApplication+ (return app)+ (\p -> do+ (ic, oc, cic) <-+ Unagi.newChans "localhost" p "" :: IO (Unagi.InChan Text, Unagi.OutChan Text, Unagi.InChan Text)+ Unagi.writeList2Chan ic msgs+ res <- forM msgs (\_ -> Unagi.readChan oc)+ Unagi.writeChan cic ("finished" :: Text)+ return res)++sendAndReceiveProps :: [Text] -> Property+sendAndReceiveProps msgs =+ monadicIO $ do+ run $ sendAndReceiveAction msgs+ assert True++tests = [testProperty "send and receive some text" sendAndReceiveProps]+
+ test/Spec.hs view
@@ -0,0 +1,7 @@+module Main where++import Network.WebSockets.Chan.UnagiSpec as US+import Test.Framework (defaultMain)++main :: IO ()+main = defaultMain US.tests
+ ws-chans.cabal view
@@ -0,0 +1,50 @@+name: ws-chans+version: 0.1.0.0+synopsis: Unagi chan based websocket client+description: Use Control.Concurrent.Chan.Unagi as an interface to a websocket server+homepage: https://github.com/shmish111/ws-chans+license: BSD3+license-file: LICENSE+author: David Smith+maintainer: david.smith@keemail.me+copyright: 2017 David Smith+category: Network+build-type: Simple+extra-source-files: README.md+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules: Network.WebSockets.Chan.Unagi+ build-depends: base >= 4.7 && < 5+ , async+ , network+ , unagi-chan >= 0.4+ , websockets+ default-language: Haskell2010++test-suite ws-chans-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ other-modules: Network.WebSockets.Chan.UnagiSpec+ build-depends: base+ , HUnit+ , test-framework-quickcheck2+ , http-types+ , QuickCheck+ , quickcheck-instances+ , test-framework+ , text+ , unagi-chan+ , wai+ , wai-websockets+ , warp+ , websockets+ , ws-chans+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/shmish111/ws-chans