path: root/lisp/aws/aws.lisp

;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
(declaim (optimize (speed 0) (safety 3) (debug 3)))

(in-package :snow)

(defclass aws ()
  ((profile :initarg :profile
            :initform nil
            :accessor profile)
   (region :initarg :region
           :initform (region *webapp*)
           :accessor region))
  (:documentation ""))

(defclass aws-tag ()
  ((key :initarg :key
        :initform nil
        :accessor key)
   (value :initarg :value
          :initform nil
          :accessor value))
  (:documentation ""))

(defclass aws-instance ()
  ((id :initarg :id
       :initform nil
       :accessor id)
   (ip :initarg :ip
       :initform nil
       :accessor ip)
   (launch-time :initarg :launch-time
                :initform nil
                :accessor launch-time))
  (:documentation ""))

(defclass aws-asg (aws)
  ((name :initarg :name
         :initform nil
         :accessor name)
   (arn :initarg :arn
        :initform nil
        :accessor arn)
   (count-min :initarg :count-min
              :initform nil
              :accessor count-min)
   (count-max :initarg :count-max
              :initform nil
              :accessor count-max)
   (count-desired :initarg :count-desired
                  :initform nil
                  :accessor count-desired)
   (age :initarg :age
        :initform nil
        :accessor age)
   (instance-ids :initarg :instance-ids
                 :initform nil
                 :accessor instance-ids)
   (instances :initarg :instances
              :initform nil
              :accessor instances)
   (howmany :initarg :howmany
            :initform nil
            :accessor howmany))
  (:documentation ""))

(defclass aws-certificate (aws)
  ((arn :initarg :arn
        :initform nil
        :accessor arn)
   (domain-name :initarg :domain-name
                :initform nil
                :accessor domain-name)
   (status :initarg :status
           :initform nil
           :accessor status)
   (renewal-eligibility :initarg :renewal-eligibility
                        :initform nil
                        :accessor renewal-eligibility)
   (not-before :initarg :not-before
               :initform nil
               :accessor not-before)
   (not-after :initarg :not-after
              :initform nil
              :accessor not-after)
   (tags :initarg :tags
         :initform nil
         :accessor tags)
   (cert :initarg :cert
         :initform nil
         :accessor cert)
   (chain :initarg :chain
          :initform nil
          :accessor chain)
   (key :initarg :key
        :initform nil
        :accessor key)
   (passphrase :initarg :passphrase
               :initform nil
               :accessor passphrase))
  (:documentation ""))

(defclass aws-targetgroup (aws)
  ((name :initarg :name
         :initform nil
         :accessor name)
   (arn :initarg :arn
        :initform nil
        :accessor arn)
   (protocol :initarg :protocol
             :initform nil
             :accessor protocol)
   (port :initarg :port
         :initform nil
         :accessor port)
   (healthy-p :initarg :healthy-p
              :initform nil
              :accessor healthy-p)
   (stdout :initarg :stdout
           :initform nil
           :accessor stdout)
   (filter :initarg :filter
           :initform nil
           :accessor filter)
   (targets :initarg :targets
            :initform nil
            :accessor targets))
  (:documentation ""))

(defclass aws-target ()
  ((instance-id :initarg :instance-id
                :initform nil
                :accessor instance-id)
   (port :initarg :port
         :initform nil
         :accessor port)
   (state :initarg :state
          :initform nil
          :accessor state)
   (healthy-p :initarg :healthy-p
              :initform nil
              :accessor healthy-p))
  (:documentation ""))

(defclass aws-ssm-parameter (aws)
  ((name :initarg :name
         :initform nil
         :accessor name)
   (value :initarg :value
          :initform nil
          :accessor value))
  (:documentation ""))

(defmethod sanitize-json ((aws-asg aws-asg))
  (make-instance 'aws-asg
                 :profile nil
                 :region nil
                 :name (name aws-asg)
                 :count-min (count-min aws-asg)
                 :count-max (count-max aws-asg)
                 :count-desired (count-desired aws-asg)
                 :age (age aws-asg)
                 :instances (instances aws-asg)
                 :howmany nil))

(defmethod run-aws-cli ((aws aws) command)
  "Runs an awscli command and returns the results as CL-JSON object."
  (let ((output (make-array '(0) :element-type 'character :fill-pointer 0 :adjustable t)))
    (with-output-to-string (stream output)
      (uffi:run-shell-command (format nil
                                      "~a --profile ~a --region ~a"
                                      command
                                      (profile aws)
                                      (region aws))
                              :output stream))
    (if (org-ckons-core::null-or-empty-p output)
        output
        (cl-json:decode-json-from-string output))))

(defmethod get-asgs ((aws aws) filter)
  (let* ((command "aws autoscaling describe-auto-scaling-groups")
         (data (cdar (run-aws-cli aws command)))
         (instances (get-instances aws (org-ckons-core::flatten (loop for asg in data
                                                                      when (org-ckons-core::match-it filter (cdr (assoc :*auto-scaling-group-name asg)))
                                                                        collect (loop for instance in (cdr (assoc :*instances asg))
                                                                                      collect (cdr (assoc :*instance-id instance)))))))
         (asgs (loop for asg in data
                     when (org-ckons-core::match-it filter (cdr (assoc :*auto-scaling-group-name asg)))
                       collect (make-instance 'aws-asg
                                              :profile (profile aws)
                                              :region (region aws)
                                              :name (cdr (assoc :*auto-scaling-group-name asg))
                                              :arn (cdr (assoc :*auto-scaling-group-+arn+ asg))
                                              :count-min (cdr (assoc :*min-size asg))
                                              :count-max (cdr (assoc :*max-size asg))
                                              :count-desired (cdr (assoc :*desired-capacity asg))
                                              :instance-ids (org-ckons-core::flatten (loop for instance in (cdr (assoc :*instances asg))
                                                                                           collect (cdr (assoc :*instance-id instance))))))))
    (loop for instance in instances
          do (loop for asg in asgs
                   when (intersection `(,(id instance)) (instance-ids asg) :test 'string=)
                     do (push instance (instances asg))))
    (loop for asg in asgs
          do (handler-case
                 (progn
                   (setf (instances asg) (sort (instances asg)
                                               (lambda (x y)
                                                 (string< (launch-time x) (launch-time y)))))
                   (setf (age asg) (/ (- (get-universal-time)
                                         (local-time:timestamp-to-universal (local-time:parse-timestring (launch-time (first (instances asg))))))
                                      86400.0)))
               (error (e)
                 (declare (ignore e))
                 (setf (age asg) -1))))
    (sort asgs (lambda (x y) (> (age x) (age y))))))

(defmethod get-instances ((aws aws) instance-ids)
  (let ((command (format nil
                         "aws ec2 describe-instances --instance-ids ~a"
                         (org-ckons-core::reduce-to-char-separated-string instance-ids " "))))
    (loop for instance in (loop for reservation in (cdr (assoc :*reservations (run-aws-cli aws command)))
                                collect (car (cdr (assoc :*instances reservation))))
          collect (make-instance 'aws-instance
                                 :id (cdr (assoc :*instance-id instance))
                                 :ip (first (loop for interface in (cdr (assoc :*network-interfaces instance))
                                                  collect (cdr (assoc :*private-ip-address interface))))
                                 :launch-time (cdr (assoc :*launch-time instance))))))

(defmethod get-targetgroups ((aws-targetgroup aws-targetgroup))
  (let ((command "aws elbv2 describe-target-groups"))
    (sort (loop for targetgroup in (cdar (run-aws-cli aws-targetgroup command))
                when (org-ckons-core::match-it (if (string= (filter aws-targetgroup) "all")
                                                   ""
                                                   (filter aws-targetgroup))
                                               (cdr (assoc :*target-group-name targetgroup)))
                  collect (let ((targetgroup (make-instance 'aws-targetgroup
                                                            :profile (profile aws-targetgroup)
                                                            :region (region aws-targetgroup)
                                                            :name (cdr (assoc :*target-group-name targetgroup))
                                                            :arn (cdr (assoc :*target-group-arn targetgroup))
                                                            :protocol (cdr (assoc :*protocol targetgroup))
                                                            :port (cdr (assoc :*port targetgroup)))))
                            (setf (targets targetgroup) (get-targets targetgroup))
                            (setf (healthy-p targetgroup) (get-targetgroup-health targetgroup))
                            targetgroup))
          (lambda (x y) (string< (name x) (name y))))))

(defmethod get-targets ((aws-targetgroup aws-targetgroup))
  (let ((command (format nil
                         "aws elbv2 describe-target-health --target-group-arn ~a"
                         (arn aws-targetgroup))))
    (loop for target in (cdar (run-aws-cli aws-targetgroup command))
          collect (make-instance 'aws-target
                                 :instance-id (cdr (assoc :*id (cdr (assoc :*target target))))
                                 :port (cdr (assoc :*port (cdr (assoc :*target target))))
                                 :state (cdr (assoc :*state (cdr (assoc :*target-health target))))
                                 :healthy-p (string= (cdr (assoc :*state (cdr (assoc :*target-health target)))) "healthy")))))

(defmethod get-targetgroup-health ((aws-targetgroup aws-targetgroup))
  (let ((states (loop for target in (targets aws-targetgroup)
                      collect (healthy-p target))))
    (= (length states)
       (length (remove-if 'null states)))))

(defmethod get-aws-unhealthy-targetgroups ((aws-targetgroup aws-targetgroup))
  (enqueue *queue-aws* aws-targetgroup))

(defmethod bg-perform ((aws-targetgroup aws-targetgroup))
  (let ((output (make-array '(0) :element-type 'character :fill-pointer 0 :adjustable t))
        (targetgroups (get-targetgroups aws-targetgroup)))
    (with-output-to-string (stream output)
      (loop for targetgroup in targetgroups
            when (not (healthy-p targetgroup))
              do (format stream
                         "~a~t~a~t~a~%"
                         (name targetgroup)
                         (arn targetgroup)
                         (port targetgroup))
                 (loop for target in (targets targetgroup)
                       when (not (healthy-p target))
                         do (format stream
                                    "~t~a~t~a~%"
                                    (instance-id target)
                                    (state target)))
                 (format stream "~%")))
    (with-open-file (stream (stdout aws-targetgroup) :direction :output :if-exists :append :if-does-not-exist :create)
      (format stream output))))

(defmethod get-certificates ((aws aws) &optional filter)
  (sort (loop for cert in (cdr (assoc :*certificate-summary-list (run-aws-cli aws "aws acm list-certificates")))
              when (or (and (null filter)
                            (string= (cdr (assoc :*status cert)) "ISSUED"))
                       (string= filter (cdr (assoc :*domain-name cert))))
                collect (make-instance 'aws-certificate
                                       :profile (profile aws)
                                       :region (region aws)
                                       :arn (cdr (assoc :*certificate-arn cert))
                                       :domain-name (cdr (assoc :*domain-name cert))
                                       :status (cdr (assoc :*status cert))
                                       :renewal-eligibility (cdr (assoc :*renewal-eligibility cert))
                                       :not-before (cdr (assoc :*not-before cert))
                                       :not-after (cdr (assoc :*not-after cert))))
        (lambda (x y) (string< (domain-name x) (domain-name y)))))

(defmethod get-certificate-tags ((aws-certificate aws-certificate))
  (setf (tags aws-certificate) (sort (loop for tag in (cdr (assoc :*tags (run-aws-cli aws-certificate (format nil "aws acm list-tags-for-certificate --certificate-arn ~a" (arn aws-certificate)))))
                                           collect (make-instance 'aws-tag
                                                                  :key (cdr (assoc :*key tag))
                                                                  :value (cdr (assoc :*value tag))))
                                     (lambda (x y) (string< (key x) (key y))))))

(defun tag-exists-p (cert key value)
  (find-if (lambda (x)
             (and (string= (key x) key)
                  (string= (value x) value)))
           (tags cert)))

(defun get-certificates-to-renew (certs environment)
  (loop for cert in certs
        do (get-certificate-tags cert))
  (loop for cert in certs
        when (and (or (tag-exists-p cert "Purpose" "KafkaAuth")
                      (tag-exists-p cert "Purpose" "OloAuthSigningKey"))
                  (tag-exists-p cert "Environment" environment))
          collect cert))

(defmethod bg-perform ((aws-asg aws-asg))
  (labels ((do-scale (count-desired)
             (let ((command (format nil
                                    "aws autoscaling set-desired-capacity --auto-scaling-group-name ~a --desired-capacity ~a"
                                    (name aws-asg)
                                    count-desired)))
               (run-aws-cli aws-asg command)))
           (instances-ready-p ()
             (let ((updated-asg (car (get-asgs aws-asg (name aws-asg))))
                   (in-service-p t))
               (loop for id in (instances updated-asg)
                     do (let* ((command (format nil "aws autoscaling describe-auto-scaling-instances --instance-id ~a" id))
                               (instance (cadar (run-aws-cli updated-asg command))))
                          (when (not (string= (cdr (assoc :*lifecycle-state instance)) "InService"))
                            (setf in-service-p nil))))
               in-service-p)))
    (let ((count (cond ((string= (howmany aws-asg) "all") (count-desired aws-asg))
                       ((string= (howmany aws-asg) "one") 1)
                       (t 0))))
      (loop for index from 1 to count
            do (progn
                 (do-scale (+ (count-desired aws-asg) 1))
                 (sleep 15)
                 (do-scale (count-desired aws-asg))
                 (sleep 15)
                 (loop while (not (instances-ready-p))
                       do (sleep 30)))))))

(defmethod recycle-asg ((aws-asg aws-asg))
  (enqueue *queue-aws* aws-asg))

(defmethod bg-perform ((aws-certificate aws-certificate))
  )

(defmethod renew-certificates ((aws-certificate aws-certificate) environment filter)
  (loop for cert in (get-certificates-to-renew (get-certificates aws-certificate filter) environment)
        do (let* ((passphrase (cl-base64:string-to-base64-string (org-ckons-session::generate-sessionid)))
                  (exported-cert (run-aws-cli aws-certificate (format nil "aws acm export-certificate --certificate-arn ~a --passphrase ~a --output json" (arn cert) passphrase))))
             (setf (cert cert) (cdr (assoc :*certificate exported-cert)))
             (setf (chain cert) (cdr (assoc :*certificate-chain exported-cert)))
             (setf (key cert) (cdr (assoc :*private-key exported-cert)))
             (setf (passphrase cert) passphrase))))
        ;;do (enqueue *queue-aws* cert)))

(defun get-aws-ssm-parameter (profile key)
  (let* ((aws-ssm-parameter (make-instance 'aws-ssm-parameter :profile profile :region "us-east-1"))
         (command (format nil "aws ssm get-parameter --with-decryption --name \"~a\"" key))
         (results (run-aws-cli aws-ssm-parameter command)))
    (setf (name aws-ssm-parameter) (cdr (assoc :*name (cdar results))))
    (setf (value aws-ssm-parameter) (cdr (assoc :*value (cdar results))))
    aws-ssm-parameter))