diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/octopus/octopus.lisp | 161 | ||||
| -rw-r--r-- | lisp/service/menu-service.lisp | 5 | ||||
| -rw-r--r-- | lisp/service/octopus-environments-with-roles-service.lisp | 4 | ||||
| -rw-r--r-- | lisp/service/octopus-latest-deployments-service.lisp | 13 | ||||
| -rw-r--r-- | lisp/service/octopus-machines-with-roles-service.lisp | 2 | ||||
| -rw-r--r-- | lisp/service/octopus-ode-deploy-release-service.lisp | 2 | ||||
| -rw-r--r-- | lisp/service/octopus-projects-with-roles-service.lisp | 4 | ||||
| -rw-r--r-- | lisp/service/octopus-qrs-lsrs-redeploy-service.lisp | 72 | ||||
| -rw-r--r-- | lisp/service/rest-service.lisp | 3 | ||||
| -rw-r--r-- | lisp/snow.asd | 3 | ||||
| -rw-r--r-- | lisp/webapps/snow/clojurescript/snow/src/core.cljs | 102 | ||||
| -rw-r--r-- | lisp/webapps/snow/site.lisp | 20 |
12 files changed, 312 insertions, 79 deletions
diff --git a/lisp/octopus/octopus.lisp b/lisp/octopus/octopus.lisp index 88712a3..61302bf 100644 --- a/lisp/octopus/octopus.lisp +++ b/lisp/octopus/octopus.lisp @@ -71,6 +71,9 @@ (version-control-reference :initarg :version-control-reference :initform nil :accessor version-control-reference) + (channel-id :initarg :channel-id + :initform nil + :accessor channel-id) (project :initarg :project :initform nil :accessor project)) @@ -89,6 +92,9 @@ (environment :initarg :environment :initform nil :accessor environment) + (channel-id :initarg :channel-id + :initform nil + :accessor channel-id) (project :initarg :project :initform nil :accessor project) @@ -136,16 +142,16 @@ as an input filter are stored here for the ride through the queue.") :accessor stdout)) (:documentation "")) -(defclass octopus-ode-deploy-release (octopus) +(defclass octopus-deploy-release (octopus) ((project-name :initarg :project-name :initform nil :accessor project-name) - (ode-names :initarg :ode-names - :initform nil - :accessor ode-names) (version :initarg :version :initform nil :accessor version) + (environment-name :initarg :environment-name + :initform nil + :accessor environment-name) (environment :initarg :environment :initform nil :accessor environment) @@ -160,6 +166,12 @@ as an input filter are stored here for the ride through the queue.") :accessor stdout)) (:documentation "")) +(defclass octopus-ode-deploy-release (octopus-deploy-release) + ((ode-names :initarg :ode-names + :initform nil + :accessor ode-names)) + (:documentation "")) + (defclass octopus-latest-deployment () ((deployment-id :initarg :deployment-id :initform nil @@ -170,6 +182,9 @@ as an input filter are stored here for the ride through the queue.") (release-version :initarg :release-version :initform nil :accessor release-version) + (channel-id :initarg :channel-id + :initform nil + :accessor channel-id) (git-commit :initarg :git-commit :initform nil :accessor git-commit) @@ -230,27 +245,30 @@ as an input filter are stored here for the ride through the queue.") (define-octopus-api-call (get-octopus-items-process-steps-impl) (cdr (assoc :*steps response))) -(defmethod get-octopus-environments ((octopus octopus) &key ode-only-p filter) +(defmacro filter-match-p (filter &body body) + `(or (null ,filter) + (string= "all" (car ,filter)) + (intersection (loop for f in ,filter + when (not (string= "all" f)) + collect f) + ,@body + :test (lambda (x y) (org-ckons-core::match-it x y))))) + +(defmethod get-octopus-environments ((octopus octopus) &key ode-only-p environment-filter) (sort (loop for environment in (get-octopus-items-default-impl octopus "environments" :method :get :params `(("name" . ,(if ode-only-p "OnDemand-" "")))) - when (or (null filter) - (string= "all" (car filter)) - (intersection (loop for f in filter - when (not (string= "all" f)) - collect f) - `(,(cdr (assoc :*name environment))) - :test (lambda (x y) (org-ckons-core::match-it x y)))) + when (filter-match-p environment-filter `(,(cdr (assoc :*name environment)))) collect (make-instance 'octopus-environment :id (cdr (assoc :*id environment)) :name (cdr (assoc :*name environment)))) (lambda (x y) (string< (name x) (name y))))) -(defmethod get-octopus-ode-environments ((octopus octopus) &key filter) +(defmethod get-octopus-ode-environments ((octopus octopus) &key environment-filter) (get-octopus-environments octopus :ode-only-p t - :filter (if (string= "all" (car filter)) - filter - (loop for f in filter - collect (format nil "OnDemand-~a" f))))) + :environment-filter (if (string= "all" (car environment-filter)) + environment-filter + (loop for f in environment-filter + collect (format nil "OnDemand-~a" f))))) (defmethod get-octopus-projects ((octopus octopus)) (sort (loop for project in (get-octopus-items-default-impl octopus "projects" :method :get) @@ -289,6 +307,7 @@ as an input filter are stored here for the ride through the queue.") :id (cdr (assoc :*id release)) :version (cdr (assoc :*version release)) :version-control-reference (cdr (assoc :*version-control-reference release)) + :channel-id (cdr (assoc :*channel-id release)) :project project)) (lambda (x y) (string< (version x) (version y))))) @@ -319,24 +338,22 @@ as an input filter are stored here for the ride through the queue.") (lambda (x y) (string< (name x) (name y)))) :test (lambda (x y) (string= (name x) (name y)))))) -(defmethod do-octopus-deployment ((octopus-ode-deploy-release octopus-ode-deploy-release)) - (let ((deployment (get-octopus-items-raw-impl octopus-ode-deploy-release +(defmethod do-octopus-deployment ((octopus-deploy-release octopus-deploy-release)) + (let ((deployment (get-octopus-items-raw-impl octopus-deploy-release "deployments" :method :post :params (json:encode-json-alist-to-string - `((:*environment-id . ,(id (environment octopus-ode-deploy-release))) - (:*project-id . ,(id (project octopus-ode-deploy-release))) - (:*release-id . ,(id (release octopus-ode-deploy-release))) - (:*use-guided-failure . nil) - (:*force-package-download . t) - (:*force-package-redeployment . t)))))) + `((:*environment-id . ,(id (environment octopus-deploy-release))) + (:*project-id . ,(id (project octopus-deploy-release))) + (:*release-id . ,(id (release octopus-deploy-release)))))))) (when deployment (make-instance 'octopus-deployment :id (cdr (assoc :*id deployment)) :task-id (cdr (assoc :*task-id deployment)) - :environment (environment octopus-ode-deploy-release) - :project (project octopus-ode-deploy-release) - :release (release octopus-ode-deploy-release))))) + :environment (environment octopus-deploy-release) + :channel-id (cdr (assoc :*channel-id deployment)) + :project (project octopus-deploy-release) + :release (release octopus-deploy-release))))) (defmethod get-octopus-task ((octopus octopus) task-id) (let ((task (get-octopus-items-raw-impl octopus (format nil "tasks/~a" task-id) :method :get))) @@ -364,58 +381,80 @@ as an input filter are stored here for the ride through the queue.") (defmethod get-octopus-projects-with-roles ((octopus-process-step octopus-process-step)) (enqueue *queue-octopus-fast* octopus-process-step)) -(defmethod bg-perform ((octopus-ode-deploy-release octopus-ode-deploy-release)) +(defmethod bg-perform ((octopus-deploy-release octopus-deploy-release)) (let ((output (make-array '(0) :element-type 'character :fill-pointer 0 :adjustable t)) - (deployment (do-octopus-deployment octopus-ode-deploy-release)) + (deployment (do-octopus-deployment octopus-deploy-release)) task) (with-output-to-string (stream output) (format stream "Deployed ~a ~a ~a ~a to ~a ~a~%" - (name (project octopus-ode-deploy-release)) - (id (project octopus-ode-deploy-release)) - (id (release octopus-ode-deploy-release)) + (name (project octopus-deploy-release)) + (id (project octopus-deploy-release)) + (id (release octopus-deploy-release)) (task-id deployment) - (id (environment octopus-ode-deploy-release)) - (name (environment octopus-ode-deploy-release))) + (id (environment octopus-deploy-release)) + (name (environment octopus-deploy-release))) (loop while (or (not task) (not (completed-p task))) do (sleep 15) - (setf task (get-octopus-task octopus-ode-deploy-release (task-id deployment)))) + (setf task (get-octopus-task octopus-deploy-release (task-id deployment)))) (when (not (successful-p task)) (format stream " ~a failed: ~a~%" (id task) (error-message task))) (format stream "~%")) - (with-open-file (stream (stdout octopus-ode-deploy-release) :direction :output :if-exists :append :if-does-not-exist :create) + (with-open-file (stream (stdout octopus-deploy-release) :direction :output :if-exists :append :if-does-not-exist :create) (format stream output)))) +(defmethod do-octopus-enqueue-deploy-release ((octopus-deploy-release octopus-deploy-release)) + (let ((job (make-instance 'octopus-deploy-release + :project-name (project-name octopus-deploy-release) + :version (version octopus-deploy-release) + :project (project octopus-deploy-release) + :release (release octopus-deploy-release) + :environment (environment octopus-deploy-release) + :stdout (stdout octopus-deploy-release)))) + (cond ((or (string= "Platform Database Release" (project-name octopus-deploy-release)) + (string= "Platform Release" (project-name octopus-deploy-release)) + (string= "Dispatch V2" (project-name octopus-deploy-release))) + (enqueue *queue-octopus-slow* job)) + (t + (enqueue *queue-octopus-fast* job))))) + +(defmethod do-octopus-deploy-release ((octopus-deploy-release octopus-deploy-release)) + (let* ((project (get-octopus-project octopus-deploy-release (project-name octopus-deploy-release))) + (release (get-octopus-release octopus-deploy-release project (version octopus-deploy-release))) + (environment (car (remove-if-not (lambda (x) + (string= (name x) (environment-name octopus-deploy-release))) + (get-octopus-environments octopus-deploy-release :environment-filter `(,(environment-name octopus-deploy-release))))))) + (do-octopus-enqueue-deploy-release (make-instance 'octopus-deploy-release + :project-name (project-name octopus-deploy-release) + :version (version octopus-deploy-release) + :project project + :release release + :environment environment + :stdout (stdout octopus-deploy-release))))) + (defmethod do-octopus-ode-deploy-release ((octopus-ode-deploy-release octopus-ode-deploy-release)) (let* ((project (get-octopus-project octopus-ode-deploy-release (project-name octopus-ode-deploy-release))) (release (get-octopus-release octopus-ode-deploy-release project (version octopus-ode-deploy-release)))) (when (and project release) (loop for environment in (remove-if (lambda (x) (or (string= "OnDemand-oid" (name x)) (string= "OnDemand-verify" (name x)))) - (get-octopus-ode-environments octopus-ode-deploy-release :filter (ode-names octopus-ode-deploy-release))) - do (let ((job (make-instance 'octopus-ode-deploy-release - :project-name (project-name octopus-ode-deploy-release) - :ode-names (ode-names octopus-ode-deploy-release) - :version (version octopus-ode-deploy-release) - :project project - :release release - :environment environment - :stdout (stdout octopus-ode-deploy-release)))) - (cond ((or (string= "Platform Database Release" (project-name octopus-ode-deploy-release)) - (string= "Platform Release" (project-name octopus-ode-deploy-release)) - (string= "Dispatch V2" (project-name octopus-ode-deploy-release))) - (enqueue *queue-octopus-slow* job)) - (t - (enqueue *queue-octopus-fast* job)))))))) + (get-octopus-ode-environments octopus-ode-deploy-release :environment-filter (ode-names octopus-ode-deploy-release))) + do (do-octopus-enqueue-deploy-release (make-instance 'octopus-deploy-release + :project-name (project-name octopus-ode-deploy-release) + :version (version octopus-ode-deploy-release) + :project project + :release release + :environment environment + :stdout (stdout octopus-ode-deploy-release))))))) (defmethod get-octopus-deployments-successful ((octopus octopus)) (loop for deployment in (get-octopus-items-default-impl octopus "dashboard/dynamic" :method :get) when (string= (cdr (assoc :*state deployment)) "Success") collect deployment)) -(defmethod get-octopus-deployments ((octopus octopus) &key ode-only-p) - (let ((environments (get-octopus-environments octopus :ode-only-p ode-only-p :filter '("all"))) +(defmethod get-octopus-deployments ((octopus octopus) &key ode-only-p (environment-filter '("all")) (project-filter '("all"))) + (let ((environments (get-octopus-environments octopus :ode-only-p ode-only-p :environment-filter environment-filter)) (projects (get-octopus-projects octopus))) (sort (loop for deployment in (get-octopus-deployments-successful octopus) for environment = (find-if (lambda (x) @@ -424,27 +463,26 @@ as an input filter are stored here for the ride through the queue.") for project = (find-if (lambda (x) (string= (id x) (cdr (assoc :*project-id deployment)))) projects) - when (and environment project) + when (and (and environment project) + (filter-match-p environment-filter `(,(name environment))) + (filter-match-p project-filter `(,(name project)))) collect (make-instance 'octopus-deployment :id (cdr (assoc :*id deployment)) :task-id (cdr (assoc :*task-id deployment)) :release-version (cdr (assoc :*release-version deployment)) + :channel-id (cdr (assoc :*channel-id deployment)) :completed-time (local-time:to-rfc3339-timestring (local-time:parse-timestring (cdr (assoc :*completed-time deployment)))) :environment environment :project project)) (lambda (x y) (string> (completed-time x) (completed-time y)))))) -(defmethod get-octopus-latest-deployments ((octopus octopus) &key ode-only-p) +(defmethod get-octopus-latest-deployments ((octopus octopus) &key ode-only-p (environment-filter '("all")) (project-filter '("all"))) (labels ((deployment-included-p (deployment deploy-hash) (and (not (intersection '("Feature Flags for Pipeline" "Channel Resource Release") `(,(name (project deployment))) :test 'string=)) - (not (org-ckons-core::match-it ".*-rc$" (release-version deployment))) - (not (org-ckons-core::match-it ".*-main$" (release-version deployment))) - (not (org-ckons-core::match-it "EKS" (name (project deployment)))) - (not (org-ckons-core::match-it "YARP" (name (project deployment)))) (or (not (gethash (name (environment deployment)) deploy-hash)) (string> (completed-time deployment) (completed-time (gethash (name (environment deployment)) deploy-hash))))))) (let ((deploy-hash (make-hash-table :test 'equal))) - (loop for deployment in (get-octopus-deployments octopus :ode-only-p ode-only-p) + (loop for deployment in (get-octopus-deployments octopus :ode-only-p ode-only-p :environment-filter environment-filter :project-filter project-filter) when (deployment-included-p deployment deploy-hash) do (let ((release (get-octopus-release octopus (project deployment) (release-version deployment)))) (when (version-control-reference release) @@ -455,6 +493,7 @@ as an input filter are stored here for the ride through the queue.") :deployment-id (id deployment) :task-id (task-id deployment) :release-version (release-version deployment) + :channel-id (channel-id deployment) :git-commit (cdr (assoc :*git-commit (version-control-reference (release deployment)))) :completed-time (completed-time deployment) :environment-name (name (environment deployment)) diff --git a/lisp/service/menu-service.lisp b/lisp/service/menu-service.lisp index ba6e934..ae9fca5 100644 --- a/lisp/service/menu-service.lisp +++ b/lisp/service/menu-service.lisp @@ -11,8 +11,9 @@ (:id "a_menu_octopus_machines_with_roles" :label "Octo Machines With Roles" :handler "/octopus-machines-with-roles" :permissions "t") (:id "a_menu_octopus_environments_with_roles" :label "Octo Envs With Roles" :handler "/octopus-environments-with-roles" :permissions "t") (:id "a_menu_octopus_projects_with_roles" :label "Octo Projects With Roles" :handler "/octopus-projects-with-roles" :permissions "t") - (:id "a_menu_octopus_ode_deploy_release" :label "Deploy Octo Release to ODEs" :handler "/octopus-ode-deploy-release" :permissions "t") - (:id "a_menu_octopus_latest_deployments" :label "Octo Latest Deployments" :handler "/octopus-latest-deployments" :permissions "t"))) + (:id "a_menu_octopus_ode_deploy_release" :label "Octo Deploy Release to ODEs" :handler "/octopus-ode-deploy-release" :permissions "t") + (:id "a_menu_octopus_latest_deployments" :label "Octo Latest Deployments" :handler "/octopus-latest-deployments" :permissions "t") + (:id "a_menu_octopus_qrs_lsrs_redeploy" :label "Octo QRS/LSRS Redeploy" :handler "/octopus-qrs-lsrs-redeploy" :permissions "t"))) (defclass menuitem () ((id :initarg :id diff --git a/lisp/service/octopus-environments-with-roles-service.lisp b/lisp/service/octopus-environments-with-roles-service.lisp index 8cd494e..588d32d 100644 --- a/lisp/service/octopus-environments-with-roles-service.lisp +++ b/lisp/service/octopus-environments-with-roles-service.lisp @@ -40,8 +40,6 @@ (with-octopus (octopus) (let ((environments (get-octopus-environments-with-roles octopus :ode-only-p (string= "true" ode_only_p) - :roles (remove-if (lambda (x) - (org-ckons-core::null-or-empty-p x)) - (cl-ppcre:split "[, ]" roles))))) + :roles (split-text-input roles)))) (setf (results instance) environments) (setf (session-value :octopus-roles) roles))))) diff --git a/lisp/service/octopus-latest-deployments-service.lisp b/lisp/service/octopus-latest-deployments-service.lisp index 4b786bd..63a163d 100644 --- a/lisp/service/octopus-latest-deployments-service.lisp +++ b/lisp/service/octopus-latest-deployments-service.lisp @@ -25,6 +25,8 @@ nil t `((:name "ode_only_p" :label "ODE only?" :field-type "checkbox") + (:name "environment" :label "Environment" :field-type "text" :value ,(or (session-value :octopus-environment) "")) + (:name "project" :label "Project" :field-type "text" :value ,(or (session-value :octopus-project) "")) (:label "Find Latest Deployments" :field-type "button" :onclick "on_octopus_latest_deployments_results_clicked()")))))) (defclass octopus-latest-deployments/results-service (octopus-latest-deployments/view-service) @@ -34,8 +36,13 @@ (location-p :initform nil)) (:documentation "")) -(defun octopus-latest-deployments-results-json (ode_only_p) +(defun octopus-latest-deployments-results-json (ode_only_p environment project) (with-noauth (instance octopus-latest-deployments/results-service) (with-octopus (octopus) - (let ((deployments (get-octopus-latest-deployments octopus :ode-only-p (string= "true" ode_only_p)))) - (setf (results instance) deployments))))) + (let ((deployments (get-octopus-latest-deployments octopus + :ode-only-p (string= "true" ode_only_p) + :environment-filter `(,environment) + :project-filter `(,project)))) + (setf (results instance) deployments) + (setf (session-value :octopus-environment) environment) + (setf (session-value :octopus-project) project))))) diff --git a/lisp/service/octopus-machines-with-roles-service.lisp b/lisp/service/octopus-machines-with-roles-service.lisp index b9bf74f..e20d55f 100644 --- a/lisp/service/octopus-machines-with-roles-service.lisp +++ b/lisp/service/octopus-machines-with-roles-service.lisp @@ -37,6 +37,6 @@ (defun octopus-machines-with-roles-results-json (roles) (with-noauth (instance octopus-machines-with-roles/results-service) (with-octopus (octopus) - (let ((machines (get-octopus-machines-with-roles octopus (remove-if (lambda (x) (org-ckons-core::null-or-empty-p x)) (cl-ppcre:split "[, ]" roles))))) + (let ((machines (get-octopus-machines-with-roles octopus (split-text-input roles)))) (setf (results instance) (loop for machine in machines collect (sanitize machine))) (setf (session-value :octopus-roles) roles))))) diff --git a/lisp/service/octopus-ode-deploy-release-service.lisp b/lisp/service/octopus-ode-deploy-release-service.lisp index 411fc15..924eddd 100644 --- a/lisp/service/octopus-ode-deploy-release-service.lisp +++ b/lisp/service/octopus-ode-deploy-release-service.lisp @@ -42,7 +42,7 @@ (do-octopus-ode-deploy-release (make-instance 'octopus-ode-deploy-release :project-name project_name :version version - :ode-names (cl-ppcre:split "[, ]" ode_names) + :ode-names (split-text-input ode_names) :stdout (pathname f))) (setf (stdout instance) (uiop:native-namestring (pathname f)))) (setf (session-value :octopus-project-name) project_name) diff --git a/lisp/service/octopus-projects-with-roles-service.lisp b/lisp/service/octopus-projects-with-roles-service.lisp index 627f346..ee55782 100644 --- a/lisp/service/octopus-projects-with-roles-service.lisp +++ b/lisp/service/octopus-projects-with-roles-service.lisp @@ -38,9 +38,7 @@ (with-noauth (instance octopus-projects-with-roles/results-service) (cl-fad:with-output-to-temporary-file (f :template "/tmp/snow/temp-%") (get-octopus-projects-with-roles (make-instance 'octopus-process-step - :target-roles (remove-if (lambda (x) - (org-ckons-core::null-or-empty-p x)) - (cl-ppcre:split "[, ]" roles)) + :target-roles (split-text-input roles) :stdout (pathname f))) (setf (stdout instance) (uiop:native-namestring (pathname f)))) (setf (session-value :octopus-roles) roles))) diff --git a/lisp/service/octopus-qrs-lsrs-redeploy-service.lisp b/lisp/service/octopus-qrs-lsrs-redeploy-service.lisp new file mode 100644 index 0000000..4796754 --- /dev/null +++ b/lisp/service/octopus-qrs-lsrs-redeploy-service.lisp @@ -0,0 +1,72 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package :snow) + +(defclass octopus-qrs-lsrs-redeploy-service (rest-service) + () + (:documentation "")) + +(defun octopus-qrs-lsrs-redeploy-json () + (with-noauth (instance octopus-qrs-lsrs-redeploy-service) + t)) + +(defclass octopus-qrs-lsrs-redeploy/view-service (octopus-qrs-lsrs-redeploy-service) + ((form :initarg :form + :initform nil + :accessor form) + (location-p :initform nil)) + (:documentation "")) + +(defun octopus-qrs-lsrs-redeploy-view-json () + (with-noauth (instance octopus-qrs-lsrs-redeploy/view-service) + (setf (form instance) + (make-form "octopus-qrs-lsrs-redeploy-form" + nil + t + `((:name "environment" :label "Environment" :field-type "text" :required "required" :value ,(or (session-value :octopus-environment) "")) + (:label "Find Latest QRS/LSRS in Environment" :field-type "button" :onclick "on_octopus_qrs_lsrs_redeploy_results_clicked()")))))) + +(defclass octopus-qrs-lsrs-redeploy/results-service (octopus-qrs-lsrs-redeploy/view-service) + ((results :initarg :results + :initform nil + :accessor results) + (location-p :initform nil)) + (:documentation "")) + +(defun octopus-qrs-lsrs-redeploy-results-json (environment) + (with-noauth (instance octopus-latest-deployments/results-service) + (with-octopus (octopus) + (let* ((projects '("Queue Retry Service" "Log Streaming Retry Service")) + (deployments (org-ckons-core::flatten + (loop for project in projects + collect (get-octopus-latest-deployments octopus + :ode-only-p nil + :environment-filter `(,environment) + :project-filter `(,project)))))) + (setf (session-value :octopus-environment) environment) + (setf (session-value :octopus-qrs-lsrs-redeploy-deployments) deployments) + (setf (results instance) deployments) + (setf (form instance) + (make-form "octopus-qrs-lsrs-redeploy-submit-form" + nil + t + `((:label "Redeploy QRS/LSRS" :field-type "button" :onclick "on_octopus_qrs_lsrs_redeploy_results_submit_clicked()")))))))) + +(defclass octopus-qrs-lsrs-redeploy/results-submit-service (octopus-qrs-lsrs-redeploy-service) + ((stdout :initarg :stdout + :initform nil + :accessor stdout) + (location-p :initform nil)) + (:documentation "")) + +(defun octopus-qrs-lsrs-redeploy-results-submit-json () + (with-noauth (instance octopus-qrs-lsrs-redeploy/results-submit-service) + (cl-fad:with-output-to-temporary-file (f :template "/tmp/snow/temp-%") + (loop for deployment in (session-value :octopus-qrs-lsrs-redeploy-deployments) + do (do-octopus-deploy-release (make-instance 'octopus-deploy-release + :project-name (project-name deployment) + :version (release-version deployment) + :environment-name (environment-name deployment) + :stdout (pathname f))) + (setf (stdout instance) (uiop:native-namestring (pathname f))))))) diff --git a/lisp/service/rest-service.lisp b/lisp/service/rest-service.lisp index a060863..7941630 100644 --- a/lisp/service/rest-service.lisp +++ b/lisp/service/rest-service.lisp @@ -34,3 +34,6 @@ (defun type-to-path (rest-type) (concatenate 'string "/" (ppcre:regex-replace "-service" (string-downcase (type-of rest-type)) "/"))) + +(defun split-text-input (input) + (remove-if (lambda (x) (org-ckons-core::null-or-empty-p x)) (cl-ppcre:split "[, ]" input))) diff --git a/lisp/snow.asd b/lisp/snow.asd index e9bc646..0aecb6e 100644 --- a/lisp/snow.asd +++ b/lisp/snow.asd @@ -68,7 +68,8 @@ (:file "octopus-environments-with-roles-service" :depends-on ("auth-service")) (:file "octopus-projects-with-roles-service" :depends-on ("auth-service")) (:file "octopus-ode-deploy-release-service" :depends-on ("auth-service")) - (:file "octopus-latest-deployments-service" :depends-on ("auth-service")))) + (:file "octopus-latest-deployments-service" :depends-on ("auth-service")) + (:file "octopus-qrs-lsrs-redeploy-service" :depends-on ("auth-service")))) (:module webapps :depends-on (service) :components ((:file "webapp-loader") diff --git a/lisp/webapps/snow/clojurescript/snow/src/core.cljs b/lisp/webapps/snow/clojurescript/snow/src/core.cljs index c2078af..31df968 100644 --- a/lisp/webapps/snow/clojurescript/snow/src/core.cljs +++ b/lisp/webapps/snow/clojurescript/snow/src/core.cljs @@ -124,6 +124,20 @@ (declare template-octopus-latest-deployments-results) (declare handler-octopus-latest-deployments-results) (declare render-octopus-latest-deployments-results) +(declare template-octopus-qrs-lsrs-redeploy) +(declare handler-octopus-qrs-lsrs-redeploy) +(declare render-octopus-qrs-lsrs-redeploy) +(declare template-octopus-qrs-lsrs-redeploy-view) +(declare handler-octopus-qrs-lsrs-redeploy-view) +(declare render-octopus-qrs-lsrs-redeploy-view) +(declare on-octopus-qrs-lsrs-redeploy-results-clicked) +(declare template-octopus-qrs-lsrs-redeploy-results) +(declare handler-octopus-qrs-lsrs-redeploy-results) +(declare render-octopus-qrs-lsrs-redeploy-results) +(declare on-octopus-qrs-lsrs-redeploy-results-submit-clicked) +(declare template-octopus-qrs-lsrs-redeploy-results-submit) +(declare handler-octopus-qrs-lsrs-redeploy-results-submit) +(declare render-octopus-qrs-lsrs-redeploy-results-submit) (declare on-menu-clicked) (declare handler-location) (declare goto-location) @@ -687,6 +701,7 @@ (hiccups/defhtml template-octopus-latest-deployments [jsonobj] [:h3 {:style "text-align: center"} "Find the latest octopus deployments in each environment."] [:h5 {:style "text-align: center"} "Assumes that you have the <code>OLO_AWS_BUILD_PROFILE</code> environment variable set with the name of your build profile."] + [:h5 {:style "text-align: center"} "For all enviroments and projects please specify `all` for the filters."] [:div {:id "content"}] [:div {:id "results"}]) @@ -731,9 +746,91 @@ (defn render-octopus-latest-deployments-results [] (POST "/octopus-latest-deployments/results" {:format :raw - :params {:ode_only_p (.-checked (dommy/sel1 :#ode_only_p))} + :params {:ode_only_p (.-checked (dommy/sel1 :#ode_only_p)) + :environment (dommy/value (dommy/sel1 :#environment)) + :project (dommy/value (dommy/sel1 :#project))} :handler handler-octopus-latest-deployments-results})) +;; octopus-qrs-lsrs-redeploy + +(hiccups/defhtml template-octopus-qrs-lsrs-redeploy [jsonobj] + [:h3 {:style "text-align: center"} "Redeploy Queue Retry Service and Log Streaming Retry Service to a single target in the specified environment."] + [:h5 {:style "text-align: center"} "The target will be chosen at random. The purpose of this tool is to clear the octopus deployment log. For this purpose the choice of target is unimportant."] + [:div {:id "content"}] + [:div {:id "results-submit-ack"}] + [:div {:id "results-submit"}] + [:div {:id "results"}]) + +(defn handler-octopus-qrs-lsrs-redeploy [response] + (let [jsonobj (js->clj (js/JSON.parse response))] + (notifications jsonobj) + (dommy/set-html! (dommy/sel1 :#body) (template-octopus-qrs-lsrs-redeploy jsonobj)) + (render-octopus-qrs-lsrs-redeploy-view))) + +(defn render-octopus-qrs-lsrs-redeploy [] + (GET "/octopus-qrs-lsrs-redeploy" {:handler handler-octopus-qrs-lsrs-redeploy})) + +;; octopus-qrs-lsrs-redeploy-view + +(hiccups/defhtml template-octopus-qrs-lsrs-redeploy-view [jsonobj] + (ck-form/template-generic-form (get jsonobj "form") (namespace ::x))) + +(defn handler-octopus-qrs-lsrs-redeploy-view [response] + (let [jsonobj (js->clj (js/JSON.parse response))] + (notifications jsonobj) + (dommy/set-html! (dommy/sel1 :#content) (template-octopus-qrs-lsrs-redeploy-view jsonobj)))) + +(defn render-octopus-qrs-lsrs-redeploy-view [] + (GET "/octopus-qrs-lsrs-redeploy/view" {:handler handler-octopus-qrs-lsrs-redeploy-view})) + +;; octopus-qrs-lsrs-redeploy-results + +(defn on-octopus-qrs-lsrs-redeploy-results-clicked [] + (when (-> (jquery "#octopus-qrs-lsrs-redeploy-form") + (.get "0") + (.checkValidity)) + (dommy/set-html! (dommy/sel1 :#results) (template-generic-wait)) + (dommy/set-html! (dommy/sel1 :#results-submit) "") + (dommy/set-html! (dommy/sel1 :#results-submit-ack) "") + (render-octopus-qrs-lsrs-redeploy-results))) + +(hiccups/defhtml template-octopus-qrs-lsrs-redeploy-results-form [jsonobj] + (ck-form/template-generic-form (get jsonobj "form") (namespace ::x))) + +(hiccups/defhtml template-octopus-qrs-lsrs-redeploy-results [jsonobj] + (generic-table jsonobj true)) + +(defn handler-octopus-qrs-lsrs-redeploy-results [response] + (let [jsonobj (js->clj (js/JSON.parse response))] + (notifications jsonobj) + (dommy/set-html! (dommy/sel1 :#results) (template-octopus-qrs-lsrs-redeploy-results jsonobj)) + (when (not (empty? (get jsonobj "results"))) + (dommy/set-html! (dommy/sel1 :#results-submit) (template-octopus-qrs-lsrs-redeploy-results-form jsonobj))))) + +(defn render-octopus-qrs-lsrs-redeploy-results [] + (POST "/octopus-qrs-lsrs-redeploy/results" {:format :raw + :params {:environment (dommy/value (dommy/sel1 :#environment))} + :handler handler-octopus-qrs-lsrs-redeploy-results})) + +;; octopus-qrs-lsrs-redeploy-results-submit + +(defn on-octopus-qrs-lsrs-redeploy-results-submit-clicked [] + (dommy/set-html! (dommy/sel1 :#results-submit-ack) (template-generic-wait)) + (render-octopus-qrs-lsrs-redeploy-results-submit)) + +(hiccups/defhtml template-octopus-qrs-lsrs-redeploy-results-submit [jsonobj] + [:h5 {:style "text-align: center"} + "Process started in background. See the output at " [:code (get jsonobj "stdout")]]) + +(defn handler-octopus-qrs-lsrs-redeploy-results-submit [response] + (let [jsonobj (js->clj (js/JSON.parse response))] + (notifications jsonobj) + (dommy/set-html! (dommy/sel1 :#results-submit) "") + (dommy/set-html! (dommy/sel1 :#results-submit-ack) (template-octopus-qrs-lsrs-redeploy-results-submit jsonobj)))) + +(defn render-octopus-qrs-lsrs-redeploy-results-submit [] + (POST "/octopus-qrs-lsrs-redeploy/results/submit" {:handler handler-octopus-qrs-lsrs-redeploy-results-submit})) + ;; location (defn on-menu-clicked [handler] @@ -748,7 +845,8 @@ (cond (= handler "/octopus-environments-with-roles") (render-octopus-environments-with-roles)) (cond (= handler "/octopus-projects-with-roles") (render-octopus-projects-with-roles)) (cond (= handler "/octopus-ode-deploy-release") (render-octopus-ode-deploy-release)) - (cond (= handler "/octopus-latest-deployments") (render-octopus-latest-deployments))) + (cond (= handler "/octopus-latest-deployments") (render-octopus-latest-deployments)) + (cond (= handler "/octopus-qrs-lsrs-redeploy") (render-octopus-qrs-lsrs-redeploy))) (defn handler-location [response] (let [jsonobj (js->clj (js/JSON.parse response))] diff --git a/lisp/webapps/snow/site.lisp b/lisp/webapps/snow/site.lisp index d1091ad..a640e9a 100644 --- a/lisp/webapps/snow/site.lisp +++ b/lisp/webapps/snow/site.lisp @@ -132,7 +132,19 @@ `(octopus-latest-deployments-view-json)) (defmacro .octopus-latest-deployments-results () - `(octopus-latest-deployments-results-json ode_only_p)) + `(octopus-latest-deployments-results-json ode_only_p environment project)) + +(defmacro .octopus-qrs-lsrs-redeploy () + `(octopus-qrs-lsrs-redeploy-json)) + +(defmacro .octopus-qrs-lsrs-redeploy-view () + `(octopus-qrs-lsrs-redeploy-view-json)) + +(defmacro .octopus-qrs-lsrs-redeploy-results () + `(octopus-qrs-lsrs-redeploy-results-json environment)) + +(defmacro .octopus-qrs-lsrs-redeploy-results-submit () + `(octopus-qrs-lsrs-redeploy-results-submit-json)) (define-endpoint :get "/" () .base) (define-endpoint :post "/location" ((location :parameter-type 'string)) .location) @@ -167,4 +179,8 @@ (define-endpoint :post "/octopus-ode-deploy-release/results" ((project_name :parameter-type 'string) (version :parameter-type 'string) (ode_names :parameter-type 'string)) .octopus-ode-deploy-release-results) (define-endpoint :get "/octopus-latest-deployments" () .octopus-latest-deployments) (define-endpoint :get "/octopus-latest-deployments/view" () .octopus-latest-deployments-view) -(define-endpoint :post "/octopus-latest-deployments/results" ((ode_only_p :parameter-type 'string)) .octopus-latest-deployments-results) +(define-endpoint :post "/octopus-latest-deployments/results" ((ode_only_p :parameter-type 'string) (environment :parameter-type 'string) (project :parameter-type 'string)) .octopus-latest-deployments-results) +(define-endpoint :get "/octopus-qrs-lsrs-redeploy" () .octopus-qrs-lsrs-redeploy) +(define-endpoint :get "/octopus-qrs-lsrs-redeploy/view" () .octopus-qrs-lsrs-redeploy-view) +(define-endpoint :post "/octopus-qrs-lsrs-redeploy/results" ((environment :parameter-type 'string)) .octopus-qrs-lsrs-redeploy-results) +(define-endpoint :post "/octopus-qrs-lsrs-redeploy/results/submit" () .octopus-qrs-lsrs-redeploy-results-submit) |