1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586 |
- (define-module (test-suite web-request)
- #:use-module (web uri)
- #:use-module (web request)
- #:use-module (test-suite lib))
- (define example-1
- "GET /qux HTTP/1.1\r
- Host: localhost:8080\r
- User-Agent: Mozilla/5.0 (X11; U; Linux x86_64; en-us) AppleWebKit/531.2+ (KHTML, like Gecko) Safari/531.2+ Epiphany/2.30.2\r
- Accept: application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5\r
- Accept-Encoding: gzip\r
- Accept-Language: en-gb, en;q=0.9\r
- \r
- ")
- (define (requests-equal? r1 r2)
- (and (equal? (request-method r1) (request-method r2))
- (equal? (request-uri r1) (request-uri r2))
- (equal? (request-version r1) (request-version r2))
- (equal? (request-headers r1) (request-headers r2))))
- (with-test-prefix "example-1"
- (let ((r #f))
- (pass-if "read-request"
- (begin
- (set! r (read-request (open-input-string example-1)))
- (request? r)))
-
- (pass-if (equal?
- (request-host (build-request (string->uri "http://www.gnu.org/")))
- '("www.gnu.org" . #f)))
-
- (pass-if (equal? (request-method r) 'GET))
-
- (pass-if (equal? (request-uri r) (build-uri 'http #:path "/qux")))
-
- (pass-if (equal? (read-request-body r) #f))
- (pass-if "checking all headers"
- (equal?
- (request-headers r)
- '((host . ("localhost" . 8080))
- (user-agent . "Mozilla/5.0 (X11; U; Linux x86_64; en-us) AppleWebKit/531.2+ (KHTML, like Gecko) Safari/531.2+ Epiphany/2.30.2")
- (accept . ((application/xml)
- (application/xhtml+xml)
- (text/html (q . 900))
- (text/plain (q . 800))
- (image/png)
- (*/* (q . 500))))
- (accept-encoding . ((1000 . "gzip")))
- (accept-language . ((1000 . "en-gb") (900 . "en"))))))
-
-
- (pass-if "write then read"
- (requests-equal? (with-input-from-string
- (with-output-to-string
- (lambda ()
- (write-request r (current-output-port))))
- (lambda ()
- (read-request (current-input-port))))
- r))
- (pass-if "by accessor"
- (equal? (request-accept-encoding r) '((1000 . "gzip"))))))
|