diff options
Diffstat (limited to 'bin')
| -rw-r--r-- | bin/serve.fnl | 231 |
1 files changed, 188 insertions, 43 deletions
diff --git a/bin/serve.fnl b/bin/serve.fnl index 222c4b5..a76de08 100644 --- a/bin/serve.fnl +++ b/bin/serve.fnl @@ -1,54 +1,199 @@ (local fennel (require :vendor.fennel)) +(local lib (require :lib)) (when _G.unpack (tset table :unpack _G.unpack)) -(set _G.reload - (fn [module] - (local old (require module)) - (tset package :loaded module nil) - (local (ok? new) (pcall require module)) - (if (not ok?) - (do - (tset package :loaded module old) - (error new)) - (when (= (type new) :table) - (do - (each [k v (pairs new)] - (tset old k v)) - (each [k (pairs old)] - (when (not (. new k)) - (tset old k nil))) - (tset package :loaded module old)))))) - -(fn ends-with [str end] - (= (string.sub str (- (# end))) end)) - -(fn trim [str pattern] - (local pattern (or pattern "%s")) - (str:match (.. "^" pattern "*(.-)" pattern "*$"))) - -(fn file-exists? [path] - (local f (io.open path "r")) - (and (~= f nil) (io.close f))) +(fn _G.must [...] + (local (ok? result) ...) + (if ok? result (error result))) + +(fn _G.pp [...] + (local args (table.pack ...)) + (for [i 1 args.n] + (print (fennel.view (. args i))))) + +(fn _G.reload [module] + (local old (require module)) + (tset package :loaded module nil) + (local (ok? new) (pcall require module)) + (if (not ok?) + (do + (tset package :loaded module old) + (error new)) + (when (= (type new) :table) + (do + (each [k v (pairs new)] + (tset old k v)) + (each [k (pairs old)] + (when (not (. new k)) + (tset old k nil))) + (tset package :loaded module old))))) + +(local db + (_G.must (luna.db.open "file:var/db.sqlite?_journal=WAL&_sync=NORMAL&_txlock=immediate"))) + +(_G.must + (luna.db.exec db + "PRAGMA foreign_keys=ON; + + CREATE TABLE IF NOT EXISTS users( + name TEXT PRIMARY KEY, + password TEXT NOT NULL + ); + + CREATE TABLE IF NOT EXISTS auth_sessions( + id TEXT PRIMARY KEY, + creation_time TEXT NOT NULL, + user TEXT NOT NULL REFERENCES users(name), + expires_at TEXT NOT NULL + ); + + CREATE TABLE IF NOT EXISTS products( + name TEXT PRIMARY KEY, + creation_time TEXT NOT NULL, + title TEXT NOT NULL, + type TEXT NOT NULL, + packaging TEXT NOT NULL, + description TEXT, + short_description TEXT NOT NULL, + position INTEGER NOT NULL DEFAULT 0, + published BOOLEAN NOT NULL DEFAULT false, + price_per REAL, + stock REAL, + vendor TEXT, + vendor_article TEXT, + vendor_description TEXT, + vendor_price_per REAL, + vendor_product_link TEXT, + image1 TEXT REFERENCES files(name), + image2 TEXT REFERENCES files(name), + image3 TEXT REFERENCES files(name), + image4 TEXT REFERENCES files(name), + image5 TEXT REFERENCES files(name) + ); + + CREATE TABLE IF NOT EXISTS files( + name TEXT PRIMARY KEY, + creation_time TEXT NOT NULL, + type TEXT NOT NULL, + size REAL NOT NULL, + thumbnail TEXT, + description TEXT + ); + + CREATE TABLE IF NOT EXISTS orders( + id TEXT PRIMARY KEY, + creation_time TEXT NOT NULL, + placement_time TEXT, + first_name TEXT, + contact TEXT + ); + + CREATE TABLE IF NOT EXISTS order_lines( + id INTEGER PRIMARY KEY, + creation_time TEXT NOT NULL, + order_id INTEGER NOT NULL REFERENCES orders(id), + product_name TEXT NOT NULL REFERENCES products(name), + quantity REAL NOT NULL + );" [])) + +(fn scan-routes [dir] + (var result {}) + (each [_ f (ipairs (_G.must (luna.fs.files dir)))] + (if f.dir + (tset result f.name (scan-routes (.. dir "/" f.name))) + (let [trimmed-name (lib.trim-right f.name ".fnl")] + (tset result trimmed-name (require (.. dir "." trimmed-name)))))) + result) + +(fn match-route [routes path] + (local variables {}) + + (fn _match [routes parts] + (var pointer routes) + (while (and (< 0 (# parts)) (= (type pointer) "table")) + (local part (table.remove parts 1)) + (set pointer + (if (. pointer part) + (. pointer part) + ;; test for routes starting with _ + (do + (var res nil) + (each [key value (pairs pointer) &until res] + (if (lib.starts-with? key "_") + (do + (set res (_match value parts)) + (when res (tset variables key part))) + nil)) + res)))) + (when (and (= (type pointer) "table") pointer.index) + (set pointer (. pointer :index))) + (values pointer variables)) + + (if (or (= path "") (= path "/")) + (values (. routes "index") variables) + (_match routes (lib.split (lib.trim path "/") "/")))) + +(fn test-match-route [] + (let [routes {:index "index" + :shop {:index "shop/index" + :cart "shop/cart" + :_product {:index "shop/_product/index" + :edit "shop/_product/edit"}} + :faq "faq" + :_page {:edit "_page/edit"}}] + + (fn test [path exp-res exp-vars] + (local (res vars) (match-route routes path)) + (assert (= exp-res res) + (.. "router test failed for " path + ": expected " exp-res ", got " res)) + (assert (lib.equal-tables? exp-vars vars) + (.. "router test failed for " path + ": expected " (fennel.view exp-vars) + ", got " (fennel.view vars)))) + + (test "" "index" {}) + (test "/" "index" {}) + (test "shop" "shop/index" {}) + (test "shop/" "shop/index" {}) + (test "shop/index" "shop/index" {}) + (test "faq" "faq" {}) + (test "faq/" "faq" {}) + (test "shop/cart" "shop/cart" {}) + (test "shop/cart/" "shop/cart" {}) + (test "foobar/edit" "_page/edit" {:_page "foobar"}) + (test "foobar/edit/" "_page/edit" {:_page "foobar"}) + (test "shop/xyz" "shop/_product/index" {:_product "xyz"}) + (test "shop/xyz/index" "shop/_product/index" {:_product "xyz"}) + (test "shop/xyz/edit" "shop/_product/edit" {:_product "xyz"}))) + +(test-match-route) + +(local routes (scan-routes "pages")) (fn router [request] - (let - [path (trim - (if (ends-with request.path "/") - (.. request.path "index") - request.path) - "/") - module-path (.. "pages." (string.gsub path "%." "/")) - module-exists? (file-exists? (.. "pages/" path ".fnl"))] - ;; FIXME: slow - (if module-exists? - (let [(code headers html) ((. (require module-path) :render) request)] - (values code headers (.. "<!DOCTYPE html>\n" html))) - (values 404 {:content-type "text/html"} "not found")))) - -(luna.router.route "GET /" router) + (if (and (lib.ends-with? request.path "/") + (~= request.path "/")) + (values 302 {:Location (lib.trim-right request.path "/")} "") + (let [(handler params) (match-route routes request.path)] + (tset request :params params) + (if (and (= (type handler) "table") handler.render) + (let [(code headers content) + (handler.render request db (lib.authenticate-request db request))] + (values code headers (.. "<!DOCTYPE html>\n" content))) + (values 404 {:content-type "text/html"} "not found"))))) + +(luna.router.route "/" router) (luna.router.static "GET /static/" "static/") +(when (= 0 (# (_G.must (luna.db.query db "SELECT name FROM users LIMIT 1" [])))) + (let [password (_G.must (luna.crypto.random-string 20)) + hash (_G.must (luna.crypto.password-hash password))] + (_G.must (luna.db.exec db "INSERT INTO users (name, password) VALUES (?, ?)" + ["admin" hash])) + (print (.. "admin user created: admin / " password)))) + (when luna.debug (luna.on-eval (fn [code] (fennel.eval code {:env _G})))) |