[INF-18492] Automate Queue Retry and Log Streaming Retry octopus fix

1 files changed, 84 insertions, 58 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)