src/routes/root-routes.lisp

DOWNLOAD
(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))