scrumli/scrumli.lisp

194 lines
7.1 KiB
Common Lisp
Raw Normal View History

2013-06-30 22:38:05 +02:00
(in-package #:scrumli)
(defvar *scrumli-host* "http://localhost:8080"
"The host currently running Scrumli. Used by Mozilla Persona.")
2013-07-05 23:22:25 +02:00
(defvar *scrumli-bootstrap-css-location*
2013-06-30 22:38:05 +02:00
"http://netdna.bootstrapcdn.com/twitter-bootstrap/2.3.2/css/bootstrap-combined.no-icons.min.css"
"The location of the twitter bootstrap CSS file.")
2013-07-05 23:22:25 +02:00
(defvar *scrumli-bootstrap-js-location*
2013-06-30 22:38:05 +02:00
"http://netdna.bootstrapcdn.com/twitter-bootstrap/2.3.2/js/bootstrap.min.js"
"The location of the twitter bootstrap JS file.")
2013-07-05 23:22:25 +02:00
(defvar *scrumli-font-awesome-css-location*
2013-06-30 22:38:05 +02:00
"http://netdna.bootstrapcdn.com/font-awesome/3.1.1/css/font-awesome.min.css"
"The location of the font awesome CSS file.")
2013-07-05 23:22:25 +02:00
(defvar *scrumli-jquery-js-location*
2013-06-30 22:38:05 +02:00
"http://code.jquery.com/jquery-2.0.0.min.js"
"The location of the jQuery JS file.")
2013-07-05 23:22:25 +02:00
(defvar *scrumli-react-js-location*
2013-06-30 22:38:05 +02:00
"http://cdnjs.cloudflare.com/ajax/libs/react/0.3.2/react.min.js"
"The location of the React JS file.")
2013-07-05 23:22:25 +02:00
(defvar *scrumli-jsxtransformer-js-location*
2013-06-30 22:38:05 +02:00
"http://cdnjs.cloudflare.com/ajax/libs/react/0.3.2/JSXTransformer.js"
"The location of the JSX Transformer JS file.")
(defun logged-in-p ()
(hunchentoot:session-value :username))
(defun page-title (title)
2013-07-13 22:55:54 +02:00
(concatenate 'string title " | scrumli"))
2013-07-05 23:22:25 +02:00
(defun css (&rest sheets)
(apply 'concatenate 'string
(mapcar (lambda (s)
(<:link :href s :rel "stylesheet" :type "text/css"))
sheets)))
(defun js (&rest scripts)
(apply 'concatenate 'string
(mapcar (lambda (s)
(<:script :type "text/javascript" :src s))
scripts)))
(defmacro navbar (&body body)
`(<:div :class "navbar navbar-static-top navbar-inverse"
(<:div :class "navbar-inner"
(<:div :class "container"
(<:a :class "brand" "scrumli")
,@body))))
2013-06-30 22:38:05 +02:00
(define-route main ("")
(if (logged-in-p)
2013-07-13 22:55:54 +02:00
(scrumli-templates:main
`(:title ,(page-title "Backlog")
:csss ,(list *scrumli-bootstrap-css-location*
*scrumli-font-awesome-css-location*
(genurl 'scrumli-css))
2013-07-15 19:51:45 +02:00
:jss ,(list *scrumli-jquery-js-location*
*scrumli-bootstrap-js-location*
2013-07-13 22:55:54 +02:00
*scrumli-react-js-location*
*scrumli-jsxtransformer-js-location*)
:username ,(hunchentoot:session-value :username)
:ulogout ,(genurl 'logout-page)
:umainjs ,(genurl 'main-js)))
2013-06-30 22:38:05 +02:00
(redirect 'login-page)))
2013-07-05 23:22:25 +02:00
(defmacro serve-static (name relpath)
`(define-route ,name (,relpath :content-type "application/ecmascript")
(merge-pathnames ,relpath *static-directory*)))
2013-06-30 22:38:05 +02:00
2013-07-05 23:22:25 +02:00
(serve-static main-js "js/main.js")
(serve-static login-js "js/login.js")
2013-07-13 21:23:46 +02:00
(serve-static scrumli-css "css/scrumli.css")
2013-06-30 22:38:05 +02:00
(define-route stories-json ("stories" :content-type "text/json")
(if (logged-in-p)
2013-07-13 02:31:30 +02:00
(encode-json-to-string (get-all-stories))
2013-06-30 22:38:05 +02:00
403))
2013-07-05 23:22:25 +02:00
(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")
2013-06-30 22:38:05 +02:00
(if (logged-in-p)
2013-07-05 23:22:25 +02:00
(with-post-parameters ("role" "necessity" "headline" "content")
(post-story role necessity headline content
2013-06-30 22:38:05 +02:00
(hunchentoot:session-value :username))
2013-07-13 02:31:30 +02:00
(encode-json-to-string '((status . "ok"))))
2013-06-30 22:38:05 +02:00
403))
(define-route tasks-new ("stories/tasks/new" :method :post
:content-type "text/json")
2013-07-04 21:51:31 +02:00
(if (logged-in-p)
2013-07-05 23:22:25 +02:00
(with-post-parameters ("storyId" "description")
(post-task storyid description
(hunchentoot:session-value :username))
(encode-json-to-string '((status . "ok"))))
2013-07-04 21:51:31 +02:00
403))
2013-07-07 23:46:15 +02:00
(define-route stories-state ("stories/state" :method :post
:content-type "text/json")
2013-06-30 22:38:05 +02:00
(if (logged-in-p)
(let* ((id (hunchentoot:post-parameter "id"))
2013-07-07 23:46:15 +02:00
(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))))
2013-06-30 22:38:05 +02:00
403))
2013-07-13 02:31:30 +02:00
(define-route task-state ("tasks/state" :method :post
:content-type "text/json")
2013-07-04 23:55:43 +02:00
(if (logged-in-p)
(let* ((id (hunchentoot:post-parameter "id"))
2013-07-07 23:46:15 +02:00
(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))
2013-07-04 23:55:43 +02:00
2013-07-07 23:46:15 +02:00
(define-route stories-priority ("stories/:dir" :method :post
:content-type "text/json")
2013-06-30 22:38:05 +02:00
(if (logged-in-p)
(let* ((id (hunchentoot:post-parameter "id")))
2013-07-04 23:55:43 +02:00
(story-change-priority
'story id (intern (string-upcase dir) :keyword))
2013-07-07 23:46:15 +02:00
(encode-json-to-string '((status . "ok"))))
2013-07-04 23:55:43 +02:00
403))
(define-route task-priority ("tasks/:dir" :method :post
:content-type "text/json")
2013-07-04 23:55:43 +02:00
(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"))))
2013-06-30 22:38:05 +02:00
403))
(define-route login-page ("login")
(if (not (logged-in-p))
2013-07-13 22:55:54 +02:00
(scrumli-templates:login
`(:title ,(page-title "Login")
:csss ,(list *scrumli-bootstrap-css-location*)
:jss ,(list *scrumli-bootstrap-js-location*
"https://login.persona.org/include.js"
(genurl 'login-js))))
2013-06-30 22:38:05 +02:00
(redirect 'main)))
(define-route logout-page ("logout")
(if (logged-in-p)
2013-07-05 23:22:25 +02:00
(setf (hunchentoot:session-value :username) nil))
2013-06-30 22:38:05 +02:00
(redirect 'login-page))
(defun verify-credentials (audience assertion)
(let ((response
(http-request "https://verifier.login.persona.org/verify"
:method :post :content-type "application/json"
2013-07-13 02:31:30 +02:00
:content (encode-json-to-string
2013-06-30 22:38:05 +02:00
`(("assertion" . ,assertion)
("audience" . ,audience)))
: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)))
2013-07-13 02:31:30 +02:00
(define-route scrumli-story ("stories/:id" :content-type "json")
2013-06-30 22:38:05 +02:00
(if (logged-in-p)
2013-07-13 02:31:30 +02:00
(encode-json-to-string (get-story id))
2013-06-30 22:38:05 +02:00
403))