init

.gitignore

@@ -0,0 +1,9 @@
+*.abcl
+*.fasl
+*.dx32fsl
+*.dx64fsl
+*.lx32fsl
+*.lx64fsl
+*.x86f
+*~
+.#*

README.org

@@ -0,0 +1,12 @@
+* K8splayground
+
+Playing around with using CLOG to set up kind clusters for teaching
+different techniques for canarying.
+
+** Author
+
++ Adam Mohammed (adam@fixergrid.net)
+
+** Copyright
+
+Copyright (c) 2023 Adam Mohammed (adam@fixergrid.net)

k8splayground.asd

@@ -0,0 +1,21 @@
+(defsystem "k8splayground"
+  :version "0.1.0"
+  :author "Adam Mohammed"
+  :license ""
+  :depends-on ("yason")
+  :components ((:module "src"
+                :components
+                ((:file "main"))))
+  :description ""
+  :in-order-to ((test-op (test-op "k8splayground/tests"))))
+
+(defsystem "k8splayground/tests"
+  :author "Adam Mohammed"
+  :license ""
+  :depends-on ("k8splayground"
+               "rove")
+  :components ((:module "tests"
+                :components
+                ((:file "main"))))
+  :description "Test system for k8splayground"
+  :perform (test-op (op c) (symbol-call :rove :run c)))

src/main.lisp

@@ -0,0 +1,116 @@
+(defpackage k8splayground
+  (:use :cl)
+  (:export :create-kube-cluster)
+  (:import-from #:yason
+		#:parse)
+  (:import-from #:uiop
+		#:run-program))
+
+
+(in-package :k8splayground)
+
+(defclass demo-cluster ()
+  ((name :accessor cluster-name
+	 :documentation "name of the k8s cluster.")
+   (deployments :accessor k8s-deployments
+		:initform '()
+		:documentation "currently active deployments")
+   (services :accessor k8s-services
+	     :initform '()
+	     :documentation "currently active services")))
+
+(defun kind-executable ()
+  "Determine the location of the `kind` executable"
+  "/home/adammo/go/bin/kind")
+
+(defun kubectl-executable ()
+  "Location for kubectl"
+  "/usr/local/bin/kubectl")
+
+(defun initial-deployment-files ()
+  "Files to deploy when the cluster first starts."
+  "/home/adammo/repos/k8splayground/src/tutorial0/deployment.yaml")
+
+(defun create-kube-cluster (name)
+  (let ((result (nth-value 2 (run-program (create-kube-cluster-command name) :output *STANDARD-OUTPUT*))))
+    (= 0 result)))
+
+(defun delete-kube-cluster (cluster)
+  (let ((result (nth-value 2 (run-program (delete-kube-cluster-command cluster) :output *STANDARD-OUTPUT*))))
+    (= 0 result)))
+
+(defun create-kube-cluster-command (name)
+  "Create the command to create the cluster."
+  (list (kind-executable) "create" "cluster" "--name" name))
+
+(defun delete-kube-cluster-command (cluster)
+  "Lists the existing kube clusters."
+  (list (kind-executable) "delete" "cluster" "--name" (cluster-name cluster)))
+
+
+(defun update-cluster (cluster)
+  "Fetches the latest state for the cluster."
+  (progn
+    (update-cluster-deployments cluster)
+    (update-cluster-services cluster)
+    cluster))
+
+
+(defun fetch-resources (resource)
+  (let* ((api-response (run-program (list "/usr/local/bin/kubectl" "get" resource "-o" "json") :output :string))
+	 (json-resp (parse api-response))
+	 (resources  (gethash "items" json-resp)))
+    (loop for r in resources
+	  collect (gethash "name" (gethash "metadata" r)))))
+
+(defun update-cluster-deployments (cluster)
+  (let ((active-deployments (fetch-resources "deployments")))
+    (setf (k8s-deployments cluster) active-deployments)))
+
+(defun update-cluster-services (cluster)
+  (let ((active-services (fetch-resources "services")))
+    (setf (k8s-services cluster) active-services)))
+
+(defun bring-up-environment (name)
+  "Starts a kind cluster and applies yaml and updates the cluster-state"
+  (let ((cluster (make-instance 'demo-cluster))
+	(kcname (format nil "kind-~A" name))
+	(output *STANDARD-OUTPUT*))
+    (format output "Creating cluster ~A... This may take a few seconds.~%" name)
+    (setf (cluster-name cluster) name)
+    (create-kube-cluster name)
+    (format output "Switching Kube context.~%")
+    (run-program `(,(kubectl-executable) "config" "use-context" ,kcname) :output output)
+    (format output "Creating K8s resources.~%")
+    (run-program `(,(kubectl-executable) "apply" "-f" ,(initial-deployment-files)) :ouptut output)
+    (format output "Refreshing cluster state.~%")
+    (update-cluster cluster)))
+
+(defun update-drop-list (drop-list items)
+  (loop for i in items
+	  do (clog:create-list-item (clog-drop-list:drop-root drop-list) :content i)))
+
+(defun update-cluster-ui (dep-drop svc-drop cluster)
+  (progn
+    (update-cluster cluster)
+    (update-drop-list dep-drop (k8s-deployments cluster))
+    (update-drop-list svc-drop (k8s-services cluster))))
+
+(defun on-new-window (body)
+  (let ((active-name (clog:create-child body (format nil "<h1>Cluster Name: kind-~A</h1>" (cluster-name *ACTIVE-CLUSTER*))))
+	 (dep-drop (clog-drop-list:create-drop-list body :content "Deployments"))
+	 (svc-drop (clog-drop-list:create-drop-list body :content "Services"))
+	 (refresh-btn (clog:create-button body :content "⟳ Refresh")))
+    (declare (ignore active-name))
+    (setf (clog:background-color body) "#3B4252")
+    (setf (clog:color body) "#ECEFF4")
+    (update-cluster-ui dep-drop svc-drop *ACTIVE-CLUSTER*)
+    (clog:set-on-click refresh-btn (lambda (obj)
+				     (declare (ignore obj))
+				     (let ((new-dep-drop (clog-drop-list:create-drop-list body :auto-place nil :content "Deployments"))
+					   (new-svc-drop (clog-drop-list:create-drop-list body :auto-place nil :content "Services")))
+				       (update-cluster-ui new-dep-drop new-svc-drop *ACTIVE-CLUSTER*)
+				       (clog:replace-element dep-drop new-dep-drop)
+				       (setf dep-drop new-dep-drop)
+				       (clog:replace-element svc-drop new-svc-drop)
+				       (setf svc-drop new-svc-drop))))))

src/tutorial0/deployment.yaml

@@ -0,0 +1,41 @@
+---
+apiVersion: apps/v1
+kind: Deployment
+metadata:
+  labels:
+    app: demo-echo-server
+  name: demo-echo-server
+spec:
+  replicas: 3
+  selector:
+    matchLabels:
+      app: demo-echo-server
+  strategy: {}
+  template:
+    metadata:
+      labels:
+        app: demo-echo-server
+    spec:
+      containers:
+        - image: docker.io/hashicorp/http-echo
+          name: echo-server
+          env:
+            - name: POD_NAME
+              valueFrom:
+                fieldRef:
+                  fieldPath: metadata.name
+          command:
+            - /http-echo
+            - -text=$(POD_NAME)
+---
+apiVersion: v1
+kind: Service
+metadata:
+  name: demo-echo-service
+spec:
+  selector:
+    app: demo-echo-server
+  ports:
+    - name: web
+      port: 8080
+      targetPort: 5678

tests/main.lisp

@@ -0,0 +1,12 @@
+(defpackage k8splayground/tests/main
+  (:use :cl
+        :k8splayground
+        :rove))
+(in-package :k8splayground/tests/main)
+
+;; NOTE: To run this test file, execute `(asdf:test-system :k8splayground)' in your Lisp.
+
+(deftest make-k8s-cluster
+  (testing "should create a k8s-cluster"
+    (let ((cluster (k8smake-k8s-cluster)))
+      (ok (= "test" (k8splayground:cluster-name cluster))))))