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