ws 0.0.3 → 0.0.4
raw patch · 5 files changed
+149/−69 lines, 5 filesdep +attoparsecdep +attoparsec-uridep +strictdep −network-uridep ~basedep ~websockets
Dependencies added: attoparsec, attoparsec-uri, strict, vector
Dependencies removed: network-uri
Dependency ranges changed: base, websockets
Files
- README.md +36/−0
- app/Main.hs +35/−23
- src/App.hs +6/−2
- src/App/Types.hs +0/−4
- ws.cabal +72/−40
+ README.md view
@@ -0,0 +1,36 @@+# ws++A really trivial websocket client for debugging and testing.++## Installation / Building++```bash+git clone http://github.com/athanclark/ws+```++Then depending on your build system:++```bash+stack install+```++or++```bash+cabal install+```++> It _should_ work with either, but if you run into issues, don't hesitate to+> file an issue.+++## Usage++```+ws ws://echo.websocket.org/++ws://echo.websocket.org/> test+test+ws://echo.websocket.org/> ayoo+ayoo+```
app/Main.hs view
@@ -1,14 +1,22 @@ {-# LANGUAGE ScopedTypeVariables , FlexibleContexts+ , NamedFieldPuns+ , OverloadedStrings #-} module Main where import App (app)-import App.Types (Env (Env, envHost, envPort, envPath, envSecure), runAppM, handleInitException, InitException (NoURIAuthority, URIParseException))+import App.Types (Env (..), runAppM, handleInitException, InitException (..)) import Options.Applicative (Parser, strArgument, ParserInfo, metavar, help, fullDesc, progDesc, header, helper, info, execParser)-import Network.URI (parseURI, uriAuthority, uriRegName, uriUserInfo, uriScheme, uriPath, uriPort)+import qualified Data.Text as T+import qualified Data.Vector as V+import qualified Data.Strict.Maybe as Strict+import Data.Strict.Tuple (Pair (..))+import Data.URI (URI (..), parseURI)+import Data.URI.Auth (URIAuth (..), printURIAuth)+import Data.Attoparsec.Text (parseOnly) import Data.Monoid ((<>)) import Control.Monad.Catch (throwM, handle)@@ -62,28 +70,32 @@ putStrLn "Websocket URI: " getLine Just x -> pure x- case parseURI u of- Nothing -> throwM $ URIParseException u- Just u' ->- case uriAuthority u' of- Nothing -> throwM $ NoURIAuthority u- Just a ->- let host = uriUserInfo a- ++ uriRegName a- port = fromIntegral $- let ps = drop 1 (uriPort a)- in if ps /= ""- then read ps- else if uriScheme u' == "wss:"- then 443 :: Int- else 80- path' =- let p = uriPath u'- in if p == ""- then "/"- else p+ case parseOnly parseURI (T.pack u) of+ Left _ -> throwM $ URIParseException u+ Right URI+ { uriScheme+ , uriAuthority = URIAuth+ { uriAuthUser+ , uriAuthHost+ , uriAuthPort+ }+ , uriPath+ , uriQuery+ } ->+ let host = T.unpack $ printURIAuth URIAuth {uriAuthUser,uriAuthHost,uriAuthPort = Strict.Nothing}+ port = case uriAuthPort of+ Strict.Nothing+ | uriScheme == Strict.Just "wss" -> 433+ | otherwise -> 80+ Strict.Just p -> fromIntegral p+ path' = T.unpack $+ "/" <> T.intercalate "/" (V.toList uriPath) <>+ ( if V.null uriQuery+ then ""+ else "?" <> T.intercalate "&" ((\(k :!: mv) -> k <> Strict.maybe "" ("=" <>) mv) <$> V.toList uriQuery)+ ) in pure Env { envHost = host , envPort = port , envPath = path'- , envSecure = uriScheme u' == "wss:"+ , envSecure = uriScheme == Strict.Just "wss" }
src/App.hs view
@@ -7,7 +7,8 @@ import App.Types (AppM, Env (envSecure, envHost, envPort, envPath)) -import Network.WebSockets (ClientApp, DataMessage (Text, Binary), ConnectionException (CloseRequest, ConnectionClosed, ParseException), runClient, receiveDataMessage, sendTextData, sendClose)+import Network.WebSockets+ (ClientApp, DataMessage (..), ConnectionException (..), runClient, receiveDataMessage, sendTextData, sendClose) import Wuss (runSecureClient) import qualified Data.Text as T@@ -64,7 +65,7 @@ let listen = forever $ do message <- receiveDataMessage conn let bs = case message of- Text x -> x+ Text x _ -> x Binary x -> x print' $ case LT.decodeUtf8' bs of Left e -> "[Warn] UTF8 Decode Error: " ++ show e@@ -96,4 +97,7 @@ exitFailure ParseException s -> do print' $ "[Error] Websocket stream parse failure: " ++ s+ exitFailure+ UnicodeException s -> do+ print' $ "[Error] Websocket couldn't parse unicode: " ++ s exitFailure
src/App/Types.hs view
@@ -39,7 +39,6 @@ data InitException = URIParseException String- | NoURIAuthority String deriving (Generic, Show) instance Exception InitException@@ -50,7 +49,4 @@ case e of URIParseException u -> do hPutStr stderr $ "Error: not a valid URI string - `" ++ u ++ "`"- exitFailure- NoURIAuthority u -> do- hPutStr stderr $ "Error: no URI authority - `" ++ u ++ "`" exitFailure
ws.cabal view
@@ -1,44 +1,76 @@-Name: ws-Version: 0.0.3-Author: Athan Clark <athan.clark@gmail.com>-Maintainer: Athan Clark <athan.clark@gmail.com>-License: BSD3-License-File: LICENSE-Synopsis: A simple CLI utility for interacting with a websocket--- Description:-Cabal-Version: >= 1.10-Build-Type: Simple+-- This file has been generated from package.yaml by hpack version 0.21.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: b6402f73c4dc03d95debbd67a2f16770b5dac6fc20c70e0bfa61dcc04a2950f4 -Library- Default-Language: Haskell2010- HS-Source-Dirs: src- GHC-Options: -Wall- Exposed-Modules: App- App.Types- Build-Depends: base >= 4.8 && < 5- , async- , bytestring- , exceptions- , haskeline >= 0.7.4- , mtl- , network- , network-uri- , text- , websockets- , wuss+name: ws+version: 0.0.4+synopsis: A simple CLI utility for interacting with a websocket+description: Please see the README on Github at <https://git.localcooking.com/tooling/ws#readme>+category: Web+homepage: https://github.com/athanclark/ws#readme+bug-reports: https://github.com/athanclark/ws/issues+author: Athan Clark+maintainer: athan.clark@localcooking.com+copyright: 2018 Athan Clark+license: BSD3+license-file: LICENSE+build-type: Simple+cabal-version: >= 1.10 -Executable ws- Default-Language: Haskell2010- HS-Source-Dirs: app- GHC-Options: -Wall -threaded- Main-Is: Main.hs- Build-Depends: base- , ws- , exceptions- , network-uri- , optparse-applicative+extra-source-files:+ README.md +source-repository head+ type: git+ location: https://github.com/athanclark/ws -Source-Repository head- Type: git- Location: https://github.com/athanclark/ws.git+library+ exposed-modules:+ App+ App.Types+ other-modules:+ Paths_ws+ hs-source-dirs:+ src+ ghc-options: -Wall+ build-depends:+ async+ , attoparsec-uri+ , base >=4.7 && <5+ , bytestring+ , exceptions+ , haskeline >=0.7.4+ , mtl+ , network+ , text+ , websockets >=0.12+ , wuss+ default-language: Haskell2010++executable ws+ main-is: Main.hs+ other-modules:+ Paths_ws+ hs-source-dirs:+ app+ ghc-options: -Wall -threaded -rtsopts -Wall -with-rtsopts=-N+ build-depends:+ async+ , attoparsec+ , attoparsec-uri+ , base >=4.7 && <5+ , bytestring+ , exceptions+ , haskeline >=0.7.4+ , mtl+ , network+ , optparse-applicative+ , strict+ , text+ , vector+ , websockets >=0.12+ , ws+ , wuss+ default-language: Haskell2010