Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Wuss
Description
Wuss is a library that lets you easily create secure WebSocket clients over the WSS protocol. It is a small addition to the websockets package and is adapted from existing solutions by @jaspervdj, @mpickering, and @elfenlaid.
Example
import Wuss import Control.Concurrent (forkIO) import Control.Monad (forever, unless, void) import Data.Text (Text, pack) import Network.WebSockets (ClientApp, receiveData, sendClose, sendTextData) main :: IO () main = runSecureClient "echo.websocket.org" 443 "/" ws ws :: ClientApp () ws connection = do putStrLn "Connected!" void . forkIO . forever $ do message <- receiveData connection print (message :: Text) let loop = do line <- getLine unless (null line) $ do sendTextData connection (pack line) loop loop sendClose connection (pack "Bye!")
Retry
Note that it is possible for the connection itself or any message to fail and need to be retried. Fortunately this can be handled by something like the retry package. See this comment for an example.
Synopsis
- runSecureClient :: MonadIO m => MonadMask m => HostName -> PortNumber -> String -> ClientApp a -> m a
- runSecureClientWith :: MonadIO m => MonadMask m => HostName -> PortNumber -> String -> ConnectionOptions -> Headers -> ClientApp a -> m a
- newtype Config = Config {
- connectionGet :: Connection -> IO ByteString
- defaultConfig :: Config
- runSecureClientWithConfig :: MonadIO m => MonadMask m => HostName -> PortNumber -> String -> Config -> ConnectionOptions -> Headers -> ClientApp a -> m a
Documentation
Arguments
:: MonadIO m | |
=> MonadMask m | |
=> HostName | Host |
-> PortNumber | Port |
-> String | Path |
-> ClientApp a | Application |
-> m a |
A secure replacement for runClient
.
>>>
let app _connection = return ()
>>>
runSecureClient "echo.websocket.org" 443 "/" app
Arguments
:: MonadIO m | |
=> MonadMask m | |
=> HostName | Host |
-> PortNumber | Port |
-> String | Path |
-> ConnectionOptions | Options |
-> Headers | Headers |
-> ClientApp a | Application |
-> m a |
A secure replacement for runClientWith
.
>>>
let options = defaultConnectionOptions
>>>
let headers = []
>>>
let app _connection = return ()
>>>
runSecureClientWith "echo.websocket.org" 443 "/" options headers app
If you want to run a secure client without certificate validation, use
runClientWithStream
. For example:
let host = "echo.websocket.org" let port = 443 let path = "/" let options = defaultConnectionOptions let headers = [] let tlsSettings = TLSSettingsSimple -- This is the important setting. { settingDisableCertificateValidation = True , settingDisableSession = False , settingUseServerName = False } let connectionParams = ConnectionParams { connectionHostname = host , connectionPort = port , connectionUseSecure = Just tlsSettings , connectionUseSocks = Nothing } context <- initConnectionContext connection <- connectTo context connectionParams stream <- makeStream (fmap Just (connectionGetChunk connection)) (maybe (return ()) (connectionPut connection . toStrict)) runClientWithStream stream host path options headers $ \ connection -> do -- Do something with the connection. return ()
Configures a secure WebSocket connection.
Constructors
Config | |
Fields
|
defaultConfig :: Config Source #
The default Config
value used by runSecureClientWith
.
runSecureClientWithConfig Source #
Arguments
:: MonadIO m | |
=> MonadMask m | |
=> HostName | Host |
-> PortNumber | Port |
-> String | Path |
-> Config | Config |
-> ConnectionOptions | Options |
-> Headers | Headers |
-> ClientApp a | Application |
-> m a |
Runs a secure WebSockets client with the given Config
.