eutro: 4 Prototype HTTP frontend Generalize backend, improve HTTP frontend UI Make the UI more mobile-friendly Templated HTML responses, and changes to how the backend handles errors 26 files changed, 1256 insertions(+), 493 deletions(-)
r16/patches/linux_buildtest.yml: SUCCESS in 2m20s [Prototype HTTP frontend][0] v4 from [eutro][1] [0]: https://lists.sr.ht/~williewillus/public-inbox/patches/32761 [1]: mailto:benedek.szilvasy@gmail.com ✓ #774291 SUCCESS r16/patches/linux_buildtest.yml https://builds.sr.ht/~williewillus/job/774291
Copy & paste the following snippet into your terminal to import this patchset into git:
curl -s https://lists.sr.ht/~williewillus/public-inbox/patches/32761/mbox | git am -3Learn more about email & git
--- backend.rkt | 12 ++-- frontends/http.rkt | 175 +++++++++++++++++++++++++++++++++++++++++++++ interface.rkt | 4 +- 3 files changed, 184 insertions(+), 7 deletions(-) create mode 100644 frontends/http.rkt diff --git a/backend.rkt b/backend.rkt index 17ecd92..d7bb465 100644 --- a/backend.rkt @@ -110,11 +110,11 @@ (define/public (register name code author timestamp) (cond [(zero? (string-length code)) - (~a "Trick " name " needs a body!")] + (cons 'err (~a "Trick " name " needs a body!"))] [(db:add-trick! db (current-context-id) name (thunk (trick author code timestamp (make-hash) 0))) - (~a "Successfully registered trick " name "!")] + (cons 'ok (~a "Successfully registered trick " name "!"))] [else (update name code)])) (define/public (update name code) @@ -123,9 +123,9 @@ (define frontend (current-frontend)) (cond [(not trick-obj) - (~a "Trick " name " doesn't exist!")] + (cons 'err (~a "Trick " name " doesn't exist!"))] [(zero? (string-length code)) - (~a "Trick " name " needs a body!")] + (cons 'err (~a "Trick " name " needs a body!"))] [(db:update-trick! db ctx-id name (lambda (trick-obj) @@ -136,7 +136,9 @@ (trick-invocations trick-obj))) (lambda (t) (send frontend can-modify? t))) - (~a "Successfully updated trick " name "!")])) + (cons 'ok (~a "Successfully updated trick " name "!"))] + [else + (cons 'err (~a "You cannot modify trick " name "!"))])) (define/public (lookup name) (db:get-trick db (current-context-id) name)) diff --git a/frontends/http.rkt b/frontends/http.rkt new file mode 100644 index 0000000..5374066 --- /dev/null +++ b/frontends/http.rkt @@ -0,0 +1,175 @@ +#lang racket/base + +(require + racket/class + racket/list + racket/match + racket/function + racket/string + "../common.rkt" + "../config.rkt" + (prefix-in ev: "../evaluator.rkt") + "../interface.rkt" + + base64 + file/sha1 + net/url-structs + web-server/web-server + web-server/servlet-dispatch + web-server/http/xexpr + web-server/http/request-structs + web-server/http/response-structs) + +(provide r16-make-frontend) + +(struct image (bytes)) + +(define http-frontend + (class* object% [r16-frontend<%>] + (init-field port) + + (define mutex (make-semaphore 1)) + (define current-hashed (make-parameter #f)) + (define/public (response? v) (image? v)) + (define/public (get-enrich-context) + (define (enrich-context base _trick _args _parent-ctx) + (define (make-image png-bytes) + (image png-bytes)) + `(((make-image . ,make-image) + ,@(car base)) + ,@(cdr base))) + enrich-context) + (define/public (can-modify? trick) + (equal? (trick-author trick) (current-hashed))) + (define/public (start) + (define (handle-request req) + (define req-uri (request-uri req)) + (define path (takef (url-path req-uri) (compose1 non-empty-string? path/param-path))) + (match* [(request-method req) path] + [[#"POST" (list (path/param "tricks" _) + (path/param "submit" _))] + (define bindings (request-bindings/raw req)) + (match* [(bindings-assq #"name" bindings) + (bindings-assq #"code" bindings) + (bindings-assq #"password" bindings)] + [[(binding:form _ (and name-bytes + (pregexp "^[a-zA-Z_\\-0-9]+$") + (app bytes->string/utf-8 name))) + (binding:form _ (app bytes->string/utf-8 code)) + (binding:form _ password)] + ;; yeah, it's not secure at all + (call-with-semaphore + mutex + (thunk + (define hashed (bytes->hex-string (sha256-bytes (bytes-append (sha256-bytes name-bytes) password)))) + (match (parameterize ([current-hashed hashed]) + (send (current-backend) register name code hashed (number->string (current-seconds)))) + [(cons 'ok _) + (response/full + 303 #"See Other" + (current-seconds) TEXT/HTML-MIME-TYPE + (list (make-header #"Location" (string->bytes/utf-8 (format "/tricks/~a.rkt" name)))) + (list #"Redirecting..."))] + [(cons 'err msg) + (response/full + 400 #"Bad Request" + (current-seconds) TEXT/HTML-MIME-TYPE + null + (list (string->bytes/utf-8 msg)))])))] + [[_ _ _] + (response/full + 400 #"Bad Request" + (current-seconds) TEXT/HTML-MIME-TYPE + null + (list #"400 Bad Request"))])] + [[#"GET" (list (path/param "tricks" _))] + (define popular (send (current-backend) popular)) + (response/xexpr + `(html (head (title "Tricks")) + (body (div + (h2 "Add trick") + (form + ((action "/tricks/submit") + (method "post") + (enctype "multipart/form-data")) + (label ((for "name")) "Name: ") + (input ((type "text") (id "name") (name "name"))) + (br) + (label ((for "password")) "Password: ") + (input ((type "password") (id "password") (name "password"))) + (br) + (span + ((style "color:red;")) + "None of this is very secure at all, so under no circumstances should you use a password you use elsewhere.") + (br) + (label ((for "code")) "Code: ") + (textarea + ((id "code") + (name "code") + (rows "5") + (cols "60") + (placeholder "Enter text") + (spellcheck "false"))) + (br) + (input ((type "submit") (value "Add"))))) + (div + (h1 "Registered tricks") + (ol + ,@(for/list ([t (in-list popular)]) + (define n (car t)) + `(li + ,n + " (" + (a ((href ,(format "/tricks/~a.rkt" n))) "src") + ") " + (form + ((action ,(format "/tricks/~a" n)) + (method "get") + (style "display:inline;")) + (input ((type "text") (name "args"))) + (input ((type "submit") (value "Call")))))))))))] + [[#"GET" (list (path/param "tricks" _) + (path/param (pregexp "^([a-zA-Z_\\-0-9]+)\\.rkt$" (list trick-file-name trick-name)) _))] + (define trick-v (send (current-backend) lookup trick-name)) + (response/xexpr + `(html (head (title ,trick-file-name)) + (body (pre ,(trick-body trick-v)))))] + [[#"GET" (list (path/param "tricks" _) + (path/param (pregexp "^[a-zA-Z_\\-0-9]+$" (list trick-name)) _))] + (define args (assoc 'args (url-query req-uri))) + (define res (send (current-backend) call trick-name (if args (cdr args) ""))) + (cond + [(ev:run-result? res) + (define stderr (ev:run-result-stderr res)) + (define stdout (ev:run-result-stdout res)) + (response/xexpr + `(html (head (title ,trick-name)) + (body ,@(if stderr `((pre ,stderr)) null) + ,@(if (zero? (string-length stdout)) null `((pre ,stdout))) + ,@(for/list ([r (ev:run-result-results res)]) + (cond + [(image? r) + `(img + ((src ,(format "data:image/png;base64,~a" (base64-encode (image-bytes r))))))] + [else + `(pre ,r)])))))] + [(string? res) + (response/xexpr + #:code 400 + `(html (head (title "400 Bad Request")) + (body ,res)))])] + [[#"GET" _] + (response/xexpr + #:code 404 + `(html (head (title "404 Not found")) + (body "404 Not found")))])) + (serve + #:dispatch (dispatch/servlet handle-request) + #:port port) + (do-not-return)) + (super-new))) + +(define (r16-make-frontend raw-config) + (define port (check-config exact-positive-integer? (hash-ref raw-config 'port 8080))) + (new http-frontend + [port port])) diff --git a/interface.rkt b/interface.rkt index 9062c09..fabae44 100644 --- a/interface.rkt +++ b/interface.rkt @@ -49,10 +49,10 @@ ;; register a trick, returning an error or success message [register (#;trick string? #;code string? #;author string? #;timestamp string? - . ->m . string?)] + . ->m . (cons/c (or/c 'err 'ok) string?))] ;; update a trick, returning an error or success message - [update (#;trick string? #;code string? . ->m . string?)] + [update (#;trick string? #;code string? . ->m . (cons/c (or/c 'err 'ok) string?))] ;; look up a trick by name [lookup (#;trick string? . ->m . (or/c trick? #f))] -- 2.36.1
--- backend.rkt | 12 +- frontends/discord.rkt | 23 ++- frontends/http.rkt | 336 ++++++++++++++++++++++++++++++------------ interface.rkt | 14 +- result.rkt | 23 +++ 5 files changed, 287 insertions(+), 121 deletions(-) create mode 100644 result.rkt diff --git a/backend.rkt b/backend.rkt index d7bb465..0e67637 100644 --- a/backend.rkt @@ -70,7 +70,7 @@ enrich-context (current-context-id) #f "" "" #f)) - (ev:run code ev-ctx response?)) + (cons 'ok (ev:run code ev-ctx response?))) (define/public (call name args) (define ctx-id (current-context-id)) @@ -89,9 +89,9 @@ (current-context-id) trick-obj name args #f)) (define code (trick-body trick-obj)) - (ev:run code ev-ctx response?)] + (cons 'ok (ev:run code ev-ctx response?))] [else - (~a "Trick " name " doesn't exist!")])) + (cons 'err (~a "Trick " name " doesn't exist!"))])) (define/public (delete name) (define ctx-id (current-context-id)) @@ -99,13 +99,13 @@ (define frontend (current-frontend)) (cond [(not trick-obj) - (~a "Trick " name " doesn't exist!")] + (cons 'err (~a "Trick " name " doesn't exist!"))] [(db:remove-trick! db ctx-id name (lambda (t) (send frontend can-modify? t))) - (~a "Successfully removed trick " name "!")] + (cons 'ok (~a "Successfully removed trick " name "!"))] [else - (~a "You cannot modify trick " name "!")])) + (cons 'err (~a "You cannot modify trick " name "!"))])) (define/public (register name code author timestamp) (cond diff --git a/frontends/discord.rkt b/frontends/discord.rkt index 42b072e..be00918 100644 --- a/frontends/discord.rkt +++ b/frontends/discord.rkt @@ -453,9 +453,7 @@ (thunk (define result (send (current-backend) evaluate (strip-backticks text))) - (if (ev:run-result? result) - (format-run-result result) - (list result))))) + (result-case format-run-result list result)))) (define/command/trick (call-trick name body) " [_name_] ...: invoke the trick [_name_], evaluating its source code in a fresh sandbox" @@ -463,17 +461,16 @@ (thunk (define result (send (current-backend) call name body)) - (if (ev:run-result? result) - (format-run-result result) - (list result))))) + (result-case format-run-result list result)))) (define/command/trick (register-trick name body) " [_name_] [_code_]: register [_code_] as a trick with name [_name_]" - (list - (send (current-backend) register - name (strip-backticks body) - (message-author-id (current-message)) - (hash-ref (current-message) 'timestamp)))) + (define result + (send (current-backend) register + name (strip-backticks body) + (message-author-id (current-message)) + (hash-ref (current-message) 'timestamp))) + (list (cdr result))) (define/command/trick (show-trick name _body) " [_name_]: show metadata and source for the trick [_name_]" @@ -494,11 +491,11 @@ (define/command/trick (update-trick name body) " [_name_] [_code_]: change the source of the trick [_name_]; requires ownership or administrator" - (list (send (current-backend) update name (strip-backticks body)))) + (list (cdr (send (current-backend) update name (strip-backticks body))))) (define/command/trick (delete-trick name _body) " [_name_]: delete the trick [_name_]; requires ownership or administrator and cannot be undone!" - (list (send (current-backend) delete name))) + (list (cdr (send (current-backend) delete name)))) (define/command (popular text) ": show a leaderboard of popular tricks" diff --git a/frontends/http.rkt b/frontends/http.rkt index 5374066..74b6f11 100644 --- a/frontends/http.rkt +++ b/frontends/http.rkt @@ -8,10 +8,11 @@ racket/string "../common.rkt" "../config.rkt" + "../log.rkt" (prefix-in ev: "../evaluator.rkt") "../interface.rkt" - base64 + net/base64 file/sha1 net/url-structs web-server/web-server @@ -24,6 +25,78 @@ (struct image (bytes)) +(define (simple-response code msg body) + (response/full + code msg + (current-seconds) TEXT/HTML-MIME-TYPE + null + (list body))) + +(define (format-for-html str) + (define url-regex #px"(([^:/?#]+):)(//([^/?#]*))([^?#]*)(\\?([^#]*))?(#(.*))?") + `(div + ((class "content")) + ,@(for/list ([line (in-list (string-split str "\n"))]) + (define urls (regexp-match-positions* url-regex line #:match-select car)) + `(div + ((class "block")) + ,@(cond + [(null? urls) (list line)] + [else + (define positions + (append* + (for/list ([url-pos (in-list urls)]) + (list (car url-pos) (cdr url-pos))))) + (for/list ([start (in-list `(0 ,@positions))] + [end (in-list `(,@positions ,(string-length line)))] + [is-link? (in-cycle (in-list '(#f #t)))]) + (define v (substring line start end)) + (if is-link? + `(a ((href ,v)) ,v) + v))]))))) + +(define HTML-DOCTYPE #"<!DOCTYPE html>") + +(define (response/html + #:title title + #:navbar? [navbar? #f] + . body) + (response/xexpr + #:preamble HTML-DOCTYPE + `(html (head + (meta ((charset "utf-8"))) + (meta ((name "viewport") (content "width=device-width, initial-scale=1"))) + (title ,title) + (link ((rel "stylesheet") (href "https://cdn.jsdelivr.net/npm/bulma@0.9.3/css/bulma.min.css"))) + (link ((rel "stylesheet") (href "https://fonts.googleapis.com/icon?family=Material+Icons"))) + (style + ".code-input { font-family: mono; }" + ".toggled .togglable { display: none; }" + ".togglable-inverse { display: none; }" + ".toggled .togglable-inverse { display: inline; }")) + (body + ,@(if navbar? + `((navbar + ((class "navbar is-dark") + (role "navigation") + (aria-label "main navigation")) + (div + ((class "navbar-menu")) + (div + ((class "navbar-start")) + (a ((class "navbar-item") (href "/")) "Home") + (a ((class "navbar-item") (href "/tricks")) "Tricks")) + (div + ((class "navbar-end")) + (a ((class "navbar-item") (href "https://sr.ht/~williewillus/r16")) "Source"))))) + null) + (div ((class "container")) ,@body) + (footer + ((class "footer")) + (div + ((class "container has-text-centered")) + ,(format-for-html (send (current-backend) about)))))))) + (define http-frontend (class* object% [r16-frontend<%>] (init-field port) @@ -42,7 +115,13 @@ (define/public (can-modify? trick) (equal? (trick-author trick) (current-hashed))) (define/public (start) - (define (handle-request req) + (log-r16-debug "Starting server on port ~a" port) + (serve + #:dispatch (dispatch/servlet handle-request) + #:port port) + (do-not-return)) + + (define (handle-request req) (define req-uri (request-uri req)) (define path (takef (url-path req-uri) (compose1 non-empty-string? path/param-path))) (match* [(request-method req) path] @@ -62,111 +141,176 @@ mutex (thunk (define hashed (bytes->hex-string (sha256-bytes (bytes-append (sha256-bytes name-bytes) password)))) - (match (parameterize ([current-hashed hashed]) - (send (current-backend) register name code hashed (number->string (current-seconds)))) - [(cons 'ok _) - (response/full - 303 #"See Other" - (current-seconds) TEXT/HTML-MIME-TYPE - (list (make-header #"Location" (string->bytes/utf-8 (format "/tricks/~a.rkt" name)))) - (list #"Redirecting..."))] - [(cons 'err msg) - (response/full - 400 #"Bad Request" - (current-seconds) TEXT/HTML-MIME-TYPE - null - (list (string->bytes/utf-8 msg)))])))] + (parameterize ([current-hashed hashed]) + (cond + [(zero? (string-length code)) + (match (send (current-backend) delete name) + [(cons 'ok msg) (simple-response 200 #"OK" (string->bytes/utf-8 msg))] + [(cons 'err msg) (simple-response 400 #"Bad Request" (string->bytes/utf-8 msg))])] + [else + (match (send (current-backend) register name code hashed (number->string (current-seconds))) + [(cons 'ok _) + (response/full + 303 #"See Other" + (current-seconds) TEXT/HTML-MIME-TYPE + (list (make-header #"Location" (string->bytes/utf-8 (format "/tricks/~a.rkt" name)))) + (list #"Redirecting..."))] + [(cons 'err msg) + (simple-response 400 #"Bad Request" (string->bytes/utf-8 msg))])]))))] [[_ _ _] - (response/full - 400 #"Bad Request" - (current-seconds) TEXT/HTML-MIME-TYPE - null - (list #"400 Bad Request"))])] + (simple-response 400 #"Bad Request" #"400 Bad Request")])] + [[#"GET" (list (path/param "tricks" _))] (define popular (send (current-backend) popular)) - (response/xexpr - `(html (head (title "Tricks")) - (body (div - (h2 "Add trick") - (form - ((action "/tricks/submit") - (method "post") - (enctype "multipart/form-data")) - (label ((for "name")) "Name: ") - (input ((type "text") (id "name") (name "name"))) - (br) - (label ((for "password")) "Password: ") - (input ((type "password") (id "password") (name "password"))) - (br) - (span - ((style "color:red;")) - "None of this is very secure at all, so under no circumstances should you use a password you use elsewhere.") - (br) - (label ((for "code")) "Code: ") - (textarea - ((id "code") - (name "code") - (rows "5") - (cols "60") - (placeholder "Enter text") - (spellcheck "false"))) - (br) - (input ((type "submit") (value "Add"))))) - (div - (h1 "Registered tricks") - (ol - ,@(for/list ([t (in-list popular)]) - (define n (car t)) - `(li - ,n - " (" - (a ((href ,(format "/tricks/~a.rkt" n))) "src") - ") " - (form - ((action ,(format "/tricks/~a" n)) - (method "get") - (style "display:inline;")) - (input ((type "text") (name "args"))) - (input ((type "submit") (value "Call")))))))))))] + (response/html + #:title "Tricks" + #:navbar? #t + `(div + ((class "section")) + (h1 ((class "title")) "Add trick") + (form + ((action "/tricks/submit") + (method "post") + (target "_blank") + (enctype "multipart/form-data")) + + (div + ((class "field is-grouped")) + (div + ((class "control")) + (label ((class "label") (for "name")) "Trick Name") + (div + ((class "control")) + (input ((class "input") (type "text") (id "name") (name "name"))))) + (div + ((class "control")) + (label ((class "label") (for "password")) "Password") + (div + ((class "control")) + (input ((class "input") (type "password") (id "password") (name "password")))))) + (div + ((class "field")) + (label ((class "label") (for "code")) "Code") + (div + ((class "control")) + (textarea + ((class "textarea code-input") + (id "code") + (name "code") + (rows "5") + (cols "60") + (placeholder "Enter code") + (spellcheck "false"))))) + (div + ((class "field")) + (input ((class "button is-success") (type "submit") (value "Add")))))) + `(div + ((class "section")) + (h1 ((class "title")) "Registered tricks") + ,@(for/list ([trick-pair (in-list popular)]) + (define name (car trick-pair)) + (define trick-v (cdr trick-pair)) + `(div + ((class "block")) + (div + ((class "card toggled")) + (header + ((class "card-header has-background-dark has-text-white") + (onclick "toggle(this.parentElement)") + (title ,(format "Invocations: ~a" (trick-invocations trick-v)))) + (p ((class "card-header-title has-text-white")) ,name) + (button + ((class "card-header-icon") + (aria-label "more options")) + (span + ((class "material-icons togglable-inverse") (aria-hidden "true")) + "arrow_drop_down") + (span + ((class "material-icons togglable") (aria-hidden "true")) + "arrow_drop_up"))) + (div + ((class "card-content togglable")) + (form + ((action ,(format "/tricks/~a" name)) + (target "_blank") + (method "get")) + (div + ((class "field")) + (textarea ((class "textarea code-input") + (name "args") + (spellcheck "false") + (rows "1") + (placeholder "Enter arguments")))) + (input ((class "button is-primary") (type "submit") (value "Call"))))) + (footer + ((class "card-footer togglable")) + (a ((class "card-footer-item") (href ,(format "/tricks/~a.rkt" name)) (target "_blank")) "Source")))))) + `(script #<<EOF +function toggle(el) { + let toggled = el.classList.contains("toggled"); + if (toggled) { + el.classList.remove("toggled"); + } else { + el.classList.add("toggled"); + } +} +EOF + ))] + [[#"GET" (list (path/param "tricks" _) - (path/param (pregexp "^([a-zA-Z_\\-0-9]+)\\.rkt$" (list trick-file-name trick-name)) _))] + (path/param (pregexp "^([a-zA-Z_\\-0-9]+)\\.rkt$" (list _ trick-name)) _))] (define trick-v (send (current-backend) lookup trick-name)) - (response/xexpr - `(html (head (title ,trick-file-name)) - (body (pre ,(trick-body trick-v)))))] + (response/full + 200 #"OK" + (current-seconds) #"text/plain; charset=utf-8" + null + (list (string->bytes/utf-8 (trick-body trick-v))))] + [[#"GET" (list (path/param "tricks" _) (path/param (pregexp "^[a-zA-Z_\\-0-9]+$" (list trick-name)) _))] (define args (assoc 'args (url-query req-uri))) - (define res (send (current-backend) call trick-name (if args (cdr args) ""))) - (cond - [(ev:run-result? res) + (match (send (current-backend) call trick-name (if args (cdr args) "")) + [(cons 'ok res) (define stderr (ev:run-result-stderr res)) (define stdout (ev:run-result-stdout res)) - (response/xexpr - `(html (head (title ,trick-name)) - (body ,@(if stderr `((pre ,stderr)) null) - ,@(if (zero? (string-length stdout)) null `((pre ,stdout))) - ,@(for/list ([r (ev:run-result-results res)]) - (cond - [(image? r) - `(img - ((src ,(format "data:image/png;base64,~a" (base64-encode (image-bytes r))))))] - [else - `(pre ,r)])))))] - [(string? res) - (response/xexpr - #:code 400 - `(html (head (title "400 Bad Request")) - (body ,res)))])] + (define results (ev:run-result-results res)) + (match* [stderr stdout results] + [[#f "" (list (image raw-bytes))] + (response/full + 200 #"OK" + (current-seconds) #"image/png" + null + (list raw-bytes))] + [[_ _ _] + (response/xexpr + #:preamble HTML-DOCTYPE + `(html + (head (title ,trick-name)) + (body + ,@(if stderr `((pre ,stderr)) null) + ,@(if (zero? (string-length stdout)) null `((pre ,stdout))) + ,@(for/list ([r results]) + (cond + [(image? r) + `(img + ((src ,(format "data:image/png;base64,~a" (base64-encode (image-bytes r))))))] + [else + `(pre ,r)])))))])] + [(cons 'err msg) + (simple-response 400 #"Bad Request" (string->bytes/utf-8 msg))])] + + [[#"GET" (list)] + (response/html + #:title "r16" + #:navbar? #t + `(div + ((class "section")) + (h1 ((class "title")) "Stats") + ,(format-for-html (send (current-backend) stats))))] + [[#"GET" _] - (response/xexpr - #:code 404 - `(html (head (title "404 Not found")) - (body "404 Not found")))])) - (serve - #:dispatch (dispatch/servlet handle-request) - #:port port) - (do-not-return)) + (simple-response 404 #"Not Found" #"404 Not Found")])) + (super-new))) (define (r16-make-frontend raw-config) diff --git a/interface.rkt b/interface.rkt index fabae44..14c952a 100644 --- a/interface.rkt +++ b/interface.rkt @@ -3,13 +3,15 @@ (require racket/class racket/contract + "result.rkt" (only-in "evaluator.rkt" definitions? run-result?) "common.rkt") (provide r16-backend? r16-frontend? r16-backend<%> r16-frontend<%> current-backend current-frontend - current-context-id) + current-context-id + (all-from-out "result.rkt")) ;; an r16 frontend (define r16-frontend<%> @@ -38,21 +40,21 @@ (define r16-backend<%> (interface () ;; evaluate a code snippet, returning either an error message or a run result - [evaluate (#;code string? . ->m . (or/c string? run-result?))] + [evaluate (#;code string? . ->m . (result/c run-result? string?))] ;; call a trick with arguments, returning either an error message or a run result - [call (#;trick string? #;args string? . ->m . (or/c string? run-result?))] + [call (#;trick string? #;args string? . ->m . (result/c run-result? string?))] ;; delete a trick, returning an error or success message - [delete (#;trick string? . ->m . string?)] + [delete (#;trick string? . ->m . (result/c string? string?))] ;; register a trick, returning an error or success message [register (#;trick string? #;code string? #;author string? #;timestamp string? - . ->m . (cons/c (or/c 'err 'ok) string?))] + . ->m . (result/c string? string?))] ;; update a trick, returning an error or success message - [update (#;trick string? #;code string? . ->m . (cons/c (or/c 'err 'ok) string?))] + [update (#;trick string? #;code string? . ->m . (result/c string? string?))] ;; look up a trick by name [lookup (#;trick string? . ->m . (or/c trick? #f))] diff --git a/result.rkt b/result.rkt new file mode 100644 index 0000000..2f4f8d0 --- /dev/null +++ b/result.rkt @@ -0,0 +1,23 @@ +#lang racket/base + +(require racket/contract (for-syntax racket/base syntax/parse)) + +(provide result/c ok? err? result-case) + +;; represents a fallible computation +;; (cons 'ok ok-value) on success +;; (cons 'err err-value) on failure +(define-syntax (result/c stx) + (syntax-parse stx + [(_ ok-ctc:expr err-ctc:expr) + (with-syntax ([name stx]) + (syntax/loc stx + (rename-contract + (or/c (cons/c 'ok ok-ctc) + (cons/c 'err err-ctc)) + 'name)))])) + +(define (ok? x) (eq? 'ok (car x))) +(define (err? x) (eq? 'err (car x))) +(define (result-case if-ok if-err x) + ((if (ok? x) if-ok if-err) (cdr x))) -- 2.36.1
--- frontends/http.rkt | 50 ++++++++++++++++++++++++---------------------- 1 file changed, 26 insertions(+), 24 deletions(-) diff --git a/frontends/http.rkt b/frontends/http.rkt index 74b6f11..a779489 100644 --- a/frontends/http.rkt +++ b/frontends/http.rkt @@ -81,7 +81,18 @@ (role "navigation") (aria-label "main navigation")) (div - ((class "navbar-menu")) + ((class "navbar-brand has-background-dark")) + (p ((class "navbar-item")) "R16") + (a ((role "button") + (class "navbar-burger") + (aria-label "menu") + (aria-expanded "false") + (onclick "this.classList.toggle(\"is-active\");document.getElementById(\"navmenu\").classList.toggle(\"is-active\")")) + (span ((aria-hidden "true"))) + (span ((aria-hidden "true"))) + (span ((aria-hidden "true"))))) + (div + ((class "navbar-menu") (id "navmenu")) (div ((class "navbar-start")) (a ((class "navbar-item") (href "/")) "Home") @@ -175,19 +186,21 @@ (enctype "multipart/form-data")) (div - ((class "field is-grouped")) + ((class "field")) (div - ((class "control")) - (label ((class "label") (for "name")) "Trick Name") + ((class "columns")) (div - ((class "control")) - (input ((class "input") (type "text") (id "name") (name "name"))))) - (div - ((class "control")) - (label ((class "label") (for "password")) "Password") + ((class "column")) + (label ((class "label") (for "name")) "Trick Name") + (div + ((class "control")) + (input ((class "input") (type "text") (id "name") (name "name"))))) (div - ((class "control")) - (input ((class "input") (type "password") (id "password") (name "password")))))) + ((class "column")) + (label ((class "label") (for "password")) "Password") + (div + ((class "control")) + (input ((class "input") (type "password") (id "password") (name "password"))))))) (div ((class "field")) (label ((class "label") (for "code")) "Code") @@ -216,7 +229,7 @@ ((class "card toggled")) (header ((class "card-header has-background-dark has-text-white") - (onclick "toggle(this.parentElement)") + (onclick "this.parentElement.classList.toggle(\"toggled\")") (title ,(format "Invocations: ~a" (trick-invocations trick-v)))) (p ((class "card-header-title has-text-white")) ,name) (button @@ -244,18 +257,7 @@ (input ((class "button is-primary") (type "submit") (value "Call"))))) (footer ((class "card-footer togglable")) - (a ((class "card-footer-item") (href ,(format "/tricks/~a.rkt" name)) (target "_blank")) "Source")))))) - `(script #<<EOF -function toggle(el) { - let toggled = el.classList.contains("toggled"); - if (toggled) { - el.classList.remove("toggled"); - } else { - el.classList.add("toggled"); - } -} -EOF - ))] + (a ((class "card-footer-item") (href ,(format "/tricks/~a.rkt" name)) (target "_blank")) "Source")))))))] [[#"GET" (list (path/param "tricks" _) (path/param (pregexp "^([a-zA-Z_\\-0-9]+)\\.rkt$" (list _ trick-name)) _))] -- 2.36.1
Improve whitespace handling in result presentation Update on top of rebase, make template arguments explicit, support dynamic template reloads Styling improvements --- backend.rkt | 14 +- frontends/discord.rkt | 13 +- frontends/http.rkt | 321 ------------------------------ frontends/http/base.html | 43 ++++ frontends/http/favicon.ico | Bin 0 -> 67646 bytes frontends/http/home.html | 5 + frontends/http/icon.svg | 194 ++++++++++++++++++ frontends/http/main.rkt | 265 ++++++++++++++++++++++++ frontends/http/raw.html | 23 +++ frontends/http/result.html | 40 ++++ frontends/http/simple.html | 4 + frontends/http/style-in.css | 20 ++ frontends/http/style.css | 1 + frontends/http/tailwind.config.js | 5 + frontends/http/tricks.html | 109 ++++++++++ interface.rkt | 27 ++- result.rkt | 16 +- 17 files changed, 759 insertions(+), 341 deletions(-) delete mode 100644 frontends/http.rkt create mode 100644 frontends/http/base.html create mode 100644 frontends/http/favicon.ico create mode 100644 frontends/http/home.html create mode 100644 frontends/http/icon.svg create mode 100644 frontends/http/main.rkt create mode 100644 frontends/http/raw.html create mode 100644 frontends/http/result.html create mode 100644 frontends/http/simple.html create mode 100644 frontends/http/style-in.css create mode 100644 frontends/http/style.css create mode 100644 frontends/http/tailwind.config.js create mode 100644 frontends/http/tricks.html diff --git a/backend.rkt b/backend.rkt index 0e67637..b8104f9 100644 --- a/backend.rkt @@ -91,7 +91,7 @@ (define code (trick-body trick-obj)) (cons 'ok (ev:run code ev-ctx response?))] [else - (cons 'err (~a "Trick " name " doesn't exist!"))])) + (list 'err (~a "Trick " name " doesn't exist!") 'no-such-trick)])) (define/public (delete name) (define ctx-id (current-context-id)) @@ -99,18 +99,18 @@ (define frontend (current-frontend)) (cond [(not trick-obj) - (cons 'err (~a "Trick " name " doesn't exist!"))] + (list 'err (~a "Trick " name " doesn't exist!") 'no-such-trick)] [(db:remove-trick! db ctx-id name (lambda (t) (send frontend can-modify? t))) (cons 'ok (~a "Successfully removed trick " name "!"))] [else - (cons 'err (~a "You cannot modify trick " name "!"))])) + (list 'err (~a "You cannot modify trick " name "!") 'missing-permissions)])) (define/public (register name code author timestamp) (cond [(zero? (string-length code)) - (cons 'err (~a "Trick " name " needs a body!"))] + (list 'err (~a "Trick " name " needs a body!") 'needs-body)] [(db:add-trick! db (current-context-id) name (thunk (trick author code timestamp (make-hash) 0))) @@ -123,9 +123,9 @@ (define frontend (current-frontend)) (cond [(not trick-obj) - (cons 'err (~a "Trick " name " doesn't exist!"))] + (list 'err (~a "Trick " name " doesn't exist!") 'no-such-trick)] [(zero? (string-length code)) - (cons 'err (~a "Trick " name " needs a body!"))] + (list 'err (~a "Trick " name " needs a body!") 'needs-body)] [(db:update-trick! db ctx-id name (lambda (trick-obj) @@ -138,7 +138,7 @@ (send frontend can-modify? t))) (cons 'ok (~a "Successfully updated trick " name "!"))] [else - (cons 'err (~a "You cannot modify trick " name "!"))])) + (list 'err (~a "You cannot modify trick " name "!") 'missing-permissions)])) (define/public (lookup name) (db:get-trick db (current-context-id) name)) diff --git a/frontends/discord.rkt b/frontends/discord.rkt index be00918..19bd541 100644 --- a/frontends/discord.rkt +++ b/frontends/discord.rkt @@ -447,13 +447,16 @@ (define (codeblock-quote result) (~a "```scheme\n" result "```")) + (define (error-response err) + (list (car err))) + (define/command (call-snippet text) " [_code_]: evaluate [_code_] as a Racket form" (with-typing-indicator (thunk (define result (send (current-backend) evaluate (strip-backticks text))) - (result-case format-run-result list result)))) + (result-case format-run-result error-response result)))) (define/command/trick (call-trick name body) " [_name_] ...: invoke the trick [_name_], evaluating its source code in a fresh sandbox" @@ -461,7 +464,7 @@ (thunk (define result (send (current-backend) call name body)) - (result-case format-run-result list result)))) + (result-case format-run-result error-response result)))) (define/command/trick (register-trick name body) " [_name_] [_code_]: register [_code_] as a trick with name [_name_]" @@ -470,7 +473,7 @@ name (strip-backticks body) (message-author-id (current-message)) (hash-ref (current-message) 'timestamp))) - (list (cdr result))) + (list (result-case cdr cadr result))) (define/command/trick (show-trick name _body) " [_name_]: show metadata and source for the trick [_name_]" @@ -491,11 +494,11 @@ (define/command/trick (update-trick name body) " [_name_] [_code_]: change the source of the trick [_name_]; requires ownership or administrator" - (list (cdr (send (current-backend) update name (strip-backticks body))))) + (list (result-case cdr cadr (send (current-backend) update name (strip-backticks body))))) (define/command/trick (delete-trick name _body) " [_name_]: delete the trick [_name_]; requires ownership or administrator and cannot be undone!" - (list (cdr (send (current-backend) delete name)))) + (list (result-case cdr cadr (send (current-backend) delete name)))) (define/command (popular text) ": show a leaderboard of popular tricks" diff --git a/frontends/http.rkt b/frontends/http.rkt deleted file mode 100644 index a779489..0000000 --- a/frontends/http.rkt @@ -1,321 +0,0 @@ -#lang racket/base - -(require - racket/class - racket/list - racket/match - racket/function - racket/string - "../common.rkt" - "../config.rkt" - "../log.rkt" - (prefix-in ev: "../evaluator.rkt") - "../interface.rkt" - - net/base64 - file/sha1 - net/url-structs - web-server/web-server - web-server/servlet-dispatch - web-server/http/xexpr - web-server/http/request-structs - web-server/http/response-structs) - -(provide r16-make-frontend) - -(struct image (bytes)) - -(define (simple-response code msg body) - (response/full - code msg - (current-seconds) TEXT/HTML-MIME-TYPE - null - (list body))) - -(define (format-for-html str) - (define url-regex #px"(([^:/?#]+):)(//([^/?#]*))([^?#]*)(\\?([^#]*))?(#(.*))?") - `(div - ((class "content")) - ,@(for/list ([line (in-list (string-split str "\n"))]) - (define urls (regexp-match-positions* url-regex line #:match-select car)) - `(div - ((class "block")) - ,@(cond - [(null? urls) (list line)] - [else - (define positions - (append* - (for/list ([url-pos (in-list urls)]) - (list (car url-pos) (cdr url-pos))))) - (for/list ([start (in-list `(0 ,@positions))] - [end (in-list `(,@positions ,(string-length line)))] - [is-link? (in-cycle (in-list '(#f #t)))]) - (define v (substring line start end)) - (if is-link? - `(a ((href ,v)) ,v) - v))]))))) - -(define HTML-DOCTYPE #"<!DOCTYPE html>") - -(define (response/html - #:title title - #:navbar? [navbar? #f] - . body) - (response/xexpr - #:preamble HTML-DOCTYPE - `(html (head - (meta ((charset "utf-8"))) - (meta ((name "viewport") (content "width=device-width, initial-scale=1"))) - (title ,title) - (link ((rel "stylesheet") (href "https://cdn.jsdelivr.net/npm/bulma@0.9.3/css/bulma.min.css"))) - (link ((rel "stylesheet") (href "https://fonts.googleapis.com/icon?family=Material+Icons"))) - (style - ".code-input { font-family: mono; }" - ".toggled .togglable { display: none; }" - ".togglable-inverse { display: none; }" - ".toggled .togglable-inverse { display: inline; }")) - (body - ,@(if navbar? - `((navbar - ((class "navbar is-dark") - (role "navigation") - (aria-label "main navigation")) - (div - ((class "navbar-brand has-background-dark")) - (p ((class "navbar-item")) "R16") - (a ((role "button") - (class "navbar-burger") - (aria-label "menu") - (aria-expanded "false") - (onclick "this.classList.toggle(\"is-active\");document.getElementById(\"navmenu\").classList.toggle(\"is-active\")")) - (span ((aria-hidden "true"))) - (span ((aria-hidden "true"))) - (span ((aria-hidden "true"))))) - (div - ((class "navbar-menu") (id "navmenu")) - (div - ((class "navbar-start")) - (a ((class "navbar-item") (href "/")) "Home") - (a ((class "navbar-item") (href "/tricks")) "Tricks")) - (div - ((class "navbar-end")) - (a ((class "navbar-item") (href "https://sr.ht/~williewillus/r16")) "Source"))))) - null) - (div ((class "container")) ,@body) - (footer - ((class "footer")) - (div - ((class "container has-text-centered")) - ,(format-for-html (send (current-backend) about)))))))) - -(define http-frontend - (class* object% [r16-frontend<%>] - (init-field port) - - (define mutex (make-semaphore 1)) - (define current-hashed (make-parameter #f)) - (define/public (response? v) (image? v)) - (define/public (get-enrich-context) - (define (enrich-context base _trick _args _parent-ctx) - (define (make-image png-bytes) - (image png-bytes)) - `(((make-image . ,make-image) - ,@(car base)) - ,@(cdr base))) - enrich-context) - (define/public (can-modify? trick) - (equal? (trick-author trick) (current-hashed))) - (define/public (start) - (log-r16-debug "Starting server on port ~a" port) - (serve - #:dispatch (dispatch/servlet handle-request) - #:port port) - (do-not-return)) - - (define (handle-request req) - (define req-uri (request-uri req)) - (define path (takef (url-path req-uri) (compose1 non-empty-string? path/param-path))) - (match* [(request-method req) path] - [[#"POST" (list (path/param "tricks" _) - (path/param "submit" _))] - (define bindings (request-bindings/raw req)) - (match* [(bindings-assq #"name" bindings) - (bindings-assq #"code" bindings) - (bindings-assq #"password" bindings)] - [[(binding:form _ (and name-bytes - (pregexp "^[a-zA-Z_\\-0-9]+$") - (app bytes->string/utf-8 name))) - (binding:form _ (app bytes->string/utf-8 code)) - (binding:form _ password)] - ;; yeah, it's not secure at all - (call-with-semaphore - mutex - (thunk - (define hashed (bytes->hex-string (sha256-bytes (bytes-append (sha256-bytes name-bytes) password)))) - (parameterize ([current-hashed hashed]) - (cond - [(zero? (string-length code)) - (match (send (current-backend) delete name) - [(cons 'ok msg) (simple-response 200 #"OK" (string->bytes/utf-8 msg))] - [(cons 'err msg) (simple-response 400 #"Bad Request" (string->bytes/utf-8 msg))])] - [else - (match (send (current-backend) register name code hashed (number->string (current-seconds))) - [(cons 'ok _) - (response/full - 303 #"See Other" - (current-seconds) TEXT/HTML-MIME-TYPE - (list (make-header #"Location" (string->bytes/utf-8 (format "/tricks/~a.rkt" name)))) - (list #"Redirecting..."))] - [(cons 'err msg) - (simple-response 400 #"Bad Request" (string->bytes/utf-8 msg))])]))))] - [[_ _ _] - (simple-response 400 #"Bad Request" #"400 Bad Request")])] - - [[#"GET" (list (path/param "tricks" _))] - (define popular (send (current-backend) popular)) - (response/html - #:title "Tricks" - #:navbar? #t - `(div - ((class "section")) - (h1 ((class "title")) "Add trick") - (form - ((action "/tricks/submit") - (method "post") - (target "_blank") - (enctype "multipart/form-data")) - - (div - ((class "field")) - (div - ((class "columns")) - (div - ((class "column")) - (label ((class "label") (for "name")) "Trick Name") - (div - ((class "control")) - (input ((class "input") (type "text") (id "name") (name "name"))))) - (div - ((class "column")) - (label ((class "label") (for "password")) "Password") - (div - ((class "control")) - (input ((class "input") (type "password") (id "password") (name "password"))))))) - (div - ((class "field")) - (label ((class "label") (for "code")) "Code") - (div - ((class "control")) - (textarea - ((class "textarea code-input") - (id "code") - (name "code") - (rows "5") - (cols "60") - (placeholder "Enter code") - (spellcheck "false"))))) - (div - ((class "field")) - (input ((class "button is-success") (type "submit") (value "Add")))))) - `(div - ((class "section")) - (h1 ((class "title")) "Registered tricks") - ,@(for/list ([trick-pair (in-list popular)]) - (define name (car trick-pair)) - (define trick-v (cdr trick-pair)) - `(div - ((class "block")) - (div - ((class "card toggled")) - (header - ((class "card-header has-background-dark has-text-white") - (onclick "this.parentElement.classList.toggle(\"toggled\")") - (title ,(format "Invocations: ~a" (trick-invocations trick-v)))) - (p ((class "card-header-title has-text-white")) ,name) - (button - ((class "card-header-icon") - (aria-label "more options")) - (span - ((class "material-icons togglable-inverse") (aria-hidden "true")) - "arrow_drop_down") - (span - ((class "material-icons togglable") (aria-hidden "true")) - "arrow_drop_up"))) - (div - ((class "card-content togglable")) - (form - ((action ,(format "/tricks/~a" name)) - (target "_blank") - (method "get")) - (div - ((class "field")) - (textarea ((class "textarea code-input") - (name "args") - (spellcheck "false") - (rows "1") - (placeholder "Enter arguments")))) - (input ((class "button is-primary") (type "submit") (value "Call"))))) - (footer - ((class "card-footer togglable")) - (a ((class "card-footer-item") (href ,(format "/tricks/~a.rkt" name)) (target "_blank")) "Source")))))))] - - [[#"GET" (list (path/param "tricks" _) - (path/param (pregexp "^([a-zA-Z_\\-0-9]+)\\.rkt$" (list _ trick-name)) _))] - (define trick-v (send (current-backend) lookup trick-name)) - (response/full - 200 #"OK" - (current-seconds) #"text/plain; charset=utf-8" - null - (list (string->bytes/utf-8 (trick-body trick-v))))] - - [[#"GET" (list (path/param "tricks" _) - (path/param (pregexp "^[a-zA-Z_\\-0-9]+$" (list trick-name)) _))] - (define args (assoc 'args (url-query req-uri))) - (match (send (current-backend) call trick-name (if args (cdr args) "")) - [(cons 'ok res) - (define stderr (ev:run-result-stderr res)) - (define stdout (ev:run-result-stdout res)) - (define results (ev:run-result-results res)) - (match* [stderr stdout results] - [[#f "" (list (image raw-bytes))] - (response/full - 200 #"OK" - (current-seconds) #"image/png" - null - (list raw-bytes))] - [[_ _ _] - (response/xexpr - #:preamble HTML-DOCTYPE - `(html - (head (title ,trick-name)) - (body - ,@(if stderr `((pre ,stderr)) null) - ,@(if (zero? (string-length stdout)) null `((pre ,stdout))) - ,@(for/list ([r results]) - (cond - [(image? r) - `(img - ((src ,(format "data:image/png;base64,~a" (base64-encode (image-bytes r))))))] - [else - `(pre ,r)])))))])] - [(cons 'err msg) - (simple-response 400 #"Bad Request" (string->bytes/utf-8 msg))])] - - [[#"GET" (list)] - (response/html - #:title "r16" - #:navbar? #t - `(div - ((class "section")) - (h1 ((class "title")) "Stats") - ,(format-for-html (send (current-backend) stats))))] - - [[#"GET" _] - (simple-response 404 #"Not Found" #"404 Not Found")])) - - (super-new))) - -(define (r16-make-frontend raw-config) - (define port (check-config exact-positive-integer? (hash-ref raw-config 'port 8080))) - (new http-frontend - [port port])) diff --git a/frontends/http/base.html b/frontends/http/base.html new file mode 100644 index 0000000..095b55e --- /dev/null +++ b/frontends/http/base.html @@ -0,0 +1,43 @@ +@; Inputs: 'title 'navbar? 'body +<!DOCTYPE html> +<html lang="en" class="text-[16px] text-slate-700 bg-neutral-50"> + <head> + <meta charset="utf-8"/> + <meta name="viewport" content="width=device-width, initial-scale=1"/> + <title>@|title|</title> + <link rel="stylesheet" href="https://fonts.googleapis.com/icon?family=Material+Icons"/> + <link rel="stylesheet" href="/style.css"></style> + </head> + <body> + @when[navbar?]{ + @list{ + <navbar class="bg-neutral-700 text-white flex items-stretch min-h-[3.25rem]" + role="navigation" + aria-label="main navigation"> + <div class="flex items-stretch"> + <p class="flex items-center py-2 px-3"> + <img class="w-8 h-8" src="/icon.svg"></img> + </p> + </div> + <div class="flex items-stretch grow"> + <div class="flex items-stretch justify-start mr-auto"> + <a class="flex items-center py-2 px-3 hover:bg-neutral-800" href="/">Home</a> + <a class="flex items-center py-2 px-3 hover:bg-neutral-800" href="/tricks">Tricks</a> + </div> + <div class="flex items-stretch justify-end ml-auto"> + <a class="flex items-center py-2 px-3 hover:bg-neutral-800" href="https://sr.ht/~williewillus/r16">Source</a> + </div> + </div> + </navbar> + } + } + <div class="w-full bg-white"> + <div class="mx-auto 2xl:max-w-screen-xl xl:max-w-screen-lg lg:max-w-screen-md">@|body|</div> + </div> + <footer class="bg-neutral-50"> + <div class="p-12 text-center"> + @(format-for-html (send (current-backend) about)) + </div> + </footer> + </body> +</html> diff --git a/frontends/http/favicon.ico b/frontends/http/favicon.ico new file mode 100644 index 0000000000000000000000000000000000000000..de7078f233317ef74eb70a5d308bce115f1588ed GIT binary patch literal 67646 zcmeHQ34Bf0_C6UTqA|}NVt#6@YKcarO3g~CnV{61D%Fw}iCK9FHPccpT1B;{Jp438 z4XuZ#hW?AzP(0EaONN_!*Z*7l-gECccSvro%-JWum2>tv`|PvN_pLpyb@o*hFZ@MC zDfnMWshQtPDWxb%O$bi$NpYSJ<t7o32uK7Z0ulj<fJ8tdAQ6xVNCYGT5&?;TL_i`S z5s(N-1SA3y0f~S_Kq4R!kO)WwBmxoviGV~vA|Mfv2uK7Z0ulj<fJ8tdAQ6xVNCYGT z5&?;TL_i`S5s(N-1SA3y0f~S_Ae$oKi+uHhEQI_EG8Dp}Ov)|yBhV19cm_gt5|8i_ zNFYRRxetNnc%?NE=GmTmZTJ^luMLq~?m(a@USm5%%W-PQw-LWq?s)w?{T2au`$Le_ z_;z;v8tyBTr_sy#FFz$U?!COcsBq!JRG>fsXF3pr`>}e4+;SiS+@F64amK4SSEfuE z>e;g=4H+^-NaxO-sdVYm_VEYhz;~BfR+JGbabKuVAsR4XfR%ey2L=xwOf_oM(CWYq zq*Fiwn&S}ocS`&>Z{FO2dsPSCeDh7JSh1p32j0tZZ!a@^&lUf^zP|Lv8*jMepY@<$ zzkZZIe|}X5ZXzw7Gm=}DB0yEpocDu7L(s3MILNP%1CWi71(0!=-s!0*4(+(gC6y{w zDn;(qdLTGB*m@6MyF-?~dY*hZl?0zXAS)riLBNN*VnW<~kU%Ym;<#$ns&4T=XwV>S z9q?72q##pYno!45C}bAoB*X*(XO2>?oQX=7G*Mun<28N!t`7Wj|4uFAsqO33siWS1 zA5h3Pz(ai~TefUaxpL(eLH6UAZ7!B^HI)WmVUSIbyL#@3yuFEP*EZ4M!A4rV*g)TX zmqfR3CsJafO&&Z*q_by}X!mXdEnjY+ciu^+4jqhCt(u8^eLq$Cv+k=@sp2;O9Xock z-iJIl^6>TZ<ZY3Wk>1OfFMn?3%9RoI>(}1`?#Uu|z;g)Xusz=a0YsspMv90?rf<JB z(5+iGp0%92dwl(R0{Q#v+W>dlf36$24e;^tQFY+mJV|64UV6of6=fmaAnPE1LQp1` zQ&3RQU6udRr5iE-qHaf5oSuEwMB~OKi}HK_{*&?TOfR~0nXd9D_I`eT#ACeF>VEZl zv0}y4`&Xv{iaZf@$&w|3;I|9P_%d*Pf%&$V2@@u$<zDP7R}K?=fBm(A;^NYuZ+jis zw(W|_pLO4*OBc8Kx6TE4`TU?1seMc-T5GOSy!P|Z;n|Shkf-tl*_xMJy?S*ua6TJc z|7Fj&eVE%&we0hL{P^*@_S>GXl){f5CDQ5BNwjgJfg&T5segYXg@-58)Tznz*=Ghi zc`}JOjy4Srmnl=-$~|5Kb<VSH^UwVSzDM!Sm#7r2O;+(e{1~TkEt&V9L)t-dZ6A@_ zb8y}g<$XIiHrey+DqO2pEgk>S(a}17v|QOA|NeUtefgz<#*R&<7hg2NPLo=Hp9s}E zHE3X>VZ)5HW{rW)pHIU5TXp;gV&LFz8&IiIC6#|0_pAqg-{8D`ehl1)T?}~vlH+Yh zD6gv_H!x<70l&Yy;@H*sxpU|0xaab}Y11aB{3j$Nit@W?k%4;jFw#H%!DD!Pd_4;X z1YAH`-ew+=D3|Ay=780<pZ6t7lrZ1t?PtgTcAQTsKZ$?f`V7d^nyNF$9F{L%z8>?% zg8thrR~)P7KmPb*+O};Q9X@=RE?&Gy_wL;jeE~HMb${^SLBapy$BA_6R1z&&VxX>F zjlel2EYss!J01T83l^k-0|%zq4)Aqr|KG>oj{jY$@UO|USNv({K{%vDPEi2xH9_U9 zdiCl~`*xpy{<+}$%9Se=A0O{fuA`!&bmbp91)aD|-MSeG@Vk#+isj7RbbiG1ymUH{ z+Fa1fFTZSypRb^v|9n4qkbk2|@p|+F^nm9)vb9|i+#gW+Z_=d6MYWvse)Hzdm~%Pn zlyhwx{@}p_nm&C7wP?|WTDDw8MT*??05d|npFmZr+(N(Y5;bgiiSp$$c$AK!^tAB_ z0=OM$(4c|SI)H6N>>I*yg!mWN^Y3#B=iSvkC-J-z9xL8)+;6Ox-RcC4c?*GigUUbK z%F*|uojZ5Z)vH$>%DI+vKIXce=i>$rG!ll-ZsP=Z9Qa_|qvxN$h&JIUjTy6p=FVN` zFs2+cW;=1*wBsL#drCnpoLcskD_5poy?R;opl{#4#C4S}USI`1|6YH4@O&3}_P%{h z@xBh*)f3kVRgveukj4;?Hq_%m7~g%Pa?krolP1xfJ9kp#Jw85B%+HP*l?)D3@4I<> zo2YErJJh)GuhhN!Vay49OA8mS(Q(Z>w_(Eup?7=t?!{Q(OY8OO)o*x+|4!Ve?+XGb z=#v)}FJ4^O2iZo<=WK#@qsY@X{tJhC_-q&atM!OiJp7X%!VjG)r;)su5dUk45u)aM z4~~mL+}gl<MU>r7AO`z(`;$*TamqdS*$*5@5@T?-$>7m0B_JS?o__id>e%r(jU2g~ z=FeYi<x*{1nD6b|x6_FeC+OzQo0OcKOxo@K{rlE?TD3am@>wb6!+dR$ijjMJf6M`D z$NmK-Kf$wIV`R&>3G<_d-3YgIgS?Lr$JKir$2InYb-4lGB1uU}{{rvvTz9j)_S$Q@ ze%p>6J9PXXJC-Eo@PdMzbMEbJ#F!zDUV7;ad@c6Vv}qfyyfN4F=g+72-+v!=ox#L@ zcdT#g*RQ9)|NdJ`x5Kf)V6djsr_aGB;J}D`N4dgGf8GmqMd5$y`S(5Y1kZMde{CES z+d}(8{GE{aD$eQhTck)4;lmaHV~XY4JSX>APl4}=D(~u^eIK;-|FL7o=;+ZTVV9{< z!;$mCg&(0G^}A@Z$Bp}jKKkfmD^H6SEutw?rqHNSqtNf~My*@7CZ2y~+se?PLoqiq zR>VDd@}vXb_9r-hYF#m4z<24u!4{<9+E+x37XpLy+!q{_4$sx{>-O>gKy?%ZHdE^s zizAh1(RMMeJZ}*e7KXl;uw5h~P6g{7b_c+8tIE5&NBhrXetPDaVD#IgsX~QE4)0vB z;A2s~-+ucGa2rmOCr=jKaM>O<Y#6=%`s>uLT|2=w&$W#lIZ~WwpIbi9<(~68W5x_| zAJ_M(ZE<mNR{s0-``#f>fWm`w4{;CMh$=#CSSmc;FIY*>eWCW42j)JcC(lW@dlK;c zwTg10KJshO=DB6dmexKj>p<_`y<tNaeVu8D=X3+-kt*-J|M};nJHv-3W6t~*-jnM| zTfV)#OjN7ZHSoBHmMvQ)xQK{|5Wci3|IFuGZ@q;+K{)2;`@<IBL6mvU3+n;b`P|oT z-@ZM)`s%AlXPHQc=MPfb&Ye4F<-cv)6S}-<^Xb_!zw2I7e8!Vfpc8nnXU9E!NxVH9 zzj~G*8}82Ue{c$}$;h)!XPx;p*Q{BS<D79yKHp5_3*J9~T)lB4aU#wn+dq%Xdh6CF zQC7|E_|m0I>Am;fgHOg{^xeB-zP1Okosa8g=AOfx7oI=s)2ELp>&!LRNnAH@z0W?D ztP^T|&TV^2o6%^bEnBvT_{*2C#Q5y5bmre4??mXrMN)jBXWm>E?5}5s@Sn)nG>Ewk zb7s?M)20os3mr*u?h)Ag1P3P%*1l)ivUkDR_n4zyEpVSbd$!<}>u#=JxNYaYBA4-Z z-+foa88KpnwSDJf=9|aUoDZIJ=X;rZRTotLA3uKVKtJom_3PK^r=Na;&CjfRT<^4K zaXOpwkySbo4?Gr#_LO<i3fI9F{+qd~18nCBJ`M!mshc!nL=1d4RuY%>F=NIEPC2dN z!-rds=ggTS%6F?)t%OfCbIJWV=9-1;d2Zubm~+;XX3d(3_MgMtCs6DEJ$v@R{&SMJ zugS+e$GB>hxs6${U=8Y(oy23lk|pm;?p@SHAt4iW+_N5Vdu!ppi;ZXJN7bv}{2%w< z*Q{AXF)=Z8<j4`s$t)CocdpCTJ{#BDT&}sz=d#_kYgbX{GymMzXFcKeo%<u)*XOd% zI>2dgd-2LEuTV%xh|m$X2di}e?`O?gkLT@1y>blmfEUDkpl5S^SydLZ?zw@1ryTg_ zd29>+-JP?pD6q-;&6%_Qi<p>y6Wel3CX=-;=5oj!Gk;vybGc<6x&2qibYWo;7~5?| zSzamn1gsm}&u`ndEwK%SeL(m=?i;Yq@EBp<yiYNQ@D1vZ0~kk~CFmaJ`O)UO&~16% zJ-uqv=0lwh@L0>je+yUquU)(L9arNoo`2<foH^yP+o@A0!TadZ+o*2cD>}})bvq); zGPfDir%wmROW>RHg_!T-`TUTO^HjC!O?v7nZm-;X9~m!gIOWfOT<6<j^<P3K(G~x& z>zub1c)J7UlG}GKzg+Kg8$NU9ESLRnp7&$nF@xkTZQP|7UL{I&r>0Gtq90eyT=sqP z$18rDdLVs2dmTVs9I$KGF8xHiMF+S~&h0t3`#g8Yb^64K6UCfvdgWE7lMy=d8+g}z zyYN&6QUYfGrYI(S$E5d5LmxYsZ7$9>w()bD&230nSbx;x>!DZYpTPc}5$`I~bX|sy zl9KOjQVMmzoYquPA4f+UrorCxj9L%C=GL9<s@g3fApyQwr-<!-;o<X8|NjWz4aYfP z*Uy!lWLIp43^AVNd0yziKJ06Q{}JrFcjn9)I)3~(Z0);Y=h=?2*-6+F<XAhq^5|*4 z;6rVK-Too#0A%NsDVqjOn)DUw_gH%Fxr@Tr%G0#veL17vyL2h(n1%l@&Fuj70e9@X zF8l0x0E2}KlQ*OOAA&YNpV|)q_vIlwr4HnYGJy3mTy5-gMDQER6FB76`tH0d_RZ&c zj7XR-CjM?AuVR#&-y43SR4`>7P_I&R#6>@WEZ;jyeaIzc;zgBV_x7wWV*RDf*gwc6 z806+Mp4z*Oc8_;wv3MStU{50WmeMa$7jk5sxXKx`o}Hsg(18Jvb&#u4AI$m?9DD?} z(+w0F8VkS4v-rM*{k5`<u3*fcQ5#jmd%gjIj?sT14nBoAmz}V1D=+^33HXNP9Q+x+ zg-_Ic_&SWlcW!Oy!i8#d_ihn<8&`o=uO0-yYqM|StXUH<#KwziBr(ws-$z%aefwI7 zxDzK%gMY<mu&W%zH}8MIUsvyQn?X4Jg>>_06#I_pQXrle3c(smv;}ev;uhwa9j{QK z`}mgO1nixg;L|z_K4^n!|NiEJTayVN9cs9AbsQ7ZTD)6$_#(IBYtv!<V13%Vw<W&0 zd=q{)AHx3nwa`01zjX7D!5W%by-_)E+Zi$)vJC?Jr0X^Ra4p^RrD)MR_>TCv;CTG_ z+3;BzBJjR+sS13b+~Ziwnf<ZR=neme2k?R0k!Jqw)6#~MlYK<pv1?abTCm`4_+l=F zFYG>ipK&!U*u(=%%=Kl*O^h*`Ab&$3iy`|V*CA<nKM~iS<8|x$!M@cH>rxa>S5CD2 zXpfsU`yT5^U&)kb@pB(O45UMcLg14f4j=6`RI}!JSD4Muj?AZ=Cn^jb_*tt5zP<*m z32+HMrhDP<wt{BQ9*?zUx(SXM3oRE}aXfbHJbY7Z68(a#cs@UK-n_B)I>6)hk||@I zU9ZwJ_3HgMiR(V@KN$>IJkX7{IIH4p+{kN95FI?&G|TeYyZ3r~{>NljcHPMr`eu_) zpRSu_c&0^{xDUttFIh4oOY(c|T6wH}nxN&M$6*?KpF4<Ww>abz5_0Gy_mR`WMOMV+ zek6|rhYeenC3)pGk@e3aJpOK!-PrUjKU8_@)JX|h!D(8b$$gW$bx&tH|G)lP9X^^# zD)+qq&@-&F=UoK~JR17rkI!d1u4&~zB4VcK1IEQ+al1_HtMu%-QOo@~@SlluJ(;63 zjT#->|M)Q$49`Sd)A}s654d&fYnhhMBS(U@bBI{`ff{BGBbogaDv9#-Ag!EaW_<3e z0)HAkIyzJM=YA2}8TgqN$<h7&)HDk7p`Bx6Lo)?iPxK}!DIeA&PNe$vPi0CT(JxYY z=RN!K<@hy-Q_}&=<9?ML=6hV}2hYQ?P3Ov$iW#Z{zx?t~{9cjuyGpjNq`2NgYPjZ{ z>l6rE+-+C*XZ86PUNEl{J8jy;4C6mOKEJS8S?YWP_DypRe@~uM%mp`v%?%%|qv6YD z(x%OBQ74xvb5qz5(>s5U9u*MwK@0c%tO-w!XwFLkbHhvT+$ox^_&;^3KGrqYuNTHP z3$_jM7>(y>*#7vz2h)Z9B074sutlz4-&@!+Hf-o6!fc;p;p=SYm^^t3)?-+Wbu{)+ zK!EN$YyKTX@0`b8dgPe=hYnp1gIm_t0r&40!a7x5u<pqg?Kn)^FUzQ7{N}CW_uc7% zY|cr8>cR$S%q$&XTk?PY^DNfO8Gto0KB6W~4%^SWWfa%;=`IEL&ejLbIn<?7PBHHp z47=B%nKL7d+qQMWTEY$J&p(TM)Gpk*RSN4N*1>vIuh6HThKYKYZEB4hA9bkLfxkT` zPZH+eNW(W8;<s(LV$b|efrLYPLD(n14x|jkC!L_nWyuI^*avY9<o_^doWN~wojN}Y z-yfcvZ`W=o)->8Gd<dF1-!IOy?-%>w+0CCn376`<+%M;G8UOwRe@_7)EQ){(fV77^ z2Z3KsUa!M5QVppX@T~=T3BteE)y*Q^v1gwnRmS0XyhWn0=iho`VSo1(8sTy|3&L@S zLi$2D&DM~YA((rmx)AntljSrcsg-F<1SA3y0f~S_Kq4R!kO)WwBmxoviGV~vA|Mfv z2uK7Z0ulj<fJ8tdAQ6xVNCYGT5&?;TL_i`S5s(N-1SA3y0f~S_Kq4R!kO)WwBmxov ziGV~vA|Mfv2uK7Z0ulj<fJ7h{A%G8~<(BgixEHE_hs(Umy=IH@*8~VZv*4o(CoBA` z2evI4pQ~!O1jlfs-F5qLsOEYs3XCR<)OBILtOQx(PvxL3EMjZIm&Il4b(1-$D3Rs_ zkX7?$K_FHQo8QnH-ExB^b&e!%(1gVeny`3+HF<HvHM*xJkG&5?QLHAckP@j4Di!U* zeoCnBI#5X^92BdM5Og_}aFpHkRKi$iU$@z>DUs%HnC+gY#Ojh)e6;xCl8+W&guU?b zyms@_1B~nX8^BqVKE6HzbE=KN#Xw83C>ED(DVU3m?GAG|)*8XAWS3orgM?DrUNTgK zZFx3_Z8?Y(*KJ`D<X=UxZ04{P6thnA$`j^IE!9z$usOSA1<gLJ))JR3@q;Yss~L{8 Vgv}XJ@5V{KA;@x3?s6~!{||>D@CpC` literal 0 HcmV?d00001 diff --git a/frontends/http/home.html b/frontends/http/home.html new file mode 100644 index 0000000..0ee8a2d --- /dev/null +++ b/frontends/http/home.html @@ -0,0 +1,5 @@ +@; No inputs +<div class="p-12"> + <h1 class="text-3xl font-bold mb-6">Stats</h1> + @(format-for-html (send (current-backend) stats)) +</div> diff --git a/frontends/http/icon.svg b/frontends/http/icon.svg new file mode 100644 index 0000000..ce74571 --- /dev/null +++ b/frontends/http/icon.svg @@ -0,0 +1,194 @@ +<?xml version="1.0" encoding="UTF-8" standalone="no"?> +<!-- Created with Inkscape (http://www.inkscape.org/) --> + +<svg + width="48" + height="48" + viewBox="0 0 12.7 12.7" + version="1.1" + id="svg12" + inkscape:version="1.2 (dc2aedaf03, 2022-05-15)" + sodipodi:docname="icon.svg" + xml:space="preserve" + xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape" + xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd" + xmlns="http://www.w3.org/2000/svg" + xmlns:svg="http://www.w3.org/2000/svg"><sodipodi:namedview + id="namedview14" + pagecolor="#505050" + bordercolor="#eeeeee" + borderopacity="1" + inkscape:showpageshadow="0" + inkscape:pageopacity="0" + inkscape:pagecheckerboard="0" + inkscape:deskcolor="#505050" + inkscape:document-units="mm" + showgrid="false" + inkscape:zoom="11.313709" + inkscape:cx="29.168155" + inkscape:cy="21.655145" + inkscape:window-width="1920" + inkscape:window-height="1005" + inkscape:window-x="0" + inkscape:window-y="0" + inkscape:window-maximized="1" + inkscape:current-layer="layer1" + showguides="false" /><defs + id="defs9" /><g + inkscape:label="Layer 1" + inkscape:groupmode="layer" + id="layer1"><g + id="g2355" + transform="matrix(0.91804629,1.019921,-0.99884202,0.94043439,6.7377364,-6.9958554)"><g + id="g2582" + transform="matrix(0.61546137,-0.63649361,0.63617398,0.58694288,-1.8558291,6.9648282)"><path + style="fill:#2b1100;stroke:none;stroke-width:0.264583px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" + d="M 7.8446378,8.6920138 9.7349272,8.006514 11.707549,6.9120432 11.843408,6.6855273 11.636088,6.5130031 6.6632938,7.4475905 Z" + id="path1537" + sodipodi:nodetypes="ccccccc" /><g + id="g1482"><ellipse + style="opacity:1;fill:#000000;fill-opacity:1;stroke:none;stroke-width:0.030263;stroke-dasharray:none;stop-color:#000000" + id="path1266-3-6" + cx="8.3380928" + cy="8.7987413" + rx="0.72943509" + ry="1.2260661" + transform="matrix(1,0,-0.18171274,0.98335166,0,0)" /><ellipse + style="opacity:1;fill:#000000;fill-opacity:1;stroke:none;stroke-width:0.030263;stroke-dasharray:none;stop-color:#000000" + id="path1266-3" + cx="8.672637" + cy="8.9571257" + rx="0.72943509" + ry="1.2260661" + transform="matrix(1,0,-0.18171274,0.98335166,0,0)" /><ellipse + style="opacity:1;fill:#666666;stroke:none;stroke-width:0.0192557;stroke-dasharray:none;stop-color:#000000" + id="path1266" + cx="8.7366724" + cy="8.9439192" + rx="0.46412322" + ry="0.78011847" + transform="matrix(1,0,-0.18171274,0.98335166,0,0)" /></g><g + id="g1482-2" + transform="matrix(0.53446691,-0.04360994,0.04360994,0.53446691,7.1804071,2.9320907)"><ellipse + style="opacity:1;fill:#000000;fill-opacity:1;stroke:none;stroke-width:0.030263;stroke-dasharray:none;stop-color:#000000" + id="path1266-3-6-7" + cx="8.3380928" + cy="8.7987413" + rx="0.72943509" + ry="1.2260661" + transform="matrix(1,0,-0.18171274,0.98335166,0,0)" /><ellipse + style="opacity:1;fill:#000000;fill-opacity:1;stroke:none;stroke-width:0.030263;stroke-dasharray:none;stop-color:#000000" + id="path1266-3-0" + cx="8.672637" + cy="8.9571257" + rx="0.72943509" + ry="1.2260661" + transform="matrix(1,0,-0.18171274,0.98335166,0,0)" /><ellipse + style="opacity:1;fill:#666666;stroke:none;stroke-width:0.0192557;stroke-dasharray:none;stop-color:#000000" + id="path1266-9" + cx="8.7366724" + cy="8.9439192" + rx="0.46412322" + ry="0.78011847" + transform="matrix(1,0,-0.18171274,0.98335166,0,0)" /></g><path + style="opacity:1;fill:#ff0000" + d="m 1.6793011,6.7156723 c 0,0 0.3177174,-0.2906969 0.9140617,-0.4926469 1.149243,-0.3892598 2.4775849,-0.6064402 2.4775849,-0.6064402 0,0 0.7743494,-1.1514973 0.8581033,-1.2611017 0.093078,-0.040247 0.2475159,-0.162861 0.7825183,-0.1980318 L 8.1167726,4.094834 c 0,0 0.5854591,0.024663 0.855628,0.01889 0.2456737,0.035511 1.9753494,0.1325717 1.9753494,0.1325717 0.126721,0.058449 0.358642,0.3530208 0.593064,0.6842311 0.211791,0.2992349 0.427359,0.6207368 0.538132,0.9618418 l -0.09787,0.507183 c 0,0 -0.03144,0.3994155 -0.251952,0.5214519 0,0 0.03848,-0.1807453 0.02625,-0.1865008 -0.04607,-0.063333 -0.241435,0.00564 -0.42402,0.1280836 l -0.233764,0.4744478 -0.322527,0.1542192 -0.03342,0.079625 c 0,0 -0.553217,0.2594952 -0.8304199,0.3828551 -0.2778259,0.1454976 -1.8355055,0.7237729 -1.8355055,0.7237729 0,0 0.054761,-0.2437003 -0.020319,-0.6892414 C 7.9751278,7.6853338 7.904724,7.6899834 7.7898714,7.5605763 7.6130522,7.5151007 7.6166514,7.4989813 7.2289203,7.6028733 6.9352325,7.701357 6.815883,7.8193039 6.7471974,7.8748407 6.6676054,7.9737701 6.5335808,8.1428416 6.444312,8.3335706 6.2762497,8.692648 6.1658293,9.1049462 6.1658293,9.1049462 6.0719796,9.1917106 5.7580414,9.2107728 5.4577127,9.2481915 5.2646052,9.2424647 4.1430664,8.9400389 4.1430664,8.9400389 L 1.9680034,7.7366812 Z" + id="path215" + sodipodi:nodetypes="ccccccccsccccccccccccccsccccc" /><path + style="fill:#00ffff;stroke:none;stroke-width:0.0269875;stroke-linecap:butt;stroke-linejoin:miter;stroke-dasharray:none;stroke-opacity:1" + d="m 5.2170041,5.4772501 c -0.032036,0.024234 0.072186,0.037374 0.072186,0.037374 L 8.396629,5.8703478 c 0,0 0.1032609,0.014243 0.2167412,-0.036999 C 8.694435,5.7802523 8.709779,5.7165541 8.709779,5.7165541 8.7784888,5.3652764 8.9315902,4.6965787 8.9066371,4.5556902 8.9244951,4.3494912 7.7790753,4.2625488 7.3050775,4.2355251 6.8310796,4.2085011 6.0599217,4.2798231 5.9535875,4.3753143 Z" + id="path991" + sodipodi:nodetypes="ccccccscc" /><path + style="opacity:1;fill:#f9f9f9;stroke:none;stroke-width:0.264583px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" + d="m 1.6724805,7.9477631 c 0,0 0.4057261,0.213695 0.5742953,0.2799417 0.2795746,0.089547 1.5015504,0.4430406 1.6370133,0.4794593 0.1480695,0.040753 1.2843597,0.3028603 1.502017,0.3092193 0.2176574,0.00636 0.8416384,-0.1185482 0.8416384,-0.1185482 L 6.3843746,8.4744811 c 0,0 -0.6404257,0.1739944 -0.8479998,0.1676334 C 5.3288006,8.6357544 4.2053624,8.3920796 4.1033871,8.3640003 3.9198169,8.3050712 2.5772727,7.8798022 2.5772727,7.8798022 c 0,0 -0.6500039,-0.1813305 -0.6857419,-0.2183323 -0.012409,-0.027689 0.014248,-0.084786 0.014248,-0.084786 0,0 -0.1796452,0.07146 -0.1977973,0.085352 -0.024997,0.021449 -0.061778,0.080706 -0.073263,0.1110017 -1.762e-4,0.059261 0.037762,0.1747256 0.037762,0.1747255 z" + id="path1571" + sodipodi:nodetypes="cccsccsccccccc" /><path + style="fill:#f9f9f9;stroke:none;stroke-width:0.264583px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" + d="m 11.881503,6.751299 c 0,0 0.168045,-0.051677 0.269607,-0.1283385 0.02541,-0.031872 0.022,-0.1303578 0.01311,-0.158809 -0.03134,-0.034961 -0.179553,-0.080683 -0.179553,-0.080683 l -0.022,0.1339263 c -0.01281,0.051058 -0.08117,0.2339042 -0.08117,0.2339042 z" + id="path1711" + sodipodi:nodetypes="ccccccc" /><path + style="fill:#00ffff;stroke:none;stroke-width:0.264583px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" + d="M 8.8397451,5.9005251 C 8.8062191,5.8506731 9.018576,4.6104521 9.1571362,4.5433786 9.2956964,4.4763056 10.790622,4.3984947 10.940027,4.5016569 c 0.149405,0.1031621 0.58263,0.8517712 0.560054,0.9432753 -0.02258,0.091504 -2.6102659,0.477233 -2.6603359,0.4555929 z" + id="path1713" + sodipodi:nodetypes="csscc" /><path + style="opacity:1;fill:#999999;stroke:none;stroke-width:0.264583px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" + d="m 1.6686261,6.7122063 c -0.027033,0.049278 0.00971,0.4474938 0.1010088,0.5713854 0.091296,0.1238917 1.1193243,0.5101368 1.2845769,0.5456182 0.1652527,0.035482 2.0861946,0.4227248 2.2456336,0.3833746 0.159439,-0.03935 0.1692166,-0.2965293 0.1692166,-0.403987 0,-0.1074578 0.012975,-0.3106562 -0.1897377,-0.3885781 C 5.0766114,7.3420974 3.4206061,7.11768 3.3201072,7.130366 3.2196084,7.1430527 3.1717567,7.2834211 3.1717567,7.2834211 L 2.8212528,7.2074682 c 0,0 -0.068139,-0.1837381 -0.1243904,-0.2176373 C 2.6406115,6.9559317 1.6949493,6.6615658 1.6686261,6.7122063 Z" + id="path1715" + sodipodi:nodetypes="cssssssccsc" /><path + style="fill:#333333;stroke:none;stroke-width:0.264583px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" + d="M 2.3412966,7.4363582 2.8625898,7.6262592 2.8607641,7.5646398 2.3397838,7.3758697 Z" + id="path1717" /><path + style="fill:#333333;stroke:none;stroke-width:0.264583px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" + d="M 2.3512177,7.338614 2.860323,7.528515 2.8484446,7.4639146 2.352777,7.2789483 Z" + id="path1717-3" + sodipodi:nodetypes="ccccc" /><path + style="fill:#333333;stroke:none;stroke-width:0.264583px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" + d="M 2.3505641,7.2493669 2.8421551,7.424954 2.8207549,7.3595962 2.3464685,7.1881837 Z" + id="path1717-6" + sodipodi:nodetypes="ccccc" /><path + style="fill:#333333;stroke:none;stroke-width:0.264583px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" + d="M 2.3477005,7.156058 2.8203138,7.3234714 2.7989169,7.2492185 2.3353086,7.0810409 Z" + id="path1717-3-0" + sodipodi:nodetypes="ccccc" /><path + style="fill:#333333;stroke:none;stroke-width:0.264583px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" + d="M 2.3275896,7.0510161 2.7378866,7.200189 2.7017376,7.1214037 2.3138811,6.98722 Z" + id="path1790" + sodipodi:nodetypes="ccccc" /><path + style="fill:#333333;stroke:none;stroke-width:0.264583px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" + d="m 2.2870315,6.8925259 0.021131,0.074939 0.382772,0.1313778 C 2.6081351,6.9945736 2.4462478,6.9444643 2.2870315,6.8925259 Z" + id="path1792" + sodipodi:nodetypes="cccc" /><path + style="fill:#ffffff;stroke:none;stroke-width:0.284693px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" + d="m 1.7750972,6.8257544 c 0,0 -0.056726,0.3485276 0.016905,0.4141901 0.073631,0.065662 0.4375705,0.1795598 0.4853653,0.1386119 0.047795,-0.040948 8.04e-5,-0.385499 -0.054299,-0.4462441 C 2.1686897,6.8715673 1.8343248,6.7699549 1.7750972,6.8257544 Z" + id="path1794" /><path + style="fill:#ffffff;stroke:none;stroke-width:0.280763px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" + d="m 4.4626337,7.4216451 c -0.085319,0.087047 -0.00946,0.4634482 0.045638,0.5071091 0.055098,0.043661 0.6431375,0.1723766 0.7107567,0.1012747 0.067619,-0.071102 0.02007,-0.4149322 -0.043643,-0.4883863 C 5.1116721,7.468188 4.5370195,7.3777087 4.4626337,7.4216451 Z" + id="path1796" /><path + style="fill:#333333;stroke:none;stroke-width:0.264583px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" + d="M 3.3304136,7.7598592 4.386585,7.9496247 4.3489771,7.8774604 3.3105463,7.6922923 Z" + id="path1798" /><path + style="fill:#333333;stroke:none;stroke-width:0.264583px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" + d="m 3.3058142,7.581225 0.00198,0.066978 1.0209725,0.1884979 -0.030352,-0.069747 z" + id="path1800" + sodipodi:nodetypes="ccccc" /><path + style="fill:#333333;stroke:none;stroke-width:0.264583px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" + d="m 3.2985572,7.4924207 0.00285,0.061813 0.9689086,0.1670145 -0.016182,-0.066872 z" + id="path1802" /><path + style="fill:#333333;stroke:none;stroke-width:0.264583px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" + d="m 3.3016433,7.3875288 0.00146,0.065372 0.944712,0.1634244 -0.00857,-0.079127 z" + id="path1804" /><path + style="fill:#333333;stroke:none;stroke-width:0.264583px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" + d="m 3.3484745,7.2901628 -0.039855,0.060815 0.9288535,0.1615644 0.00677,-0.077175 z" + id="path1806" + sodipodi:nodetypes="ccccc" /><path + style="fill:#333333;stroke:none;stroke-width:0.264583px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" + d="m 3.3648795,7.2679357 c 0,0 0.040296,-0.046604 0.087686,-0.055869 l 0.8217251,0.1118989 -0.011187,0.077862 z" + id="path1808" + sodipodi:nodetypes="ccccc" /><path + style="fill:#333333;stroke:none;stroke-width:0.264583px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" + d="m 2.9707895,7.6742207 0.030687,0.088502 0.135015,0.028198 0.00581,-0.062412 z" + id="path1810" /><path + style="fill:#333333;stroke:none;stroke-width:0.264583px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" + d="m 2.9447262,7.5745318 0.017148,0.073099 0.1766035,0.045978 0.011298,-0.06685 z" + id="path1812" /><path + style="fill:#333333;stroke:none;stroke-width:0.264583px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" + d="m 2.9218448,7.4777636 0.014621,0.064662 0.2138113,0.054541 2.382e-4,-0.068689 z" + id="path1814" /><path + style="fill:#333333;stroke:none;stroke-width:0.264583px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" + d="m 2.9005535,7.365861 0.015081,0.080423 0.2358218,0.051363 0.00887,-0.068393 z" + id="path1816" /><path + style="fill:#333333;stroke:none;stroke-width:0.264583px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" + d="m 2.8886062,7.2539015 0.012914,0.088634 0.2566856,0.06281 0.0081,-0.090248 z" + id="path1818" /><path + style="fill:#999999;stroke:none;stroke-width:0.264583px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" + d="m 2.3945851,8.1214997 0.03233,0.4260111 c 0,0 0.4031754,0.1667788 0.5031548,0.1996104 0.099979,0.032831 0.7856493,0.1923843 0.7856493,0.1923843 l -0.00369,-0.4310996 c 0,0 -0.6549766,-0.1140655 -0.7702664,-0.1595953 C 2.8569882,8.3153321 2.3945858,8.1214997 2.3945851,8.1214997 Z" + id="path1854" + sodipodi:nodetypes="ccsccsc" /><path + style="fill:#1a1a1a;stroke:none;stroke-width:0.264583px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" + d="m 2.2037278,8.5415849 c 0,0 -0.1896868,-0.6024502 -0.1689952,-0.6991277 0.031298,-0.043065 0.1297596,-0.098844 0.1297596,-0.098844 l 0.2071374,0.077509 0.069085,0.7135511 c 0,0 -0.060219,0.052667 -0.1238306,0.044235 -0.063612,-0.00843 -0.1131567,-0.037323 -0.1131562,-0.037323 z" + id="path1820" + sodipodi:nodetypes="ccccccc" /><path + style="fill:#1a1a1a;stroke:none;stroke-width:0.277277px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" + d="m 3.7419399,8.9877574 c 0,0 -0.2135569,-0.5742229 -0.189601,-0.6659321 0.036236,-0.040852 0.1441756,-0.091031 0.1441756,-0.091031 l 0.2398154,0.073526 0.079984,0.676881 c 0,0 -0.069719,0.04996 -0.1433662,0.041962 -0.073647,-0.008 -0.1310083,-0.035405 -0.1310078,-0.035406 z" + id="path1820-6" + sodipodi:nodetypes="cccccccc" /></g></g></g></svg> diff --git a/frontends/http/main.rkt b/frontends/http/main.rkt new file mode 100644 index 0000000..2ddec2b --- /dev/null +++ b/frontends/http/main.rkt @@ -0,0 +1,265 @@ +#lang racket/base + +(require + racket/class + racket/list + racket/match + racket/function + racket/string + racket/include + racket/port + + "../../common.rkt" + "../../config.rkt" + "../../log.rkt" + (prefix-in ev: "../../evaluator.rkt") + "../../interface.rkt" + + xml + net/base64 + file/sha1 + net/url-structs + web-server/web-server + web-server/servlet-dispatch + web-server/templates + web-server/http/request-structs + web-server/http/response-structs + + (for-syntax racket/base + racket/port + syntax/location)) + +(provide r16-make-frontend) + +(define-for-syntax use-reincludes? + (environment-variables-ref + (current-environment-variables) + #"R16_REINCLUDE_TEMPLATES")) + +(define-syntax (syntax-relative-path stx) + (syntax-case stx () + [(_ path) + (quasisyntax/loc stx + (build-path + #,(syntax-source-directory stx) + path))])) + +(define-syntax (include-bytes stx) + (syntax-case stx () + [(_ path) + (if use-reincludes? + (quasisyntax/loc stx + (with-input-from-file (syntax-relative-path path) port->bytes)) + (quasisyntax/loc stx + (include/reader + path + (lambda (_ port) + (if (port-closed? port) + eof + (datum->syntax + #'#,stx + (port->bytes port #:close? #t)))))))])) + +(define-syntax (maybe-define-namespace-anchor stx) + (syntax-case stx () + [(_ name) + (if use-reincludes? + (quasisyntax/loc stx + (define-namespace-anchor name)) + #'(begin))])) + +(maybe-define-namespace-anchor anchor) + +(define-syntax (include-template* stx) + (syntax-case stx () + [(_ path args ...) + (if use-reincludes? + (quasisyntax/loc stx + (let ([namespace (namespace-anchor->namespace anchor)]) + (namespace-set-variable-value! + 'args args + #f namespace) ... + (eval #'(include-template path) + namespace))) + (quasisyntax/loc stx + (include-template path)))])) + +(struct image (bytes)) + +(define (simple-response code msg) + (define title msg) + (define navbar? #t) + (define body (include-template* "simple.html" msg)) + (response/full + code #f + (current-seconds) TEXT/HTML-MIME-TYPE + null + (list + (string->bytes/utf-8 + (include-template* "base.html" title navbar? body))))) + +(define (format-for-html str) + (include-template* "raw.html" str)) + +(define (response/html #:title title #:navbar? [navbar? #f] . body) + (response/full + 200 #f + (current-seconds) TEXT/HTML-MIME-TYPE + null + (list (string->bytes/utf-8 (include-template* "base.html" title navbar? body))))) + +(define http-frontend + (class* object% [r16-frontend<%>] + (init-field port) + + (define trick-modify-mutex (make-semaphore 1)) + (define current-password-hash (make-parameter #f)) + (define/public (response? v) (image? v)) + (define/public (get-enrich-context) + (define (enrich-context base _trick _args _parent-ctx) + (define (make-image png-bytes) + (image png-bytes)) + `(((make-image . ,make-image) + ,@(car base)) + ,@(cdr base))) + enrich-context) + (define/public (can-modify? trick) + (equal? (trick-author trick) (current-password-hash))) + (define/public (start) + (log-r16-debug "Starting server on port ~a" port) + (parameterize ([current-frontend this]) + (serve + #:dispatch (dispatch/servlet handle-request) + #:port port) + (do-not-return))) + + (define (handle-request req) + (define req-uri (request-uri req)) + (define path (takef (url-path req-uri) (compose1 non-empty-string? path/param-path))) + (match* [(request-method req) path] + [[#"POST" (list (path/param "tricks" _) + (path/param "submit" _))] + (define bindings (request-bindings/raw req)) + (match* [(bindings-assq #"name" bindings) + (bindings-assq #"code" bindings) + (bindings-assq #"password" bindings)] + [[(binding:form _ (and name-bytes + (pregexp "^[a-zA-Z_\\-0-9]+$") + (app bytes->string/utf-8 name))) + (binding:form _ (app bytes->string/utf-8 code)) + (binding:form _ password)] + (call-with-semaphore + ;; protect against concurrent modification of the body + trick-modify-mutex + (thunk + ;; hash the password, using the sha256sum of the trick name as salt; + ;; this is not completely secure because the salt *should* + ;; be generated randomly so as not to be predictable, + ;; but the risk factor is estimated to be low; + ;; this hash is then used as the "author" field of the trick + ;; and checked against for modification perms + (define salt (sha256-bytes name-bytes)) + (define hashed-pass (bytes->hex-string (sha256-bytes (bytes-append salt password)))) + (parameterize ([current-password-hash hashed-pass]) + (cond + [(zero? (string-length code)) + (match (send (current-backend) delete name) + [(cons 'ok msg) (simple-response 200 (string->bytes/utf-8 msg))] + [(list* 'err msg _) (simple-response 400 (string->bytes/utf-8 msg))])] + [else + (match (send (current-backend) register name code hashed-pass (number->string (current-seconds))) + [(cons 'ok _) + (response/full + 303 #"See Other" + (current-seconds) TEXT/HTML-MIME-TYPE + (list (make-header #"Location" (string->bytes/utf-8 (format "/tricks/~a.rkt" name)))) + (list #"Redirecting..."))] + [(list* 'err msg _) + (simple-response 400 (string->bytes/utf-8 msg))])]))))] + [[_ _ _] + (simple-response 400 #"400 Bad Request")])] + + [[#"GET" (list (path/param "tricks" _))] + (response/html + #:title "Tricks" + #:navbar? #t + (include-template* "tricks.html"))] + + [[#"GET" (list (path/param "tricks" _) + (path/param (pregexp "^([a-zA-Z_\\-0-9]+)\\.rkt$" (list _ trick-name)) _))] + (define trick-v (send (current-backend) lookup trick-name)) + (response/full + 200 #"OK" + (current-seconds) #"text/plain; charset=utf-8" + null + (list (string->bytes/utf-8 (trick-body trick-v))))] + + [[#"GET" (list (path/param "tricks" _) + (path/param (pregexp "^[a-zA-Z_\\-0-9]+$" (list trick-name)) _))] + (define args (assoc 'args (url-query req-uri))) + (define resp (send (current-backend) call trick-name (if args (cdr args) ""))) + (match resp + [(cons 'ok res) + (define stderr (ev:run-result-stderr res)) + (define stdout (ev:run-result-stdout res)) + (define results (ev:run-result-results res)) + (match* [stderr stdout results] + [[#f "" (list (image raw-bytes))] + (response/full + 200 #f + (current-seconds) #"image/png" + null + (list raw-bytes))] + [[_ _ _] + (response/full + 200 #f + (current-seconds) TEXT/HTML-MIME-TYPE + null + (list (string->bytes/utf-8 + (include-template* + "result.html" + trick-name + stderr + stdout + results))))])] + [(list 'err msg 'no-such-trick) + (simple-response 404 (string->bytes/utf-8 msg))] + [(list* 'err msg _) + (simple-response 400 (string->bytes/utf-8 msg))])] + + [[#"GET" (list (path/param (or "style.css" "error.css") _))] + (response/full + 200 #f + (current-seconds) #"text/css" + null + (list (include-bytes "style.css")))] + + [[#"GET" (list (path/param "favicon.ico" _))] + (response/full + 200 #f + (current-seconds) #"image/x-icon" + null + (list (include-bytes "favicon.ico")))] + + [[#"GET" (list (path/param "icon.svg" _))] + (response/full + 200 #f + (current-seconds) #"image/svg+xml" + null + (list (include-bytes "icon.svg")))] + + [[#"GET" (list)] + (response/html + #:title "r16" + #:navbar? #t + (include-template* "home.html"))] + + [[#"GET" _] + (simple-response 404 #"404 Not Found")])) + + (super-new))) + +(define (r16-make-frontend raw-config) + (define port (check-config exact-positive-integer? (hash-ref raw-config 'port 8080))) + (new http-frontend + [port port])) diff --git a/frontends/http/raw.html b/frontends/http/raw.html new file mode 100644 index 0000000..0b85c25 --- /dev/null +++ b/frontends/http/raw.html @@ -0,0 +1,23 @@ +@; Inputs: 'str +@(define url-regex #px"(([^:/?#]+):)(//([^/?#]*))([^?#]*)(\\?([^#]*))?(#(.*))?") +<div> + @in[line (in-list (string-split str "\n"))]{ + @(define urls (regexp-match-positions* url-regex line #:match-select car)) + <div class="mb-6 last:mb-0"> + @(cond + [(null? urls) (list line)] + [else + (define positions + (append* + (for/list ([url-pos (in-list urls)]) + (list (car url-pos) (cdr url-pos))))) + (for/list ([start (in-list `(0 ,@positions))] + [end (in-list `(,@positions ,(string-length line)))] + [is-link? (in-cycle (in-list '(#f #t)))]) + (define v (substring line start end)) + (if is-link? + (xexpr->string `(a ((href ,v) (class "text-blue-500 hover:text-blue-700")) ,v)) + v))]) + </div> + } +</div> diff --git a/frontends/http/result.html b/frontends/http/result.html new file mode 100644 index 0000000..04079a4 --- /dev/null +++ b/frontends/http/result.html @@ -0,0 +1,40 @@ +@; Inputs: 'trick-name 'stderr 'stdout 'results +@; TODO: limits on output length +@(define trick-name-esc (xexpr->string trick-name)) +@(local-require racket/port) +@(define description + (with-output-to-string + (lambda () + (when stderr + (display stderr)) + (unless (zero? (string-length stdout)) + (display stdout)) + (for ([r (in-list results)]) + (unless (image? r) + (displayln r)))))) +@(define head + @list{ + <title>@|trick-name-esc|</title> + <meta name="viewport" content="width=device-width, initial-scale=1"/> + <meta property="og:title" content="@(xml-attribute-encode trick-name)"> + <meta property="og:type" content="website"> + <meta property="og:description" content="@(xml-attribute-encode description)"> + @(when stderr + @list{<meta name="theme-color" content="#FF0000">}) + }) +@(define body + (list + (when stderr @list{<pre style="color:red;">@(xexpr->string stderr)</pre>}) + (unless (zero? (string-length stdout)) @list{<pre>@(xexpr->string stdout)</pre>}) + (for/list ([r (in-list results)]) + (cond + [(image? r) @list{<img src="data:image/png;base64,@(base64-encode (image-bytes r))"></img>}] + [else @list{<pre>@(xexpr->string r)</pre>}])))) + +<!DOCTYPE html> +<head> +@|head| +</head> +<body> +@|body| +</body> diff --git a/frontends/http/simple.html b/frontends/http/simple.html new file mode 100644 index 0000000..7647576 --- /dev/null +++ b/frontends/http/simple.html @@ -0,0 +1,4 @@ +@; Inputs: msg +<div class="p-12"> + <span class="text-2xl font-bold mb-2">@|msg|</span> +</div> diff --git a/frontends/http/style-in.css b/frontends/http/style-in.css new file mode 100644 index 0000000..e094896 --- /dev/null +++ b/frontends/http/style-in.css @@ -0,0 +1,20 @@ +@tailwind base; +@tailwind components; +@tailwind utilities; + +.toggled .togglable { display: none; } +.togglable-inverse { display: none; } +.toggled .togglable-inverse { display: inline; } + +.trick > .trick-info { + max-width: 0; + max-height: 0; + overflow: hidden; + opacity: 0; +} + +.trick:hover > .trick-info { + max-width: 2000px; + max-height: 300px; + opacity: 1; +} diff --git a/frontends/http/style.css b/frontends/http/style.css new file mode 100644 index 0000000..d974471 --- /dev/null +++ b/frontends/http/style.css @@ -0,0 +1 @@ +/*! tailwindcss v3.0.24 | MIT License | https://tailwindcss.com*/*,:after,:before{box-sizing:border-box;border:0 solid #e5e7eb}:after,:before{--tw-content:""}html{line-height:1.5;-webkit-text-size-adjust:100%;-moz-tab-size:4;-o-tab-size:4;tab-size:4;font-family:ui-sans-serif,system-ui,-apple-system,BlinkMacSystemFont,Segoe UI,Roboto,Helvetica Neue,Arial,Noto Sans,sans-serif,Apple Color Emoji,Segoe UI Emoji,Segoe UI Symbol,Noto Color Emoji}body{margin:0;line-height:inherit}hr{height:0;color:inherit;border-top-width:1px}abbr:where([title]){-webkit-text-decoration:underline dotted;text-decoration:underline dotted}h1,h2,h3,h4,h5,h6{font-size:inherit;font-weight:inherit}a{color:inherit;text-decoration:inherit}b,strong{font-weight:bolder}code,kbd,pre,samp{font-family:ui-monospace,SFMono-Regular,Menlo,Monaco,Consolas,Liberation Mono,Courier New,monospace;font-size:1em}small{font-size:80%}sub,sup{font-size:75%;line-height:0;position:relative;vertical-align:initial}sub{bottom:-.25em}sup{top:-.5em}table{text-indent:0;border-color:inherit;border-collapse:collapse}button,input,optgroup,select,textarea{font-family:inherit;font-size:100%;line-height:inherit;color:inherit;margin:0;padding:0}button,select{text-transform:none}[type=button],[type=reset],[type=submit],button{-webkit-appearance:button;background-color:initial;background-image:none}:-moz-focusring{outline:auto}:-moz-ui-invalid{box-shadow:none}progress{vertical-align:initial}::-webkit-inner-spin-button,::-webkit-outer-spin-button{height:auto}[type=search]{-webkit-appearance:textfield;outline-offset:-2px}::-webkit-search-decoration{-webkit-appearance:none}::-webkit-file-upload-button{-webkit-appearance:button;font:inherit}summary{display:list-item}blockquote,dd,dl,figure,h1,h2,h3,h4,h5,h6,hr,p,pre{margin:0}fieldset{margin:0}fieldset,legend{padding:0}menu,ol,ul{list-style:none;margin:0;padding:0}textarea{resize:vertical}input::-moz-placeholder,textarea::-moz-placeholder{opacity:1;color:#9ca3af}input:-ms-input-placeholder,textarea:-ms-input-placeholder{opacity:1;color:#9ca3af}input::placeholder,textarea::placeholder{opacity:1;color:#9ca3af}[role=button],button{cursor:pointer}:disabled{cursor:default}audio,canvas,embed,iframe,img,object,svg,video{display:block;vertical-align:middle}img,video{max-width:100%;height:auto}[hidden]{display:none}*,:after,:before{--tw-translate-x:0;--tw-translate-y:0;--tw-rotate:0;--tw-skew-x:0;--tw-skew-y:0;--tw-scale-x:1;--tw-scale-y:1;--tw-pan-x: ;--tw-pan-y: ;--tw-pinch-zoom: ;--tw-scroll-snap-strictness:proximity;--tw-ordinal: ;--tw-slashed-zero: ;--tw-numeric-figure: ;--tw-numeric-spacing: ;--tw-numeric-fraction: ;--tw-ring-inset: ;--tw-ring-offset-width:0px;--tw-ring-offset-color:#fff;--tw-ring-color:#3b82f680;--tw-ring-offset-shadow:0 0 #0000;--tw-ring-shadow:0 0 #0000;--tw-shadow:0 0 #0000;--tw-shadow-colored:0 0 #0000;--tw-blur: ;--tw-brightness: ;--tw-contrast: ;--tw-grayscale: ;--tw-hue-rotate: ;--tw-invert: ;--tw-saturate: ;--tw-sepia: ;--tw-drop-shadow: ;--tw-backdrop-blur: ;--tw-backdrop-brightness: ;--tw-backdrop-contrast: ;--tw-backdrop-grayscale: ;--tw-backdrop-hue-rotate: ;--tw-backdrop-invert: ;--tw-backdrop-opacity: ;--tw-backdrop-saturate: ;--tw-backdrop-sepia: }.absolute{position:absolute}.-m-3{margin:-.75rem}.-m-6{margin:-1.5rem}.mx-auto{margin-left:auto}.mr-auto,.mx-auto{margin-right:auto}.ml-auto{margin-left:auto}.mb-6{margin-bottom:1.5rem}.mb-3{margin-bottom:.75rem}.mb-2{margin-bottom:.5rem}.mr-2{margin-right:.5rem}.mb-0{margin-bottom:0}.mb-1{margin-bottom:.25rem}.mb-4{margin-bottom:1rem}.mb-5{margin-bottom:1.25rem}.block{display:block}.flex{display:flex}.inline-flex{display:inline-flex}.hidden{display:none}.h-1{height:.25rem}.h-5{height:1.25rem}.h-2{height:.5rem}.h-12{height:3rem}.h-4{height:1rem}.h-8{height:2rem}.min-h-\[3\.25rem\]{min-height:3.25rem}.w-full{width:100%}.w-12{width:3rem}.w-4{width:1rem}.w-8{width:2rem}.shrink{flex-shrink:1}.grow{flex-grow:1}.basis-0{flex-basis:0px}.cursor-pointer{cursor:pointer}.flex-col{flex-direction:column}.flex-wrap{flex-wrap:wrap}.content-center{align-content:center}.items-center{align-items:center}.items-stretch{align-items:stretch}.justify-start{justify-content:flex-start}.justify-end{justify-content:flex-end}.justify-center{justify-content:center}.rounded{border-radius:.25rem}.rounded-lg{border-radius:.5rem}.rounded-t-lg{border-top-left-radius:.5rem;border-top-right-radius:.5rem}.border{border-width:1px}.border-neutral-100{--tw-border-opacity:1;border-color:rgb(245 245 245/var(--tw-border-opacity))}.bg-neutral-50{--tw-bg-opacity:1;background-color:rgb(250 250 250/var(--tw-bg-opacity))}.bg-neutral-700{--tw-bg-opacity:1;background-color:rgb(64 64 64/var(--tw-bg-opacity))}.bg-white{--tw-bg-opacity:1;background-color:rgb(255 255 255/var(--tw-bg-opacity))}.bg-green-400{--tw-bg-opacity:1;background-color:rgb(74 222 128/var(--tw-bg-opacity))}.bg-neutral-800{--tw-bg-opacity:1;background-color:rgb(38 38 38/var(--tw-bg-opacity))}.bg-gray-300{--tw-bg-opacity:1;background-color:rgb(209 213 219/var(--tw-bg-opacity))}.bg-gray-800{--tw-bg-opacity:1;background-color:rgb(31 41 55/var(--tw-bg-opacity))}.bg-neutral-900{--tw-bg-opacity:1;background-color:rgb(23 23 23/var(--tw-bg-opacity))}.p-12{padding:3rem}.p-3{padding:.75rem}.p-2{padding:.5rem}.p-6{padding:1.5rem}.py-2{padding-top:.5rem;padding-bottom:.5rem}.px-3{padding-left:.75rem;padding-right:.75rem}.px-4{padding-left:1rem;padding-right:1rem}.px-2{padding-left:.5rem;padding-right:.5rem}.py-1{padding-top:.25rem;padding-bottom:.25rem}.px-6{padding-left:1.5rem;padding-right:1.5rem}.py-4{padding-top:1rem;padding-bottom:1rem}.text-center{text-align:center}.font-mono{font-family:ui-monospace,SFMono-Regular,Menlo,Monaco,Consolas,Liberation Mono,Courier New,monospace}.text-\[16px\]{font-size:16px}.text-3xl{font-size:1.875rem;line-height:2.25rem}.text-xl{font-size:1.25rem;line-height:1.75rem}.text-2xl{font-size:1.5rem;line-height:2rem}.font-bold{font-weight:700}.text-slate-700{--tw-text-opacity:1;color:rgb(51 65 85/var(--tw-text-opacity))}.text-white{--tw-text-opacity:1;color:rgb(255 255 255/var(--tw-text-opacity))}.text-blue-500{--tw-text-opacity:1;color:rgb(59 130 246/var(--tw-text-opacity))}.opacity-0{opacity:0}.opacity-20{opacity:.2}.shadow-inner{--tw-shadow:inset 0 2px 4px 0 #0000000d;--tw-shadow-colored:inset 0 2px 4px 0 var(--tw-shadow-color)}.shadow,.shadow-inner{box-shadow:var(--tw-ring-offset-shadow,0 0 #0000),var(--tw-ring-shadow,0 0 #0000),var(--tw-shadow)}.shadow{--tw-shadow:0 1px 3px 0 #0000001a,0 1px 2px -1px #0000001a;--tw-shadow-colored:0 1px 3px 0 var(--tw-shadow-color),0 1px 2px -1px var(--tw-shadow-color)}.shadow-lg{--tw-shadow:0 10px 15px -3px #0000001a,0 4px 6px -4px #0000001a;--tw-shadow-colored:0 10px 15px -3px var(--tw-shadow-color),0 4px 6px -4px var(--tw-shadow-color);box-shadow:var(--tw-ring-offset-shadow,0 0 #0000),var(--tw-ring-shadow,0 0 #0000),var(--tw-shadow)}.transition-all{transition-property:all;transition-timing-function:cubic-bezier(.4,0,.2,1);transition-duration:.15s}.duration-500{transition-duration:.5s}.ease-out{transition-timing-function:cubic-bezier(0,0,.2,1)}.\[overflow-wrap\:break-word\]{overflow-wrap:break-word}.togglable-inverse,.toggled .togglable{display:none}.toggled .togglable-inverse{display:inline}.trick>.trick-info{max-width:0;max-height:0;overflow:hidden;opacity:0}.trick:hover>.trick-info{max-width:2000px;max-height:300px;opacity:1}.last\:mb-0:last-child{margin-bottom:0}.hover\:w-full:hover{width:100%}.hover\:grow:hover{flex-grow:1}.hover\:border-neutral-300:hover{--tw-border-opacity:1;border-color:rgb(212 212 212/var(--tw-border-opacity))}.hover\:bg-neutral-800:hover{--tw-bg-opacity:1;background-color:rgb(38 38 38/var(--tw-bg-opacity))}.hover\:bg-green-500:hover{--tw-bg-opacity:1;background-color:rgb(34 197 94/var(--tw-bg-opacity))}.hover\:bg-neutral-900:hover{--tw-bg-opacity:1;background-color:rgb(23 23 23/var(--tw-bg-opacity))}.hover\:bg-green-400:hover{--tw-bg-opacity:1;background-color:rgb(74 222 128/var(--tw-bg-opacity))}.hover\:bg-green-600:hover{--tw-bg-opacity:1;background-color:rgb(22 163 74/var(--tw-bg-opacity))}.hover\:text-blue-700:hover{--tw-text-opacity:1;color:rgb(29 78 216/var(--tw-text-opacity))}@media (min-width:768px){.md\:flex-row{flex-direction:row}.md\:text-xl{font-size:1.25rem;line-height:1.75rem}.md\:text-lg{font-size:1.125rem;line-height:1.75rem}}@media (min-width:1024px){.lg\:max-w-screen-md{max-width:768px}}@media (min-width:1280px){.xl\:max-w-screen-lg{max-width:1024px}}@media (min-width:1536px){.\32xl\:max-w-screen-xl{max-width:1280px}} \ No newline at end of file diff --git a/frontends/http/tailwind.config.js b/frontends/http/tailwind.config.js new file mode 100644 index 0000000..7c10ed8 --- /dev/null +++ b/frontends/http/tailwind.config.js @@ -0,0 +1,5 @@ +module.exports = { + content: [ + "*.{html,rkt}" + ] +} diff --git a/frontends/http/tricks.html b/frontends/http/tricks.html new file mode 100644 index 0000000..02bb9e3 --- /dev/null +++ b/frontends/http/tricks.html @@ -0,0 +1,109 @@ +@; No inputs +@(define popular (send (current-backend) popular)) +<div class="p-12"> + <h1 class="text-3xl font-bold mb-6">Add trick</h1> + <form action="/tricks/submit" method="post" target="_blank" enctype="multipart/form-data"> + <div class="mb-3"> + <div class="flex flex-col md:flex-row -m-3"> + <div class="grow shrink basis-0 p-3"> + <label class="mb-2 font-bold block" for="name">Trick Name</label> + <input class="p-2 border-neutral-100 hover:border-neutral-300 border rounded w-full shadow-inner" + type="text" id="name" name="name"></input> + </div> + <div class="grow shrink basis-0 p-3"> + <label class="mb-2 font-bold block" for="password">Password</label> + <input class="p-2 border-neutral-100 hover:border-neutral-300 border rounded w-full shadow-inner" + type="password" id="password" name="password"></input> + </div> + </div> + </div> + <div class="mb-3"> + <label class="mb-2 font-bold block" for="code">Code</label> + <textarea + class="font-mono p-2 border-neutral-100 hover:border-neutral-300 border rounded w-full shadow-inner" + id="code" + name="code" + rows="5" + cols="60" + placeholder="Enter code" + spellcheck="false"></textarea> + </div> + <div> + <input class="p-2 bg-green-400 hover:bg-green-500 rounded text-white content-center px-4 py-2 cursor-pointer" + type="submit" value="Add"/> + </div> + </form> +</div> +<div class="p-12"> + <h1 class="text-3xl font-bold mb-6">Registered tricks</h1> + <script> + let lastTrick = null; + function setTrick(trick, soft) { + if (trick === null) trick = lastTrick; + + let invocations = trick ? trick.dataset.trickInvocations : "-"; + document.getElementById("trick-invocations").innerText = invocations; + + let trickSource = document.getElementById("trick-source"); + let trickName = document.getElementById("trick-name"); + let trickCall = document.getElementById("trick-call"); + if (trick) { + let name = trick.dataset.trickName; + trickSource.href = "/tricks/"+name+".rkt"; + trickCall.action = "/tricks/"+name; + trickName.innerText = name; + if (!soft) { + if (trick === lastTrick) return; + if (lastTrick) { + lastTrick.classList.remove("bg-neutral-900"); + lastTrick.classList.add("bg-neutral-700"); + } + lastTrick = trick; + lastTrick.classList.add("bg-neutral-900"); + lastTrick.classList.remove("bg-neutral-700"); + } + } else { + trickSource.href = ""; + trickCall.action = ""; + trickName.innerText = "-"; + } + } + </script> + <div class="mb-6 shadow-lg rounded-lg p-6"> + <div class="bg-neutral-800 rounded-t-lg w-[calc(100% + 3rem)] -m-6 mb-3 px-6 py-4 text-white md:text-lg font-bold"> + <span>Trick Name: </span> + <code id="trick-name">-</code> + </div> + <p class="mb-3"><span class="font-bold">Invocations</span>: <span id="trick-invocations">-</span></p> + <p class="mb-3"><a class="text-blue-500 hover:text-blue-700 cursor-pointer" id="trick-source">Trick Source</a></p> + <form id="trick-call" target="_blank" method="get"> + <div class="mb-3"> + <textarea class="font-mono p-2 border-neutral-100 hover:border-neutral-300 border rounded w-full shadow-inner" + name="args" + spellcheck="false" + rows="1" + placeholder="Enter arguments"></textarea> + </div> + <input class="p-2 bg-green-400 hover:bg-green-500 rounded text-white content-center px-4 py-2 cursor-pointer" + type="submit" value="Call"/> + </form> + </div> + <div id="trick-list" class="flex flex-wrap"> + @in[trick-pair (in-list popular)]{ + @(define name (xexpr->string (car trick-pair))) + @(define trick-v (cdr trick-pair)) + <button class="mr-2 mb-2 shadow px-3 py-2 bg-neutral-700 hover:bg-neutral-800 rounded text-white trick" + data-trick-name="@|name|" + data-trick-invocations="@(trick-invocations trick-v)" + onmouseover="setTrick(this, true)" + onmouseout="setTrick(null, true)" + onclick="setTrick(this, false)"> + <code class="card-header-title has-text-white">@|name|</code> + </button> + } + </div> + <script> + let trickList = document.getElementById("trick-list"); + if (trickList.children.length) setTrick(trickList.children[0], false); + </script> +</div> diff --git a/interface.rkt b/interface.rkt index 14c952a..42279fa 100644 --- a/interface.rkt +++ b/interface.rkt @@ -40,21 +40,34 @@ (define r16-backend<%> (interface () ;; evaluate a code snippet, returning either an error message or a run result - [evaluate (#;code string? . ->m . (result/c run-result? string?))] + [evaluate (#;code string? . ->m . + (result/c run-result? + (error/c)))] - ;; call a trick with arguments, returning either an error message or a run result - [call (#;trick string? #;args string? . ->m . (result/c run-result? string?))] + ;; call a trick with arguments, returning either an error or a run result + [call (#;trick string? #;args string? . ->m . + (result/c run-result? + (error/c (no-such-trick))))] ;; delete a trick, returning an error or success message - [delete (#;trick string? . ->m . (result/c string? string?))] + [delete (#;trick string? . ->m . + (result/c string? + (error/c (no-such-trick) + (missing-permissions))))] ;; register a trick, returning an error or success message [register (#;trick string? #;code string? - #;author string? #;timestamp string? - . ->m . (result/c string? string?))] + #;author string? #;timestamp string? . ->m . + (result/c string? + (error/c (needs-body) + (missing-permissions))))] ;; update a trick, returning an error or success message - [update (#;trick string? #;code string? . ->m . (result/c string? string?))] + [update (#;trick string? #;code string? . ->m . + (result/c string? + (error/c (no-such-trick) + (needs-body) + (missing-permissions))))] ;; look up a trick by name [lookup (#;trick string? . ->m . (or/c trick? #f))] diff --git a/result.rkt b/result.rkt index 2f4f8d0..18bc257 100644 --- a/result.rkt +++ b/result.rkt @@ -2,7 +2,8 @@ (require racket/contract (for-syntax racket/base syntax/parse)) -(provide result/c ok? err? result-case) +(provide result/c ok? err? result-case + error/c) ;; represents a fallible computation ;; (cons 'ok ok-value) on success @@ -17,6 +18,19 @@ (cons/c 'err err-ctc)) 'name)))])) +;; represents an error, a message tagged with a type +;; (cons message . case) +(define-syntax (error/c stx) + (syntax-parse stx + [(_ (tag:id others ...) ...) + (with-syntax ([name stx]) + (syntax/loc stx + (rename-contract + (cons/c string? + (or/c (list/c 'tag others ...) + ...)) + 'name)))])) + (define (ok? x) (eq? 'ok (car x))) (define (err? x) (eq? 'err (car x))) (define (result-case if-ok if-err x) -- 2.36.1
builds.sr.ht <builds@sr.ht>r16/patches/linux_buildtest.yml: SUCCESS in 2m20s [Prototype HTTP frontend][0] v4 from [eutro][1] [0]: https://lists.sr.ht/~williewillus/public-inbox/patches/32761 [1]: mailto:benedek.szilvasy@gmail.com ✓ #774291 SUCCESS r16/patches/linux_buildtest.yml https://builds.sr.ht/~williewillus/job/774291
