diff options
Diffstat (limited to 'lisp/service/octopus-qrs-lsrs-redeploy-service.lisp')
| -rw-r--r-- | lisp/service/octopus-qrs-lsrs-redeploy-service.lisp | 72 |
1 files changed, 72 insertions, 0 deletions
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))))))) |
