Tom Willemse
bb2f75ec1c
When selecting the task to replace the task with based on priority, be sure to limit the options to tasks with the same story id.
281 lines
11 KiB
Common Lisp
281 lines
11 KiB
Common Lisp
;; scrumli --- A simple scrum web application
|
|
;; Copyright (C) 2013 Tom Willemse
|
|
|
|
;; scrumli is free software: you can redistribute it and/or modify
|
|
;; it under the terms of the GNU Affero General Public License as published by
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
;; (at your option) any later version.
|
|
|
|
;; scrumli is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU Affero General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU Affero General Public License
|
|
;; along with scrumli. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
(in-package #:scrumli)
|
|
|
|
(defvar *scrumli-host* "http://localhost:5000"
|
|
"The host currently running Scrumli. Used by Mozilla Persona.")
|
|
|
|
(defvar *scrumli-bootstrap-css-location*
|
|
"//netdna.bootstrapcdn.com/twitter-bootstrap/2.3.2/css/bootstrap-combined.no-icons.min.css"
|
|
"The location of the twitter bootstrap CSS file.")
|
|
|
|
(defvar *scrumli-bootstrap-js-location*
|
|
"//netdna.bootstrapcdn.com/twitter-bootstrap/2.3.2/js/bootstrap.min.js"
|
|
"The location of the twitter bootstrap JS file.")
|
|
|
|
(defvar *scrumli-font-awesome-css-location*
|
|
"//netdna.bootstrapcdn.com/font-awesome/3.1.1/css/font-awesome.min.css"
|
|
"The location of the font awesome CSS file.")
|
|
|
|
(defvar *scrumli-jquery-js-location*
|
|
"//code.jquery.com/jquery-2.0.0.min.js"
|
|
"The location of the jQuery JS file.")
|
|
|
|
(defvar *scrumli-react-js-location*
|
|
"//cdnjs.cloudflare.com/ajax/libs/react/0.3.2/react.min.js"
|
|
"The location of the React JS file.")
|
|
|
|
(defvar *scrumli-jsxtransformer-js-location*
|
|
"//cdnjs.cloudflare.com/ajax/libs/react/0.3.2/JSXTransformer.js"
|
|
"The location of the JSX Transformer JS file.")
|
|
|
|
(defun logged-in-p ()
|
|
(gethash :username (getf (env *request*) :clack.session)))
|
|
|
|
(defun page-title (title)
|
|
(concatenate 'string title " | scrumli"))
|
|
|
|
(defun md5-hash (str)
|
|
(string-downcase (format nil "~{~2,'0x~}"
|
|
(coerce (md5:md5sum-string str) 'list))))
|
|
|
|
(defun verify-credentials (audience assertion)
|
|
(let ((response
|
|
(http-request "https://verifier.login.persona.org/verify"
|
|
:method :post :content-type "application/json"
|
|
:content (encode-json-to-string
|
|
`(("assertion" . ,assertion)
|
|
("audience" . ,audience)))
|
|
:want-stream t)))
|
|
(decode-json response)))
|
|
|
|
(defclass scrumli-app (<app>) ())
|
|
|
|
(defvar *app* (make-instance 'scrumli-app))
|
|
|
|
(defun make-tpl-parameters (&rest args)
|
|
(append (list :prefix (script-name *request*)) args))
|
|
|
|
(defun story-list-page (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"))))
|
|
|
|
(defun login-page (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*)))))
|
|
|
|
(defun login-page/post (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))))
|
|
|
|
(defun logout (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")))
|
|
|
|
(defun stories-json (params)
|
|
(declare (ignore params))
|
|
(if (logged-in-p)
|
|
(list 200 '(:content-type "text/json")
|
|
(encode-json-to-string (get-all-stories)))
|
|
'(403)))
|
|
|
|
(defun user-stories-json (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)))
|
|
|
|
(defun add-story-json/post (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)))
|
|
|
|
(defun add-task-json/post (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)))
|
|
|
|
(defun story-set-state-json/post (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)))
|
|
|
|
(defun task-set-state-json/post (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)))
|
|
|
|
(defun story-move-json/post (params)
|
|
(if (logged-in-p)
|
|
(let ((id (getf params :|id|))
|
|
(dir (getf params :dir)))
|
|
(story-change-priority id (intern (string-upcase dir) :keyword))
|
|
(list 200 '(:content-type "text/json")
|
|
(encode-json-to-string '((status . "ok")))))
|
|
'(403)))
|
|
|
|
(defun task-move-json/post (params)
|
|
(if (logged-in-p)
|
|
(let ((id (getf params :|id|))
|
|
(dir (getf params :dir)))
|
|
(task-change-priority id (intern (string-upcase dir) :keyword))
|
|
(list 200 '(:content-type "text/json")
|
|
(encode-json-to-string '((status . "ok")))))
|
|
'(403)))
|
|
|
|
(defun story-json (params)
|
|
(if (logged-in-p)
|
|
(list 200 '(:content-type "text/json")
|
|
(encode-json-to-string (get-story (getf params :id))))
|
|
'(403)))
|
|
|
|
(defun story-set-assignee/post (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)))
|
|
|
|
(defun task-set-assignee/post (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)))
|
|
|
|
(defun lisp->js-bridge (params)
|
|
(declare (ignore params))
|
|
(list 200 '(:content-type "text/javascript")
|
|
(ps (var base-url (lisp (if (equal (script-name *request*) "")
|
|
"/" (script-name *request*)))))))
|
|
|
|
(setf (route *app* "/") #'story-list-page)
|
|
(setf (route *app* "/login") #'login-page)
|
|
(setf (route *app* "/login" :method :post) #'login-page/post)
|
|
(setf (route *app* "/logout") #'logout)
|
|
(setf (route *app* "/stories") #'stories-json)
|
|
(setf (route *app* "/stories/mine") #'user-stories-json)
|
|
(setf (route *app* "/stories/new" :method :post) #'add-story-json/post)
|
|
(setf (route *app* "/stories/tasks/new" :method :post) #'add-task-json/post)
|
|
(setf (route *app* "/stories/state" :method :post) #'story-set-state-json/post)
|
|
(setf (route *app* "/tasks/state" :method :post) #'task-set-state-json/post)
|
|
(setf (route *app* "/stories/:dir" :method :post) #'story-move-json/post)
|
|
(setf (route *app* "/tasks/:dir" :method :post) #'task-move-json/post)
|
|
(setf (route *app* "/stories/:id") #'story-json)
|
|
(setf (route *app* "/story/assignee" :method :post) #'story-set-assignee/post)
|
|
(setf (route *app* "/task/assignee" :method :post) #'task-set-assignee/post)
|
|
(setf (route *app* "/js/bridge.js") #'lisp->js-bridge)
|
|
|
|
(defun get-app ()
|
|
(builder
|
|
(<clack-middleware-static>
|
|
:path "/static/"
|
|
:root (merge-pathnames #P"static/" scrumli-config:*base-directory*))
|
|
(<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*))
|