~/jendhub

sigv4.bend

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