sigv4.bend
bend-kit-sigv4@0.1.0.0 · 1,200 lines · 0 definitions
1# AWS Signature V4 signing and S3 object storage over Hairpin. Source: https://github.com/paymog/bend-kit/tree/main/sigv4
2import Base
3import bend-kit-crypto@0.1.1.0/crypto.bend as Crypto
4import bend-kit-hairpin@0.1.0.0/hairpin.bend as Hairpin
5import bend-kit-http@0.23.0.1/http.bend as Http
6import bend-kit-time@0.1.0.0/time.bend as Time
7# By hash, as http imports them: bend-kit-url@0.4.1.0, -bytes@0.3.0.0.
8import bend-kit-url@0.4.1.0/url.bend as Url
9import bend-kit-encoding@0.3.0.0/encoding.bend as Enc
10import bend-kit-bytes@0.3.0.0/bytes.bend as Bytes
11
12# Text (path, query, header values) is a String of code points; non-ASCII is sent as UTF-8.
13# S3 decodes and re-encodes wire escapes once; other services encode an escaped wire path twice.
14# SigV4 encoding keeps only A-Z a-z 0-9 - _ . ~ and uses uppercase %XX.
15# date is the x-amz-date form, YYYYMMDDTHHMMSSZ. token is "" for long-term keys.
16type Credentials is Data:
17 Credentials{access: String, secret: String, token: String}
18
19# Code points to UTF-8 octets, one Char per octet. acc is reversed.
20def utf8.c3(three: Bool, +c: U32, acc: String) -> String:
21 match three:
22 case True{}:
23 SCon{Chr{(128 + c % 64 : U32)}, SCon{Chr{(128 + c / 64 % 64 : U32)}, SCon{Chr{(224 + c / 4096 : U32)}, acc}}}
24 case False{}:
25 SCon{Chr{(128 + c % 64 : U32)}, SCon{Chr{(128 + c / 64 % 64 : U32)}, SCon{Chr{(128 + c / 4096 % 64 : U32)}, SCon{Chr{(240 + c / 262144 : U32)}, acc}}}}
26
27def utf8.c2(two: Bool, +c: U32, acc: String) -> String:
28 match two:
29 case True{}:
30 SCon{Chr{(128 + c % 64 : U32)}, SCon{Chr{(192 + c / 64 : U32)}, acc}}
31 case False{}:
32 utf8.c3(U32.is_lt(c, 65536), c, acc)
33
34def utf8.c1(one: Bool, +c: U32, acc: String) -> String:
35 match one:
36 case True{}:
37 SCon{Chr{c}, acc}
38 case False{}:
39 utf8.c2(U32.is_lt(c, 2048), c, acc)
40
41def utf8.go(s: String, acc: String) -> String:
42 match s:
43 case SNil{}:
44 String.reverse(acc)
45 case SCon{Chr{+c}, t}:
46 utf8.go(t, utf8.c1(U32.is_lt(c, 128), c, acc))
47
48def utf8(s: String) -> String:
49 utf8.go(s, SNil{})
50
51# SigV4 URI encoding of text: UTF-8, then every octet but the unreserved ones as %XX. slash keeps '/'.
52def encode(s: String, slash: Bool) -> String:
53 match slash:
54 case True{}:
55 Url.pct.encode_path(utf8(s))
56 case False{}:
57 Url.pct.encode_q(utf8(s))
58
59def dec.of(m: Maybe<&2, String>, +raw: String) -> String:
60 match m:
61 case None{}:
62 raw
63 case Some{d}:
64 d
65
66# A wire component, re-encoded. A malformed escape stays literal, so its '%' is encoded.
67def norm(s: String) -> String:
68 +o = utf8(s)
69 Url.pct.encode_q(dec.of(Url.pct.decode(o), o))
70
71def norms(xs: List<&2, String>) -> List<&2, String>:
72 match xs:
73 case Nil{}:
74 Nil{}
75 case Con{h, t}:
76 Con{norm(h), norms(t)}
77
78# Non-S3 services encode the wire path a second time; '%' becomes '%25'.
79def wire.segs(xs: List<&2, String>) -> List<&2, String>:
80 match xs:
81 case Nil{}:
82 Nil{}
83 case Con{h, t}:
84 Con{Url.pct.encode_q(utf8(h)), wire.segs(t)}
85
86# Canonical URI (RFC 3986 §5.2.4 for services other than s3): "" and "." segments drop, ".." pops.
87def dots.seg(skip: Bool, up: Bool, +seg: String, st: List<&2, String>) -> List<&2, String>:
88 match skip up:
89 case True{} _:
90 st
91 case False{} True{}:
92 List.drop(&2, String, st, 1n)
93 case False{} False{}:
94 Con{seg, st}
95
96def dots(xs: List<&2, String>, st: List<&2, String>) -> List<&2, String>:
97 match xs:
98 case Nil{}:
99 List.reverse(&2, String, st)
100 case Con{+h, t}:
101 dots(t, dots.seg(Bool.or(String.is_empty(h), String.eq(h, ".")), String.eq(h, ".."), h, st))
102
103def uri.slash(empty: Bool, trail: Bool, +body: String) -> String:
104 match empty trail:
105 case True{} _:
106 "/"
107 case False{} True{}:
108 "/" ++ body ++ "/"
109 case False{} False{}:
110 "/" ++ body
111
112def uri.dots(+path: String) -> String:
113 +body = String.join(wire.segs(dots(String.split(path, '/'), Nil{})), "/")
114 +trail = Bool.or(String.ends_with(path, "/"), Bool.or(String.ends_with(path, "/."), String.ends_with(path, "/..")))
115 uri.slash(String.is_empty(body), trail, body)
116
117# S3 signs the path as sent: each segment re-encoded, nothing removed.
118def uri.s3(empty: Bool, +path: String) -> String:
119 match empty:
120 case True{}:
121 "/"
122 case False{}:
123 String.join(norms(String.split(path, '/')), "/")
124
125def uri.if(s3: Bool, +path: String) -> String:
126 match s3:
127 case True{}:
128 uri.s3(String.is_empty(path), path)
129 case False{}:
130 uri.dots(path)
131
132def uri(+service: String, +path: String) -> String:
133 uri.if(String.eq(service, "s3"), path)
134
135# Canonical query: split on '&', each "k=v" (a bare "k" is "k="), re-encoded, sorted by key then value.
136def pair(xs: List<&2, String>) -> Sigma<&2, &2, String, _ => String>:
137 match xs:
138 case Nil{}:
139 ("", "")
140 case Con{k, t}:
141 (norm(k), norm(String.join(t, "=")))
142
143def pairs.if(empty: Bool, +h: String, rest: List<&2, Sigma<&2, &2, String, _ => String>>) -> List<&2, Sigma<&2, &2, String, _ => String>>:
144 match empty:
145 case True{}:
146 rest
147 case False{}:
148 Con{pair(String.split(h, '=')), rest}
149
150def pairs(xs: List<&2, String>) -> List<&2, Sigma<&2, &2, String, _ => String>>:
151 match xs:
152 case Nil{}:
153 Nil{}
154 case Con{+h, t}:
155 pairs.if(String.is_empty(h), h, pairs(t))
156
157def pair.le.of(c: Cmp, av: String, bv: String) -> Bool:
158 match c:
159 case LT{}:
160 True{}
161 case GT{}:
162 False{}
163 case EQ{}:
164 String.is_le(av, bv)
165
166def pair.le(a: Sigma<&2, &2, String, _ => String>, b: Sigma<&2, &2, String, _ => String>) -> Bool:
167 (ak, av) = a
168 (bk, bv) = b
169 pair.le.of(String.order(ak, bk), av, bv)
170
171def pairs.show(xs: List<&2, Sigma<&2, &2, String, _ => String>>) -> List<&2, String>:
172 match xs:
173 case Nil{}:
174 Nil{}
175 case Con{(k, v), t}:
176 Con{k ++ "=" ++ v, pairs.show(t)}
177
178def query(q: String) -> String:
179 String.join(pairs.show(List.sort(~Sigma<&2, &2, String, _ => String>, ~pair.le, pairs(String.split(q, '&')))), "&")
180
181# Canonical headers: lowercase names, trimmed values with space runs squashed, sorted by name,
182# and a repeated name's values joined by ',' in the order given.
183def squash.if(space: Bool, sp: Bool, +c: U32, rest: String) -> String:
184 match space sp:
185 case True{} True{}:
186 rest
187 case _ _:
188 SCon{Chr{c}, rest}
189
190def squash(s: String, sp: Bool) -> String:
191 match s:
192 case SNil{}:
193 SNil{}
194 case SCon{Chr{+c}, t}:
195 squash.if(U32.is_eq(c, 32), sp, c, squash(t, U32.is_eq(c, 32)))
196
197def hdrs.low(xs: List<&2, Sigma<&2, &2, String, _ => String>>) -> List<&2, Sigma<&2, &2, String, _ => String>>:
198 match xs:
199 case Nil{}:
200 Nil{}
201 case Con{(n, v), t}:
202 Con{(String.to_lower(n), squash(String.trim(v), False{})), hdrs.low(t)}
203
204def name.le(a: Sigma<&2, &2, String, _ => String>, b: Sigma<&2, &2, String, _ => String>) -> Bool:
205 (an, av) = a
206 (bn, bv) = b
207 String.is_le(an, bn)
208
209def grp.if(same: Bool, +n: String, +v: String, +pn: String, +pv: String, rest: List<&2, Sigma<&2, &2, String, _ => String>>) -> List<&2, Sigma<&2, &2, String, _ => String>>:
210 match same:
211 case True{}:
212 Con{(pn, pv ++ "," ++ v), rest}
213 case False{}:
214 Con{(n, v), Con{(pn, pv), rest}}
215
216def grp.add(acc: List<&2, Sigma<&2, &2, String, _ => String>>, +n: String, +v: String) -> List<&2, Sigma<&2, &2, String, _ => String>>:
217 match acc:
218 case Nil{}:
219 [(n, v)]
220 case Con{(+pn, +pv), rest}:
221 grp.if(String.eq(pn, n), n, v, pn, pv, rest)
222
223def grp(xs: List<&2, Sigma<&2, &2, String, _ => String>>, acc: List<&2, Sigma<&2, &2, String, _ => String>>) -> List<&2, Sigma<&2, &2, String, _ => String>>:
224 match xs:
225 case Nil{}:
226 List.reverse(&2, Sigma<&2, &2, String, _ => String>, acc)
227 case Con{(+n, +v), t}:
228 grp(t, grp.add(acc, n, v))
229
230def headers(hs: List<&2, Sigma<&2, &2, String, _ => String>>) -> List<&2, Sigma<&2, &2, String, _ => String>>:
231 grp(List.sort(~Sigma<&2, &2, String, _ => String>, ~name.le, hdrs.low(hs)), Nil{})
232
233def names(xs: List<&2, Sigma<&2, &2, String, _ => String>>) -> List<&2, String>:
234 match xs:
235 case Nil{}:
236 Nil{}
237 case Con{(n, v), t}:
238 Con{n, names(t)}
239
240def lines(xs: List<&2, Sigma<&2, &2, String, _ => String>>) -> String:
241 match xs:
242 case Nil{}:
243 ""
244 case Con{(n, v), t}:
245 n ++ ":" ++ v ++ "\n" ++ lines(t)
246
247# The SignedHeaders value for headers hs.
248def signed(hs: List<&2, Sigma<&2, &2, String, _ => String>>) -> String:
249 String.join(names(headers(hs)), ";")
250
251# The canonical request. hs must hold every header to sign, host included. phash is the
252# payload's lowercase hex SHA-256, or "UNSIGNED-PAYLOAD".
253def canonical(+service: String, +method: String, +path: String, +q: String, +hs: List<&2, Sigma<&2, &2, String, _ => String>>, +phash: String) -> String:
254 +h = headers(hs)
255 method ++ "\n" ++ uri(service, path) ++ "\n" ++ query(q) ++ "\n" ++ lines(h) ++ "\n" ++ String.join(names(h), ";") ++ "\n" ++ phash
256
257def scope(+date: String, +region: String, +service: String) -> String:
258 String.take(date, 8n) ++ "/" ++ region ++ "/" ++ service ++ "/aws4_request"
259
260# The string to sign, from the hex SHA-256 of the canonical request.
261def to_sign(+date: String, +scope: String, +hash: String) -> String:
262 "AWS4-HMAC-SHA256\n" ++ date ++ "\n" ++ scope ++ "\n" ++ hash
263
264def header(+access: String, +scope: String, +signed: String, +sig: String) -> String:
265 "AWS4-HMAC-SHA256 Credential=" ++ access ++ "/" ++ scope ++ ", SignedHeaders=" ++ signed ++ ", Signature=" ++ sig
266
267# Crypto. Errors are the crypto effect's (errno, why).
268
269def hex.of(r: Result<&1, &1, U32 & String, U32 & Array<U32>>) -> Result<&1, &1, U32 & String, String>:
270 match r:
271 case Fail{e}:
272 Fail{e}
273 case Done{(len, buf)}:
274 Done{Bytes.to_hex(Bytes.Bytes{len, buf})}
275
276# Hex SHA-256 of a byte string.
277def sha.words(b: Bytes.Bytes) -> IO(Result<&1, &1, U32 & String, U32 & Array<U32>>):
278 Bytes.Bytes{+len, buf} = b
279 Crypto.sha256.words(len, buf)
280
281def sha(+s: String) -> IO(Result<&1, &1, U32 & String, String>):
282 do IO<Result<&1, &1, U32 & String, String>>:
283 r : Result<&1, &1, U32 & String, U32 & Array<U32>> <- sha.words(Bytes.from_string(s))
284 return hex.of(r)
285
286def mac.words(+kn: U32, kb: Array<U32>, d: Bytes.Bytes) -> IO(Result<&1, &1, U32 & String, U32 & Array<U32>>):
287 Bytes.Bytes{+dn, db} = d
288 Crypto.hmac.words("SHA256", kn, kb, dn, db)
289
290def words(b: Bytes.Bytes) -> Result<&1, &1, U32 & String, U32 & Array<U32>>:
291 Bytes.Bytes{+len, buf} = b
292 Done{(len, buf)}
293
294# HMAC-SHA256 of msg under the key k holds, or k's failure.
295def mac(k: Result<&1, &1, U32 & String, U32 & Array<U32>>, +msg: String) -> IO(Result<&1, &1, U32 & String, U32 & Array<U32>>):
296 match k:
297 case Fail{e}:
298 IO.pure(Result<&1, &1, U32 & String, U32 & Array<U32>>, Fail{e})
299 case Done{(kn, kb)}:
300 mac.words(kn, kb, Bytes.from_string(msg))
301
302# The signing key: HMAC(HMAC(HMAC(HMAC("AWS4" + secret, day), region), service), "aws4_request").
303def key(+secret: String, +day: String, +region: String, +service: String) -> IO(Result<&1, &1, U32 & String, U32 & Array<U32>>):
304 do IO<Result<&1, &1, U32 & String, U32 & Array<U32>>>:
305 k1 : Result<&1, &1, U32 & String, U32 & Array<U32>> <- mac(words(Bytes.from_string("AWS4" ++ secret)), day)
306 k2 : Result<&1, &1, U32 & String, U32 & Array<U32>> <- mac(k1, region)
307 k3 : Result<&1, &1, U32 & String, U32 & Array<U32>> <- mac(k2, service)
308 mac(k3, "aws4_request")
309
310def signature.of(h: Result<&1, &1, U32 & String, String>, +secret: String, +date: String, +region: String, +service: String) -> IO(Result<&1, &1, U32 & String, String>):
311 match h:
312 case Fail{e}:
313 IO.pure(Result<&1, &1, U32 & String, String>, Fail{e})
314 case Done{+hash}:
315 do IO<Result<&1, &1, U32 & String, String>>:
316 k : Result<&1, &1, U32 & String, U32 & Array<U32>> <- key(secret, String.take(date, 8n), region, service)
317 s : Result<&1, &1, U32 & String, U32 & Array<U32>> <- mac(k, to_sign(date, scope(date, region, service), hash))
318 return hex.of(s)
319
320# The hex signature of a canonical request.
321def signature(+secret: String, +date: String, +region: String, +service: String, +creq: String) -> IO(Result<&1, &1, U32 & String, String>):
322 do IO<Result<&1, &1, U32 & String, String>>:
323 h : Result<&1, &1, U32 & String, String> <- sha(creq)
324 signature.of(h, secret, date, region, service)
325
326def header.of(r: Result<&1, &1, U32 & String, String>, +access: String, +scope: String, +signed: String) -> Result<&1, &1, U32 & String, String>:
327 match r:
328 case Fail{e}:
329 Fail{e}
330 case Done{sig}:
331 Done{header(access, scope, signed, sig)}
332
333# The Authorization header over exactly the headers hs: the general form, for any header set.
334# hs must include host and x-amz-date, and x-amz-security-token for temporary credentials;
335# creds.token is not added here (authorize.hash adds it). Send every header in hs.
336def sign(creds: Credentials, +region: String, +service: String, +date: String, +method: String, +path: String, +q: String, +hs: List<&2, Sigma<&2, &2, String, _ => String>>, +phash: String) -> IO(Result<&1, &1, U32 & String, String>):
337 Credentials{+access, +secret, token} = creds
338 do IO<Result<&1, &1, U32 & String, String>>:
339 s : Result<&1, &1, U32 & String, String> <- signature(secret, date, region, service, canonical(service, method, path, q, hs, phash))
340 return header.of(s, access, scope(date, region, service), signed(hs))
341
342def token.hdr(empty: Bool, +token: String) -> List<&2, Sigma<&2, &2, String, _ => String>>:
343 match empty:
344 case True{}:
345 Nil{}
346 case False{}:
347 [("x-amz-security-token", token)]
348
349# The Authorization header over host;x-amz-content-sha256;x-amz-date, plus x-amz-security-token
350# when creds has a token. Send those headers with these values. phash: the payload's hex
351# SHA-256, or "UNSIGNED-PAYLOAD".
352def authorize.hash(creds: Credentials, +region: String, +service: String, +date: String, +method: String, +path: String, +q: String, +host: String, +phash: String) -> IO(Result<&1, &1, U32 & String, String>):
353 Credentials{+access, +secret, +token} = creds
354 sign(Credentials{access, secret, token}, region, service, date, method, path, q, Con{("host", host), Con{("x-amz-content-sha256", phash), Con{("x-amz-date", date), token.hdr(String.is_empty(token), token)}}}, phash)
355
356def authorize.pair(r: Result<&1, &1, U32 & String, String>, +phash: String) -> Result<&1, &1, U32 & String, String & String>:
357 match r:
358 case Fail{e}:
359 Fail{e}
360 case Done{a}:
361 Done{(a, phash)}
362
363def authorize.of(h: Result<&1, &1, U32 & String, String>, creds: Credentials, +region: String, +service: String, +date: String, +method: String, +path: String, +q: String, +host: String) -> IO(Result<&1, &1, U32 & String, String & String>):
364 match h:
365 case Fail{e}:
366 IO.pure(Result<&1, &1, U32 & String, String & String>, Fail{e})
367 case Done{+phash}:
368 do IO<Result<&1, &1, U32 & String, String & String>>:
369 a : Result<&1, &1, U32 & String, String> <- authorize.hash(creds, region, service, date, method, path, q, host, phash)
370 return authorize.pair(a, phash)
371
372# authorize.hash over the payload's SHA-256. Done{(authorization, x-amz-content-sha256)}.
373def authorize(creds: Credentials, +region: String, +service: String, +date: String, +method: String, +path: String, +q: String, +host: String, payload: Bytes.Bytes) -> IO(Result<&1, &1, U32 & String, String & String>):
374 do IO<Result<&1, &1, U32 & String, String & String>>:
375 r : Result<&1, &1, U32 & String, U32 & Array<U32>> <- sha.words(payload)
376 authorize.of(hex.of(r), creds, region, service, date, method, path, q, host)
377
378def token.q(empty: Bool, +token: String) -> String:
379 match empty:
380 case True{}:
381 ""
382 case False{}:
383 "&X-Amz-Security-Token=" ++ encode(token, False{})
384
385# The query a presigned request adds to q, before X-Amz-Signature.
386def presign.query(+access: String, +token: String, +scope: String, +date: String, +expires: U32, +q: String) -> String:
387 query(q ++ "&X-Amz-Algorithm=AWS4-HMAC-SHA256&X-Amz-Credential=" ++ encode(access ++ "/" ++ scope, False{}) ++ "&X-Amz-Date=" ++ date ++ "&X-Amz-Expires=" ++ U32.show(expires) ++ token.q(String.is_empty(token), token) ++ "&X-Amz-SignedHeaders=host")
388
389def presign.of(r: Result<&1, &1, U32 & String, String>, +cq: String) -> Result<&1, &1, U32 & String, String>:
390 match r:
391 case Fail{e}:
392 Fail{e}
393 case Done{sig}:
394 Done{cq ++ "&X-Amz-Signature=" ++ sig}
395
396def presign.go(+creds: Credentials, +region: String, +service: String, +date: String, +method: String, +path: String, +q: String, +host: String, +expires: U32) -> IO(Result<&1, &1, U32 & String, String>):
397 Credentials{+access, +secret, +token} = creds
398 +cq = presign.query(access, token, scope(date, region, service), date, expires, q)
399 do IO<Result<&1, &1, U32 & String, String>>:
400 s : Result<&1, &1, U32 & String, String> <- signature(secret, date, region, service, canonical(service, method, path, cq, [("host", host)], "UNSIGNED-PAYLOAD"))
401 return presign.of(s, cq)
402
403def presign.if(ok: Bool, +creds: Credentials, +region: String, +service: String, +date: String, +method: String, +path: String, +q: String, +host: String, +expires: U32) -> IO(Result<&1, &1, U32 & String, String>):
404 match ok:
405 case True{}:
406 presign.go(creds, region, service, date, method, path, q, host, expires)
407 case False{}:
408 IO.pure(Result<&1, &1, U32 & String, String>, Fail{(22, "sigv4: expires must be 1 to 604800 seconds")})
409
410# A presigned URL's query, signing host only over UNSIGNED-PAYLOAD, valid for expires seconds,
411# 1 to 604800 (else Fail EINVAL). Request https://{host}{path}?{result} with no auth headers.
412def presign(+creds: Credentials, +region: String, +service: String, +date: String, +method: String, +path: String, +q: String, +host: String, +expires: U32) -> IO(Result<&1, &1, U32 & String, String>):
413 presign.if(Bool.and(U32.is_lt(0, expires), U32.is_le(expires, 604800)), creds, region, service, date, method, path, q, host, expires)
414
415# ---- S3
416
417# Path: {endpoint}/{bucket}/{key}. Virtual: {bucket}.{endpoint host}/{key}.
418type Style is Data:
419 Path{}
420 Virtual{}
421
422# endpoint: scheme://host[:port], as https://s3.us-east-1.amazonaws.com or http://127.0.0.1:9000. Its path is ignored.
423type Config is Data:
424 Config{endpoint: String, region: String, style: Style, creds: Credentials}
425
426type Client is Type:
427 Client{cfg: Config, http: Hairpin.Client}
428
429# ErrNet: no response. ErrSign: the signer failed. ErrConfig: a bad endpoint or a missing setting.
430# ErrS3: any status outside 2xx, redirects included, with S3's error Code and Message ("" when there is no
431# error body, as for HEAD). ErrXml: a 2xx body that is not the XML asked for, with its text.
432type Err is Data:
433 ErrNet{e: Http.Err}
434 ErrSign{code: U32, why: String}
435 ErrConfig{why: String}
436 ErrS3{status: U32, code: String, message: String}
437 ErrXml{body: String}
438
439# etag keeps S3's quotes. modified is S3's ISO 8601 text.
440type Object is Data:
441 Object{key: String, size: Nat, etag: String, modified: String}
442
443# next: the continuation token when S3 cut the listing off.
444type Page is Data:
445 Page{objects: List<&2, Object>, prefixes: List<&2, String>, next: Maybe<&2, String>}
446
447# From a HEAD: Content-Length, ETag, Content-Type, and Last-Modified.
448type Meta is Data:
449 Meta{size: Nat, etag: String, mime: String, modified: String}
450
451# ---- config
452
453# Redirects come back as ErrS3: a signed request must not follow one.
454def new(cfg: Config) -> Client:
455 Client{cfg, Hairpin.redirect(Hairpin.new(), Http.ModeManual{})}
456
457def close(c: Client) -> IO(Unit):
458 Client{cfg, http} = c
459 Hairpin.close(http)
460
461# Up to n more tries after a connect error, a timeout, or 408, 429, 500, 502, 503, or 504. The signature stays valid for 15 minutes.
462def retry(c: Client, n: U32) -> Client:
463 Client{cfg, http} = c
464 Client{cfg, Hairpin.retry(http, n)}
465
466def timeout(c: Client, ms: U32) -> Client:
467 Client{cfg, http} = c
468 Client{cfg, Hairpin.timeout(http, ms)}
469
470# AWS itself: https://s3.{region}.amazonaws.com, virtual-hosted.
471def aws(+region: String, creds: Credentials) -> Config:
472 Config{"https://s3." ++ region ++ ".amazonaws.com", region, Virtual{}, creds}
473
474def env(r: Result<&1, &1, U32 & String, String>) -> String:
475 match r:
476 case Fail{e}:
477 ""
478 case Done{s}:
479 s
480
481def or(+a: String, b: String) -> String:
482 Bool.pick(String, String.is_empty(a), b, a)
483
484def from_env.cfg(custom: Bool, +region: String, endpoint: String, creds: Credentials) -> Config:
485 match custom:
486 case True{}:
487 Config{endpoint, region, Path{}, creds}
488 case False{}:
489 aws(region, creds)
490
491def from_env.if(missing: Bool, access: String, secret: String, token: String, region: String, +endpoint: String) ->
492 Result<&1, &1, Err, Config>:
493 match missing:
494 case True{}:
495 Fail{ErrConfig{"AWS_ACCESS_KEY_ID and AWS_SECRET_ACCESS_KEY must be set"}}
496 case False{}:
497 Done{from_env.cfg(Bool.not(String.is_empty(endpoint)), region, endpoint, Credentials{access, secret, token})}
498
499def from_env.of(+access: String, +secret: String, token: String, region: String, endpoint: String) -> Result<&1, &1, Err, Config>:
500 from_env.if(Bool.or(String.is_empty(access), String.is_empty(secret)), access, secret, token, region, endpoint)
501
502# AWS_ACCESS_KEY_ID, AWS_SECRET_ACCESS_KEY, AWS_SESSION_TOKEN; AWS_REGION, else AWS_DEFAULT_REGION, else us-east-1;
503# AWS_ENDPOINT_URL_S3, else AWS_ENDPOINT_URL. A custom endpoint is path-style, as MinIO wants; AWS is virtual-hosted.
504def from_env() -> IO(Result<&1, &1, Err, Config>):
505 do IO<Result<&1, &1, Err, Config>>:
506 a : Result<&1, &1, U32 & String, String> <- IO.get_env("AWS_ACCESS_KEY_ID")
507 s : Result<&1, &1, U32 & String, String> <- IO.get_env("AWS_SECRET_ACCESS_KEY")
508 t : Result<&1, &1, U32 & String, String> <- IO.get_env("AWS_SESSION_TOKEN")
509 r : Result<&1, &1, U32 & String, String> <- IO.get_env("AWS_REGION")
510 dr : Result<&1, &1, U32 & String, String> <- IO.get_env("AWS_DEFAULT_REGION")
511 e3 : Result<&1, &1, U32 & String, String> <- IO.get_env("AWS_ENDPOINT_URL_S3")
512 e : Result<&1, &1, U32 & String, String> <- IO.get_env("AWS_ENDPOINT_URL")
513 return from_env.of(env(a), env(s), env(t), or(env(r), or(env(dr), "us-east-1")), or(env(e3), env(e)))
514
515# ---- XML
516
517# One closed element: its parent's name, its name, and its own text, entities decoded. Names drop any namespace prefix.
518type Leaf is Data:
519 Leaf{parent: String, name: String, text: String}
520
521# Where the lexer is: text; after '<'; a start tag's name; its attributes, outside or in "..." or '...'; after '/'
522# in a start tag; an end tag's name; <?...?>, after '?'; after '<!'; a comment, after one or two '-'; <![CDATA[ up
523# to its '['; CDATA, after one or two ']'; an entity; <!DOCTYPE ...>.
524type Lx is Data:
525 LText{}
526 LOpen{}
527 LName{}
528 LAttr{}
529 LDq{}
530 LSq{}
531 LSelf{}
532 LEnd{}
533 LPi{}
534 LPiQ{}
535 LBang{}
536 LCom{}
537 LCom1{}
538 LCom2{}
539 LCdHead{}
540 LCd{}
541 LCd1{}
542 LCd2{}
543 LEnt{}
544 LDecl{}
545
546# stack: open names, innermost first. txt and nm: text and the name or entity so far, reversed. out: leaves, last first.
547# ok turns False at a mismatched end tag or an unknown entity.
548type St is Data:
549 St{stack: List<&2, String>, txt: String, nm: String, out: List<&2, Leaf>, ok: Bool}
550
551def first(xs: List<&2, String>) -> String:
552 match xs:
553 case Nil{}:
554 ""
555 case Con{h, t}:
556 h
557
558def local.go(s: String, acc: String) -> String:
559 match s:
560 case SNil{}:
561 String.reverse(acc)
562 case SCon{Chr{58}, t}:
563 local.go(t, SNil{})
564 case SCon{c, t}:
565 local.go(t, SCon{c, acc})
566
567# The name after its namespace prefix, as Key for s3:Key.
568def local(s: String) -> String:
569 local.go(s, SNil{})
570
571def st.txt(st: St, c: Char) -> St:
572 St{a, x, n, o, k} = st
573 St{a, SCon{c, x}, n, o, k}
574
575def st.nm(st: St, c: Char) -> St:
576 St{a, x, n, o, k} = st
577 St{a, x, SCon{c, n}, o, k}
578
579def st.nm0(st: St) -> St:
580 St{a, x, n, o, k} = st
581 St{a, x, "", o, k}
582
583def st.open(st: St) -> St:
584 St{a, x, n, o, k} = st
585 St{Con{local(String.reverse(n)), a}, "", "", o, k}
586
587def st.shut(stack: List<&2, String>, txt: String, out: List<&2, Leaf>, ok: Bool, +name: String) -> St:
588 match stack:
589 case Nil{}:
590 St{Nil{}, "", "", out, False{}}
591 case Con{+top, +rest}:
592 St{rest, "", "", Con{Leaf{first(rest), top, String.reverse(txt)}, out}, Bool.and(ok, String.eq(top, name))}
593
594def st.close(st: St) -> St:
595 St{a, x, n, o, k} = st
596 st.shut(a, x, o, k, local(String.reverse(n)))
597
598def st.close.top(st: St) -> St:
599 St{+a, x, n, o, k} = st
600 st.shut(a, x, o, k, first(a))
601
602def hex.digit(+c: U32) -> Maybe<&2, U32>:
603 Bool.pick(Maybe<&2, U32>, Bool.and(U32.is_le(48, c), U32.is_le(c, 57)), Some{(c - 48 : U32)},
604 Bool.pick(Maybe<&2, U32>, Bool.and(U32.is_le(97, c), U32.is_le(c, 102)), Some{(c - 87 : U32)},
605 Bool.pick(Maybe<&2, U32>, Bool.and(U32.is_le(65, c), U32.is_le(c, 70)), Some{(c - 55 : U32)}, None{})))
606
607def hex.step(m: Maybe<&2, U32>, +acc: U32) -> Maybe<&2, U32>:
608 match m:
609 case None{}:
610 None{}
611 case Some{d}:
612 Some{(acc * 16 + d : U32)}
613
614# ponytail: no overflow check; a reference past U+10FFFF wraps and decodes to junk rather than failing.
615def hex(s: String, m: Maybe<&2, U32>) -> Maybe<&2, U32>:
616 match s:
617 case SNil{}:
618 m
619 case SCon{Chr{c}, t}:
620 match m:
621 case None{}:
622 None{}
623 case Some{acc}:
624 hex(t, hex.step(hex.digit(c), acc))
625
626def ent.num(+s: String) -> Maybe<&2, U32>:
627 Bool.pick(Maybe<&2, U32>, String.starts_with(s, "x"), hex(String.drop(s, 1n), Some{0}), U32.read(s))
628
629# The five XML entities and &#NN; / &#xHH;. None for any other.
630def ent(+e: String) -> Maybe<&2, U32>:
631 Bool.pick(Maybe<&2, U32>, String.eq(e, "lt"), Some{60},
632 Bool.pick(Maybe<&2, U32>, String.eq(e, "gt"), Some{62},
633 Bool.pick(Maybe<&2, U32>, String.eq(e, "amp"), Some{38},
634 Bool.pick(Maybe<&2, U32>, String.eq(e, "quot"), Some{34},
635 Bool.pick(Maybe<&2, U32>, String.eq(e, "apos"), Some{39},
636 Bool.pick(Maybe<&2, U32>, Bool.and(String.starts_with(e, "#"), Nat.is_lt(1n, String.length(e))), ent.num(String.drop(e, 1n)), None{}))))))
637
638def st.ent.of(m: Maybe<&2, U32>, st: St) -> St:
639 match m:
640 case None{}:
641 St{a, x, n, o, k} = st
642 St{a, x, n, o, False{}}
643 case Some{c}:
644 st.txt(st, Chr{c})
645
646def st.ent(st: St) -> St:
647 St{a, x, n, o, k} = st
648 st.ent.of(ent(String.reverse(n)), St{a, x, "", o, k})
649
650def lx.idle(m: Lx) -> Bool:
651 match m:
652 case LText{}:
653 True{}
654 case _:
655 False{}
656
657def st.end(m: Lx, st: St) -> St:
658 St{a, x, n, o, k} = st
659 St{a, x, n, o, Bool.and(k, lx.idle(m))}
660
661# One pass over the text. Each step takes one char, so it ends.
662def lex(s: String, m: Lx, st: St) -> St:
663 match s:
664 case SNil{}:
665 st.end(m, st)
666 case SCon{h, t}:
667 match h m:
668 case '<' LText{}:
669 lex(t, LOpen{}, st.nm0(st))
670 case '&' LText{}:
671 lex(t, LEnt{}, st.nm0(st))
672 case c LText{}:
673 lex(t, LText{}, st.txt(st, c))
674 case '/' LOpen{}:
675 lex(t, LEnd{}, st)
676 case '?' LOpen{}:
677 lex(t, LPi{}, st)
678 case '!' LOpen{}:
679 lex(t, LBang{}, st)
680 case c LOpen{}:
681 lex(t, LName{}, st.nm(st, c))
682 case '>' LName{}:
683 lex(t, LText{}, st.open(st))
684 case '/' LName{}:
685 lex(t, LSelf{}, st.open(st))
686 case ' ' LName{}:
687 lex(t, LAttr{}, st.open(st))
688 case Chr{9} LName{}:
689 lex(t, LAttr{}, st.open(st))
690 case Chr{10} LName{}:
691 lex(t, LAttr{}, st.open(st))
692 case Chr{13} LName{}:
693 lex(t, LAttr{}, st.open(st))
694 case c LName{}:
695 lex(t, LName{}, st.nm(st, c))
696 case '"' LAttr{}:
697 lex(t, LDq{}, st)
698 case Chr{39} LAttr{}:
699 lex(t, LSq{}, st)
700 case '>' LAttr{}:
701 lex(t, LText{}, st)
702 case '/' LAttr{}:
703 lex(t, LSelf{}, st)
704 case c LAttr{}:
705 lex(t, LAttr{}, st)
706 case '"' LDq{}:
707 lex(t, LAttr{}, st)
708 case c LDq{}:
709 lex(t, LDq{}, st)
710 case Chr{39} LSq{}:
711 lex(t, LAttr{}, st)
712 case c LSq{}:
713 lex(t, LSq{}, st)
714 case '>' LSelf{}:
715 lex(t, LText{}, st.close.top(st))
716 case c LSelf{}:
717 lex(t, LAttr{}, st)
718 case '>' LEnd{}:
719 lex(t, LText{}, st.close(st))
720 case ' ' LEnd{}:
721 lex(t, LEnd{}, st)
722 case Chr{9} LEnd{}:
723 lex(t, LEnd{}, st)
724 case Chr{10} LEnd{}:
725 lex(t, LEnd{}, st)
726 case Chr{13} LEnd{}:
727 lex(t, LEnd{}, st)
728 case c LEnd{}:
729 lex(t, LEnd{}, st.nm(st, c))
730 case '?' LPi{}:
731 lex(t, LPiQ{}, st)
732 case c LPi{}:
733 lex(t, LPi{}, st)
734 case '>' LPiQ{}:
735 lex(t, LText{}, st)
736 case '?' LPiQ{}:
737 lex(t, LPiQ{}, st)
738 case c LPiQ{}:
739 lex(t, LPi{}, st)
740 case '-' LBang{}:
741 lex(t, LCom{}, st)
742 case '[' LBang{}:
743 lex(t, LCdHead{}, st)
744 case c LBang{}:
745 lex(t, LDecl{}, st)
746 case '-' LCom{}:
747 lex(t, LCom1{}, st)
748 case c LCom{}:
749 lex(t, LCom{}, st)
750 case '-' LCom1{}:
751 lex(t, LCom2{}, st)
752 case c LCom1{}:
753 lex(t, LCom{}, st)
754 case '>' LCom2{}:
755 lex(t, LText{}, st)
756 case '-' LCom2{}:
757 lex(t, LCom2{}, st)
758 case c LCom2{}:
759 lex(t, LCom{}, st)
760 case '[' LCdHead{}:
761 lex(t, LCd{}, st)
762 case c LCdHead{}:
763 lex(t, LCdHead{}, st)
764 case ']' LCd{}:
765 lex(t, LCd1{}, st)
766 case c LCd{}:
767 lex(t, LCd{}, st.txt(st, c))
768 case ']' LCd1{}:
769 lex(t, LCd2{}, st)
770 case c LCd1{}:
771 lex(t, LCd{}, st.txt(st.txt(st, ']'), c))
772 case '>' LCd2{}:
773 lex(t, LText{}, st)
774 case ']' LCd2{}:
775 lex(t, LCd2{}, st.txt(st, ']'))
776 case c LCd2{}:
777 lex(t, LCd{}, st.txt(st.txt(st.txt(st, ']'), ']'), c))
778 case ';' LEnt{}:
779 lex(t, LText{}, st.ent(st))
780 case c LEnt{}:
781 lex(t, LEnt{}, st.nm(st, c))
782 case '>' LDecl{}:
783 lex(t, LText{}, st)
784 case c LDecl{}:
785 lex(t, LDecl{}, st)
786
787def xml.if(ok: Bool, out: List<&2, Leaf>) -> Maybe<&2, List<&2, Leaf>>:
788 match ok:
789 case True{}:
790 Some{List.reverse(&2, Leaf, out)}
791 case False{}:
792 None{}
793
794def closed(xs: List<&2, String>) -> Bool:
795 match xs:
796 case Nil{}:
797 True{}
798 case Con{h, t}:
799 False{}
800
801def xml.fin(st: St) -> Maybe<&2, List<&2, Leaf>>:
802 St{a, x, n, o, k} = st
803 xml.if(Bool.and(k, closed(a)), o)
804
805# The closed elements of a document in document order, or None when it is not well formed.
806# ponytail: no DTD internal subsets, and no check of names or attribute syntax; S3 sends neither.
807def xml(s: String) -> Maybe<&2, List<&2, Leaf>>:
808 xml.fin(lex(s, LText{}, St{Nil{}, "", "", Nil{}, True{}}))
809
810# ---- responses
811
812# S3's <Error><Code>..</Code><Message>..</Message></Error>.
813def fault.scan(ls: List<&2, Leaf>, code: String, msg: String) -> String & String:
814 match ls:
815 case Nil{}:
816 (code, msg)
817 case Con{Leaf{+p, +n, +x}, t}:
818 +err = String.eq(p, "Error")
819 fault.scan(t, Bool.pick(String, Bool.and(err, String.eq(n, "Code")), x, code),
820 Bool.pick(String, Bool.and(err, String.eq(n, "Message")), x, msg))
821
822def fault.of(+status: U32, cm: String & String) -> Err:
823 (code, msg) = cm
824 ErrS3{status, code, msg}
825
826def fault(+status: U32, m: Maybe<&2, List<&2, Leaf>>) -> Err:
827 match m:
828 case None{}:
829 ErrS3{status, "", ""}
830 case Some{ls}:
831 fault.of(status, fault.scan(ls, "", ""))
832
833def ok(+s: U32) -> Bool:
834 Bool.and(U32.is_le(200, s), U32.is_lt(s, 300))
835
836def judge.res(good: Bool, +status: U32, h: Map<&2, List<&2, String>>, b: Bytes.Bytes) -> Result<&1, &1, Err, Http.Res>:
837 match good:
838 case True{}:
839 Done{Http.Res{status, h, b}}
840 case False{}:
841 Fail{fault(status, xml(Enc.utf8.decode(b)))}
842
843def judge(r: Result<&1, &1, Http.Err, Http.Res>) -> Result<&1, &1, Err, Http.Res>:
844 match r:
845 case Fail{e}:
846 Fail{ErrNet{e}}
847 case Done{res}:
848 Http.Res{+status, h, b} = res
849 judge.res(ok(status), status, h, b)
850
851# ---- requests
852
853def stamp.of(m: Maybe<&2, Time.DateTime>) -> String:
854 match m:
855 case None{}:
856 ""
857 case Some{Time.DateTime{Time.Date{y, mo, d}, h, mi, s, n}}:
858 String.concat([Time.pad(y, 4n), Time.pad(mo, 2n), Time.pad(d, 2n), "T", Time.pad(h, 2n), Time.pad(mi, 2n), Time.pad(s, 2n), "Z"])
859
860# Now as YYYYMMDDTHHMMSSZ. "" only outside years 0 to 9999, which S3 then refuses.
861def stamp() -> IO(String):
862 do IO<String>:
863 now : Time.Instant <- Time.now()
864 return stamp.of(Time.DateTime.of_instant(now))
865
866# origin: scheme://host field. host: the Host field, as Http sends it. path: the wire path.
867type Where is Data:
868 Where{origin: String, host: String, path: String}
869
870# "" for the bucket itself.
871def seg(+key: String) -> String:
872 Bool.pick(String, String.is_empty(key), "", "/" ++ encode(key, True{}))
873
874def loc.at(style: Style, +bucket: String, +key: String, a: Url.Abs) -> Where:
875 match style:
876 case Path{}:
877 Url.Abs{+scheme, host, port, t} = a
878 +field = Url.host_field(Url.Abs{scheme, host, port, "/"})
879 Where{scheme ++ "://" ++ field, field, "/" ++ bucket ++ seg(key)}
880 case Virtual{}:
881 Url.Abs{+scheme, host, port, t} = a
882 +field = Url.host_field(Url.Abs{scheme, bucket ++ "." ++ host, port, "/"})
883 Where{scheme ++ "://" ++ field, field, or(seg(key), "/")}
884
885def loc(style: Style, +bucket: String, +key: String, m: Maybe<&2, Url.Abs>) -> Maybe<&2, Where>:
886 match m:
887 case None{}:
888 None{}
889 case Some{a}:
890 Some{loc.at(style, bucket, key, a)}
891
892def token(c: Credentials) -> String:
893 Credentials{a, s, t} = c
894 t
895
896def with.token(+token: String, +h: Map<&2, List<&2, String>>) -> Map<&2, List<&2, String>>:
897 Bool.pick(Map<&2, List<&2, String>>, String.is_empty(token), h, Http.set(h, "x-amz-security-token", token))
898
899# extra, and the headers the signature covers. Host is Http's own, from the same URL.
900def request.signed(extra: Map<&2, List<&2, String>>, date: String, +token: String, got: String & String) -> Map<&2, List<&2, String>>:
901 (auth, hash) = got
902 with.token(token, Http.set(Http.set(Http.set(Http.set(extra, "x-amz-date", date), "x-amz-content-sha256", hash), "authorization", auth), "accept-encoding", "identity"))
903
904def url(origin: String, path: String, +query: String) -> String:
905 origin ++ path ++ Bool.pick(String, String.is_empty(query), "", "?" ++ query)
906
907def call.done(cfg: Config, x: Hairpin.Client & Result<&1, &1, Http.Err, Http.Res>) -> Client & Result<&1, &1, Err, Http.Res>:
908 (h, r) = x
909 (Client{cfg, h}, judge(r))
910
911# Hairpin.request with the codings "identity": Http then leaves a stored Content-Encoding (gzip, br, ..) as sent,
912# so GET returns the object's bytes and HEAD's size matches. ponytail: Http still undoes x-gzip, which S3 rarely stores.
913def send(c: Hairpin.Client, +method: String, url: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes) ->
914 IO(Hairpin.Client & Result<&1, &1, Http.Err, Http.Res>):
915 Hairpin.Client{+o, p, j} = c
916 Hairpin.Opts{b, +h, ms, mode, +n, cert} = o
917 Hairpin.request.go(o, n, "identity", p, j, method, Hairpin.target.abs(Some{url}), Hairpin.merge(h, headers), body)
918
919def call.send(s: Result<&1, &1, U32 & String, String & String>, cfg: Config, http: Hairpin.Client, +method: String, url: String,
920 extra: Map<&2, List<&2, String>>, date: String, token: String, body: Bytes.Bytes) -> IO(Client & Result<&1, &1, Err, Http.Res>):
921 match s:
922 case Fail{e}:
923 (code, why) = e
924 IO.pure(Client & Result<&1, &1, Err, Http.Res>, (Client{cfg, http}, Fail{ErrSign{code, why}}))
925 case Done{got}:
926 do IO<Client & Result<&1, &1, Err, Http.Res>>:
927 x : Hairpin.Client & Result<&1, &1, Http.Err, Http.Res> <- send(http, method, url, request.signed(extra, date, token, got), body)
928 return call.done(cfg, x)
929
930# The signer hashes one copy of the body; the other goes on the wire.
931def call.sign(got: Where, +endpoint: String, +region: String, +style: Style, +creds: Credentials,
932 http: Hairpin.Client, +method: String, +query: String, extra: Map<&2, List<&2, String>>, +date: String,
933 b: Bytes.Bytes & Bytes.Bytes) -> IO(Client & Result<&1, &1, Err, Http.Res>):
934 Where{origin, host, +path} = got
935 (keep, copy) = b
936 do IO<Client & Result<&1, &1, Err, Http.Res>>:
937 s : Result<&1, &1, U32 & String, String & String> <- authorize(creds, region, "s3", date, method, path, query, host, copy)
938 call.send(s, Config{endpoint, region, style, creds}, http, method, url(origin, path, query), extra, date, token(creds), keep)
939
940def call.at(w: Maybe<&2, Where>, +endpoint: String, +region: String, +style: Style, +creds: Credentials,
941 http: Hairpin.Client, +method: String, +query: String, extra: Map<&2, List<&2, String>>, +date: String, body: Bytes.Bytes) ->
942 IO(Client & Result<&1, &1, Err, Http.Res>):
943 match w:
944 case None{}:
945 IO.pure(Client & Result<&1, &1, Err, Http.Res>, (Client{Config{endpoint, region, style, creds}, http}, Fail{ErrConfig{"bad endpoint: " ++ endpoint}}))
946 case Some{got}:
947 call.sign(got, endpoint, region, style, creds, http, method, query, extra, date, Bytes.slice(body, 0, 4294967295))
948
949# Object calls require a bucket and a key. ListObjectsV2 targets the bucket with list-type=2.
950# The absolute URL bypasses base resolution, so '.' and '..' in object keys survive.
951def call.run(c: Client, +method: String, +bucket: String, +key: String, +query: String, extra: Map<&2, List<&2, String>>,
952 body: Bytes.Bytes) -> IO(Client & Result<&1, &1, Err, Http.Res>):
953 Client{cfg, http} = c
954 Config{+endpoint, +region, +style, +creds} = cfg
955 do IO<Client & Result<&1, &1, Err, Http.Res>>:
956 date : String <- stamp()
957 call.at(loc(style, bucket, key, Url.absolute(endpoint)), endpoint, region, style, creds, http, method, query, extra, date, body)
958
959def call.guard(bad: Bool, c: Client, +method: String, +bucket: String, +key: String, +query: String,
960 extra: Map<&2, List<&2, String>>, body: Bytes.Bytes) -> IO(Client & Result<&1, &1, Err, Http.Res>):
961 match bad:
962 case True{}:
963 IO.pure(Client & Result<&1, &1, Err, Http.Res>, (c, Fail{ErrConfig{"bucket and object key must not be empty"}}))
964 case False{}:
965 call.run(c, method, bucket, key, query, extra, body)
966
967def call(c: Client, +method: String, +bucket: String, +key: String, +query: String, extra: Map<&2, List<&2, String>>,
968 body: Bytes.Bytes) -> IO(Client & Result<&1, &1, Err, Http.Res>):
969 call.guard(Bool.or(String.is_empty(bucket), Bool.and(String.is_empty(key), String.is_empty(query))),
970 c, method, bucket, key, query, extra, body)
971
972# ---- operations
973
974def etag.of(r: Result<&1, &1, Err, Http.Res>) -> Result<&1, &1, Err, String>:
975 match r:
976 case Fail{e}:
977 Fail{e}
978 case Done{res}:
979 Http.Res{s, +h, b} = res
980 Done{Http.header(h, "etag")}
981
982def put.done(x: Client & Result<&1, &1, Err, Http.Res>) -> Client & Result<&1, &1, Err, String>:
983 (c, r) = x
984 (c, etag.of(r))
985
986# PutObject. mime: Content-Type, "" for none. The ETag comes back.
987def put(c: Client, bucket: String, key: String, +mime: String, body: Bytes.Bytes) -> IO(Client & Result<&1, &1, Err, String>):
988 +h = Bool.pick(Map<&2, List<&2, String>>, String.is_empty(mime), Http.empty(), Http.set(Http.empty(), "content-type", mime))
989 do IO<Client & Result<&1, &1, Err, String>>:
990 x : Client & Result<&1, &1, Err, Http.Res> <- call(c, "PUT", bucket, key, "", h, body)
991 return put.done(x)
992
993def xgzip.values(xs: List<&2, String>) -> Bool:
994 match xs:
995 case Nil{}:
996 False{}
997 case Con{v, t}:
998 Bool.or(String.eq(String.to_lower(String.trim(v)), "x-gzip"), xgzip.values(t))
999
1000def xgzip.fields(xs: List<&2, String>) -> Bool:
1001 match xs:
1002 case Nil{}:
1003 False{}
1004 case Con{v, t}:
1005 Bool.or(xgzip.values(String.split(v, ',')), xgzip.fields(t))
1006
1007def body.encoding(gzip: Bool, b: Bytes.Bytes) -> Result<&1, &1, Err, Bytes.Bytes>:
1008 match gzip:
1009 case True{}:
1010 Fail{ErrConfig{"Hairpin decodes x-gzip objects; their stored bytes are unavailable"}}
1011 case False{}:
1012 Done{b}
1013
1014def body.of(r: Result<&1, &1, Err, Http.Res>) -> Result<&1, &1, Err, Bytes.Bytes>:
1015 match r:
1016 case Fail{e}:
1017 Fail{e}
1018 case Done{res}:
1019 Http.Res{s, h, b} = res
1020 body.encoding(xgzip.fields(Http.fields(h, "content-encoding")), b)
1021
1022def get.done(x: Client & Result<&1, &1, Err, Http.Res>) -> Client & Result<&1, &1, Err, Bytes.Bytes>:
1023 (c, r) = x
1024 (c, body.of(r))
1025
1026# GetObject: the object's bytes. A missing key is ErrS3{404, "NoSuchKey", ..}.
1027# ponytail: Hairpin decodes x-gzip; reject it rather than return bytes that differ from the stored object.
1028def get(c: Client, bucket: String, key: String) -> IO(Client & Result<&1, &1, Err, Bytes.Bytes>):
1029 do IO<Client & Result<&1, &1, Err, Bytes.Bytes>>:
1030 x : Client & Result<&1, &1, Err, Http.Res> <- call(c, "GET", bucket, key, "", Http.empty(), Bytes.new(0))
1031 return get.done(x)
1032
1033def nat(s: String) -> Nat:
1034 Maybe.default(&2, Nat, Nat.read(s), 0n)
1035
1036def meta.of(r: Result<&1, &1, Err, Http.Res>) -> Result<&1, &1, Err, Meta>:
1037 match r:
1038 case Fail{e}:
1039 Fail{e}
1040 case Done{res}:
1041 Http.Res{s, +h, b} = res
1042 Done{Meta{nat(Http.header(h, "content-length")), Http.header(h, "etag"), Http.header(h, "content-type"), Http.header(h, "last-modified")}}
1043
1044def head.done(x: Client & Result<&1, &1, Err, Http.Res>) -> Client & Result<&1, &1, Err, Meta>:
1045 (c, r) = x
1046 (c, meta.of(r))
1047
1048# HeadObject. A missing key is ErrS3{404, "", ""}: HEAD has no error body.
1049def head(c: Client, bucket: String, key: String) -> IO(Client & Result<&1, &1, Err, Meta>):
1050 do IO<Client & Result<&1, &1, Err, Meta>>:
1051 x : Client & Result<&1, &1, Err, Http.Res> <- call(c, "HEAD", bucket, key, "", Http.empty(), Bytes.new(0))
1052 return head.done(x)
1053
1054def unit.of(r: Result<&1, &1, Err, Http.Res>) -> Result<&1, &1, Err, Unit>:
1055 match r:
1056 case Fail{e}:
1057 Fail{e}
1058 case Done{res}:
1059 Done{Unit{}}
1060
1061def delete.done(x: Client & Result<&1, &1, Err, Http.Res>) -> Client & Result<&1, &1, Err, Unit>:
1062 (c, r) = x
1063 (c, unit.of(r))
1064
1065# DeleteObject. S3 answers 204 for a key that was never there too.
1066def delete(c: Client, bucket: String, key: String) -> IO(Client & Result<&1, &1, Err, Unit>):
1067 do IO<Client & Result<&1, &1, Err, Unit>>:
1068 x : Client & Result<&1, &1, Err, Http.Res> <- call(c, "DELETE", bucket, key, "", Http.empty(), Bytes.new(0))
1069 return delete.done(x)
1070
1071# ---- ListObjectsV2
1072
1073# cur: the <Contents> being read. Leaves come in document order, so a Contents closes after its fields.
1074type Acc is Data:
1075 Acc{cur: Object, objs: List<&2, Object>, pre: List<&2, String>, cut: Bool, next: String}
1076
1077def blank() -> Object:
1078 Object{"", 0n, "", ""}
1079
1080def obj.set(o: Object, +n: String, +x: String) -> Object:
1081 Object{+k, +sz, +e, +mo} = o
1082 Object{Bool.pick(String, String.eq(n, "Key"), x, k), Bool.pick(Nat, String.eq(n, "Size"), nat(x), sz),
1083 Bool.pick(String, String.eq(n, "ETag"), x, e), Bool.pick(String, String.eq(n, "LastModified"), x, mo)}
1084
1085def page.leaf(a: Acc, +p: String, +n: String, +x: String) -> Acc:
1086 Acc{+cur, +objs, +pre, +cut, +next} = a
1087 +top = String.eq(p, "ListBucketResult")
1088 +done = Bool.and(top, String.eq(n, "Contents"))
1089 Acc{Bool.pick(Object, done, blank(), Bool.pick(Object, String.eq(p, "Contents"), obj.set(cur, n, x), cur)),
1090 Bool.pick(List<&2, Object>, done, Con{cur, objs}, objs),
1091 Bool.pick(List<&2, String>, Bool.and(String.eq(p, "CommonPrefixes"), String.eq(n, "Prefix")), Con{x, pre}, pre),
1092 Bool.pick(Bool, Bool.and(top, String.eq(n, "IsTruncated")), String.eq(x, "true"), cut),
1093 Bool.pick(String, Bool.and(top, String.eq(n, "NextContinuationToken")), x, next)}
1094
1095def page.scan(ls: List<&2, Leaf>, a: Acc) -> Acc:
1096 match ls:
1097 case Nil{}:
1098 a
1099 case Con{Leaf{p, n, x}, t}:
1100 page.scan(t, page.leaf(a, p, n, x))
1101
1102def page.fin(a: Acc) -> Page:
1103 Acc{cur, objs, pre, +cut, +next} = a
1104 Page{List.reverse(&2, Object, objs), List.reverse(&2, String, pre),
1105 Bool.pick(Maybe<&2, String>, Bool.and(cut, Bool.not(String.is_empty(next))), Some{next}, None{})}
1106
1107def page.root.last(ls: List<&2, Leaf>, +n: String) -> String:
1108 match ls:
1109 case Nil{}:
1110 n
1111 case Con{Leaf{p, +m, x}, t}:
1112 page.root.last(t, m)
1113
1114def page.if(good: Bool, s: String, ls: List<&2, Leaf>) -> Result<&1, &1, Err, Page>:
1115 match good:
1116 case True{}:
1117 Done{page.fin(page.scan(ls, Acc{blank(), Nil{}, Nil{}, False{}, ""}))}
1118 case False{}:
1119 Fail{ErrXml{s}}
1120
1121def page.doc(+s: String, m: Maybe<&2, List<&2, Leaf>>) -> Result<&1, &1, Err, Page>:
1122 match m:
1123 case None{}:
1124 Fail{ErrXml{s}}
1125 case Some{+ls}:
1126 page.if(String.eq(page.root.last(ls, ""), "ListBucketResult"), s, ls)
1127
1128def page.of(r: Result<&1, &1, Err, Http.Res>) -> Result<&1, &1, Err, Page>:
1129 match r:
1130 case Fail{e}:
1131 Fail{e}
1132 case Done{res}:
1133 Http.Res{s, h, b} = res
1134 +text = Enc.utf8.decode(b)
1135 page.doc(text, xml(text))
1136
1137def list.done(x: Client & Result<&1, &1, Err, Http.Res>) -> Client & Result<&1, &1, Err, Page>:
1138 (c, r) = x
1139 (c, page.of(r))
1140
1141def q.kv(k: String, +v: String) -> String:
1142 k ++ "=" ++ encode(v, False{})
1143
1144def q.opt(k: String, +v: String, +rest: List<&2, String>) -> List<&2, String>:
1145 Bool.pick(List<&2, String>, String.is_empty(v), rest, Con{q.kv(k, v), rest})
1146
1147def q.token(t: Maybe<&2, String>, rest: List<&2, String>) -> List<&2, String>:
1148 match t:
1149 case None{}:
1150 rest
1151 case Some{v}:
1152 Con{q.kv("continuation-token", v), rest}
1153
1154def q.max(+n: U32) -> List<&2, String>:
1155 Bool.pick(List<&2, String>, U32.is_eq(n, 0), Nil{}, ["max-keys=" ++ U32.show(n)])
1156
1157# In the signer's order: continuation-token, delimiter, list-type, max-keys, prefix.
1158def list.query(prefix: String, delim: String, +max: U32, t: Maybe<&2, String>) -> String:
1159 String.join(q.token(t, q.opt("delimiter", delim, Con{"list-type=2", List.append(&2, String, q.max(max), q.opt("prefix", prefix, Nil{}))})), "&")
1160
1161# One page of ListObjectsV2. prefix, delim: "" for none. max: keys per page, 0 for S3's 1000. token: a page's next.
1162def list(c: Client, +bucket: String, prefix: String, delim: String, +max: U32, token: Maybe<&2, String>) ->
1163 IO(Client & Result<&1, &1, Err, Page>):
1164 do IO<Client & Result<&1, &1, Err, Page>>:
1165 x : Client & Result<&1, &1, Err, Http.Res> <- call(c, "GET", bucket, "", list.query(prefix, delim, max, token), Http.empty(), Bytes.new(0))
1166 return list.done(x)
1167
1168def all.merge(objs: List<&2, Object>, pre: List<&2, String>, r: Result<&1, &1, Err, Page>) -> Result<&1, &1, Err, Page>:
1169 match r:
1170 case Fail{e}:
1171 Fail{e}
1172 case Done{Page{os, ps, next}}:
1173 Done{Page{List.append(&2, Object, objs, os), List.append(&2, String, pre, ps), next}}
1174
1175# f: pages left. When they run out, next holds the token to go on from.
1176def all.go(f: Nat, +bucket: String, +prefix: String, +delim: String, +max: U32, objs: List<&2, Object>, pre: List<&2, String>,
1177 x: Client & Result<&1, &1, Err, Page>) -> IO(Client & Result<&1, &1, Err, Page>):
1178 match f:
1179 case 0n:
1180 (c, r) = x
1181 IO.pure(Client & Result<&1, &1, Err, Page>, (c, all.merge(objs, pre, r)))
1182 case 1n+g:
1183 (c, r) = x
1184 match r:
1185 case Fail{e}:
1186 IO.pure(Client & Result<&1, &1, Err, Page>, (c, Fail{e}))
1187 case Done{Page{os, ps, next}}:
1188 match next:
1189 case None{}:
1190 IO.pure(Client & Result<&1, &1, Err, Page>, (c, Done{Page{List.append(&2, Object, objs, os), List.append(&2, String, pre, ps), None{}}}))
1191 case Some{tok}:
1192 do IO<Client & Result<&1, &1, Err, Page>>:
1193 y : Client & Result<&1, &1, Err, Page> <- list(c, bucket, prefix, delim, max, Some{tok})
1194 all.go(g, bucket, prefix, delim, max, List.append(&2, Object, objs, os), List.append(&2, String, pre, ps), y)
1195
1196# Every page, following NextContinuationToken, up to 100000 pages.
1197def list.all(c: Client, +bucket: String, +prefix: String, +delim: String, +max: U32) -> IO(Client & Result<&1, &1, Err, Page>):
1198 do IO<Client & Result<&1, &1, Err, Page>>:
1199 x : Client & Result<&1, &1, Err, Page> <- list(c, bucket, prefix, delim, max, None{})
1200 all.go(U32.to_nat(100000), bucket, prefix, delim, max, Nil{}, Nil{}, x)