module Network.WebSockets.Client
( ClientApp
, runClient
, runClientWith
, runClientWithSocket
, runClientWithStream
) where
import qualified Blaze.ByteString.Builder as Builder
import Control.Exception (finally)
import qualified Data.ByteString as B
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Network.Socket as S
import qualified System.IO.Streams as Streams
import qualified System.IO.Streams.Attoparsec as Streams
import Network.WebSockets.Connection
import Network.WebSockets.Http
import Network.WebSockets.Protocol
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 path opts customHeaders app = do
let hints = S.defaultHints
{S.addrFamily = S.AF_INET, S.addrSocketType = S.Stream}
addrInfos <- S.getAddrInfo (Just hints) (Just host) (Just $ show port)
sock <- S.socket S.AF_INET S.Stream S.defaultProtocol
res <- finally
(S.connect sock (S.addrAddress $ head addrInfos) >>
runClientWithSocket sock host path opts customHeaders app)
(S.sClose sock)
return res
runClientWithStream
:: (Streams.InputStream B.ByteString, Streams.OutputStream B.ByteString)
-> String
-> String
-> ConnectionOptions
-> Headers
-> ClientApp a
-> IO a
runClientWithStream (sIn, sOut) host path opts customHeaders app = do
request <- createRequest protocol bHost bPath False customHeaders
bOut <- Streams.builderStream sOut
Streams.write (Just $ encodeRequestHead request) bOut
Streams.write (Just Builder.flush) bOut
response <- Streams.parseFromStream decodeResponseHead sIn
Response _ _ <- return $ finishResponse protocol request response
mIn <- decodeMessages protocol sIn
mOut <- encodeMessages protocol ClientConnection bOut
app Connection
{ connectionOptions = opts
, connectionType = ClientConnection
, connectionProtocol = protocol
, connectionIn = mIn
, connectionOut = mOut
}
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 = do
stream <- Streams.socketToStreams sock
runClientWithStream stream host path opts customHeaders app