-
Notifications
You must be signed in to change notification settings - Fork 112
/
Client.hs
130 lines (113 loc) · 4.95 KB
/
Client.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
--------------------------------------------------------------------------------
-- | This part of the library provides you with utilities to create WebSockets
-- clients (in addition to servers).
module Network.WebSockets.Client
( ClientApp
, runClient
, runClientWith
, runClientWithSocket
, runClientWithStream
) where
--------------------------------------------------------------------------------
import qualified Blaze.ByteString.Builder as Builder
import Control.Exception (bracket, finally, throwIO)
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
--------------------------------------------------------------------------------
-- | A client application interacting with a single server. Once this 'IO'
-- action finished, the underlying socket is closed automatically.
type ClientApp a = Connection -> IO a
--------------------------------------------------------------------------------
-- TODO: Maybe this should all be strings
runClient :: String -- ^ Host
-> Int -- ^ Port
-> String -- ^ Path
-> ClientApp a -- ^ Client application
-> IO a
runClient host port path ws =
runClientWith host port path defaultConnectionOptions [] ws
--------------------------------------------------------------------------------
runClientWith :: String -- ^ Host
-> Int -- ^ Port
-> String -- ^ Path
-> ConnectionOptions -- ^ Options
-> Headers -- ^ Custom headers to send
-> ClientApp a -- ^ Client application
-> IO a
runClientWith host port path opts customHeaders app = do
-- Create and connect socket
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
-- Connect WebSocket and run client
res <- finally
(S.connect sock (S.addrAddress $ head addrInfos) >>
runClientWithSocket sock host path opts customHeaders app)
(S.sClose sock)
-- Clean up
return res
--------------------------------------------------------------------------------
runClientWithStream
:: Stream
-- ^ Stream
-> String
-- ^ Host
-> String
-- ^ Path
-> ConnectionOptions
-- ^ Connection options
-> Headers
-- ^ Custom headers to send
-> ClientApp a
-- ^ Client application
-> IO a
runClientWithStream stream host path opts customHeaders app = do
-- Create the request and send it
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.runClientWithStream: no handshake " ++
"response from server"
-- Note that we pattern match to evaluate the result here
Response _ _ <- return $ finishResponse protocol request response
parse <- decodeMessages protocol stream
write <- encodeMessages protocol ClientConnection stream
sentRef <- newIORef False
app Connection
{ connectionOptions = opts
, connectionType = ClientConnection
, connectionProtocol = protocol
, connectionParse = parse
, connectionWrite = write
, connectionSentClose = sentRef
}
where
protocol = defaultProtocol -- TODO
bHost = T.encodeUtf8 $ T.pack host
bPath = T.encodeUtf8 $ T.pack path
--------------------------------------------------------------------------------
runClientWithSocket :: S.Socket -- ^ Socket
-> String -- ^ Host
-> String -- ^ Path
-> ConnectionOptions -- ^ Options
-> Headers -- ^ Custom headers to send
-> ClientApp a -- ^ Client application
-> IO a
runClientWithSocket sock host path opts customHeaders app = bracket
(Stream.makeSocketStream sock)
Stream.close
(\stream ->
runClientWithStream stream host path opts customHeaders app)