;;; -*- 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))