(defpackage :daydreamer.stack-tester (:use :cl) (:import-from :daydreamer.aws-result :extract-list :extract-stack :stack-name :stack-status) (:export )) (in-package :daydreamer.stack-tester) (defmacro with-api-response ((stream success &rest r &key indent) &body forms) (declare (ignore indent)) `(yason:with-output (,stream ,@r) (yason:with-object () (yason:encode-object-element "success" (if ,success 'yason:true 'yason:false)) (yason:with-object-element ("result") ,@forms)))) (defun encode-stack (name stack-status) (yason:with-object () (fw.lu:vector-destructuring-bind (verb status) (fwoar.string-utils:split #\_ (string-downcase stack-status) :count 2) (yason:encode-object-element "name" name) (yason:encode-object-element "verb" verb) (yason:encode-object-element "status" status)))) (defun encode-result (result) (yason:with-array () (loop for (name value) in result do (encode-stack name value)))) (defun get-active-stack-statuses () (let ((get-information (serapeum:juxt 'stack-name 'stack-status))) (mapcar get-information (mapcar 'extract-stack (extract-list (cdar (aws-sdk/services/cloudformation:list-stacks :stack-status-filter '("UPDATE_COMPLETE" "UPDATE_IN_PROGRESS" "UPDATE_COMPLETE_CLEANUP_IN_PROGRESS" "UPDATE_ROLLBACK_COMPLETE" "UPDATE_ROLLBACK_IN_PROGRESS" "UPDATE_ROLLBACK_FAILED" "UPDATE_ROLLBACK_COMPLETE_CLEANUP_IN_PROGRESS" "CREATE_FAILED" "CREATE_COMPLETE" "CREATE_IN_PROGRESS" "DELETE_IN_PROGRESS" "DELETE_FAILED")))))))) (defclass status-server (hunchentoot:acceptor) ()) (defmethod hunchentoot:acceptor-dispatch-request ((server status-server) request) (setf (hunchentoot:content-type*) "application/json") (setf (hunchentoot:header-out "Access-Control-Allow-Origin") "*") (string-case:string-case ((hunchentoot:script-name request)) ("/healthchecks" (with-output-to-string (s) (with-api-response (s t :indent t) (yason:with-object () (yason:encode-object-element "ElasticSearch Cluster Status" (string-downcase (get-es-cluster-status (local-time:now)))) (yason:encode-object-element "ElasticSearch Backup Status" (string-downcase (get-es-backup-status (local-time:now)))))))) ("/stacks" (with-output-to-string (s) (with-api-response (s t :indent t) (encode-result (get-active-stack-statuses))))))) (defun aws-host (service region) (format nil "~(~A~).~(~A~).amazonaws.com" service region)) (defun aws-request (&key (path "/") service method params headers payload (session aws-sdk/api:*session*)) (let ((credentials (or (aws-sdk/session:session-credentials session) (aws-sdk/credentials:aws-credentials))) (region (aws-sdk/session:session-region session))) (unless credentials (error "No credentials are found")) (unless region (error "AWS region is not configured")) (let ((host (aws-host service region)) (aws-sign4:*aws-credentials* (or aws-sign4:*aws-credentials* (lambda () (aws-sdk/credentials:credential-keys credentials))))) (multiple-value-bind (authorization x-amz-date) (aws-sign4:aws-sign4 :region region :service service :method method :host host :path path :params params :headers headers :payload (or payload "")) (dex:request (format nil "https://~A~A?~A" host path (quri:url-encode-params params)) :method method :keep-alive nil :headers `(("Authorization" . ,authorization) ("X-Amz-Date" . ,x-amz-date) ,@(aws-sdk/credentials:credential-headers credentials) ("Content-Type" . "application/json") ("Accept" . "application/json") ,@headers) :content payload))))) #+null (get-metric-statistics "es-pseudo-prod.insights.cj.com" "ClusterStatus.green" '(("ClusterHealth" . "ClusterStatus")) (local-time:parse-timestring "2018-06-11T07:00:00.000Z") (local-time:parse-timestring "2018-06-11T07:05:00.000Z") 300 '("Maximum") ) (defun get-metric-statistics (namespace metric-name dimensions start-time end-time period statistics) (aws-request :service "monitoring" :method :post :params `(("Action" . "GetMetricStatistics") ("Version" . "2010-08-01") ("Namespace" . ,namespace) ("MetricName" . ,metric-name) ,@(loop for (dimension-name . dimension-value) in dimensions for idx from 1 append (list (cons (format nil "Dimensions.member.~d.Name" idx) dimension-name) (cons (format nil "Dimensions.member.~d.Value" idx) dimension-value))) ("StartTime" . ,(local-time:format-timestring nil start-time :format '((:YEAR 4) #\- (:MONTH 2) #\- (:DAY 2) #\T (:HOUR 2) #\: (:MIN 2) #\: (:SEC 2) #\. (:USEC 3) :GMT-OFFSET-OR-Z) :timezone local-time:+utc-zone+)) ("EndTime" . ,(local-time:format-timestring nil end-time :format '((:YEAR 4) #\- (:MONTH 2) #\- (:DAY 2) #\T (:HOUR 2) #\: (:MIN 2) #\: (:SEC 2) #\. (:USEC 3) :GMT-OFFSET-OR-Z) :timezone local-time:+utc-zone+)) ("Period" . ,period) ,@(loop for statistic in statistics for idx from 1 collect (cons (format nil "Statistics.member.~d" idx) statistic))))) (defun get-metric-statistics-for-time (namespace metric-name dimensions start-time statistics) (yason:parse (get-metric-statistics namespace metric-name dimensions start-time (local-time:timestamp+ start-time 5 :minute) 300 statistics))) (defun extract-datapoints (response statistics) (funcall (apply 'serapeum:juxt (mapcar 'data-lens:key statistics)) (car (fw.lu:pick '("GetMetricStatisticsResponse" "GetMetricStatisticsResult" "Datapoints") response)))) (defun get-es-cluster-status (start-time) (flet ((get-healthcheck (metric-name) (let ((statistics '("Maximum"))) (extract-datapoints (get-metric-statistics-for-time "es.pseudo-prod.insights.cj.com" metric-name '(("ClusterHealth" . "ClusterStatus")) (local-time:timestamp- start-time 5 :minute) statistics) statistics)))) (uiop:nest (destructuring-bind (green) (get-healthcheck "ClusterStatus.green")) (destructuring-bind (yellow) (get-healthcheck "ClusterStatus.yellow")) (destructuring-bind (red) (get-healthcheck "ClusterStatus.red")) (cond ((and (numberp red) (> red 0)) :red) ((and (numberp yellow) (> yellow 0)) :yellow) ((and (numberp green) (> green 0)) :green) (t :invalid))))) (defun get-es-backup-status (start-time) (flet ((get-healthcheck (metric-name) (let ((statistics '("Maximum"))) (extract-datapoints (yason:parse (get-metric-statistics "es-backup.pseudo-prod.insights.cj.com" metric-name '(("ESBackup" . "ESBackupStatus")) (local-time:timestamp-minimize-part start-time :hour) (local-time:timestamp+ (local-time:timestamp-minimize-part start-time :hour) 1 :day) #.(* 24 60 60) statistics)) statistics)))) (uiop:nest (destructuring-bind (green) (get-healthcheck "ESBackupStatus.GREEN")) (destructuring-bind (yellow) (get-healthcheck "ESBackupStatus.YELLOW")) (destructuring-bind (red) (get-healthcheck "ESBackupStatus.RED")) (cond ((and (numberp red) (> red 0)) :red) ((and (numberp yellow) (> yellow 0)) :yellow) ((and (numberp green) (> green 0)) :green) (t :invalid)))))