basis/http/http-tests.factor

   1 USING: destructors http http.server http.server.requests http.client
   2 http.client.private tools.test multiline fry io.streams.string io.crlf
   3 io.encodings.utf8 io.encodings.8-bit io.encodings.binary io.encodings.string
   4 io.encodings.ascii kernel arrays splitting sequences assocs io.sockets db
   5 db.sqlite make continuations urls hashtables accessors namespaces xml.data
   6 io.encodings.8-bit.latin1 random combinators.short-circuit literals ;
   7 IN: http.tests
   8
   9 { "text/plain" "UTF-8" } [ "text/plain" parse-content-type ] unit-test
  10
  11 { "text/html" "ASCII" } [ "text/html;  charset=ASCII" parse-content-type ] unit-test
  12
  13 { "text/html" "utf-8" } [ "text/html; charset=\"utf-8\"" parse-content-type ] unit-test
  14
  15 { "application/octet-stream" f } [ "application/octet-stream" parse-content-type ] unit-test
  16
  17 { "localhost" f } [ "localhost" parse-host ] unit-test
  18 { "localhost" 8888 } [ "localhost:8888" parse-host ] unit-test
  19 { "::1" 8888 } [ "::1:8888" parse-host ] unit-test
  20 { "127.0.0.1" 8888 } [ "127.0.0.1:8888" parse-host ] unit-test
  21
  22 { "localhost" } [ T{ url { protocol "http" } { host "localhost" } } unparse-host ] unit-test
  23 { "localhost" } [ T{ url { protocol "http" } { host "localhost" } { port 80 } } unparse-host ] unit-test
  24 { "localhost" } [ T{ url { protocol "https" } { host "localhost" } { port 443 } } unparse-host ] unit-test
  25 { "localhost:8080" } [ T{ url { protocol "http" } { host "localhost" } { port 8080 } } unparse-host ] unit-test
  26 { "localhost:8443" } [ T{ url { protocol "https" } { host "localhost" } { port 8443 } } unparse-host ] unit-test
  27
  28 STRING: read-request-test-1
  29 POST /bar HTTP/1.1
  30 Some-Header: 1
  31 Some-Header: 2
  32 Content-Length: 4
  33 Content-type: application/octet-stream
  34
  35 blah
  36 ;
  37
  38 {
  39     T{ request
  40         { url T{ url { path "/bar" } } }
  41         { proxy-url T{ url } }
  42         { method "POST" }
  43         { version "1.1" }
  44         { header H{ { "some-header" "1; 2" } { "content-length" "4" } { "content-type" "application/octet-stream" } } }
  45         { post-data T{ post-data { data "blah" } { content-type "application/octet-stream" } } }
  46         { cookies V{ } }
  47         { redirects 10 }
  48     }
  49 } [
  50     read-request-test-1 lf>crlf [
  51         read-request
  52     ] with-string-reader
  53 ] unit-test
  54
  55 STRING: read-request-test-1'
  56 POST /bar HTTP/1.1
  57 content-length: 4
  58 content-type: application/octet-stream
  59 some-header: 1; 2
  60
  61 blah
  62 ;
  63
  64 ${ read-request-test-1' } [
  65     read-request-test-1 lf>crlf
  66     [ read-request ] with-string-reader
  67     [ write-request ] with-string-writer
  68     ! normalize crlf
  69     string-lines "\n" join
  70 ] unit-test
  71
  72 STRING: read-request-test-2
  73 HEAD  /bar   HTTP/1.1
  74 Host: www.sex.com
  75
  76 ;
  77
  78 {
  79     T{ request
  80         { url T{ url { host "www.sex.com" } { path "/bar" } } }
  81         { proxy-url T{ url } }
  82         { method "HEAD" }
  83         { version "1.1" }
  84         { header H{ { "host" "www.sex.com" } } }
  85         { cookies V{ } }
  86         { redirects 10 }
  87     }
  88 } [
  89     read-request-test-2 lf>crlf [
  90         read-request
  91     ] with-string-reader
  92 ] unit-test
  93
  94 STRING: read-request-test-2'
  95 HEAD  /bar   HTTP/1.1
  96 Host: www.sex.com:101
  97
  98 ;
  99
 100 {
 101     T{ request
 102         { url T{ url { host "www.sex.com" } { port 101 } { path "/bar" } } }
 103         { proxy-url T{ url } }
 104         { method "HEAD" }
 105         { version "1.1" }
 106         { header H{ { "host" "www.sex.com:101" } } }
 107         { cookies V{ } }
 108         { redirects 10 }
 109     }
 110 } [
 111     read-request-test-2' lf>crlf [
 112         read-request
 113     ] with-string-reader
 114 ] unit-test
 115
 116 STRING: read-request-test-3
 117 GET nested HTTP/1.0
 118
 119 ;
 120
 121 STRING: read-request-test-4
 122 GET /blah HTTP/1.0
 123 Host: "www.amazon.com"
 124 ;
 125
 126 { "www.amazon.com" }
 127 [
 128     read-request-test-4 lf>crlf [ read-request ] with-string-reader
 129     "host" header
 130 ] unit-test
 131
 132 STRING: read-response-test-1
 133 HTTP/1.1 404 not found
 134 Content-Type: text/html; charset=UTF-8
 135
 136 blah
 137 ;
 138
 139 {
 140     T{ response
 141         { version "1.1" }
 142         { code 404 }
 143         { message "not found" }
 144         { header H{ { "content-type" "text/html; charset=UTF-8" } } }
 145         { cookies { } }
 146         { content-type "text/html" }
 147         { content-charset "UTF-8" }
 148         { content-encoding utf8 }
 149     }
 150 } [
 151     read-response-test-1 lf>crlf
 152     [ read-response ] with-string-reader
 153 ] unit-test
 154
 155
 156 STRING: read-response-test-1'
 157 HTTP/1.1 404 not found
 158 content-type: text/html; charset=UTF-8
 159
 160 ;
 161
 162 ${ read-response-test-1' } [
 163     URL" http://localhost/" url set
 164     read-response-test-1 lf>crlf
 165     [ read-response ] with-string-reader
 166     [ write-response ] with-string-writer
 167     ! normalize crlf
 168     string-lines "\n" join
 169 ] unit-test
 170
 171 { t } [
 172     "rmid=732423sdfs73242; path=/; domain=.example.net; expires=Fri, 31-Dec-2010 23:59:59 GMT"
 173     dup parse-set-cookie first unparse-set-cookie =
 174 ] unit-test
 175
 176 { t } [
 177     "a="
 178     dup parse-set-cookie first unparse-set-cookie =
 179 ] unit-test
 180
 181 STRING: read-response-test-2
 182 HTTP/1.1 200 Content follows
 183 Set-Cookie: oo="bar; a=b"; httponly=yes; sid=123456
 184
 185
 186 ;
 187
 188 { 2 } [
 189     read-response-test-2 lf>crlf
 190     [ read-response ] with-string-reader
 191     cookies>> length
 192 ] unit-test
 193
 194 STRING: read-response-test-3
 195 HTTP/1.1 200 Content follows
 196 Set-Cookie: oo="bar; a=b"; comment="your mom"; httponly=yes
 197
 198
 199 ;
 200
 201 { 1 } [
 202     read-response-test-3 lf>crlf
 203     [ read-response ] with-string-reader
 204     cookies>> length
 205 ] unit-test
 206
 207 ! Live-fire exercise
 208 USING: http.server.static furnace.sessions furnace.alloy
 209 furnace.actions furnace.auth furnace.auth.login furnace.db
 210 io.servers io.files io.files.temp io.directories io
 211 threads
 212 http.server.responses http.server.redirection furnace.redirection
 213 http.server.dispatchers db.tuples ;
 214
 215 : add-quit-action ( responder -- responder )
 216     <action>
 217         [ stop-this-server "Goodbye" "text/html" <content> ] >>display
 218     "quit" add-responder ;
 219
 220 : test-db-file ( -- path ) "test.db" temp-file ;
 221
 222 : test-db ( -- db ) test-db-file <sqlite-db> ;
 223
 224 : add-addr ( url -- url' )
 225     >url clone "addr" get set-url-addr ;
 226
 227 : stop-test-httpd ( -- )
 228     "http://localhost/quit" add-addr http-get nip
 229     "Goodbye" assert= ;
 230
 231 { } [
 232     test-db-file ?delete-file
 233
 234     test-db [
 235         init-furnace-tables
 236     ] with-db
 237 ] unit-test
 238
 239 : test-with-dispatcher ( dispatcher quot -- )
 240     '[
 241         main-responder set
 242         <http-server> 0 >>insecure f >>secure
 243         [
 244             server-addrs random "addr" set @
 245         ] with-threaded-server
 246     ] with-scope ; inline
 247
 248 USING: locals ;
 249
 250 :: test-with-db-persistence ( db-persistence quot -- )
 251     db-persistence [
 252         quot test-with-dispatcher
 253     ] with-disposal ; inline
 254
 255 <dispatcher>
 256     add-quit-action
 257     <dispatcher>
 258         "vocab:http/test" <static> >>default
 259     "nested" add-responder
 260     <action>
 261         [ URL" redirect-loop" <temporary-redirect> ] >>display
 262     "redirect-loop" add-responder [
 263
 264     [ t ] [
 265         "vocab:http/test/foo.html" ascii file-contents
 266         "http://localhost/nested/foo.html" add-addr http-get nip =
 267     ] unit-test
 268
 269     [ "http://localhost/redirect-loop" add-addr http-get nip ]
 270     [ too-many-redirects? ] must-fail-with
 271
 272     [ "Goodbye" ] [
 273         "http://localhost/quit" add-addr http-get nip
 274     ] unit-test
 275
 276 ] test-with-dispatcher
 277
 278 ! HTTP client redirect bug
 279 <dispatcher>
 280     add-quit-action
 281     <action> [ "quit" <temporary-redirect> ] >>display
 282     "redirect" add-responder [
 283
 284     [ "Goodbye" ] [
 285         "http://localhost/redirect" add-addr http-get nip
 286     ] unit-test
 287
 288     [ ] [
 289         [ stop-test-httpd ] ignore-errors
 290     ] unit-test
 291
 292 ] test-with-dispatcher
 293
 294 ! Dispatcher bugs
 295 : 404? ( response -- ? )
 296     {
 297         [ download-failed? ]
 298         [ response>> response? ]
 299         [ response>> code>> 404 = ]
 300     } 1&& ;
 301
 302 <dispatcher>
 303     <action> <protected>
 304     "Test" <login-realm>
 305     <sessions>
 306     "" add-responder
 307     add-quit-action
 308     <dispatcher>
 309         <action> "" add-responder
 310     "d" add-responder
 311 test-db <db-persistence> [
 312
 313     ! This should give a 404 not an infinite redirect loop
 314     [ "http://localhost/d/blah" add-addr http-get nip ] [ 404? ] must-fail-with
 315
 316     ! This should give a 404 not an infinite redirect loop
 317     [ "http://localhost/blah/" add-addr http-get nip ] [ 404? ] must-fail-with
 318
 319     [ "Goodbye" ] [ "http://localhost/quit" add-addr http-get nip ] unit-test
 320
 321 ] test-with-db-persistence
 322
 323 <dispatcher>
 324     <action> [ [ "Hi" write ] "text/plain" <content> ] >>display
 325     "Test" <login-realm>
 326     <sessions>
 327     "" add-responder
 328     add-quit-action
 329 test-db <db-persistence> [
 330
 331         [ "Hi" ] [ "http://localhost/" add-addr http-get nip ] unit-test
 332
 333         [ "Goodbye" ] [ "http://localhost/quit" add-addr http-get nip ] unit-test
 334
 335 ] test-with-db-persistence
 336
 337 USING: html.components html.forms
 338 xml xml.traversal validators
 339 furnace furnace.conversations ;
 340
 341 SYMBOL: a
 342
 343 : test-a ( xml -- value )
 344     string>xml body>> "input" deep-tag-named "value" attr ;
 345
 346 <dispatcher>
 347     <action>
 348         [ a get-global "a" set-value ] >>init
 349         [ [ "<html>" write "a" <field> render "</html>" write ] "text/html" <content> ] >>display
 350         [ { { "a" [ v-integer ] } } validate-params ] >>validate
 351         [ "a" value a set-global URL" " <redirect> ] >>submit
 352     <conversations>
 353     <sessions>
 354     >>default
 355     add-quit-action
 356 test-db <db-persistence> [
 357
 358     3 a set-global
 359
 360     [ "3" ] [
 361         "http://localhost/" add-addr http-get
 362         swap dup cookies>> "cookies" set session-id-key get-cookie
 363         value>> "session-id" set test-a
 364     ] unit-test
 365
 366     [ "4" ] [
 367         [
 368             "4" "a" ,,
 369             "http://localhost" add-addr "__u" ,,
 370             "session-id" get session-id-key ,,
 371         ] H{ } make
 372         "http://localhost/" add-addr <post-request> "cookies" get >>cookies
 373         http-request nip test-a
 374     ] unit-test
 375
 376     [ 4 ] [ a get-global ] unit-test
 377
 378     ! Test flash scope
 379     [ "xyz" ] [
 380         [
 381             "xyz" "a" ,,
 382             "http://localhost" add-addr "__u" ,,
 383             "session-id" get session-id-key ,,
 384         ] H{ } make
 385         "http://localhost/" add-addr <post-request> "cookies" get >>cookies
 386         http-request nip test-a
 387     ] unit-test
 388
 389     [ 4 ] [ a get-global ] unit-test
 390
 391     [ "Goodbye" ] [ "http://localhost/quit" add-addr http-get nip ] unit-test
 392
 393 ] test-with-db-persistence
 394
 395 ! Test cloning
 396 { f } [ <404> dup clone "b" "a" set-header drop "a" header ] unit-test
 397 { f } [ <404> dup clone "b" "a" <cookie> put-cookie drop "a" get-cookie ] unit-test
 398
 399 ! Test basic auth
 400 { "Basic QWxhZGRpbjpvcGVuIHNlc2FtZQ==" } [
 401     <request> "Aladdin" "open sesame" set-basic-auth "Authorization" header
 402 ] unit-test
 403
 404 ! Test a corner case with static responder
 405 <dispatcher>
 406     add-quit-action
 407     "vocab:http/test/foo.html" <static> >>default [
 408     [ t ] [
 409         "http://localhost/" add-addr http-get nip
 410         "vocab:http/test/foo.html" ascii file-contents =
 411     ] unit-test
 412
 413     [ ] [ stop-test-httpd ] unit-test
 414
 415 ] test-with-dispatcher
 416
 417 ! Check behavior of 307 redirect (reported by Chris Double)
 418 <dispatcher>
 419     add-quit-action
 420     <action>
 421         [ "b" <temporary-redirect> ] >>submit
 422     "a" add-responder
 423     <action>
 424         [
 425             request get post-data>> data>> "data" =
 426             [ "OK" "text/plain" <content> ] [ "OOPS" throw ] if
 427         ] >>submit
 428     "b" add-responder [
 429
 430     [ "OK" ] [ "data" "http://localhost/a" add-addr http-post nip ] unit-test
 431
 432     ! Check that download throws errors (reported by Chris Double)
 433     [
 434         [
 435             "http://localhost/tweet_my_twat" add-addr download
 436         ] with-temp-directory
 437     ] must-fail
 438
 439     [ ] [ stop-test-httpd ] unit-test
 440
 441 ] test-with-dispatcher
 442
 443 ! Check that index.fhtml works
 444 <dispatcher>
 445     "resource:basis/http/test/" <static> enable-fhtml >>default
 446     add-quit-action [
 447
 448     [ "OK\n" ] [ "http://localhost/" add-addr http-get nip ] unit-test
 449
 450     [ ] [ stop-test-httpd ] unit-test
 451
 452 ] test-with-dispatcher
 453
 454 ! Check that just closing the socket without sending anything works
 455 <dispatcher>
 456     add-quit-action [
 457     [ ] [ "addr" get binary [ ] with-client ] unit-test
 458
 459     [ ] [ stop-test-httpd ] unit-test
 460
 461 ] test-with-dispatcher