guile-knots/tests/web-server.scm

(use-modules (srfi srfi-71)
             (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* ((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")