initial commit

1 files changed, 97 insertions, 0 deletions

diff --git a/lisp/tfcloud/tfcloud.lisp b/lisp/tfcloud/tfcloud.lisp
new file mode 100644
index 0000000..167abb6
--- /dev/null
+++ b/lisp/tfcloud/tfcloud.lisp
@@ -0,0 +1,97 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package :snow)
+
+(defclass tfcloud ()
+  ((token :initarg :token
+          :initform (cdr (assoc :token (cdadr (car (cl-json:decode-json-from-string (uiop:read-file-string "~/.terraform.d/credentials.tfrc.json"))))))
+          :accessor token)
+   (baseurl :initarg :baseurl
+            :initform "https://app.terraform.io/api/v2"
+            :accessor baseurl)
+   (proxy :initarg :proxy
+          :initform (let ((proxy-string (uffi:getenv "http_proxy")))
+                      (when (not (org-ckons-core::null-or-empty-p proxy-string))
+                        (let ((proxy-list (cl-ppcre:split ":" (car (last (cl-ppcre:split "//" proxy-string))))))
+                          (setf (elt proxy-list 1) (parse-integer (elt proxy-list 1)))
+                          proxy-list)))
+          :accessor proxy)
+   (cookie-jar :initarg :cookie-jar
+               :initform (make-instance 'drakma:cookie-jar)
+               :accessor cookie-jar))
+  (:documentation ""))
+
+(defclass tfcloud-workspace (tfcloud)
+  ((id :initarg :id
+       :initform nil
+       :accessor id)
+   (name :initarg :name
+         :initform nil
+         :accessor name))
+  (:documentation ""))
+
+ (defmacro with-tfcloud ((instance-name) &body body)
+  `(let ((,instance-name (make-instance 'tfcloud)))
+     ,@body))
+
+(defmethod sanitize-json ((tfcloud-workspace tfcloud-workspace))
+  (make-instance 'tfcloud-workspace
+                 :id (id tfcloud-workspace)
+                 :name (name tfcloud-workspace)
+                 :token nil
+                 :baseurl nil
+                 :proxy nil
+                 :cookie-jar nil))
+
+(defmacro define-tfcloud-api-call ((method-name) &body macro-body)
+  (let ((endpoint (gensym)))
+    `(progn
+       (defgeneric ,method-name (tfcloud uri &key method macro-content-type params paginate-p))
+       (defmethod ,method-name ((tfcloud tfcloud) uri &key method macro-content-type params paginate-p)
+         (let ((,endpoint (format nil "~a/~a" (baseurl tfcloud) uri))
+               (page "1")
+               results)
+           (loop until (null page) do
+             (multiple-value-bind (body status-code headers uri stream must-close reason)
+                 (apply #'org-ckons-http::drakma-request
+                        `(,,endpoint
+                          ,(cookie-jar tfcloud)
+                          :method ,method
+                          :content-type ,macro-content-type
+                          :proxy ,(proxy tfcloud)
+                          ,@(if (eq method :get)
+                                `(:parameters ,(append params (when paginate-p `(("page[number]" . ,(format nil "~a" page))
+                                                                                 ("page[size]" . "100")))))
+                                `(:content ,params))
+                          :additional-headers (("Authorization" . ,(format nil "Bearer ~a" (token tfcloud))))))
+               (declare (ignore headers uri stream must-close reason))
+               (let ((response (cl-json:decode-json-from-string (flexi-streams:octets-to-string body :external-format :utf-8))))
+                 (cond ((< status-code 300)
+                        (org-ckons-core::add-to-list results ,@macro-body)
+                        (setf page (when paginate-p
+                                     (cdr (assoc :next-page (cdr (assoc :pagination (cdr (assoc :meta response)))))))))
+                       (t
+                        (error (format nil "Error response from tfcloud.~%Method = [~a]~%Endpoint = [~a]~%Params = [~a]~%Page = [~a]~%Response = [~a]" method ,endpoint params page response)))))))
+           results)))))
+
+(define-tfcloud-api-call (tfcloud-default-impl)
+  (cdr (assoc :data response)))
+
+(defmethod get-tfcloud-workspaces ((tfcloud tfcloud) filter)
+  (sort (loop for workspace in (tfcloud-default-impl tfcloud "organizations/olo/workspaces" :method :get :paginate-p t)
+              when (org-ckons-core::match-it filter (cdr (assoc :name (cdr (assoc :attributes workspace)))))
+                collect (make-instance 'tfcloud-workspace
+                                       :id (cdr (assoc :id workspace))
+                                       :name (cdr (assoc :name (cdr (assoc :attributes workspace))))))
+        (lambda (x y) (string< (name x) (name y)))))
+
+(defmethod bg-perform ((tfcloud-workspace tfcloud-workspace))
+  (tfcloud-default-impl tfcloud-workspace
+                                "runs"
+                                :method :post
+                                :macro-content-type "application/vnd.api+json"
+                                :params (cl-json:encode-json-to-string `((:data . ((:attributes . ((:message . "Applied via Snow"))) (:type . "runs") (:relationships . ((:workspace . ((:data . ((:type . "workspaces") (:id . ,(id tfcloud-workspace))))))))))))))
+
+(defmethod apply-tfcloud-workspace ((tfcloud-workspace tfcloud-workspace))
+  (enqueue *queue-tfcloud* tfcloud-workspace))