basis/http/http-tests.factor

   1 USING: http http.server http.client tools.test multiline
   2 io.streams.string io.encodings.utf8 io.encodings.8-bit
   3 io.encodings.binary io.encodings.string kernel arrays splitting
   4 sequences assocs io.sockets db db.sqlite continuations urls
   5 hashtables accessors ;
   6 IN: http.tests
   7
   8 [ "text/plain" latin1 ] [ "text/plain" parse-content-type ] unit-test
   9
  10 [ "text/html" utf8 ] [ "text/html;  charset=UTF-8" parse-content-type ] unit-test
  11
  12 [ "application/octet-stream" binary ] [ "application/octet-stream" parse-content-type ] unit-test
  13
  14 : lf>crlf "\n" split "\r\n" join ;
  15
  16 STRING: read-request-test-1
  17 POST /bar HTTP/1.1
  18 Some-Header: 1
  19 Some-Header: 2
  20 Content-Length: 4
  21 Content-type: application/octet-stream
  22
  23 blah
  24 ;
  25
  26 [
  27     T{ request
  28         { url T{ url { path "/bar" } } }
  29         { method "POST" }
  30         { version "1.1" }
  31         { header H{ { "some-header" "1; 2" } { "content-length" "4" } { "content-type" "application/octet-stream" } } }
  32         { post-data T{ post-data { content "blah" } { raw "blah" } { content-type "application/octet-stream" } } }
  33         { cookies V{ } }
  34     }
  35 ] [
  36     read-request-test-1 lf>crlf [
  37         read-request
  38     ] with-string-reader
  39 ] unit-test
  40
  41 STRING: read-request-test-1'
  42 POST /bar HTTP/1.1
  43 content-length: 4
  44 content-type: application/octet-stream
  45 some-header: 1; 2
  46
  47 blah
  48 ;
  49
  50 read-request-test-1' 1array [
  51     read-request-test-1 lf>crlf
  52     [ read-request ] with-string-reader
  53     [ write-request ] with-string-writer
  54     ! normalize crlf
  55     string-lines "\n" join
  56 ] unit-test
  57
  58 STRING: read-request-test-2
  59 HEAD  /bar   HTTP/1.1
  60 Host: www.sex.com
  61
  62 ;
  63
  64 [
  65     T{ request
  66         { url T{ url { host "www.sex.com" } { path "/bar" } } }
  67         { method "HEAD" }
  68         { version "1.1" }
  69         { header H{ { "host" "www.sex.com" } } }
  70         { cookies V{ } }
  71     }
  72 ] [
  73     read-request-test-2 lf>crlf [
  74         read-request
  75     ] with-string-reader
  76 ] unit-test
  77
  78 STRING: read-request-test-3
  79 GET nested HTTP/1.0
  80
  81 ;
  82
  83 [ read-request-test-3 lf>crlf [ read-request ] with-string-reader ]
  84 [ "Bad request: URL" = ]
  85 must-fail-with
  86
  87 STRING: read-request-test-4
  88 GET /blah HTTP/1.0
  89 Host: "www.amazon.com"
  90 ;
  91
  92 [ "www.amazon.com" ]
  93 [
  94     read-request-test-4 lf>crlf [ read-request ] with-string-reader
  95     "host" header
  96 ] unit-test
  97
  98 STRING: read-response-test-1
  99 HTTP/1.1 404 not found
 100 Content-Type: text/html; charset=UTF-8
 101
 102 blah
 103 ;
 104
 105 [
 106     T{ response
 107         { version "1.1" }
 108         { code 404 }
 109         { message "not found" }
 110         { header H{ { "content-type" "text/html; charset=UTF-8" } } }
 111         { cookies { } }
 112         { content-type "text/html" }
 113         { content-charset utf8 }
 114     }
 115 ] [
 116     read-response-test-1 lf>crlf
 117     [ read-response ] with-string-reader
 118 ] unit-test
 119
 120
 121 STRING: read-response-test-1'
 122 HTTP/1.1 404 not found
 123 content-type: text/html; charset=UTF-8
 124
 125
 126 ;
 127
 128 read-response-test-1' 1array [
 129     read-response-test-1 lf>crlf
 130     [ read-response ] with-string-reader
 131     [ write-response ] with-string-writer
 132     ! normalize crlf
 133     string-lines "\n" join
 134 ] unit-test
 135
 136 [ t ] [
 137     "rmid=732423sdfs73242; path=/; domain=.example.net; expires=Fri, 31-Dec-2010 23:59:59 GMT"
 138     dup parse-set-cookie first unparse-set-cookie =
 139 ] unit-test
 140
 141 [ t ] [
 142     "a="
 143     dup parse-set-cookie first unparse-set-cookie =
 144 ] unit-test
 145
 146 STRING: read-response-test-2
 147 HTTP/1.1 200 Content follows
 148 Set-Cookie: oo="bar; a=b"; httponly=yes; sid=123456
 149
 150
 151 ;
 152
 153 [ 2 ] [
 154     read-response-test-2 lf>crlf
 155     [ read-response ] with-string-reader
 156     cookies>> length
 157 ] unit-test
 158
 159 STRING: read-response-test-3
 160 HTTP/1.1 200 Content follows
 161 Set-Cookie: oo="bar; a=b"; comment="your mom"; httponly=yes
 162
 163
 164 ;
 165
 166 [ 1 ] [
 167     read-response-test-3 lf>crlf
 168     [ read-response ] with-string-reader
 169     cookies>> length
 170 ] unit-test
 171
 172 ! Live-fire exercise
 173 USING: http.server http.server.static furnace.sessions furnace.alloy
 174 furnace.actions furnace.auth furnace.auth.login furnace.db http.client
 175 io.servers.connection io.files io io.encodings.ascii
 176 accessors namespaces threads
 177 http.server.responses http.server.redirection furnace.redirection
 178 http.server.dispatchers db.tuples ;
 179
 180 : add-quit-action
 181     <action>
 182         [ stop-this-server "Goodbye" "text/html" <content> ] >>display
 183     "quit" add-responder ;
 184
 185 : test-db "test.db" temp-file sqlite-db ;
 186
 187 [ test-db drop delete-file ] ignore-errors
 188
 189 test-db [
 190     init-furnace-tables
 191 ] with-db
 192
 193 : test-httpd ( -- )
 194     #! Return as soon as server is running.
 195     <http-server>
 196         1237 >>insecure
 197         f >>secure
 198     start-server* ;
 199
 200 [ ] [
 201     [
 202         <dispatcher>
 203             add-quit-action
 204             <dispatcher>
 205                 "resource:basis/http/test" <static> >>default
 206             "nested" add-responder
 207             <action>
 208                 [ URL" redirect-loop" <temporary-redirect> ] >>display
 209             "redirect-loop" add-responder
 210         main-responder set
 211
 212         test-httpd
 213     ] with-scope
 214 ] unit-test
 215
 216 [ t ] [
 217     "resource:basis/http/test/foo.html" ascii file-contents
 218     "http://localhost:1237/nested/foo.html" http-get nip =
 219 ] unit-test
 220
 221 [ "http://localhost:1237/redirect-loop" http-get nip ]
 222 [ too-many-redirects? ] must-fail-with
 223
 224 [ "Goodbye" ] [
 225     "http://localhost:1237/quit" http-get nip
 226 ] unit-test
 227
 228 ! HTTP client redirect bug
 229 [ ] [
 230     [
 231         <dispatcher>
 232             add-quit-action
 233             <action> [ "quit" <temporary-redirect> ] >>display
 234             "redirect" add-responder
 235         main-responder set
 236
 237         test-httpd
 238     ] with-scope
 239 ] unit-test
 240
 241 [ "Goodbye" ] [
 242     "http://localhost:1237/redirect" http-get nip
 243 ] unit-test
 244
 245
 246 [ ] [
 247     [ "http://localhost:1237/quit" http-get 2drop ] ignore-errors
 248 ] unit-test
 249
 250 ! Dispatcher bugs
 251 [ ] [
 252     [
 253         <dispatcher>
 254             <action> <protected>
 255             "Test" <login-realm>
 256             <sessions>
 257             "" add-responder
 258             add-quit-action
 259             <dispatcher>
 260                 <action> "" add-responder
 261             "d" add-responder
 262         test-db <db-persistence>
 263         main-responder set
 264
 265         test-httpd
 266     ] with-scope
 267 ] unit-test
 268
 269 : 404? [ download-failed? ] [ response>> code>> 404 = ] bi and ;
 270
 271 ! This should give a 404 not an infinite redirect loop
 272 [ "http://localhost:1237/d/blah" http-get nip ] [ 404? ] must-fail-with
 273
 274 ! This should give a 404 not an infinite redirect loop
 275 [ "http://localhost:1237/blah/" http-get nip ] [ 404? ] must-fail-with
 276
 277 [ "Goodbye" ] [ "http://localhost:1237/quit" http-get nip ] unit-test
 278
 279 [ ] [
 280     [
 281         <dispatcher>
 282             <action> [ [ "Hi" write ] "text/plain" <content> ] >>display
 283             "Test" <login-realm>
 284             <sessions>
 285             "" add-responder
 286             add-quit-action
 287         test-db <db-persistence>
 288         main-responder set
 289
 290         test-httpd
 291     ] with-scope
 292 ] unit-test
 293
 294 [ "Hi" ] [ "http://localhost:1237/" http-get nip ] unit-test
 295
 296 [ "Goodbye" ] [ "http://localhost:1237/quit" http-get nip ] unit-test
 297
 298 USING: html.components html.elements html.forms
 299 xml xml.utilities validators
 300 furnace furnace.conversations ;
 301
 302 SYMBOL: a
 303
 304 [ ] [
 305     [
 306         <dispatcher>
 307             <action>
 308                 [ a get-global "a" set-value ] >>init
 309                 [ [ <html> "a" <field> render </html> ] "text/html" <content> ] >>display
 310                 [ { { "a" [ v-integer ] } } validate-params ] >>validate
 311                 [ "a" value a set-global URL" " <redirect> ] >>submit
 312             <conversations>
 313             <sessions>
 314             >>default
 315             add-quit-action
 316         test-db <db-persistence>
 317         main-responder set
 318
 319         test-httpd
 320     ] with-scope
 321 ] unit-test
 322
 323 3 a set-global
 324
 325 : test-a string>xml "input" tag-named "value" swap at ;
 326
 327 [ "3" ] [
 328     "http://localhost:1237/" http-get
 329     swap dup cookies>> "cookies" set session-id-key get-cookie
 330     value>> "session-id" set test-a
 331 ] unit-test
 332
 333 [ "4" ] [
 334     H{ { "a" "4" } { "__u" "http://localhost:1237/" } } "session-id" get session-id-key associate assoc-union
 335     "http://localhost:1237/" <post-request> "cookies" get >>cookies http-request nip test-a
 336 ] unit-test
 337
 338 [ 4 ] [ a get-global ] unit-test
 339
 340 ! Test flash scope
 341 [ "xyz" ] [
 342     H{ { "a" "xyz" } { "__u" "http://localhost:1237/" } } "session-id" get session-id-key associate assoc-union
 343     "http://localhost:1237/" <post-request> "cookies" get >>cookies http-request nip test-a
 344 ] unit-test
 345
 346 [ 4 ] [ a get-global ] unit-test
 347
 348 [ "Goodbye" ] [ "http://localhost:1237/quit" http-get nip ] unit-test
 349
 350 ! Test cloning
 351 [ f ] [ <404> dup clone "b" "a" set-header drop "a" header ] unit-test
 352 [ f ] [ <404> dup clone "b" "a" <cookie> put-cookie drop "a" get-cookie ] unit-test