diff --git a/examples/kubernetes.scm b/examples/kubernetes.scm index 52ddf95..97841eb 100644 --- a/examples/kubernetes.scm +++ b/examples/kubernetes.scm @@ -30,37 +30,65 @@ (hx-ops ;; ---- tintin: public app in namespace "tintin" ---- + ;; Explicit workload + ingress so it can show off the fuller deployment sugar: + ;; probes, rolling-update strategy, a second (metrics) port, pod annotations, + ;; an emptyDir scratch mount, and grace period. `expose` derives a (multi-port) + ;; Service from the container ports; `hpa`/`pdb` scale + protect it; the + ;; `ingress` carries an ingressClassName and two hosts. (with-namespace "tintin" ;; ServiceAccount + ClusterRole + ClusterRoleBinding in one op. (cluster-rbac "tintin" (rule (api-groups "") (resources "configmaps" "secrets") (verbs "get" "list" "watch")) (rule (api-groups "") (resources "pods" "services") (verbs "get" "list")) (rule (api-groups "apps") (resources "deployments") (verbs "get" "list" "watch"))) - (public-app "tintin" - (image "secure.io/tintin:1.0") - (port 8080) - (service-account "tintin") - (env-from (cm "tintin-config")) - (volumes (mount (sec "tintin-secret") "/etc/tintin/secret")) - (resources "100m-500m/128Mi")) + (expose + (deployment "tintin" + (image "secure.io/tintin:1.0") + (port 8080) + (ports (port "metrics" 9797)) ; a second container port + (replicas 2) + (service-account "tintin") + (env-from (cm "tintin-config")) + (volumes (mount (sec "tintin-secret") "/etc/tintin/secret") + (mount (empty-dir "scratch") "/tmp")) + (liveness (probe 8080 (http "/healthz") (initial-delay 5) (period 10))) + (readiness (probe 8080 (http "/readyz") (failure-threshold 3))) + (startup (probe 8080 (http "/healthz") (failure-threshold 30))) + (strategy (strategy "RollingUpdate" (max-surge "25%") (max-unavailable 0))) + (annotations (prometheus.io/scrape "true") (prometheus.io/port "9797")) + (termination-grace-period 30) + (resources "100m-500m/128Mi"))) + (ingress "tintin" + (class "nginx") + (host-rule "tintin.example.com" (service "tintin") (port 8080)) + (host-rule "www.tintin.example.com" (service "tintin") (port 8080))) + (hpa "tintin" (target "tintin") (min-replicas 2) (max-replicas 10) (cpu 80) (memory 75)) + (pdb "tintin" (min-available 1)) (configmap "tintin-config" (data (LOG_LEVEL "info") (FEATURE_MOON "true") (REGION "alpha5"))) (secret "tintin-secret" (data (API_TOKEN "dGludGluLXRva2Vu")))) ;; ---- loulou: internal app in namespace "loulou" ---- - (with-namespace "loulou" - (app "loulou" - (image "secure.io/loulou:2.1") - (port 9000) - (replicas 2) - (env-from (cm "loulou-config")) - (volumes (mount (sec "loulou-secret") "/etc/loulou/secret")) - (resources "200m-*/256Mi")) - (configmap "loulou-config" - (data (LOG_LEVEL "debug") (CACHE_SIZE "256"))) - (secret "loulou-secret" - (data (DB_PASSWORD "bG91bG91LXNlY3JldA==")))) + ;; Selects on `app.kubernetes.io/name` instead of the default `app` label, via + ;; `with-label-key` — so it interops with upstream charts that use that key. + ;; Everything inside (Deployment selector/labels, Service, PDB) picks it up. + (with-label-key 'app.kubernetes.io/name + (with-namespace "loulou" + (expose + (deployment "loulou" + (image "secure.io/loulou:2.1") + (port 9000) + (replicas 2) + (env-from (cm "loulou-config")) + (volumes (mount (sec "loulou-secret") "/etc/loulou/secret")) + (readiness (probe 9000 (tcp))) + (resources "200m-*/256Mi"))) + (pdb "loulou" (max-unavailable "25%")) + (configmap "loulou-config" + (data (LOG_LEVEL "debug") (CACHE_SIZE "256"))) + (secret "loulou-secret" + (data (DB_PASSWORD "bG91bG91LXNlY3JldA=="))))) ;; ---- cross-cutting ---- (tls-all) diff --git a/hexol/k8s.scm b/hexol/k8s.scm index 17ee0f5..bf85802 100644 --- a/hexol/k8s.scm +++ b/hexol/k8s.scm @@ -19,6 +19,20 @@ ;;; (http-route "app" (parent-name "edge") (backend-service "…") …) -> HTTPRoute ;;; (custom-resource (api "…") (kind "…") (name "…") (spec …)) -> any CRD ;;; (service-monitor "api" …) -> ServiceMonitor +;;; (hpa "api" (target "api") (max-replicas 10) (cpu 80)) -> HorizontalPodAutoscaler +;;; (pdb "api" (min-available 1)) -> PodDisruptionBudget +;;; +;;; Workload sub-specs (values for a deployment/daemonset field): +;;; (probe 8080 (http "/healthz") (initial-delay 5)) ; httpGet; (tcp)/(exec …) too +;;; (strategy "RollingUpdate" (max-surge "25%") (max-unavailable 0)) +;;; (port "metrics" 9797) one of several container/service ports +;;; (host-rule "a.com" (service "api") (port 80) [(path "/x")]) one ingress rule +;;; Deployment gains: liveness/readiness/startup probes, strategy, multiple +;;; `ports`, `annotations` (pod template), `termination-grace-period`. +;;; +;;; Label scheme: selectors + the forced identity label key on `current-label-key` +;;; (default `app`); `with-label-key` scopes an override (e.g. +;;; app.kubernetes.io/name), #f drops the forced label. ;;; ;;; Volume / env source refs (do NOT clash with the secret/configmap ;;; constructors): @@ -26,6 +40,7 @@ ;;; (sec "name") secret source ;;; (pvc "name") PersistentVolumeClaim source ;;; (host-path "/p") hostPath source +;;; (empty-dir "scratch") emptyDir scratch volume (name is arbitrary) ;;; (mount "/path" [#:read-only #t]) volume mount: source + path ;;; (env-from (cm "api-config")) ; whole-source env injection ;;; (volumes (mount (sec "tls") "/etc/tls")); mounted volume @@ -57,6 +72,8 @@ current-render-cache) #:export (;; namespace scope with-namespace current-k8s-namespace namespace + ;; label scheme + current-label-key with-label-key ;; compact resources spec res ;; resource sugar @@ -64,8 +81,11 @@ storage-class persistent-volume-claim gateway-class gateway listener http-route custom-resource service-monitor + hpa pdb + ;; workload sub-specs + probe strategy host-rule port ;; volume / env source refs - cm sec pvc mount host-path + cm sec pvc mount host-path empty-dir ;; RBAC service-account role role-binding rule cluster-role cluster-role-binding cluster-rbac @@ -88,6 +108,27 @@ (define current-k8s-namespace (make-parameter "default")) +;; --------------------------------------------------------------------------- +;; label scheme +;; --------------------------------------------------------------------------- +;; +;; Every workload/service keys its selector + default label on ONE key, `app` +;; by default. Charts that select on `app.kubernetes.io/name` scope it with +;; `with-label-key`; #f drops the forced label entirely (bring your own labels). + +(define current-label-key (make-parameter 'app)) + +(define (selector-labels name) + "The forced identity label/selector for NAME under the current label key +(empty when the key is #f)." + (let ((k (current-label-key))) + (if k `((,k . ,name)) '()))) + +;; Build-time scope, like `with-namespace`: bake KEY into the body's ops. +(define-syntax-rule (with-label-key key body ...) + (scope-ops 'with-label-key (current-label-key key) "label-key " + body ...)) + (define* (%namespace name #:key (labels '())) (resource `((apiVersion . "v1") (kind . "Namespace") (metadata (name . ,name) @@ -143,7 +184,7 @@ alist. Each side is \"req\" or \"req-lim\"; `*' or empty omits a bound." (define* (k8s-metadata name namespace #:optional (extra-labels '())) `(,@(if namespace `((namespace . ,namespace)) '()) (name . ,name) - (labels (app . ,name) ,@extra-labels))) + (labels ,@(selector-labels name) ,@extra-labels))) (define (envFrom-entries refs) (map (lambda (ref) @@ -161,9 +202,9 @@ alist. Each side is \"req\" or \"req-lim\"; `*' or empty omits a bound." #\-)) (define (volume-name kind ident) - (if (eq? kind 'hostPath) - (string-append "host-" (sanitize-name ident)) - (string-append (symbol->string kind) "-" ident))) + (cond ((eq? kind 'hostPath) (string-append "host-" (sanitize-name ident))) + ((eq? kind 'emptyDir) (sanitize-name ident)) ; user picks a friendly name + (else (string-append (symbol->string kind) "-" ident)))) (define (volume-entries refs) (map (lambda (ref) @@ -176,6 +217,8 @@ alist. Each side is \"req\" or \"req-lim\"; `*' or empty omits a bound." `((name . ,(volume-name kind n)) (persistentVolumeClaim (claimName . ,n)))) ((eq? kind 'hostPath) `((name . ,(volume-name kind n)) (hostPath (path . ,n)))) + ((eq? kind 'emptyDir) + `((name . ,(volume-name kind n)) (emptyDir))) (else (error "unknown volume kind:" kind))))) refs)) @@ -189,49 +232,76 @@ alist. Each side is \"req\" or \"req-lim\"; `*' or empty omits a bound." ,@(if ro '((readOnly . #t)) '())))) refs)) -(define* (container-alist #:key name image (port 0) (args '()) (command '()) +;; A port tuple (name number protocol target-port), shared by container `ports` +;; and multi-port `service`; matches the `cm`/`sec`/`mount` builder convention. +(define* (port name number #:key (protocol #f) (target-port #f)) + (list name number protocol target-port)) + +(define (containerPort-entries specs) + (map (lambda (p) + `((name . ,(list-ref p 0)) (containerPort . ,(list-ref p 1)) + ,@(if (list-ref p 2) `((protocol . ,(list-ref p 2))) '()))) + specs)) + +(define* (container-alist #:key name image (port 0) (ports '()) (args '()) (command '()) (env '()) (env-from '()) (volumes '()) (resources '()) - (privileged #f) (capabilities '()) (host-port #f) (protocol #f)) - (let ((resources (normalize-resources resources)) - (sec-ctx (append (if privileged '((privileged . #t)) '()) - (if (pair? capabilities) - `((capabilities (add ,@capabilities))) '())))) + (privileged #f) (capabilities '()) (host-port #f) (protocol #f) + (liveness '()) (readiness '()) (startup '())) + (let* ((resources (normalize-resources resources)) + (sec-ctx (append (if privileged '((privileged . #t)) '()) + (if (pair? capabilities) + `((capabilities (add ,@capabilities))) '()))) + (port-entries + (append + (if (and (number? port) (> port 0)) + `(((containerPort . ,port) + ,@(if host-port `((hostPort . ,host-port)) '()) + ,@(if protocol `((protocol . ,protocol)) '()))) + '()) + (containerPort-entries ports)))) `((name . ,name) (image . ,image) ,@(if (null? command) '() `((command ,@command))) ,@(if (null? args) '() `((args ,@args))) - ,@(if (and (number? port) (> port 0)) - `((ports ((containerPort . ,port) - ,@(if host-port `((hostPort . ,host-port)) '()) - ,@(if protocol `((protocol . ,protocol)) '())))) - '()) + ,@(if (null? port-entries) '() `((ports ,@port-entries))) ,@(if (null? env) '() `((env ,@env))) ,@(if (null? env-from) '() `((envFrom ,@(envFrom-entries env-from)))) ,@(if (null? volumes) '() `((volumeMounts ,@(volumeMount-entries volumes)))) + ,@(if (null? liveness) '() `((livenessProbe ,@liveness))) + ,@(if (null? readiness) '() `((readinessProbe ,@readiness))) + ,@(if (null? startup) '() `((startupProbe ,@startup))) ,@(if (null? resources) '() `((resources ,@resources))) ,@(if (null? sec-ctx) '() `((securityContext ,@sec-ctx)))))) -(define* (workload-alist #:key kind name image (port 0) (replicas #f) +(define* (workload-alist #:key kind name image (port 0) (ports '()) (replicas #f) (namespace (current-k8s-namespace)) (env '()) (env-from '()) (volumes '()) (resources '()) (privileged #f) (args '()) (command '()) (service-account #f) (host-network #f) (host-pid #f) - (labels '()) (capabilities '()) (host-port #f) (protocol #f)) + (labels '()) (annotations '()) (capabilities '()) (host-port #f) (protocol #f) + (liveness '()) (readiness '()) (startup '()) + (strategy '()) (termination-grace-period #f)) `((apiVersion . "apps/v1") (kind . ,kind) (metadata ,@(k8s-metadata name namespace labels)) (spec ,@(if replicas `((replicas . ,replicas)) '()) - (selector (matchLabels (app . ,name))) + ,@(if (null? strategy) '() `((strategy ,@strategy))) + (selector (matchLabels ,@(selector-labels name))) (template - (metadata (labels (app . ,name) ,@labels)) + (metadata (labels ,@(selector-labels name) ,@labels) + ,@(if (null? annotations) '() `((annotations ,@annotations)))) (spec ,@(if service-account `((serviceAccountName . ,service-account)) '()) ,@(if host-network `((hostNetwork . #t)) '()) ,@(if host-pid `((hostPID . #t)) '()) - (containers ,(container-alist #:name name #:image image #:port port + ,@(if termination-grace-period + `((terminationGracePeriodSeconds . ,termination-grace-period)) '()) + (containers ,(container-alist #:name name #:image image #:port port #:ports ports #:args args #:command command #:env env #:env-from env-from #:volumes volumes #:resources resources #:privileged privileged #:capabilities capabilities - #:host-port host-port #:protocol protocol)) + #:host-port host-port #:protocol protocol + #:liveness liveness #:readiness readiness + #:startup startup)) ,@(if (null? volumes) '() `((volumes ,@(volume-entries volumes))))))))) ;; --------------------------------------------------------------------------- @@ -246,34 +316,82 @@ alist. Each side is \"req\" or \"req-lim\"; `*' or empty omits a bound." (define (sec name) (list 'secret name)) (define (pvc name) (list 'pvc name)) (define (host-path path) (list 'hostPath path)) +(define (empty-dir name) (list 'emptyDir name)) ; scratch volume; NAME is arbitrary (define* (mount source path #:key (read-only #f)) (append source (list path read-only))) +;; --------------------------------------------------------------------------- +;; workload sub-specs — probe / strategy +;; --------------------------------------------------------------------------- +;; +;; Small record-body builders whose #:build returns an alist (like `rule`), fed +;; to a workload's `liveness`/`readiness`/`startup` and `strategy` fields. + +;; (probe 8080 (http "/healthz") (initial-delay 5)) ; httpGet by default +;; (probe 5432 (tcp)) ; tcpSocket +;; (probe 0 (exec "cat" "/tmp/ready")) ; exec (port ignored) +(define-construct probe + #:head port + #:fields ((http #:default #f) (tcp #:flag) (exec #:list) + (initial-delay #:default #f) (period #:default #f) (timeout #:default #f) + (success-threshold #:default #f) (failure-threshold #:default #f)) + #:build (append + (cond ((pair? exec) `((exec (command ,@exec)))) + (tcp `((tcpSocket (port . ,port)))) + (else `((httpGet (path . ,(or http "/")) (port . ,port))))) + (filter pair? + (list (and initial-delay (cons 'initialDelaySeconds initial-delay)) + (and period (cons 'periodSeconds period)) + (and timeout (cons 'timeoutSeconds timeout)) + (and success-threshold (cons 'successThreshold success-threshold)) + (and failure-threshold (cons 'failureThreshold failure-threshold)))))) + +;; (strategy "RollingUpdate" (max-surge "25%") (max-unavailable 0)) | (strategy "Recreate") +(define-construct strategy + #:head type + #:fields ((max-surge #:default #f) (max-unavailable #:default #f)) + #:build `((type . ,type) + ,@(if (or max-surge max-unavailable) + `((rollingUpdate + ,@(filter pair? + (list (and max-surge (cons 'maxSurge max-surge)) + (and max-unavailable (cons 'maxUnavailable max-unavailable)))))) + '()))) + ;; --------------------------------------------------------------------------- ;; resource sugar ;; --------------------------------------------------------------------------- -(define* (%deployment #:key name image (port 8080) (replicas 1) (namespace (current-k8s-namespace)) +(define* (%deployment #:key name image (port 8080) (ports '()) (replicas 1) + (namespace (current-k8s-namespace)) (env '()) (env-from '()) (volumes '()) (resources '()) (privileged #f) - (args '()) (command '()) (service-account #f) (labels '())) - (resource (workload-alist #:kind "Deployment" #:name name #:image image #:port port + (args '()) (command '()) (service-account #f) (labels '()) (annotations '()) + (liveness '()) (readiness '()) (startup '()) + (strategy '()) (termination-grace-period #f)) + (resource (workload-alist #:kind "Deployment" #:name name #:image image #:port port #:ports ports #:replicas replicas #:namespace namespace #:env env #:env-from env-from #:volumes volumes #:resources resources #:privileged privileged #:args args #:command command #:service-account service-account - #:labels labels))) + #:labels labels #:annotations annotations + #:liveness liveness #:readiness readiness #:startup startup + #:strategy strategy #:termination-grace-period termination-grace-period))) (define-construct deployment #:head name - #:fields ((image #:required) (port #:default 8080) (replicas #:default 1) + #:fields ((image #:required) (port #:default 8080) (ports #:list) (replicas #:default 1) (namespace #:default (current-k8s-namespace)) (env #:list) (env-from #:list) (volumes #:list) (resources #:default '()) (privileged #:flag) (args #:list) (command #:list) - (service-account #:default #f) (labels #:map)) - #:build (%deployment #:name name #:image image #:port port #:replicas replicas + (service-account #:default #f) (labels #:map) (annotations #:map) + (liveness #:default '()) (readiness #:default '()) (startup #:default '()) + (strategy #:default '()) (termination-grace-period #:default #f)) + #:build (%deployment #:name name #:image image #:port port #:ports ports #:replicas replicas #:namespace namespace #:env env #:env-from env-from #:volumes volumes #:resources resources #:privileged privileged #:args args #:command command - #:service-account service-account #:labels labels)) + #:service-account service-account #:labels labels #:annotations annotations + #:liveness liveness #:readiness readiness #:startup startup + #:strategy strategy #:termination-grace-period termination-grace-period)) (define-construct daemonset #:head name @@ -291,38 +409,69 @@ alist. Each side is \"req\" or \"req-lim\"; `*' or empty omits a bound." #:host-network host-network #:host-pid host-pid #:labels labels #:capabilities capabilities #:host-port host-port #:protocol protocol))) +(define (servicePort-entries specs) + (map (lambda (p) + (let ((name (list-ref p 0)) (num (list-ref p 1)) + (proto (list-ref p 2)) (tp (list-ref p 3))) + `((name . ,name) (port . ,num) (targetPort . ,(or tp num)) + ,@(if proto `((protocol . ,proto)) '())))) + specs)) + +;; Single port via #:port/#:target-port/#:port-name, or several via #:ports +;; (a list of `port` tuples): (service "api" (ports (port "http" 80) (port "grpc" 9090))). (define-construct service #:head name - #:fields ((port #:required) (target-port #:default port) (port-name #:default "http") + #:fields ((port #:default #f) (target-port #:default port) (port-name #:default "http") + (ports #:list) (namespace #:default (current-k8s-namespace)) (type #:default #f) (selector-name #:default #f) (labels #:map)) - #:build (let ((sel (or selector-name name))) + #:build (let* ((sel (or selector-name name)) + (specs (cond ((pair? ports) ports) + (port (list (list port-name port #f target-port))) + (else (error "service: needs (port …) or (ports …)"))))) (resource `((apiVersion . "v1") (kind . "Service") (metadata ,@(k8s-metadata name namespace labels)) - (spec (selector (app . ,sel)) + (spec (selector ,@(selector-labels sel)) ,@(if type `((type . ,type)) '()) - (ports ((name . ,port-name) (port . ,port) (targetPort . ,target-port)))))))) - -(define* (%ingress #:key name port (host #f) (namespace (current-k8s-namespace)) (path "/") (labels '())) - (let ((h (or host (string-append name ".example.com")))) + (ports ,@(servicePort-entries specs))))))) + +;; One host+path rule for `ingress` (repeat for more hosts or paths): +;; (host-rule "a.com" (service "api") (port 80) (path "/api")) +(define-construct host-rule + #:head host + #:fields ((service #:required) (port #:required) + (path #:default "/") (path-type #:default "Prefix")) + #:build `((host . ,host) + (http (paths ((path . ,path) (pathType . ,path-type) + (backend (service (name . ,service) (port (number . ,port))))))))) + +(define* (%ingress #:key name port (host #f) (class #f) (hosts '()) + (namespace (current-k8s-namespace)) (path "/") (labels '())) + (let* ((h (or host (string-append name ".example.com"))) + (rules (if (pair? hosts) hosts + `(((host . ,h) + (http (paths ((path . ,path) + (pathType . "Prefix") + (backend (service (name . ,name) + (port (number . ,port)))))))))))) (resource `((apiVersion . "networking.k8s.io/v1") (kind . "Ingress") (metadata ,@(k8s-metadata name namespace labels)) - (spec (rules ((host . ,h) - (http (paths ((path . ,path) - (pathType . "Prefix") - (backend (service (name . ,name) - (port (number . ,port)))))))))))))) + (spec ,@(if class `((ingressClassName . ,class)) '()) + (rules ,@rules)))))) +;; Simple single host/path via #:port/#:host/#:path, or several via repeated +;; `host-rule` (each an `ingress-host`); #:class sets ingressClassName. (define-construct ingress #:head name - #:fields ((port #:required) (host #:default #f) + #:fields ((port #:default #f) (host #:default #f) (class #:default #f) + (host-rule #:repeated #:construct host-rule) (namespace #:default (current-k8s-namespace)) (path #:default "/") (labels #:map)) - #:build (%ingress #:name name #:port port #:host host #:namespace namespace - #:path path #:labels labels)) + #:build (%ingress #:name name #:port port #:host host #:class class #:hosts host-rule + #:namespace namespace #:path path #:labels labels)) (define-construct configmap #:head name @@ -401,9 +550,51 @@ alist. Each side is \"req\" or \"req-lim\"; `*' or empty omits a bound." #:build (%custom-resource #:api "monitoring.coreos.com/v1" #:kind "ServiceMonitor" #:name name #:namespace namespace #:labels labels - #:spec `((selector (matchLabels (app . ,name))) + #:spec `((selector (matchLabels ,@(selector-labels name))) (endpoints ((port . ,port) (path . ,path) (interval . ,interval)))))) +;; --------------------------------------------------------------------------- +;; autoscaling / disruption +;; --------------------------------------------------------------------------- + +(define (metric-resource res pct) + `((type . "Resource") + (resource (name . ,res) + (target (type . "Utilization") (averageUtilization . ,pct))))) + +;; (hpa "api" (target "api") (max-replicas 10) (cpu 80) (memory 75)) +(define-construct hpa + #:head name + #:fields ((target #:required) (target-kind #:default "Deployment") + (min-replicas #:default 1) (max-replicas #:required) + (cpu #:default #f) (memory #:default #f) + (namespace #:default (current-k8s-namespace)) (labels #:map)) + #:build (resource + `((apiVersion . "autoscaling/v2") + (kind . "HorizontalPodAutoscaler") + (metadata ,@(k8s-metadata name namespace labels)) + (spec (scaleTargetRef (apiVersion . "apps/v1") (kind . ,target-kind) (name . ,target)) + (minReplicas . ,min-replicas) + (maxReplicas . ,max-replicas) + (metrics ,@(filter pair? + (list (and cpu (metric-resource "cpu" cpu)) + (and memory (metric-resource "memory" memory))))))))) + +;; (pdb "api" (min-available 1)) | (pdb "api" (max-unavailable "25%")) +(define-construct pdb + #:head name + #:fields ((min-available #:default #f) (max-unavailable #:default #f) + (selector-name #:default #f) + (namespace #:default (current-k8s-namespace)) (labels #:map)) + #:build (let ((sel (or selector-name name))) + (resource + `((apiVersion . "policy/v1") + (kind . "PodDisruptionBudget") + (metadata ,@(k8s-metadata name namespace labels)) + (spec ,@(if min-available `((minAvailable . ,min-available)) '()) + ,@(if max-unavailable `((maxUnavailable . ,max-unavailable)) '()) + (selector (matchLabels ,@(selector-labels sel)))))))) + ;; --------------------------------------------------------------------------- ;; Gateway API ;; --------------------------------------------------------------------------- @@ -672,7 +863,7 @@ JSON with yq, and appends every manifest it yields to (kubernetes_resources)." ports))) `((apiVersion . "v1") (kind . "Service") - (metadata ,@(if ns `((namespace . ,ns)) '()) (name . ,name) (labels (app . ,name))) + (metadata ,@(if ns `((namespace . ,ns)) '()) (name . ,name) (labels ,@selector)) (spec (selector ,@selector) (ports ,@port-entries))))) diff --git a/test/construct.scm b/test/construct.scm index b3c7832..f399069 100644 --- a/test/construct.scm +++ b/test/construct.scm @@ -80,6 +80,23 @@ '("z" "X" ((foo . "bar") (nums 1 2 3))) (openrec "z" (kind "X") (foo "bar") (nums 1 2 3))) +;; ---- a sub-construct's value used as a scalar field (the probe-in-liveness +;; pattern the k8s workload sugar relies on) ---- +(define-construct healthcheck + #:head port + #:fields ((path #:default "/")) + #:build `((httpGet (path . ,path) (port . ,port)))) +(define-construct workload2 + #:head name + #:fields ((live #:default '())) + #:build (list name live)) +(format #t "~%construct: nested construct value in a scalar field~%") +(check "scalar field holds another construct's alist" + '("api" ((httpGet (path . "/healthz") (port . 8080)))) + (workload2 "api" (live (healthcheck 8080 (path "/healthz"))))) +(check "scalar field default when nested construct absent" + '("api" ()) (workload2 "api")) + (format #t "~%~a~%" (if (zero? failures) "all construct checks passed" (format #f "~a CONSTRUCT CHECK(S) FAILED" failures))) (exit (if (zero? failures) 0 1)) diff --git a/test/k8s-res.scm b/test/k8s-res.scm index 16b2fbb..ae592b6 100644 --- a/test/k8s-res.scm +++ b/test/k8s-res.scm @@ -12,6 +12,7 @@ (add-to-load-path (dirname (dirname (current-filename)))) (use-modules (hexol k8s) + (hexol kernel) (ice-9 format)) (define failures 0) @@ -83,6 +84,102 @@ (limits (memory . "128Mi"))) (res "100m-/128Mi")) +;; --------------------------------------------------------------------------- +;; resource sugar — render an op and inspect the produced alist +;; --------------------------------------------------------------------------- + +(define (render op) + "Resolve OP alone and return the first resource alist it appends." + (car (state-get (resolve (list op) '()) '(kubernetes_resources)))) + +(format #t "~%k8s: deployment — probes / ports / strategy / annotations / emptyDir / grace~%") +(define dep + (render (deployment "api" (image "i") (port 8080) + (ports (port "grpc" 9090) (port "metrics" 9797)) + (liveness (probe 8080 (http "/healthz") (initial-delay 5))) + (readiness (probe 8080 (tcp))) + (startup (probe 0 (exec "sh" "-c" "true"))) + (strategy (strategy "RollingUpdate" (max-surge "25%") (max-unavailable 0))) + (annotations (prometheus.io/scrape "true")) + (termination-grace-period 30) + (volumes (mount (empty-dir "cache") "/cache"))))) +(define c0 (path-get dep '(spec template spec containers 0))) +(check "container ports: single + multi merged" + '(((containerPort . 8080)) + ((name . "grpc") (containerPort . 9090)) + ((name . "metrics") (containerPort . 9797))) + (assq-ref c0 'ports)) +(check "livenessProbe httpGet + timing" + '((httpGet (path . "/healthz") (port . 8080)) (initialDelaySeconds . 5)) + (assq-ref c0 'livenessProbe)) +(check "readinessProbe tcpSocket" '((tcpSocket (port . 8080))) (assq-ref c0 'readinessProbe)) +(check "startupProbe exec" '((exec (command "sh" "-c" "true"))) (assq-ref c0 'startupProbe)) +(check "strategy RollingUpdate + rollingUpdate block" + '((type . "RollingUpdate") (rollingUpdate (maxSurge . "25%") (maxUnavailable . 0))) + (path-get dep '(spec strategy))) +(check "pod template annotations" + '((prometheus.io/scrape . "true")) + (path-get dep '(spec template metadata annotations))) +(check "terminationGracePeriodSeconds" 30 + (path-get dep '(spec template spec terminationGracePeriodSeconds))) +(check "emptyDir volume" '((name . "cache") (emptyDir)) + (path-get dep '(spec template spec volumes 0))) + +(format #t "~%k8s: service — multi-port and single-port back-compat~%") +(check "multi-port service" + '(((name . "http") (port . 80) (targetPort . 8080)) + ((name . "grpc") (port . 9090) (targetPort . 9090))) + (path-get (render (service "api" (ports (port "http" 80 #:target-port 8080) + (port "grpc" 9090)))) + '(spec ports))) +(check "single-port service unchanged" + '(((name . "http") (port . 80) (targetPort . 80))) + (path-get (render (service "web" (port 80))) '(spec ports))) + +(format #t "~%k8s: hpa — autoscaling/v2 with cpu/memory targets~%") +(define h (render (hpa "api" (target "api") (max-replicas 10) (cpu 80) (memory 75)))) +(check "hpa apiVersion+kind" + '("autoscaling/v2" . "HorizontalPodAutoscaler") + (cons (assq-ref h 'apiVersion) (assq-ref h 'kind))) +(check "hpa spec" + '((scaleTargetRef (apiVersion . "apps/v1") (kind . "Deployment") (name . "api")) + (minReplicas . 1) (maxReplicas . 10) + (metrics ((type . "Resource") + (resource (name . "cpu") + (target (type . "Utilization") (averageUtilization . 80)))) + ((type . "Resource") + (resource (name . "memory") + (target (type . "Utilization") (averageUtilization . 75)))))) + (assq-ref h 'spec)) + +(format #t "~%k8s: pdb — policy/v1~%") +(define pd (render (pdb "api" (min-available 1)))) +(check "pdb apiVersion" "policy/v1" (assq-ref pd 'apiVersion)) +(check "pdb spec" '((minAvailable . 1) (selector (matchLabels (app . "api")))) + (assq-ref pd 'spec)) + +(format #t "~%k8s: ingress — class + multiple hosts/paths, single back-compat~%") +(define ing (render (ingress "web" (class "nginx") + (host-rule "a.com" (service "web") (port 80)) + (host-rule "b.com" (service "api") (port 8080) (path "/api"))))) +(check "ingressClassName" "nginx" (path-get ing '(spec ingressClassName))) +(check "hosts a.com / b.com" + '("a.com" "b.com") + (list (path-get ing '(spec rules 0 host)) (path-get ing '(spec rules 1 host)))) +(check "second rule path" "/api" (path-get ing '(spec rules 1 http paths 0 path))) +(check "single-host ingress unchanged" + "web.io" + (path-get (render (ingress "web" (port 80) (host "web.io"))) '(spec rules 0 host))) + +(format #t "~%k8s: label scheme — default app, overridable key~%") +(check "default label key is app" + '((app . "api")) + (path-get (render (deployment "api" (image "i"))) '(spec selector matchLabels))) +(check "with-label-key overrides selector + labels" + '((app.kubernetes.io/name . "api")) + (path-get (render (with-label-key 'app.kubernetes.io/name (deployment "api" (image "i")))) + '(spec selector matchLabels))) + (format #t "~%~a~%" (if (zero? failures) "all checks passed"