From ff046a6b6b7c594d7e0becf37f9e859e1dccfb17 Mon Sep 17 00:00:00 2001 From: natalie roentgen connolly Date: Sun, 29 Jun 2025 02:08:34 -0700 Subject: [PATCH] redo server routing; in theory faster under some conditions --- srv/content/comments.hy | 43 +++++++++ srv/content/router.hy | 194 ++++++++++++++++---------------------- srv/http_utils/request.hy | 28 ++++-- 3 files changed, 143 insertions(+), 122 deletions(-) create mode 100644 srv/content/comments.hy diff --git a/srv/content/comments.hy b/srv/content/comments.hy new file mode 100644 index 0000000..8cb9de1 --- /dev/null +++ b/srv/content/comments.hy @@ -0,0 +1,43 @@ +(import urllib.parse [quote-plus urlparse]) +(import os [mkdir]) +(import os.path [isdir :as dir? isfile :as file? abspath]) +(import datetime [datetime]) +(import bleach [clean]) +(import validators [domain :as domain?]) +(require hyrule.destructure [setv+]) + +(defn create-comment [request] + (setv now (datetime.now)) + + (setv url-comment-dir (quote-plus (. request (get "route") (get "parameters") (get "route")) :safe "")) + + (when (not (dir? "./www/data")) + (mkdir "./www/data")) + + (when (not (dir? f"./www/data/comments")) + (mkdir "./www/data/comments")) + + (when (not (dir? f"./www/data/comments/{url-comment-dir}")) + (mkdir f"./www/data/comments/{url-comment-dir}")) + + (setv+ {{comment "comment" name "name" site "site"} "body"} request) + + (when (.startswith site "//") + (setv site (.replace site "//" ""))) + + (setv [protocol domain path #* _] (urlparse + (if (in "://" site) + site + (+ "http://" site)))) + + (setv site-valid? (= (domain? domain) True)) + + (when (not protocol) + (setv protocol "//")) + + (with [f (open f"./www/data/comments/{url-comment-dir}/{(.strftime now "%Y-%m-%d_%H:%M:%S_%f")}" "w")] + (.write f f"
{(if (and site site-valid?) f"" "")}{(clean name)}{(if (and site site-valid?) "" "")} at {(.strftime now "%Y-%m-%d %H:%M:%S")}:
{(clean comment)}
")) + + (return (dict + :code 303 + :headers {"Location" (. request (get "headers") (get "Referer"))}))) diff --git a/srv/content/router.hy b/srv/content/router.hy index 359b525..32c198b 100644 --- a/srv/content/router.hy +++ b/srv/content/router.hy @@ -1,12 +1,12 @@ -(require hyrule.destructure [defn+ setv+]) +(require hyrule.destructure [defn+]) (require hyrule.argmove [doto]) +(require hyrule.oop [meth]) +(import hyrule.collections [assoc]) (import content.file-io [parse-html-file send-raw-file]) -(import urllib.parse [quote-plus urlparse]) -(import os [mkdir]) +(import content.comments [create-comment]) +(import re) +(import functools [lru-cache]) (import os.path [isdir :as dir? isfile :as file? abspath]) -(import datetime [datetime]) -(import bleach [clean]) -(import validators [domain :as domain?]) (defmacro unless [test #* body] `(when (not ~test) (do ~@body))) @@ -14,119 +14,87 @@ (defn error [code message] (return (dict :code code - :body (parse-html-file "./www/site/html/error.html")))) + :body (parse-html-file "./www/site/html/error.html" :code code :message message)))) -(defn+ match-request [{method "method" {path "path"} "route" :as request}] - (when (.startswith path "/assets/") - (when (!= method "GET") - (return (error 405 "method not allowed"))) +(defclass always [] + (meth __init__ [@value]) + (meth __getitem__ [_] @value)) - (setv [headers data] (send-raw-file (+ "./www/site" path))) - - (return (dict - :code 200 - :headers headers - :body data))) - - (when (.startswith path "/html/") - (when (!= method "GET") - (return (error 405 "method not allowed"))) - - (when (file? (+ "./www/site/html" path)) - (unless (= path "/html/view-thought.html") - (return (dict - :code 200 - :body (parse-html-file f"./www/site/html{path}")))) - - (return (dict - :code 200 - :body (parse-html-file "./www/site/html/html/view-thought.html" #** (dfor [k v] (.items (. request (get "route") (get "parameters"))) k (quote-plus v))))))) - - (when (= path "/style.css") - (when (!= method "GET") - (return (error 405 "method not allowed"))) - - (setv [headers data] (send-raw-file "./www/site/assets/style.css")) - (return (dict - :code 200 - :headers headers - :body data))) +(defclass method-map [] + (meth __init__ [] (setv @methods {})) + (meth __getattr__ [attr] + (if (in attr @methods) + (get @methods attr) + (fn [value] (setv (get @methods attr) value)))) - (when (= path "/robots.txt") - (when (!= method "GET") - (return (error 405 "method not allowed"))) + (meth __getitem__ [item] + (setv item (.get @methods item None)) + (if item + item + (fn [#* _] (error 405 "method not allowed"))))) - (return (dict - :code 200 - :headers {"Content-Type" "text/plain"} - :body "user-agent: *\ndisallow: /\n"))) - - (when (= path "/") - (when (!= method "GET") - (return (error 405 "method not allowed"))) - - (return (dict - :code 200 - :body (parse-html-file "./www/site/html/home.html" :route "/")))) - - (when (= path "/test.html") - (when (!= method "GET") - (return (error 405 "method not allowed"))) - - (return (dict - :code 200 - :body (parse-html-file "./www/site/html/test.html" :route "/test.html")))) - - (when (= path "/files/natalieee.net.png") - (return (dict - :code 308 - :headers {"Location" "/assets/88x31/natalieee.net.png"} - :body ""))) - - (when (= path "/comment") +(defclass router [] + (meth __init__ [] + (setv @route-map {}) + (setv @route-cache {})) + + (meth add-route [route] + (when (not-in route @route-map) + (setv (get @route-map route) (method-map))) + + (return (get @route-map route))) + + (meth [lru-cache] get-route-by-path [path] (cond - (= method "POST") (do - (setv now (datetime.now)) - - (setv url-comment-dir (quote-plus (. request (get "route") (get "parameters") (get "route")) :safe "")) - - (when (not (dir? "./www/data")) - (mkdir "./www/data")) - - (when (not (dir? f"./www/data/comments")) - (mkdir "./www/data/comments")) - - (when (not (dir? f"./www/data/comments/{url-comment-dir}")) - (mkdir f"./www/data/comments/{url-comment-dir}")) - - (setv+ {{comment "comment" name "name" site "site"} "body"} request) - - (when (.startswith site "//") - (setv site (.replace site "//" ""))) - - (setv [protocol domain path #* _] (urlparse - (if (in "://" site) - site - (+ "http://" site)))) - - (setv site-valid? (= (domain? domain) True)) - - (when (not protocol) - (setv protocol "//")) - - (print protocol domain path site-valid?) - - - (with [f (open f"./www/data/comments/{url-comment-dir}/{(.strftime now "%Y-%m-%d_%H:%M:%S_%f")}" "w")] - (.write f f"
{(if (and site site-valid?) f"" "")}{(clean name)}{(if (and site site-valid?) "" "")} at {(.strftime now "%Y-%m-%d %H:%M:%S")}:
{(clean comment)}
")) + (in path @route-map) (do (get @route-map path)) + True (do + (while (> (.count path "/") 1) + (setv path (.join "/" (get (.split path "/") (slice 0 -1)))) + (when (in (+ path "/*") @route-map) + (setv handler (get @route-map (+ path "/*"))) + (return handler))) - (return (dict - :code 303 - :headers {"Location" (. request (get "headers") (get "Referer"))}))) + (always (fn [#* _] (error 404 "not-found)"))))))) - (= method "GET") (error 405 "method not allowed"))) +(setv routes (router)) - (return (dict - :code 404 - :body (parse-html-file "./www/site/html/error.html" :code 404 :message f"{path} not found")))) +(defmacro route [route method] + `(. (routes.add-route ~route) ~(hy.models.Symbol method))) + +(defreader route-args + (.slurp-space &reader) + (if (= (.peekc &reader) "[") + `[method path request ~@(.parse-one-form &reader)] + '[method path request])) + +(defn if-file-exists [* base-path otherwise] + (fn [f] + (fn [method path request] + (if (file? f"{base-path}{path}") + (f method path request) + otherwise)))) + +(defn forward-params [#* params] + (fn [f] + (fn [method path request] + (f method path request #** (dict (lfor param params + :if (setx value (. request (get "route") (get "parameters") (get param None))) + #(param value))))))) + +(defn shtml-file-response [file [code 200] [template-params {}]] + (dict :code code :body (parse-html-file f"./www/site/html/{file}" #** template-params))) + +(defn raw-file-response [file [code 200]] + (dict :code code #** (dict (zip ["headers" "body"] (send-raw-file f"./www/site/{file}"))))) + +(defn [(route "/" "GET")] /home #route-args (shtml-file-response "home.html")) +(defn [(route "/html/*" "GET") (if-file-exists :base-path "./www/site/html" :otherwise (error 404 "not found"))] /html/* #route-args (shtml-file-response path)) +(defn [(route "/assets/*" "GET") (if-file-exists :base-path "./www/site/" :otherwise (error 404 "not found"))] /assets/* #route-args (raw-file-response path)) +(defn [(route "/html/view-thought.html" "GET") (forward-params "thought" "filter-tag")] /html/view-thought #route-args [#** template-args] (shtml-file-response "/html/view-thought.html" :template-params template-args)) +(defn [(route "/comment" "POST")] /comments #route-args (create-comment request)) +(defn [(route "/robots.txt" "GET") ] /robots #route-args (dict :code 200 :headers {"Content-Type" "text/plain"} :body "User-agent *\nDisallow: /\n")) + +(defn+ [lru-cache] match-request [{method "method" {path "path"} "route" :as request}] + ((get (routes.get-route-by-path path) method) method path request)) + diff --git a/srv/http_utils/request.hy b/srv/http_utils/request.hy index c74553d..8fbe7f7 100644 --- a/srv/http_utils/request.hy +++ b/srv/http_utils/request.hy @@ -2,17 +2,27 @@ (require hyrule.control [branch]) (require hyrule.argmove [doto]) (require hyrule.collections :readers [s]) +(require hyrule.oop [meth]) (import urllib.parse [urlsplit unquote-plus parse-qs]) +(defclass hashable-dict [dict] + ;; this is ok because requests are never mutated after being built. + (meth __key [] + (tuple (sorted (@items)))) + + (meth __hash__ [] + (hash (@__key)))) + (defn parse-url-encoded [query] - (dfor pair (.items (parse-qs (unquote-plus query) :keep-blank-values True)) - (get pair 0) - (cond - (get pair 1 0) (get pair 1 0) - True ""))) + (hashable-dict + (dfor pair (.items (parse-qs (unquote-plus query) :keep-blank-values True)) + (get pair 0) + (cond + (get pair 1 0) (get pair 1 0) + True "")))) (defn parse-data [data] - (setv request {}) + (setv request (hashable-dict)) (setv [head #* body] (.split data b"\r\n\r\n")) (setv [request-line #* headers] (.split head b"\r\n")) @@ -22,7 +32,7 @@ (assoc "method" http-method) (assoc "route" (let [[_ _ path query _] (urlsplit route)] - (dict + (hashable-dict :path (.join "/" (do (setv segments []) @@ -36,7 +46,7 @@ :parameters (parse-url-encoded query)))) (assoc "version" http-version) - (assoc "headers" (dict + (assoc "headers" (hashable-dict (dfor header (map (fn [x] (.split (.decode x "utf-8") ": ")) headers) @@ -54,4 +64,4 @@ ;; (print "boundary" boundary) ;; (print (.split (.join b"\n" body) (.encode boundary "utf-8")))))) else (raise (NotImplementedError f"{(get (.split (. request (get "headers") (get "Content-Type")) ";") 0)} parsing is TODO")))))) - +