(load "~/quicklisp/setup.lisp") (ql:quickload :hunchentoot) (ql:quickload :drakma) (ql:quickload :cl-json) (defpackage :shout (:use :common-lisp :hunchentoot :cl-json) (:import-from :drakma :http-request) (:export :api)) (in-package :shout) (defvar *slack-webhook* "... you have to set this ...") (defvar *states* ()) (defclass event () ((message :initarg :message :accessor message) (ok :initarg :ok :accessor event-ok?))) (defclass state () ((name :initarg :name :accessor state-name) (status :initarg :status :initform "unknown" :accessor status) (last-event :initarg :last-event :accessor last-event))) (defun slack (ok summary details) (http-request *slack-webhook* :method :post :content (encode-json-to-string `((text . ,summary) (username . "shout!bot") (icon_url . "https://bit.ly/2AC9vAV") (attachments ((text . ,details) (color . ,(if ok "good" "danger")))))))) (defun notify-about (state) (let ((event (last-event state))) (slack (event-ok? event) (format nil "~A is ~A" (state-name state) (status state)) (message event)))) (defun still-ok? (e1 e2) (and (event-ok? e1) (event-ok? e2))) (defun transition (e1 e2) (cond ((still-ok? e1 e2) "working") ((event-ok? e2) "fixed") (t "broken"))) (defun update-state (state event) (let ((prev (last-event state))) (setf (status state) (transition prev event) (last-event state) event) (when (not (still-ok? prev event)) (notify-about state)) state)) (defun create-state (key topic event) (let ((state (make-instance 'state :name topic :last-event event :status (if (event-ok? event) "working" "broken")))) (setf *states* (acons key state *states*)) state)) (defun ingest (topic event) (let* ((key (intern topic)) (state (cdr (assoc key *states*)))) (if state (update-state state event) (create-state key topic event)))) (defun event-json (event) (when event `((message . ,(message event)) (ok . ,(event-ok? event))))) (defun state-json (state) (when state `((name . ,(state-name state)) (status . ,(status state)) (last . ,(event-json (last-event state)))))) (defun json-body () (decode-json-from-string (raw-post-data :force-text t))) (defun attr (object field) (cdr (assoc field object))) (defmacro handle (url &body body) (let ((fn (gensym "fn"))) `(progn (defun ,fn () (setf (content-type* *reply*) "application/json") (format nil "~A~%" (encode-json-to-string (progn ,@body)))) (push (create-prefix-dispatcher ,url ',fn) *dispatch-table*)))) (defun api (port) (handle "/states" *states*) (handle "/events" (let ((b (json-body))) (state-json (ingest (attr b :topic) (make-instance 'event :ok (attr b :ok) :message (attr b :message)))))) (start (make-instance 'easy-acceptor :port port)))