Christopher Baines
e1858dfff5
This turned out not to be useful, since I wanted to handle exceptions happening in the exception handler, so it didn't really help in the end to allow customising it.
236 lines
6.9 KiB
Scheme
236 lines
6.9 KiB
Scheme
(use-modules (srfi srfi-71)
|
|
(rnrs bytevectors)
|
|
(ice-9 binary-ports)
|
|
(ice-9 textual-ports)
|
|
(tests)
|
|
(fibers)
|
|
(fibers channels)
|
|
(unit-test)
|
|
(web uri)
|
|
(web client)
|
|
(web request)
|
|
(web response)
|
|
(knots web-server)
|
|
(knots non-blocking))
|
|
|
|
(run-fibers-for-tests
|
|
(lambda ()
|
|
(let* ((web-server
|
|
(run-knots-web-server
|
|
(lambda (request)
|
|
(values '((content-type . (text/plain)))
|
|
"Hello, World!"))
|
|
#:port 0)) ;; Bind to any port
|
|
(port
|
|
(web-server-port web-server))
|
|
(uri
|
|
(build-uri 'http #:host "127.0.0.1" #:port port)))
|
|
|
|
(assert-equal
|
|
200
|
|
(response-code
|
|
(http-get
|
|
uri
|
|
#:port (non-blocking-open-socket-for-uri uri)))))))
|
|
|
|
(run-fibers-for-tests
|
|
(lambda ()
|
|
(let* ((web-server
|
|
(run-knots-web-server
|
|
(lambda (request)
|
|
"Hello, World!")
|
|
#:port 0)) ;; Bind to any port
|
|
(port
|
|
(web-server-port web-server))
|
|
(uri
|
|
(build-uri 'http #:host "127.0.0.1" #:port port)))
|
|
|
|
(assert-equal
|
|
500
|
|
(response-code
|
|
(http-get
|
|
uri
|
|
#:port (non-blocking-open-socket-for-uri uri)))))))
|
|
|
|
(run-fibers-for-tests
|
|
(lambda ()
|
|
(let* ((web-server
|
|
(run-knots-web-server
|
|
(lambda (request)
|
|
(values '((content-type . (text/plain))
|
|
(content-length . 3))
|
|
(lambda (port)
|
|
(display "foo" port))))
|
|
#:port 0)) ;; Bind to any port
|
|
(port
|
|
(web-server-port web-server))
|
|
(uri
|
|
(build-uri 'http #:host "127.0.0.1" #:port port)))
|
|
|
|
(let ((response
|
|
body
|
|
(http-get
|
|
uri
|
|
#:port (non-blocking-open-socket-for-uri uri))))
|
|
(assert-equal
|
|
"foo"
|
|
body)))))
|
|
|
|
(run-fibers-for-tests
|
|
(lambda ()
|
|
(let* ((web-server
|
|
(run-knots-web-server
|
|
(lambda (request)
|
|
(values '((content-type . (text/plain
|
|
(charset . "utf-8"))))
|
|
(lambda (port)
|
|
(display "☺" port))))
|
|
#:port 0)) ;; Bind to any port
|
|
(port
|
|
(web-server-port web-server))
|
|
(uri
|
|
(build-uri 'http #:host "127.0.0.1" #:port port)))
|
|
|
|
(let ((response
|
|
body
|
|
(http-get
|
|
uri
|
|
#:port (non-blocking-open-socket-for-uri uri))))
|
|
(assert-equal
|
|
"☺"
|
|
body)))))
|
|
|
|
(run-fibers-for-tests
|
|
(lambda ()
|
|
(let* ((web-server
|
|
(run-knots-web-server
|
|
(lambda (request)
|
|
(values '((content-type . (text/plain
|
|
(charset . "utf-8")))
|
|
(content-length . 3))
|
|
(lambda (port)
|
|
(display "☺" port))))
|
|
#:port 0)) ;; Bind to any port
|
|
(port
|
|
(web-server-port web-server))
|
|
(uri
|
|
(build-uri 'http #:host "127.0.0.1" #:port port)))
|
|
|
|
(let ((response
|
|
body
|
|
(http-get
|
|
uri
|
|
;; TODO Remove once using Guile 3.0.10
|
|
#:streaming? #t
|
|
#:port (non-blocking-open-socket-for-uri uri))))
|
|
(assert-equal
|
|
"☺"
|
|
(utf8->string
|
|
(get-bytevector-n body 3)))))))
|
|
|
|
(run-fibers-for-tests
|
|
(lambda ()
|
|
(let* ((web-server
|
|
(run-knots-web-server
|
|
(lambda (request)
|
|
(if (string=? (utf8->string
|
|
(read-request-body/knots request))
|
|
"☺")
|
|
(values (build-response #:code 200)
|
|
"")
|
|
(values (build-response #:code 500)
|
|
"")))
|
|
#:port 0)) ;; Bind to any port
|
|
(port
|
|
(web-server-port web-server))
|
|
(uri
|
|
(build-uri 'http #:host "127.0.0.1" #:port port)))
|
|
|
|
(let ((response
|
|
body
|
|
(http-post
|
|
uri
|
|
#:body "☺"
|
|
#:port (non-blocking-open-socket-for-uri uri))))
|
|
(assert-equal
|
|
200
|
|
(response-code response))))))
|
|
|
|
(run-fibers-for-tests
|
|
(lambda ()
|
|
(let* ((channel (make-channel))
|
|
(web-server
|
|
(run-knots-web-server
|
|
(lambda (request)
|
|
(with-exception-handler
|
|
(lambda (exn)
|
|
(put-message channel exn))
|
|
(lambda ()
|
|
(read-request-body/knots request))
|
|
#:unwind? #t))
|
|
#:port 0)) ;; Bind to any port
|
|
(port
|
|
(web-server-port web-server))
|
|
(uri
|
|
(build-uri 'http #:host "127.0.0.1" #:port port)))
|
|
|
|
(let* ((port (non-blocking-open-socket-for-uri uri))
|
|
(request
|
|
(build-request
|
|
uri
|
|
#:method 'POST
|
|
#:version '(1 . 1)
|
|
#:headers `((connection close)
|
|
(content-length . 20)
|
|
(Content-Type . "application/octet-stream"))
|
|
#:port port)))
|
|
|
|
(set-port-encoding! port "ISO-8859-1")
|
|
(let ((request (write-request request port)))
|
|
(display "12")
|
|
(force-output port)
|
|
|
|
(close-port port)))
|
|
|
|
(assert-true
|
|
(request-body-ended-prematurely-error?
|
|
(get-message channel))))))
|
|
|
|
;; Test hanlding of exceptions when writing the response to a client
|
|
(run-fibers-for-tests
|
|
(lambda ()
|
|
(let* ((exception-handled-sucecssfully-channel
|
|
(make-channel))
|
|
(port-closed-channel (make-channel))
|
|
(web-server
|
|
(run-knots-web-server
|
|
(lambda (request)
|
|
;; TODO Not sure why buffering makes a difference here
|
|
(setvbuf (request-port request) 'none)
|
|
(get-message port-closed-channel)
|
|
(values '((content-type . (text/plain)))
|
|
"Hello, World!"))
|
|
#:write-response-exception-handler
|
|
(lambda (exn request)
|
|
(spawn-fiber
|
|
(lambda ()
|
|
(put-message exception-handled-sucecssfully-channel
|
|
#t)))
|
|
#f)
|
|
#:port 0)) ;; Bind to any port
|
|
(port
|
|
(web-server-port web-server))
|
|
(uri
|
|
(build-uri 'http #:host "127.0.0.1" #:port port)))
|
|
|
|
(let ((request-port (non-blocking-open-socket-for-uri uri)))
|
|
(write-request
|
|
(build-request uri)
|
|
request-port)
|
|
(close-port request-port))
|
|
(put-message port-closed-channel #t)
|
|
|
|
(assert-equal (get-message exception-handled-sucecssfully-channel)
|
|
#t))))
|
|
|
|
(display "web-server test finished successfully\n")
|