aboutsummaryrefslogtreecommitdiffstats
path: root/scrumli.lisp
diff options
context:
space:
mode:
Diffstat (limited to 'scrumli.lisp')
-rw-r--r--scrumli.lisp363
1 files changed, 206 insertions, 157 deletions
diff --git a/scrumli.lisp b/scrumli.lisp
index 76eff35..bd786a8 100644
--- a/scrumli.lisp
+++ b/scrumli.lisp
@@ -16,7 +16,7 @@
(in-package #:scrumli)
-(defvar *scrumli-host* "http://localhost:8080"
+(defvar *scrumli-host* "http://localhost:5000"
"The host currently running Scrumli. Used by Mozilla Persona.")
(defvar *scrumli-bootstrap-css-location*
@@ -44,7 +44,7 @@
"The location of the JSX Transformer JS file.")
(defun logged-in-p ()
- (hunchentoot:session-value :username))
+ (gethash :username (getf (env *request*) :clack.session)))
(defun page-title (title)
(concatenate 'string title " | scrumli"))
@@ -53,127 +53,6 @@
(string-downcase (format nil "~{~2,'0x~}"
(coerce (md5:md5sum-string str) 'list))))
-(define-route main ("")
- (if (logged-in-p)
- (scrumli-templates:main
- `(:title ,(page-title "Backlog")
- :csss ,(list *scrumli-bootstrap-css-location*
- *scrumli-font-awesome-css-location*
- (genurl 'scrumli-css))
- :jss ,(list *scrumli-jquery-js-location*
- *scrumli-bootstrap-js-location*
- *scrumli-react-js-location*
- *scrumli-jsxtransformer-js-location*)
- :username ,(hunchentoot:session-value :username)
- :usermd5 ,(md5-hash (hunchentoot:session-value :username))
- :ulogout ,(genurl 'logout-page)
- :umainjs ,(genurl 'main-js)))
- (redirect 'login-page)))
-
-(defmacro serve-static (name relpath)
- `(define-route ,name (,relpath :content-type "application/ecmascript")
- (merge-pathnames ,relpath *static-directory*)))
-
-(serve-static main-js "js/main.js")
-(serve-static login-js "js/login.js")
-(serve-static scrumli-css "css/scrumli.css")
-
-(define-route stories-json ("stories" :content-type "text/json")
- (if (logged-in-p)
- (encode-json-to-string (get-all-stories))
- 403))
-
-(define-route my-stories-json ("stories/mine" :content-type "text/json")
- (if (logged-in-p)
- (encode-json-to-string (get-stories-for
- (hunchentoot:session-value :username)))
- 403))
-
-(defmacro with-post-parameters (parameters &body body)
- `(let ,(mapcar (lambda (p)
- (list (intern (string-upcase p))
- `(hunchentoot:post-parameter ,p)))
- parameters)
- ,@body))
-
-(define-route stories-new ("stories/new" :method :post
- :content-type "text/json")
- (if (logged-in-p)
- (with-post-parameters ("role" "necessity" "headline" "content")
- (post-story role necessity headline content
- (hunchentoot:session-value :username))
- (encode-json-to-string '((status . "ok"))))
- 403))
-
-(define-route tasks-new ("stories/tasks/new" :method :post
- :content-type "text/json")
- (if (logged-in-p)
- (with-post-parameters ("storyId" "description")
- (post-task storyid description
- (hunchentoot:session-value :username))
- (encode-json-to-string '((status . "ok"))))
- 403))
-
-(define-route stories-state ("stories/state" :method :post
- :content-type "text/json")
- (if (logged-in-p)
- (let* ((id (hunchentoot:post-parameter "id"))
- (current-state (story-get-state 'story id))
- (next (ecase (intern current-state :scrumli)
- (todo "DOING")
- (doing "DONE")
- (done "TODO"))))
- (story-set-state 'story id next)
- (encode-json-to-string `((status . "ok") (state . ,next))))
- 403))
-
-(define-route task-state ("tasks/state" :method :post
- :content-type "text/json")
- (if (logged-in-p)
- (let* ((id (hunchentoot:post-parameter "id"))
- (current-state (story-get-state 'task id))
- (next (ecase (intern current-state :scrumli)
- (todo "DOING")
- (doing "DONE")
- (done "TODO"))))
- (story-set-state 'task id next)
- (encode-json-to-string `((status . "ok") (state . ,next))))
- 403))
-
-(define-route stories-priority ("stories/:dir" :method :post
- :content-type "text/json")
- (if (logged-in-p)
- (let* ((id (hunchentoot:post-parameter "id")))
- (story-change-priority
- 'story id (intern (string-upcase dir) :keyword))
- (encode-json-to-string '((status . "ok"))))
- 403))
-
-(define-route task-priority ("tasks/:dir" :method :post
- :content-type "text/json")
- (if (logged-in-p)
- (let* ((id (hunchentoot:post-parameter "id")))
- (story-change-priority
- 'task id (intern (string-upcase dir) :keyword))
- (encode-json-to-string '((status . "ok"))))
- 403))
-
-(define-route login-page ("login")
- (if (not (logged-in-p))
- (scrumli-templates:login
- `(:title ,(page-title "Login")
- :csss ,(list *scrumli-bootstrap-css-location*
- *scrumli-font-awesome-css-location*)
- :jss ,(list *scrumli-bootstrap-js-location*
- "https://login.persona.org/include.js"
- (genurl 'login-js))))
- (redirect 'main)))
-
-(define-route logout-page ("logout")
- (if (logged-in-p)
- (setf (hunchentoot:session-value :username) nil))
- (redirect 'login-page))
-
(defun verify-credentials (audience assertion)
(let ((response
(http-request "https://verifier.login.persona.org/verify"
@@ -184,37 +63,207 @@
:want-stream t)))
(decode-json response)))
-(define-route login-page/post ("login" :method :post)
- (let ((result (verify-credentials
- *scrumli-host*
- (hunchentoot:post-parameter "assertion"))))
- (if (equal (cdr (assoc :status result)) "okay")
- (progn
- (hunchentoot:start-session)
- (setf (hunchentoot:session-value :username)
- (cdr (assoc :email result)))
- (redirect 'main))
- 403)))
-
-(define-route scrumli-story ("stories/:id" :content-type "json")
- (if (logged-in-p)
- (encode-json-to-string (get-story id))
- 403))
-
-(define-route scrumli-story-set-assignee ("story/assignee"
- :content-type "json"
- :method :post)
- (if (logged-in-p)
- (with-post-parameters ("id" "assignee")
- (set-assignee 'story id assignee)
- (encode-json-to-string '((status . "ok"))))
- 403))
-
-(define-route scrumli-task-set-assignee ("tasks/assignee"
- :content-type "json"
- :method :post)
- (if (logged-in-p)
- (with-post-parameters ("id" "assignee")
- (set-assignee 'task id assignee)
- (encode-json-to-string '((status . "ok"))))
- 403))
+(defclass scrumli-app (<app>) ())
+
+(defvar *app* (make-instance 'scrumli-app))
+
+(defun make-tpl-parameters (&rest args)
+ (append (list :prefix (script-name *request*)) args))
+
+(setf (route *app* "/")
+ (lambda (params)
+ (declare (ignore params))
+ (if (logged-in-p)
+ (scrumli-templates:main
+ (make-tpl-parameters
+ :title (page-title "Backlog")
+ :csss (list *scrumli-bootstrap-css-location*
+ *scrumli-font-awesome-css-location*
+ (concatenate 'string (script-name *request*) "static/css/scrumli.css"))
+ :jss (list *scrumli-jquery-js-location*
+ *scrumli-bootstrap-js-location*
+ *scrumli-react-js-location*
+ *scrumli-jsxtransformer-js-location*
+ (concatenate 'string (script-name *request*) "js/bridge.js"))
+ :username (gethash :username (getf (env *request*) :clack.session))
+ :usermd5 (md5-hash (gethash :username (getf (env *request*) :clack.session)))
+ :ulogout (concatenate 'string (script-name *request*) "logout")
+ :umainjs (concatenate 'string (script-name *request*) "static/js/main.js")))
+ (redirect *response*
+ (concatenate 'string (script-name *request*)
+ "login")))))
+
+(setf (route *app* "/login")
+ (lambda (params)
+ (declare (ignore params))
+ (if (not (logged-in-p))
+ (scrumli-templates:login
+ (make-tpl-parameters
+ :title (page-title "Login")
+ :csss (list *scrumli-bootstrap-css-location*
+ *scrumli-font-awesome-css-location*)
+ :jss (list *scrumli-bootstrap-js-location*
+ "https://login.persona.org/include.js"
+ (concatenate 'string (script-name *request*)
+ "js/bridge.js")
+ (concatenate 'string (script-name *request*)
+ "static/js/login.js"))))
+ (redirect *response* (if (equal (script-name *request*) "")
+ "/" (script-name *request*))))))
+
+(setf (route *app* "/login" :method :post)
+ (lambda (params)
+ (let ((result (verify-credentials
+ *scrumli-host* (getf params :|assertion|))))
+ (if (equal (cdr (assoc :status result)) "okay")
+ (progn
+ (setf (gethash :username
+ (getf (env *request*) :clack.session))
+ (cdr (assoc :email result)))
+ (redirect *response*
+ (if (equal (script-name *request*) "")
+ "/" (script-name *request*))))
+ '(403)))))
+
+(setf (route *app* "/logout")
+ (lambda (params)
+ (declare (ignore params))
+ (if (logged-in-p)
+ (setf (gethash :username
+ (getf (env *request*) :clack.session)) nil))
+ (redirect *response* (concatenate 'string (script-name *request*)
+ "login"))))
+
+(setf (route *app* "/stories")
+ (lambda (params)
+ (declare (ignore params))
+ (if (logged-in-p)
+ (list 200 '(:content-type "text/json")
+ (encode-json-to-string (get-all-stories)))
+ '(403))))
+
+(setf (route *app* "/stories/mine")
+ (lambda (params)
+ (declare (ignore params))
+ (if (logged-in-p)
+ (list 200 '(:content-type "text/json")
+ (encode-json-to-string
+ (get-stories-for
+ (gethash :username (getf (env *request*) :clack.session)))))
+ '(403))))
+
+(setf (route *app* "/stories/new" :method :post)
+ (lambda (params)
+ (if (logged-in-p)
+ (let ((role (getf params :|role|))
+ (necessity (getf params :|necessity|))
+ (headline (getf params :|headline|))
+ (content (getf params :|content|)))
+ (post-story role necessity headline content
+ (gethash :username (getf (env *request*) :clack.session)))
+ (list 200 '(:content-type "text/json")
+ (encode-json-to-string '((status . "ok")))))
+ '(403))))
+
+(setf (route *app* "/stories/tasks/new" :method :post)
+ (lambda (params)
+ (if (logged-in-p)
+ (let ((story-id (getf params :|storyId|))
+ (description (getf params :|description|)))
+ (post-task story-id description
+ (gethash :username (getf (env *request*) :clack.session)))
+ (list 200 '(:content-type "text/json")
+ (encode-json-to-string '((status . "ok")))))
+ '(403))))
+
+(setf (route *app* "/stories/state" :method :post)
+ (lambda (params)
+ (if (logged-in-p)
+ (let* ((id (getf params :|id|))
+ (current-state (story-get-state 'story id))
+ (next (ecase (intern current-state :scrumli)
+ (todo "DOING")
+ (doing "DONE")
+ (done "TODO"))))
+ (story-set-state 'story id next)
+ (list 200 '(:content-type "text/json")
+ (encode-json-to-string `((status . "ok")
+ (state . ,next)))))
+ '(403))))
+
+(setf (route *app* "/tasks/state" :method :post)
+ (lambda (params)
+ (if (logged-in-p)
+ (let* ((id (getf params :|id|))
+ (current-state (story-get-state 'task id))
+ (next (ecase (intern current-state :scrumli)
+ (todo "DOING")
+ (doing "DONE")
+ (done "TODO"))))
+ (story-set-state 'task id next)
+ (list 200 '(:content-type "text/json")
+ (encode-json-to-string `((status . "ok")
+ (state . ,next)))))
+ '(403))))
+
+(setf (route *app* "/stories/:dir" :method :post)
+ (lambda (params)
+ (if (logged-in-p)
+ (let ((id (getf params :|id|))
+ (dir (getf params :dir)))
+ (story-change-priority
+ 'story id (intern (string-upcase dir) :keyword))
+ (list 200 '(:content-type "text/json")
+ (encode-json-to-string '((status . "ok")))))
+ '(403))))
+
+(setf (route *app* "/tasks/:dir" :method :post)
+ (lambda (params)
+ (if (logged-in-p)
+ (let ((id (getf params :|id|)))
+ (story-change-priority
+ 'task id (intern (string-upcase (getf params :dir)) :keyword))
+ (list 200 '(:content-type "text/json")
+ (encode-json-to-string '((status . "ok")))))
+ '(403))))
+
+(setf (route *app* "/stories/:id")
+ (lambda (params)
+ (if (logged-in-p)
+ (list 200 '(:content-type "text/json")
+ (encode-json-to-string (get-story (getf params :id))))
+ '(403))))
+
+(setf (route *app* "/story/assignee" :method :post)
+ (lambda (params)
+ (if (logged-in-p)
+ (progn
+ (set-assignee 'story (getf params :|id|) (getf params :|assignee|))
+ (list 200 '(:content-type "text/json")
+ (encode-json-to-string '((status . "ok")))))
+ '(403))))
+
+(setf (route *app* "/task/assignee" :method :post)
+ (lambda (params)
+ (if (logged-in-p)
+ (progn
+ (set-assignee 'task (getf params :|id|) (getf params :|assignee|))
+ (list 200 '(:content-type "text/json")
+ (encode-json-to-string '((status . "ok")))))
+ '(403))))
+
+(setf (route *app* "/js/bridge.js")
+ (lambda (params)
+ (declare (ignore params))
+ (list 200 '(:content-type "text/javascript")
+ (ps (var base-url (lisp (if (equal (script-name *request*) "")
+ "/" (script-name *request*))))))))
+
+(defun get-app ()
+ (builder
+ (<clack-middleware-static> :path "/static/" :root "static/")
+ (<clack-middleware-session>
+ :state (make-instance 'clack.session.state.cookie:<clack-session-state-cookie>))
+ (<clack-middleware-postmodern>
+ :database "scrumli" :user "slash" :password nil :host "localhost")
+ *app*))