module Network.WebSockets.Client
( withConnection
, WS.Connection
, 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
, WS.Message (..)
, WS.ControlMessage (..)
, WS.DataMessage (..)
, WS.WebSocketsData (..)
, WS.HandshakeException (..)
, WS.ConnectionException (..)
, WS.withPingThread
) 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 Network.URI (URI (..), URIAuth (..), parseURI)
import qualified Network.WebSockets as WS
import qualified Network.WebSockets.Stream as WS
withConnection
:: String
-> (WS.Connection -> IO a)
-> IO a
withConnection url action = do
man <- Http.newManager tlsManagerSettings
withConnectionFromManager man url action
withConnectionFromManager
:: Http.Manager -> String -> (WS.Connection -> IO a) -> IO a
withConnectionFromManager man rawUrl action = do
(isSecure, host, port, path) <- parseWsUrl rawUrl
let httpUrl = (if isSecure then "https://" else "http://") ++ host ++ port ++ 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
WS.runClientWithStream stream
host
path
WS.defaultConnectionOptions
[]
action
)
parseWsUrl :: String -> IO (Bool, String, 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, uriPort auth, 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