-
Notifications
You must be signed in to change notification settings - Fork 199
/
HttpWriters.fs
203 lines (172 loc) · 6.53 KB
/
HttpWriters.fs
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
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
module Suave.Tests.HttpWriters
open Expecto
open System
open System.IO
open System.Linq
open System.Net.Sockets
open Suave
open Suave.Operators
open Suave.Successful
open Suave.Writers
open Suave.Utils
open Suave.Tests.TestUtilities
open Suave.Testing
[<Tests>]
let cookies cfg =
let runWithConfig = runWith cfg
let basicCookie =
{ name = "mycookie"
value = "42"
expires = None
domain = None
path = Some "/"
httpOnly = false
secure = false
sameSite = None }
let ip, port =
let binding = SuaveConfig.firstBinding cfg
string binding.socketBinding.ip,
int binding.socketBinding.port
testList "Cookies basic tests" [
testCase "cookie data makes round trip" <| fun _ ->
Assert.Equal("expecting cookie value"
, "42"
, (reqCookies HttpMethod.GET "/" None
(runWithConfig (Cookie.setCookie basicCookie >=> OK "test")))
.GetCookies(Uri(sprintf "http://%s" ip)).[0].Value)
testCase "cookie name makes round trip" <| fun _ ->
Assert.Equal("expecting cookie name"
, "mycookie"
, (reqCookies HttpMethod.GET "/" None
(runWithConfig (Cookie.setCookie basicCookie >=> OK "test")))
.GetCookies(Uri(sprintf "http://%s" ip)).[0].Name)
testCase "http_only cookie is http_only" <| fun _ ->
Assert.Equal("expecting http_only"
, true
, (reqCookies HttpMethod.GET "/" None
(runWithConfig (Cookie.setCookie { basicCookie with httpOnly = true } >=> OK "test")))
.GetCookies(Uri(sprintf "http://%s" ip)).[0].HttpOnly)
]
[<Tests>]
let headers cfg =
let runWithConfig = runWith cfg
let requestHeaders () =
let ip, port =
let binding = SuaveConfig.firstBinding cfg
string binding.socketBinding.ip,
int binding.socketBinding.port
use client = new TcpClient(ip, port)
let outputData = ASCII.bytes (sprintf "GET / HTTP/1.1\r\nHost: %s\r\nConnection: Close\r\n\r\n" ip)
use stream = client.GetStream()
stream.Write(outputData, 0, outputData.Length)
use streamReader = new StreamReader(stream)
let splitHeader (line: string) =
let ind = line.IndexOf(':')
let name = line.Substring(0, ind)
let value = line.Substring(ind + 1)
name.Trim(), value.Trim()
// skip 200 OK
streamReader.ReadLine() |> ignore
// read header lines
let rec loop hdrs =
let line = streamReader.ReadLine()
if line.Equals("") then (List.rev hdrs)
else
let name, value = splitHeader line
loop ((name, value) :: hdrs)
loop []
let getRespHeaders key =
List.filter (fst >> (String.equalsCaseInsensitive key))
let getRespHeader key =
getRespHeaders key >> List.head
testList "addHeader,setHeader,setHeaderValue tests" [
testCase "setHeader adds header if it was not there" <| fun _ ->
let ctx = runWithConfig (Writers.setHeader "X-Custom-Header" "value" >=> OK "test")
withContext (fun _ ->
let hdrs = requestHeaders ()
Assert.Equal(
"expecting header value",
[ "X-Custom-Header", "value" ],
hdrs |> getRespHeaders "X-Custom-Header"))
ctx
testCase "setHeader rewrites all instances of header with new single value" <| fun _ ->
let ctx =
runWithConfig
(Writers.setHeader "X-Custom-Header" "first"
>=> Writers.setHeader "X-Custom-Header" "second"
>=> Writers.setHeader "x-custom-header" "third"
>=> OK "test")
withContext (fun _ ->
let hdrs = requestHeaders ()
Assert.Equal(
"expecting header value",
"third",
hdrs |> getRespHeader "X-Custom-Header" |> snd))
ctx
testCase "addHeader adds header and preserves the order" <| fun _ ->
let ctx =
runWithConfig
(Writers.addHeader "X-Custom-Header" "first"
>=> Writers.addHeader "X-Custom-Header" "second"
>=> OK "test")
withContext (fun _ ->
let hdrs = requestHeaders ()
Assert.Equal(
"expecting headers value",
[ "X-Custom-Header", "first"
"X-Custom-Header", "second"],
hdrs |> getRespHeaders "X-Custom-Header"))
ctx
testCase "setHeaderValue sets the first by-key found header's value so it includes the value" <| fun _ ->
let ctx =
runWithConfig
(Writers.addHeader "Vary" "Accept-Encoding"
// e.g. in Suave.Locale:
>=> Writers.setHeaderValue "Vary" "Accept-Language"
// later, e.g. in Logibit.Hawk, since this turned out to be authenticated
// content:
>=> Writers.setHeaderValue "Vary" "Authorization"
// note on the above:
// with Hawk it will turn out to be a cache-busting mechanism since
// the Authorization header includes a nonce and a timestamp
// but it's the semantically correct interpretation.
// Meanwhile, the Cookie header gets changed as the cookie ages and
// expires.
>=> Writers.setHeaderValue "Vary" "Cookie"
// Note: it's up to the client to use optimistic concurrency control
// on its side for data requested under Hawk authorization
>=> OK "test")
withContext (fun _ ->
let hdrs = requestHeaders ()
Assert.Equal(
"expecting headers value",
["Vary", "Accept-Encoding,Accept-Language,Authorization,Cookie"],
hdrs |> getRespHeaders "Vary"))
ctx
testCase "setHeaderValue only modifies ONE of the found headers; the first one" <| fun _ ->
let ctx =
runWithConfig
(Writers.addHeader "Vary" "Accept-Encoding"
>=> Writers.addHeader "vary" "Accept-Language"
>=> Writers.setHeaderValue "Vary" "Authorization"
>=> Writers.setHeaderValue "vary" "Cookie"
>=> OK "test")
withContext (fun _ ->
let hdrs = requestHeaders ()
Assert.Equal(
"expecting headers value",
[ "vary", "Accept-Encoding,Authorization,Cookie"
"vary", "Accept-Language"
],
hdrs |> getRespHeaders "Vary"))
ctx
testCase "setHeader adds Server header with hideHeader = true" <| fun _ ->
let ctx = runWith { cfg with hideHeader = true } (Writers.setHeader "Server" "My custom value" >=> OK "test")
withContext (fun _ ->
let hdrs = requestHeaders ()
Assert.Equal(
"expecting Server header value",
[ "Server", "My custom value" ],
hdrs |> getRespHeaders "Server"))
ctx
]