1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
|
(local lib (require :lib))
( when _G.unpack
(tset table :unpack _G.unpack))
(fn _G.must [...]
(local (ok? result) ...)
(if ok? result (error result)))
(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,
position INTEGER NOT NULL DEFAULT 0,
published BOOLEAN NOT NULL DEFAULT false,
title TEXT NOT NULL,
type TEXT NOT NULL,
packaging TEXT NOT NULL,
description TEXT,
short_description TEXT NOT NULL,
year INTEGER,
season TEXT,
region TEXT,
recommendations TEXT,
price_per REAL,
stock REAL,
volume INTEGER,
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,
state TEXT NOT NULL DEFAULT 'cart',
name TEXT,
contact TEXT,
consent BOOLEAN
);
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 authenticate-request [db request]
(let [cookies-header (. request.headers :Cookie)
cookies (if cookies-header (lib.parse-values cookies-header) {})
session-id cookies.auth]
(if (not (lib.empty? session-id))
(let [sessions
(_G.must
(luna.db.query-assoc
db
"SELECT id FROM auth_sessions
WHERE id = ?
AND expires_at > STRFTIME('%Y-%m-%d %H:%M:%S', DATETIME('now'))"
[session-id]))]
(< 0 (# sessions)))
false)))
(fn router [request]
(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 (authenticate-request db request))]
(values code headers (.. "<!DOCTYPE html>\n" content)))
(values 404 {:content-type "text/html"} "not found")))))
(_G.must (luna.router.route "/" router))
(_G.must (luna.router.static "GET /static" "static/" ""))
(_G.must (luna.router.static "GET /static/files" "static/files" ""))
(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}))))
|
