142 lines
6.1 KiB
Hy
142 lines
6.1 KiB
Hy
(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 content.comments [create-comment])
|
|
(import content.arpa-n-gon :as arpa-n-gon)
|
|
(import re)
|
|
(import functools [lru-cache])
|
|
(import os.path [isdir :as dir? isfile :as file? abspath])
|
|
(import asyncio)
|
|
|
|
(defn :async error [code message]
|
|
(return (dict
|
|
:code code
|
|
:body (await (parse-html-file "./www/site/html/error.html" :code code :message message)))))
|
|
|
|
(defclass always []
|
|
(meth __init__ [@value])
|
|
(meth __getitem__ [_] @value))
|
|
|
|
(defclass method-map []
|
|
(meth __init__ [] (setv @methods {}))
|
|
|
|
(meth __getattr__ [attr]
|
|
(if (in attr @methods)
|
|
(get @methods attr)
|
|
(fn [value] (setv (get @methods attr) value))))
|
|
|
|
(meth __getitem__ [item]
|
|
(setv item (.get @methods item None))
|
|
(if item
|
|
item
|
|
(fn [#* _] (error 405 "method not allowed")))))
|
|
|
|
(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 get-route-by-path [path]
|
|
(cond
|
|
(in path @route-map) (get @route-map path)
|
|
(in (when (.endswith path "/") (get path (slice 0 -1))) @route-map) (get @route-map (get path (slice 0 -1)))
|
|
True (do
|
|
(while (> (.count path "/") 1)
|
|
(setv path (.join "/" (get (.split path "/") (slice 0 -1))))
|
|
(when (in (+ path "/*") @route-map)
|
|
(return (get @route-map (+ path "/*")))))
|
|
|
|
(always (fn [#* _] (error 404 "not-found)")))))))
|
|
|
|
(setv routes (router))
|
|
|
|
(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]))
|
|
|
|
(defreader await
|
|
(.slurp-space &reader)
|
|
`(await ~(.parse-one-form &reader)))
|
|
|
|
(defn if-file-exists [* base-path otherwise]
|
|
(fn [f]
|
|
(fn [method path request]
|
|
(if (file? f"{base-path}{path}")
|
|
(f method path request)
|
|
(otherwise method path request)))))
|
|
|
|
(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 require-params [#* params [otherwise (fn [#* _] (error 409 "missing required parameters"))]]
|
|
(fn [f]
|
|
(fn [method post request #** kwargs]
|
|
(if (all (lfor param params (in param (. request (get "route") (get "parameters") (keys)))))
|
|
(f method post request #** kwargs)
|
|
(otherwise method post request #** kwargs)))))
|
|
|
|
(defn 303-if-not-arpa [[unless (fn [#* _] False)]]
|
|
(fn [f]
|
|
(fn [method path request]
|
|
(if (or (. request (get "headers") (get "Host") (endswith "arpa")) (unless request))
|
|
(f method path request)
|
|
(dict
|
|
:code 303
|
|
:headers {"Location" f"http://natalieee.net.8.f.9.e.0.7.4.0.1.0.0.2.ip6.arpa{(. request (get "route") (get "unparsed_route"))}"})))))
|
|
|
|
(defn :async shtml-file-response [file [code 200] [no-exec False] [template-params {}]]
|
|
(dict
|
|
:code code
|
|
:headers {"Connection" "keep-alive" "Keep-Alive" "timeout=5 max=200"}
|
|
:body #await (parse-html-file f"./www/site/html/{file}" :no-exec no-exec #** template-params)))
|
|
|
|
(defn :async raw-file-response [file [code 200]]
|
|
(dict :code code #** (dict (zip ["headers" "body"] #await (send-raw-file f"./www/site/{file}")))))
|
|
|
|
(defn+ :async match-request [{method "method" {path "path"} "route" :as request}]
|
|
#await ((get (routes.get-route-by-path path) method) method path request))
|
|
|
|
(defn [(route "/" "GET")] /home #route-args (shtml-file-response "home.html"))
|
|
(defn [(route "/html/*" GET) (if-file-exists :base-path "./www/site/html" :otherwise (fn :async [#* _] #await (error 404 "not found")))] /html/* #route-args (shtml-file-response path))
|
|
(defn [lru-cache (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 [lru-cache (route "/robots.txt" "GET") ] /robots #route-args (dict :code 200 :headers {"Content-Type" "text/plain"} :body "User-agent *\nDisallow: /\n"))
|
|
|
|
;; *.arpa web n-gon
|
|
(setv members (arpa-n-gon.get-members))
|
|
|
|
(defn [(route "/arpa-n-gon" GET) (303-if-not-arpa)] /arpa-n-gon #route-args (shtml-file-response "arpa-n-gon.html" :template-params (dict :n_gon (arpa-n-gon.n-gon-name (len members)) :n_gon_inc (arpa-n-gon.n-gon-name (+ (len members) 1)) :n (len members))))
|
|
|
|
(defn [(route "/arpa-n-gon/nav" GET) (303-if-not-arpa :unless (fn [request] (in "from-iframe" (. request (get "route") (get "parameters") (keys))))) (forward-params "current" "style") (require-params "current") ] /arpa-n-gon/nav #route-args [current [style None]]
|
|
(shtml-file-response "arpa-n-gon-nav.html" :no-exec True :template-params (dict
|
|
:style style
|
|
:next (+ "http://" (get (arpa-n-gon.next-member members current) "arpa-domain"))
|
|
:prev (+ "http://" (get (arpa-n-gon.prev-member members current) "arpa-domain"))
|
|
:n_gon (arpa-n-gon.n-gon-name (len members)))))
|
|
|
|
(defn [(route "/arpa-n-gon/next" GET) (303-if-not-arpa) (forward-params "current" )(require-params "current")] /arpa-n-gon/next #route-args [current] (dict
|
|
:code 303
|
|
:headers {"Location" (+ "http://" (get (arpa-n-gon.next-member members current) "arpa-domain"))}))
|
|
|
|
(defn [(route "/arpa-n-gon/prev" GET) (303-if-not-arpa) (forward-params "current") (require-params "current")] /arpa-n-gon/next #route-args [current] (dict
|
|
:code 303
|
|
:headers {"Location" (+ "http://" (get (arpa-n-gon.prev-member members current) "arpa-domain"))}))
|