module Network.WebSockets.Client
( ClientApp
, runClient
, runClientWith
, runClientWithSocket
, runClientWithStream
, newClientConnection
) where
import qualified Data.ByteString.Builder as Builder
import Control.Exception (bracket, finally, throwIO)
import Control.Monad (void)
import Data.IORef (newIORef)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Network.Socket as S
import Network.WebSockets.Connection
import Network.WebSockets.Http
import Network.WebSockets.Protocol
import Network.WebSockets.Stream (Stream)
import qualified Network.WebSockets.Stream as Stream
import Network.WebSockets.Types
type ClientApp a = Connection -> IO a
runClient :: String
-> Int
-> String
-> ClientApp a
-> IO a
runClient host port path ws =
runClientWith host port path defaultConnectionOptions [] ws
runClientWith :: String
-> Int
-> String
-> ConnectionOptions
-> Headers
-> ClientApp a
-> IO a
runClientWith host port path0 opts customHeaders app = do
let hints = S.defaultHints
{S.addrSocketType = S.Stream}
fullHost = if port == 80 then host else (host ++ ":" ++ show port)
path = if null path0 then "/" else path0
addr:_ <- S.getAddrInfo (Just hints) (Just host) (Just $ show port)
sock <- S.socket (S.addrFamily addr) S.Stream S.defaultProtocol
S.setSocketOption sock S.NoDelay 1
res <- finally
(S.connect sock (S.addrAddress addr) >>
runClientWithSocket sock fullHost path opts customHeaders app)
(S.close sock)
return res
runClientWithStream
:: Stream
-> String
-> String
-> ConnectionOptions
-> Headers
-> ClientApp a
-> IO a
runClientWithStream stream host path opts customHeaders app = do
newClientConnection stream host path opts customHeaders >>= app
newClientConnection
:: Stream
-> String
-> String
-> ConnectionOptions
-> Headers
-> IO Connection
newClientConnection stream host path opts customHeaders = do
request <- createRequest protocol bHost bPath False customHeaders
Stream.write stream (Builder.toLazyByteString $ encodeRequestHead request)
mbResponse <- Stream.parse stream decodeResponseHead
response <- case mbResponse of
Just response -> return response
Nothing -> throwIO $ OtherHandshakeException $
"Network.WebSockets.Client.newClientConnection: no handshake " ++
"response from server"
void $ either throwIO return $ finishResponse protocol request response
parse <- decodeMessages protocol
(connectionFramePayloadSizeLimit opts)
(connectionMessageDataSizeLimit opts) stream
write <- encodeMessages protocol ClientConnection stream
sentRef <- newIORef False
return $ Connection
{ connectionOptions = opts
, connectionType = ClientConnection
, connectionProtocol = protocol
, connectionParse = parse
, connectionWrite = write
, connectionSentClose = sentRef
}
where
protocol = defaultProtocol
bHost = T.encodeUtf8 $ T.pack host
bPath = T.encodeUtf8 $ T.pack path
runClientWithSocket :: S.Socket
-> String
-> String
-> ConnectionOptions
-> Headers
-> ClientApp a
-> IO a
runClientWithSocket sock host path opts customHeaders app = bracket
(Stream.makeSocketStream sock)
Stream.close
(\stream ->
runClientWithStream stream host path opts customHeaders app)