diff --git a/alert.lisp b/alert.lisp index 2146286..232b93d 100644 --- a/alert.lisp +++ b/alert.lisp @@ -85,7 +85,7 @@ (lambda (x) (<= (dm:field x "value") hi-threshold))))) (points (db:select 'datapoints (db:query (:and (:= 'series (dm:field alert "series")) (:<= min 'time))) - :order '(("time" . :ASC)))) + :sort '(("time" . :ASC)))) (streak (longest-streak points check))) (when (and streak (<= (dm:field alert "duration") diff --git a/api.lisp b/api.lisp index 0b17155..0ecba99 100644 --- a/api.lisp +++ b/api.lisp @@ -1,3 +1,69 @@ (in-package #:monitor) +(defun api-output* (data &optional message url-format &rest url-args) + (let ((target (when url-format + (uri-to-url (if (stringp url-format) + (apply #'format NIL url-format url-args) + url-format) + :representation :external + :query `(("message" . ,message)))))) + (if (and target (string= "true" (post/get "browser"))) + (redirect target) + (api-output data :message (or message "Ok.") :target target)))) +(define-api monitor/series (id) (:access (perm monitor)) + (api-output* (ensure-series id))) + +(define-api monitor/series/list () (:access (perm monitor)) + (api-output* (list-series))) + +(define-api monitor/series/new (type &optional title interval argument[]) (:access (perm monitor)) + (let ((series (add-series type :title (or* title (string-downcase type)) + :interval (parse-float:parse-float (or* interval "1.0")) + :arguments argument[]))) + (api-output* series + "Series created." + (series-url series)))) + +(define-api monitor/series/remove (id) (:access (perm monitor)) + (remove-series id) + (api-output* NIL + "Series deleted." + "monitor/")) + +(define-api monitor/series/data (id &optional since before) (:access (perm monitor)) + (let ((series (ensure-series id))) + (api-output* (list-measurements series :since (time? since) :before (time? before))))) + +(define-api monitor/alert (id) (:access (perm monitor)) + (api-output* (ensure-alert id))) + +(define-api monitor/alert/list () (:access (perm monitor)) + (api-output* (list-alerts))) + +(define-api monitor/alert/new (series threshold &optional title duration) (:access (perm monitor)) + (api-output* (add-alert series (parse-float:parse-float threshold) + :title title + :duration (parse-float:parse-float (or* duration "0.0"))) + "Alert created." + "monitor/alerts")) + +(define-api monitor/alert/remove (id) (:access (perm monitor)) + (remove-alert id) + (api-output* NIL + "Alert deleted." + "monitor/alerts")) + +(define-api monitor/alert/subscribe (id email &optional name) (:access (perm monitor)) + (let ((alert (ensure-alert id))) + (add-subscription alert email (or* name email)) + (api-output* NIL + "Subscription created." + (alert-url alert)))) + +(define-api monitor/alert/unsubscribe (id email) (:access (perm monitor)) + (let ((alert (ensure-alert id))) + (remove-subscription alert email (or* name email)) + (api-output* NIL + "Subscription deleted." + (alert-url alert)))) diff --git a/db.lisp b/db.lisp index 7bd03ba..004d259 100644 --- a/db.lisp +++ b/db.lisp @@ -128,6 +128,16 @@ (defun perform-measurements () (mapcar #'perform-measurement (list-series))) +(defun list-measurements (series &key since count before) + (let* ((series (ensure-series series)) + (before (or before (precise-time:get-precise-time/double))) + (since (or since (- before (* count (dm:field series "interval")))))) + (db:select 'datapoints (db:query (:and (:= 'series (dm:id series)) + (:<= (float since 0d0) 'time) + (:<= 'time (float before 0d0)))) + :sort '(("time" . :ASC)) + :amount count))) + (defun list-alerts () (dm:get 'alert (db:query :all) :order '(("title" . :DESC)))) @@ -146,7 +156,7 @@ (defun add-alert (series threshold &key title (duration 0.0) emails) (let ((alert (dm:hull 'alert))) (setf (dm:field alert "series") (ensure-id series)) - (setf (dm:field alert "title") (or title (dm:field (ensure-series series) "title"))) + (setf (dm:field alert "title") (or* title (dm:field (ensure-series series) "title"))) (setf (dm:field alert "threshold") (float threshold 0f0)) (setf (dm:field alert "duration") (float duration 0f0)) (dm:insert alert) @@ -159,7 +169,10 @@ (db:remove 'alert/subscribers (db:query (:= 'alert id))) (db:remove 'alerts (db:query (:= '_id id)))))) -(defun add-subscription (alert email name) +(defun list-subscriptions (alert) + (dm:get 'alert/subscribers (db:query (:= 'alert (dm:id (ensure-alert alert)))))) + +(defun add-subscription (alert email &optional (name email)) (db:insert 'alert/subscribers `(("alert" . ,(ensure-id alert)) ("name" . ,name) ("email" . ,(string-downcase email))))) diff --git a/front.lisp b/front.lisp index 706b9cc..5735294 100644 --- a/front.lisp +++ b/front.lisp @@ -1,2 +1,29 @@ (in-package #:monitor) +(defun alert-url (alert) + (uri-to-url (format NIL "monitor/alert/~a" (dm:id (ensure-alert alert))) + :representation :external)) + +(defun series-url (series) + (uri-to-url (format NIL "monitor/series/~a" (dm:field (ensure-series series) "title")) + :representation :external)) + +(defun time? (var) + (when (and var (string/= var "")) + (org.shirakumo.fuzzy-dates:parse var))) + +(define-page dashboard "monitor/^$" (:access (perm monitor)) :clip "dashboard.ctml" + (r-clip:process T :series (list-series) + :alerts (list-alerts))) + +(define-page series "monitor/^series/(.*)$" (:uri-groups (series) :access (perm monitor) :clip "series.ctml") + (let ((series (ensure-series series))) + (r-clip:process T :series alert + :measurements (list-measurements series + :since (time? (post/get "since")) + :before (time? (post/get "before")))))) + +(define-page alert "monitor/^alert/(.*)$" (:uri-groups (alert) :access (perm monitor) :clip "alert.ctml") + (let ((alert (ensure-alert alert))) + (r-clip:process T :alert alert + :subscriptions (list-subscriptions alert)))) diff --git a/monitor.asd b/monitor.asd index a445f0d..c87f5ca 100644 --- a/monitor.asd +++ b/monitor.asd @@ -14,6 +14,8 @@ (:interface :relational-database) :machine-measurements :precise-time + :fuzzy-dates + :parse-float :r-data-model :r-oauth :r-clip