src/routes/root-routes.lisp
(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)
(:local-nicknames (:user-db :murja.users.user-db)))
(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 get-resource (file)
;; there are not other resources beside murja.css anymore, and I'd love to get rid of it too
(when (equalp file "murja.css")
(let ((path (gethash file *allowed-resources*)))
(if path
(let ((source (lisp-fixup:slurp-utf-8 path)))
(setf (hunchentoot:content-type*) "text/css")
source)
(progn
(setf (hunchentoot:return-code*) 404)
"")))))
(defroute resources ("/resources/:file" :method :get) ()
(get-resource file))