|
2 | 2 | (:require |
3 | 3 | [clojure.java.io :as io] |
4 | 4 | [clojure.string :as str] |
5 | | - [cognitect.aws.client.api :as aws]) |
| 5 | + [cognitect.aws.client.api :as aws] |
| 6 | + [cognitect.aws.credentials :as credentials]) |
6 | 7 | (:import |
7 | 8 | (java.io |
8 | 9 | ByteArrayInputStream) |
| 10 | + (java.util |
| 11 | + Date) |
9 | 12 | (org.apache.commons.io |
10 | 13 | IOUtils))) |
11 | 14 |
|
12 | 15 | (defprotocol S3Bucket |
13 | 16 | (-delete-object [client key]) |
14 | 17 | (-get-object-details [client key]) |
15 | 18 | (-get-object-stream [client key]) |
| 19 | + (-list-entries [client prefix]) |
16 | 20 | (-list-objects [client prefix]) |
17 | 21 | (-put-object [client key stream opts])) |
18 | 22 |
|
|
23 | 27 | v)) |
24 | 28 |
|
25 | 29 | (defn- list-objects-chunk |
26 | | - [client bucket-name prefix marker] |
| 30 | + [client bucket-name prefix delimeter continuation-token] |
27 | 31 | (let [request (cond-> {:Bucket bucket-name} |
28 | | - prefix (assoc :Prefix prefix) |
29 | | - marker (assoc :Marker marker))] |
| 32 | + continuation-token (assoc :ContinuationToken continuation-token) |
| 33 | + delimeter (assoc :Delimiter delimeter) |
| 34 | + prefix (assoc :Prefix prefix))] |
30 | 35 | (throw-on-error |
31 | 36 | (aws/invoke client |
32 | | - {:op :ListObjects |
| 37 | + {:op :ListObjectsV2 |
33 | 38 | :request request})))) |
34 | 39 |
|
35 | 40 | (defn- list-objects-seq |
36 | | - "Generates a lazy seq of objects, chunked by the API's paging." |
37 | | - [client bucket-name prefix marker] |
38 | | - (let [{:keys [Contents IsTruncated]} |
39 | | - (list-objects-chunk client bucket-name prefix marker)] |
| 41 | + "Generates a lazy seq of list-objects results, chunked by the API's paging." |
| 42 | + [client bucket-name {:as opts :keys [continuation-token delimeter prefix]}] |
| 43 | + (let [{:as result :keys [IsTruncated NextContinuationToken]} |
| 44 | + (list-objects-chunk client bucket-name prefix delimeter continuation-token)] |
40 | 45 | (if IsTruncated |
41 | 46 | (lazy-seq |
42 | | - (concat Contents |
43 | | - (list-objects-seq client bucket-name prefix |
44 | | - (-> Contents last :Key)))) |
45 | | - Contents))) |
| 47 | + (cons result |
| 48 | + (list-objects-seq client bucket-name |
| 49 | + (assoc opts :continuation-token NextContinuationToken)))) |
| 50 | + [result]))) |
46 | 51 |
|
47 | 52 | (defn- strip-etag |
48 | 53 | "ETags from the s3 api are wrapped in \"s" |
|
82 | 87 | (throw-on-error) |
83 | 88 | :Body)) |
84 | 89 |
|
| 90 | + (-list-entries [_ prefix] |
| 91 | + (sequence |
| 92 | + (mapcat #(concat (:CommonPrefixes %) (map strip-etag (:Contents %)))) |
| 93 | + (list-objects-seq s3 bucket-name {:delimeter "/" |
| 94 | + :prefix prefix}))) |
| 95 | + |
85 | 96 | (-list-objects [_ prefix] |
86 | | - (map strip-etag (list-objects-seq s3 bucket-name prefix nil))) |
| 97 | + (sequence |
| 98 | + (comp |
| 99 | + (mapcat :Contents) |
| 100 | + (map strip-etag)) |
| 101 | + (list-objects-seq s3 bucket-name {:prefix prefix}))) |
87 | 102 |
|
88 | 103 | (-put-object [_ key stream opts] |
89 | 104 | (->> {:op :PutObject |
|
95 | 110 | (throw-on-error)))) |
96 | 111 |
|
97 | 112 | (defn s3-client |
98 | | - [bucket] |
99 | | - {:pre [(not (str/blank? bucket))]} |
100 | | - ;; Credentials are derived from the instance's role and region comes from the |
101 | | - ;; aws.region property, so we don't have to set either here. |
102 | | - (->S3Client (doto (aws/client {:api :s3}) |
103 | | - (aws/validate-requests true)) |
104 | | - bucket)) |
| 113 | + ;; Credentials are derived from the instance's role when running in |
| 114 | + ;; production and region comes from the aws.region property, so we don't have |
| 115 | + ;; to set either here. |
| 116 | + ([bucket] |
| 117 | + (s3-client bucket nil)) |
| 118 | + ;; This arity is only used directly in testing, where we use minio via docker, and we have |
| 119 | + ;; to override the endpoint and provide credentials |
| 120 | + ([bucket {:keys [credentials endpoint region]}] |
| 121 | + {:pre [(not (str/blank? bucket))]} |
| 122 | + (->S3Client |
| 123 | + (doto (aws/client |
| 124 | + (cond-> {:api :s3} |
| 125 | + credentials (assoc :credentials-provider (credentials/basic-credentials-provider credentials)) |
| 126 | + endpoint (assoc :endpoint-override endpoint) |
| 127 | + region (assoc :region region))) |
| 128 | + (aws/validate-requests true)) |
| 129 | + bucket))) |
| 130 | + |
| 131 | +(defn- mock-object-entry |
| 132 | + [k bytes] |
| 133 | + {:Key k |
| 134 | + :Size (count bytes) |
| 135 | + :LastModified (Date.)}) |
105 | 136 |
|
106 | 137 | (defrecord MockS3Client [state] |
107 | 138 | S3Bucket |
|
113 | 144 | (-get-object-stream [_ key] |
114 | 145 | (when-let [data (get @state key)] |
115 | 146 | (ByteArrayInputStream. data))) |
116 | | - (-list-objects [_ prefix] |
| 147 | + (-list-entries [_ prefix] |
117 | 148 | (->> (keys @state) |
118 | | - (filter (fn [k] (if prefix (.startsWith k prefix) true))) |
119 | | - (map (fn [k] {:Key k})))) |
| 149 | + (filter (fn [k] |
| 150 | + (if prefix |
| 151 | + (.startsWith k prefix) |
| 152 | + true))) |
| 153 | + (map (fn [k] |
| 154 | + (let [k-sans-prefix (if prefix |
| 155 | + (subs k (count prefix)) |
| 156 | + k) |
| 157 | + [k-segment & more] (str/split k-sans-prefix #"/")] |
| 158 | + (if more |
| 159 | + {:Prefix (format "%s%s/" (or prefix "") k-segment)} |
| 160 | + (mock-object-entry k (get @state k)))))) |
| 161 | + (distinct))) |
| 162 | + (-list-objects [_ prefix] |
| 163 | + (into [] |
| 164 | + (comp |
| 165 | + (filter (fn [k] (if prefix (.startsWith k prefix) true))) |
| 166 | + (map (fn [k] (mock-object-entry k (get @state k))))) |
| 167 | + (keys @state))) |
120 | 168 | (-put-object [_ key stream _opts] |
121 | 169 | (swap! state assoc key (IOUtils/toByteArray stream)))) |
122 | 170 |
|
|
139 | 187 | [s3 key] |
140 | 188 | (-get-object-stream s3 key)) |
141 | 189 |
|
| 190 | +(defn list-entries |
| 191 | + "Lists the entries in the bucket at the level defined by prefix. |
| 192 | +
|
| 193 | + Returns a sequence of intermixed prefix maps (of the form {:Prefix \"some/string/\"}) |
| 194 | + and object list maps (of the form {:Key \"a-key\", :Size 123, ...}, same as |
| 195 | + `list-objects`). |
| 196 | +
|
| 197 | + This is used to generate directory listings." |
| 198 | + [s3 prefix] |
| 199 | + (-list-entries s3 prefix)) |
| 200 | + |
142 | 201 | (defn list-objects |
143 | 202 | ([s3] |
144 | 203 | (list-objects s3 nil)) |
|
0 commit comments