summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--lisp/octopus/octopus.lisp142
-rw-r--r--lisp/service/menu-service.lisp5
-rw-r--r--lisp/service/octopus-environments-with-roles-service.lisp4
-rw-r--r--lisp/service/octopus-latest-deployments-service.lisp13
-rw-r--r--lisp/service/octopus-machines-with-roles-service.lisp2
-rw-r--r--lisp/service/octopus-ode-deploy-release-service.lisp2
-rw-r--r--lisp/service/octopus-projects-with-roles-service.lisp4
-rw-r--r--lisp/service/octopus-qrs-lsrs-redeploy-service.lisp72
-rw-r--r--lisp/service/rest-service.lisp3
-rw-r--r--lisp/snow.asd3
-rw-r--r--lisp/webapps/snow/clojurescript/snow/src/core.cljs102
-rw-r--r--lisp/webapps/snow/site.lisp20
12 files changed, 296 insertions, 76 deletions
diff --git a/lisp/octopus/octopus.lisp b/lisp/octopus/octopus.lisp
index 88712a3..a0b6d3d 100644
--- a/lisp/octopus/octopus.lisp
+++ b/lisp/octopus/octopus.lisp
@@ -136,16 +136,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 +160,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
@@ -230,27 +236,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)
@@ -319,14 +328,14 @@ 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)))
+ `((:*environment-id . ,(id (environment octopus-deploy-release)))
+ (:*project-id . ,(id (project octopus-deploy-release)))
+ (:*release-id . ,(id (release octopus-deploy-release)))
(:*use-guided-failure . nil)
(:*force-package-download . t)
(:*force-package-redeployment . t))))))
@@ -334,9 +343,9 @@ as an input filter are stored here for the ride through the queue.")
(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)
+ :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 +373,78 @@ 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 (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,7 +453,8 @@ 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 project-filter `(,(name project))))
collect (make-instance 'octopus-deployment
:id (cdr (assoc :*id deployment))
:task-id (cdr (assoc :*task-id deployment))
@@ -434,17 +464,13 @@ as an input filter are stored here for the ride through the queue.")
: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)
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..a2d4a18
--- /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 (session-value :octopus-environment)
+ :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)
generated by cgit v1.3 (git 2.53.0) at 2026-09-24 14:12:55 +0000