1--------------------------------------------------------------------------------
2-- | This part of the library provides you with utilities to create WebSockets
3-- clients (in addition to servers).
4module Network.WebSockets.Client
5    ( ClientApp
6    , runClient
7    , runClientWith
8    , runClientWithSocket
9    , runClientWithStream
10    , newClientConnection
11    -- * Low level functionality
12    , createRequest
13    , Protocol(..)
14    , defaultProtocol
15    , checkServerResponse
16    , streamToClientConnection
17    ) where
18
19
20--------------------------------------------------------------------------------
21import qualified Data.ByteString.Builder       as Builder
22import           Control.Exception             (bracket, finally, throwIO)
23import           Control.Monad                 (void)
24import           Data.IORef                    (newIORef)
25import qualified Data.Text                     as T
26import qualified Data.Text.Encoding            as T
27import qualified Network.Socket                as S
28
29
30--------------------------------------------------------------------------------
31import           Network.WebSockets.Connection
32import           Network.WebSockets.Http
33import           Network.WebSockets.Protocol
34import           Network.WebSockets.Stream     (Stream)
35import qualified Network.WebSockets.Stream     as Stream
36import           Network.WebSockets.Types
37
38
39--------------------------------------------------------------------------------
40-- | A client application interacting with a single server. Once this 'IO'
41-- action finished, the underlying socket is closed automatically.
42type ClientApp a = Connection -> IO a
43
44
45--------------------------------------------------------------------------------
46-- TODO: Maybe this should all be strings
47runClient :: String       -- ^ Host
48          -> Int          -- ^ Port
49          -> String       -- ^ Path
50          -> ClientApp a  -- ^ Client application
51          -> IO a
52runClient host port path ws =
53    runClientWith host port path defaultConnectionOptions [] ws
54
55
56--------------------------------------------------------------------------------
57runClientWith :: String             -- ^ Host
58              -> Int                -- ^ Port
59              -> String             -- ^ Path
60              -> ConnectionOptions  -- ^ Options
61              -> Headers            -- ^ Custom headers to send
62              -> ClientApp a        -- ^ Client application
63              -> IO a
64runClientWith host port path0 opts customHeaders app = do
65    -- Create and connect socket
66    let hints = S.defaultHints
67                    {S.addrSocketType = S.Stream}
68
69        -- Correct host and path.
70        fullHost = if port == 80 then host else (host ++ ":" ++ show port)
71        path     = if null path0 then "/" else path0
72    addr:_ <- S.getAddrInfo (Just hints) (Just host) (Just $ show port)
73    sock      <- S.socket (S.addrFamily addr) S.Stream S.defaultProtocol
74    S.setSocketOption sock S.NoDelay 1
75
76    -- Connect WebSocket and run client
77    res <- finally
78        (S.connect sock (S.addrAddress addr) >>
79         runClientWithSocket sock fullHost path opts customHeaders app)
80        (S.close sock)
81
82    -- Clean up
83    return res
84
85
86--------------------------------------------------------------------------------
87
88runClientWithStream
89    :: Stream
90    -- ^ Stream
91    -> String
92    -- ^ Host
93    -> String
94    -- ^ Path
95    -> ConnectionOptions
96    -- ^ Connection options
97    -> Headers
98    -- ^ Custom headers to send
99    -> ClientApp a
100    -- ^ Client application
101    -> IO a
102runClientWithStream stream host path opts customHeaders app = do
103    newClientConnection stream host path opts customHeaders >>= app
104
105-- | Build a new 'Connection' from the client's point of view.
106--
107-- /WARNING/: Be sure to call 'Stream.close' on the given 'Stream' after you are
108-- done using the 'Connection' in order to properly close the communication
109-- channel. 'runClientWithStream' handles this for you, prefer to use it when
110-- possible.
111newClientConnection
112    :: Stream
113    -- ^ Stream that will be used by the new 'Connection'.
114    -> String
115    -- ^ Host
116    -> String
117    -- ^ Path
118    -> ConnectionOptions
119    -- ^ Connection options
120    -> Headers
121    -- ^ Custom headers to send
122    -> IO Connection
123newClientConnection stream host path opts customHeaders = do
124    -- Create the request and send it
125    request    <- createRequest protocol bHost bPath False customHeaders
126    Stream.write stream (Builder.toLazyByteString $ encodeRequestHead request)
127    checkServerResponse stream request
128    streamToClientConnection stream opts
129  where
130    protocol = defaultProtocol  -- TODO
131    bHost    = T.encodeUtf8 $ T.pack host
132    bPath    = T.encodeUtf8 $ T.pack path
133
134-- | Check the response from the server.
135-- Throws 'OtherHandshakeException' on failure
136checkServerResponse :: Stream -> RequestHead -> IO ()
137checkServerResponse stream request = do
138    mbResponse <- Stream.parse stream decodeResponseHead
139    response   <- case mbResponse of
140        Just response -> return response
141        Nothing       -> throwIO $ OtherHandshakeException $
142            "Network.WebSockets.Client.newClientConnection: no handshake " ++
143            "response from server"
144    void $ either throwIO return $ finishResponse protocol request response
145  where
146    protocol = defaultProtocol -- TODO
147
148
149-- | Build a 'Connection' from a pre-established stream with already finished
150-- handshake.
151--
152-- /NB/: this will not perform any handshaking.
153streamToClientConnection :: Stream -> ConnectionOptions -> IO Connection
154streamToClientConnection stream opts = do
155    parse   <- decodeMessages protocol
156                (connectionFramePayloadSizeLimit opts)
157                (connectionMessageDataSizeLimit opts) stream
158    write   <- encodeMessages protocol ClientConnection stream
159    sentRef <- newIORef False
160    return $ Connection
161        { connectionOptions   = opts
162        , connectionType      = ClientConnection
163        , connectionProtocol  = protocol
164        , connectionParse     = parse
165        , connectionWrite     = write
166        , connectionSentClose = sentRef
167        }
168  where
169    protocol = defaultProtocol
170
171
172--------------------------------------------------------------------------------
173runClientWithSocket :: S.Socket           -- ^ Socket
174                    -> String             -- ^ Host
175                    -> String             -- ^ Path
176                    -> ConnectionOptions  -- ^ Options
177                    -> Headers            -- ^ Custom headers to send
178                    -> ClientApp a        -- ^ Client application
179                    -> IO a
180runClientWithSocket sock host path opts customHeaders app = bracket
181    (Stream.makeSocketStream sock)
182    Stream.close
183    (\stream ->
184        runClientWithStream stream host path opts customHeaders app)
185