67 lines
2.8 KiB
Racket
67 lines
2.8 KiB
Racket
;;; SPDX-License-Identifier: LGPL-3.0-or-later
|
|
;;; SPDX-FileCopyrightText: Copyright © 2024 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
|
|
|
|
#lang syndicate
|
|
;; Simple example of the HTTP server protocol and Racket implementation.
|
|
|
|
(require syndicate/drivers/http)
|
|
(require racket/pretty)
|
|
(require xml)
|
|
|
|
(define (html-response #:title title #:head [head '()] . body-items)
|
|
(parameterize ((current-unescaped-tags html-unescaped-tags)
|
|
(empty-tag-shorthand html-empty-tags))
|
|
(mime 'text/html
|
|
(string-append "<!DOCTYPE html>\n"
|
|
(xexpr->string
|
|
`(html
|
|
(head
|
|
(meta ((http-equiv "Content-Type") (content "text/html; charset=utf-8")))
|
|
(meta ((name "viewport") (content "width=device-width, initial-scale=1.0")))
|
|
(title ,title)
|
|
,@head)
|
|
(body ,@body-items)))))))
|
|
|
|
(module+ main
|
|
(standard-actor-system (ds)
|
|
(with-services [syndicate/drivers/http]
|
|
(spawn #:name 'logger
|
|
(at ds
|
|
(during (HttpRequest $id $host $port $method $path $headers $query $body)
|
|
(define start-time (current-inexact-milliseconds))
|
|
(on-start (log-info ":+ ~a ~a ~a ~a ~v" id method host port path))
|
|
(on-stop (define stop-time (current-inexact-milliseconds))
|
|
(define duration-ms (- stop-time start-time))
|
|
(log-info ":- ~a ~a ~a ~a ~v ~ams" id method host port path
|
|
duration-ms)))))
|
|
|
|
(spawn #:name 'server
|
|
(define-field counter 0)
|
|
|
|
(at ds
|
|
(define-http-route [#f 8080 'get [""] req res]
|
|
[]
|
|
(counter (+ (counter) 1))
|
|
(html-response #:title "Hello"
|
|
`(h1 "Hello world")
|
|
`(p "Counter " ,(number->string (counter)))
|
|
`(a ((href "/page2")) "Go forward")))
|
|
(define-http-route [#f 8080 'get ["page2"] req res]
|
|
[]
|
|
(html-response #:title "Page 2"
|
|
`(h1 "Second page")
|
|
`(a ((href "/")) "Go back")))))
|
|
|
|
(spawn #:name 'server2
|
|
(at ds
|
|
(assert (HttpBinding #f 8080 'get (list (PathPatternElement-label "page3"))
|
|
(object
|
|
[(HttpContext req res)
|
|
(at res
|
|
(log-info "+page3")
|
|
(on-stop (log-info "-page3"))
|
|
(send! (HttpResponse-header 'content-type "text/plain"))
|
|
(send! (HttpResponse-done "this is page3\n")))])))))
|
|
|
|
)))
|