diff of 4370eec15be43d9a8b391d6d2a5b153dd048eda3
4370eec15be43d9a8b391d6d2a5b153dd048eda3
diff --git a/aggressive-murja.asd b/aggressive-murja.asd
index e26bd66..424becd 100644
--- a/aggressive-murja.asd
+++ b/aggressive-murja.asd
@@ -15,14 +15,30 @@
"easy-routes"
"drakma"
"str"
+ "cl-fad"
"log4cl"
"cl-advice")
:description "A rewrite of the <a href=\"https://github.com/feuery/murja-blog/\">murja blogging engine</a> in lisp"
:components ((:module "src"
:components
- ((:module "posts"
+ ((:module "local-lib"
+ :components ((:file "lisp-fixup")
+ (:file "halisql")))
+ (:module "users"
+ :components ((:file "user-db")))
+ (:module "middleware"
+ :components ((:file "json")
+ (:file "db")
+ (:file "auth")))
+ (:module "posts"
:components
((:file "post-db")))
+
+ (:module "routes"
+ :components
+ ((:file "login-routes")
+ (:file "post-routes")
+ (:file "root-routes")))
(:file "main")))))
diff --git a/resources/css/murja.css b/resources/css/murja.css
new file mode 120000
index 0000000..809d42b
--- /dev/null
+++ b/resources/css/murja.css
@@ -0,0 +1 @@
+../../old-murja//murja/resources/public/css/murja.css
\ No newline at end of file
diff --git a/resources/js/murja-helper.js b/resources/js/murja-helper.js
new file mode 120000
index 0000000..18d439d
--- /dev/null
+++ b/resources/js/murja-helper.js
@@ -0,0 +1 @@
+../../old-murja/murja/resources/public/js/murja-helper.js
\ No newline at end of file
diff --git a/resources/js/murja.js b/resources/js/murja.js
new file mode 120000
index 0000000..68c2e15
--- /dev/null
+++ b/resources/js/murja.js
@@ -0,0 +1 @@
+../../old-murja/elm-frontti/elm.js
\ No newline at end of file
diff --git a/resources/sql/post-fns.sql b/resources/sql/post-fns.sql
new file mode 100644
index 0000000..d50a055
--- /dev/null
+++ b/resources/sql/post-fns.sql
@@ -0,0 +1,147 @@
+-- name: post-comments*
+SELECT c.ID, c.parent_comment_id,
+c.Content,
+c.created_at,
+u.Username, u.Nickname, u.Img_location
+FROM blog.Comment c
+JOIN blog.Users u ON u.ID = c.creator_id
+WHERE c.parent_post_id = :parent-post-id
+ORDER BY c.created_at;
+
+-- $1 == allow-hidden?
+-- name: get-titles-by-year*
+-- returns: :array-hash
+SELECT p.Title AS "Title",
+ EXTRACT(MONTH FROM p.created_at) AS "Month",
+ EXTRACT(YEAR FROM p.created_at) AS "Year",
+ p.id as "Id",
+ p.Tags as "Tags"
+FROM blog.Post p
+WHERE $1 OR (NOT p.tags ? 'unlisted' AND NOT p.tags ? 'hidden')
+ORDER BY p.created_at DESC;
+
+-- name: post-versions*
+SELECT version
+FROM blog.Post_History
+WHERE ID = :post-id AND NOT tags ?? 'hidden'
+ORDER BY version ASC;
+
+-- name: next-post-id
+SELECT p.ID
+FROM blog.Post p
+WHERE p.ID < :post-id AND NOT p.tags ?? 'hidden'
+ORDER BY p.ID DESC
+LIMIT 1;
+
+-- name: prev-post-id
+SELECT p.ID
+FROM blog.Post p
+WHERE p.ID > :post-id AND NOT p.tags ?? 'hidden'
+ORDER BY p.ID ASC
+LIMIT 1;
+
+-- name: get-by-id*
+SELECT p.ID, p.Title, p.created_at, p.Content, p.tags, u.Username, u.Nickname, u.Img_location, COUNT(c.ID) AS "amount-of-comments"
+FROM blog.Post p
+JOIN blog.Users u ON u.ID = p.creator_id
+LEFT JOIN blog.Comment c ON c.parent_post_id = p.ID
+WHERE p.ID = :post-id AND (NOT p.tags ?? 'hidden' OR (p.tags ?? 'hidden' AND :show-hidden))
+GROUP BY p.ID, u.ID;
+
+-- name: get-versioned-by-id*
+SELECT p.ID, p.Title, p.created_at, p.Content, p.tags, u.Username, u.Nickname, u.Img_location, p.version, COUNT(c.ID) AS "amount-of-comments"
+FROM blog.Post_History p
+JOIN blog.Users u ON u.ID = p.creator_id
+LEFT JOIN blog.Comment c ON c.parent_post_id = p.ID
+WHERE p.ID = :post-id AND p.version = :version-id AND not tags ?? 'hidden'
+GROUP BY p.ID, u.ID, p.title, p.created_at, p.Content, p.tags, u.Username, u.Nickname, u.Img_location, p.version;
+
+
+-- name: get-all*
+SELECT p.id, p.Title, p.Content, p.created_at, p.tags, u.Username, u.Nickname, u.Img_location, COUNT(c.ID) AS "amount-of-comments"
+FROM blog.Post p
+JOIN blog.Users u ON u.ID = p.creator_id
+LEFT JOIN blog.Comment c ON c.parent_post_id = p.ID
+WHERE NOT p.tags ?? 'hidden'
+GROUP BY p.ID, u.ID
+ORDER BY p.created_at DESC
+-- this isn't going to work :)
+--~ (when (contains? params :limit) "LIMIT :limit") ;
+;
+
+
+-- $1 == page-id
+-- $2 == page-size
+-- $3 == show-hidden?
+-- name: get-page*
+-- returns: :array-hash
+SELECT p.ID, p.Title, p.Content, p.created_at, p.tags, COUNT(c.ID) AS "amount-of-comments", json_build_object('username', u.Username, 'nickname', u.Nickname, 'img_location', u.Img_location) as "creator"
+FROM blog.Post p
+JOIN blog.Users u ON u.ID = p.creator_id
+LEFT JOIN blog.Comment c ON c.parent_post_id = p.ID
+WHERE ((NOT p.tags ? 'unlisted') OR $3)
+ AND ((NOT p.tags ? 'hidden') OR $3)
+GROUP BY p.ID, u.ID
+ORDER BY p.created_at DESC
+LIMIT $2
+OFFSET $1;
+
+-- name: landing-page-ids*
+SELECT id
+FROM blog.Post
+WHERE tags ?? 'landing-page' AND NOT tags ?? 'hidden';
+
+-- name: get-posts-tags*
+SELECT tags FROM blog.Post WHERE id = :post-id;
+
+-- name: update-tags* @execute
+update blog.post
+set tags = :new-tags
+where id = :post-id;
+
+-- name: insert-post :<! :1
+insert into blog.post (title, content, creator_id, tags)
+values (:title, :content, :creator-id, :tags) returning id;
+
+-- name: update-post @execute :1
+update blog.post
+set title = :title,
+ content = :content,
+ tags = :tags
+where id = :id;
+
+-- name: delete-post @execute
+delete blog.post
+where id = :id
+-- also: this
+--~ (when (contains? params :version) "AND version = :version");
+;
+
+-- name: delete-comment @execute
+delete blog.comment
+where id = :id;
+
+-- name: insert-comment @execute
+insert into blog.comment (parent_post_id, parent_comment_id, content, creator_id)
+values (:parent-post-id, :parent-comment-id, :content, :creator-id);
+
+-- name: get-landing-page*
+SELECT p.ID, p.Title, p.created_at, p.Content, p.tags, u.Username, u.Nickname, u.Img_location, COUNT(c.ID) AS \"amount-of-comments\"
+FROM blog.Post p
+JOIN blog.Users u ON u.ID = p.creator_id
+LEFT JOIN blog.Comment c ON c.parent_post_id = p.ID
+WHERE p.tags ?? 'landing-page' AND NOT p.tags ?? 'hidden'
+GROUP BY p.ID, u.ID;
+
+-- name: landing-page-title
+SELECT p.Title, p.Id
+FROM blog.Post p
+WHERE p.tags ?? 'landing-page' AND NOT p.tags ?? 'hidden';
+
+
+-- name: get-tagged*
+SELECT p.ID, p.Title, p.created_at, p.Content, p.tags, u.Username, u.Nickname, u.Img_location, 0 AS "amount-of-comments"
+FROM blog.Post p
+JOIN blog.Users u ON u.ID = p.creator_id
+WHERE p.tags @> :tags AND (NOT p.tags ?? 'hidden' OR (p.tags ?? 'hidden' AND :show-hidden))
+ and ((NOT p.tags ?? 'unlisted') OR :show-hidden);
diff --git a/resources/sql/user-fns.sql b/resources/sql/user-fns.sql
new file mode 100644
index 0000000..7f695c5
--- /dev/null
+++ b/resources/sql/user-fns.sql
@@ -0,0 +1,52 @@
+-- name: get-user-by-id*
+-- returns: :array-hash
+
+SELECT
+ u.id,
+ u.username,
+ u.nickname,
+ u.img_location,
+ json_agg(DISTINCT perm.action) "permissions"
+FROM
+ blog.users u
+ JOIN blog.groupmapping gm ON u.id = gm.userid
+ JOIN blog.grouppermissions gp ON gp.groupid = gm.groupid
+ JOIN blog.permission perm ON gp.permissionid = perm.id
+WHERE
+ u.id = $1
+GROUP BY
+ u.id;
+
+-- name: query-users*
+-- :? :1
+SELECT u.Username, u.Nickname, u.ID as UserID, u.Password, u.Img_location, ug.ID as GroupID, ug.Name as GroupName, gm.PrimaryGroup, json_agg(DISTINCT perm.action) "permissions"
+FROM blog.Users u
+JOIN blog.GroupMapping gm ON u.ID = gm.UserID
+JOIN blog.UserGroup ug ON ug.ID = gm.GroupID
+JOIN blog.grouppermissions gp ON gp.groupid = gm.groupid
+JOIN blog.permission perm ON perm.id = gp.permissionid
+WHERE u.Username = $1 AND u.Password = $2;
+
+-- name: get-user-view-data*
+SELECT u.Username, u.Nickname, u.Img_location, ug.Name as "primary-group-name", gm.PrimaryGroup, u.ID as userid, perm.action
+FROM blog.Users u
+JOIN blog.GroupMapping gm ON u.ID = gm.UserID
+JOIN blog.UserGroup ug ON ug.ID = gm.GroupID
+JOIN blog.grouppermissions gp ON gp.groupid = gm.groupid
+JOIN blog.permission perm ON perm.id = gp.permissionid
+WHERE u.ID = :user-id;
+
+-- name: user-groups*
+SELECT ug.ID, ug.Name, ug.Description
+FROM blog.Users u
+LEFT JOIN blog.GroupMapping um ON um.UserID = u.ID
+LEFT JOIN blog.UserGroup ug ON um.GroupID = ug.ID
+WHERE u.Username = :username;
+
+
+-- name: can?*
+-- :? :1
+SELECT COUNT(perm.ACTION) > 0 AS "can?"
+FROM blog.GroupPermissions gp
+LEFT JOIN blog.Permission perm ON gp.PermissionID = perm.ID
+WHERE gp.GroupID = :group-id AND perm.action = :action;
diff --git a/src/local-lib/halisql.lisp b/src/local-lib/halisql.lisp
new file mode 100644
index 0000000..5b104ae
--- /dev/null
+++ b/src/local-lib/halisql.lisp
@@ -0,0 +1,134 @@
+(defpackage halisql
+ (:use :cl :binding-arrows)
+ (:import-from :lisp-fixup :slurp-utf-8 :drop :partial :compose)
+ (:export :*log* :defqueries :*system-name*))
+
+(in-package :halisql)
+
+(defvar *system-name* :aggressive-murja
+ "Symbol that names the current system, and is used to find files under ${(asdf:system-relative-pathname *system-name*)}/resources/sql/~a.sql")
+
+(defun slurp-sql (sql-file-name)
+ "Reads an sql-file into a compile-time constant you can push to exec-all"
+
+ (let ((file-path (asdf:system-relative-pathname *system-name*
+ (format nil "resources/sql/~a.sql" sql-file-name))))
+ (slurp-utf-8 file-path)))
+
+(defparameter interesting-keywords (list "name:" "returns:"))
+
+(defun is-comment? (line)
+ (str:starts-with? "--" line))
+
+(defun merge-hash (hash1 hash2)
+ (dolist (k (loop for k being each hash-key of hash2
+ collect k))
+ (setf (gethash k hash1) (gethash k hash2)))
+ hash1)
+
+(defun query-meta (query)
+ (let* ((relevant-lines (->> query
+ (remove-if-not #'is-comment?)
+ (mapcar (lambda (line)
+ (str:trim
+ (str:replace-first "--" "" line))))))
+ (processed-records (->> relevant-lines
+ (remove-if-not
+ (lambda (line)
+ (some (lambda (kw)
+ (str:starts-with? kw line))
+ interesting-keywords)))
+ (mapcar (lambda (line)
+ (let* ((result (str:split #\Space line ))
+ (key (str:replace-first ":" "" (first result)))
+ (value (rest result))
+ (modifiers (drop 2 result))
+ (dict (make-hash-table :size 2 :test 'equal)))
+ (setf (gethash key dict) value)
+ (when modifiers
+ (setf (gethash "modifiers" dict) modifiers))
+ dict)))))
+ (result (make-hash-table :test 'equal)))
+
+ (dolist (record processed-records)
+ (setf result (merge-hash result record)))
+ result))
+
+(defun get-sql (query)
+ (->> query
+ (remove-if #'is-comment?)
+ (str:join #\Newline)))
+
+(defun amount-of-query-params (query-sql)
+ (let ((params (->>
+ query-sql
+ (cl-ppcre:all-matches-as-strings "\\$\\d")
+ (mapcar (compose #'parse-integer (partial #'str:replace-all "$" ""))))))
+ (if params
+ (apply #'max params )
+ 0)))
+
+(defparameter *log* nil)
+
+(defmacro defqueries (file-path)
+ (let ((queries (->> (uiop:split-string
+ (slurp-sql file-path)
+ :separator '(#\;))
+ (mapcar (lambda (fn)
+ (uiop:split-string fn :separator '(#\Newline))))
+ (remove-if (lambda (query)
+ (every (partial #'string= "") query))))))
+ `(progn
+ ,@(->> queries
+ (mapcar (lambda (query)
+ (let* ((meta (query-meta query))
+ (sql (get-sql query))
+ (amount-of-params (amount-of-query-params sql))
+ (name (first (gethash "name" meta)))
+ (returns (str:join #\Space (gethash "returns" meta)))
+ (modifiers (gethash "modifiers" meta))
+ (execute? (some (partial #'string= "@execute") modifiers))
+ ;;(args (gensym))
+ (fn (if execute?
+ 'postmodern:execute
+ 'postmodern:query))
+ (params (loop for x from 1 to amount-of-params collect (gensym))))
+
+ `(defun ,(intern (string-upcase name)) ,params
+ (when *log*
+ (format t "running ~a~%" ,sql))
+ (handler-case
+ (,fn ,sql
+ ,@params
+ ,(if (not (string= "" returns))
+ (let ((*read-eval* nil))
+ (when *log*
+ (format t "returns: ~a~%" (prin1-to-string returns)))
+ (read-from-string (string-upcase returns)))
+ (if (equalp fn 'postmodern:query)
+ :rows
+ :none)))
+ (error (e)
+ (format t "caught error in ~a~%~a~%" (quote ,(intern (string-upcase name)))
+ e)
+ e)))))))
+ '(,@(->> queries
+ (mapcar (lambda (query)
+ (let ((meta (query-meta query)))
+ (intern (string-upcase (first (gethash "name" meta))))))))))))
+
+
+;; (macroexpand-1 '
+;; (defqueries "user-routes.sql"))
+
+
+;; (pichunter.std:with-db
+;; (postmodern:with-schema (:pichunter)
+
+;; (do-something-stupid-with-users "feuer" "TESTI" (pichunter.std:sha-512 "passu")
+;; 3
+;; (pichunter.std:sha-512 "passu"))))
+
+
+
+
diff --git a/src/local-lib/lisp-fixup.lisp b/src/local-lib/lisp-fixup.lisp
new file mode 100644
index 0000000..d157422
--- /dev/null
+++ b/src/local-lib/lisp-fixup.lisp
@@ -0,0 +1,58 @@
+(defpackage lisp-fixup
+ (:use :cl)
+ (:export :partial :compose :drop :slurp-bytes :slurp-utf-8))
+
+(in-package :lisp-fixup)
+
+
+;; https://www.n16f.net/blog/reading-files-faster-in-common-lisp/
+(defun slurp-bytes (path)
+ (declare (type (or pathname string) path))
+ (let ((data (make-array 0 :element-type '(unsigned-byte 8) :adjustable t))
+ (block-size 4096)
+ (offset 0))
+ (with-open-file (file path :element-type '(unsigned-byte 8))
+ (loop
+ (let* ((capacity (array-total-size data))
+ (nb-left (- capacity offset)))
+ (when (< nb-left block-size)
+ (let ((new-length (max (+ capacity (- block-size nb-left))
+ (floor (* capacity 3) 2))))
+ (setf data (adjust-array data new-length)))))
+ (let ((end (read-sequence data file :start offset)))
+ (when (= end offset)
+ (return-from slurp-bytes (adjust-array data end)))
+ (setf offset end))))))
+
+(defun slurp-utf-8 (path)
+ (trivial-utf-8:utf-8-bytes-to-string (slurp-bytes path)))
+
+(defun drop (n lst)
+ "Returns a sequence that skips the first N elements of the given list."
+ (cond ((or (null lst) (<= n 0)) lst)
+ ((> n 0) (drop (1- n) (cdr lst)))))
+
+(defun partial (f &rest args)
+ (lambda (&rest rst-args)
+ (apply f (concatenate 'list args rst-args))))
+
+(defun compose (&rest functions)
+ "Compose FUNCTIONS right-associatively, returning a function"
+ #'(lambda (x)
+ (reduce #'funcall functions
+ :initial-value x
+ :from-end t)))
+
+(defun fix-timestamp (timestamp)
+ "Fixes timestamps returned from postmodern to a json-format elm can parse"
+ (multiple-value-bind (year month day hour minute second millisec)
+ (simple-date:decode-timestamp timestamp)
+ (let ((obj (make-hash-table :test 'equal :size 7)))
+ (setf (gethash "year" obj) year)
+ (setf (gethash "month" obj) month)
+ (setf (gethash "day" obj) day)
+ (setf (gethash "hour" obj) hour)
+ (setf (gethash "minute" obj) minute)
+ (setf (gethash "second" obj) second)
+ (setf (gethash "millisec" obj) millisec)
+ obj)))
diff --git a/src/main.lisp b/src/main.lisp
index e6f50da..3f0cb5b 100644
--- a/src/main.lisp
+++ b/src/main.lisp
@@ -1,6 +1,19 @@
(defpackage murja
(:use :cl)
- (:import-from :murja.posts.post-db :test))
+ (:import-from :murja.posts.post-db))
-(format t "Loaded murja, calling inner fns: ~a~%" (test 3))
-
+(in-package :murja)
+
+(defvar *server* nil)
+(setf hunchentoot:*catch-errors-p* nil)
+
+(defun start-server (&key (port 3010))
+ (format t "Starting murja server~%")
+ (let ((server (make-instance 'easy-routes:easy-routes-acceptor :port port)))
+ (when (equalp 3010 port)
+ (setf *server* server))
+ (hunchentoot:start server)
+ (format t "Started murja server on ~a ~%" port)
+ server))
+
+;;(start-server :port 3010)
diff --git a/src/middleware/auth.lisp b/src/middleware/auth.lisp
new file mode 100644
index 0000000..6eb9acb
--- /dev/null
+++ b/src/middleware/auth.lisp
@@ -0,0 +1,38 @@
+(defpackage murja.middleware.auth
+ (:use :cl :postmodern)
+ (:import-from :murja.users.user-db :get-user-by-id)
+ (:export :*user* :@can?))
+
+(in-package :murja.middleware.auth)
+
+(defvar *user* nil
+ "A special variable for storing the logged in user (as defined in the db)")
+
+(defun @authenticated (next)
+ (let ((user-id (hunchentoot:session-value :logged-in-user-id)))
+ (if user-id
+ (let ((user (get-user-by-id user-id)))
+ (if (and user
+ (string= (hunchentoot:session-value :logged-in-username)
+ (gethash "username" user)))
+ (let ((*user* user))
+ (funcall next))
+ (progn
+ (setf (hunchentoot:return-code*) 401)
+ "not authorized")))
+ (progn
+ (setf (hunchentoot:return-code*) 401)
+ "not authorized"))))
+
+(defun @can? (ability next)
+ (if (and *user*
+ (member ability
+ (gethash "permissions" *user*)
+ :test #'string=))
+ (funcall next)
+ (progn
+ (setf (hunchentoot:return-code*) 401)
+ (format nil "you need to be able to ~a" ability))))
+
+
+
diff --git a/src/middleware/db.lisp b/src/middleware/db.lisp
new file mode 100644
index 0000000..c015aef
--- /dev/null
+++ b/src/middleware/db.lisp
@@ -0,0 +1,31 @@
+(defpackage murja.middleware.db
+ (:use :cl :postmodern))
+
+(in-package :murja.middleware.db)
+
+(defun db-config ()
+ (list :db (or (sb-ext:posix-getenv "MURJA_DB")
+ "blogdb")
+ :username (or (sb-ext:posix-getenv "MURJA_DB_USER")
+ "blogadmin")
+ :password (or (sb-ext:posix-getenv "MURJA_DB_PASSWD")
+ "blog")
+ :host (or (sb-ext:posix-getenv "MURJA_DB_HOST")
+ "localhost")
+ :port (let ((port-str (sb-ext:posix-getenv "MURJA_DB_PORT")))
+ (if port-str
+ (parse-integer port-str)
+ 5432))))
+
+(defun @transaction (next)
+ (destructuring-bind (&key db username password host port) (db-config)
+ (with-connection (list db username password host :port port)
+
+ (with-schema (:blog :if-not-exist nil)
+ (handler-bind ((cl-postgres:database-error
+ (lambda (c)
+ (format t "Error from db: ~a~%" c)
+ (setf (hunchentoot:return-code*) 500)
+ "Internal Server Error")))
+ (with-transaction ()
+ (funcall next)))))))
diff --git a/src/middleware/json.lisp b/src/middleware/json.lisp
new file mode 100644
index 0000000..ab95f21
--- /dev/null
+++ b/src/middleware/json.lisp
@@ -0,0 +1,8 @@
+(defpackage murja.middleware.json
+ (:use :cl))
+
+(in-package :murja.middleware.json)
+
+(defun @json (next)
+ (setf (hunchentoot:content-type*) "application/json")
+ (funcall next))
diff --git a/src/posts/post-db.lisp b/src/posts/post-db.lisp
index fda09e3..dbd1c8a 100644
--- a/src/posts/post-db.lisp
+++ b/src/posts/post-db.lisp
@@ -1,7 +1,32 @@
(defpackage :murja.posts.post-db
- (:use :cl)
- (:export :test))
+ (:use :cl :postmodern)
+ (:import-from :com.inuoe.jzon :parse)
+ (:import-from :halisql :defqueries)
+ (:import-from :lisp-fixup :fix-timestamp)
+ (:export :get-page :get-titles-by-year))
-(defun test (a)
- (* a a ))
-
+(in-package :murja.posts.post-db)
+
+(defqueries "post-fns")
+
+(defun get-titles-by-year (&key allow-hidden?)
+ (mapcar (lambda (title)
+
+ (when (gethash "Tags" title)
+ (setf (gethash "Tags" title)
+ (parse (gethash "Tags" title))))
+ title)
+ (coerce
+ (get-titles-by-year* allow-hidden?) 'list)))
+
+(defun get-page (page page-size &key allow-hidden?)
+ (mapcar (lambda (post)
+ (dolist (key (list "creator" "tags"))
+ (setf (gethash key post)
+ (parse (gethash key post))))
+
+ (setf (gethash "created_at" post)
+ (fix-timestamp (gethash "created_at" post)))
+ post)
+ (coerce
+ (get-page* page page-size allow-hidden?) 'list)))
diff --git a/src/routes/login-routes.lisp b/src/routes/login-routes.lisp
new file mode 100644
index 0000000..1bc92bb
--- /dev/null
+++ b/src/routes/login-routes.lisp
@@ -0,0 +1,35 @@
+(defpackage murja.routes.login-routes
+ (:use :cl)
+ (:import-from :murja.middleware.auth :@authenticated)
+ (:import-from :murja.middleware.db :@transaction)
+
+ (:import-from :murja.middleware.json :@json)
+ (:import-from :easy-routes :defroute)
+ (:import-from :com.inuoe.jzon :parse))
+
+(in-package :murja.routes.login-routes)
+
+(defroute post-login ("/api/login" :method :post :decorators (@transaction @json)) ()
+ (let* ((body-params (parse (hunchentoot:raw-post-data :force-text t)))
+ (username (gethash "username" body-params))
+ (password (gethash "password" body-params))
+ (user-row (select-user-by-login username (sha-512 password))))
+ (if (and user-row
+ (string= (gethash "username" user-row) username))
+ (progn
+ (setf (hunchentoot:session-value :logged-in-username) username)
+ (setf (hunchentoot:session-value :logged-in-user-id) (gethash "id" user-row))
+ (stringify data-for-frontend))
+
+ (progn
+ (setf (hunchentoot:return-code*) 401)
+ "not authorized"))))
+
+(defroute api-session ("/api/login/session" :method :get :decorators (@transaction
+ @json
+ @authenticated)) ()
+ (if *user*
+ (com.inuoe.jzon:stringify *user*)
+ (progn
+ (setf (hunchentoot:return-code*) 401)
+ nil)))
diff --git a/src/routes/post-routes.lisp b/src/routes/post-routes.lisp
new file mode 100644
index 0000000..d8c7597
--- /dev/null
+++ b/src/routes/post-routes.lisp
@@ -0,0 +1,31 @@
+(defpackage murja.routes.post-routes
+ (:use :cl)
+ (:import-from :com.inuoe.jzon :stringify)
+ (:import-from :murja.middleware.db :@transaction)
+ (:import-from :murja.posts.post-db :get-page :get-titles-by-year)
+
+ (:import-from :murja.middleware.json :@json)
+ (:import-from :easy-routes :defroute))
+
+(in-package :murja.routes.post-routes)
+
+(defroute title-routes ("/api/posts/titles" :method :get
+ :decorators (@json @transaction)) ()
+ (let ((titles (get-titles-by-year)))
+ (stringify titles)))
+
+
+(defroute get-page-route ("/api/posts/page/:page/page-size/:page-size" :method :get
+ :decorators (@json @transaction))
+ (&path (page 'integer)
+ &path (page-size 'integer))
+ (let* ((page (1- page))
+ (posts (murja.posts.post-db:get-page page page-size))
+ (id page)
+ (last-page? (zerop (length (murja.posts.post-db:get-page (1+ page) page-size))))
+ (result (make-hash-table)))
+ (setf (gethash "id" result) id)
+ (setf (gethash "posts" result) posts)
+ (setf (gethash "last-page?" result) last-page?)
+
+ (com.inuoe.jzon:stringify result)))
diff --git a/src/routes/root-routes.lisp b/src/routes/root-routes.lisp
new file mode 100644
index 0000000..e56533b
--- /dev/null
+++ b/src/routes/root-routes.lisp
@@ -0,0 +1,87 @@
+(defpackage murja.routes.root-routes
+ (:use :cl)
+ (:import-from :binding-arrows :->> :->)
+ (:import-from :lisp-fixup :partial)
+ (:import-from :murja.middleware.db :@transaction)
+
+ (:import-from :murja.middleware.json :@json)
+ (:import-from :easy-routes :defroute))
+
+(in-package :murja.routes.root-routes)
+
+(defparameter *allowed-resources*
+ (let ((result nil))
+ (cl-fad:walk-directory
+ (asdf:system-relative-pathname halisql:*system-name*
+ "resources/")
+ (lambda (n)
+ (push n result))
+ :directories nil
+ )
+
+ (reduce (lambda (hash path)
+ (let ((filename (file-namestring path)))
+ (setf (gethash (if (string= "elm.js" filename)
+ "murja.js"
+ filename)
+ hash)
+ path)
+ hash))
+ (->> result
+ (mapcar (partial #'format nil "~a"))
+ (remove-if (partial #'str:ends-with-p "~"))
+ (remove-if (partial #'str:ends-with-p ".sql"))
+ (mapcar #'pathname))
+ :initial-value (make-hash-table :test 'equalp))))
+
+(define-condition unknown-mime (error)
+ ((file-type :initarg :file-type
+ :initform nil
+ :accessor file-type))
+ ;; the :report is the message into the debugger:
+ (:report (lambda (condition stream)
+ (format stream
+ "Don't know how to transform file of type ~a to a mime type"
+ (file-type condition)))))
+
+(defun path->mime (path)
+ (let ((type (pathname-type path)))
+ (cond ((string= type "js") "text/javascript")
+ ((string= type "css") "text/css")
+ (t (error 'unknown-mime :file-type type)))))
+
+(defroute client-settings ("/api/settings/client-settings" :method :get
+ :decorators (@json)) ()
+ "{\"time-format\":\"dd.MM.yyyy HH:mm\",\"blog-title\":\"Murja.dev @ $HOSTNAME\",\"recent-post-count\":6,\"xss-filter-posts?\":false}")
+
+(defroute resources ("/resources/:file" :method :get) ()
+ (let ((path (gethash file *allowed-resources*)))
+ (if path
+ (let ((source (lisp-fixup:slurp-utf-8 path)))
+ (setf (hunchentoot:content-type*) (path->mime path))
+ source)
+ (progn
+ (setf (hunchentoot:return-code*) 404)
+ ""))))
+
+(defroute root ("/" :method :get) ()
+ ;; (let ((css-file (asdf:system-relative-pathname halisql:*system-name*
+ ;; "resources/css/murja.css"))
+ ;; (js-file (asdf:system-relative-pathname halisql:*system-name*
+ ;; "resources/js/murja.js")))
+"<!DOCTYPE html>
+<html xmlns:of=\"http://ogp.me/ns#\"
+ xmlns:fb=\"http://www.facebook.com/2008/fbml\">
+ <head>
+ <link href=\"/resources/murja.css\" rel=\"stylesheet\" type=\"text/css\">
+ <script src=\"https://unpkg.com/ace-custom-element@latest/dist/index.min.js\" type=\"module\"></script>
+ <meta charset=\"UTF-8\" />
+ <script src=\"/resources/murja.js\"></script>
+ </head>
+ <body>
+ <script src=\"resources/murja-helper.js\"></script>
+ <div id=\"#app\" />
+ </body>
+</html>")
+
+
diff --git a/src/users/user-db.lisp b/src/users/user-db.lisp
new file mode 100644
index 0000000..e892cd9
--- /dev/null
+++ b/src/users/user-db.lisp
@@ -0,0 +1,22 @@
+(defpackage :murja.users.user-db
+ (:use :cl :postmodern)
+ (:import-from :halisql :defqueries))
+
+(in-package :murja.users.user-db)
+
+(defqueries "user-fns")
+
+(defun jsonize-key (hash key)
+ (setf (gethash key hash)
+ (coerce
+ (com.inuoe.jzon:parse (gethash key hash))
+ 'list))
+ hash)
+
+(defun get-user-by-id (id)
+ (jsonize-key (aref (get-user-by-id* id) 0) "permissions"))
+
+(defun select-user-by-login (username password-sha)
+ (jsonize-key (aref (query-users* username password-sha) 0) "permissions"))
+
+ ;;(postmodern:connect-toplevel "blogdb" "blogadmin" "blog" "localhost")