Browse code
fix SBCL_HOME now that I'm using a fancy docker container
Ed Langley authored on 12/01/2019 21:46:09Showing 2 changed files
| 6 | 6 |
new file mode 100644 |
| ... | ... |
@@ -0,0 +1,173 @@ |
| 1 |
+(defpackage :daydreamer.stack-tester |
|
| 2 |
+ (:use :cl) |
|
| 3 |
+ (:import-from :daydreamer.aws-result :extract-list :extract-stack :stack-name :stack-status) |
|
| 4 |
+ (:export )) |
|
| 5 |
+(in-package :daydreamer.stack-tester) |
|
| 6 |
+ |
|
| 7 |
+(defmacro with-api-response ((stream success &rest r &key indent) &body forms) |
|
| 8 |
+ (declare (ignore indent)) |
|
| 9 |
+ `(yason:with-output (,stream ,@r) |
|
| 10 |
+ (yason:with-object () |
|
| 11 |
+ (yason:encode-object-element "success" (if ,success 'yason:true 'yason:false)) |
|
| 12 |
+ (yason:with-object-element ("result")
|
|
| 13 |
+ ,@forms)))) |
|
| 14 |
+ |
|
| 15 |
+(defun encode-stack (name stack-status) |
|
| 16 |
+ (yason:with-object () |
|
| 17 |
+ (fw.lu:vector-destructuring-bind (verb status) |
|
| 18 |
+ (fwoar.string-utils:split #\_ (string-downcase stack-status) |
|
| 19 |
+ :count 2) |
|
| 20 |
+ (yason:encode-object-element "name" name) |
|
| 21 |
+ (yason:encode-object-element "verb" verb) |
|
| 22 |
+ (yason:encode-object-element "status" status)))) |
|
| 23 |
+ |
|
| 24 |
+(defun encode-result (result) |
|
| 25 |
+ (yason:with-array () |
|
| 26 |
+ (loop for (name value) in result |
|
| 27 |
+ do (encode-stack name value)))) |
|
| 28 |
+ |
|
| 29 |
+(defun get-active-stack-statuses () |
|
| 30 |
+ (let ((get-information (serapeum:juxt 'stack-name |
|
| 31 |
+ 'stack-status))) |
|
| 32 |
+ (mapcar get-information |
|
| 33 |
+ (mapcar 'extract-stack |
|
| 34 |
+ (extract-list |
|
| 35 |
+ (cdar (aws-sdk/services/cloudformation:list-stacks |
|
| 36 |
+ :stack-status-filter '("UPDATE_COMPLETE" "UPDATE_IN_PROGRESS"
|
|
| 37 |
+ "UPDATE_COMPLETE_CLEANUP_IN_PROGRESS" "UPDATE_ROLLBACK_COMPLETE" |
|
| 38 |
+ "UPDATE_ROLLBACK_IN_PROGRESS" "UPDATE_ROLLBACK_FAILED" |
|
| 39 |
+ "UPDATE_ROLLBACK_COMPLETE_CLEANUP_IN_PROGRESS" "CREATE_FAILED" |
|
| 40 |
+ "CREATE_COMPLETE" "CREATE_IN_PROGRESS" |
|
| 41 |
+ "DELETE_IN_PROGRESS" "DELETE_FAILED")))))))) |
|
| 42 |
+(defclass status-server (hunchentoot:acceptor) |
|
| 43 |
+ ()) |
|
| 44 |
+ |
|
| 45 |
+(defmethod hunchentoot:acceptor-dispatch-request ((server status-server) request) |
|
| 46 |
+ (setf (hunchentoot:content-type*) "application/json") |
|
| 47 |
+ (setf (hunchentoot:header-out "Access-Control-Allow-Origin") "*") |
|
| 48 |
+ (string-case:string-case ((hunchentoot:script-name request)) |
|
| 49 |
+ ("/healthchecks" (with-output-to-string (s)
|
|
| 50 |
+ (with-api-response (s t :indent t) |
|
| 51 |
+ (yason:with-object () |
|
| 52 |
+ (yason:encode-object-element "ElasticSearch Cluster Status" (string-downcase (get-es-cluster-status (local-time:now)))) |
|
| 53 |
+ (yason:encode-object-element "ElasticSearch Backup Status" (string-downcase (get-es-backup-status (local-time:now)))))))) |
|
| 54 |
+ ("/stacks" (with-output-to-string (s)
|
|
| 55 |
+ (with-api-response (s t :indent t) |
|
| 56 |
+ (encode-result (get-active-stack-statuses))))))) |
|
| 57 |
+ |
|
| 58 |
+(defun aws-host (service region) |
|
| 59 |
+ (format nil "~(~A~).~(~A~).amazonaws.com" service region)) |
|
| 60 |
+ |
|
| 61 |
+(defun aws-request (&key (path "/") service method params headers payload (session aws-sdk/api:*session*)) |
|
| 62 |
+ (let ((credentials (or (aws-sdk/session:session-credentials session) |
|
| 63 |
+ (aws-sdk/credentials:aws-credentials))) |
|
| 64 |
+ (region (aws-sdk/session:session-region session))) |
|
| 65 |
+ |
|
| 66 |
+ (unless credentials |
|
| 67 |
+ (error "No credentials are found")) |
|
| 68 |
+ (unless region |
|
| 69 |
+ (error "AWS region is not configured")) |
|
| 70 |
+ |
|
| 71 |
+ (let ((host (aws-host service region)) |
|
| 72 |
+ (aws-sign4:*aws-credentials* (or aws-sign4:*aws-credentials* |
|
| 73 |
+ (lambda () (aws-sdk/credentials:credential-keys credentials))))) |
|
| 74 |
+ (multiple-value-bind (authorization x-amz-date) |
|
| 75 |
+ (aws-sign4:aws-sign4 :region region |
|
| 76 |
+ :service service |
|
| 77 |
+ :method method |
|
| 78 |
+ :host host |
|
| 79 |
+ :path path |
|
| 80 |
+ :params params |
|
| 81 |
+ :headers headers |
|
| 82 |
+ :payload (or payload "")) |
|
| 83 |
+ (dex:request (format nil "https://~A~A?~A" host path |
|
| 84 |
+ (quri:url-encode-params params)) |
|
| 85 |
+ :method method |
|
| 86 |
+ :keep-alive nil |
|
| 87 |
+ :headers `(("Authorization" . ,authorization)
|
|
| 88 |
+ ("X-Amz-Date" . ,x-amz-date)
|
|
| 89 |
+ ,@(aws-sdk/credentials:credential-headers credentials) |
|
| 90 |
+ ("Content-Type" . "application/json")
|
|
| 91 |
+ ("Accept" . "application/json")
|
|
| 92 |
+ ,@headers) |
|
| 93 |
+ :content payload))))) |
|
| 94 |
+ |
|
| 95 |
+#+null |
|
| 96 |
+(get-metric-statistics "es-pseudo-prod.insights.cj.com" "ClusterStatus.green" '(("ClusterHealth" . "ClusterStatus"))
|
|
| 97 |
+ (local-time:parse-timestring "2018-06-11T07:00:00.000Z") |
|
| 98 |
+ (local-time:parse-timestring "2018-06-11T07:05:00.000Z") 300 '("Maximum")
|
|
| 99 |
+ ) |
|
| 100 |
+ |
|
| 101 |
+(defun get-metric-statistics (namespace metric-name dimensions start-time end-time period statistics) |
|
| 102 |
+ (aws-request :service "monitoring" |
|
| 103 |
+ :method :post |
|
| 104 |
+ :params `(("Action" . "GetMetricStatistics")
|
|
| 105 |
+ ("Version" . "2010-08-01")
|
|
| 106 |
+ ("Namespace" . ,namespace)
|
|
| 107 |
+ ("MetricName" . ,metric-name)
|
|
| 108 |
+ ,@(loop for (dimension-name . dimension-value) in dimensions |
|
| 109 |
+ for idx from 1 |
|
| 110 |
+ append (list (cons (format nil "Dimensions.member.~d.Name" idx) |
|
| 111 |
+ dimension-name) |
|
| 112 |
+ (cons (format nil "Dimensions.member.~d.Value" idx) |
|
| 113 |
+ dimension-value))) |
|
| 114 |
+ ("StartTime" . ,(local-time:format-timestring nil start-time
|
|
| 115 |
+ :format '((:YEAR 4) #\- (:MONTH 2) #\- (:DAY 2) #\T (:HOUR 2) #\: (:MIN 2) #\: (:SEC 2) #\. (:USEC 3) :GMT-OFFSET-OR-Z) |
|
| 116 |
+ :timezone local-time:+utc-zone+)) |
|
| 117 |
+ ("EndTime" . ,(local-time:format-timestring nil end-time
|
|
| 118 |
+ :format '((:YEAR 4) #\- (:MONTH 2) #\- (:DAY 2) #\T (:HOUR 2) #\: (:MIN 2) #\: (:SEC 2) #\. (:USEC 3) :GMT-OFFSET-OR-Z) |
|
| 119 |
+ :timezone local-time:+utc-zone+)) |
|
| 120 |
+ ("Period" . ,period)
|
|
| 121 |
+ ,@(loop for statistic in statistics |
|
| 122 |
+ for idx from 1 |
|
| 123 |
+ collect (cons (format nil "Statistics.member.~d" idx) statistic))))) |
|
| 124 |
+ |
|
| 125 |
+(defun get-metric-statistics-for-time (namespace metric-name dimensions start-time statistics) |
|
| 126 |
+ (yason:parse (get-metric-statistics namespace metric-name dimensions start-time (local-time:timestamp+ start-time 5 :minute) 300 statistics))) |
|
| 127 |
+ |
|
| 128 |
+(defun extract-datapoints (response statistics) |
|
| 129 |
+ (funcall (apply 'serapeum:juxt (mapcar 'data-lens:key statistics)) |
|
| 130 |
+ (car (fw.lu:pick '("GetMetricStatisticsResponse" "GetMetricStatisticsResult" "Datapoints")
|
|
| 131 |
+ response)))) |
|
| 132 |
+ |
|
| 133 |
+(defun get-es-cluster-status (start-time) |
|
| 134 |
+ (flet ((get-healthcheck (metric-name) |
|
| 135 |
+ (let ((statistics '("Maximum")))
|
|
| 136 |
+ (extract-datapoints |
|
| 137 |
+ (get-metric-statistics-for-time "es.pseudo-prod.insights.cj.com" |
|
| 138 |
+ metric-name |
|
| 139 |
+ '(("ClusterHealth" . "ClusterStatus"))
|
|
| 140 |
+ (local-time:timestamp- start-time 5 :minute) |
|
| 141 |
+ statistics) |
|
| 142 |
+ statistics)))) |
|
| 143 |
+ (uiop:nest |
|
| 144 |
+ (destructuring-bind (green) (get-healthcheck "ClusterStatus.green")) |
|
| 145 |
+ (destructuring-bind (yellow) (get-healthcheck "ClusterStatus.yellow")) |
|
| 146 |
+ (destructuring-bind (red) (get-healthcheck "ClusterStatus.red")) |
|
| 147 |
+ (cond ((and (numberp red) (> red 0)) :red) |
|
| 148 |
+ ((and (numberp yellow) (> yellow 0)) :yellow) |
|
| 149 |
+ ((and (numberp green) (> green 0)) :green) |
|
| 150 |
+ (t :invalid))))) |
|
| 151 |
+ |
|
| 152 |
+(defun get-es-backup-status (start-time) |
|
| 153 |
+ (flet ((get-healthcheck (metric-name) |
|
| 154 |
+ (let ((statistics '("Maximum")))
|
|
| 155 |
+ (extract-datapoints |
|
| 156 |
+ (yason:parse |
|
| 157 |
+ (get-metric-statistics "es-backup.pseudo-prod.insights.cj.com" |
|
| 158 |
+ metric-name |
|
| 159 |
+ '(("ESBackup" . "ESBackupStatus"))
|
|
| 160 |
+ (local-time:timestamp-minimize-part start-time :hour) |
|
| 161 |
+ (local-time:timestamp+ (local-time:timestamp-minimize-part start-time :hour) |
|
| 162 |
+ 1 :day) |
|
| 163 |
+ #.(* 24 60 60) |
|
| 164 |
+ statistics)) |
|
| 165 |
+ statistics)))) |
|
| 166 |
+ (uiop:nest |
|
| 167 |
+ (destructuring-bind (green) (get-healthcheck "ESBackupStatus.GREEN")) |
|
| 168 |
+ (destructuring-bind (yellow) (get-healthcheck "ESBackupStatus.YELLOW")) |
|
| 169 |
+ (destructuring-bind (red) (get-healthcheck "ESBackupStatus.RED")) |
|
| 170 |
+ (cond ((and (numberp red) (> red 0)) :red) |
|
| 171 |
+ ((and (numberp yellow) (> yellow 0)) :yellow) |
|
| 172 |
+ ((and (numberp green) (> green 0)) :green) |
|
| 173 |
+ (t :invalid))))) |