;;; scrumelo.el --- Scrum with elnode and org-mode -*- lexical-binding: t -*- ;; Copyright (C) 2013 Tom Willemse ;; Author: Tom Willemse ;; Keywords: tools, hypermedia, outlines, comm ;;; Commentary: ;; A scrum web app. (require 'cl-lib) (require 'eieio) (require 'elnode) (require 'esxml) (require 'org) (eval-when-compile (require 'cl-macs)) ;;; Code: (defvar scrumelo-project-file "~/projects/scrumelo/aeos.org" "The file containing the scrum backlog.") (defvar scrumelo-host "http://localhost:8028" "The URL on which scrumelo is running. Mozilla persona uses this to verify login requests.") (defvar scrumelo--base-dir (if load-file-name (file-name-directory load-file-name) default-directory) "The current directory.") (defvar scrumelo-bootstrap-css-location "http://netdna.bootstrapcdn.com/twitter-bootstrap/2.3.2/css/bootstrap-combined.no-icons.min.css" "The location of the twitter bootstrap CSS file.") (defvar scrumelo-bootstrap-js-location "http://netdna.bootstrapcdn.com/twitter-bootstrap/2.3.2/js/bootstrap.min.js" "The location of the twitter bootstrap JS file.") (defvar scrumelo-font-awesome-css-location "http://netdna.bootstrapcdn.com/font-awesome/3.1.1/css/font-awesome.min.css" "The location of the font awesome CSS file.") (defvar scrumelo-jquery-js-location "http://code.jquery.com/jquery-2.0.0.min.js" "The location of the jQuery JS file.") (defvar scrumelo-react-js-location "http://cdnjs.cloudflare.com/ajax/libs/react/0.3.2/react.min.js" "The location of the React JS file.") (defvar scrumelo-jsxtransformer-js-location "http://cdnjs.cloudflare.com/ajax/libs/react/0.3.2/JSXTransformer.js" "The location of the JSX Transformer JS file.") (defvar scrumelo--sessions (make-hash-table :test 'equal :size 6) "Collection of session information.") (defclass scrumelo-session () ((email :accessor session-email) (audience :accessor session-audience) (expires :accessor session-expires) (issuer :accessor session-issuer) (status))) (defmacro editing-scrumelo-story (id after &rest body) "Edit the story with ID. Goto the story with ID and execute AFTER after executing BODY and saving the buffer." (declare (indent 2)) (let ((entry-var (cl-gensym))) `(with-scrumelo-buffer (let ((,entry-var (cdr (org-id-find ,id)))) (goto-char ,entry-var) ,@body (save-buffer) ,after)))) (defmacro with-scrumelo-http-params (params httpcon &rest body) "Bind parameters PARAMS from HTTPCON and execute BODY." (declare (indent 2)) `(let (,@(mapcar (lambda (p) `(,p (elnode-http-param ,httpcon ,(symbol-name p)))) params)) ,@body)) (defmacro with-scrumelo-buffer (&rest body) "Set the current buffer to `scrumelo-project-file' and run BODY." (declare (indent 0)) `(with-current-buffer (find-file-noselect scrumelo-project-file) ,@body)) (defun scrumelo--json-to-session (persona-json) "Turn PERSONA-JSON into a `scrumelo-session' object." (let ((session (scrumelo-session "session"))) (mapc (lambda (cns) (setf (slot-value session (car cns)) (cdr cns))) persona-json) session)) (defun scrumelo--css (href) "Return a link pointing to HREF." `(link (@ (href ,href) (rel "stylesheet") (type "text/css")))) (defun scrumelo--css-list () "Return a list of all required CSS files." (list (scrumelo--css scrumelo-bootstrap-css-location) (scrumelo--css scrumelo-font-awesome-css-location))) (defun scrumelo--js (src) "Return a script sourcing SRC." `(script (@ (src ,src) (language "JavaScript") (type "text/javascript")) "")) (defun scrumelo--js-list () "Return a list of all required JS files." (list (scrumelo--js scrumelo-bootstrap-js-location) (scrumelo--js scrumelo-jquery-js-location) (scrumelo--js scrumelo-react-js-location) (scrumelo--js scrumelo-jsxtransformer-js-location) (scrumelo--js "js/scrumelo.js"))) (defun scrumelo--logged-in-p (httpcon) "Check if the session on HTTPCON is logged-in." (gethash (elnode-http-cookie httpcon "sessionid" t) scrumelo--sessions)) (defun scrumelo-backlog-page (httpcon) "Send the backlog overview over HTTPCON." (if (not (scrumelo--logged-in-p httpcon)) (elnode-send-redirect httpcon "/login") (elnode-send-html httpcon (concat "\n" (sxml-to-xml `(html (head (title "Scrumelo") ,@(scrumelo--css-list) ,@(scrumelo--js-list)) (body (a (@ (href "/logout")) "Logout") (div (@ (class "container")) (h1 "Backlog") (div (@ (id "content")) "") (script (@ (type "text/jsx") (src "js/main.js")) ""))))))))) (defun scrumelo-new-story (httpcon) "Parse data from HTTPCON and write a new scrum story using it." (elnode-method httpcon (POST (with-scrumelo-http-params (role necessity headline) httpcon (with-scrumelo-buffer (goto-char (point-max)) (insert "\n* TODO " headline) (org-set-property "Role" role) (org-set-property "Necessity" necessity) (org-set-property "ID" (org-id-new "scrumelo")) (save-buffer))) (elnode-send-redirect httpcon "/")))) (defun scrumelo-change-state (httpcon) "Parse data from HTTPCON and change the given task's state." (elnode-method httpcon (POST (with-scrumelo-http-params (id) httpcon (editing-scrumelo-story id (scrumelo--send-json httpcon `((:state . ,(org-entry-get (point) "TODO")))) (org-todo)))))) (defun scrumelo-move-story (dir) "Create a function to move a story in direction DIR." (let ((func (intern (concat "org-move-subtree-" dir)))) (lambda (httpcon) (elnode-method httpcon (POST (with-scrumelo-http-params (id) httpcon (editing-scrumelo-story id (scrumelo--send-json httpcon '((:status . "OK"))) (funcall func)))))))) (defun scrumelo--send-json (httpcon obj) "Respond to HTTPCON with OBJ converted to a json structure." (elnode-http-start httpcon 200 '("Content-Type" . "text/json")) (elnode-http-return httpcon (json-encode obj))) (defun scrumelo-story-json (httpcon) "Repsond to HTTPCON with some json info about a story." (let* ((story (match-string 1 (elnode-http-mapping httpcon))) (entry (cdr (org-id-find story)))) (with-scrumelo-buffer (goto-char entry) (scrumelo--send-json httpcon (list (cons 'Assignee (org-entry-get (point) "Assignee")) (cons 'content (buffer-substring-no-properties (org-end-of-meta-data-and-drawers) (org-entry-end-position)))))))) (defun scrumelo--org-entry-to-list () "Turn an org-entry to json." (let ((components (org-heading-components))) (when (= (car components) 1) `((:id . ,(org-id-get)) (:state . ,(org-entry-get (point) "TODO")) (:role . ,(org-entry-get (point) "Role")) (:necessity . ,(org-entry-get (point) "Necessity")) (:title . ,(nth 4 components)))))) (defun scrumelo-main-json (request) "Respond to REQUEST with the json info for the main page." (with-scrumelo-buffer (scrumelo--send-json request (cl-map 'vector #'identity (delq nil (org-map-entries #'scrumelo--org-entry-to-list nil nil 'comment)))))) (defun scrumelo--verify-credentials (audience assertion) "Make sure AUDIENCE and ASSERTION are correct." (let ((url-request-extra-headers '(("Content-Type" . "application/json"))) (url-request-data (json-encode `(("assertion" . ,assertion) ("audience" . ,audience)))) (url-request-method "POST") result) (with-current-buffer (url-retrieve-synchronously "https://verifier.login.persona.org/verify") (goto-char (point-min)) (search-forward "\n\n") (setq result (json-read)) (kill-buffer)) result)) (defun scrumelo-login-page (httpcon) "Show a login link for persona for HTTPCON." (if (scrumelo--logged-in-p httpcon) (elnode-send-redirect httpcon "/") (elnode-method httpcon (GET (elnode-http-start httpcon 200 '("Content-Type" . "text/html")) (elnode-http-return httpcon (concat "\n" (sxml-to-xml '(html (@ (lang "en")) (head (meta (@ (charset "utf-8"))) (title "Login") (script (@ (src "https://login.persona.org/include.js")) "") (script (@ (src "/js/login.js")) "")) (body (form (@ (id "login-form") (method "POST") (action "")) (input (@ (id "assertion-field") (type "hidden") (name "assertion") (value "")))) (p (a (@ (href "javascript:login()")) "Login")))))))) (POST (let* ((audience scrumelo-host) (assertion (elnode-http-param httpcon "assertion")) (result (scrumelo--verify-credentials audience assertion))) (if (equal (cdr (assoc 'status result)) "okay") (progn (puthash (elnode-http-cookie httpcon "sessionid" t) (scrumelo--json-to-session result) scrumelo--sessions) (elnode-send-redirect httpcon "/")) (elnode-send-status httpcon 403 "Not allowed"))))))) (defun scrumelo-logout (httpcon) "Destroy the session on HTTPCON." (remhash (elnode-http-cookie httpcon "sessionid" t) scrumelo--sessions) (elnode-send-redirect httpcon "/login")) (defun scrumelo-handler (httpcon) "Send the right requests in HTTPCON to the right functions." (elnode-dispatcher httpcon `(("^/$" . scrumelo-backlog-page) ("^/js/main.js" . ,(elnode-make-send-file (concat scrumelo--base-dir "js/main.js"))) ("^/js/login.js" . ,(elnode-make-send-file (concat scrumelo--base-dir "js/login.js"))) ("^/login/$" . scrumelo-login-page) ("^/logout/$" . scrumelo-logout) ("^/stories/$" . scrumelo-main-json) ("^/stories/new/$" . scrumelo-new-story) ("^/stories/state/$" . scrumelo-change-state) ("^/stories/up/$" . ,(scrumelo-move-story "up")) ("^/stories/down/$" . ,(scrumelo-move-story "down")) ("^/stories/\\([a-z0-9:-]+\\)/$" . scrumelo-story-json)))) (elnode-start 'scrumelo-handler :port 8028 :host "0.0.0.0") (provide 'scrumelo) ;;; scrumelo.el ends here