aboutsummaryrefslogtreecommitdiff
path: root/tests/web-server.scm
blob: 3eebd1d6db5c2c7256a06063ea3646967045a1bd (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
(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")