From f39107f9f3ad8e467abb6d4bb23d13a74c5ddba2 Mon Sep 17 00:00:00 2001
From: Toby Crawley <toby@tcrawley.org>
Date: Mon, 6 Jun 2022 07:49:43 -0400
Subject: [PATCH] Report CDN purge failures

This will at least allow us to see when they happen and address
manually. We'll do later work to add retries if we are seeing failures.

Related to #831.
---
 src/clojars/storage.clj | 28 +++++++++++++++++-----------
 src/clojars/system.clj  |  6 +++---
 2 files changed, 20 insertions(+), 14 deletions(-)

diff --git a/src/clojars/storage.clj b/src/clojars/storage.clj
index b7b0cec3..44bbfb73 100644
--- a/src/clojars/storage.clj
+++ b/src/clojars/storage.clj
@@ -1,8 +1,10 @@
 (ns clojars.storage
-  (:require [clojars.cdn :as cdn]
-            [clojars.file-utils :as fu]
-            [clojars.s3 :as s3]
-            [clojure.java.io :as io])
+  (:require
+   [clojars.cdn :as cdn]
+   [clojars.errors :as errors]
+   [clojars.file-utils :as fu]
+   [clojars.s3 :as s3]
+   [clojure.java.io :as io])
   (:import org.apache.commons.io.FileUtils))
 
 (defprotocol Storage
@@ -80,7 +82,7 @@
       (s3/object-exists? client path)))
   (path-seq [_ path]
     (s3/list-object-keys client path))
-  (artifact-url [_ path]
+  (artifact-url [_ _path]
     (throw (ex-info "Not implemented" {}))))
 
 (defn s3-storage
@@ -98,24 +100,28 @@
       (when (not= "ok" status)
         (throw (ex-info (format "Fastly purge failed for %s" path) resp))))))
 
-(defrecord CDNStorage [cdn-token cdn-url]
+(defrecord CDNStorage [error-reporter cdn-token cdn-url]
   Storage
   (-write-artifact [_ path _ _]
     ;; Purge any file in the deploy in case it has been requested in
     ;; the last 24 hours, since fastly will cache the 404.  Run in a
     ;; future so we don't have to wait for the request to finish to
     ;; complete the deploy.
-    (future (purge cdn-token cdn-url path)))
+    (future (try
+              (purge cdn-token cdn-url path)
+              (catch Throwable t
+                (errors/report-error error-reporter t)
+                (throw t)))))
   (remove-path [_ path]
     (purge cdn-token cdn-url path))
   (path-exists? [_ _])
   (artifact-url [_ _]))
 
-(defn cdn-storage [cdn-token cdn-url]
-  (->CDNStorage cdn-token cdn-url))
+(defn cdn-storage [error-reporter cdn-token cdn-url]
+  (->CDNStorage error-reporter cdn-token cdn-url))
 
-(defn full-storage [on-disk-repo repo-bucket cdn-token cdn-url]
+(defn full-storage [error-reporter on-disk-repo repo-bucket cdn-token cdn-url]
   (multi-storage
     (fs-storage on-disk-repo)
     (s3-storage repo-bucket)
-    (cdn-storage cdn-token cdn-url)))
+    (cdn-storage error-reporter cdn-token cdn-url)))
diff --git a/src/clojars/system.clj b/src/clojars/system.clj
index 49873488..7d1579e4 100644
--- a/src/clojars/system.clj
+++ b/src/clojars/system.clj
@@ -26,7 +26,7 @@
   {:app {:middleware []}
    :http {:configurator patch/use-status-message-header}})
 
-(defrecord StorageComponent [delegate on-disk-repo repo-bucket cdn-token cdn-url]
+(defrecord StorageComponent [error-reporter delegate on-disk-repo repo-bucket cdn-token cdn-url]
   storage/Storage
   (-write-artifact [_ path file force-overwrite?]
     (storage/write-artifact delegate path file force-overwrite?))
@@ -44,7 +44,7 @@
     (if delegate
       t
       (assoc t
-             :delegate (storage/full-storage on-disk-repo repo-bucket
+             :delegate (storage/full-storage error-reporter on-disk-repo repo-bucket
                                              cdn-token cdn-url))))
   (stop [t]
     (assoc t :delegate nil)))
@@ -96,4 +96,4 @@
                           :mailer :stats :search :storage]
           :http          [:app]
           :notifications [:db :mailer]
-          :storage       [:repo-bucket]}))))
+          :storage       [:error-reporter :repo-bucket]}))))