module Network.WebSockets.Client
( ClientApp
, runClient
, runClientWith
, runClientWithSocket
, runClientWithStream
, newClientConnection
, createRequest
, Protocol(..)
, defaultProtocol
, checkServerResponse
, streamToClientConnection
) 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 :: forall a. String -> Int -> String -> ClientApp a -> IO a
runClient String
host Int
port String
path ClientApp a
ws =
String
-> Int
-> String
-> ConnectionOptions
-> Headers
-> ClientApp a
-> IO a
forall a.
String
-> Int
-> String
-> ConnectionOptions
-> Headers
-> ClientApp a
-> IO a
runClientWith String
host Int
port String
path ConnectionOptions
defaultConnectionOptions [] ClientApp a
ws
runClientWith :: String
-> Int
-> String
-> ConnectionOptions
-> Headers
-> ClientApp a
-> IO a
runClientWith :: forall a.
String
-> Int
-> String
-> ConnectionOptions
-> Headers
-> ClientApp a
-> IO a
runClientWith String
host Int
port String
path0 ConnectionOptions
opts Headers
customHeaders ClientApp a
app = do
let hints :: AddrInfo
hints = AddrInfo
S.defaultHints
{S.addrSocketType = S.Stream}
fullHost :: String
fullHost = if Int
port Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
80 then String
host else (String
host String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
port)
path :: String
path = if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
path0 then String
"/" else String
path0
AddrInfo
addr:[AddrInfo]
_ <- Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
S.getAddrInfo (AddrInfo -> Maybe AddrInfo
forall a. a -> Maybe a
Just AddrInfo
hints) (String -> Maybe String
forall a. a -> Maybe a
Just String
host) (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
port)
Socket
sock <- Family -> SocketType -> ProtocolNumber -> IO Socket
S.socket (AddrInfo -> Family
S.addrFamily AddrInfo
addr) SocketType
S.Stream ProtocolNumber
S.defaultProtocol
Socket -> SocketOption -> Int -> IO ()
S.setSocketOption Socket
sock SocketOption
S.NoDelay Int
1
a
res <- IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
finally
(Socket -> SockAddr -> IO ()
S.connect Socket
sock (AddrInfo -> SockAddr
S.addrAddress AddrInfo
addr) IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Socket
-> String
-> String
-> ConnectionOptions
-> Headers
-> ClientApp a
-> IO a
forall a.
Socket
-> String
-> String
-> ConnectionOptions
-> Headers
-> ClientApp a
-> IO a
runClientWithSocket Socket
sock String
fullHost String
path ConnectionOptions
opts Headers
customHeaders ClientApp a
app)
(Socket -> IO ()
S.close Socket
sock)
a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res
runClientWithStream
:: Stream
-> String
-> String
-> ConnectionOptions
-> Headers
-> ClientApp a
-> IO a
runClientWithStream :: forall a.
Stream
-> String
-> String
-> ConnectionOptions
-> Headers
-> ClientApp a
-> IO a
runClientWithStream Stream
stream String
host String
path ConnectionOptions
opts Headers
customHeaders ClientApp a
app = do
Stream
-> String
-> String
-> ConnectionOptions
-> Headers
-> IO Connection
newClientConnection Stream
stream String
host String
path ConnectionOptions
opts Headers
customHeaders IO Connection -> ClientApp a -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ClientApp a
app
newClientConnection
:: Stream
-> String
-> String
-> ConnectionOptions
-> Headers
-> IO Connection
newClientConnection :: Stream
-> String
-> String
-> ConnectionOptions
-> Headers
-> IO Connection
newClientConnection Stream
stream String
host String
path ConnectionOptions
opts Headers
customHeaders = do
RequestHead
request <- Protocol
-> ByteString -> ByteString -> Bool -> Headers -> IO RequestHead
createRequest Protocol
protocol ByteString
bHost ByteString
bPath Bool
False Headers
customHeaders
Stream -> ByteString -> IO ()
Stream.write Stream
stream (Builder -> ByteString
Builder.toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ RequestHead -> Builder
encodeRequestHead RequestHead
request)
Stream -> RequestHead -> IO ()
checkServerResponse Stream
stream RequestHead
request
Stream -> ConnectionOptions -> IO Connection
streamToClientConnection Stream
stream ConnectionOptions
opts
where
protocol :: Protocol
protocol = Protocol
defaultProtocol
bHost :: ByteString
bHost = Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
host
bPath :: ByteString
bPath = Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
path
checkServerResponse :: Stream -> RequestHead -> IO ()
checkServerResponse :: Stream -> RequestHead -> IO ()
checkServerResponse Stream
stream RequestHead
request = do
Maybe ResponseHead
mbResponse <- Stream -> Parser ResponseHead -> IO (Maybe ResponseHead)
forall a. Stream -> Parser a -> IO (Maybe a)
Stream.parse Stream
stream Parser ResponseHead
decodeResponseHead
ResponseHead
response <- case Maybe ResponseHead
mbResponse of
Just ResponseHead
response -> ResponseHead -> IO ResponseHead
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ResponseHead
response
Maybe ResponseHead
Nothing -> HandshakeException -> IO ResponseHead
forall e a. Exception e => e -> IO a
throwIO (HandshakeException -> IO ResponseHead)
-> HandshakeException -> IO ResponseHead
forall a b. (a -> b) -> a -> b
$ String -> HandshakeException
OtherHandshakeException (String -> HandshakeException) -> String -> HandshakeException
forall a b. (a -> b) -> a -> b
$
String
"Network.WebSockets.Client.newClientConnection: no handshake " String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"response from server"
IO Response -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Response -> IO ()) -> IO Response -> IO ()
forall a b. (a -> b) -> a -> b
$ (HandshakeException -> IO Response)
-> (Response -> IO Response)
-> Either HandshakeException Response
-> IO Response
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either HandshakeException -> IO Response
forall e a. Exception e => e -> IO a
throwIO Response -> IO Response
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either HandshakeException Response -> IO Response)
-> Either HandshakeException Response -> IO Response
forall a b. (a -> b) -> a -> b
$ Protocol
-> RequestHead
-> ResponseHead
-> Either HandshakeException Response
finishResponse Protocol
protocol RequestHead
request ResponseHead
response
where
protocol :: Protocol
protocol = Protocol
defaultProtocol
streamToClientConnection :: Stream -> ConnectionOptions -> IO Connection
streamToClientConnection :: Stream -> ConnectionOptions -> IO Connection
streamToClientConnection Stream
stream ConnectionOptions
opts = do
IO (Maybe Message)
parse <- Protocol
-> SizeLimit -> SizeLimit -> Stream -> IO (IO (Maybe Message))
decodeMessages Protocol
protocol
(ConnectionOptions -> SizeLimit
connectionFramePayloadSizeLimit ConnectionOptions
opts)
(ConnectionOptions -> SizeLimit
connectionMessageDataSizeLimit ConnectionOptions
opts) Stream
stream
[Message] -> IO ()
write <- Protocol -> ConnectionType -> Stream -> IO ([Message] -> IO ())
encodeMessages Protocol
protocol ConnectionType
ClientConnection Stream
stream
IORef Bool
sentRef <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
Connection -> IO Connection
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Connection -> IO Connection) -> Connection -> IO Connection
forall a b. (a -> b) -> a -> b
$ Connection
{ connectionOptions :: ConnectionOptions
connectionOptions = ConnectionOptions
opts
, connectionType :: ConnectionType
connectionType = ConnectionType
ClientConnection
, connectionProtocol :: Protocol
connectionProtocol = Protocol
protocol
, connectionParse :: IO (Maybe Message)
connectionParse = IO (Maybe Message)
parse
, connectionWrite :: [Message] -> IO ()
connectionWrite = [Message] -> IO ()
write
, connectionSentClose :: IORef Bool
connectionSentClose = IORef Bool
sentRef
}
where
protocol :: Protocol
protocol = Protocol
defaultProtocol
runClientWithSocket :: S.Socket
-> String
-> String
-> ConnectionOptions
-> Headers
-> ClientApp a
-> IO a
runClientWithSocket :: forall a.
Socket
-> String
-> String
-> ConnectionOptions
-> Headers
-> ClientApp a
-> IO a
runClientWithSocket Socket
sock String
host String
path ConnectionOptions
opts Headers
customHeaders ClientApp a
app = IO Stream -> (Stream -> IO ()) -> (Stream -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
(Socket -> IO Stream
Stream.makeSocketStream Socket
sock)
Stream -> IO ()
Stream.close
(\Stream
stream ->
Stream
-> String
-> String
-> ConnectionOptions
-> Headers
-> ClientApp a
-> IO a
forall a.
Stream
-> String
-> String
-> ConnectionOptions
-> Headers
-> ClientApp a
-> IO a
runClientWithStream Stream
stream String
host String
path ConnectionOptions
opts Headers
customHeaders ClientApp a
app)