http.bend
bend-kit-http@0.24.2.0 · 5,491 lines · 0 definitions
1# HTTP/1.1 and HTTP/2 client, with an HTTP/1.1 server. Source: https://github.com/paymog/bend-kit/tree/main/http
2import Base
3# By hash: bend-kit-url@0.4.1.0, -encoding@0.3.0.0, -json@0.5.0.1, -bytes@0.3.0.0, -dns@0.4.0.1, -zlib@0.1.5.0.
4import bend-kit-wire@0.4.2.0/wire.bend as Wire
5import bend-kit-http2@0.1.2.0/http2.bend as H2
6import bend-kit-http2@0.1.2.0/hpack.bend as Hpack
7import bend-kit-bytes@0.3.1.0/bytes.bend as HBytes
8import bend-kit-time@0.1.0.0/time.bend as Time
9import bend-kit-int@0.2.0.0/int.bend as Int
10import bend-kit-concurrency@0.1.0.0/concurrency.bend as Conc
11import bend-kit-url@0.4.1.0/url.bend as Url
12import bend-kit-encoding@0.3.0.0/encoding.bend as Enc
13import bend-kit-json@0.5.0.1/json.bend as Json
14import bend-kit-bytes@0.3.0.0/bytes.bend as Bytes
15import bend-kit-dns@0.4.0.2/dns.bend as Dns
16import bend-kit-zlib@0.1.5.0/zlib.bend as Zlib
17
18# HTTP/1.1 codec and client (RFC 9112) for http:// and https:// (OpenSSL 3 at run time).
19# parse: start-line → field lines → blank → body length (§6.3); chunked (§7.1).
20# Bodies are Bytes. The String parsers below are the spec: one Char per octet.
21# fetch reads until frame() says the response is whole. It returns Result, not Maybe.
22# Build with -o for big bodies: the `bend file.bend` runner overflows on ~30 KB strings; native binaries do not.
23# import bend-kit-http@0.22.0.0/http.bend as Http
24
25type Req is Type:
26 Req{method: String, path: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes}
27
28type Res is Type:
29 Res{status: U32, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes}
30
31# The body type and its conversions, so a caller needs no bytes import.
32def Body() -> Type:
33 Bytes.Bytes
34
35# A byte string (one Char per octet) to a body, and back.
36def from_string(+s: String) -> Bytes.Bytes:
37 Bytes.from_string(s)
38
39def to_string(b: Bytes.Bytes) -> String:
40 Bytes.to_string(b)
41
42def length(b: Bytes.Bytes) -> Bytes.Bytes & U32:
43 Bytes.length(b)
44
45# Why fetch failed. Wire errors keep the errno and the text the effect already had.
46# ponytail: 60 and 110 are ETIMEDOUT on macOS and Linux. Windows is out of scope.
47type Err is Data:
48 ErrUrl{}
49 ErrDns{}
50 ErrConnect{code: U32, why: String}
51 ErrTls{code: U32, why: String}
52 ErrRead{code: U32, why: String}
53 ErrWrite{code: U32, why: String}
54 ErrTimeout{}
55 ErrRedirect{}
56 ErrBad{}
57
58def err.late(+code: U32) -> Bool:
59 Bool.or(U32.is_eq(code, 60), U32.is_eq(code, 110))
60
61def err.pick(e: Err, late: Bool) -> Err:
62 match late:
63 case True{}:
64 ErrTimeout{}
65 case False{}:
66 e
67
68def err.or_late(code: U32, e: Err) -> Err:
69 err.pick(e, err.late(code))
70
71type Fields is Data:
72 FieldsBad{}
73 FieldsOk{m: Map<&2, List<&2, String>>}
74
75# One list per field name, in arrival order. header() is the first value.
76# Set-Cookie is never joined. Encode writes one line per value.
77def empty() -> Map<&2, List<&2, String>>:
78 Map.new(&2, List<&2, String>)
79
80def fields.of(r: Map<&2, List<&2, String>> & List<&2, String>) -> List<&2, String>:
81 (h, xs) = r
82 xs
83
84def fields(+h: Map<&2, List<&2, String>>, k: String) -> List<&2, String>:
85 fields.of(Map.get(List<&2, String>, Nil{}, h, k))
86
87def header.first(xs: List<&2, String>) -> String:
88 match xs:
89 case Nil{}:
90 ""
91 case Con{v, t}:
92 v
93
94def header(+h: Map<&2, List<&2, String>>, k: String) -> String:
95 header.first(fields(h, k))
96
97def field.last(xs: List<&2, String>) -> String:
98 match xs:
99 case Nil{}:
100 ""
101 case Con{v, Nil{}}:
102 v
103 case Con{v, t}:
104 field.last(t)
105
106# Transfer-Encoding is a list; chunked, when present, is the last coding.
107def header.last(+h: Map<&2, List<&2, String>>, k: String) -> String:
108 field.last(fields(h, k))
109
110def snoc(xs: List<&2, String>, v: String) -> List<&2, String>:
111 match xs:
112 case Nil{}:
113 [v]
114 case Con{h, t}:
115 Con{h, snoc(t, v)}
116
117def set(m: Map<&2, List<&2, String>>, k: String, v: String) -> Map<&2, List<&2, String>>:
118 Map.set(&2, List<&2, String>, m, k, [v])
119
120def add(+m: Map<&2, List<&2, String>>, +k: String, v: String) -> Map<&2, List<&2, String>>:
121 Map.set(&2, List<&2, String>, m, k, snoc(fields(m, k), v))
122
123def sanitize.cons(ch: Char, rest: String, drop: Bool) -> String:
124 match drop:
125 case True{}:
126 rest
127 case False{}:
128 SCon{ch, rest}
129
130def sanitize(s: String) -> String:
131 match s:
132 case SNil{}:
133 SNil{}
134 case SCon{Chr{+c}, t}:
135 sanitize.cons(Chr{c}, sanitize(t), Bool.or(U32.is_eq(c, 13), U32.is_eq(c, 10)))
136
137def drop_cr.last.if(cr: Bool, c: U32) -> String:
138 match cr:
139 case True{}:
140 SNil{}
141 case False{}:
142 SCon{Chr{c}, SNil{}}
143
144def drop_cr.last(+c: U32) -> String:
145 drop_cr.last.if(U32.is_eq(c, 13), c)
146
147# prev is the char before s; it is kept unless it is a final CR.
148def drop_cr.go(s: String, prev: U32) -> String:
149 match s:
150 case SNil{}:
151 drop_cr.last(prev)
152 case SCon{Chr{c}, t}:
153 SCon{Chr{prev}, drop_cr.go(t, c)}
154
155def drop_cr(s: String) -> String:
156 match s:
157 case SNil{}:
158 SNil{}
159 case SCon{Chr{c}, t}:
160 drop_cr.go(t, c)
161
162# w holds the last four octets; a char past 255 clears it.
163def blank_end.go(s: String, w: U32) -> Bool:
164 match s:
165 case SNil{}:
166 U32.is_eq(w, 218762506)
167 case SCon{Chr{+c}, t}:
168 blank_end.go(t, Bool.pick(U32, U32.is_lt(c, 256), (w * 256 + c : U32), 0))
169
170# String.ends_with(s, "\r\n\r\n") in one pass, with no reversed copy.
171def blank_end(s: String) -> Bool:
172 blank_end.go(s, 0)
173
174def trim_end.cons(h: Char, r: String, space: Bool) -> String:
175 match r:
176 case SNil{}:
177 match space:
178 case True{}:
179 SNil{}
180 case False{}:
181 SCon{h, SNil{}}
182 case SCon{a, t}:
183 SCon{h, SCon{a, t}}
184
185# String.trim_end without the two reversed copies.
186def trim_end(s: String) -> String:
187 match s:
188 case SNil{}:
189 SNil{}
190 case SCon{+h, t}:
191 trim_end.cons(h, trim_end(t), Char.is_space(h))
192
193def trim(s: String) -> String:
194 trim_end(String.trim_start(s))
195
196# Bool.pick evaluates both arms; a split that recursed inside it would reverse acc at every byte.
197def take.cut(acc: String, rest: String) -> String & String:
198 (String.reverse(String.drop(acc, 1n)), rest)
199
200# hit: the last char pushed onto acc was the stop char.
201def take_sp.go(s: String, acc: String, hit: Bool) -> String & String:
202 match s:
203 case SNil{}:
204 match hit:
205 case True{}:
206 take.cut(acc, SNil{})
207 case False{}:
208 (String.reverse(acc), SNil{})
209 case SCon{Chr{+c}, t}:
210 match hit:
211 case True{}:
212 take.cut(acc, SCon{Chr{c}, t})
213 case False{}:
214 take_sp.go(t, SCon{Chr{c}, acc}, U32.is_eq(c, 32))
215
216def take_sp(s: String) -> String & String:
217 take_sp.go(s, SNil{}, False{})
218
219def start_line.ver(m: String, pv: String & String) -> String & String & String:
220 (p, v) = pv
221 (m, p, drop_cr(v))
222
223def start_line.rest(mr: String & String) -> String & String & String:
224 (m, r) = mr
225 start_line.ver(m, take_sp(r))
226
227def start_line(s: String) -> String & String & String:
228 start_line.rest(take_sp(s))
229
230def split_at_blank.go(s: String, e: Bool, w: U32, acc: String) -> String & String:
231 match s:
232 case SNil{}:
233 (String.reverse(acc), SNil{})
234 case SCon{Chr{+a}, t}:
235 match e:
236 case True{}:
237 (String.reverse(acc), SCon{Chr{a}, t})
238 case False{}:
239 +w2 = (w * 256 + a : U32)
240 split_at_blank.go(t, U32.is_eq(w2, 218762506), w2, SCon{Chr{a}, acc})
241
242# split_at_blank, plus whether the head ends in the blank line.
243def split_at_blank.flag.go(+raw: String, s: String, off: Nat, w: U32, e: Bool) -> String & String & Bool:
244 match s:
245 case SNil{}:
246 (String.take(raw, off), SNil{}, e)
247 case SCon{Chr{+a}, t}:
248 match e:
249 case True{}:
250 (String.take(raw, off), SCon{Chr{a}, t}, True{})
251 case False{}:
252 +w2 = (w * 256 + a : U32)
253 +off1 = (1n + off : Nat)
254 split_at_blank.flag.go(raw, t, off1, w2, U32.is_eq(w2, 218762506))
255
256def split_at_blank.pair(r: String & String & Bool) -> String & String:
257 (head, rest, whole) = r
258 (head, rest)
259
260def split_at_blank(+s: String) -> String & String:
261 split_at_blank.pair(split_at_blank.flag.go(s, s, 0n, 0, False{}))
262
263def split_colon.go(s: String, acc: String, hit: Bool) -> String & String:
264 match s:
265 case SNil{}:
266 match hit:
267 case True{}:
268 take.cut(acc, SNil{})
269 case False{}:
270 (String.reverse(acc), SNil{})
271 case SCon{Chr{+c}, t}:
272 match hit:
273 case True{}:
274 take.cut(acc, SCon{Chr{c}, t})
275 case False{}:
276 split_colon.go(t, SCon{Char.to_lower(Chr{c}), acc}, U32.is_eq(c, 58))
277
278def split_colon(+s: String) -> String & String:
279 split_colon.go(s, SNil{}, False{})
280
281def has_header.of(r: Map<&2, List<&2, String>> & Bool) -> Bool:
282 (h, b) = r
283 b
284
285def has_header(+h: Map<&2, List<&2, String>>, k: String) -> Bool:
286 has_header.of(Map.has(&2, List<&2, String>, h, k))
287
288def folded(+line: String) -> Bool:
289 Bool.or(String.starts_with(line, " "), String.starts_with(line, "\t"))
290
291def tracked(+k: String) -> Bool:
292 Bool.or(String.eq(k, "host"), String.eq(k, "content-length"))
293
294def fields_put.dup(m: Map<&2, List<&2, String>>, k: String, v: String, bad: Bool) -> Fields:
295 match bad:
296 case True{}:
297 FieldsBad{}
298 case False{}:
299 FieldsOk{add(m, k, v)}
300
301def fields_put.tracked(+m: Map<&2, List<&2, String>>, +k: String, v: String, t: Bool) -> Fields:
302 match t:
303 case True{}:
304 fields_put.dup(m, k, v, has_header(m, k))
305 case False{}:
306 FieldsOk{add(m, k, v)}
307
308def fields_put.key(+m: Map<&2, List<&2, String>>, +k: String, v: String) -> Fields:
309 fields_put.tracked(m, k, v, tracked(k))
310
311def fields_put.kv(m: Map<&2, List<&2, String>>, kv: String & String) -> Fields:
312 (k, v) = kv
313 fields_put.key(m, k, trim(v))
314
315def fields_put.fold(m: Map<&2, List<&2, String>>, line: String, fold: Bool) -> Fields:
316 match fold:
317 case True{}:
318 FieldsBad{}
319 case False{}:
320 fields_put.kv(m, split_colon(line))
321
322def fields_put.empty(m: Map<&2, List<&2, String>>, +line: String, e: Bool) -> Fields:
323 match e:
324 case True{}:
325 FieldsOk{m}
326 case False{}:
327 fields_put.fold(m, line, folded(line))
328
329def fields_put.ok(m: Map<&2, List<&2, String>>, +line: String) -> Fields:
330 fields_put.empty(m, line, String.is_empty(line))
331
332def fields_put(acc: Fields, line: String) -> Fields:
333 match acc:
334 case FieldsBad{}:
335 FieldsBad{}
336 case FieldsOk{m}:
337 fields_put.ok(m, line)
338
339def parse.headers.done(acc: Fields) -> Maybe<&2, Map<&2, List<&2, String>>>:
340 match acc:
341 case FieldsBad{}:
342 None{}
343 case FieldsOk{m}:
344 Some{m}
345
346def parse.headers(xs: List<&2, String>, acc: Fields) -> Maybe<&2, Map<&2, List<&2, String>>>:
347 match xs:
348 case Nil{}:
349 parse.headers.done(acc)
350 case Con{line, rest}:
351 parse.headers(rest, fields_put(acc, drop_cr(line)))
352
353def parse_u32.digit(+c: U32) -> Bool:
354 Bool.and(U32.is_le(48, c), U32.is_le(c, 57))
355
356def parse_u32.add(acc: U32, c: U32) -> U32:
357 (acc * 10 + (c - 48 : U32) : U32)
358
359def parse_u32.done(acc: U32, bad: Bool) -> Maybe<&2, U32>:
360 match bad:
361 case True{}:
362 None{}
363 case False{}:
364 Some{acc}
365
366def parse_u32.go(s: String, acc: U32, bad: Bool) -> Maybe<&2, U32>:
367 match s:
368 case SNil{}:
369 parse_u32.done(acc, bad)
370 case SCon{Chr{+c}, t}:
371 parse_u32.go(t, parse_u32.add(acc, c), Bool.or(bad, Bool.not(parse_u32.digit(c))))
372
373def parse_u32(s: String) -> Maybe<&2, U32>:
374 match s:
375 case SNil{}:
376 None{}
377 case SCon{Chr{+c}, t}:
378 parse_u32.go(t, parse_u32.add(0, c), Bool.not(parse_u32.digit(c)))
379
380# More: a valid prefix. Bad: cannot become a body. Body: a whole chunked body.
381type Hold is Data:
382 HoldMore{}
383 HoldBad{}
384 HoldBody{b: String}
385 HoldUntil{b: String}
386
387def is_hex(+c: U32) -> Bool:
388 Bool.or(parse_u32.digit(c), Bool.or(Bool.and(U32.is_le(97, c), U32.is_le(c, 102)), Bool.and(U32.is_le(65, c), U32.is_le(c, 70))))
389
390def hexv(+c: U32) -> U32:
391 Bool.pick(U32, parse_u32.digit(c), (c - 48 : U32), Bool.pick(U32, U32.is_le(c, 70), (c - 55 : U32), (c - 87 : U32)))
392
393# A chunked body decoder that reads each byte once, so a body fed in pieces
394# costs O(bytes) in total. Tr{j}: j bytes of the closing CRLF CRLF matched.
395type Dc is Data:
396 DcSize{acc: U32, seen: Bool}
397 DcExt{n: U32}
398 DcSizeLf{n: U32}
399 DcData{k: U32}
400 DcDataCr{}
401 DcDataLf{}
402 DcTr{j: U32}
403 DcDone{}
404 DcBad{}
405
406# st: where the decoder is. racc: the body so far, reversed. rest: bytes after a Done body.
407type Dco is Data:
408 Dco{st: Dc, racc: String, rest: String}
409
410def dc.start() -> Dc:
411 DcSize{0, False{}}
412
413def dc.size.semi(+n: U32, semi: Bool) -> Dc:
414 match semi:
415 case True{}:
416 DcExt{n}
417 case False{}:
418 DcBad{}
419
420def dc.size.cr(+n: U32, +c: U32, cr: Bool) -> Dc:
421 match cr:
422 case True{}:
423 DcSizeLf{n}
424 case False{}:
425 dc.size.semi(n, U32.is_eq(c, 59))
426
427def dc.size.end(+n: U32, +c: U32, seen: Bool) -> Dc:
428 match seen:
429 case False{}:
430 DcBad{}
431 case True{}:
432 dc.size.cr(n, c, U32.is_eq(c, 13))
433
434# A size that would overflow 32 bits ends the digits, and size.end then refuses it.
435def dc.size(+acc: U32, seen: Bool, +c: U32, digit: Bool) -> Dc:
436 match digit:
437 case True{}:
438 DcSize{(acc * 16 + hexv(c) : U32), True{}}
439 case False{}:
440 dc.size.end(acc, c, seen)
441
442# RFC 9112 §7.1.1: recipients ignore unknown chunk extensions; a bare LF is not CRLF.
443def dc.ext.lf(+n: U32, lf: Bool) -> Dc:
444 match lf:
445 case True{}:
446 DcBad{}
447 case False{}:
448 DcExt{n}
449
450def dc.ext(+n: U32, +c: U32, cr: Bool) -> Dc:
451 match cr:
452 case True{}:
453 DcSizeLf{n}
454 case False{}:
455 dc.ext.lf(n, U32.is_eq(c, 10))
456
457def dc.sized(+n: U32, zero: Bool) -> Dc:
458 match zero:
459 case True{}:
460 DcTr{2}
461 case False{}:
462 DcData{n}
463
464def dc.size.lf(+n: U32, lf: Bool) -> Dc:
465 match lf:
466 case True{}:
467 dc.sized(n, U32.is_eq(n, 0))
468 case False{}:
469 DcBad{}
470
471# k data bytes are left and m of them were just read.
472def dc.data(+k: U32, +m: U32) -> Dc:
473 Bool.pick(Dc, U32.is_le(k, m), DcDataCr{}, DcData{(k - m : U32)})
474
475def dc.pick(ok: Bool, next: Dc) -> Dc:
476 match ok:
477 case True{}:
478 next
479 case False{}:
480 DcBad{}
481
482# ponytail: trailer fields are dropped unparsed (§7.1.2 allows discarding)
483def dc.tr.hit(+j: U32) -> Dc:
484 Bool.pick(Dc, U32.is_eq(j, 3), DcDone{}, DcTr{(j + 1 : U32)})
485
486def dc.tr(+j: U32, +c: U32, hit: Bool) -> Dc:
487 match hit:
488 case True{}:
489 dc.tr.hit(j)
490 case False{}:
491 Bool.pick(Dc, U32.is_eq(c, 13), DcTr{1}, DcTr{0})
492
493def dc.tr.want(+j: U32) -> U32:
494 Bool.pick(U32, U32.is_eq(U32.mod(j, 2), 0), 13, 10)
495
496def dc.byte(h: Char) -> U32:
497 Chr{c} = h
498 c
499
500# One byte c. Done and Bad never look at it, and a data byte is not inspected.
501def dc.step(st: Dc, +c: U32) -> Dc:
502 match st:
503 case DcBad{}:
504 DcBad{}
505 case DcSize{+acc, seen}:
506 dc.size(acc, seen, c, Bool.and(is_hex(c), U32.is_le(acc, 268435455)))
507 case DcExt{+n}:
508 dc.ext(n, c, U32.is_eq(c, 13))
509 case DcSizeLf{+n}:
510 dc.size.lf(n, U32.is_eq(c, 10))
511 case DcDataCr{}:
512 dc.pick(U32.is_eq(c, 13), DcDataLf{})
513 case DcDataLf{}:
514 dc.pick(U32.is_eq(c, 10), dc.start())
515 case DcTr{+j}:
516 dc.tr(j, c, U32.is_eq(c, dc.tr.want(j)))
517 case DcData{+k}:
518 dc.data(k, 1)
519 case DcDone{}:
520 DcDone{}
521
522def dc.live(st: Dc) -> Bool:
523 match st:
524 case DcDone{}:
525 False{}
526 case DcBad{}:
527 False{}
528 case DcSize{a, b}:
529 True{}
530 case DcExt{n}:
531 True{}
532 case DcSizeLf{n}:
533 True{}
534 case DcData{k}:
535 True{}
536 case DcDataCr{}:
537 True{}
538 case DcDataLf{}:
539 True{}
540 case DcTr{j}:
541 True{}
542
543def dc.feed(s: String, st: Dc, racc: String) -> Dco:
544 match s:
545 case SNil{}:
546 Dco{st, racc, ""}
547 case SCon{h, t}:
548 match st:
549 case DcBad{}:
550 Dco{DcBad{}, racc, ""}
551 case DcDone{}:
552 Dco{DcDone{}, racc, SCon{h, t}}
553 case DcData{+k}:
554 dc.feed(t, dc.data(k, 1), SCon{h, racc})
555 case DcSize{+acc, seen}:
556 dc.feed(t, dc.step(DcSize{acc, seen}, dc.byte(h)), racc)
557 case DcExt{+n}:
558 dc.feed(t, dc.step(DcExt{n}, dc.byte(h)), racc)
559 case DcSizeLf{+n}:
560 dc.feed(t, dc.step(DcSizeLf{n}, dc.byte(h)), racc)
561 case DcDataCr{}:
562 dc.feed(t, dc.step(DcDataCr{}, dc.byte(h)), racc)
563 case DcDataLf{}:
564 dc.feed(t, dc.step(DcDataLf{}, dc.byte(h)), racc)
565 case DcTr{+j}:
566 dc.feed(t, dc.step(DcTr{j}, dc.byte(h)), racc)
567
568def chunk.hold(o: Dco) -> Hold:
569 Dco{st, racc, rest} = o
570 match st:
571 case DcDone{}:
572 HoldBody{String.reverse(racc)}
573 case DcBad{}:
574 HoldBad{}
575 case DcSize{a, b}:
576 HoldMore{}
577 case DcExt{n}:
578 HoldMore{}
579 case DcSizeLf{n}:
580 HoldMore{}
581 case DcData{k}:
582 HoldMore{}
583 case DcDataCr{}:
584 HoldMore{}
585 case DcDataLf{}:
586 HoldMore{}
587 case DcTr{j}:
588 HoldMore{}
589
590def chunk.live(s: String) -> Hold:
591 chunk.hold(dc.feed(s, dc.start(), ""))
592
593def chunk.rest(o: Dco) -> Maybe<&2, String>:
594 Dco{st, racc, rest} = o
595 match st:
596 case DcDone{}:
597 Some{rest}
598 case DcBad{}:
599 None{}
600 case DcSize{a, b}:
601 None{}
602 case DcExt{n}:
603 None{}
604 case DcSizeLf{n}:
605 None{}
606 case DcData{k}:
607 None{}
608 case DcDataCr{}:
609 None{}
610 case DcDataLf{}:
611 None{}
612 case DcTr{j}:
613 None{}
614
615def chunk.suffix(s: String) -> Maybe<&2, String>:
616 chunk.rest(dc.feed(s, dc.start(), ""))
617
618def chunk.decode.hold(h: Hold) -> Maybe<&2, String>:
619 match h:
620 case HoldMore{}:
621 None{}
622 case HoldBad{}:
623 None{}
624 case HoldUntil{b}:
625 None{}
626 case HoldBody{b}:
627 Some{b}
628
629def chunk.decode(s: String) -> Maybe<&2, String>:
630 chunk.decode.hold(chunk.live(s))
631
632def bytes.snd(r: Bytes.Bytes & Bytes.Bytes) -> Bytes.Bytes:
633 (a, b) = r
634 b
635
636def found.at(+from: U32, m: Maybe<&2, U32>) -> Maybe<&2, U32>:
637 match m:
638 case None{}:
639 None{}
640 case Some{+j}:
641 Some{(from + j : U32)}
642
643# A chunked body decoded from piece[i..]: a data run is sliced whole, and every other byte steps dc.
644type Cs is Type:
645 Cs{piece: Bytes.Bytes, i: U32, st: Dc, parts: List<&1, Bytes.Bytes>}
646
647# st: where the decoder stopped. parts: the data so far, newest first. rest: the bytes after a Done body.
648type Ck is Type:
649 Ck{st: Dc, parts: List<&1, Bytes.Bytes>, rest: Bytes.Bytes}
650
651def ck.next(+len: U32, +i: U32, +st: Dc, piece: Bytes.Bytes, parts: List<&1, Bytes.Bytes>) -> Bool & Cs:
652 (Bool.and(U32.is_lt(i, len), dc.live(st)), Cs{piece, i, st, parts})
653
654def ck.data(+len: U32, +i: U32, +k: U32, +m: U32, parts: List<&1, Bytes.Bytes>, r: Bytes.Bytes & Bytes.Bytes) -> Bool & Cs:
655 (piece, run) = r
656 ck.next(len, (i + m : U32), dc.data(k, m), piece, Con{run, parts})
657
658def ck.byte(+len: U32, +i: U32, st: Dc, parts: List<&1, Bytes.Bytes>, r: Bytes.Bytes & Maybe<&2, U32>) -> Bool & Cs:
659 (piece, m) = r
660 match m:
661 case None{}:
662 ck.next(len, i, DcBad{}, piece, parts)
663 case Some{+c}:
664 ck.next(len, (i + 1 : U32), dc.step(st, c), piece, parts)
665
666def ck.step(+len: U32, cs: Cs) -> Bool & Cs:
667 Cs{piece, +i, st, parts} = cs
668 match st:
669 case DcData{+k}:
670 +m = U32.min(k, (len - i : U32))
671 ck.data(len, i, k, m, parts, Bytes.slice(piece, i, m))
672 case DcDone{}:
673 (False{}, Cs{piece, i, DcDone{}, parts})
674 case DcBad{}:
675 (False{}, Cs{piece, i, DcBad{}, parts})
676 case DcSize{+acc, seen}:
677 ck.byte(len, i, DcSize{acc, seen}, parts, Bytes.get(piece, i))
678 case DcExt{+n}:
679 ck.byte(len, i, DcExt{n}, parts, Bytes.get(piece, i))
680 case DcSizeLf{+n}:
681 ck.byte(len, i, DcSizeLf{n}, parts, Bytes.get(piece, i))
682 case DcDataCr{}:
683 ck.byte(len, i, DcDataCr{}, parts, Bytes.get(piece, i))
684 case DcDataLf{}:
685 ck.byte(len, i, DcDataLf{}, parts, Bytes.get(piece, i))
686 case DcTr{+j}:
687 ck.byte(len, i, DcTr{j}, parts, Bytes.get(piece, i))
688
689def ck.rest(st: Dc, parts: List<&1, Bytes.Bytes>, r: Bytes.Bytes & Bytes.Bytes) -> Ck:
690 (piece, rest) = r
691 Ck{st, parts, rest}
692
693def ck.end(+len: U32, cs: Cs) -> Ck:
694 Cs{piece, +i, st, parts} = cs
695 ck.rest(st, parts, Bytes.slice(piece, i, (len - i : U32)))
696
697# Each step reads at least one byte, so len steps are enough.
698def ck.feed(f: Nat, +len: U32, r: Bool & Cs) -> Ck:
699 match f:
700 case 0n:
701 (go, cs) = r
702 ck.end(len, cs)
703 case 1n+p:
704 (go, cs) = r
705 match go:
706 case False{}:
707 ck.end(len, cs)
708 case True{}:
709 ck.feed(p, len, ck.step(len, cs))
710
711def ck(piece: Bytes.Bytes, +st: Dc, parts: List<&1, Bytes.Bytes>) -> Ck:
712 Bytes.Bytes{+len, buf} = piece
713 ck.feed(U32.to_nat(len), len, ck.next(len, 0, st, Bytes.Bytes{len, buf}, parts))
714
715def parse.res.cl.have(+rest: String, +k: Nat, short: Bool) -> Hold:
716 match short:
717 case True{}:
718 HoldMore{}
719 case False{}:
720 HoldBody{String.take(rest, k)}
721
722def parse.res.cl.k(+rest: String, +k: Nat) -> Hold:
723 parse.res.cl.have(rest, k, Nat.is_lt(String.length(rest), k))
724
725def parse.res.cl.n(rest: String, n: Maybe<&2, U32>) -> Hold:
726 match n:
727 case None{}:
728 HoldBad{}
729 case Some{k}:
730 parse.res.cl.k(rest, U32.to_nat(k))
731
732def parse.body.cl(+h: Map<&2, List<&2, String>>, rest: String, hascl: Bool) -> Hold:
733 match hascl:
734 case False{}:
735 HoldBody{""}
736 case True{}:
737 parse.res.cl.n(rest, parse_u32(header(h, "content-length")))
738
739# RFC 9112 §6.3 (4): a request coding other than chunked cannot be framed.
740def parse.body.chunked.eq(rest: String, ok: Bool) -> Hold:
741 match ok:
742 case False{}:
743 HoldBad{}
744 case True{}:
745 chunk.live(rest)
746
747def parse.body.chunked.val(te: String, rest: String) -> Hold:
748 parse.body.chunked.eq(rest, String.eq(String.to_lower(te), "chunked"))
749
750def parse.body.chunked(+h: Map<&2, List<&2, String>>, rest: String, hascl: Bool) -> Hold:
751 match hascl:
752 case True{}:
753 HoldBad{}
754 case False{}:
755 parse.body.chunked.val(header.last(h, "transfer-encoding"), rest)
756
757def parse.body.te(+h: Map<&2, List<&2, String>>, rest: String, te: Bool) -> Hold:
758 match te:
759 case True{}:
760 parse.body.chunked(h, rest, has_header(h, "content-length"))
761 case False{}:
762 parse.body.cl(h, rest, has_header(h, "content-length"))
763
764def parse.body(+h: Map<&2, List<&2, String>>, rest: String) -> Hold:
765 parse.body.te(h, rest, has_header(h, "transfer-encoding"))
766
767# Bad: never a request. More: the head is not whole; read on. Head: the head is whole
768# and valid, and the body is still coming (req.body is empty). Req: a whole request.
769type Got is Type:
770 GotBad{}
771 GotMore{}
772 GotHead{req: Req}
773 GotReq{req: Req}
774
775def parse.finish(method: String, path: String, h: Map<&2, List<&2, String>>, body: Hold) -> Got:
776 match body:
777 case HoldBad{}:
778 GotBad{}
779 case HoldMore{}:
780 GotHead{Req{method, path, h, Bytes.new(0)}}
781 case HoldUntil{b}:
782 GotBad{}
783 case HoldBody{b}:
784 GotReq{Req{method, path, h, Bytes.from_string(b)}}
785
786def parse.host(method: String, path: String, +h: Map<&2, List<&2, String>>, rest: String, has: Bool) -> Got:
787 match has:
788 case False{}:
789 GotBad{}
790 case True{}:
791 parse.finish(method, path, h, parse.body(h, rest))
792
793# RFC 9112 §3.2: only HTTP/1.1 requires Host.
794def parse.fields(method: String, path: String, rest: String, v11: Bool, fs: Maybe<&2, Map<&2, List<&2, String>>>) -> Got:
795 match fs:
796 case None{}:
797 GotBad{}
798 case Some{+h}:
799 parse.host(method, path, h, rest, Bool.or(Bool.not(v11), has_header(h, "host")))
800
801def target_ok(+p: String) -> Bool:
802 Bool.or(String.starts_with(p, "/"), Bool.or(String.eq(p, "*"), String.starts_with(p, "http://")))
803
804def parse.target(method: String, +path: String, headers: List<&2, String>, rest: String, v11: Bool, ok: Bool) -> Got:
805 match ok:
806 case False{}:
807 GotBad{}
808 case True{}:
809 parse.fields(method, path, rest, v11, parse.headers(headers, FieldsOk{empty()}))
810
811def parse.ver(method: String, +path: String, +v: String, headers: List<&2, String>, rest: String, ok: Bool) -> Got:
812 match ok:
813 case False{}:
814 GotBad{}
815 case True{}:
816 parse.target(method, path, headers, rest, String.eq(v, "HTTP/1.1"), target_ok(path))
817
818def parse.empty_method(method: String, path: String, +v: String, headers: List<&2, String>, rest: String, empty: Bool) -> Got:
819 match empty:
820 case True{}:
821 GotBad{}
822 case False{}:
823 parse.ver(method, path, v, headers, rest, Bool.or(String.eq(v, "HTTP/1.1"), String.eq(v, "HTTP/1.0")))
824
825def parse.start3(mpv: String & String & String, headers: List<&2, String>, rest: String) -> Got:
826 (+method, path, v) = mpv
827 parse.empty_method(method, path, v, headers, rest, String.is_empty(method))
828
829def parse.lines(xs: List<&2, String>, rest: String) -> Got:
830 match xs:
831 case Nil{}:
832 GotBad{}
833 case Con{line, headers}:
834 parse.start3(start_line(line), headers, rest)
835
836
837def parse.head(+head: String, rest: String, whole: Bool) -> Got:
838 match whole:
839 case False{}:
840 GotMore{}
841 case True{}:
842 parse.lines(String.lines(head), rest)
843
844def parse.of(hb: String & String & Bool) -> Got:
845 (head, rest, whole) = hb
846 parse.head(head, rest, whole)
847
848# serve reads until this is not GotMore.
849def parse.got(+raw: String) -> Got:
850 parse.of(split_at_blank.flag.go(raw, raw, 0n, 0, False{}))
851
852
853def parse.req(g: Got) -> Maybe<&1, Req>:
854 match g:
855 case GotReq{req}:
856 Some{req}
857 case GotBad{}:
858 None{}
859 case GotMore{}:
860 None{}
861 case GotHead{req}:
862 None{}
863
864def parse(raw: String) -> Maybe<&1, Req>:
865 parse.req(parse.got(raw))
866
867def parse.res.cl(+h: Map<&2, List<&2, String>>, rest: String, hascl: Bool) -> Hold:
868 match hascl:
869 case False{}:
870 HoldBody{rest}
871 case True{}:
872 parse.res.cl.n(rest, parse_u32(header(h, "content-length")))
873
874def parse.res.chunked.eq(rest: String, ok: Bool) -> Hold:
875 match ok:
876 case False{}:
877 HoldUntil{rest}
878 case True{}:
879 chunk.live(rest)
880
881def parse.res.chunked.val(te: String, rest: String) -> Hold:
882 parse.res.chunked.eq(rest, String.eq(String.to_lower(te), "chunked"))
883
884def parse.res.chunked(+h: Map<&2, List<&2, String>>, rest: String, hascl: Bool) -> Hold:
885 match hascl:
886 case True{}:
887 HoldBad{}
888 case False{}:
889 parse.res.chunked.val(header.last(h, "transfer-encoding"), rest)
890
891def parse.res.te(+h: Map<&2, List<&2, String>>, rest: String, te: Bool) -> Hold:
892 match te:
893 case True{}:
894 parse.res.chunked(h, rest, has_header(h, "content-length"))
895 case False{}:
896 parse.res.cl(h, rest, has_header(h, "content-length"))
897
898def parse.res.body(+h: Map<&2, List<&2, String>>, rest: String) -> Hold:
899 parse.res.te(h, rest, has_header(h, "transfer-encoding"))
900
901# Bad: never a message. More: a valid prefix; read on. Done: a whole response.
902type Frame is Type:
903 FrameBad{}
904 FrameMore{}
905 FrameDone{res: Res}
906
907# RFC 9112 §8: a message cut short by close is incomplete, not valid.
908def frame.cut(closed: Bool) -> Frame:
909 match closed:
910 case True{}:
911 FrameBad{}
912 case False{}:
913 FrameMore{}
914
915def frame.wait(res: Res, wait: Bool) -> Frame:
916 match wait:
917 case True{}:
918 FrameMore{}
919 case False{}:
920 FrameDone{res}
921
922def frame.done(status: U32, h: Map<&2, List<&2, String>>, body: Hold, +closed: Bool, open: Bool) -> Frame:
923 match body:
924 case HoldBad{}:
925 FrameBad{}
926 case HoldMore{}:
927 frame.cut(closed)
928 case HoldUntil{b}:
929 frame.wait(Res{status, h, Bytes.from_string(b)}, Bool.not(closed))
930 case HoldBody{b}:
931 frame.wait(Res{status, h, Bytes.from_string(b)}, Bool.and(open, Bool.not(closed)))
932
933# RFC 9112 §6.3 (8): no TE and no CL ⇒ the body runs until the server closes.
934def frame.open(+h: Map<&2, List<&2, String>>) -> Bool:
935 Bool.not(Bool.or(has_header(h, "transfer-encoding"), has_header(h, "content-length")))
936
937# RFC 9112 §6.3 (1): HEAD, 1xx, 204 and 304 responses end at the blank line.
938def frame.nobody(+status: U32, head: Bool) -> Bool:
939 Bool.or(head, Bool.or(U32.is_lt(status, 200), Bool.or(U32.is_eq(status, 204), U32.is_eq(status, 304))))
940
941# 101 is the final response. Other 1xx are interim; a final response follows.
942def frame.interim(+status: U32) -> Bool:
943 Bool.and(U32.is_lt(status, 200), Bool.not(U32.is_eq(status, 101)))
944
945def frame.status(status: U32, +h: Map<&2, List<&2, String>>, rest: String, closed: Bool, nobody: Bool) -> Frame:
946 match nobody:
947 case True{}:
948 FrameDone{Res{status, h, Bytes.new(0)}}
949 case False{}:
950 frame.done(status, h, parse.res.body(h, rest), closed, frame.open(h))
951
952def parse.res.fields(+status: U32, rest: String, fs: Maybe<&2, Map<&2, List<&2, String>>>, closed: Bool, head: Bool) -> Frame:
953 match fs:
954 case None{}:
955 FrameBad{}
956 case Some{h}:
957 frame.status(status, h, rest, closed, frame.nobody(status, head))
958
959def parse.res.num(code: Maybe<&2, U32>, headers: List<&2, String>, rest: String, closed: Bool, head: Bool) -> Frame:
960 match code:
961 case None{}:
962 FrameBad{}
963 case Some{n}:
964 parse.res.fields(n, rest, parse.headers(headers, FieldsOk{empty()}), closed, head)
965
966def parse.res.ver(code: String, headers: List<&2, String>, rest: String, closed: Bool, head: Bool, ok: Bool) -> Frame:
967 match ok:
968 case False{}:
969 FrameBad{}
970 case True{}:
971 parse.res.num(parse_u32(code), headers, rest, closed, head)
972
973def parse.res.start3(mpv: String & String & String, headers: List<&2, String>, rest: String, closed: Bool, head: Bool) -> Frame:
974 (+ver, code, reason) = mpv
975 parse.res.ver(code, headers, rest, closed, head, Bool.or(String.eq(ver, "HTTP/1.1"), String.eq(ver, "HTTP/1.0")))
976
977def parse.res.lines(xs: List<&2, String>, rest: String, closed: Bool, head: Bool) -> Frame:
978 match xs:
979 case Nil{}:
980 FrameBad{}
981 case Con{line, headers}:
982 parse.res.start3(start_line(line), headers, rest, closed, head)
983
984def parse.res.blank(hd: String, rest: String, +closed: Bool, head: Bool, ok: Bool) -> Frame:
985 match ok:
986 case False{}:
987 frame.cut(closed)
988 case True{}:
989 parse.res.lines(String.lines(hd), rest, closed, head)
990
991def parse.res.of(hb: String & String, closed: Bool, head: Bool) -> Frame:
992 (+hd, rest) = hb
993 parse.res.blank(hd, rest, closed, head, blank_end(hd))
994
995type Lead is Data:
996 LeadCut{}
997 LeadFinal{}
998 LeadSkip{+rest: String}
999
1000def frame.lead.if(rest: String, interim: Bool) -> Lead:
1001 match interim:
1002 case True{}:
1003 LeadSkip{rest}
1004 case False{}:
1005 LeadFinal{}
1006
1007def frame.lead.num(n: Maybe<&2, U32>, rest: String) -> Lead:
1008 match n:
1009 case None{}:
1010 LeadFinal{}
1011 case Some{s}:
1012 frame.lead.if(rest, frame.interim(s))
1013
1014def frame.lead.code(mpv: String & String & String, rest: String) -> Lead:
1015 (ver, code, reason) = mpv
1016 frame.lead.num(parse_u32(code), rest)
1017
1018def frame.lead.lines(xs: List<&2, String>, rest: String) -> Lead:
1019 match xs:
1020 case Nil{}:
1021 LeadFinal{}
1022 case Con{line, headers}:
1023 frame.lead.code(start_line(line), rest)
1024
1025def frame.lead.blank(+hd: String, rest: String, ok: Bool) -> Lead:
1026 match ok:
1027 case False{}:
1028 LeadCut{}
1029 case True{}:
1030 frame.lead.lines(String.lines(hd), rest)
1031
1032def frame.lead(hb: String & String) -> Lead:
1033 (+hd, rest) = hb
1034 frame.lead.blank(hd, rest, blank_end(hd))
1035
1036def frame.at.cont(+raw: String, lead: Lead) -> String:
1037 match lead:
1038 case LeadCut{}:
1039 raw
1040 case LeadFinal{}:
1041 raw
1042 case LeadSkip{rest}:
1043 rest
1044
1045def frame.at.zero.go(+raw: String, closed: Bool, head: Bool, lead: Lead) -> Frame:
1046 match lead:
1047 case LeadCut{}:
1048 frame.cut(closed)
1049 case LeadFinal{}:
1050 parse.res.of(split_at_blank(raw), closed, head)
1051 case LeadSkip{rest}:
1052 FrameBad{}
1053
1054def frame.at.zero.of(+raw: String, closed: Bool, head: Bool) -> Frame:
1055 frame.at.zero.go(raw, closed, head, frame.lead(split_at_blank(raw)))
1056
1057def frame.at.pos.do(f: Nat, +raw: String, closed: Bool, head: Bool, hb: String & String, lead: Lead) -> Frame:
1058 match f:
1059 case 0n:
1060 match lead:
1061 case LeadCut{}:
1062 frame.cut(closed)
1063 case LeadFinal{}:
1064 parse.res.of(hb, closed, head)
1065 case LeadSkip{+rest}:
1066 frame.at.zero.of(rest, closed, head)
1067 case 1n+g:
1068 match lead:
1069 case LeadCut{}:
1070 frame.cut(closed)
1071 case LeadFinal{}:
1072 parse.res.of(hb, closed, head)
1073 case LeadSkip{+rest}:
1074 frame.at.pos.do(g, rest, closed, head, split_at_blank(rest), frame.lead(split_at_blank(rest)))
1075
1076def frame.at.zero(+raw: String, closed: Bool, head: Bool) -> Frame:
1077 frame.at.zero.of(raw, closed, head)
1078
1079# ponytail: 8 interim responses; raise the fuel if a server sends more
1080def frame.at(fuel: Nat, +raw: String, closed: Bool, head: Bool) -> Frame:
1081 match fuel:
1082 case 0n:
1083 frame.at.zero(raw, closed, head)
1084 case 1n+f:
1085 frame.at.pos.do(f, raw, closed, head, split_at_blank(raw), frame.lead(split_at_blank(raw)))
1086
1087# frame(bytes so far, server closed?, request was HEAD?)
1088def frame(raw: String, closed: Bool, head: Bool) -> Frame:
1089 frame.at(8n, raw, closed, head)
1090
1091def frame.res(f: Frame) -> Maybe<&1, Res>:
1092 match f:
1093 case FrameDone{res}:
1094 Some{res}
1095 case FrameBad{}:
1096 None{}
1097 case FrameMore{}:
1098 None{}
1099
1100def parse_res(raw: String) -> Maybe<&1, Res>:
1101 frame.res(frame(raw, True{}, False{}))
1102
1103def res_fields.res(res: Res, k: String) -> List<&2, String>:
1104 Res{status, headers, body} = res
1105 fields(headers, k)
1106
1107def res_fields(m: Maybe<&1, Res>, k: String) -> List<&2, String>:
1108 match m:
1109 case None{}:
1110 Nil{}
1111 case Some{res}:
1112 res_fields.res(res, k)
1113
1114# The response body as it arrives. Len: bytes left. Chunk: the decoder. Close: until the
1115# server closes. Done: the body is whole. Bad: it cannot become a body.
1116type Rb is Data:
1117 RbLen{left: U32}
1118 RbChunk{st: Dc}
1119 RbClose{}
1120 RbDone{}
1121 RbBad{}
1122
1123def rb.cl(n: Maybe<&2, U32>) -> Maybe<&2, Rb>:
1124 match n:
1125 case None{}:
1126 None{}
1127 case Some{+k}:
1128 Some{Bool.pick(Rb, U32.is_zero(k), RbDone{}, RbLen{k})}
1129
1130def rb.te(+h: Map<&2, List<&2, String>>, cl: Bool) -> Maybe<&2, Rb>:
1131 match cl:
1132 case True{}:
1133 None{}
1134 case False{}:
1135 Some{Bool.pick(Rb, String.eq(String.to_lower(header.last(h, "transfer-encoding")), "chunked"), RbChunk{dc.start()}, RbClose{})}
1136
1137def rb.len(+h: Map<&2, List<&2, String>>, te: Bool) -> Maybe<&2, Rb>:
1138 match te:
1139 case True{}:
1140 rb.te(h, has_header(h, "content-length"))
1141 case False{}:
1142 Bool.pick(Maybe<&2, Rb>, has_header(h, "content-length"), rb.cl(parse_u32(header(h, "content-length"))), Some{RbClose{}})
1143
1144# RFC 9112 §6.3: how the body of this response ends. None: it cannot be framed.
1145def rb.of(+h: Map<&2, List<&2, String>>, nobody: Bool) -> Maybe<&2, Rb>:
1146 match nobody:
1147 case True{}:
1148 Some{RbDone{}}
1149 case False{}:
1150 rb.len(h, has_header(h, "transfer-encoding"))
1151
1152# rb: how the body goes on. parts: body bytes so far, newest first. rest: bytes past a Done body.
1153type Bf is Type:
1154 Bf{rb: Rb, parts: List<&1, Bytes.Bytes>, rest: Bytes.Bytes}
1155
1156def rb.len.cut(parts: List<&1, Bytes.Bytes>, +len: U32, +left: U32, r: Bytes.Bytes & Bytes.Bytes) -> Bf:
1157 (piece, data) = r
1158 Bf{RbDone{}, Con{data, parts}, bytes.snd(Bytes.slice(piece, left, (len - left : U32)))}
1159
1160def rb.len.have(short: Bool, +left: U32, parts: List<&1, Bytes.Bytes>, +len: U32, piece: Bytes.Bytes) -> Bf:
1161 match short:
1162 case True{}:
1163 Bf{RbLen{(left - len : U32)}, Con{piece, parts}, Bytes.new(0)}
1164 case False{}:
1165 rb.len.cut(parts, len, left, Bytes.slice(piece, 0, left))
1166
1167def rb.chunk(c: Ck) -> Bf:
1168 Ck{st, parts, rest} = c
1169 match st:
1170 case DcDone{}:
1171 Bf{RbDone{}, parts, rest}
1172 case DcBad{}:
1173 Bf{RbBad{}, parts, rest}
1174 case DcSize{a, b}:
1175 Bf{RbChunk{DcSize{a, b}}, parts, rest}
1176 case DcExt{x}:
1177 Bf{RbChunk{DcExt{x}}, parts, rest}
1178 case DcSizeLf{x}:
1179 Bf{RbChunk{DcSizeLf{x}}, parts, rest}
1180 case DcData{k}:
1181 Bf{RbChunk{DcData{k}}, parts, rest}
1182 case DcDataCr{}:
1183 Bf{RbChunk{DcDataCr{}}, parts, rest}
1184 case DcDataLf{}:
1185 Bf{RbChunk{DcDataLf{}}, parts, rest}
1186 case DcTr{j}:
1187 Bf{RbChunk{DcTr{j}}, parts, rest}
1188
1189# The body bytes in piece, added to parts.
1190def rb.feed(rb: Rb, parts: List<&1, Bytes.Bytes>, piece: Bytes.Bytes) -> Bf:
1191 match rb:
1192 case RbLen{+left}:
1193 Bytes.Bytes{+len, buf} = piece
1194 rb.len.have(U32.is_lt(len, left), left, parts, len, Bytes.Bytes{len, buf})
1195 case RbChunk{st}:
1196 rb.chunk(ck(piece, st, parts))
1197 case RbClose{}:
1198 Bf{RbClose{}, Con{piece, parts}, Bytes.new(0)}
1199 case RbDone{}:
1200 Bf{RbDone{}, parts, piece}
1201 case RbBad{}:
1202 Bf{RbBad{}, parts, piece}
1203
1204# RFC 9112 §8: only a close-delimited body may end at close.
1205def rb.eof(rb: Rb) -> Bool:
1206 match rb:
1207 case RbClose{}:
1208 True{}
1209 case RbDone{}:
1210 True{}
1211 case RbLen{n}:
1212 False{}
1213 case RbChunk{st}:
1214 False{}
1215 case RbBad{}:
1216 False{}
1217
1218def rb.body(parts: List<&1, Bytes.Bytes>) -> Bytes.Bytes:
1219 Bytes.concat(List.reverse(&1, Bytes.Bytes, parts))
1220
1221# The head scan. Seek: look for the blank line from byte from; k interim heads are behind.
1222# Wait: no blank line yet. Res: the final head, how its body ends, and the bytes after it.
1223type Hs is Type:
1224 HsSeek{buf: Bytes.Bytes, from: U32, k: U32}
1225 HsWait{buf: Bytes.Bytes, k: U32}
1226 HsBad{}
1227 HsRes{res: Res, rb: Rb, rest: Bytes.Bytes}
1228
1229def hs.final(+status: U32, +h: Map<&2, List<&2, String>>, rest: Bytes.Bytes, m: Maybe<&2, Rb>) -> Hs:
1230 match m:
1231 case None{}:
1232 HsBad{}
1233 case Some{rb}:
1234 HsRes{Res{status, h, Bytes.new(0)}, rb, rest}
1235
1236def hs.skip(more: Bool, +k: U32, rest: Bytes.Bytes) -> Hs:
1237 match more:
1238 case True{}:
1239 HsSeek{rest, 0, (k + 1 : U32)}
1240 case False{}:
1241 HsBad{}
1242
1243def hs.pick(interim: Bool, +head: Bool, +k: U32, +status: U32, +h: Map<&2, List<&2, String>>, rest: Bytes.Bytes) -> Hs:
1244 match interim:
1245 case True{}:
1246 hs.skip(U32.is_lt(k, 8), k, rest)
1247 case False{}:
1248 hs.final(status, h, rest, rb.of(h, frame.nobody(status, head)))
1249
1250def hs.res(+head: Bool, +k: U32, rest: Bytes.Bytes, res: Res) -> Hs:
1251 Res{+status, +h, body} = res
1252 hs.pick(frame.interim(status), head, k, status, h, rest)
1253
1254# The head alone, framed as a HEAD response so it stops at the blank line.
1255def hs.parsed(+head: Bool, +k: U32, rest: Bytes.Bytes, f: Frame) -> Hs:
1256 match f:
1257 case FrameDone{res}:
1258 hs.res(head, k, rest, res)
1259 case FrameBad{}:
1260 HsBad{}
1261 case FrameMore{}:
1262 HsBad{}
1263
1264def hs.split(+head: Bool, +k: U32, +hlen: U32, +len: U32, r: Bytes.Bytes & Bytes.Bytes) -> Hs:
1265 (buf, hb) = r
1266 hs.parsed(head, k, bytes.snd(Bytes.slice(buf, hlen, (len - hlen : U32))), parse.res.of(split_at_blank(Bytes.to_string(hb)), False{}, True{}))
1267
1268def hs.hit(+head: Bool, +k: U32, +len: U32, buf: Bytes.Bytes, at: Maybe<&2, U32>) -> Hs:
1269 match at:
1270 case None{}:
1271 HsWait{buf, k}
1272 case Some{+i}:
1273 +hlen = (i + 4 : U32)
1274 hs.split(head, k, hlen, len, Bytes.slice(buf, 0, hlen))
1275
1276def hs.seek.of(+head: Bool, +k: U32, +len: U32, +from: U32, buf: Bytes.Bytes, r: Bytes.Bytes & Maybe<&2, U32>) -> Hs:
1277 (tail, m) = r
1278 hs.hit(head, k, len, buf, found.at(from, m))
1279
1280def hs.seek(+head: Bool, +k: U32, +len: U32, +from: U32, r: Bytes.Bytes & Bytes.Bytes) -> Hs:
1281 (buf, tail) = r
1282 hs.seek.of(head, k, len, from, buf, Bytes.find(tail, "\r\n\r\n"))
1283
1284def hs.step(+head: Bool, st: Hs) -> Hs:
1285 match st:
1286 case HsSeek{buf, +from, +k}:
1287 Bytes.Bytes{+len, b} = buf
1288 hs.seek(head, k, len, from, Bytes.slice(Bytes.Bytes{len, b}, from, (len - from : U32)))
1289 case HsWait{buf, k}:
1290 HsWait{buf, k}
1291 case HsBad{}:
1292 HsBad{}
1293 case HsRes{res, rb, rest}:
1294 HsRes{res, rb, rest}
1295
1296# Each step ends the scan or passes one interim head, and at most 8 interim heads pass.
1297def hs.scan(fuel: Nat, +head: Bool, st: Hs) -> Hs:
1298 match fuel:
1299 case 0n:
1300 match st:
1301 case HsSeek{buf, from, k}:
1302 HsBad{}
1303 case HsWait{buf, k}:
1304 HsWait{buf, k}
1305 case HsBad{}:
1306 HsBad{}
1307 case HsRes{res, rb, rest}:
1308 HsRes{res, rb, rest}
1309 case 1n+f:
1310 hs.scan(f, head, hs.step(head, st))
1311
1312# piece joins buf; only the new bytes, and the 3 before them, can finish the blank line.
1313def hs.more(+head: Bool, +k: U32, buf: Bytes.Bytes, piece: Bytes.Bytes) -> Hs:
1314 Bytes.Bytes{+ol, ob} = buf
1315 hs.scan(10n, head, HsSeek{Bytes.append(Bytes.Bytes{ol, ob}, piece), Bool.pick(U32, U32.is_lt(ol, 3), 0, (ol - 3 : U32)), k})
1316
1317# Untrusted servers must not grow the buffer without bound.
1318def fetch.max() -> Nat:
1319 U32.to_nat(16777216)
1320
1321# A response read in pieces. Head: the head is not whole yet. Body: it is, and parts is the body so far.
1322# Len: a Content-Length body in one buffer of that size, with left bytes still to come.
1323type Rv is Type:
1324 RvHead{buf: Bytes.Bytes, k: U32}
1325 RvBody{res: Res, rb: Rb, parts: List<&1, Bytes.Bytes>}
1326 RvLen{res: Res, left: U32, body: Bytes.Bytes}
1327
1328# More: read on. Done: the response, and the bytes after it when the body is self-delimited.
1329type Rt is Type:
1330 RtMore{rv: Rv}
1331 RtBad{}
1332 RtDone{res: Res, rest: Maybe<&1, Bytes.Bytes>}
1333
1334def rv.start() -> Rv:
1335 RvHead{Bytes.new(0), 0}
1336
1337def rv.whole(res: Res, b: Bytes.Bytes, rest: Maybe<&1, Bytes.Bytes>) -> Rt:
1338 Res{status, headers, body} = res
1339 RtDone{Res{status, headers, b}, rest}
1340
1341def rv.done(res: Res, parts: List<&1, Bytes.Bytes>, rest: Maybe<&1, Bytes.Bytes>) -> Rt:
1342 rv.whole(res, rb.body(parts), rest)
1343
1344def rl.put.of(+total: U32, +len: U32, r: Array<U32> & Array<U32>) -> Bytes.Bytes & Bytes.Bytes:
1345 (src, dst) = r
1346 (Bytes.Bytes{total, dst}, Bytes.Bytes{len, src})
1347
1348# The first m bytes of piece, written into body after the total - left bytes already there.
1349def rl.put(+m: U32, +left: U32, body: Bytes.Bytes, piece: Bytes.Bytes) -> Bytes.Bytes & Bytes.Bytes:
1350 Bytes.Bytes{+total, dst} = body
1351 Bytes.Bytes{+len, src} = piece
1352 rl.put.of(total, len, Bytes.copy(m, src, dst, 0, (total - left : U32)))
1353
1354def rl.fed(short: Bool, res: Res, +left: U32, +len: U32, r: Bytes.Bytes & Bytes.Bytes) -> Rt:
1355 match short:
1356 case True{}:
1357 (body, piece) = r
1358 RtMore{RvLen{res, (left - len : U32), body}}
1359 case False{}:
1360 (body, piece) = r
1361 rv.whole(res, body, Some{bytes.snd(Bytes.slice(piece, left, (len - left : U32)))})
1362
1363def rl.feed(res: Res, +left: U32, body: Bytes.Bytes, piece: Bytes.Bytes) -> Rt:
1364 Bytes.Bytes{+len, buf} = piece
1365 rl.fed(U32.is_lt(len, left), res, left, len, rl.put(U32.min(len, left), left, body, Bytes.Bytes{len, buf}))
1366
1367def rv.fed(res: Res, bf: Bf) -> Rt:
1368 Bf{rb, parts, rest} = bf
1369 match rb:
1370 case RbDone{}:
1371 rv.done(res, parts, Some{rest})
1372 case RbBad{}:
1373 RtBad{}
1374 case RbLen{n}:
1375 RtMore{RvBody{res, RbLen{n}, parts}}
1376 case RbChunk{st}:
1377 RtMore{RvBody{res, RbChunk{st}, parts}}
1378 case RbClose{}:
1379 RtMore{RvBody{res, RbClose{}, parts}}
1380
1381# Some{left}: a Content-Length body small enough to allocate up front. Larger ones fail at the fetch cap.
1382def rb.buf(rb: Rb) -> Maybe<&2, U32>:
1383 match rb:
1384 case RbLen{+left}:
1385 Bool.pick(Maybe<&2, U32>, Nat.is_lt(fetch.max(), U32.to_nat(left)), None{}, Some{left})
1386 case RbChunk{st}:
1387 None{}
1388 case RbClose{}:
1389 None{}
1390 case RbDone{}:
1391 None{}
1392 case RbBad{}:
1393 None{}
1394
1395def rv.body(m: Maybe<&2, U32>, res: Res, rb: Rb, rest: Bytes.Bytes) -> Rt:
1396 match m:
1397 case None{}:
1398 rv.fed(res, rb.feed(rb, Nil{}, rest))
1399 case Some{+left}:
1400 rl.feed(res, left, Bytes.new(left), rest)
1401
1402def rv.head(hs: Hs) -> Rt:
1403 match hs:
1404 case HsWait{buf, k}:
1405 RtMore{RvHead{buf, k}}
1406 case HsBad{}:
1407 RtBad{}
1408 case HsSeek{buf, from, k}:
1409 RtBad{}
1410 case HsRes{res, +rb, rest}:
1411 rv.body(rb.buf(rb), res, rb, rest)
1412
1413def rv.eof(res: Res, parts: List<&1, Bytes.Bytes>, ok: Bool) -> Rt:
1414 match ok:
1415 case True{}:
1416 rv.done(res, parts, None{})
1417 case False{}:
1418 RtBad{}
1419
1420# One read: piece, or the server closed (RFC 9112 §8: a message cut short is not a message).
1421def rv.step(closed: Bool, +head: Bool, rv: Rv, piece: Bytes.Bytes) -> Rt:
1422 match closed:
1423 case True{}:
1424 match rv:
1425 case RvHead{buf, k}:
1426 RtBad{}
1427 case RvBody{res, rb, parts}:
1428 rv.eof(res, parts, rb.eof(rb))
1429 case RvLen{res, left, body}:
1430 RtBad{}
1431 case False{}:
1432 match rv:
1433 case RvHead{buf, +k}:
1434 rv.head(hs.more(head, k, buf, piece))
1435 case RvBody{res, rb, parts}:
1436 rv.fed(res, rb.feed(rb, parts, piece))
1437 case RvLen{res, +left, body}:
1438 rl.feed(res, left, body, piece)
1439
1440def rv.end(closed: Bool, +head: Bool, t: Rt) -> Rt:
1441 match closed:
1442 case False{}:
1443 t
1444 case True{}:
1445 match t:
1446 case RtMore{rv}:
1447 rv.step(True{}, head, rv, Bytes.new(0))
1448 case RtBad{}:
1449 RtBad{}
1450 case RtDone{res, rest}:
1451 RtDone{res, rest}
1452
1453def rv.go(xs: List<&2, String>, closed: Bool, +head: Bool, t: Rt) -> Rt:
1454 match xs:
1455 case Nil{}:
1456 rv.end(closed, head, t)
1457 case Con{+x, rest}:
1458 match t:
1459 case RtMore{rv}:
1460 rv.go(rest, closed, head, rv.step(False{}, head, rv, Bytes.from_string(x)))
1461 case RtBad{}:
1462 RtBad{}
1463 case RtDone{res, r}:
1464 RtDone{res, r}
1465
1466def rt.frame(t: Rt) -> Frame:
1467 match t:
1468 case RtMore{rv}:
1469 FrameMore{}
1470 case RtBad{}:
1471 FrameBad{}
1472 case RtDone{res, rest}:
1473 FrameDone{res}
1474
1475# What the read loop makes of these pieces, then a close when closed is set.
1476def res.frame(xs: List<&2, String>, closed: Bool, +head: Bool) -> Frame:
1477 rt.frame(rv.go(xs, closed, head, RtMore{rv.start()}))
1478
1479def rt.rest(t: Rt) -> Maybe<&1, Bytes.Bytes>:
1480 match t:
1481 case RtMore{rv}:
1482 None{}
1483 case RtBad{}:
1484 None{}
1485 case RtDone{res, rest}:
1486 rest
1487
1488def after.of(m: Maybe<&1, Bytes.Bytes>) -> Maybe<&2, String>:
1489 match m:
1490 case None{}:
1491 None{}
1492 case Some{b}:
1493 Some{Bytes.to_string(b)}
1494
1495# Bytes after a complete self-delimited message. None if it is not one yet.
1496def after(+raw: String, +head: Bool) -> Maybe<&2, String>:
1497 after.of(rt.rest(rv.go([raw], False{}, head, RtMore{rv.start()})))
1498
1499def req.v11.ver(mpv: String & String & String) -> Bool:
1500 (+method, path, v) = mpv
1501 String.eq(v, "HTTP/1.1")
1502
1503def req.v11.line(+line: String) -> Bool:
1504 req.v11.ver(start_line(line))
1505
1506def req.v11.lines(xs: List<&2, String>) -> Bool:
1507 match xs:
1508 case Nil{}:
1509 False{}
1510 case Con{line, headers}:
1511 req.v11.line(line)
1512
1513def req.v11.pick(+head: String, ok: Bool) -> Bool:
1514 match ok:
1515 case False{}:
1516 False{}
1517 case True{}:
1518 req.v11.lines(String.lines(head))
1519
1520def req.v11.of(hb: String & String) -> Bool:
1521 (+head, rest) = hb
1522 req.v11.pick(head, blank_end(head))
1523
1524def req.v11(+raw: String) -> Bool:
1525 req.v11.of(split_at_blank(raw))
1526
1527def req.conn_close(+headers: Map<&2, List<&2, String>>) -> Bool:
1528 String.eq(String.to_lower(header(headers, "connection")), "close")
1529
1530def res.conn_close(+headers: Map<&2, List<&2, String>>) -> Bool:
1531 String.eq(String.to_lower(header(headers, "connection")), "close")
1532
1533def serve.fail_close(+status: U32) -> Bool:
1534 Bool.or(U32.is_eq(status, 400), Bool.or(U32.is_eq(status, 413), U32.is_eq(status, 431)))
1535
1536def serve.keep.ok(fail: Bool, res_close: Bool) -> Bool:
1537 match fail:
1538 case True{}:
1539 False{}
1540 case False{}:
1541 Bool.not(res_close)
1542
1543def serve.keep.v11(v11: Bool, +req_close: Bool, +status: U32, res_close: Bool) -> Bool:
1544 match v11:
1545 case False{}:
1546 False{}
1547 case True{}:
1548 match req_close:
1549 case True{}:
1550 False{}
1551 case False{}:
1552 serve.keep.ok(serve.fail_close(status), res_close)
1553
1554def serve.keep(+headers: Map<&2, List<&2, String>>, v11: Bool, +status: U32, +res: Map<&2, List<&2, String>>) -> Bool:
1555 serve.keep.v11(v11, req.conn_close(headers), status, res.conn_close(res))
1556
1557
1558def again.keep(close: Bool, x: Bytes.Bytes) -> Maybe<&1, Bytes.Bytes>:
1559 match close:
1560 case True{}:
1561 None{}
1562 case False{}:
1563 Some{x}
1564
1565def again.rest(close: Bool, rest: Maybe<&1, Bytes.Bytes>) -> Maybe<&1, Bytes.Bytes>:
1566 match rest:
1567 case None{}:
1568 None{}
1569 case Some{x}:
1570 again.keep(close, x)
1571
1572# The bytes past the response when the socket can take another request: the request did not
1573# ask to close, the response is self-delimited, and the peer did not say close.
1574def again(close: Bool, +h: Map<&2, List<&2, String>>, rest: Maybe<&1, Bytes.Bytes>) -> Maybe<&1, Bytes.Bytes>:
1575 match close:
1576 case True{}:
1577 None{}
1578 case False{}:
1579 again.rest(String.eq(String.to_lower(header(h, "connection")), "close"), rest)
1580
1581def res_body.res(res: Res) -> Bytes.Bytes:
1582 Res{status, headers, body} = res
1583 body
1584
1585def res_body(m: Maybe<&1, Res>) -> Bytes.Bytes:
1586 match m:
1587 case None{}:
1588 Bytes.new(0)
1589 case Some{res}:
1590 res_body.res(res)
1591
1592def text(res: Res) -> String:
1593 Enc.utf8.decode(res_body.res(res))
1594
1595# UTF-8 is checked, not repaired: bad UTF-8 in a string gives None (RFC 8259 §8.1).
1596def json(res: Res) -> Maybe<&1, Json.Val>:
1597 Json.parse.bytes(res_body.res(res))
1598
1599def got_body.req(req: Req) -> Bytes.Bytes:
1600 Req{method, path, headers, body} = req
1601 body
1602
1603def got_body(m: Maybe<&1, Req>) -> Bytes.Bytes:
1604 match m:
1605 case None{}:
1606 Bytes.new(0)
1607 case Some{req}:
1608 got_body.req(req)
1609
1610def body.of(hb: String & String) -> String:
1611 (h, b) = hb
1612 b
1613
1614def body(s: String) -> String:
1615 body.of(split_at_blank.go(s, False{}, 0, SNil{}))
1616
1617def headers_lines(+k: String, vs: List<&2, String>, acc: String) -> String:
1618 match vs:
1619 case Nil{}:
1620 acc
1621 case Con{v, t}:
1622 headers_lines(k, t, acc ++ ("\r\n" ++ sanitize(k) ++ ": " ++ sanitize(v)))
1623
1624def headers_block.go(xs: List<&2, Sigma<&2, &2, String, _ => List<&2, String>>>, acc: String) -> String:
1625 match xs:
1626 case Nil{}:
1627 acc
1628 case (k, vs) <> t:
1629 headers_block.go(t, headers_lines(k, vs, acc))
1630
1631def headers_block(h: Map<&2, List<&2, String>>) -> String:
1632 headers_block.go(Map.to_list(&2, List<&2, String>, h), "")
1633
1634# RFC 9110 §15. An unknown code gets an empty reason, which RFC 9112 §4 allows.
1635type Reason is Data:
1636 Reason{code: U32, text: String}
1637
1638def reasons() -> List<&2, Reason>:
1639 [Reason{100, "Continue"}, Reason{101, "Switching Protocols"}, Reason{103, "Early Hints"},
1640 Reason{200, "OK"}, Reason{201, "Created"}, Reason{202, "Accepted"}, Reason{203, "Non-Authoritative Information"}, Reason{204, "No Content"}, Reason{205, "Reset Content"}, Reason{206, "Partial Content"},
1641 Reason{300, "Multiple Choices"}, Reason{301, "Moved Permanently"}, Reason{302, "Found"}, Reason{303, "See Other"}, Reason{304, "Not Modified"}, Reason{307, "Temporary Redirect"}, Reason{308, "Permanent Redirect"},
1642 Reason{400, "Bad Request"}, Reason{401, "Unauthorized"}, Reason{402, "Payment Required"}, Reason{403, "Forbidden"}, Reason{404, "Not Found"}, Reason{405, "Method Not Allowed"}, Reason{406, "Not Acceptable"}, Reason{407, "Proxy Authentication Required"}, Reason{408, "Request Timeout"}, Reason{409, "Conflict"}, Reason{410, "Gone"}, Reason{411, "Length Required"}, Reason{412, "Precondition Failed"}, Reason{413, "Content Too Large"}, Reason{414, "URI Too Long"}, Reason{415, "Unsupported Media Type"}, Reason{416, "Range Not Satisfiable"}, Reason{417, "Expectation Failed"}, Reason{421, "Misdirected Request"}, Reason{422, "Unprocessable Content"}, Reason{426, "Upgrade Required"}, Reason{428, "Precondition Required"}, Reason{429, "Too Many Requests"}, Reason{431, "Request Header Fields Too Large"},
1643 Reason{500, "Internal Server Error"}, Reason{501, "Not Implemented"}, Reason{502, "Bad Gateway"}, Reason{503, "Service Unavailable"}, Reason{504, "Gateway Timeout"}, Reason{505, "HTTP Version Not Supported"}]
1644
1645def reason.go(xs: List<&2, Reason>, +status: U32) -> String:
1646 match xs:
1647 case Nil{}:
1648 ""
1649 case Con{Reason{k, v}, t}:
1650 Bool.pick(String, U32.is_eq(k, status), v, reason.go(t, status))
1651
1652def reason(+status: U32) -> String:
1653 reason.go(reasons(), status)
1654
1655def response(+status: U32, headers: Map<&2, List<&2, String>>, body: String) -> String:
1656 ("HTTP/1.1 " ++ U32.show(status) ++ " " ++ reason(status) ++ headers_block(headers)) ++ ("\r\n\r\n" ++ body)
1657
1658def encode.body(head: Bool, top: Bytes.Bytes, body: Bytes.Bytes) -> Bytes.Bytes:
1659 match head:
1660 case True{}:
1661 top
1662 case False{}:
1663 Bytes.append(top, body)
1664
1665def encode.len(+status: U32, headers: Map<&2, List<&2, String>>, head: Bool, body: Bytes.Bytes) -> Bytes.Bytes:
1666 Bytes.Bytes{+len, buf} = body
1667 encode.body(head, Bytes.from_string(response(status, set(headers, "content-length", U32.show(len)), "")), Bytes.Bytes{len, buf})
1668
1669# RFC 9110 §6.4.1, §8.6: 1xx, 204 and 304 have no body; HEAD gets the length but no body.
1670def encode.pick(+status: U32, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes, head: Bool, nobody: Bool) -> Bytes.Bytes:
1671 match nobody:
1672 case True{}:
1673 Bytes.from_string(response(status, headers, ""))
1674 case False{}:
1675 encode.len(status, headers, head, body)
1676
1677def encode.on(r: Res, head: Bool) -> Bytes.Bytes:
1678 Res{+status, headers, body} = r
1679 encode.pick(status, headers, body, head, frame.nobody(status, False{}))
1680
1681def encode(r: Res) -> Bytes.Bytes:
1682 encode.on(r, False{})
1683
1684def request(method: String, path: String, headers: Map<&2, List<&2, String>>, body: String) -> String:
1685 (method ++ " " ++ path ++ " HTTP/1.1" ++ headers_block(headers)) ++ ("\r\n\r\n" ++ body)
1686
1687def req.reserved(+k: String) -> Bool:
1688 Bool.or(Bool.or(String.eq(k, "host"), String.eq(k, "connection")), Bool.or(String.eq(k, "content-length"), String.eq(k, "transfer-encoding")))
1689
1690def req.put.one(m: Map<&2, List<&2, String>>, +k: String, vs: List<&2, String>, skip: Bool) -> Map<&2, List<&2, String>>:
1691 match skip:
1692 case True{}:
1693 m
1694 case False{}:
1695 Map.set(&2, List<&2, String>, m, k, vs)
1696
1697def req.put(xs: List<&2, Sigma<&2, &2, String, _ => List<&2, String>>>, m: Map<&2, List<&2, String>>) -> Map<&2, List<&2, String>>:
1698 match xs:
1699 case Nil{}:
1700 m
1701 case (k, vs) <> t:
1702 +lk = String.to_lower(k)
1703 req.put(t, req.put.one(m, lk, vs, req.reserved(lk)))
1704
1705# RFC 9110 §8.6: no Content-Length on a bodiless request whose method gives a body no meaning.
1706def req.cl(+m: Map<&2, List<&2, String>>, +method: String, +len: U32) -> Map<&2, List<&2, String>>:
1707 +bodied = Bool.or(Bool.not(U32.is_zero(len)), Bool.or(String.eq(method, "POST"), Bool.or(String.eq(method, "PUT"), String.eq(method, "PATCH"))))
1708 Bool.pick(Map<&2, List<&2, String>>, bodied, set(m, "content-length", U32.show(len)), m)
1709
1710# Caller headers are lowercased so they cannot duplicate ours; host, connection,
1711# content-length and transfer-encoding are always ours (no smuggling through them).
1712def encode_req.word(close: Bool) -> String:
1713 match close:
1714 case True{}:
1715 "close"
1716 case False{}:
1717 "keep-alive"
1718
1719def encode_req.on(+method: String, target: String, host: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes, close: Bool) -> Bytes.Bytes:
1720 Bytes.Bytes{+len, buf} = body
1721 +h = set(set(req.put(Map.to_list(&2, List<&2, String>, headers), empty()), "host", host), "connection", encode_req.word(close))
1722 Bytes.append(Bytes.from_string(request(method, target, req.cl(h, method, len), "")), Bytes.Bytes{len, buf})
1723
1724def encode_req(+method: String, target: String, host: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes) -> Bytes.Bytes:
1725 encode_req.on(method, target, host, headers, body, True{})
1726
1727# Redirects (RFC 9110 §15.4, as WHATWG fetch applies them)
1728# --------------------------------------------------------
1729
1730# One request to make: headers are already lowercased (see req.put).
1731type Hop is Type:
1732 Hop{method: String, url: Url.Abs, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes}
1733
1734def redirect.code(+s: U32) -> Bool:
1735 Bool.or(Bool.or(U32.is_eq(s, 301), U32.is_eq(s, 302)), Bool.or(U32.is_eq(s, 303), Bool.or(U32.is_eq(s, 307), U32.is_eq(s, 308))))
1736
1737def redirect.origin(a: Url.Abs) -> String:
1738 Url.Abs{scheme, host, port, target} = a
1739 scheme ++ "://" ++ host ++ ":" ++ U32.show(port)
1740
1741def redirect.del(ks: List<&2, String>, m: Map<&2, List<&2, String>>) -> Map<&2, List<&2, String>>:
1742 match ks:
1743 case Nil{}:
1744 m
1745 case Con{k, t}:
1746 redirect.del(t, Map.del(&2, List<&2, String>, m, k))
1747
1748def redirect.hdrs(+h: Map<&2, List<&2, String>>, drop: Bool, cross: Bool) -> Map<&2, List<&2, String>>:
1749 +h2 = Bool.pick(Map<&2, List<&2, String>>, drop, redirect.del(["content-type", "content-encoding", "content-language", "content-location"], h), h)
1750 Bool.pick(Map<&2, List<&2, String>>, cross, redirect.del(["authorization", "cookie", "proxy-authorization"], h2), h2)
1751
1752# 303 turns any method but HEAD into GET; 301 and 302 turn POST into GET;
1753# 307 and 308 keep method and body. A GET carries no body or body headers.
1754# Credentials do not follow a hop to another origin.
1755def redirect.body(drop: Bool, body: Bytes.Bytes) -> Bytes.Bytes:
1756 match drop:
1757 case True{}:
1758 Bytes.new(0)
1759 case False{}:
1760 body
1761
1762def redirect.to(+status: U32, +method: String, +from: Url.Abs, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes, next: Maybe<&2, Url.Abs>) -> Maybe<&1, Hop>:
1763 match next:
1764 case None{}:
1765 None{}
1766 case Some{+to}:
1767 +drop = Bool.or(Bool.and(U32.is_eq(status, 303), Bool.not(String.eq(method, "HEAD"))), Bool.and(Bool.or(U32.is_eq(status, 301), U32.is_eq(status, 302)), String.eq(method, "POST")))
1768 Some{Hop{Bool.pick(String, drop, "GET", method), to, redirect.hdrs(headers, drop, Bool.not(String.eq(redirect.origin(from), redirect.origin(to)))), redirect.body(drop, body)}}
1769
1770def redirect.hop(status: U32, h: Hop, loc: String) -> Maybe<&1, Hop>:
1771 Hop{method, +url, headers, body} = h
1772 redirect.to(status, method, url, headers, body, Url.resolve(url, loc))
1773
1774def redirect.if(status: U32, h: Hop, loc: String, ok: Bool) -> Maybe<&1, Hop>:
1775 match ok:
1776 case False{}:
1777 None{}
1778 case True{}:
1779 redirect.hop(status, h, loc)
1780
1781# The next request after a response, or None when it is not a redirect we follow.
1782def redirect(+status: U32, +headers: Map<&2, List<&2, String>>, h: Hop) -> Maybe<&1, Hop>:
1783 redirect.if(status, h, header(headers, "location"), Bool.and(redirect.code(status), has_header(headers, "location")))
1784
1785# Cookies (RFC 6265bis §5)
1786# ------------------------
1787
1788# A stored cookie. domain is lowercase, with no leading dot; host_only sends it to that host alone.
1789# expiry None is a session cookie. http_only and same_site ("strict", "lax", "none" or "default")
1790# are kept, not enforced: fetch has no browsing client, so its requests are same-site (§5.2).
1791type Cookie is Data:
1792 Cookie{name: String, value: String, domain: String, host_only: Bool, path: String, secure: Bool, http_only: Bool, same_site: String, expiry: Maybe<&2, Time.Instant>}
1793
1794# The cookies, oldest first, and the caller's clock. No cookie in it has expired by now.
1795type Jar is Data:
1796 Jar{now: Time.Instant, cookies: List<&2, Cookie>}
1797
1798def jar.new(now: Time.Instant) -> Jar:
1799 Jar{now, Nil{}}
1800
1801def jar.cookies(j: Jar) -> List<&2, Cookie>:
1802 Jar{now, cs} = j
1803 cs
1804
1805def cookie.live.at(+now: Time.Instant, e: Maybe<&2, Time.Instant>) -> Bool:
1806 match e:
1807 case None{}:
1808 True{}
1809 case Some{t}:
1810 Cmp.is_lt(Time.Instant.cmp(now, t))
1811
1812# Alive at now: no expiry, or an expiry after now.
1813def cookie.live(+now: Time.Instant, c: Cookie) -> Bool:
1814 Cookie{name, value, domain, host_only, path, secure, http_only, same_site, expiry} = c
1815 cookie.live.at(now, expiry)
1816
1817def jar.live(cs: List<&2, Cookie>, +now: Time.Instant) -> List<&2, Cookie>:
1818 match cs:
1819 case Nil{}:
1820 Nil{}
1821 case Con{+c, t}:
1822 List.filter.put(Cookie, c, jar.live(t, now), cookie.live(now, c))
1823
1824# The jar at a later time: cookies expired by now are evicted (§5.7).
1825def jar.at(j: Jar, +now: Time.Instant) -> Jar:
1826 Jar{old, cs} = j
1827 Jar{now, jar.live(cs, now)}
1828
1829def cookie.cut.found(r: String & String) -> String & String & Bool:
1830 (a, b) = r
1831 (a, b, True{})
1832
1833# hit: the last char pushed onto acc was c.
1834def cookie.cut.go(s: String, +c: U32, acc: String, hit: Bool) -> String & String & Bool:
1835 match s:
1836 case SNil{}:
1837 match hit:
1838 case True{}:
1839 cookie.cut.found(take.cut(acc, SNil{}))
1840 case False{}:
1841 (String.reverse(acc), SNil{}, False{})
1842 case SCon{Chr{+x}, t}:
1843 match hit:
1844 case True{}:
1845 cookie.cut.found(take.cut(acc, SCon{Chr{x}, t}))
1846 case False{}:
1847 cookie.cut.go(t, c, SCon{Chr{x}, acc}, U32.is_eq(x, c))
1848
1849# s split at its first c: before, after, and whether c was there.
1850def cookie.cut(s: String, +c: U32) -> String & String & Bool:
1851 cookie.cut.go(s, c, SNil{}, False{})
1852
1853def cookie.fst(r: String & String & Bool) -> String:
1854 (a, b, found) = r
1855 a
1856
1857# The path of an origin-form target: the part before "?".
1858def cookie.target_path(t: String) -> String:
1859 cookie.fst(cookie.cut(t, 63))
1860
1861# Longer than n octets.
1862def cookie.over(s: String, +n: U32) -> Bool:
1863 match s:
1864 case SNil{}:
1865 False{}
1866 case SCon{c, t}:
1867 Bool.or(U32.is_eq(n, 0), cookie.over(t, (n - 1 : U32)))
1868
1869# %x00-08 / %x0A-1F / %x7F: control characters other than HTAB.
1870def cookie.ctl(s: String) -> Bool:
1871 match s:
1872 case SNil{}:
1873 False{}
1874 case SCon{Chr{+c}, t}:
1875 Bool.or(Bool.or(U32.is_lt(c, 9), Bool.and(U32.is_gt(c, 9), U32.is_lt(c, 32))), Bool.or(U32.is_eq(c, 127), cookie.ctl(t)))
1876
1877def cookie.ascii(s: String) -> Bool:
1878 match s:
1879 case SNil{}:
1880 True{}
1881 case SCon{Chr{+c}, t}:
1882 Bool.and(U32.is_lt(c, 128), cookie.ascii(t))
1883
1884def cookie.ip4(s: String) -> Bool:
1885 match s:
1886 case SNil{}:
1887 True{}
1888 case SCon{Chr{+c}, t}:
1889 Bool.and(Bool.or(parse_u32.digit(c), U32.is_eq(c, 46)), cookie.ip4(t))
1890
1891# An IP literal rather than a host name: IPv6 has a colon, IPv4 is digits and dots.
1892def cookie.ip(+h: String) -> Bool:
1893 Bool.or(String.contains(h, ":"), cookie.ip4(h))
1894
1895# §5.1.3: s is d, or a host name under d on a label boundary.
1896def cookie.domain_match(+s: String, +d: String) -> Bool:
1897 Bool.or(String.eq(s, d), Bool.and(String.ends_with(s, "." ++ d), Bool.not(cookie.ip(s))))
1898
1899# A reversed path with its last segment and slash dropped.
1900def cookie.up(rs: String) -> String:
1901 match rs:
1902 case SNil{}:
1903 SNil{}
1904 case SCon{Chr{47}, t}:
1905 t
1906 case SCon{Chr{c}, t}:
1907 cookie.up(t)
1908
1909# §5.1.4: the request path up to its last "/", or "/".
1910def cookie.default_path(+p: String) -> String:
1911 +up = String.reverse(cookie.up(String.reverse(p)))
1912 Bool.pick(String, Bool.or(Bool.not(String.starts_with(p, "/")), String.is_empty(up)), "/", up)
1913
1914# §5.1.4: request path p path-matches cookie path c.
1915def cookie.path_match(+p: String, +c: String) -> Bool:
1916 Bool.or(String.eq(p, c), Bool.and(String.starts_with(p, c), Bool.or(String.ends_with(c, "/"), String.starts_with(String.drop(p, String.length(c)), "/"))))
1917
1918type Hms is Data:
1919 Hms{h: U32, m: U32, s: U32}
1920
1921# §5.1.1 cookie-date: the first time, day, month and year tokens found.
1922type Cdate is Data:
1923 Cdate{time: Maybe<&2, Hms>, day: Maybe<&2, U32>, month: Maybe<&2, U32>, year: Maybe<&2, U32>}
1924
1925def cookie.date.delim(+c: U32) -> Bool:
1926 Bool.or(U32.is_eq(c, 9), Bool.or(Bool.and(U32.is_ge(c, 32), U32.is_le(c, 47)), Bool.or(Bool.and(U32.is_ge(c, 59), U32.is_le(c, 64)), Bool.or(Bool.and(U32.is_ge(c, 91), U32.is_le(c, 96)), Bool.and(U32.is_ge(c, 123), U32.is_le(c, 126))))))
1927
1928def cookie.date.push(acc: String, ts: List<&2, String>) -> List<&2, String>:
1929 match acc:
1930 case SNil{}:
1931 ts
1932 case SCon{h, t}:
1933 Con{String.reverse(SCon{h, t}), ts}
1934
1935def cookie.date.step(d: Bool, +c: U32, acc: String, ts: List<&2, String>) -> String & List<&2, String>:
1936 match d:
1937 case True{}:
1938 (SNil{}, cookie.date.push(acc, ts))
1939 case False{}:
1940 (SCon{Chr{c}, acc}, ts)
1941
1942# The date-tokens, last first. st: the token so far (reversed) and the tokens before it.
1943def cookie.date.tokens(s: String, st: String & List<&2, String>) -> List<&2, String>:
1944 match s:
1945 case SNil{}:
1946 (acc, ts) = st
1947 cookie.date.push(acc, ts)
1948 case SCon{Chr{+c}, t}:
1949 (acc, ts) = st
1950 cookie.date.tokens(t, cookie.date.step(cookie.date.delim(c), c, acc, ts))
1951
1952def cookie.date.head(+s: String) -> Bool:
1953 match s:
1954 case SNil{}:
1955 False{}
1956 case SCon{Chr{+c}, t}:
1957 parse_u32.digit(c)
1958
1959# The digits at the start of s: (count, value, rest). d: s starts with a digit.
1960def cookie.date.run(s: String, d: Bool, +n: U32, +acc: U32) -> U32 & U32 & String:
1961 match s:
1962 case SNil{}:
1963 (n, acc, SNil{})
1964 case SCon{Chr{+c}, +t}:
1965 match d:
1966 case True{}:
1967 cookie.date.run(t, cookie.date.head(t), (n + 1 : U32), (acc * 10 + (c - 48 : U32) : U32))
1968 case False{}:
1969 (n, acc, SCon{Chr{c}, t})
1970
1971def cookie.date.within(r: U32 & U32 & String, +lo: U32, +hi: U32) -> Maybe<&1, U32 & String>:
1972 (+n, v, rest) = r
1973 Bool.pick(Maybe<&1, U32 & String>, Bool.and(U32.is_ge(n, lo), U32.is_le(n, hi)), Some{(v, rest)}, None{})
1974
1975# lo to hi digits and what follows them, which does not start with a digit.
1976def cookie.date.num(+s: String, +lo: U32, +hi: U32) -> Maybe<&1, U32 & String>:
1977 cookie.date.within(cookie.date.run(s, cookie.date.head(s), 0, 0), lo, hi)
1978
1979def cookie.date.val(m: Maybe<&1, U32 & String>) -> Maybe<&2, U32>:
1980 match m:
1981 case None{}:
1982 None{}
1983 case Some{(v, t)}:
1984 Some{v}
1985
1986def cookie.date.colon(s: String) -> Maybe<&2, String>:
1987 match s:
1988 case SNil{}:
1989 None{}
1990 case SCon{Chr{58}, t}:
1991 Some{t}
1992 case SCon{Chr{c}, t}:
1993 None{}
1994
1995def cookie.date.sec(+h: U32, +m: U32, r: Maybe<&1, U32 & String>) -> Maybe<&2, Hms>:
1996 match r:
1997 case None{}:
1998 None{}
1999 case Some{(s, t)}:
2000 Some{Hms{h, m, s}}
2001
2002def cookie.date.min.c(+h: U32, +m: U32, c: Maybe<&2, String>) -> Maybe<&2, Hms>:
2003 match c:
2004 case None{}:
2005 None{}
2006 case Some{+t}:
2007 cookie.date.sec(h, m, cookie.date.num(t, 1, 2))
2008
2009def cookie.date.min(+h: U32, r: Maybe<&1, U32 & String>) -> Maybe<&2, Hms>:
2010 match r:
2011 case None{}:
2012 None{}
2013 case Some{(m, t)}:
2014 cookie.date.min.c(h, m, cookie.date.colon(t))
2015
2016def cookie.date.hour.c(+h: U32, c: Maybe<&2, String>) -> Maybe<&2, Hms>:
2017 match c:
2018 case None{}:
2019 None{}
2020 case Some{+t}:
2021 cookie.date.min(h, cookie.date.num(t, 1, 2))
2022
2023def cookie.date.hour(r: Maybe<&1, U32 & String>) -> Maybe<&2, Hms>:
2024 match r:
2025 case None{}:
2026 None{}
2027 case Some{(h, t)}:
2028 cookie.date.hour.c(h, cookie.date.colon(t))
2029
2030# hms-time: 1*2DIGIT ":" 1*2DIGIT ":" 1*2DIGIT, then anything but a digit.
2031def cookie.date.time(+tok: String) -> Maybe<&2, Hms>:
2032 cookie.date.hour(cookie.date.num(tok, 1, 2))
2033
2034def cookie.date.month.go(xs: List<&2, String>, +w: String, +i: U32) -> Maybe<&2, U32>:
2035 match xs:
2036 case Nil{}:
2037 None{}
2038 case Con{x, t}:
2039 Bool.pick(Maybe<&2, U32>, String.eq(x, w), Some{i}, cookie.date.month.go(t, w, (i + 1 : U32)))
2040
2041# The month named by the first three letters, from 1.
2042def cookie.date.month(+tok: String) -> Maybe<&2, U32>:
2043 cookie.date.month.go(["jan", "feb", "mar", "apr", "may", "jun", "jul", "aug", "sep", "oct", "nov", "dec"], String.to_lower(String.take(tok, 3n)), 1)
2044
2045# Each try* below: the flag is set, so go on; or the token matches, so stop; or go on.
2046def cookie.date.year(y: Maybe<&2, U32>, +tok: String, t: Maybe<&2, Hms>, d: Maybe<&2, U32>, m: Maybe<&2, U32>) -> Cdate:
2047 match y:
2048 case None{}:
2049 Cdate{t, d, m, cookie.date.val(cookie.date.num(tok, 2, 4))}
2050 case Some{v}:
2051 Cdate{t, d, m, Some{v}}
2052
2053def cookie.date.month.got(g: Maybe<&2, U32>, +tok: String, t: Maybe<&2, Hms>, d: Maybe<&2, U32>, y: Maybe<&2, U32>) -> Cdate:
2054 match g:
2055 case None{}:
2056 cookie.date.year(y, tok, t, d, None{})
2057 case Some{v}:
2058 Cdate{t, d, Some{v}, y}
2059
2060def cookie.date.month.try(m: Maybe<&2, U32>, +tok: String, t: Maybe<&2, Hms>, d: Maybe<&2, U32>, y: Maybe<&2, U32>) -> Cdate:
2061 match m:
2062 case None{}:
2063 cookie.date.month.got(cookie.date.month(tok), tok, t, d, y)
2064 case Some{v}:
2065 cookie.date.year(y, tok, t, d, Some{v})
2066
2067def cookie.date.day.got(g: Maybe<&2, U32>, +tok: String, t: Maybe<&2, Hms>, m: Maybe<&2, U32>, y: Maybe<&2, U32>) -> Cdate:
2068 match g:
2069 case None{}:
2070 cookie.date.month.try(m, tok, t, None{}, y)
2071 case Some{v}:
2072 Cdate{t, Some{v}, m, y}
2073
2074def cookie.date.day.try(d: Maybe<&2, U32>, +tok: String, t: Maybe<&2, Hms>, m: Maybe<&2, U32>, y: Maybe<&2, U32>) -> Cdate:
2075 match d:
2076 case None{}:
2077 cookie.date.day.got(cookie.date.val(cookie.date.num(tok, 1, 2)), tok, t, m, y)
2078 case Some{v}:
2079 cookie.date.month.try(m, tok, t, Some{v}, y)
2080
2081def cookie.date.time.got(g: Maybe<&2, Hms>, +tok: String, d: Maybe<&2, U32>, m: Maybe<&2, U32>, y: Maybe<&2, U32>) -> Cdate:
2082 match g:
2083 case None{}:
2084 cookie.date.day.try(d, tok, None{}, m, y)
2085 case Some{v}:
2086 Cdate{Some{v}, d, m, y}
2087
2088def cookie.date.time.try(t: Maybe<&2, Hms>, +tok: String, d: Maybe<&2, U32>, m: Maybe<&2, U32>, y: Maybe<&2, U32>) -> Cdate:
2089 match t:
2090 case None{}:
2091 cookie.date.time.got(cookie.date.time(tok), tok, d, m, y)
2092 case Some{v}:
2093 cookie.date.day.try(d, tok, Some{v}, m, y)
2094
2095def cookie.date.fold(ts: List<&2, String>, st: Cdate) -> Cdate:
2096 match ts:
2097 case Nil{}:
2098 st
2099 case Con{+tok, rest}:
2100 Cdate{t, d, m, y} = st
2101 cookie.date.fold(rest, cookie.date.time.try(t, tok, d, m, y))
2102
2103# 70–99 are 19xx, 0–69 are 20xx.
2104def cookie.date.fix(+y: U32) -> U32:
2105 Bool.pick(U32, U32.is_le(y, 69), (y + 2000 : U32), Bool.pick(U32, U32.is_le(y, 99), (y + 1900 : U32), y))
2106
2107def cookie.date.at(+y: U32, +d: U32, mo: U32, h: U32, mi: U32, s: U32) -> Maybe<&2, Time.Instant>:
2108 Bool.pick(Maybe<&2, Time.Instant>, Bool.and(U32.is_ge(y, 1601), Bool.and(U32.is_ge(d, 1), U32.is_le(d, 31))), Time.mk(Time.DateTime{Time.Date{y, mo, d}, h, mi, s, 0}), None{})
2109
2110def cookie.date.fin(st: Cdate) -> Maybe<&2, Time.Instant>:
2111 match st:
2112 case Cdate{Some{Hms{h, mi, s}}, Some{d}, Some{mo}, Some{y}}:
2113 cookie.date.at(cookie.date.fix(y), d, mo, h, mi, s)
2114 case _:
2115 None{}
2116
2117# §5.1.1: a cookie-date such as "Sun, 06 Nov 1994 08:49:37 GMT" or "Thu, 01-Jan-70 00:00:01 GMT".
2118# Time.mk refuses a day past the month's end and a time past 23:59:59.
2119def cookie.date(s: String) -> Maybe<&2, Time.Instant>:
2120 cookie.date.fin(cookie.date.fold(List.reverse(&2, String, cookie.date.tokens(s, (SNil{}, Nil{}))), Cdate{None{}, None{}, None{}, None{}}))
2121
2122# §5.6.1–§5.6.7: the last of each attribute. expires is the date as sent; max_age is capped seconds.
2123# Neither is a time from now yet: a Cav with a Time.Instant and now beside it is too wide (bendlang/bend#1069).
2124type Cav is Data:
2125 Cav{expires: Maybe<&2, Time.Instant>, max_age: Maybe<&2, U32>, domain: String, path: Maybe<&2, String>, secure: Bool, http_only: Bool, same_site: String}
2126
2127def cookie.cav() -> Cav:
2128 Cav{None{}, None{}, "", None{}, False{}, False{}, "default"}
2129
2130# §5.5: 400 days, the longest a cookie lives.
2131def cookie.limit() -> U32:
2132 34560000
2133
2134def cookie.later(+now: Time.Instant, +secs: U32) -> Time.Instant:
2135 Time.Instant.add(now, Time.Duration.of_secs(Int.I64.from_u32(secs)))
2136
2137def cookie.expires.cap(+now: Time.Instant, m: Maybe<&2, Time.Instant>) -> Maybe<&2, Time.Instant>:
2138 match m:
2139 case None{}:
2140 None{}
2141 case Some{+t}:
2142 +lim = cookie.later(now, cookie.limit())
2143 Some{Bool.pick(Time.Instant, Cmp.is_lt(Time.Instant.cmp(lim, t)), lim, t)}
2144
2145def cookie.max_age.zero(m: Maybe<&2, U32>) -> Maybe<&2, U32>:
2146 match m:
2147 case None{}:
2148 None{}
2149 case Some{s}:
2150 Some{0}
2151
2152def cookie.max_age.nz(s: String) -> String:
2153 match s:
2154 case SNil{}:
2155 SNil{}
2156 case SCon{Chr{48}, t}:
2157 cookie.max_age.nz(t)
2158 case SCon{Chr{c}, t}:
2159 SCon{Chr{c}, t}
2160
2161# More than 9 significant digits is past the limit (and would overflow parse_u32).
2162def cookie.max_age.cap(long: Bool, m: Maybe<&2, U32>) -> Maybe<&2, U32>:
2163 match m:
2164 case None{}:
2165 None{}
2166 case Some{s}:
2167 Some{Bool.pick(U32, long, cookie.limit(), s)}
2168
2169def cookie.max_age.secs(+v: String, neg: Bool) -> Maybe<&2, U32>:
2170 match neg:
2171 case True{}:
2172 cookie.max_age.zero(parse_u32(String.drop(v, 1n)))
2173 case False{}:
2174 cookie.max_age.cap(cookie.over(cookie.max_age.nz(v), 9), parse_u32(v))
2175
2176# Zero or less is the earliest time, so the cookie is already expired.
2177def cookie.max_age.at(+now: Time.Instant, m: Maybe<&2, U32>) -> Maybe<&2, Time.Instant>:
2178 match m:
2179 case None{}:
2180 None{}
2181 case Some{+s}:
2182 Some{Bool.pick(Time.Instant, U32.is_eq(s, 0), Time.Instant.epoch(), cookie.later(now, U32.min(s, cookie.limit())))}
2183
2184# §5.6.2: DIGIT*, or "-" and DIGIT*. Anything else is ignored.
2185def cookie.max_age(+v: String) -> Maybe<&2, U32>:
2186 cookie.max_age.secs(v, String.starts_with(v, "-"))
2187
2188def cookie.same_site(+v: String) -> String:
2189 +l = String.to_lower(v)
2190 Bool.pick(String, Bool.or(String.eq(l, "strict"), Bool.or(String.eq(l, "lax"), String.eq(l, "none"))), l, "default")
2191
2192type Av is Data:
2193 AvExpires{}
2194 AvMaxAge{}
2195 AvDomain{}
2196 AvPath{}
2197 AvSecure{}
2198 AvHttpOnly{}
2199 AvSameSite{}
2200 AvOther{}
2201
2202def cookie.av.kind(+k: String) -> Av:
2203 Bool.pick(Av, String.eq(k, "expires"), AvExpires{}, Bool.pick(Av, String.eq(k, "max-age"), AvMaxAge{}, Bool.pick(Av, String.eq(k, "domain"), AvDomain{}, Bool.pick(Av, String.eq(k, "path"), AvPath{}, Bool.pick(Av, String.eq(k, "secure"), AvSecure{}, Bool.pick(Av, String.eq(k, "httponly"), AvHttpOnly{}, Bool.pick(Av, String.eq(k, "samesite"), AvSameSite{}, AvOther{})))))))
2204
2205# An Expires or Max-Age that does not parse leaves the earlier one. A leading dot of Domain is dropped.
2206def cookie.av.put(k: Av, a: Cav, +v: String) -> Cav:
2207 match k a:
2208 case AvExpires{} Cav{e, m, d, p, s, h, ss}:
2209 Cav{Maybe.or(&2, Time.Instant, cookie.date(v), e), m, d, p, s, h, ss}
2210 case AvMaxAge{} Cav{e, m, d, p, s, h, ss}:
2211 Cav{e, Maybe.or(&2, U32, cookie.max_age(v), m), d, p, s, h, ss}
2212 case AvDomain{} Cav{e, m, d, p, s, h, ss}:
2213 Cav{e, m, String.to_lower(Bool.pick(String, String.starts_with(v, "."), String.drop(v, 1n), v)), p, s, h, ss}
2214 case AvPath{} Cav{e, m, d, p, s, h, ss}:
2215 Cav{e, m, d, Some{v}, s, h, ss}
2216 case AvSecure{} Cav{e, m, d, p, s, h, ss}:
2217 Cav{e, m, d, p, True{}, h, ss}
2218 case AvHttpOnly{} Cav{e, m, d, p, s, h, ss}:
2219 Cav{e, m, d, p, s, True{}, ss}
2220 case AvSameSite{} Cav{e, m, d, p, s, h, ss}:
2221 Cav{e, m, d, p, s, h, cookie.same_site(v)}
2222 case AvOther{} Cav{e, m, d, p, s, h, ss}:
2223 Cav{e, m, d, p, s, h, ss}
2224
2225# §5.6: name and value trimmed; a value over 1024 octets drops the attribute.
2226def cookie.av(+a: Cav, kv: String & String & Bool) -> Cav:
2227 (k, v, found) = kv
2228 +tv = trim(v)
2229 Bool.pick(Cav, cookie.over(tv, 1024), a, cookie.av.put(cookie.av.kind(String.to_lower(trim(k))), a, tv))
2230
2231def cookie.avs(xs: List<&2, String>, a: Cav) -> Cav:
2232 match xs:
2233 case Nil{}:
2234 a
2235 case Con{x, t}:
2236 cookie.avs(t, cookie.av(a, cookie.cut(x, 61)))
2237
2238# §5.6: with no "=", the name is empty and the pair is the value.
2239def cookie.nv(r: String & String & Bool) -> String & String:
2240 (a, b, found) = r
2241 match found:
2242 case True{}:
2243 (trim(a), trim(b))
2244 case False{}:
2245 ("", trim(a))
2246
2247def cookie.prefixed(+s: String, +p: String) -> Bool:
2248 String.starts_with(String.to_lower(s), p)
2249
2250# §5.7 steps 8–10: (domain, host-only), or None to ignore the cookie.
2251# ponytail: the public-suffix check knows single-label suffixes only (com, org, localhost). Multi-label
2252# ones (co.uk, github.io) need the publicsuffix.org list; ship it as data when a caller needs it.
2253def cookie.domain.of(+host: String, +d: String) -> Maybe<&1, String & Bool>:
2254 +suffix = Bool.and(Bool.not(String.is_empty(d)), Bool.not(String.contains(d, ".")))
2255 +d2 = Bool.pick(String, Bool.and(suffix, String.eq(d, host)), "", d)
2256 Bool.pick(Maybe<&1, String & Bool>, Bool.or(Bool.and(suffix, Bool.not(String.eq(d, host))), Bool.not(cookie.ascii(d))), None{},
2257 Bool.pick(Maybe<&1, String & Bool>, String.is_empty(d2), Some{(host, True{})},
2258 Bool.pick(Maybe<&1, String & Bool>, cookie.domain_match(host, d2), Some{(d2, False{})}, None{})))
2259
2260def cookie.path.of(p: Maybe<&2, String>, +req: String) -> String:
2261 match p:
2262 case None{}:
2263 cookie.default_path(req)
2264 case Some{+v}:
2265 Bool.pick(String, String.starts_with(v, "/"), v, cookie.default_path(req))
2266
2267# §5.7 steps 12–20: Secure needs https; SameSite=None needs Secure; the __Secure- and __Host- prefixes.
2268def cookie.make.dm(dm: Maybe<&1, String & Bool>, +name: String, +value: String, +path: String, has_path: Bool, +secure: Bool, http_only: Bool, +same_site: String, expiry: Maybe<&2, Time.Instant>, https: Bool) -> Maybe<&2, Cookie>:
2269 match dm:
2270 case None{}:
2271 None{}
2272 case Some{(domain, +host_only)}:
2273 +host = Bool.and(Bool.and(secure, host_only), Bool.and(has_path, String.eq(path, "/")))
2274 +bad = Bool.or(Bool.or(Bool.and(secure, Bool.not(https)), Bool.and(String.eq(same_site, "none"), Bool.not(secure))),
2275 Bool.or(Bool.or(Bool.and(cookie.prefixed(name, "__secure-"), Bool.not(secure)), Bool.and(cookie.prefixed(name, "__host-"), Bool.not(host))),
2276 Bool.and(String.is_empty(name), Bool.or(cookie.prefixed(value, "__secure-"), cookie.prefixed(value, "__host-")))))
2277 Bool.pick(Maybe<&2, Cookie>, bad, None{}, Some{Cookie{name, value, domain, host_only, path, secure, http_only, same_site, expiry}})
2278
2279# Max-Age wins over Expires, whatever their order (§5.7 step 6). Both count from now.
2280def cookie.expiry(+now: Time.Instant, m: Maybe<&2, U32>, e: Maybe<&2, Time.Instant>) -> Maybe<&2, Time.Instant>:
2281 Maybe.or(&2, Time.Instant, cookie.max_age.at(now, m), cookie.expires.cap(now, e))
2282
2283def cookie.make(+now: Time.Instant, a: Url.Abs, +name: String, +value: String, c: Cav) -> Maybe<&2, Cookie>:
2284 Url.Abs{scheme, host, port, target} = a
2285 Cav{e, m, d, +p, secure, http_only, same_site} = c
2286 cookie.make.dm(cookie.domain.of(host, d), name, value, cookie.path.of(p, cookie.target_path(target)), Maybe.is_some(&2, String, p), secure, http_only, same_site, cookie.expiry(now, m, e), String.eq(scheme, "https"))
2287
2288# An empty name and value, or more than 4096 octets of them, is ignored.
2289def cookie.parse.nv(+now: Time.Instant, a: Url.Abs, nv: String & String, avs: List<&2, String>) -> Maybe<&2, Cookie>:
2290 (+name, +value) = nv
2291 Bool.pick(Maybe<&2, Cookie>, Bool.or(Bool.and(String.is_empty(name), String.is_empty(value)), cookie.over(name ++ value, 4096)), None{}, cookie.make(now, a, name, value, cookie.avs(avs, cookie.cav())))
2292
2293def cookie.parse.go(+now: Time.Instant, a: Url.Abs, xs: List<&2, String>) -> Maybe<&2, Cookie>:
2294 match xs:
2295 case Nil{}:
2296 None{}
2297 case Con{first, avs}:
2298 cookie.parse.nv(now, a, cookie.nv(cookie.cut(first, 61)), avs)
2299
2300# §5.6 and §5.7: one Set-Cookie value received from a at now, or None when it is ignored.
2301def cookie.parse(+now: Time.Instant, a: Url.Abs, +line: String) -> Maybe<&2, Cookie>:
2302 Bool.pick(Maybe<&2, Cookie>, cookie.ctl(line), None{}, cookie.parse.go(now, a, String.split(line, ';')))
2303
2304def cookie.https(a: Url.Abs) -> Bool:
2305 Url.Abs{scheme, host, port, target} = a
2306 String.eq(scheme, "https")
2307
2308def cookie.secure(c: Cookie) -> Bool:
2309 Cookie{name, value, domain, host_only, path, secure, http_only, same_site, expiry} = c
2310 secure
2311
2312# Same name, domain, host-only flag and path: the new cookie replaces the old one.
2313def cookie.same(+a: Cookie, +b: Cookie) -> Bool:
2314 Cookie{n1, v1, d1, h1, p1, s1, o1, ss1, e1} = a
2315 Cookie{n2, v2, d2, h2, p2, s2, o2, ss2, e2} = b
2316 Bool.and(Bool.and(String.eq(n1, n2), String.eq(d1, d2)), Bool.and(Bool.not(Bool.xor(h1, h2)), String.eq(p1, p2)))
2317
2318# §5.7 step 16: a secure cookie that a new cookie from plain http must not overlay.
2319def cookie.shadows(+old: Cookie, +c: Cookie) -> Bool:
2320 Cookie{n1, v1, +d1, h1, p1, s1, o1, ss1, e1} = old
2321 Cookie{n2, v2, +d2, h2, p2, s2, o2, ss2, e2} = c
2322 Bool.and(Bool.and(String.eq(n1, n2), s1), Bool.and(Bool.or(cookie.domain_match(d1, d2), cookie.domain_match(d2, d1)), cookie.path_match(p2, p1)))
2323
2324def cookie.shadowed(cs: List<&2, Cookie>, +c: Cookie) -> Bool:
2325 match cs:
2326 case Nil{}:
2327 False{}
2328 case Con{+o, t}:
2329 Bool.or(cookie.shadows(o, c), cookie.shadowed(t, c))
2330
2331# cs with the cookie c replaces swapped for c (keeping its place, so its creation order), or c last.
2332# A c that is not live only removes the old one: that is how a server deletes a cookie.
2333def cookie.put(cs: List<&2, Cookie>, +c: Cookie, +live: Bool) -> List<&2, Cookie>:
2334 match cs:
2335 case Nil{}:
2336 Bool.pick(List<&2, Cookie>, live, [c], Nil{})
2337 case Con{+o, +t}:
2338 Bool.pick(List<&2, Cookie>, cookie.same(o, c), Bool.pick(List<&2, Cookie>, live, Con{c, t}, t), Con{o, cookie.put(t, c, live)})
2339
2340def jar.put.c(m: Maybe<&2, Cookie>, j: Jar, +https: Bool) -> Jar:
2341 match m:
2342 case None{}:
2343 Jar{now, cs} = j
2344 Jar{now, cs}
2345 case Some{+c}:
2346 Jar{+now, +cs} = j
2347 Jar{now, Bool.pick(List<&2, Cookie>, Bool.and(Bool.not(Bool.or(https, cookie.secure(c))), cookie.shadowed(cs, c)), cs, cookie.put(cs, c, cookie.live(now, c)))}
2348
2349def jar.put.one(j: Jar, +a: Url.Abs, x: String) -> Jar:
2350 Jar{+now, cs} = j
2351 jar.put.c(cookie.parse(now, a, x), Jar{now, cs}, cookie.https(a))
2352
2353def jar.put.all(xs: List<&2, String>, j: Jar, +a: Url.Abs) -> Jar:
2354 match xs:
2355 case Nil{}:
2356 j
2357 case Con{x, t}:
2358 jar.put.all(t, jar.put.one(j, a, x), a)
2359
2360# Every set-cookie field of h, in order, as received from a.
2361def jar.store.abs(j: Jar, +a: Url.Abs, +h: Map<&2, List<&2, String>>) -> Jar:
2362 jar.put.all(fields(h, "set-cookie"), j, a)
2363
2364def jar.store.url(j: Jar, u: Maybe<&2, Url.Abs>, +h: Map<&2, List<&2, String>>) -> Jar:
2365 match u:
2366 case None{}:
2367 j
2368 case Some{+a}:
2369 jar.store.abs(j, a, h)
2370
2371# The jar after res came from url, and res as it was. Header names are lowercase, as parse gives them.
2372# An unparsable url stores nothing.
2373def jar.store(j: Jar, url: String, res: Res) -> Jar & Res:
2374 Res{status, +headers, body} = res
2375 (jar.store.url(j, Url.absolute(url), headers), Res{status, headers, body})
2376
2377# §5.8.3: domain (exact when host-only), path, and Secure only over https.
2378def cookie.sends(+host: String, +path: String, +https: Bool, +c: Cookie) -> Bool:
2379 Cookie{n, v, +d, +ho, +p, s, o, ss, e} = c
2380 Bool.and(Bool.pick(Bool, ho, String.eq(host, d), cookie.domain_match(host, d)), Bool.and(cookie.path_match(path, p), Bool.or(Bool.not(s), https)))
2381
2382def cookie.pick(cs: List<&2, Cookie>, +host: String, +path: String, +https: Bool) -> List<&2, Cookie>:
2383 match cs:
2384 case Nil{}:
2385 Nil{}
2386 case Con{+c, t}:
2387 List.filter.put(Cookie, c, cookie.pick(t, host, path, https), cookie.sends(host, path, https, c))
2388
2389# The sort order of §5.8.3: longer paths first; the stable sort keeps creation order among equals.
2390def cookie.longer(a: Cookie, b: Cookie) -> Bool:
2391 Cookie{n1, v1, d1, h1, p1, s1, o1, ss1, e1} = a
2392 Cookie{n2, v2, d2, h2, p2, s2, o2, ss2, e2} = b
2393 Bool.not(Nat.is_lt(String.length(p1), String.length(p2)))
2394
2395def cookie.pair(c: Cookie) -> String:
2396 Cookie{+n, +v, d, h, p, s, o, ss, e} = c
2397 Bool.pick(String, String.is_empty(n), v, n ++ "=" ++ v)
2398
2399def cookie.pairs(cs: List<&2, Cookie>) -> List<&2, String>:
2400 match cs:
2401 case Nil{}:
2402 Nil{}
2403 case Con{c, t}:
2404 Con{cookie.pair(c), cookie.pairs(t)}
2405
2406# §5.8.3: the cookie-string for a request to a, or "" when no cookie matches.
2407def jar.string(j: Jar, a: Url.Abs) -> String:
2408 Jar{now, cs} = j
2409 Url.Abs{scheme, +host, port, target} = a
2410 String.join(cookie.pairs(List.sort(~Cookie, ~cookie.longer, cookie.pick(cs, host, cookie.target_path(target), String.eq(scheme, "https")))), "; ")
2411
2412# One cookie field: the caller's own cookie values first, then the jar's.
2413def jar.header(+h: Map<&2, List<&2, String>>, +s: String) -> Map<&2, List<&2, String>>:
2414 +old = String.join(fields(h, "cookie"), "; ")
2415 Bool.pick(Map<&2, List<&2, String>>, String.is_empty(s), h, set(h, "cookie", Bool.pick(String, String.is_empty(old), s, old ++ "; " ++ s)))
2416
2417def jar.apply.url(j: Jar, u: Maybe<&2, Url.Abs>, +h: Map<&2, List<&2, String>>) -> Map<&2, List<&2, String>>:
2418 match u:
2419 case None{}:
2420 h
2421 case Some{a}:
2422 jar.header(h, jar.string(j, a))
2423
2424# The headers with the jar's cookies for a request to url in their cookie field (lowercase, as fetch
2425# sends names). An unparsable url adds nothing.
2426def jar.apply(j: Jar, url: String, +h: Map<&2, List<&2, String>>) -> Map<&2, List<&2, String>>:
2427 jar.apply.url(j, Url.absolute(url), h)
2428
2429# The jar, if any, that a fetch threads through its hops.
2430def jar.opt.apply(m: Maybe<&2, Jar>, a: Url.Abs, +h: Map<&2, List<&2, String>>) -> Map<&2, List<&2, String>>:
2431 match m:
2432 case None{}:
2433 h
2434 case Some{j}:
2435 jar.header(h, jar.string(j, a))
2436
2437def jar.opt.res(j: Jar, +a: Url.Abs, r: Result<&1, &1, Err, Res>) -> Maybe<&2, Jar> & Result<&1, &1, Err, Res>:
2438 match r:
2439 case Fail{e}:
2440 (Some{j}, Fail{e})
2441 case Done{res}:
2442 Res{status, +headers, body} = res
2443 (Some{jar.store.abs(j, a, headers)}, Done{Res{status, headers, body}})
2444
2445def jar.opt.store(m: Maybe<&2, Jar>, +a: Url.Abs, r: Result<&1, &1, Err, Res>) -> Maybe<&2, Jar> & Result<&1, &1, Err, Res>:
2446 match m:
2447 case None{}:
2448 (None{}, r)
2449 case Some{j}:
2450 jar.opt.res(j, a, r)
2451
2452def io.recv.words(tls: Bool, s: Socket, max: U32, ms: U32) -> IO(Socket & Result<&1, &1, U32 & String, U32 & Array<U32>>):
2453 match tls:
2454 case True{}:
2455 Wire.tls.recv.words(s, max, ms)
2456 case False{}:
2457 Wire.recv.words(s, max, ms)
2458
2459def io.send.words(tls: Bool, s: Socket, +len: U32, buf: Array<U32>) -> IO(Socket & Result<&1, &1, U32 & String, Unit>):
2460 match tls:
2461 case True{}:
2462 Wire.tls.send.words(s, len, buf)
2463 case False{}:
2464 Wire.send.words(s, len, buf)
2465
2466def io.send.bytes(tls: Bool, s: Socket, b: Bytes.Bytes) -> IO(Socket & Result<&1, &1, U32 & String, Unit>):
2467 Bytes.Bytes{+len, buf} = b
2468 io.send.words(tls, s, len, buf)
2469
2470def io.close(tls: Bool, s: Socket) -> IO(Unit):
2471 match tls:
2472 case True{}:
2473 Wire.tls.close(s)
2474 case False{}:
2475 Socket.close(s)
2476
2477def fetch.close(tls: Bool, s: Socket, r: Result<&1, &1, Err, Res>) -> IO(Result<&1, &1, Err, Res>):
2478 do IO<Result<&1, &1, Err, Res>>:
2479 io.close(tls, s)
2480 return r
2481
2482# none: no response byte arrived, so an idempotent request may be retried (RFC 9112 §9.3.1).
2483# sock: the socket, when it can take another request.
2484type Out is Type:
2485 OutDone{res: Res, sock: Maybe<&1, Socket>, rest: Bytes.Bytes}
2486 OutFail{e: Err, none: Bool}
2487
2488def fetch.boxed(r: Result<&1, &1, Err, Res>, none: Bool) -> Out:
2489 match r:
2490 case Done{res}:
2491 OutDone{res, None{}, Bytes.new(0)}
2492 case Fail{e}:
2493 OutFail{e, none}
2494
2495def fetch.bad(tls: Bool, s: Socket, e: Maybe<&2, Err>) -> IO(Result<&1, &1, Err, Res>):
2496 match e:
2497 case None{}:
2498 fetch.close(tls, s, Fail{ErrBad{}})
2499 case Some{err}:
2500 fetch.close(tls, s, Fail{err})
2501
2502def fetch.shut(tls: Bool, s: Socket, r: Result<&1, &1, Err, Res>, none: Bool) -> IO(Out):
2503 do IO<Out>:
2504 x : Result<&1, &1, Err, Res> <- fetch.close(tls, s, r)
2505 return fetch.boxed(x, none)
2506
2507def fetch.hold.go(tls: Bool, s: Socket, res: Res, left: Maybe<&1, Bytes.Bytes>) -> IO(Out):
2508 match left:
2509 case Some{x}:
2510 IO.pure(Out, OutDone{res, Some{s}, x})
2511 case None{}:
2512 fetch.shut(tls, s, Done{res}, False{})
2513
2514def fetch.hold(tls: Bool, close: Bool, s: Socket, res: Res, left: Maybe<&1, Bytes.Bytes>) -> IO(Out):
2515 Res{status, +headers, body} = res
2516 fetch.hold.go(tls, s, Res{status, headers, body}, again(close, headers, left))
2517
2518def fetch.failout(tls: Bool, s: Socket, e: Maybe<&2, Err>, none: Bool) -> IO(Out):
2519 do IO<Out>:
2520 r : Result<&1, &1, Err, Res> <- fetch.bad(tls, s, e)
2521 return fetch.boxed(r, none)
2522
2523# Read state: the response so far and the bytes read, or how it ended.
2524# none: no byte arrived, so an idempotent request may be retried.
2525type Fl is Type:
2526 FlMore{rv: Rv, n: U32}
2527 FlBad{err: Maybe<&2, Err>, none: Bool}
2528 FlDone{res: Res, rest: Maybe<&1, Bytes.Bytes>}
2529
2530def fetch.rt(+n: U32, t: Rt) -> Fl:
2531 match t:
2532 case RtMore{rv}:
2533 FlMore{rv, n}
2534 case RtBad{}:
2535 FlBad{None{}, U32.is_zero(n)}
2536 case RtDone{res, rest}:
2537 FlDone{res, rest}
2538
2539# 64 KiB of head past the body cap, as serve allows.
2540def fetch.over(+n: U32) -> Bool:
2541 Nat.is_lt(Nat.add(fetch.max(), 65536n), U32.to_nat(n))
2542
2543def fetch.piece.cap(over: Bool, +head: Bool, rv: Rv, +n2: U32, +len: U32, buf: Array<U32>) -> Fl:
2544 match over:
2545 case True{}:
2546 FlBad{None{}, False{}}
2547 case False{}:
2548 fetch.rt(n2, rv.step(U32.is_zero(len), head, rv, Bytes.Bytes{len, buf}))
2549
2550def fetch.piece(+head: Bool, rv: Rv, +n: U32, p: U32 & Array<U32>) -> Fl:
2551 (+len, buf) = p
2552 +n2 = (n + len : U32)
2553 fetch.piece.cap(fetch.over(n2), head, rv, n2, len, buf)
2554
2555def fetch.next(+head: Bool, rv: Rv, +n: U32, m: Socket & Result<&1, &1, U32 & String, U32 & Array<U32>>) -> Socket & Fl:
2556 (s, r) = m
2557 match r:
2558 case Fail{(+code, why)}:
2559 (s, FlBad{Some{err.or_late(code, ErrRead{code, why})}, U32.is_zero(n)})
2560 case Done{p}:
2561 (s, fetch.piece(head, rv, n, p))
2562
2563# Reads until the response is whole or cannot be; an empty read means the server closed.
2564@unsafe
2565def fetch.loop(+close: Bool, +head: Bool, +tls: Bool, +ms: U32, st: Socket & Fl) -> IO(Out):
2566 (s, fl) = st
2567 match fl:
2568 case FlMore{rv, +n}:
2569 do IO<Out>:
2570 m : Socket & Result<&1, &1, U32 & String, U32 & Array<U32>> <- io.recv.words(tls, s, 65536, ms)
2571 fetch.loop(close, head, tls, ms, fetch.next(head, rv, n, m))
2572 case FlBad{err, none}:
2573 fetch.failout(tls, s, err, none)
2574 case FlDone{res, rest}:
2575 fetch.hold(tls, close, s, res, rest)
2576
2577def exchange.sent(+tls: Bool, +ms: U32, +close: Bool, +head: Bool, m: Socket & Result<&1, &1, U32 & String, Unit>) -> IO(Out):
2578 (s, r) = m
2579 match r:
2580 case Fail{(+code, why)}:
2581 fetch.shut(tls, s, Fail{err.or_late(code, ErrWrite{code, why})}, True{})
2582 case Done{u}:
2583 fetch.loop(close, head, tls, ms, (s, FlMore{rv.start(), 0}))
2584
2585def exchange.go(+tls: Bool, +ms: U32, +close: Bool, +head: Bool, s: Socket, wire: Bytes.Bytes) -> IO(Out):
2586 do IO<Out>:
2587 sent : Socket & Result<&1, &1, U32 & String, Unit> <- io.send.bytes(tls, s, wire)
2588 exchange.sent(tls, ms, close, head, sent)
2589
2590def exchange.tup(o: Out) -> Maybe<&1, Socket> & Result<&1, &1, Err, Res> & Bytes.Bytes:
2591 match o:
2592 case OutFail{e, none}:
2593 (None{}, Fail{e}, Bytes.new(0))
2594 case OutDone{res, sock, rest}:
2595 (sock, Done{res}, rest)
2596
2597# One request on an open socket. Some{socket}: it can take another request.
2598def exchange(+tls: Bool, +ms: U32, +close: Bool, +head: Bool, s: Socket, wire: Bytes.Bytes) -> IO(Maybe<&1, Socket> & Result<&1, &1, Err, Res> & Bytes.Bytes):
2599 do IO<Maybe<&1, Socket> & Result<&1, &1, Err, Res> & Bytes.Bytes>:
2600 o : Out <- exchange.go(tls, ms, close, head, s, wire)
2601 return exchange.tup(o)
2602
2603# Paths to a PEM client chain and its private key for mutual TLS.
2604type Cert is Data:
2605 Cert{chain: String, key: String}
2606
2607type Proxy is Data:
2608 ProxyDirect{}
2609 ProxyVia{host: String, port: U32, authorization: String}
2610
2611type Route is Data:
2612 RouteDirect{tls: Bool, host: String, port: U32, cert: Maybe<&2, Cert>}
2613 RouteProxy{tls: Bool, host: String, port: U32, sni: String,
2614 authority: String, authorization: String, cert: Maybe<&2, Cert>}
2615
2616# Connection pool: idle sockets by origin and client identity, newest first, at most cap per key.
2617# fetch uses a fresh pool per call.
2618
2619type Conn is Type:
2620 Conn{tls: Bool, s: Socket}
2621 ConnH2{s: Socket, client: H2.Client}
2622
2623type Send is Type:
2624 Send{method: String, target: String, authority: String,
2625 headers: Map<&2, List<&2, String>>, body: Bytes.Bytes}
2626
2627type H2Step is Type:
2628 H2Reply{s: Socket, reply: H2.Reply}
2629 H2Sent{client: H2.Client, events: List<&1, H2.ClientEvent>,
2630 sent: Result<&1, &1, Err, Socket>}
2631 H2Events{s: Socket, client: H2.Client, result: Result<&1, &1, Err, Maybe<&1, Res>>}
2632 H2Received{client: H2.Client,
2633 answer: Socket & Result<&1, &1, U32 & String, U32 & Array<U32>>}
2634
2635type TunnelStep is Type:
2636 TunnelRead{s: Socket, raw: String}
2637 TunnelHead{s: Socket, raw: String, frame: Frame}
2638 TunnelGot{raw: String,
2639 answer: Socket & Result<&1, &1, U32 & String, U32 & Array<U32>>}
2640
2641type Pool is Type:
2642 Pool{cap: U32, idle: Map<&1, List<&1, Conn>>}
2643
2644def pool.new.with(+cap: U32) -> Pool:
2645 Pool{cap, Map.new(&1, List<&1, Conn>)}
2646
2647# Up to 8 idle sockets per origin.
2648def pool.new() -> Pool:
2649 pool.new.with(8)
2650
2651def pool.key(+scheme: String, +host: String, +port: U32) -> String:
2652 scheme ++ "://" ++ host ++ ":" ++ U32.show(port)
2653
2654def pool.key.cert(+base: String, cert: Maybe<&2, Cert>) -> String:
2655 match cert:
2656 case None{}:
2657 base
2658 case Some{Cert{+chain, +key}}:
2659 base ++ "|cert:" ++ Nat.show(String.length(chain)) ++ ":" ++ chain
2660 ++ Nat.show(String.length(key)) ++ ":" ++ key
2661
2662def pool.take.of(+cap: U32, +key: String, r: Map<&1, List<&1, Conn>> & Maybe<&1, List<&1, Conn>>) -> Pool & Maybe<&1, Conn>:
2663 (m, got) = r
2664 match got:
2665 case None{}:
2666 (Pool{cap, m}, None{})
2667 case Some{xs}:
2668 match xs:
2669 case Nil{}:
2670 (Pool{cap, m}, None{})
2671 case Con{c, t}:
2672 (Pool{cap, Map.set(&1, List<&1, Conn>, m, key, t)}, Some{c})
2673
2674# The socket given back last.
2675def pool.take(p: Pool, +key: String) -> Pool & Maybe<&1, Conn>:
2676 Pool{+cap, idle} = p
2677 pool.take.of(cap, key, Map.pop(&1, List<&1, Conn>, idle, key))
2678
2679def conn.close(c: Conn) -> IO(Unit):
2680 match c:
2681 case Conn{tls, s}:
2682 io.close(tls, s)
2683 case ConnH2{s, client}:
2684 Wire.tls.close(s)
2685
2686# The first n sockets; the rest are closed.
2687def conns.cut(xs: List<&1, Conn>, n: Nat) -> IO(List<&1, Conn>):
2688 match xs:
2689 case Nil{}:
2690 IO.pure(List<&1, Conn>, Nil{})
2691 case Con{c, t}:
2692 match n:
2693 case 0n:
2694 do IO<List<&1, Conn>>:
2695 conn.close(c)
2696 conns.cut(t, 0n)
2697 case 1n+k:
2698 do IO<List<&1, Conn>>:
2699 r : List<&1, Conn> <- conns.cut(t, k)
2700 return c <> r
2701
2702def pool.give.of(+cap: U32, +key: String, c: Conn, limit: Nat,
2703 r: Map<&1, List<&1, Conn>> & Maybe<&1, List<&1, Conn>>) -> IO(Pool):
2704 (m, old) = r
2705 do IO<Pool>:
2706 xs : List<&1, Conn> <- conns.cut(c <> Maybe.default(&1, List<&1, Conn>, old, Nil{}), limit)
2707 return Pool{cap, Map.set(&1, List<&1, Conn>, m, key, xs)}
2708
2709# Past the limit (cap for HTTP/1.1, one session for HTTP/2), close the oldest idle connection.
2710def pool.give(p: Pool, +key: String, c: Conn) -> IO(Pool):
2711 Pool{+cap, idle} = p
2712 match c:
2713 case Conn{tls, s}:
2714 pool.give.of(cap, key, Conn{tls, s}, U32.to_nat(cap), Map.pop(&1, List<&1, Conn>, idle, key))
2715 case ConnH2{s, client}:
2716 pool.give.of(cap, key, ConnH2{s, client}, Bool.pick(Nat, U32.is_zero(cap), 0n, 1n),
2717 Map.pop(&1, List<&1, Conn>, idle, key))
2718
2719def pool.close.go(xs: List<&1, List<&1, Conn>>) -> IO(Unit):
2720 match xs:
2721 case Nil{}:
2722 IO.pure(Unit, Unit{})
2723 case Con{cs, t}:
2724 do IO<Unit>:
2725 none : List<&1, Conn> <- conns.cut(cs, 0n)
2726 pool.close.go(t)
2727
2728def pool.close(p: Pool) -> IO(Unit):
2729 Pool{cap, idle} = p
2730 pool.close.go(Map.values(&1, List<&1, Conn>, idle))
2731
2732# RFC 9110 §9.2.2
2733def pool.idempotent(+method: String) -> Bool:
2734 Bool.or(String.eq(method, "GET"), Bool.or(String.eq(method, "HEAD"), Bool.or(String.eq(method, "OPTIONS"), Bool.or(String.eq(method, "TRACE"), Bool.or(String.eq(method, "PUT"), String.eq(method, "DELETE"))))))
2735
2736def conn.tls(m: Socket & Result<&1, &1, U32 & String, Unit>) -> IO(Result<&1, &1, Err, Conn>):
2737 (s, r) = m
2738 match r:
2739 case Fail{(+code, why)}:
2740 do IO<Result<&1, &1, Err, Conn>>:
2741 Wire.tls.close(s)
2742 return Fail{err.or_late(code, ErrTls{code, why})}
2743 case Done{u}:
2744 IO.pure(Result<&1, &1, Err, Conn>, Done{Conn{True{}, s}})
2745
2746def conn.h2.sent(client: H2.Client, r: Socket & Result<&1, &1, U32 & String, Unit>) -> IO(Result<&1, &1, Err, Conn>):
2747 (s, sent) = r
2748 match sent:
2749 case Fail{(+code, why)}:
2750 do IO<Result<&1, &1, Err, Conn>>:
2751 Wire.tls.close(s)
2752 return Fail{err.or_late(code, ErrWrite{code, why})}
2753 case Done{u}:
2754 IO.pure(Result<&1, &1, Err, Conn>, Done{ConnH2{s, client}})
2755
2756def conn.h2.start(s: Socket, r: H2.Client & HBytes.Bytes) -> IO(Result<&1, &1, Err, Conn>):
2757 (client, HBytes.Bytes{len, buf}) = r
2758 do IO<Result<&1, &1, Err, Conn>>:
2759 sent : Socket & Result<&1, &1, U32 & String, Unit> <- Wire.tls.send.words(s, len, buf)
2760 conn.h2.sent(client, sent)
2761
2762def conn.tls.protocol(proto: String, s: Socket) -> IO(Result<&1, &1, Err, Conn>):
2763 match proto:
2764 case "h2":
2765 conn.h2.start(s, H2.client.start())
2766 case "http/1.1":
2767 IO.pure(Result<&1, &1, Err, Conn>, Done{Conn{True{}, s}})
2768 case "":
2769 IO.pure(Result<&1, &1, Err, Conn>, Done{Conn{True{}, s}})
2770 case other:
2771 do IO<Result<&1, &1, Err, Conn>>:
2772 Wire.tls.close(s)
2773 return Fail{ErrTls{71, "unsupported ALPN: " ++ other}}
2774
2775def conn.tls.alpn(m: Socket & Result<&1, &1, U32 & String, String>) -> IO(Result<&1, &1, Err, Conn>):
2776 (s, r) = m
2777 match r:
2778 case Fail{(+code, why)}:
2779 do IO<Result<&1, &1, Err, Conn>>:
2780 Wire.tls.close(s)
2781 return Fail{err.or_late(code, ErrTls{code, why})}
2782 case Done{proto}:
2783 conn.tls.protocol(proto, s)
2784
2785def conn.secure.no.cert(offer: Bool, s: Socket, host: String, +ms: U32) ->
2786 IO(Result<&1, &1, Err, Conn>):
2787 match offer:
2788 case True{}:
2789 do IO<Result<&1, &1, Err, Conn>>:
2790 hs : Socket & Result<&1, &1, U32 & String, String> <-
2791 Wire.tls.connect.alpn(s, host, ms, "h2,http/1.1")
2792 conn.tls.alpn(hs)
2793 case False{}:
2794 do IO<Result<&1, &1, Err, Conn>>:
2795 hs : Socket & Result<&1, &1, U32 & String, Unit> <- Wire.tls.connect(s, host, ms)
2796 conn.tls(hs)
2797
2798def conn.secure.tls(cert: Maybe<&2, Cert>, s: Socket, host: String, +ms: U32,
2799 offer: Bool) -> IO(Result<&1, &1, Err, Conn>):
2800 match cert:
2801 case None{}:
2802 conn.secure.no.cert(offer, s, host, ms)
2803 case Some{Cert{chain, key}}:
2804 do IO<Result<&1, &1, Err, Conn>>:
2805 hs : Socket & Result<&1, &1, U32 & String, Unit> <-
2806 Wire.tls.connect.cert(s, host, ms, chain, key)
2807 conn.tls(hs)
2808
2809# A failed handshake is an error, never plaintext.
2810def conn.secure(+ms: U32, sni: String, s: Socket, tls: Bool,
2811 cert: Maybe<&2, Cert>, offer: Bool) -> IO(Result<&1, &1, Err, Conn>):
2812 match tls:
2813 case False{}:
2814 IO.pure(Result<&1, &1, Err, Conn>, Done{Conn{False{}, s}})
2815 case True{}:
2816 conn.secure.tls(cert, s, sni, ms, offer)
2817
2818def conn.made(+ms: U32, sni: String, tls: Bool, cert: Maybe<&2, Cert>,
2819 offer: Bool, r: Result<&1, &1, U32 & String, Socket>) ->
2820 IO(Result<&1, &1, Err, Conn>):
2821 match r:
2822 case Fail{(+code, why)}:
2823 IO.pure(Result<&1, &1, Err, Conn>, Fail{err.or_late(code, ErrConnect{code, why})})
2824 case Done{s}:
2825 conn.secure(ms, sni, s, tls, cert, offer)
2826
2827def conn.open(+tls: Bool, +ms: U32, sni: String, ip: String, port: U32) ->
2828 IO(Result<&1, &1, Err, Conn>):
2829 do IO<Result<&1, &1, Err, Conn>>:
2830 c : Result<&1, &1, U32 & String, Socket> <- Wire.connect(ip, port, ms)
2831 conn.made(ms, sni, tls, None{}, False{}, c)
2832
2833# ponytail: addresses are tried in order, not raced; a broken first route can consume the step timeout.
2834type Dial is Type:
2835 Dial{port: U32, ms: U32, deadline: Nat, action: IO(Result<&1, &1, U32 & String, Socket>)}
2836
2837def conn.dial.time(+ip: String, +port: U32, +deadline: Nat, now: Nat, expired: Bool) ->
2838 IO(Result<&1, &1, U32 & String, Socket>):
2839 match expired:
2840 case True{}:
2841 IO.pure(Result<&1, &1, U32 & String, Socket>, Fail{(60, "connect timeout")})
2842 case False{}:
2843 Wire.connect(ip, port, U32.from_nat(Nat.sub(deadline, now)))
2844
2845def conn.dial.with(+ip: String, +port: U32, +ms: U32, +deadline: Nat, +now: Nat, unlimited: Bool) ->
2846 IO(Result<&1, &1, U32 & String, Socket>):
2847 match unlimited:
2848 case True{}:
2849 Wire.connect(ip, port, 0)
2850 case False{}:
2851 conn.dial.time(ip, port, deadline, now, Nat.is_le(deadline, now))
2852
2853def conn.dial.try(+ip: String, +port: U32, +ms: U32, +deadline: Nat) ->
2854 IO(Result<&1, &1, U32 & String, Socket>):
2855 do IO<Result<&1, &1, U32 & String, Socket>>:
2856 now : Nat <- IO.now()
2857 conn.dial.with(ip, port, ms, deadline, now, U32.is_zero(ms))
2858
2859def conn.dial.after(r: Result<&1, &1, U32 & String, Socket>, ip: String, +port: U32, +ms: U32, +deadline: Nat) ->
2860 IO(Result<&1, &1, U32 & String, Socket>):
2861 match r:
2862 case Done{s}:
2863 IO.pure(Result<&1, &1, U32 & String, Socket>, Done{s})
2864 case Fail{e}:
2865 conn.dial.try(ip, port, ms, deadline)
2866
2867def conn.dial.more(prev: IO(Result<&1, &1, U32 & String, Socket>), ip: String, +port: U32, +ms: U32, +deadline: Nat) ->
2868 IO(Result<&1, &1, U32 & String, Socket>):
2869 do IO<Result<&1, &1, U32 & String, Socket>>:
2870 r : Result<&1, &1, U32 & String, Socket> <- prev
2871 conn.dial.after(r, ip, port, ms, deadline)
2872
2873def conn.dial.fold(d: Dial, ip: String) -> Dial:
2874 Dial{+port, +ms, +deadline, action} = d
2875 Dial{port, ms, deadline, conn.dial.more(action, ip, port, ms, deadline)}
2876
2877def conn.dial.run(d: Dial) -> IO(Result<&1, &1, U32 & String, Socket>):
2878 Dial{port, ms, deadline, action} = d
2879 action
2880
2881def conn.dial.all(+port: U32, +ms: U32, +start: Nat, first: String, rest: List<&2, String>) ->
2882 IO(Result<&1, &1, U32 & String, Socket>):
2883 match rest:
2884 case Nil{}:
2885 Wire.connect(first, port, ms)
2886 case Con{ip, tail}:
2887 +deadline = Nat.add(start, U32.to_nat(ms))
2888 conn.dial.run(List.foldl(~&2, ~String, ~Dial, ~conn.dial.fold, Con{ip, tail},
2889 Dial{port, ms, deadline, Wire.connect(first, port, ms)}))
2890
2891def conn.open.all(+tls: Bool, +ms: U32, +host: String, +port: U32,
2892 ips: List<&2, String>, cert: Maybe<&2, Cert>, offer: Bool) ->
2893 IO(Result<&1, &1, Err, Conn>):
2894 match ips:
2895 case Nil{}:
2896 IO.pure(Result<&1, &1, Err, Conn>, Fail{ErrDns{}})
2897 case Con{addr, rest}:
2898 do IO<Result<&1, &1, Err, Conn>>:
2899 start : Nat <- IO.now()
2900 r : Result<&1, &1, U32 & String, Socket> <- conn.dial.all(port, ms, start, addr, rest)
2901 conn.made(ms, host, tls, cert, offer, r)
2902
2903def proxy.auth.safe(s: String) -> Bool:
2904 match s:
2905 case SNil{}:
2906 True{}
2907 case SCon{Chr{+c}, rest}:
2908 Bool.and(U32.is_ge(c, 32), Bool.and(U32.is_ne(c, 127), proxy.auth.safe(rest)))
2909
2910def proxy.auth.checked(+decoded: String, valid: Bool) -> Maybe<&2, String>:
2911 match valid:
2912 case False{}:
2913 None{}
2914 case True{}:
2915 Some{"Basic " ++ Bytes.to_base64(Bytes.from_string(decoded))}
2916
2917def proxy.auth.value(m: Maybe<&2, String>) -> Maybe<&2, String>:
2918 match m:
2919 case None{}:
2920 None{}
2921 case Some{+decoded}:
2922 proxy.auth.checked(decoded, Bool.and(Url.has(decoded, 58), proxy.auth.safe(decoded)))
2923
2924def proxy.from.abs(authorization: String, m: Maybe<&2, Url.Abs>) -> Maybe<&2, Proxy>:
2925 match m:
2926 case None{}:
2927 None{}
2928 case Some{Url.Abs{scheme, host, port, target}}:
2929 Some{ProxyVia{host, port, authorization}}
2930
2931def proxy.from.user(user: String, host: String) -> Maybe<&2, Proxy>:
2932 do Maybe<&2, Proxy>:
2933 authorization : String <- proxy.auth.value(Url.pct.decode(user))
2934 proxy.from.abs(authorization, Url.absolute("http://" ++ host))
2935
2936def proxy.from.authority(has_user: Bool, authority: String, split: String & String) ->
2937 Maybe<&2, Proxy>:
2938 match has_user:
2939 case False{}:
2940 proxy.from.abs("", Url.absolute("http://" ++ authority))
2941 case True{}:
2942 (user, host) = split
2943 proxy.from.user(user, host)
2944
2945def proxy.from.parts(parts: String & String) -> Maybe<&2, Proxy>:
2946 (+authority, path) = parts
2947 match path:
2948 case SNil{}:
2949 proxy.from.authority(Url.has(authority, 64), authority, Url.take_to(authority, 64))
2950 case other:
2951 None{}
2952
2953def proxy.from.url.if(valid: Bool, raw: String) -> Maybe<&2, Proxy>:
2954 match valid:
2955 case False{}:
2956 None{}
2957 case True{}:
2958 proxy.from.parts(Url.take_to(String.drop(raw, 7n), 47))
2959
2960def proxy.from.url(+raw: String) -> Maybe<&2, Proxy>:
2961 proxy.from.url.if(String.starts_with(String.to_lower(raw), "http://"), raw)
2962
2963def proxy.no.domain(+host: String, +suffix: String) -> Bool:
2964 Bool.or(String.eq(host, suffix), String.ends_with(host, "." ++ suffix))
2965
2966def proxy.no.suffix(+host: String, +raw: String) -> Bool:
2967 match raw:
2968 case SCon{Chr{46}, +suffix}:
2969 proxy.no.domain(host, suffix)
2970 case other:
2971 proxy.no.domain(host, raw)
2972
2973def proxy.no.port(valid: Bool, +host: String, suffix: String) -> Bool:
2974 match valid:
2975 case False{}:
2976 False{}
2977 case True{}:
2978 proxy.no.suffix(host, suffix)
2979
2980def proxy.no.named(+host: String, +port: U32, parts: String & String) -> Bool:
2981 (suffix, port_text) = parts
2982 match port_text:
2983 case SNil{}:
2984 proxy.no.suffix(host, suffix)
2985 case other:
2986 proxy.no.port(String.eq(port_text, U32.show(port)), host, suffix)
2987
2988def proxy.no.literal(+host: String, +port: U32, +name: String) -> Bool:
2989 Bool.or(String.eq(name, host), Bool.or(String.eq(name, "[" ++ host ++ "]"),
2990 Bool.or(String.eq(name, host ++ ":" ++ U32.show(port)),
2991 String.eq(name, "[" ++ host ++ "]:" ++ U32.show(port)))))
2992
2993def proxy.no.token(+host: String, +port: U32, token: String) -> Bool:
2994 +name = String.to_lower(trim(token))
2995 Bool.or(String.eq(name, "*"),
2996 Bool.or(proxy.no.literal(host, port, name),
2997 Bool.and(Bool.not(Url.has(host, 58)),
2998 proxy.no.named(host, port, Url.take_to(name, 58)))))
2999
3000def proxy.no.list(xs: List<&2, String>, +host: String, +port: U32) -> Bool:
3001 match xs:
3002 case Nil{}:
3003 False{}
3004 case Con{token, rest}:
3005 Bool.or(proxy.no.token(host, port, token), proxy.no.list(rest, host, port))
3006
3007def proxy.no_match(+host: String, +port: U32, no_proxy: String) -> Bool:
3008 proxy.no.list(String.split(no_proxy, ','), String.to_lower(host), port)
3009
3010def proxy.env.value(r: Result<&1, &1, U32 & String, String>) -> String:
3011 match r:
3012 case Fail{e}:
3013 ""
3014 case Done{value}:
3015 value
3016
3017def proxy.env.lower(r: Result<&1, &1, U32 & String, String>, upper: String) ->
3018 IO(String):
3019 match r:
3020 case Done{value}:
3021 IO.pure(String, value)
3022 case Fail{e}:
3023 do IO<String>:
3024 got : Result<&1, &1, U32 & String, String> <- IO.get_env(upper)
3025 return proxy.env.value(got)
3026
3027def proxy.env(lower: String, upper: String) -> IO(String):
3028 do IO<String>:
3029 got : Result<&1, &1, U32 & String, String> <- IO.get_env(lower)
3030 proxy.env.lower(got, upper)
3031
3032def proxy.from.env(value: String) -> Maybe<&2, Proxy>:
3033 match value:
3034 case SNil{}:
3035 Some{ProxyDirect{}}
3036 case other:
3037 proxy.from.url(value)
3038
3039def proxy.choose(bypass: Bool, value: String) -> Maybe<&2, Proxy>:
3040 match bypass:
3041 case True{}:
3042 Some{ProxyDirect{}}
3043 case False{}:
3044 proxy.from.env(value)
3045
3046def proxy.select(+scheme: String, +host: String, +port: U32) ->
3047 IO(Maybe<&2, Proxy>):
3048 +secure = String.eq(scheme, "https")
3049 do IO<Maybe<&2, Proxy>>:
3050 bypass : String <- proxy.env("no_proxy", "NO_PROXY")
3051 value : String <- proxy.env(Bool.pick(String, secure, "https_proxy", "http_proxy"),
3052 Bool.pick(String, secure, "HTTPS_PROXY", "HTTP_PROXY"))
3053 return proxy.choose(proxy.no_match(host, port, bypass), value)
3054
3055def h2.header.skip(+name: String) -> Bool:
3056 match name:
3057 case SCon{Chr{58}, rest}:
3058 True{}
3059 case other:
3060 Bool.or(req.reserved(name),
3061 Bool.or(String.eq(name, "keep-alive"),
3062 Bool.or(String.eq(name, "proxy-connection"),
3063 Bool.or(String.eq(name, "upgrade"), String.eq(name, "te")))))
3064
3065def h2.header.mode(+name: String) -> U32:
3066 Bool.pick(U32,
3067 Bool.or(String.eq(name, "authorization"),
3068 Bool.or(String.eq(name, "cookie"), String.eq(name, "proxy-authorization"))),
3069 2, 0)
3070
3071def h2.header.values(+name: String, +mode: U32, vs: List<&2, String>) -> List<&2, Hpack.Field>:
3072 match vs:
3073 case Nil{}:
3074 Nil{}
3075 case Con{v, tail}:
3076 Hpack.Field{name, sanitize(v), mode} <> h2.header.values(name, mode, tail)
3077
3078def h2.header.tokens(vs: List<&2, String>) -> List<&2, String>:
3079 match vs:
3080 case Nil{}:
3081 Nil{}
3082 case Con{value, rest}:
3083 List.append(&2, String, String.split(value, ','), h2.header.tokens(rest))
3084
3085def h2.header.nominated.one(enabled: Bool, vs: List<&2, String>,
3086 rest: List<&2, String>) -> List<&2, String>:
3087 match enabled:
3088 case True{}:
3089 List.append(&2, String, h2.header.tokens(vs), rest)
3090 case False{}:
3091 rest
3092
3093def h2.header.nominated(xs: List<&2, Sigma<&2, &2, String, _ => List<&2, String>>>) ->
3094 List<&2, String>:
3095 match xs:
3096 case Nil{}:
3097 Nil{}
3098 case (name, values) <> tail:
3099 h2.header.nominated.one(String.eq(String.to_lower(name), "connection"),
3100 values, h2.header.nominated(tail))
3101
3102def h2.header.has(xs: List<&2, String>, +key: String) -> Bool:
3103 match xs:
3104 case Nil{}:
3105 False{}
3106 case Con{value, rest}:
3107 Bool.or(String.eq(String.to_lower(trim(value)), key), h2.header.has(rest, key))
3108
3109def h2.header.item(skip: Bool, +name: String, vs: List<&2, String>,
3110 tail: List<&2, Hpack.Field>) -> List<&2, Hpack.Field>:
3111 match skip:
3112 case True{}:
3113 tail
3114 case False{}:
3115 List.append(&2, Hpack.Field, h2.header.values(name, h2.header.mode(name), vs), tail)
3116
3117def h2.header.items(xs: List<&2, Sigma<&2, &2, String, _ => List<&2, String>>>,
3118 +nominated: List<&2, String>) -> List<&2, Hpack.Field>:
3119 match xs:
3120 case Nil{}:
3121 Nil{}
3122 case (name, values) <> tail:
3123 +key = String.to_lower(name)
3124 h2.header.item(Bool.or(h2.header.skip(key), h2.header.has(nominated, key)),
3125 key, values, h2.header.items(tail, nominated))
3126
3127def h2.request.fields(+method: String, target: String, authority: String,
3128 headers: Map<&2, List<&2, String>>) -> List<&2, Hpack.Field>:
3129 +xs = Map.to_list(&2, List<&2, String>, headers)
3130 List.append(&2, Hpack.Field,
3131 [Hpack.Field{":method", method, 0}, Hpack.Field{":scheme", "https", 0},
3132 Hpack.Field{":authority", authority, 0}, Hpack.Field{":path", target, 0}],
3133 h2.header.items(xs, h2.header.nominated(xs)))
3134
3135def h2.response.status.value(+value: String, valid: Bool) -> Maybe<&2, U32>:
3136 match valid:
3137 case False{}:
3138 None{}
3139 case True{}:
3140 parse_u32(value)
3141
3142def h2.response.status(xs: List<&2, Hpack.Field>) -> Maybe<&2, U32>:
3143 match xs:
3144 case Nil{}:
3145 None{}
3146 case Con{Hpack.Field{name, +value, mode}, tail}:
3147 match name:
3148 case ":status":
3149 h2.response.status.value(value, Nat.is_eq(String.length(value), 3n))
3150 case other:
3151 h2.response.status(tail)
3152
3153def h2.response.headers(xs: List<&2, Hpack.Field>, acc: Map<&2, List<&2, String>>) ->
3154 Map<&2, List<&2, String>>:
3155 match xs:
3156 case Nil{}:
3157 acc
3158 case Con{Hpack.Field{name, value, mode}, tail}:
3159 match name:
3160 case SCon{Chr{58}, rest}:
3161 h2.response.headers(tail, acc)
3162 case other:
3163 h2.response.headers(tail, add(acc, String.to_lower(name), value))
3164
3165def h2.response.final(interim: Bool, +status: U32, headers: List<&2, Hpack.Field>,
3166 body: HBytes.Bytes) -> Result<&1, &1, Err, Maybe<&1, Res>>:
3167 match interim:
3168 case True{}:
3169 Done{None{}}
3170 case False{}:
3171 HBytes.Bytes{len, buf} = body
3172 Done{Some{Res{status, h2.response.headers(headers, empty()), Bytes.Bytes{len, buf}}}}
3173
3174def h2.response.valid(valid: Bool, +status: U32, headers: List<&2, Hpack.Field>,
3175 body: HBytes.Bytes) -> Result<&1, &1, Err, Maybe<&1, Res>>:
3176 match valid:
3177 case False{}:
3178 Fail{ErrBad{}}
3179 case True{}:
3180 h2.response.final(U32.is_lt(status, 200), status, headers, body)
3181
3182def h2.response.parsed(m: Maybe<&2, U32>, headers: List<&2, Hpack.Field>,
3183 body: HBytes.Bytes) -> Result<&1, &1, Err, Maybe<&1, Res>>:
3184 match m:
3185 case None{}:
3186 Fail{ErrBad{}}
3187 case Some{+status}:
3188 h2.response.valid(Bool.and(U32.is_ge(status, 100), U32.is_lt(status, 600)),
3189 status, headers, body)
3190
3191def h2.response(+fields: List<&2, Hpack.Field>, body: HBytes.Bytes) ->
3192 Result<&1, &1, Err, Maybe<&1, Res>>:
3193 h2.response.parsed(h2.response.status(fields), fields, body)
3194
3195def h2.event.fold(acc: Result<&1, &1, Err, Maybe<&1, Res>>,
3196 event: H2.ClientEvent) -> Result<&1, &1, Err, Maybe<&1, Res>>:
3197 match acc:
3198 case Fail{e}:
3199 Fail{e}
3200 case Done{Some{res}}:
3201 Done{Some{res}}
3202 case Done{None{}}:
3203 match event:
3204 case H2.Response{id, headers, body}:
3205 h2.response(headers, body)
3206 case H2.Reset{id, code}:
3207 Fail{ErrBad{}}
3208 case H2.Shutdown{last, code}:
3209 Done{None{}}
3210 case H2.Pong{data}:
3211 Done{None{}}
3212
3213def h2.send.report(r: Socket & Result<&1, &1, U32 & String, Unit>) ->
3214 IO(Result<&1, &1, Err, Socket>):
3215 (s, sent) = r
3216 match sent:
3217 case Fail{(+code, why)}:
3218 do IO<Result<&1, &1, Err, Socket>>:
3219 Wire.tls.close(s)
3220 return Fail{err.or_late(code, ErrWrite{code, why})}
3221 case Done{unit}:
3222 IO.pure(Result<&1, &1, Err, Socket>, Done{s})
3223
3224def h2.send.one(prev: Result<&1, &1, Err, Socket>, b: HBytes.Bytes) ->
3225 IO(Result<&1, &1, Err, Socket>):
3226 match prev:
3227 case Fail{e}:
3228 IO.pure(Result<&1, &1, Err, Socket>, Fail{e})
3229 case Done{s}:
3230 HBytes.Bytes{len, buf} = b
3231 do IO<Result<&1, &1, Err, Socket>>:
3232 sent : Socket & Result<&1, &1, U32 & String, Unit> <- Wire.tls.send.words(s, len, buf)
3233 h2.send.report(sent)
3234
3235def h2.send.fold(prev: IO(Result<&1, &1, Err, Socket>), b: HBytes.Bytes) ->
3236 IO(Result<&1, &1, Err, Socket>):
3237 do IO<Result<&1, &1, Err, Socket>>:
3238 r : Result<&1, &1, Err, Socket> <- prev
3239 h2.send.one(r, b)
3240
3241def h2.send(xs: List<&1, HBytes.Bytes>, s: Socket) -> IO(Result<&1, &1, Err, Socket>):
3242 List.foldl(~&1, ~HBytes.Bytes, ~IO(Result<&1, &1, Err, Socket>), ~h2.send.fold,
3243 xs, IO.pure(Result<&1, &1, Err, Socket>, Done{s}))
3244
3245def h2.received.step(over: Bool, s: Socket, client: H2.Client,
3246 +len: U32, buf: Array<U32>) -> H2Step:
3247 match over:
3248 case True{}:
3249 H2Reply{s, H2.Failed{H2.Error{1, True{}, 0}}}
3250 case False{}:
3251 H2Reply{s, H2.client.receive(client, HBytes.Bytes{len, buf})}
3252
3253def h2.fail(s: Socket, e: Err) -> IO(Result<&1, &1, Err, Conn & Res>):
3254 do IO<Result<&1, &1, Err, Conn & Res>>:
3255 Wire.tls.close(s)
3256 return Fail{e}
3257
3258def h2.loop(n: Nat, step: H2Step, +ms: U32, +used: U32) ->
3259 IO(Result<&1, &1, Err, Conn & Res>):
3260 match n:
3261 case 0n:
3262 match step:
3263 case H2Reply{s, reply}:
3264 h2.fail(s, ErrBad{})
3265 case H2Sent{client, events, sent}:
3266 match sent:
3267 case Fail{e}:
3268 IO.pure(Result<&1, &1, Err, Conn & Res>, Fail{e})
3269 case Done{s}:
3270 h2.fail(s, ErrBad{})
3271 case H2Events{s, client, result}:
3272 h2.fail(s, ErrBad{})
3273 case H2Received{client, answer}:
3274 (s, r) = answer
3275 h2.fail(s, ErrBad{})
3276 case 1n+p:
3277 match step:
3278 case H2Reply{s, reply}:
3279 match reply:
3280 case H2.Failed{error}:
3281 h2.fail(s, ErrBad{})
3282 case H2.Ready{client, writes, events}:
3283 do IO<Result<&1, &1, Err, Conn & Res>>:
3284 sent : Result<&1, &1, Err, Socket> <- h2.send(writes, s)
3285 h2.loop(p, H2Sent{client, events, sent}, ms, used)
3286 case H2Sent{client, events, sent}:
3287 match sent:
3288 case Fail{e}:
3289 IO.pure(Result<&1, &1, Err, Conn & Res>, Fail{e})
3290 case Done{s}:
3291 h2.loop(p, H2Events{s, client,
3292 List.foldl(~&1, ~H2.ClientEvent,
3293 ~Result<&1, &1, Err, Maybe<&1, Res>>, ~h2.event.fold,
3294 events, Done{None{}})}, ms, used)
3295 case H2Events{s, client, result}:
3296 match result:
3297 case Fail{e}:
3298 h2.fail(s, e)
3299 case Done{Some{res}}:
3300 IO.pure(Result<&1, &1, Err, Conn & Res>,
3301 Done{(ConnH2{s, client}, res)})
3302 case Done{None{}}:
3303 do IO<Result<&1, &1, Err, Conn & Res>>:
3304 r : Socket & Result<&1, &1, U32 & String, U32 & Array<U32>> <-
3305 Wire.tls.recv.words(s, 16384, ms)
3306 h2.loop(p, H2Received{client, r}, ms, used)
3307 case H2Received{client, answer}:
3308 match answer:
3309 case (s, Fail{(+code, why)}):
3310 h2.fail(s, err.or_late(code, ErrRead{code, why}))
3311 case (s, Done{(0, buf)}):
3312 h2.fail(s, ErrBad{})
3313 case (s, Done{(+len, buf)}):
3314 +total = (used + len : U32)
3315 h2.loop(p, h2.received.step(fetch.over(total), s, client, len, buf), ms, total)
3316
3317def h2.exchange(s: Socket, client: H2.Client, +ms: U32, request: Send) ->
3318 IO(Result<&1, &1, Err, Conn & Res>):
3319 Send{method, target, authority, headers, Bytes.Bytes{len, buf}} = request
3320 h2.loop(Nat.mul(4n, Nat.add(fetch.max(), 65536n)),
3321 H2Reply{s, H2.client.request(client,
3322 h2.request.fields(method, target, authority, headers), HBytes.Bytes{len, buf})},
3323 ms, 0)
3324
3325def proxy.connect.fail(s: Socket, e: Err) -> IO(Result<&1, &1, Err, Conn>):
3326 do IO<Result<&1, &1, Err, Conn>>:
3327 io.close(False{}, s)
3328 return Fail{e}
3329
3330def proxy.connect.extra(m: Maybe<&2, String>, s: Socket, +ms: U32,
3331 sni: String, cert: Maybe<&2, Cert>) -> IO(Result<&1, &1, Err, Conn>):
3332 match m:
3333 case None{}:
3334 proxy.connect.fail(s, ErrBad{})
3335 case Some{rest}:
3336 match rest:
3337 case SNil{}:
3338 conn.secure(ms, sni, s, True{}, cert, True{})
3339 case other:
3340 proxy.connect.fail(s, ErrBad{})
3341
3342def proxy.connect.status(ok: Bool, +status: U32, raw: String, s: Socket,
3343 +ms: U32, sni: String, cert: Maybe<&2, Cert>) ->
3344 IO(Result<&1, &1, Err, Conn>):
3345 match ok:
3346 case False{}:
3347 proxy.connect.fail(s, ErrConnect{status, "proxy CONNECT refused"})
3348 case True{}:
3349 proxy.connect.extra(after(raw, True{}), s, ms, sni, cert)
3350
3351def proxy.connect.finish(res: Res, raw: String, s: Socket, +ms: U32,
3352 sni: String, cert: Maybe<&2, Cert>) -> IO(Result<&1, &1, Err, Conn>):
3353 Res{+status, headers, body} = res
3354 proxy.connect.status(Bool.and(U32.is_ge(status, 200), U32.is_lt(status, 300)),
3355 status, raw, s, ms, sni, cert)
3356
3357def proxy.connect.frame(raw: String, over: Bool) -> Frame:
3358 match over:
3359 case True{}:
3360 FrameBad{}
3361 case False{}:
3362 frame(raw, False{}, True{})
3363
3364def proxy.connect.chunk(empty: Bool, s: Socket, raw: String,
3365 +len: U32, buf: Array<U32>) -> TunnelStep:
3366 match empty:
3367 case True{}:
3368 TunnelHead{s, raw, FrameBad{}}
3369 case False{}:
3370 TunnelRead{s, raw ++ Bytes.to_string(Bytes.Bytes{len, buf})}
3371
3372def proxy.connect.loop(n: Nat, step: TunnelStep, +ms: U32, +sni: String,
3373 +cert: Maybe<&2, Cert>) -> IO(Result<&1, &1, Err, Conn>):
3374 match n:
3375 case 0n:
3376 match step:
3377 case TunnelRead{s, raw}:
3378 proxy.connect.fail(s, ErrBad{})
3379 case TunnelHead{s, raw, result}:
3380 proxy.connect.fail(s, ErrBad{})
3381 case TunnelGot{raw, answer}:
3382 (s, result) = answer
3383 proxy.connect.fail(s, ErrBad{})
3384 case 1n+p:
3385 match step:
3386 case TunnelRead{s, +raw}:
3387 proxy.connect.loop(p, TunnelHead{s, raw,
3388 proxy.connect.frame(raw, Nat.is_gt(String.length(raw), 65536n))},
3389 ms, sni, cert)
3390 case TunnelHead{s, raw, result}:
3391 match result:
3392 case FrameBad{}:
3393 proxy.connect.fail(s, ErrBad{})
3394 case FrameMore{}:
3395 do IO<Result<&1, &1, Err, Conn>>:
3396 answer : Socket & Result<&1, &1, U32 & String, U32 & Array<U32>> <-
3397 io.recv.words(False{}, s, 4096, ms)
3398 proxy.connect.loop(p, TunnelGot{raw, answer}, ms, sni, cert)
3399 case FrameDone{res}:
3400 proxy.connect.finish(res, raw, s, ms, sni, cert)
3401 case TunnelGot{raw, answer}:
3402 match answer:
3403 case (s, Fail{(+code, why)}):
3404 proxy.connect.fail(s, err.or_late(code, ErrRead{code, why}))
3405 case (s, Done{(+len, buf)}):
3406 proxy.connect.loop(p,
3407 proxy.connect.chunk(U32.is_zero(len), s, raw, len, buf),
3408 ms, sni, cert)
3409
3410def proxy.connect.header(+authority: String, authorization: String) -> String:
3411 match authorization:
3412 case SNil{}:
3413 "CONNECT " ++ authority ++ " HTTP/1.1\r\nHost: " ++ authority ++ "\r\n\r\n"
3414 case other:
3415 "CONNECT " ++ authority ++ " HTTP/1.1\r\nHost: " ++ authority
3416 ++ "\r\nProxy-Authorization: " ++ authorization ++ "\r\n\r\n"
3417
3418def proxy.connect.sent(r: Socket & Result<&1, &1, U32 & String, Unit>,
3419 +ms: U32, sni: String, cert: Maybe<&2, Cert>) ->
3420 IO(Result<&1, &1, Err, Conn>):
3421 (s, sent) = r
3422 match sent:
3423 case Fail{(+code, why)}:
3424 proxy.connect.fail(s, err.or_late(code, ErrWrite{code, why}))
3425 case Done{unit}:
3426 proxy.connect.loop(Nat.mul(3n, 65536n), TunnelRead{s, ""}, ms, sni, cert)
3427
3428def proxy.connect(s: Socket, +ms: U32, sni: String, authority: String,
3429 authorization: String, cert: Maybe<&2, Cert>) ->
3430 IO(Result<&1, &1, Err, Conn>):
3431 do IO<Result<&1, &1, Err, Conn>>:
3432 sent : Socket & Result<&1, &1, U32 & String, Unit> <-
3433 io.send.bytes(False{}, s, Bytes.from_string(proxy.connect.header(authority, authorization)))
3434 proxy.connect.sent(sent, ms, sni, cert)
3435
3436def proxy.route.tls(tls: Bool, s: Socket, +ms: U32, sni: String,
3437 authority: String, authorization: String, cert: Maybe<&2, Cert>) ->
3438 IO(Result<&1, &1, Err, Conn>):
3439 match tls:
3440 case False{}:
3441 IO.pure(Result<&1, &1, Err, Conn>, Done{Conn{False{}, s}})
3442 case True{}:
3443 proxy.connect(s, ms, sni, authority, authorization, cert)
3444
3445def proxy.route.connected(tls: Bool, +ms: U32, sni: String, authority: String,
3446 authorization: String, cert: Maybe<&2, Cert>,
3447 r: Result<&1, &1, Err, Conn>) -> IO(Result<&1, &1, Err, Conn>):
3448 match r:
3449 case Fail{e}:
3450 IO.pure(Result<&1, &1, Err, Conn>, Fail{e})
3451 case Done{c}:
3452 match c:
3453 case Conn{plain, s}:
3454 proxy.route.tls(tls, s, ms, sni, authority, authorization, cert)
3455 case ConnH2{s, client}:
3456 do IO<Result<&1, &1, Err, Conn>>:
3457 Wire.tls.close(s)
3458 return Fail{ErrBad{}}
3459
3460def proxy.route.open(+ms: U32, +tls: Bool, +host: String, +port: U32,
3461 +sni: String, +authority: String, +authorization: String,
3462 cert: Maybe<&2, Cert>) -> IO(Result<&1, &1, Err, Conn>):
3463 do IO<Result<&1, &1, Err, Conn>>:
3464 ips : List<&2, String> <- Dns.resolve.all(host)
3465 conn : Result<&1, &1, Err, Conn> <-
3466 conn.open.all(False{}, ms, host, port, ips, None{}, False{})
3467 proxy.route.connected(tls, ms, sni, authority, authorization, cert, conn)
3468
3469def route.open(+ms: U32, route: Route) -> IO(Result<&1, &1, Err, Conn>):
3470 match route:
3471 case RouteDirect{tls, +host, port, cert}:
3472 do IO<Result<&1, &1, Err, Conn>>:
3473 ips : List<&2, String> <- Dns.resolve.all(host)
3474 conn.open.all(tls, ms, host, port, ips, cert, True{})
3475 case RouteProxy{tls, host, port, sni, authority, authorization, cert}:
3476 proxy.route.open(ms, tls, host, port, sni, authority, authorization, cert)
3477
3478def conn.ex.h1(+tls: Bool, s: Socket, +ms: U32, request: Send) -> IO(Out):
3479 Send{+method, target, authority, headers, body} = request
3480 exchange.go(tls, ms, False{}, String.eq(method, "HEAD"), s,
3481 encode_req.on(method, target, authority, headers, body, False{}))
3482
3483# A socket with bytes past the response is out of step with the server, so it is closed.
3484def pool.keep.s(p: Pool, +key: String, +tls: Bool, res: Res, s: Socket, clean: Bool) -> IO(Pool & Result<&1, &1, Err, Res>):
3485 match clean:
3486 case True{}:
3487 do IO<Pool & Result<&1, &1, Err, Res>>:
3488 p2 : Pool <- pool.give(p, key, Conn{tls, s})
3489 return (p2, Done{res})
3490 case False{}:
3491 do IO<Pool & Result<&1, &1, Err, Res>>:
3492 io.close(tls, s)
3493 return (p, Done{res})
3494
3495def pool.keep.m(p: Pool, +key: String, +tls: Bool, res: Res, +clean: Bool, sock: Maybe<&1, Socket>) -> IO(Pool & Result<&1, &1, Err, Res>):
3496 match sock:
3497 case None{}:
3498 IO.pure(Pool & Result<&1, &1, Err, Res>, (p, Done{res}))
3499 case Some{s}:
3500 pool.keep.s(p, key, tls, res, s, clean)
3501
3502def pool.keep(p: Pool, +key: String, +tls: Bool, res: Res, sock: Maybe<&1, Socket>, rest: Bytes.Bytes) -> IO(Pool & Result<&1, &1, Err, Res>):
3503 Bytes.Bytes{+len, buf} = rest
3504 pool.keep.m(p, key, tls, res, U32.is_zero(len), sock)
3505
3506def pool.after(p: Pool, +key: String, +tls: Bool, o: Out) -> IO(Pool & Result<&1, &1, Err, Res>):
3507 match o:
3508 case OutFail{e, none}:
3509 IO.pure(Pool & Result<&1, &1, Err, Res>, (p, Fail{e}))
3510 case OutDone{res, sock, rest}:
3511 pool.keep(p, key, tls, res, sock, rest)
3512
3513def pool.h2.reusable(c: Conn) -> Bool & Conn:
3514 match c:
3515 case Conn{tls, s}:
3516 (True{}, Conn{tls, s})
3517 case ConnH2{s, H2.Client{input, streams, encoder, decoder, +control}}:
3518 H2.Control{next, active, frame_max, initial, max_streams, send_window,
3519 recv_window, first, ack, continuation, +goaway} = control
3520 (Maybe.is_none(&2, U32, goaway),
3521 ConnH2{s, H2.Client{input, streams, encoder, decoder, control}})
3522
3523def pool.h2.keep(p: Pool, +key: String, res: Res, state: Bool & Conn) ->
3524 IO(Pool & Result<&1, &1, Err, Res>):
3525 (reusable, c) = state
3526 match reusable:
3527 case True{}:
3528 do IO<Pool & Result<&1, &1, Err, Res>>:
3529 next : Pool <- pool.give(p, key, c)
3530 return (next, Done{res})
3531 case False{}:
3532 do IO<Pool & Result<&1, &1, Err, Res>>:
3533 conn.close(c)
3534 return (p, Done{res})
3535
3536def pool.h2.result(p: Pool, +key: String, r: Result<&1, &1, Err, Conn & Res>) ->
3537 IO(Pool & Result<&1, &1, Err, Res>):
3538 match r:
3539 case Fail{e}:
3540 IO.pure(Pool & Result<&1, &1, Err, Res>, (p, Fail{e}))
3541 case Done{(c, res)}:
3542 pool.h2.keep(p, key, res, pool.h2.reusable(c))
3543
3544def pool.h2.ex(p: Pool, +key: String, +ms: U32, request: Send,
3545 s: Socket, client: H2.Client) -> IO(Pool & Result<&1, &1, Err, Res>):
3546 do IO<Pool & Result<&1, &1, Err, Res>>:
3547 r : Result<&1, &1, Err, Conn & Res> <- h2.exchange(s, client, ms, request)
3548 pool.h2.result(p, key, r)
3549
3550def pool.fresh.conn(p: Pool, +key: String, +ms: U32, request: Send,
3551 r: Result<&1, &1, Err, Conn>) -> IO(Pool & Result<&1, &1, Err, Res>):
3552 match r:
3553 case Fail{e}:
3554 IO.pure(Pool & Result<&1, &1, Err, Res>, (p, Fail{e}))
3555 case Done{c}:
3556 match c:
3557 case Conn{+tls, s}:
3558 do IO<Pool & Result<&1, &1, Err, Res>>:
3559 o : Out <- conn.ex.h1(tls, s, ms, request)
3560 pool.after(p, key, tls, o)
3561 case ConnH2{s, client}:
3562 pool.h2.ex(p, key, ms, request, s, client)
3563
3564def pool.fresh(p: Pool, +key: String, +ms: U32, request: Send, route: Route) ->
3565 IO(Pool & Result<&1, &1, Err, Res>):
3566 do IO<Pool & Result<&1, &1, Err, Res>>:
3567 c : Result<&1, &1, Err, Conn> <- route.open(ms, route)
3568 pool.fresh.conn(p, key, ms, request, c)
3569
3570# A reused socket the server already closed fails before any response byte.
3571def pool.retry(+none: Bool, +idem: Bool) -> Bool:
3572 Bool.and(none, idem)
3573
3574def pool.stale(p: Pool, +key: String, +ms: U32, request: Send,
3575 e: Err, again: Bool, route: Route) ->
3576 IO(Pool & Result<&1, &1, Err, Res>):
3577 match again:
3578 case True{}:
3579 pool.fresh(p, key, ms, request, route)
3580 case False{}:
3581 IO.pure(Pool & Result<&1, &1, Err, Res>, (p, Fail{e}))
3582
3583def pool.reused(p: Pool, +key: String, +tls: Bool, +ms: U32, +idem: Bool,
3584 spare: Send, o: Out, route: Route) ->
3585 IO(Pool & Result<&1, &1, Err, Res>):
3586 match o:
3587 case OutFail{e, +none}:
3588 pool.stale(p, key, ms, spare, e, pool.retry(none, idem), route)
3589 case OutDone{res, sock, rest}:
3590 pool.keep(p, key, tls, res, sock, rest)
3591
3592# Copy only the reused HTTP/1.1 request body, for a stale-socket retry.
3593def pool.idle.h1.bodies(p: Pool, +key: String, +tls: Bool, +ms: U32, +idem: Bool,
3594 s: Socket, +method: String, +target: String, +authority: String,
3595 +headers: Map<&2, List<&2, String>>, r: Bytes.Bytes & Bytes.Bytes,
3596 route: Route) -> IO(Pool & Result<&1, &1, Err, Res>):
3597 (wire, spare) = r
3598 do IO<Pool & Result<&1, &1, Err, Res>>:
3599 o : Out <- conn.ex.h1(tls, s, ms, Send{method, target, authority, headers, wire})
3600 pool.reused(p, key, tls, ms, idem,
3601 Send{method, target, authority, headers, spare}, o, route)
3602
3603def pool.idle.h1(p: Pool, +key: String, +tls: Bool, +ms: U32, +idem: Bool,
3604 s: Socket, request: Send, route: Route) ->
3605 IO(Pool & Result<&1, &1, Err, Res>):
3606 Send{+method, +target, +authority, +headers, body} = request
3607 pool.idle.h1.bodies(p, key, tls, ms, idem, s, method, target,
3608 authority, headers, Bytes.slice(body, 0, 4294967295), route)
3609
3610def pool.idle.reuse(p: Pool, +key: String, +ms: U32, +idem: Bool,
3611 c: Conn, request: Send, route: Route) ->
3612 IO(Pool & Result<&1, &1, Err, Res>):
3613 match c:
3614 case Conn{tls, s}:
3615 pool.idle.h1(p, key, tls, ms, idem, s, request, route)
3616 case ConnH2{s, client}:
3617 pool.h2.ex(p, key, ms, request, s, client)
3618
3619def pool.idle(taken: Pool & Maybe<&1, Conn>, +key: String, +ms: U32,
3620 +idem: Bool, request: Send, route: Route) ->
3621 IO(Pool & Result<&1, &1, Err, Res>):
3622 (p, m) = taken
3623 match m:
3624 case None{}:
3625 pool.fresh(p, key, ms, request, route)
3626 case Some{c}:
3627 pool.idle.reuse(p, key, ms, idem, c, request, route)
3628
3629def proxy.http.headers(headers: Map<&2, List<&2, String>>,
3630 authorization: String) -> Map<&2, List<&2, String>>:
3631 match authorization:
3632 case SNil{}:
3633 headers
3634 case other:
3635 set(headers, "proxy-authorization", authorization)
3636
3637def proxy.absolute(scheme: String, host_field: String, target: String) -> String:
3638 scheme ++ "://" ++ host_field ++ target
3639
3640def proxy.request(secure: Bool, +scheme: String, method: String,
3641 +target: String, +hf: String, headers: Map<&2, List<&2, String>>,
3642 body: Bytes.Bytes, authorization: String) -> Send:
3643 match secure:
3644 case True{}:
3645 Send{method, target, hf, Map.del(&2, List<&2, String>, headers,
3646 "proxy-authorization"), body}
3647 case False{}:
3648 Send{method, proxy.absolute(scheme, hf, target), hf,
3649 proxy.http.headers(headers, authorization), body}
3650
3651def pool.origin.proxy(p: Pool, +method: String, +ms: U32,
3652 headers: Map<&2, List<&2, String>>, body: Bytes.Bytes, +hf: String,
3653 +scheme: String, +host: String, +port: U32, +target: String,
3654 +cert: Maybe<&2, Cert>, proxy: Proxy) ->
3655 IO(Pool & Result<&1, &1, Err, Res>):
3656 match proxy:
3657 case ProxyDirect{}:
3658 +key = pool.key.cert(pool.key(scheme, host, port), cert)
3659 pool.idle(pool.take(p, key), key, ms, pool.idempotent(method),
3660 Send{method, target, hf, headers, body},
3661 RouteDirect{String.eq(scheme, "https"), host, port, cert})
3662 case ProxyVia{+proxy_host, +proxy_port, +authorization}:
3663 +secure = String.eq(scheme, "https")
3664 +key = pool.key.cert(pool.key(scheme, host, port)
3665 ++ "|proxy:" ++ proxy_host ++ ":" ++ U32.show(proxy_port)
3666 ++ "|auth:" ++ authorization, cert)
3667 pool.idle(pool.take(p, key), key, ms, pool.idempotent(method),
3668 proxy.request(secure, scheme, method, target, hf, headers, body, authorization),
3669 RouteProxy{secure, proxy_host, proxy_port, host,
3670 Url.host_field.wrap(host, Url.has(host, 58)) ++ ":" ++ U32.show(port),
3671 authorization, cert})
3672
3673def pool.origin.choice(p: Pool, method: String, ms: U32,
3674 headers: Map<&2, List<&2, String>>, body: Bytes.Bytes, hf: String,
3675 scheme: String, host: String, port: U32, target: String,
3676 cert: Maybe<&2, Cert>, choice: Maybe<&2, Proxy>) ->
3677 IO(Pool & Result<&1, &1, Err, Res>):
3678 match choice:
3679 case None{}:
3680 IO.pure(Pool & Result<&1, &1, Err, Res>, (p, Fail{ErrUrl{}}))
3681 case Some{proxy}:
3682 pool.origin.proxy(p, method, ms, headers, body, hf, scheme, host, port,
3683 target, cert, proxy)
3684
3685def pool.origin(p: Pool, method: String, ms: U32,
3686 headers: Map<&2, List<&2, String>>, body: Bytes.Bytes, hf: String,
3687 a: Url.Abs, known: Bool, cert: Maybe<&2, Cert>,
3688 choice: Maybe<&2, Proxy>) ->
3689 IO(Pool & Result<&1, &1, Err, Res>):
3690 Url.Abs{scheme, host, port, target} = a
3691 match known:
3692 case False{}:
3693 IO.pure(Pool & Result<&1, &1, Err, Res>, (p, Fail{ErrUrl{}}))
3694 case True{}:
3695 pool.origin.choice(p, method, ms, headers, body, hf, scheme, host,
3696 port, target, cert, choice)
3697
3698def pool.scheme.ok(a: Url.Abs) -> Bool:
3699 Url.Abs{+scheme, host, port, target} = a
3700 Bool.or(String.eq(scheme, "http"), String.eq(scheme, "https"))
3701
3702def pool.one.back(h: Hop, pr: Pool & Result<&1, &1, Err, Res>) -> Pool & Result<&1, &1, Err, Res> & Hop:
3703 (p, r) = pr
3704 (p, r, h)
3705
3706# sent is headers plus any jar cookies; the hop keeps headers, so cookies never pile up across hops.
3707def pool.one.of(p: Pool, +method: String, +url: Url.Abs,
3708 headers: Map<&2, List<&2, String>>, sent: Map<&2, List<&2, String>>,
3709 +ms: U32, r: Bytes.Bytes & Bytes.Bytes, cert: Maybe<&2, Cert>) ->
3710 IO(Pool & Result<&1, &1, Err, Res> & Hop):
3711 Url.Abs{+scheme, +host, +port, target} = url
3712 (body, wire) = r
3713 do IO<Pool & Result<&1, &1, Err, Res> & Hop>:
3714 choice : Maybe<&2, Proxy> <- proxy.select(scheme, host, port)
3715 pr : Pool & Result<&1, &1, Err, Res> <-
3716 pool.origin(p, method, ms, sent, wire, Url.host_field(url),
3717 url, pool.scheme.ok(url), cert, choice)
3718 return pool.one.back(Hop{method, url, headers, body}, pr)
3719
3720# One request, on an idle socket to its origin when the pool has one. The hop comes back for the redirect.
3721def pool.one(p: Pool, h: Hop, +ms: U32, cert: Maybe<&2, Cert>, jar: Maybe<&2, Jar>) -> IO(Pool & Result<&1, &1, Err, Res> & Hop):
3722 Hop{+method, +url, +headers, body} = h
3723 pool.one.of(p, method, url, headers, jar.opt.apply(jar, url, headers), ms, Bytes.slice(body, 0, 4294967295), cert)
3724
3725type Next is Type:
3726 NDone{res: Result<&1, &1, Err, Res>}
3727 NStop{}
3728 NGo{left: Nat, hop: Hop}
3729
3730type Mode is Data:
3731 ModeFollow{}
3732 ModeManual{}
3733 ModeError{}
3734
3735# left: redirects still allowed after the request we just finished.
3736def fetch.hop(left: Nat, h: Hop) -> Next:
3737 match left:
3738 case 0n:
3739 NStop{}
3740 case 1n+p:
3741 NGo{p, h}
3742
3743def fetch.decide.r(left: Nat, r: Res, next: Maybe<&1, Hop>) -> Next:
3744 match next:
3745 case None{}:
3746 NDone{Done{r}}
3747 case Some{h}:
3748 fetch.hop(left, h)
3749
3750def fetch.decide.res(left: Nat, h: Hop, r: Res) -> Next:
3751 Res{+status, +headers, body} = r
3752 fetch.decide.r(left, Res{status, headers, body}, redirect(status, headers, h))
3753
3754def fetch.decide(left: Nat, h: Hop, m: Result<&1, &1, Err, Res>) -> Next:
3755 match m:
3756 case Fail{e}:
3757 NDone{Fail{e}}
3758 case Done{r}:
3759 fetch.decide.res(left, h, r)
3760
3761def fetch.error.res(r: Res, bad: Bool) -> Next:
3762 match bad:
3763 case True{}:
3764 NDone{Fail{ErrRedirect{}}}
3765 case False{}:
3766 NDone{Done{r}}
3767
3768def fetch.error(h: Hop, m: Result<&1, &1, Err, Res>) -> Next:
3769 match m:
3770 case Fail{e}:
3771 NDone{Fail{e}}
3772 case Done{r}:
3773 Res{+status, +headers, body} = r
3774 fetch.error.res(Res{status, headers, body}, Bool.and(redirect.code(status), has_header(headers, "location")))
3775
3776def fetch.policy(mode: Mode, left: Nat, h: Hop, m: Result<&1, &1, Err, Res>) -> Next:
3777 match mode:
3778 case ModeFollow{}:
3779 fetch.decide(left, h, m)
3780 case ModeManual{}:
3781 NDone{m}
3782 case ModeError{}:
3783 fetch.error(h, m)
3784
3785# A caller's own Accept-Encoding wins; enc is the codings fetch can undo.
3786def accept.enc(+h: Map<&2, List<&2, String>>, +enc: String) -> Map<&2, List<&2, String>>:
3787 Bool.pick(Map<&2, List<&2, String>>, has_header(h, "accept-encoding"), h, set(h, "accept-encoding", enc))
3788
3789def fetch.start(method: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes, u: Maybe<&2, Url.Abs>, +enc: String) -> Next:
3790 match u:
3791 case None{}:
3792 NDone{Fail{ErrUrl{}}}
3793 case Some{a}:
3794 NGo{20n, Hop{method, a, accept.enc(req.put(Map.to_list(&2, List<&2, String>, headers), empty()), enc), body}}
3795
3796# The redirect loop's state: the pool, what to do next, the client identity, and the jar if any.
3797type Hops is Type:
3798 Hops{p: Pool, next: Next, cert: Maybe<&2, Cert>, jar: Maybe<&2, Jar>}
3799
3800def pool.next.move(p: Pool, +old: String, cert: Maybe<&2, Cert>, jar: Maybe<&2, Jar>, n: Next) -> Hops:
3801 match n:
3802 case NGo{left, h}:
3803 Hop{method, +url, headers, body} = h
3804 Hops{p, NGo{left, Hop{method, url, headers, body}},
3805 Bool.pick(Maybe<&2, Cert>, String.eq(old, redirect.origin(url)), cert, None{}), jar}
3806 case NDone{r}:
3807 Hops{p, NDone{r}, None{}, jar}
3808 case NStop{}:
3809 Hops{p, NStop{}, None{}, jar}
3810
3811def pool.next.of(+mode: Mode, left: Nat, cert: Maybe<&2, Cert>, p: Pool, +url: Url.Abs, h: Hop, r: Maybe<&2, Jar> & Result<&1, &1, Err, Res>) -> Hops:
3812 (jar, m) = r
3813 pool.next.move(p, redirect.origin(url), cert, jar, fetch.policy(mode, left, h, m))
3814
3815# The jar takes the response's Set-Cookie fields first, redirect or not.
3816def pool.next(+mode: Mode, left: Nat, cert: Maybe<&2, Cert>, jar: Maybe<&2, Jar>, x: Pool & Result<&1, &1, Err, Res> & Hop) -> Hops:
3817 (p, m, h) = x
3818 Hop{method, +url, headers, body} = h
3819 pool.next.of(mode, left, cert, p, url, Hop{method, url, headers, body}, jar.opt.store(jar, url, m))
3820
3821def pool.hops.one(+mode: Mode, +ms: U32, +cert: Maybe<&2, Cert>, +jar: Maybe<&2, Jar>, p: Pool, h: Hop, left: Nat) -> IO(Hops):
3822 do IO<Hops>:
3823 x : Pool & Result<&1, &1, Err, Res> & Hop <- pool.one(p, h, ms, cert, jar)
3824 return pool.next(mode, left, cert, jar, x)
3825
3826# NGo.left is how many redirects may follow this request. 20 is WHATWG's limit.
3827# The jar, when there is one, gives cookies to every hop and takes them from every response.
3828@unsafe
3829def pool.hops(+mode: Mode, +ms: U32, st: Hops) -> IO(Pool & Result<&1, &1, Err, Res> & Maybe<&2, Jar>):
3830 Hops{p, n, cert, cj} = st
3831 match n:
3832 case NDone{m}:
3833 IO.pure(Pool & Result<&1, &1, Err, Res> & Maybe<&2, Jar>, (p, m, cj))
3834 case NStop{}:
3835 IO.pure(Pool & Result<&1, &1, Err, Res> & Maybe<&2, Jar>, (p, Fail{ErrRedirect{}}, cj))
3836 case NGo{+left, h}:
3837 do IO<Pool & Result<&1, &1, Err, Res> & Maybe<&2, Jar>>:
3838 next : Hops <- pool.hops.one(mode, ms, cert, cj, p, h, left)
3839 pool.hops(mode, ms, next)
3840
3841# Content-Encoding (RFC 9110 §8.4): each value, trimmed and lowercased, in the order applied.
3842def ce.keep(+w: String, +rest: List<&2, String>) -> List<&2, String>:
3843 Bool.pick(List<&2, String>, String.is_empty(w), rest, Con{w, rest})
3844
3845def ce.norm(xs: List<&2, String>) -> List<&2, String>:
3846 match xs:
3847 case Nil{}:
3848 Nil{}
3849 case Con{v, t}:
3850 ce.keep(String.to_lower(trim(v)), ce.norm(t))
3851
3852def ce.split(xs: List<&2, String>) -> List<&2, String>:
3853 match xs:
3854 case Nil{}:
3855 Nil{}
3856 case Con{v, t}:
3857 List.append(&2, String, ce.norm(String.split(v, ',')), ce.split(t))
3858
3859# Ok: decoded so far. Bad: a coding failed. Skip: a coding we cannot decode, so the body stays as sent.
3860type Dec is Data:
3861 DecOk{b: String}
3862 DecBad{}
3863 DecSkip{}
3864
3865def ce.of(m: Maybe<&2, String>) -> Dec:
3866 match m:
3867 case None{}:
3868 DecBad{}
3869 case Some{b}:
3870 DecOk{b}
3871
3872# Servers send deflate both with and without the zlib wrapper.
3873def ce.deflate(+b: String, m: Maybe<&2, String>) -> Dec:
3874 match m:
3875 case Some{out}:
3876 DecOk{out}
3877 case None{}:
3878 ce.of(Zlib.inflate(b))
3879
3880def ce.apply(+c: String, +b: String) -> Dec:
3881 Bool.pick(Dec, Bool.or(String.eq(c, "gzip"), String.eq(c, "x-gzip")), ce.of(Zlib.gunzip(b)),
3882 Bool.pick(Dec, String.eq(c, "deflate"), ce.deflate(b, Zlib.unzlib(b)),
3883 Bool.pick(Dec, String.eq(c, "identity"), DecOk{b}, DecSkip{})))
3884
3885def ce.go(cs: List<&2, String>, d: Dec) -> Dec:
3886 match cs:
3887 case Nil{}:
3888 d
3889 case Con{+c, t}:
3890 match d:
3891 case DecOk{+b}:
3892 ce.go(t, ce.apply(c, b))
3893 case DecBad{}:
3894 DecBad{}
3895 case DecSkip{}:
3896 DecSkip{}
3897
3898def decoded.pick(d: Dec, +status: U32, headers: Map<&2, List<&2, String>>, body: String) -> Result<&1, &1, Err, Res>:
3899 match d:
3900 case DecOk{b}:
3901 Done{Res{status, headers, Bytes.from_string(b)}}
3902 case DecBad{}:
3903 Fail{ErrBad{}}
3904 case DecSkip{}:
3905 Done{Res{status, headers, Bytes.from_string(body)}}
3906
3907# ponytail: the codings run on a String copy of the body; give zlib a Bytes input if gzip bodies get big.
3908def decoded.cs(+status: U32, +headers: Map<&2, List<&2, String>>, body: Bytes.Bytes, cs: List<&2, String>) -> Result<&1, &1, Err, Res>:
3909 match cs:
3910 case Nil{}:
3911 Done{Res{status, headers, body}}
3912 case Con{c, t}:
3913 +s = Bytes.to_string(body)
3914 decoded.pick(ce.go(Con{c, t}, DecOk{s}), status, headers, s)
3915
3916def decoded.go(empty: Bool, +status: U32, +headers: Map<&2, List<&2, String>>, body: Bytes.Bytes) -> Result<&1, &1, Err, Res>:
3917 match empty:
3918 case True{}:
3919 Done{Res{status, headers, body}}
3920 case False{}:
3921 decoded.cs(status, headers, body, List.reverse(&2, String, ce.split(fields(headers, "content-encoding"))))
3922
3923# The body decoded per Content-Encoding; the headers stay as sent. A corrupt body is ErrBad.
3924def decoded(res: Res) -> Result<&1, &1, Err, Res>:
3925 Res{+status, +headers, body} = res
3926 Bytes.Bytes{+len, buf} = body
3927 decoded.go(U32.is_zero(len), status, headers, Bytes.Bytes{len, buf})
3928
3929def decoded.m(r: Result<&1, &1, Err, Res>) -> Maybe<&1, Res>:
3930 match r:
3931 case Done{x}:
3932 Some{x}
3933 case Fail{e}:
3934 None{}
3935
3936def decoded.some(res: Res) -> Maybe<&1, Res>:
3937 decoded.m(decoded(res))
3938
3939def ce.words(r: Result<&1, &1, U32 & String, U32 & Array<U32>>) -> Maybe<&1, Bytes.Bytes>:
3940 match r:
3941 case Fail{e}:
3942 None{}
3943 case Done{(+len, buf)}:
3944 Some{Bytes.Bytes{len, buf}}
3945
3946# A decoded body stops at 16 MiB, like a received one.
3947def ce.eff(~eff: U32 -> U32 -> Array<U32> -> IO(Result<&1, &1, U32 & String, U32 & Array<U32>>), b: Bytes.Bytes) -> IO(Maybe<&1, Bytes.Bytes>):
3948 Bytes.Bytes{+len, buf} = b
3949 do IO<Maybe<&1, Bytes.Bytes>>:
3950 r : Result<&1, &1, U32 & String, U32 & Array<U32>> <- eff(16777216, len, buf)
3951 return ce.words(r)
3952
3953def ce.dec(d: Dec) -> Maybe<&1, Bytes.Bytes>:
3954 match d:
3955 case DecOk{b}:
3956 Some{Bytes.from_string(b)}
3957 case DecBad{}:
3958 None{}
3959 case DecSkip{}:
3960 None{}
3961
3962# ponytail: deflate runs on the pure decoder, which also takes raw DEFLATE; servers rarely send it.
3963def ce.io.deflate(on: Bool, b: Bytes.Bytes) -> IO(Maybe<&1, Bytes.Bytes>):
3964 match on:
3965 case True{}:
3966 +s = Bytes.to_string(b)
3967 IO.pure(Maybe<&1, Bytes.Bytes>, ce.dec(ce.deflate(s, Zlib.unzlib(s))))
3968 case False{}:
3969 IO.pure(Maybe<&1, Bytes.Bytes>, Some{b})
3970
3971def ce.io.zstd(on: Bool, +c: String, b: Bytes.Bytes) -> IO(Maybe<&1, Bytes.Bytes>):
3972 match on:
3973 case True{}:
3974 ce.eff(~Zlib.zstd.words, b)
3975 case False{}:
3976 ce.io.deflate(String.eq(c, "deflate"), b)
3977
3978def ce.io.br(on: Bool, +c: String, b: Bytes.Bytes) -> IO(Maybe<&1, Bytes.Bytes>):
3979 match on:
3980 case True{}:
3981 ce.eff(~Zlib.brotli.words, b)
3982 case False{}:
3983 ce.io.zstd(String.eq(c, "zstd"), c, b)
3984
3985# One known coding undone: gzip, x-gzip, br, zstd, deflate, or identity.
3986def ce.io.gz(on: Bool, +c: String, b: Bytes.Bytes) -> IO(Maybe<&1, Bytes.Bytes>):
3987 match on:
3988 case True{}:
3989 ce.eff(~Zlib.inflate.words, b)
3990 case False{}:
3991 ce.io.br(String.eq(c, "br"), c, b)
3992
3993def ce.io.go(cs: List<&2, String>, m: Maybe<&1, Bytes.Bytes>) -> IO(Maybe<&1, Bytes.Bytes>):
3994 match cs:
3995 case Nil{}:
3996 match m:
3997 case None{}:
3998 IO.pure(Maybe<&1, Bytes.Bytes>, None{})
3999 case Some{b}:
4000 IO.pure(Maybe<&1, Bytes.Bytes>, Some{b})
4001 case Con{+c, t}:
4002 match m:
4003 case None{}:
4004 IO.pure(Maybe<&1, Bytes.Bytes>, None{})
4005 case Some{b}:
4006 do IO<Maybe<&1, Bytes.Bytes>>:
4007 n : Maybe<&1, Bytes.Bytes> <- ce.io.gz(Bool.or(String.eq(c, "gzip"), String.eq(c, "x-gzip")), c, b)
4008 ce.io.go(t, n)
4009
4010def ce.has(xs: List<&2, String>, +c: String) -> Bool:
4011 match xs:
4012 case Nil{}:
4013 False{}
4014 case Con{x, t}:
4015 Bool.or(String.eq(c, x), ce.has(t, c))
4016
4017def ce.known(cs: List<&2, String>, +ok: List<&2, String>) -> Bool:
4018 match cs:
4019 case Nil{}:
4020 True{}
4021 case Con{c, t}:
4022 Bool.and(ce.has(ok, c), ce.known(t, ok))
4023
4024def decoded.io.pick(m: Maybe<&1, Bytes.Bytes>, +status: U32, headers: Map<&2, List<&2, String>>) -> Result<&1, &1, Err, Res>:
4025 match m:
4026 case Some{b}:
4027 Done{Res{status, headers, b}}
4028 case None{}:
4029 Fail{ErrBad{}}
4030
4031def decoded.io.run(known: Bool, +status: U32, +headers: Map<&2, List<&2, String>>, body: Bytes.Bytes, cs: List<&2, String>) -> IO(Result<&1, &1, Err, Res>):
4032 match known:
4033 case True{}:
4034 do IO<Result<&1, &1, Err, Res>>:
4035 m : Maybe<&1, Bytes.Bytes> <- ce.io.go(cs, Some{body})
4036 return decoded.io.pick(m, status, headers)
4037 case False{}:
4038 IO.pure(Result<&1, &1, Err, Res>, Done{Res{status, headers, body}})
4039
4040def decoded.io.go(empty: Bool, +enc: String, +status: U32, +headers: Map<&2, List<&2, String>>, body: Bytes.Bytes) -> IO(Result<&1, &1, Err, Res>):
4041 match empty:
4042 case True{}:
4043 IO.pure(Result<&1, &1, Err, Res>, Done{Res{status, headers, body}})
4044 case False{}:
4045 +cs = List.reverse(&2, String, ce.split(fields(headers, "content-encoding")))
4046 decoded.io.run(ce.known(cs, Con{"identity", Con{"x-gzip", ce.split(Con{enc, Nil{}})}}), status, headers, body, cs)
4047
4048# decoded through the C libraries, for the codings in enc. A body with any other coding stays as sent.
4049def decoded.io(+enc: String, res: Res) -> IO(Result<&1, &1, Err, Res>):
4050 Res{+status, +headers, body} = res
4051 Bytes.Bytes{+len, buf} = body
4052 decoded.io.go(U32.is_zero(len), enc, status, headers, Bytes.Bytes{len, buf})
4053
4054# An effect on empty input fails with ENOENT only when its library does not load.
4055def codings.ok(r: Result<&1, &1, U32 & String, U32 & Array<U32>>) -> Bool:
4056 match r:
4057 case Fail{(+c, why)}:
4058 Bool.not(U32.is_eq(c, 2))
4059 case Done{p}:
4060 True{}
4061
4062def codings.has(~eff: U32 -> U32 -> Array<U32> -> IO(Result<&1, &1, U32 & String, U32 & Array<U32>>), b: Bytes.Bytes) -> IO(Bool):
4063 Bytes.Bytes{+len, buf} = b
4064 do IO<Bool>:
4065 r : Result<&1, &1, U32 & String, U32 & Array<U32>> <- eff(0, len, buf)
4066 return codings.ok(r)
4067
4068def codings.add(has: Bool, +enc: String, +c: String) -> String:
4069 Bool.pick(String, has, enc ++ ", " ++ c, enc)
4070
4071# gzip and deflate, then br and zstd when their C library loads.
4072def codings() -> IO(String):
4073 do IO<String>:
4074 b : Bool <- codings.has(~Zlib.brotli.words, Bytes.new(0))
4075 z : Bool <- codings.has(~Zlib.zstd.words, Bytes.new(0))
4076 return codings.add(z, codings.add(b, "gzip, deflate", "br"), "zstd")
4077
4078# The final response of a fetch, after redirects.
4079def fetch.final(+enc: String, r: Result<&1, &1, Err, Res>) -> IO(Result<&1, &1, Err, Res>):
4080 match r:
4081 case Done{res}:
4082 decoded.io(enc, res)
4083 case Fail{e}:
4084 IO.pure(Result<&1, &1, Err, Res>, Fail{e})
4085
4086def pool.final(+enc: String, pr: Pool & Result<&1, &1, Err, Res> & Maybe<&2, Jar>) -> IO(Pool & Result<&1, &1, Err, Res>):
4087 (p, r, jar) = pr
4088 do IO<Pool & Result<&1, &1, Err, Res>>:
4089 d : Result<&1, &1, Err, Res> <- fetch.final(enc, r)
4090 return (p, d)
4091
4092def pool.how.enc(+enc: String, p: Pool, method: String, url: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes, ms: U32, mode: Mode, cert: Maybe<&2, Cert>) -> IO(Pool & Result<&1, &1, Err, Res>):
4093 do IO<Pool & Result<&1, &1, Err, Res>>:
4094 pr : Pool & Result<&1, &1, Err, Res> & Maybe<&2, Jar> <- pool.hops(mode, ms, Hops{p, fetch.start(method, headers, body, Url.absolute(url), enc), cert, None{}})
4095 pool.final(enc, pr)
4096
4097def pool.how.cert(p: Pool, method: String, url: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes, ms: U32, mode: Mode, cert: Maybe<&2, Cert>) -> IO(Pool & Result<&1, &1, Err, Res>):
4098 do IO<Pool & Result<&1, &1, Err, Res>>:
4099 enc : String <- codings()
4100 pool.how.enc(enc, p, method, url, headers, body, ms, mode, cert)
4101
4102# pool.how(p, "GET", "https://example.com/x?y=1", headers, body, ms, mode) follows redirects
4103# on p's idle sockets. Fail is a bad URL, a failed lookup, connect, handshake, send, read,
4104# a malformed response, more than 20 redirects, or a step past ms. Bodies are bytes.
4105def pool.how(p: Pool, method: String, url: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes, ms: U32, mode: Mode) -> IO(Pool & Result<&1, &1, Err, Res>):
4106 pool.how.cert(p, method, url, headers, body, ms, mode, None{})
4107
4108def pool.fetch.with(p: Pool, method: String, url: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes, ms: U32) -> IO(Pool & Result<&1, &1, Err, Res>):
4109 pool.how(p, method, url, headers, body, ms, ModeFollow{})
4110
4111def pool.fetch(p: Pool, method: String, url: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes) -> IO(Pool & Result<&1, &1, Err, Res>):
4112 pool.fetch.with(p, method, url, headers, body, 30000)
4113
4114def pool.fetch.cert.with(p: Pool, method: String, url: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes, chain: String, key: String, ms: U32) -> IO(Pool & Result<&1, &1, Err, Res>):
4115 pool.how.cert(p, method, url, headers, body, ms, ModeFollow{}, Some{Cert{chain, key}})
4116
4117def pool.fetch.cert(p: Pool, method: String, url: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes, chain: String, key: String) -> IO(Pool & Result<&1, &1, Err, Res>):
4118 pool.fetch.cert.with(p, method, url, headers, body, chain, key, 30000)
4119
4120# One request for fetch.all: the arguments of fetch, as a record.
4121type Fetch is Type:
4122 Fetch{method: String, url: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes}
4123
4124def fetch.all.job(p: Pool, f: Fetch) -> IO(Pool & Result<&1, &1, Err, Res>):
4125 Fetch{method, url, headers, body} = f
4126 pool.fetch(p, method, url, headers, body)
4127
4128def fetch.all.pools(n: Nat) -> List<Pool>:
4129 match n:
4130 case 0n:
4131 Nil{}
4132 case 1n+p:
4133 pool.new() <> fetch.all.pools(p)
4134
4135def fetch.all.close(ps: List<Pool>) -> IO(Unit):
4136 match ps:
4137 case Nil{}:
4138 IO.pure(Unit, Unit{})
4139 case p <> rest:
4140 do IO<Unit>:
4141 pool.close(p)
4142 fetch.all.close(rest)
4143
4144def fetch.all.done(r: List<Pool> & List<Result<&1, &1, Err, Res>>) -> IO(List<Result<&1, &1, Err, Res>>):
4145 (ps, rs) = r
4146 do IO<List<Result<&1, &1, Err, Res>>>:
4147 fetch.all.close(ps)
4148 return rs
4149
4150# No requests start no workers, since Conc.pool needs at least one.
4151def fetch.all.go(xs: List<Fetch>, +workers: Nat) -> IO(List<Result<&1, &1, Err, Res>>):
4152 match xs:
4153 case Nil{}:
4154 IO.pure(List<Result<&1, &1, Err, Res>>, Nil{})
4155 case x <> rest:
4156 do IO<List<Result<&1, &1, Err, Res>>>:
4157 r : List<Pool> & List<Result<&1, &1, Err, Res>> <-
4158 Conc.pool(~Pool, ~Fetch, ~Result<&1, &1, Err, Res>, ~fetch.all.job, fetch.all.pools(workers), x <> rest)
4159 fetch.all.done(r)
4160
4161def fetch.all.of(+n: U32, nx: Nat & List<Fetch>) -> IO(List<Result<&1, &1, Err, Res>>):
4162 (+len, xs) = nx
4163 fetch.all.go(xs, Nat.min(len, Nat.max(1n, U32.to_nat(n))))
4164
4165# Each request as fetch would make it, on at most n workers (0 counts as 1, and
4166# never more workers than requests). Each worker owns its own Pool, so an idle
4167# socket is reused only by the worker that opened it; every pool is closed at the
4168# end. Results come back in the order of reqs.
4169def fetch.all(reqs: List<Fetch>, +n: U32) -> IO(List<Result<&1, &1, Err, Res>>):
4170 fetch.all.of(n, Conc.count(Fetch, reqs))
4171
4172# The hops always hand the jar back; j is only the type's fallback.
4173def pool.jar.final(+enc: String, j: Jar, pr: Pool & Result<&1, &1, Err, Res> & Maybe<&2, Jar>) -> IO(Pool & Jar & Result<&1, &1, Err, Res>):
4174 (p, r, jar) = pr
4175 do IO<Pool & Jar & Result<&1, &1, Err, Res>>:
4176 d : Result<&1, &1, Err, Res> <- fetch.final(enc, r)
4177 return (p, Maybe.default(&2, Jar, jar, j), d)
4178
4179def pool.jar.enc(+enc: String, p: Pool, +j: Jar, method: String, url: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes) -> IO(Pool & Jar & Result<&1, &1, Err, Res>):
4180 do IO<Pool & Jar & Result<&1, &1, Err, Res>>:
4181 pr : Pool & Result<&1, &1, Err, Res> & Maybe<&2, Jar> <- pool.hops(ModeFollow{}, 30000, Hops{p, fetch.start(method, headers, body, Url.absolute(url), enc), None{}, Some{j}})
4182 pool.jar.final(enc, j, pr)
4183
4184# pool.fetch with a cookie jar (RFC 6265bis). Before every hop, redirects included, the jar's
4185# cookies for that URL join the request's cookie field; after every response, redirects included,
4186# its Set-Cookie fields go into the jar. The jar's clock is the caller's: advance it with jar.at.
4187def pool.fetch.jar(p: Pool, j: Jar, method: String, url: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes) -> IO(Pool & Jar & Result<&1, &1, Err, Res>):
4188 do IO<Pool & Jar & Result<&1, &1, Err, Res>>:
4189 enc : String <- codings()
4190 pool.jar.enc(enc, p, j, method, url, headers, body)
4191def fetch.end(pr: Pool & Result<&1, &1, Err, Res>) -> IO(Result<&1, &1, Err, Res>):
4192 (p, r) = pr
4193 do IO<Result<&1, &1, Err, Res>>:
4194 pool.close(p)
4195 return r
4196
4197# fetch is pool.how on a fresh pool that closes afterwards.
4198def fetch.how(method: String, url: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes, ms: U32, mode: Mode) -> IO(Result<&1, &1, Err, Res>):
4199 do IO<Result<&1, &1, Err, Res>>:
4200 pr : Pool & Result<&1, &1, Err, Res> <- pool.how(pool.new(), method, url, headers, body, ms, mode)
4201 fetch.end(pr)
4202
4203def fetch.with(method: String, url: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes, ms: U32) -> IO(Result<&1, &1, Err, Res>):
4204 fetch.how(method, url, headers, body, ms, ModeFollow{})
4205
4206def fetch.cert.with(method: String, url: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes, chain: String, key: String, ms: U32) -> IO(Result<&1, &1, Err, Res>):
4207 do IO<Result<&1, &1, Err, Res>>:
4208 pr : Pool & Result<&1, &1, Err, Res> <- pool.fetch.cert.with(pool.new(), method, url, headers, body, chain, key, ms)
4209 fetch.end(pr)
4210
4211def fetch.cert(method: String, url: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes, chain: String, key: String) -> IO(Result<&1, &1, Err, Res>):
4212 fetch.cert.with(method, url, headers, body, chain, key, 30000)
4213
4214# fetch.with and a 30 s step timeout.
4215def fetch(method: String, url: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes) -> IO(Result<&1, &1, Err, Res>):
4216 fetch.with(method, url, headers, body, 30000)
4217
4218def get(url: String) -> IO(Result<&1, &1, Err, Res>):
4219 fetch("GET", url, empty(), Bytes.new(0))
4220
4221# POST v as compact JSON, with content-type: application/json.
4222def post.json(url: String, v: Json.Val) -> IO(Result<&1, &1, Err, Res>):
4223 fetch("POST", url, set(empty(), "content-type", "application/json"), Json.encode.bytes(v))
4224
4225# Base URLs: resolve(base, ref) is ref against the absolute http(s) URL base (RFC 3986 §5.2),
4226# written back as a URL for fetch. None when base is not absolute or ref has another scheme.
4227def resolve.show(a: Url.Abs) -> String:
4228 Url.Abs{+scheme, host, port, +target} = a
4229 scheme ++ "://" ++ Url.host_field(Url.Abs{scheme, host, port, target}) ++ target
4230
4231def resolve.to(m: Maybe<&2, Url.Abs>) -> Maybe<&2, String>:
4232 match m:
4233 case None{}:
4234 None{}
4235 case Some{a}:
4236 Some{resolve.show(a)}
4237
4238def resolve.base(m: Maybe<&2, Url.Abs>, +ref: String) -> Maybe<&2, String>:
4239 match m:
4240 case None{}:
4241 None{}
4242 case Some{b}:
4243 resolve.to(Url.resolve(b, ref))
4244
4245def resolve(base: String, +ref: String) -> Maybe<&2, String>:
4246 resolve.base(Url.absolute(base), ref)
4247
4248# Retry. The wait before retry n (0 first) is 500 ms doubled n times, at most 30 s;
4249# its upper half is jitter r: backoff(n, r) = half + r mod (half + 1).
4250def retry.cap() -> U32:
4251 30000
4252
4253def retry.base(n: Nat) -> U32:
4254 match n:
4255 case 0n:
4256 500
4257 case 1n+p:
4258 U32.min((retry.base(p) * 2 : U32), retry.cap())
4259
4260def retry.backoff.half(+half: U32, +r: U32) -> U32:
4261 (half + (r % (half + 1)) : U32)
4262
4263def retry.backoff(n: Nat, +r: U32) -> U32:
4264 retry.backoff.half((retry.base(n) / 2 : U32), r)
4265
4266# ms clamped to 0 .. retry.cap().
4267def retry.after.ms(+ms: Int.I64) -> U32:
4268 Bool.pick(U32, Int.I64.is_neg(ms), 0,
4269 Bool.pick(U32, Int.I64.is_lt(ms, Int.I64.from_u32(retry.cap())), Int.I64.to_u32(ms), retry.cap()))
4270
4271def retry.after.date(m: Maybe<&2, Time.Instant>, now: Time.Instant) -> Maybe<&2, U32>:
4272 match m:
4273 case None{}:
4274 None{}
4275 case Some{date}:
4276 Some{retry.after.ms(Time.Duration.to_ms(Time.Instant.since(date, now)))}
4277
4278# More than 5 digits is past the cap, and would overflow parse_u32.
4279def retry.after.secs(+v: String, now: Time.Instant, n: Maybe<&2, U32>) -> Maybe<&2, U32>:
4280 match n:
4281 case None{}:
4282 retry.after.date(Time.http_date.parse(v), now)
4283 case Some{s}:
4284 Some{Bool.pick(U32, Nat.is_lt(5n, String.length(v)), retry.cap(), U32.min((s * 1000 : U32), retry.cap()))}
4285
4286# Retry-After (RFC 9110 §10.2.3) as ms from now, at most retry.cap(): delay-seconds, or an
4287# HTTP-date (a past date is 0). None when v is empty or neither form.
4288def retry.after(+v: String, now: Time.Instant) -> Maybe<&2, U32>:
4289 retry.after.secs(v, now, parse_u32(v))
4290
4291def retry.wait(m: Maybe<&2, U32>, n: Nat, +r: U32) -> U32:
4292 match m:
4293 case None{}:
4294 retry.backoff(n, r)
4295 case Some{ms}:
4296 ms
4297
4298# The wait before retry n: Retry-After v when it reads as a delay, else backoff with jitter r.
4299def retry.delay(+v: String, now: Time.Instant, n: Nat, +r: U32) -> U32:
4300 retry.wait(retry.after(v, now), n, r)
4301
4302# Statuses a later try may clear.
4303def retry.status(+s: U32) -> Bool:
4304 Bool.or(Bool.or(U32.is_eq(s, 408), U32.is_eq(s, 429)),
4305 Bool.or(Bool.or(U32.is_eq(s, 500), U32.is_eq(s, 502)), Bool.or(U32.is_eq(s, 503), U32.is_eq(s, 504))))
4306
4307# A refused connect or a timeout may clear; any other error would repeat.
4308def retry.fail(e: Err) -> Result<&1, &1, Err, Res> & Maybe<&2, String>:
4309 match e:
4310 case ErrConnect{code, why}:
4311 (Fail{ErrConnect{code, why}}, Some{""})
4312 case ErrTimeout{}:
4313 (Fail{ErrTimeout{}}, Some{""})
4314 case other:
4315 (Fail{other}, None{})
4316
4317def retry.res(res: Res) -> Result<&1, &1, Err, Res> & Maybe<&2, String>:
4318 Res{+status, +headers, body} = res
4319 (Done{Res{status, headers, body}}, Bool.pick(Maybe<&2, String>, retry.status(status), Some{header(headers, "retry-after")}, None{}))
4320
4321def retry.judge.try(r: Result<&1, &1, Err, Res>) -> Result<&1, &1, Err, Res> & Maybe<&2, String>:
4322 match r:
4323 case Fail{e}:
4324 retry.fail(e)
4325 case Done{res}:
4326 retry.res(res)
4327
4328# One try, judged: the result as it came, and Some{Retry-After value} ("" when absent)
4329# when an idempotent request may try again.
4330def retry.judge(idem: Bool, r: Result<&1, &1, Err, Res>) -> Result<&1, &1, Err, Res> & Maybe<&2, String>:
4331 match idem:
4332 case False{}:
4333 (r, None{})
4334 case True{}:
4335 retry.judge.try(r)
4336
4337# ponytail: a failed random source gives jitter 0, so the wait is the lower half.
4338def retry.jitter(r: Result<&1, &1, U32 & String, U32>) -> U32:
4339 match r:
4340 case Fail{e}:
4341 0
4342 case Done{x}:
4343 x
4344
4345def retry.sleep(+v: String, n: Nat) -> IO(Unit):
4346 do IO<Unit>:
4347 now : Time.Instant <- Time.now()
4348 rnd : Result<&1, &1, U32 & String, U32> <- IO.random_u32()
4349 IO.sleep(retry.delay(v, now, n, retry.jitter(rnd)))
4350
4351def retry.kept(body: Bytes.Bytes, j: Result<&1, &1, Err, Res> & Maybe<&2, String>) -> Bytes.Bytes & Result<&1, &1, Err, Res> & Maybe<&2, String>:
4352 (r, m) = j
4353 (body, r, m)
4354
4355# One fetch of the copy; the body comes back for the next try.
4356def retry.one(+idem: Bool, +method: String, +url: String, +headers: Map<&2, List<&2, String>>,
4357 r: Bytes.Bytes & Bytes.Bytes) -> IO(Bytes.Bytes & Result<&1, &1, Err, Res> & Maybe<&2, String>):
4358 (body, spare) = r
4359 do IO<Bytes.Bytes & Result<&1, &1, Err, Res> & Maybe<&2, String>>:
4360 got : Result<&1, &1, Err, Res> <- fetch(method, url, headers, spare)
4361 return retry.kept(body, retry.judge(idem, got))
4362
4363# left: retries still allowed. n: the retry to wait for next, 0 first.
4364def retry.go(left: Nat, +n: Nat, +idem: Bool, +method: String, +url: String,
4365 +headers: Map<&2, List<&2, String>>,
4366 t: Bytes.Bytes & Result<&1, &1, Err, Res> & Maybe<&2, String>) -> IO(Result<&1, &1, Err, Res>):
4367 match left:
4368 case 0n:
4369 (body, r, m) = t
4370 IO.pure(Result<&1, &1, Err, Res>, r)
4371 case 1n+p:
4372 (body, r, m) = t
4373 match m:
4374 case None{}:
4375 IO.pure(Result<&1, &1, Err, Res>, r)
4376 case Some{v}:
4377 do IO<Result<&1, &1, Err, Res>>:
4378 retry.sleep(v, n)
4379 tried : Bytes.Bytes & Result<&1, &1, Err, Res> & Maybe<&2, String> <-
4380 retry.one(idem, method, url, headers, Bytes.slice(body, 0, 4294967295))
4381 retry.go(p, 1n+n, idem, method, url, headers, tried)
4382
4383# fetch.retry(n, method, url, headers, body) is fetch, tried again up to n times while an
4384# idempotent method (GET, HEAD, OPTIONS, TRACE, PUT, DELETE) gets a connect error, a timeout,
4385# or 408, 429, 500, 502, 503, or 504. POST, PATCH and other methods get one try. It waits
4386# Retry-After (seconds or HTTP-date, at most 30 s) when given, else the backoff. When retries
4387# run out, the last response or error comes back as it was.
4388def retry.start(enabled: Bool, n: U32, +method: String, +url: String,
4389 +headers: Map<&2, List<&2, String>>, body: Bytes.Bytes) ->
4390 IO(Result<&1, &1, Err, Res>):
4391 match enabled:
4392 case False{}:
4393 fetch(method, url, headers, body)
4394 case True{}:
4395 do IO<Result<&1, &1, Err, Res>>:
4396 first : Bytes.Bytes & Result<&1, &1, Err, Res> & Maybe<&2, String> <-
4397 retry.one(True{}, method, url, headers, Bytes.slice(body, 0, 4294967295))
4398 retry.go(U32.to_nat(n), 0n, True{}, method, url, headers, first)
4399
4400def fetch.retry(+n: U32, +method: String, +url: String,
4401 +headers: Map<&2, List<&2, String>>, body: Bytes.Bytes) ->
4402 IO(Result<&1, &1, Err, Res>):
4403 retry.start(Bool.and(U32.is_ne(n, 0), pool.idempotent(method)),
4404 n, method, url, headers, body)
4405
4406# Streaming (a body read or sent in pieces). A decoded stream owns its decoders.
4407# What the next read returns: read more, a raw piece, a decoded piece, the end, or an error.
4408type Po is Type:
4409 PoNone{}
4410 PoPiece{b: Bytes.Bytes}
4411 PoReady{b: Bytes.Bytes}
4412 PoEnd{}
4413 PoBad{e: Err}
4414
4415type Stream is Type:
4416 Stream{tls: Bool, s: Socket, ms: U32, res: Res, rb: Rb, out: Po, decs: List<&1, Zlib.Decoder>}
4417
4418type Pc is Type:
4419 Pc{rb: Rb, out: Po}
4420
4421# A body piece, or none when empty: more reads the next piece, and not more is the end.
4422def pc.po(more: Bool, empty: Bool, b: Bytes.Bytes) -> Po:
4423 match empty:
4424 case True{}:
4425 Bool.pick(Po, more, PoNone{}, PoEnd{})
4426 case False{}:
4427 PoPiece{b}
4428
4429def pc.piece(more: Bool, +rb: Rb, b: Bytes.Bytes) -> Pc:
4430 Bytes.Bytes{+len, buf} = b
4431 Pc{rb, pc.po(more, U32.is_zero(len), Bytes.Bytes{len, buf})}
4432
4433def pc.fed.of(b: Bytes.Bytes, st: Rb) -> Pc:
4434 match st:
4435 case RbDone{}:
4436 pc.piece(False{}, RbDone{}, b)
4437 case RbBad{}:
4438 Pc{RbDone{}, PoBad{ErrBad{}}}
4439 case RbLen{n}:
4440 pc.piece(True{}, RbLen{n}, b)
4441 case RbChunk{st}:
4442 pc.piece(True{}, RbChunk{st}, b)
4443 case RbClose{}:
4444 pc.piece(True{}, RbClose{}, b)
4445
4446def pc.fed(bf: Bf) -> Pc:
4447 Bf{st, parts, rest} = bf
4448 pc.fed.of(rb.body(parts), st)
4449
4450# The body bytes that just arrived: what they add to the body, and how it ends.
4451def pc.of(rb: Rb, piece: Bytes.Bytes) -> Pc:
4452 pc.fed(rb.feed(rb, Nil{}, piece))
4453
4454# The server closed. Only a close-delimited body may end this way (RFC 9112 §8).
4455def pc.end(ok: Bool) -> Pc:
4456 match ok:
4457 case True{}:
4458 Pc{RbDone{}, PoEnd{}}
4459 case False{}:
4460 Pc{RbDone{}, PoBad{ErrBad{}}}
4461
4462def pc.eof(st: Rb) -> Pc:
4463 pc.end(rb.eof(st))
4464
4465def stream.mk(+tls: Bool, s: Socket, +ms: U32, res: Res, decs: List<&1, Zlib.Decoder>, pc: Pc) -> Stream:
4466 Pc{rb, out} = pc
4467 Stream{tls, s, ms, res, rb, out, decs}
4468
4469def stream.got.piece(+tls: Bool, s: Socket, +ms: U32, res: Res, decs: List<&1, Zlib.Decoder>, +rb: Rb, p: U32 & Array<U32>) -> Stream:
4470 (+len, buf) = p
4471 stream.mk(tls, s, ms, res, decs, Bool.pick(Pc, U32.is_zero(len), pc.eof(rb), pc.of(rb, Bytes.Bytes{len, buf})))
4472
4473def stream.got(+tls: Bool, +ms: U32, res: Res, decs: List<&1, Zlib.Decoder>, +rb: Rb, m: Socket & Result<&1, &1, U32 & String, U32 & Array<U32>>) -> Stream:
4474 (s, r) = m
4475 match r:
4476 case Fail{(+code, why)}:
4477 Stream{tls, s, ms, res, RbDone{}, PoBad{err.or_late(code, ErrRead{code, why})}, decs}
4478 case Done{p}:
4479 stream.got.piece(tls, s, ms, res, decs, rb, p)
4480
4481def stream.after(+rb: Rb) -> Po:
4482 match rb:
4483 case RbDone{}:
4484 PoEnd{}
4485 case RbBad{}:
4486 PoEnd{}
4487 case RbLen{n}:
4488 PoNone{}
4489 case RbChunk{st}:
4490 PoNone{}
4491 case RbClose{}:
4492 PoNone{}
4493
4494type Fed is Type:
4495 Fed{decs: List<&1, Zlib.Decoder>, body: Result<&1, &1, Err, Bytes.Bytes>}
4496
4497def stream.feed.received(done: List<&1, Zlib.Decoder>, m: Zlib.Decoder & Result<&1, &1, U32 & String, U32 & Array<U32>>) -> Fed:
4498 (d, r) = m
4499 match r:
4500 case Fail{e}:
4501 Fed{d <> done, Fail{ErrBad{}}}
4502 case Done{(+len, buf)}:
4503 Fed{d <> done, Done{Bytes.Bytes{len, buf}}}
4504
4505def stream.feed.step(st: Fed, d: Zlib.Decoder) -> IO(Fed):
4506 Fed{done, body} = st
4507 match body:
4508 case Fail{e}:
4509 IO.pure(Fed, Fed{d <> done, Fail{e}})
4510 case Done{b}:
4511 Bytes.Bytes{+len, buf} = b
4512 do IO<Fed>:
4513 m : Zlib.Decoder & Result<&1, &1, U32 & String, U32 & Array<U32>> <-
4514 Zlib.dec.feed.words(d, 16777216, len, buf)
4515 return stream.feed.received(done, m)
4516
4517def stream.feed.one(prev: IO(Fed), d: Zlib.Decoder) -> IO(Fed):
4518 do IO<Fed>:
4519 st : Fed <- prev
4520 stream.feed.step(st, d)
4521
4522def stream.feed.reverse(st: Fed) -> Fed:
4523 Fed{done, body} = st
4524 Fed{List.reverse(&1, Zlib.Decoder, done), body}
4525
4526def stream.feed.all(decs: List<&1, Zlib.Decoder>, b: Bytes.Bytes) -> IO(Fed):
4527 do IO<Fed>:
4528 st : Fed <- List.foldl(~&1, ~Zlib.Decoder, ~IO(Fed), ~stream.feed.one, decs,
4529 IO.pure(Fed, Fed{Nil{}, Done{b}}))
4530 return stream.feed.reverse(st)
4531
4532def stream.ready(empty: Bool, +rb: Rb, b: Bytes.Bytes) -> Po:
4533 match empty:
4534 case True{}:
4535 stream.after(rb)
4536 case False{}:
4537 PoReady{b}
4538
4539def stream.feed.got(+tls: Bool, s: Socket, +ms: U32, res: Res, +rb: Rb, st: Fed) -> Stream:
4540 Fed{decs, body} = st
4541 match body:
4542 case Fail{e}:
4543 Stream{tls, s, ms, res, rb, PoBad{e}, decs}
4544 case Done{b}:
4545 Bytes.Bytes{+len, buf} = b
4546 Stream{tls, s, ms, res, rb, stream.ready(U32.is_zero(len), rb, Bytes.Bytes{len, buf}), decs}
4547
4548def stream.feed.st(st: Stream, b: Bytes.Bytes) -> IO(Stream):
4549 Stream{+tls, s, +ms, res, +rb, out, decs} = st
4550 match decs:
4551 case Nil{}:
4552 IO.pure(Stream, Stream{tls, s, ms, res, rb, PoReady{b}, Nil{}})
4553 case Con{d, rest}:
4554 do IO<Stream>:
4555 fed : Fed <- stream.feed.all(Con{d, rest}, b)
4556 return stream.feed.got(tls, s, ms, res, rb, fed)
4557
4558def stream.finish.ok(r: Result<&1, &1, U32 & String, Unit>) -> Bool:
4559 match r:
4560 case Fail{e}:
4561 False{}
4562 case Done{u}:
4563 True{}
4564
4565def stream.finish(decs: List<&1, Zlib.Decoder>) -> IO(Bool):
4566 match decs:
4567 case Nil{}:
4568 IO.pure(Bool, True{})
4569 case Con{d, rest}:
4570 do IO<Bool>:
4571 r : Result<&1, &1, U32 & String, Unit> <- Zlib.dec.finish(d)
4572 tail : Bool <- stream.finish(rest)
4573 return Bool.and(stream.finish.ok(r), tail)
4574
4575def stream.ended(good: Bool, +tls: Bool, s: Socket, +ms: U32, res: Res, +rb: Rb) ->
4576 Stream & Result<&1, &1, Err, Maybe<&1, Bytes.Bytes>>:
4577 match good:
4578 case True{}:
4579 (Stream{tls, s, ms, res, rb, PoEnd{}, Nil{}}, Done{None{}})
4580 case False{}:
4581 (Stream{tls, s, ms, res, rb, PoBad{ErrBad{}}, Nil{}}, Fail{ErrBad{}})
4582
4583# The next piece of the body; None at the end. A piece is never empty.
4584@unsafe
4585def stream.read(st: Stream) -> IO(Stream & Result<&1, &1, Err, Maybe<&1, Bytes.Bytes>>):
4586 Stream{+tls, s, +ms, res, +rb, out, decs} = st
4587 match out:
4588 case PoPiece{b}:
4589 do IO<Stream & Result<&1, &1, Err, Maybe<&1, Bytes.Bytes>>>:
4590 next : Stream <- stream.feed.st(Stream{tls, s, ms, res, rb, PoNone{}, decs}, b)
4591 stream.read(next)
4592 case PoReady{b}:
4593 IO.pure(Stream & Result<&1, &1, Err, Maybe<&1, Bytes.Bytes>>,
4594 (Stream{tls, s, ms, res, rb, stream.after(rb), decs}, Done{Some{b}}))
4595 case PoEnd{}:
4596 do IO<Stream & Result<&1, &1, Err, Maybe<&1, Bytes.Bytes>>>:
4597 good : Bool <- stream.finish(decs)
4598 return stream.ended(good, tls, s, ms, res, rb)
4599 case PoBad{+e}:
4600 IO.pure(Stream & Result<&1, &1, Err, Maybe<&1, Bytes.Bytes>>,
4601 (Stream{tls, s, ms, res, rb, PoBad{e}, decs}, Fail{e}))
4602 case PoNone{}:
4603 do IO<Stream & Result<&1, &1, Err, Maybe<&1, Bytes.Bytes>>>:
4604 m : Socket & Result<&1, &1, U32 & String, U32 & Array<U32>> <- io.recv.words(tls, s, 65536, ms)
4605 stream.read(stream.got(tls, ms, res, decs, rb, m))
4606
4607# Status and headers. Its body is empty: read the body with stream.read.
4608def stream.res(st: Stream) -> Stream & Res:
4609 Stream{tls, s, ms, res, rb, out, decs} = st
4610 Res{+status, +headers, body} = res
4611 (Stream{tls, s, ms, Res{status, headers, body}, rb, out, decs}, Res{status, headers, Bytes.new(0)})
4612
4613def stream.close(st: Stream) -> IO(Unit):
4614 Stream{tls, s, ms, res, rb, out, decs} = st
4615 do IO<Unit>:
4616 good : Bool <- stream.finish(decs)
4617 io.close(tls, s)
4618
4619# Head read state: still scanning, cut short or bad, or the head with the bytes after it.
4620type Sh is Type:
4621 ShMore{buf: Bytes.Bytes, k: U32}
4622 ShBad{err: Maybe<&2, Err>}
4623 ShRes{res: Res, rb: Rb, rest: Bytes.Bytes}
4624
4625def sh.of(hs: Hs) -> Sh:
4626 match hs:
4627 case HsWait{buf, k}:
4628 ShMore{buf, k}
4629 case HsBad{}:
4630 ShBad{None{}}
4631 case HsSeek{buf, from, k}:
4632 ShBad{None{}}
4633 case HsRes{res, rb, rest}:
4634 ShRes{res, rb, rest}
4635
4636def sh.piece(+head: Bool, buf: Bytes.Bytes, +k: U32, p: U32 & Array<U32>) -> Sh:
4637 (+len, b) = p
4638 Bool.pick(Sh, U32.is_zero(len), ShBad{None{}}, sh.of(hs.more(head, k, buf, Bytes.Bytes{len, b})))
4639
4640def sh.next(+head: Bool, buf: Bytes.Bytes, +k: U32, m: Socket & Result<&1, &1, U32 & String, U32 & Array<U32>>) -> Socket & Sh:
4641 (s, r) = m
4642 match r:
4643 case Fail{(+code, why)}:
4644 (s, ShBad{Some{err.or_late(code, ErrRead{code, why})}})
4645 case Done{p}:
4646 (s, sh.piece(head, buf, k, p))
4647
4648def fetch.fail.of(r: Result<&1, &1, Err, Res>) -> Result<&1, &1, Err, Stream>:
4649 match r:
4650 case Fail{e}:
4651 Fail{e}
4652 case Done{res}:
4653 Fail{ErrBad{}}
4654
4655# Reads until the final head is in; the body bytes that came with it are the first piece.
4656@unsafe
4657def stream.head(+tls: Bool, +ms: U32, +head: Bool, st: Socket & Sh) -> IO(Result<&1, &1, Err, Stream>):
4658 (s, sh) = st
4659 match sh:
4660 case ShMore{buf, +k}:
4661 do IO<Result<&1, &1, Err, Stream>>:
4662 m : Socket & Result<&1, &1, U32 & String, U32 & Array<U32>> <- io.recv.words(tls, s, 65536, ms)
4663 stream.head(tls, ms, head, sh.next(head, buf, k, m))
4664 case ShBad{err}:
4665 do IO<Result<&1, &1, Err, Stream>>:
4666 r : Result<&1, &1, Err, Res> <- fetch.bad(tls, s, err)
4667 return fetch.fail.of(r)
4668 case ShRes{res, rb, rest}:
4669 IO.pure(Result<&1, &1, Err, Stream>, Done{stream.mk(tls, s, ms, res, Nil{}, pc.of(rb, rest))})
4670
4671def stream.sent(+tls: Bool, +ms: U32, +head: Bool, m: Socket & Result<&1, &1, U32 & String, Unit>) -> IO(Result<&1, &1, Err, Stream>):
4672 (s, r) = m
4673 match r:
4674 case Fail{(+code, why)}:
4675 do IO<Result<&1, &1, Err, Stream>>:
4676 io.close(tls, s)
4677 return Fail{err.or_late(code, ErrWrite{code, why})}
4678 case Done{u}:
4679 stream.head(tls, ms, head, (s, ShMore{Bytes.new(0), 0}))
4680
4681def stream.conn(r: Result<&1, &1, Err, Conn>, +ms: U32, +head: Bool, wire: Bytes.Bytes) -> IO(Result<&1, &1, Err, Stream>):
4682 match r:
4683 case Fail{e}:
4684 IO.pure(Result<&1, &1, Err, Stream>, Fail{e})
4685 case Done{c}:
4686 match c:
4687 case Conn{+tls, s}:
4688 do IO<Result<&1, &1, Err, Stream>>:
4689 sent : Socket & Result<&1, &1, U32 & String, Unit> <- io.send.bytes(tls, s, wire)
4690 stream.sent(tls, ms, head, sent)
4691 case ConnH2{s, client}:
4692 do IO<Result<&1, &1, Err, Stream>>:
4693 Wire.tls.close(s)
4694 return Fail{ErrBad{}}
4695
4696# One connection per stream; the request says close.
4697def stream.origin(+ms: U32, +head: Bool, wire: Bytes.Bytes, a: Url.Abs, known: Bool) -> IO(Result<&1, &1, Err, Stream>):
4698 Url.Abs{+scheme, +host, +port, target} = a
4699 match known:
4700 case False{}:
4701 IO.pure(Result<&1, &1, Err, Stream>, Fail{ErrUrl{}})
4702 case True{}:
4703 do IO<Result<&1, &1, Err, Stream>>:
4704 ips : List<&2, String> <- Dns.resolve.all(host)
4705 c : Result<&1, &1, Err, Conn> <- conn.open.all(String.eq(scheme, "https"), ms, host, port, ips, None{}, False{})
4706 stream.conn(c, ms, head, wire)
4707
4708def stream.one.of(+method: String, +url: Url.Abs, +headers: Map<&2, List<&2, String>>, +ms: U32, r: Bytes.Bytes & Bytes.Bytes) -> IO(Hop & Result<&1, &1, Err, Stream>):
4709 Url.Abs{scheme, host, port, +target} = url
4710 (body, wire) = r
4711 do IO<Hop & Result<&1, &1, Err, Stream>>:
4712 got : Result<&1, &1, Err, Stream> <- stream.origin(ms, String.eq(method, "HEAD"), encode_req.on(method, target, Url.host_field(url), headers, wire, True{}), url, pool.scheme.ok(url))
4713 return (Hop{method, url, headers, body}, got)
4714
4715# One request on its own connection. The hop comes back for the redirect.
4716def stream.one(h: Hop, +ms: U32) -> IO(Hop & Result<&1, &1, Err, Stream>):
4717 Hop{+method, +url, +headers, body} = h
4718 stream.one.of(method, url, headers, ms, Bytes.slice(body, 0, 4294967295))
4719
4720# Go: the next request. Drop: close this stream, then go on. Done: the answer.
4721type Sn is Type:
4722 SnGo{left: Nat, hop: Hop}
4723 SnDrop{st: Stream, next: Next}
4724 SnDone{r: Result<&1, &1, Err, Stream>}
4725
4726def sn.of(n: Next) -> Sn:
4727 match n:
4728 case NGo{l, h}:
4729 SnGo{l, h}
4730 case NStop{}:
4731 SnDone{Fail{ErrRedirect{}}}
4732 case NDone{m}:
4733 match m:
4734 case Fail{e}:
4735 SnDone{Fail{e}}
4736 case Done{r}:
4737 SnDone{Fail{ErrBad{}}}
4738
4739def stream.decide.n(st: Stream, n: Next) -> Sn:
4740 match n:
4741 case NDone{m}:
4742 SnDone{Done{st}}
4743 case NGo{l, h}:
4744 SnDrop{st, NGo{l, h}}
4745 case NStop{}:
4746 SnDrop{st, NStop{}}
4747
4748def stream.decide.of(+left: Nat, hop: Hop, sr: Stream & Res) -> Sn:
4749 (st, res) = sr
4750 stream.decide.n(st, fetch.decide(left, hop, Done{res}))
4751
4752def stream.decide(+left: Nat, x: Hop & Result<&1, &1, Err, Stream>) -> Sn:
4753 (hop, r) = x
4754 match r:
4755 case Fail{e}:
4756 SnDone{Fail{e}}
4757 case Done{st}:
4758 stream.decide.of(left, hop, stream.res(st))
4759
4760@unsafe
4761def stream.hops(+ms: U32, sn: Sn) -> IO(Result<&1, &1, Err, Stream>):
4762 match sn:
4763 case SnDone{r}:
4764 IO.pure(Result<&1, &1, Err, Stream>, r)
4765 case SnGo{+left, hop}:
4766 do IO<Result<&1, &1, Err, Stream>>:
4767 x : Hop & Result<&1, &1, Err, Stream> <- stream.one(hop, ms)
4768 stream.hops(ms, stream.decide(left, x))
4769 case SnDrop{st, next}:
4770 do IO<Result<&1, &1, Err, Stream>>:
4771 stream.close(st)
4772 stream.hops(ms, sn.of(next))
4773
4774type Opened is Type:
4775 Opened{decs: List<&1, Zlib.Decoder>, bad: Bool}
4776
4777def stream.open.got(st: Opened, r: Result<&1, &1, U32 & String, Zlib.Decoder>) -> Opened:
4778 Opened{decs, bad} = st
4779 match r:
4780 case Fail{e}:
4781 Opened{decs, True{}}
4782 case Done{d}:
4783 Opened{d <> decs, bad}
4784
4785def stream.open.add(st: Opened, m: IO(Result<&1, &1, U32 & String, Zlib.Decoder>)) -> IO(Opened):
4786 do IO<Opened>:
4787 r : Result<&1, &1, U32 & String, Zlib.Decoder> <- m
4788 return stream.open.got(st, r)
4789
4790def stream.open.zstd(zstd: Bool, st: Opened) -> IO(Opened):
4791 match zstd:
4792 case True{}:
4793 stream.open.add(st, Zlib.zstd.new())
4794 case False{}:
4795 IO.pure(Opened, st)
4796
4797def stream.open.br(br: Bool, +c: String, st: Opened) -> IO(Opened):
4798 match br:
4799 case True{}:
4800 stream.open.add(st, Zlib.brotli.new())
4801 case False{}:
4802 stream.open.zstd(String.eq(c, "zstd"), st)
4803
4804def stream.open.gz(gz: Bool, +c: String, st: Opened) -> IO(Opened):
4805 match gz:
4806 case True{}:
4807 stream.open.add(st, Zlib.inflate.new())
4808 case False{}:
4809 stream.open.br(String.eq(c, "br"), c, st)
4810
4811def stream.open.step(+c: String, st: Opened) -> IO(Opened):
4812 Opened{decs, bad} = st
4813 match bad:
4814 case True{}:
4815 IO.pure(Opened, Opened{decs, True{}})
4816 case False{}:
4817 stream.open.gz(Bool.or(String.eq(c, "gzip"), Bool.or(String.eq(c, "x-gzip"), String.eq(c, "deflate"))),
4818 c, Opened{decs, False{}})
4819
4820def stream.open.one(prev: IO(Opened), c: String) -> IO(Opened):
4821 do IO<Opened>:
4822 st : Opened <- prev
4823 stream.open.step(c, st)
4824
4825def stream.open.all(cs: List<&2, String>) -> IO(Opened):
4826 List.foldl(~&2, ~String, ~IO(Opened), ~stream.open.one, cs, IO.pure(Opened, Opened{Nil{}, False{}}))
4827
4828def stream.put.decs(st: Stream, decs: List<&1, Zlib.Decoder>) -> Stream:
4829 Stream{tls, s, ms, res, rb, out, old} = st
4830 Stream{tls, s, ms, res, rb, out, decs}
4831
4832def stream.init.opened(st: Stream, opened: Opened) -> IO(Result<&1, &1, Err, Stream>):
4833 Opened{decs, bad} = opened
4834 match bad:
4835 case True{}:
4836 do IO<Result<&1, &1, Err, Stream>>:
4837 stream.close(stream.put.decs(st, decs))
4838 return Fail{ErrBad{}}
4839 case False{}:
4840 IO.pure(Result<&1, &1, Err, Stream>, Done{stream.put.decs(st, List.reverse(&1, Zlib.Decoder, decs))})
4841
4842def stream.init.known(known: Bool, st: Stream, cs: List<&2, String>) -> IO(Result<&1, &1, Err, Stream>):
4843 match known:
4844 case False{}:
4845 IO.pure(Result<&1, &1, Err, Stream>, Done{st})
4846 case True{}:
4847 do IO<Result<&1, &1, Err, Stream>>:
4848 opened : Opened <- stream.open.all(cs)
4849 stream.init.opened(st, opened)
4850
4851def stream.init.st(+enc: String, st: Stream) -> IO(Result<&1, &1, Err, Stream>):
4852 Stream{tls, s, ms, res, rb, out, decs} = st
4853 Res{+status, +headers, body} = res
4854 +cs = List.reverse(&2, String, ce.split(fields(headers, "content-encoding")))
4855 stream.init.known(ce.known(cs, Con{"identity", Con{"x-gzip", ce.split(Con{enc, Nil{}})}}),
4856 Stream{tls, s, ms, Res{status, headers, body}, rb, out, decs}, cs)
4857
4858def stream.init(+enc: String, r: Result<&1, &1, Err, Stream>) -> IO(Result<&1, &1, Err, Stream>):
4859 match r:
4860 case Fail{e}:
4861 IO.pure(Result<&1, &1, Err, Stream>, Fail{e})
4862 case Done{st}:
4863 stream.init.st(enc, st)
4864
4865def stream.start(method: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes, u: Maybe<&2, Url.Abs>) -> Sn:
4866 match u:
4867 case None{}:
4868 SnDone{Fail{ErrUrl{}}}
4869 case Some{a}:
4870 SnGo{20n, Hop{method, a, req.put(Map.to_list(&2, List<&2, String>, headers), empty()), body}}
4871
4872# Open a raw stream. Its body bytes and headers remain as sent.
4873def open.raw.with(method: String, url: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes, +ms: U32) -> IO(Result<&1, &1, Err, Stream>):
4874 stream.hops(ms, stream.start(method, headers, body, Url.absolute(url)))
4875
4876def open.raw(method: String, url: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes) -> IO(Result<&1, &1, Err, Stream>):
4877 open.raw.with(method, url, headers, body, 30000)
4878
4879def open.with.enc(+enc: String, method: String, url: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes, +ms: U32) -> IO(Result<&1, &1, Err, Stream>):
4880 do IO<Result<&1, &1, Err, Stream>>:
4881 r : Result<&1, &1, Err, Stream> <-
4882 stream.hops(ms, stream.start(method, accept.enc(headers, enc), body, Url.absolute(url)))
4883 stream.init(enc, r)
4884
4885# Follow redirects, then decode each body piece by Content-Encoding. Unknown codings stay raw.
4886def open.with(method: String, url: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes, +ms: U32) -> IO(Result<&1, &1, Err, Stream>):
4887 do IO<Result<&1, &1, Err, Stream>>:
4888 enc : String <- codings()
4889 open.with.enc(enc, method, url, headers, body, ms)
4890
4891def open(method: String, url: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes) -> IO(Result<&1, &1, Err, Stream>):
4892 open.with(method, url, headers, body, 30000)
4893
4894# Upload: the request body sent in chunks (RFC 9112 §7.1). err: the first failed write.
4895type Up is Type:
4896 Up{tls: Bool, s: Socket, ms: U32, head: Bool, err: Maybe<&2, Err>}
4897
4898def hex.digit(+n: U32) -> Char:
4899 Chr{Bool.pick(U32, U32.is_lt(n, 10), (48 + n : U32), (87 + n : U32))}
4900
4901def hex.go(k: Nat, +n: U32, acc: String) -> String:
4902 match k:
4903 case 0n:
4904 acc
4905 case 1n+p:
4906 hex.go(p, U32.shrn(n, 4n), SCon{hex.digit(U32.and(n, 15)), acc})
4907
4908def hex.trim(+s: String) -> String:
4909 match s:
4910 case SNil{}:
4911 SNil{}
4912 case SCon{Chr{+c}, +t}:
4913 Bool.pick(String, Bool.and(U32.is_eq(c, 48), Bool.not(String.is_empty(t))), hex.trim(t), SCon{Chr{c}, t})
4914
4915def hex(+n: U32) -> String:
4916 hex.trim(hex.go(8n, n, ""))
4917
4918def up.sent(+tls: Bool, +ms: U32, +head: Bool, m: Socket & Result<&1, &1, U32 & String, Unit>) -> Up:
4919 (s, r) = m
4920 match r:
4921 case Fail{(+code, why)}:
4922 Up{tls, s, ms, head, Some{err.or_late(code, ErrWrite{code, why})}}
4923 case Done{u}:
4924 Up{tls, s, ms, head, None{}}
4925
4926def up.conn(r: Result<&1, &1, Err, Conn>, +ms: U32, +head: Bool, wire: String) -> IO(Result<&1, &1, Err, Up>):
4927 match r:
4928 case Fail{e}:
4929 IO.pure(Result<&1, &1, Err, Up>, Fail{e})
4930 case Done{c}:
4931 match c:
4932 case Conn{+tls, s}:
4933 do IO<Result<&1, &1, Err, Up>>:
4934 sent : Socket & Result<&1, &1, U32 & String, Unit> <- io.send.bytes(tls, s, Bytes.from_string(wire))
4935 return Done{up.sent(tls, ms, head, sent)}
4936 case ConnH2{s, client}:
4937 do IO<Result<&1, &1, Err, Up>>:
4938 Wire.tls.close(s)
4939 return Fail{ErrBad{}}
4940
4941def up.head(+method: String, +target: String, +hf: String, +headers: Map<&2, List<&2, String>>) -> String:
4942 request(method, target, set(set(set(req.put(Map.to_list(&2, List<&2, String>, headers), empty()), "host", hf), "connection", "close"), "transfer-encoding", "chunked"), "")
4943
4944def up.origin(+method: String, +ms: U32, headers: Map<&2, List<&2, String>>, a: Url.Abs, known: Bool) -> IO(Result<&1, &1, Err, Up>):
4945 Url.Abs{+scheme, +host, +port, +target} = a
4946 match known:
4947 case False{}:
4948 IO.pure(Result<&1, &1, Err, Up>, Fail{ErrUrl{}})
4949 case True{}:
4950 do IO<Result<&1, &1, Err, Up>>:
4951 ips : List<&2, String> <- Dns.resolve.all(host)
4952 c : Result<&1, &1, Err, Conn> <- conn.open.all(String.eq(scheme, "https"), ms, host, port, ips, None{}, False{})
4953 up.conn(c, ms, String.eq(method, "HEAD"), up.head(method, target, Url.host_field(a), headers))
4954
4955def up.url(+method: String, +ms: U32, headers: Map<&2, List<&2, String>>, u: Maybe<&2, Url.Abs>) -> IO(Result<&1, &1, Err, Up>):
4956 match u:
4957 case None{}:
4958 IO.pure(Result<&1, &1, Err, Up>, Fail{ErrUrl{}})
4959 case Some{+a}:
4960 up.origin(method, ms, headers, a, pool.scheme.ok(a))
4961
4962# Http.upload(method, url, headers) sends the head. A streamed body cannot be replayed, so redirects are not followed.
4963def upload.with(+method: String, url: String, headers: Map<&2, List<&2, String>>, +ms: U32) -> IO(Result<&1, &1, Err, Up>):
4964 up.url(method, ms, headers, Url.absolute(url))
4965
4966def upload(+method: String, url: String, headers: Map<&2, List<&2, String>>) -> IO(Result<&1, &1, Err, Up>):
4967 upload.with(method, url, headers, 30000)
4968
4969def up.wrote(+tls: Bool, +ms: U32, +head: Bool, m: Socket & Result<&1, &1, U32 & String, Unit>) -> Up & Result<&2, &2, Err, Unit>:
4970 (s, r) = m
4971 match r:
4972 case Fail{(+code, why)}:
4973 +e = err.or_late(code, ErrWrite{code, why})
4974 (Up{tls, s, ms, head, Some{e}}, Fail{e})
4975 case Done{u}:
4976 (Up{tls, s, ms, head, None{}}, Done{Unit{}})
4977
4978# One write per chunk, so the size line and the data do not wait on each other (Nagle).
4979def up.put(+tls: Bool, s: Socket, +ms: U32, +head: Bool, +len: U32, piece: Bytes.Bytes, skip: Bool) -> IO(Up & Result<&2, &2, Err, Unit>):
4980 match skip:
4981 case True{}:
4982 IO.pure(Up & Result<&2, &2, Err, Unit>, (Up{tls, s, ms, head, None{}}, Done{Unit{}}))
4983 case False{}:
4984 do IO<Up & Result<&2, &2, Err, Unit>>:
4985 sent : Socket & Result<&1, &1, U32 & String, Unit> <- io.send.bytes(tls, s, Bytes.concat(Con{Bytes.from_string(hex(len) ++ "\r\n"), Con{piece, Con{Bytes.from_string("\r\n"), Nil{}}}}))
4986 return up.wrote(tls, ms, head, sent)
4987
4988def up.chunk(+tls: Bool, s: Socket, +ms: U32, +head: Bool, piece: Bytes.Bytes) -> IO(Up & Result<&2, &2, Err, Unit>):
4989 Bytes.Bytes{+len, buf} = piece
4990 up.put(tls, s, ms, head, len, Bytes.Bytes{len, buf}, U32.is_zero(len))
4991
4992# One chunk. An empty piece sends nothing, since an empty chunk would end the body.
4993def upload.write(up: Up, piece: Bytes.Bytes) -> IO(Up & Result<&2, &2, Err, Unit>):
4994 Up{+tls, s, +ms, +head, err} = up
4995 match err:
4996 case Some{+e}:
4997 IO.pure(Up & Result<&2, &2, Err, Unit>, (Up{tls, s, ms, head, Some{e}}, Fail{e}))
4998 case None{}:
4999 up.chunk(tls, s, ms, head, piece)
5000
5001# Ends the body and returns the response as a stream.
5002def upload.finish(up: Up) -> IO(Result<&1, &1, Err, Stream>):
5003 Up{+tls, s, +ms, +head, err} = up
5004 match err:
5005 case Some{e}:
5006 do IO<Result<&1, &1, Err, Stream>>:
5007 io.close(tls, s)
5008 return Fail{e}
5009 case None{}:
5010 do IO<Result<&1, &1, Err, Stream>>:
5011 sent : Socket & Result<&1, &1, U32 & String, Unit> <- io.send.bytes(tls, s, Bytes.from_string("0\r\n\r\n"))
5012 stream.sent(tls, ms, head, sent)
5013
5014def reply.bytes(res: Res, head: Bool, close: Bool) -> Bytes.Bytes:
5015 Res{+status, +headers, body} = res
5016 encode.on(Res{status, Bool.pick(Map<&2, List<&2, String>>, close, set(headers, "connection", "close"), headers), body}, head)
5017
5018def reply.fail.bytes(+status: U32) -> Res:
5019 Res{status, empty(), Bytes.from_string(reason(status))}
5020
5021def reply.sent.close(m: Socket & Result<&1, &1, U32 & String, Unit>) -> IO(Unit):
5022 (s, r) = m
5023 Socket.close(s)
5024
5025def reply_fail(s: Socket, +status: U32) -> IO(Unit):
5026 do IO<Unit>:
5027 sent : Socket & Result<&1, &1, U32 & String, Unit> <- io.send.bytes(False{}, s, encode(reply.fail.bytes(status)))
5028 reply.sent.close(sent)
5029
5030
5031# The head is parsed once, when it is whole. Body pieces are kept as they come and joined once.
5032type Sv is Type:
5033 SvHead{buf: Bytes.Bytes}
5034 SvLen{req: Req, v11: Bool, left: U32, parts: List<&1, Bytes.Bytes>}
5035 SvChunk{req: Req, v11: Bool, n: U32, st: Dc, parts: List<&1, Bytes.Bytes>}
5036
5037# More: read on, first answering 100 Continue when cont is set.
5038type Turn is Type:
5039 TurnClose{}
5040 TurnFail{status: U32}
5041 TurnReq{req: Req, rest: Bytes.Bytes, v11: Bool}
5042 TurnMore{sv: Sv, cont: Bool}
5043
5044def serve.max() -> Nat:
5045 fetch.max()
5046
5047def sv.none() -> Sv:
5048 SvHead{Bytes.new(0)}
5049
5050def sv.body(req: Req, +v11: Bool, parts: List<&1, Bytes.Bytes>, rest: Bytes.Bytes) -> Turn:
5051 Req{method, path, headers, body} = req
5052 TurnReq{Req{method, path, headers, rb.body(parts)}, rest, v11}
5053
5054def sv.len.cut(req: Req, +v11: Bool, parts: List<&1, Bytes.Bytes>, +len: U32, +left: U32, r: Bytes.Bytes & Bytes.Bytes) -> Turn:
5055 (piece, last) = r
5056 sv.body(req, v11, Con{last, parts}, bytes.snd(Bytes.slice(piece, left, (len - left : U32))))
5057
5058def sv.len.have(short: Bool, req: Req, +v11: Bool, +left: U32, parts: List<&1, Bytes.Bytes>, +len: U32, piece: Bytes.Bytes) -> Turn:
5059 match short:
5060 case True{}:
5061 TurnMore{SvLen{req, v11, (left - len : U32), Con{piece, parts}}, False{}}
5062 case False{}:
5063 sv.len.cut(req, v11, parts, len, left, Bytes.slice(piece, 0, left))
5064
5065def sv.len(req: Req, +v11: Bool, +left: U32, parts: List<&1, Bytes.Bytes>, piece: Bytes.Bytes) -> Turn:
5066 Bytes.Bytes{+len, buf} = piece
5067 sv.len.have(U32.is_lt(len, left), req, v11, left, parts, len, Bytes.Bytes{len, buf})
5068
5069def sv.chunk.of(req: Req, +v11: Bool, +n: U32, c: Ck) -> Turn:
5070 Ck{st, parts, rest} = c
5071 match st:
5072 case DcDone{}:
5073 sv.body(req, v11, parts, rest)
5074 case DcBad{}:
5075 TurnFail{400}
5076 case DcSize{a, b}:
5077 TurnMore{SvChunk{req, v11, n, DcSize{a, b}, parts}, False{}}
5078 case DcExt{x}:
5079 TurnMore{SvChunk{req, v11, n, DcExt{x}, parts}, False{}}
5080 case DcSizeLf{x}:
5081 TurnMore{SvChunk{req, v11, n, DcSizeLf{x}, parts}, False{}}
5082 case DcData{k}:
5083 TurnMore{SvChunk{req, v11, n, DcData{k}, parts}, False{}}
5084 case DcDataCr{}:
5085 TurnMore{SvChunk{req, v11, n, DcDataCr{}, parts}, False{}}
5086 case DcDataLf{}:
5087 TurnMore{SvChunk{req, v11, n, DcDataLf{}, parts}, False{}}
5088 case DcTr{j}:
5089 TurnMore{SvChunk{req, v11, n, DcTr{j}, parts}, False{}}
5090
5091def sv.chunk.cap(big: Bool, req: Req, +v11: Bool, +n: U32, st: Dc, parts: List<&1, Bytes.Bytes>, piece: Bytes.Bytes) -> Turn:
5092 match big:
5093 case True{}:
5094 TurnFail{413}
5095 case False{}:
5096 sv.chunk.of(req, v11, n, ck(piece, st, parts))
5097
5098def sv.chunk(+max: Nat, req: Req, +v11: Bool, +n: U32, st: Dc, parts: List<&1, Bytes.Bytes>, piece: Bytes.Bytes) -> Turn:
5099 Bytes.Bytes{+len, buf} = piece
5100 +n2 = (n + len : U32)
5101 sv.chunk.cap(Bool.or(U32.is_lt(n2, n), Nat.is_lt(max, U32.to_nat(n2))), req, v11, n2, st, parts, Bytes.Bytes{len, buf})
5102
5103# RFC 9110 §10.1.1: answer 100 Continue only when the body is still to come.
5104def sv.cont(want: Bool, t: Turn) -> Turn:
5105 match t:
5106 case TurnMore{sv, c}:
5107 TurnMore{sv, want}
5108 case TurnClose{}:
5109 TurnClose{}
5110 case TurnFail{s}:
5111 TurnFail{s}
5112 case TurnReq{req, rest, v11}:
5113 TurnReq{req, rest, v11}
5114
5115def sv.cl.k(big: Bool, req: Req, +v11: Bool, +k: U32, rest: Bytes.Bytes) -> Turn:
5116 match big:
5117 case True{}:
5118 TurnFail{413}
5119 case False{}:
5120 sv.len(req, v11, k, Nil{}, rest)
5121
5122def sv.cl(+max: Nat, req: Req, +v11: Bool, rest: Bytes.Bytes, n: Maybe<&2, U32>) -> Turn:
5123 match n:
5124 case None{}:
5125 TurnFail{400}
5126 case Some{+k}:
5127 sv.cl.k(Nat.is_lt(max, U32.to_nat(k)), req, v11, k, rest)
5128
5129def sv.frame(+max: Nat, req: Req, +v11: Bool, rest: Bytes.Bytes, te: Bool) -> Turn:
5130 Req{method, path, +headers, body} = req
5131 match te:
5132 case True{}:
5133 sv.chunk(max, Req{method, path, headers, body}, v11, 0, dc.start(), Nil{}, rest)
5134 case False{}:
5135 sv.cl(max, Req{method, path, headers, body}, v11, rest, parse_u32(header(headers, "content-length")))
5136
5137def sv.expects(+v11: Bool, +headers: Map<&2, List<&2, String>>) -> Bool:
5138 Bool.and(v11, String.eq(String.to_lower(header(headers, "expect")), "100-continue"))
5139
5140def sv.got.head(+max: Nat, +v11: Bool, rest: Bytes.Bytes, req: Req) -> Turn:
5141 Req{method, path, +headers, body} = req
5142 sv.cont(sv.expects(v11, headers), sv.frame(max, Req{method, path, headers, body}, v11, rest, has_header(headers, "transfer-encoding")))
5143
5144def sv.parsed(+max: Nat, +v11: Bool, rest: Bytes.Bytes, g: Got) -> Turn:
5145 match g:
5146 case GotBad{}:
5147 TurnFail{400}
5148 case GotMore{}:
5149 TurnFail{400}
5150 case GotReq{req}:
5151 TurnReq{req, rest, v11}
5152 case GotHead{req}:
5153 sv.got.head(max, v11, rest, req)
5154
5155def sv.split(+max: Nat, +hlen: U32, +len: U32, r: Bytes.Bytes & Bytes.Bytes) -> Turn:
5156 (buf, hb) = r
5157 +head = Bytes.to_string(hb)
5158 sv.parsed(max, req.v11(head), bytes.snd(Bytes.slice(buf, hlen, (len - hlen : U32))), parse.got(head))
5159
5160def sv.hit.none(big: Bool, buf: Bytes.Bytes) -> Turn:
5161 match big:
5162 case True{}:
5163 TurnFail{431}
5164 case False{}:
5165 TurnMore{SvHead{buf}, False{}}
5166
5167def sv.hit.some(big: Bool, +max: Nat, +hlen: U32, +len: U32, buf: Bytes.Bytes) -> Turn:
5168 match big:
5169 case True{}:
5170 TurnFail{431}
5171 case False{}:
5172 sv.split(max, hlen, len, Bytes.slice(buf, 0, hlen))
5173
5174# RFC 6585 §5: a head over 64 KiB is refused.
5175def sv.hit(+max: Nat, +len: U32, buf: Bytes.Bytes, at: Maybe<&2, U32>) -> Turn:
5176 match at:
5177 case None{}:
5178 sv.hit.none(U32.is_lt(65536, len), buf)
5179 case Some{+i}:
5180 +hlen = (i + 4 : U32)
5181 sv.hit.some(U32.is_lt(65536, hlen), max, hlen, len, buf)
5182
5183def sv.seek.of(+max: Nat, +len: U32, +from: U32, buf: Bytes.Bytes, r: Bytes.Bytes & Maybe<&2, U32>) -> Turn:
5184 (tail, m) = r
5185 sv.hit(max, len, buf, found.at(from, m))
5186
5187def sv.seek(+max: Nat, +len: U32, +from: U32, r: Bytes.Bytes & Bytes.Bytes) -> Turn:
5188 (buf, tail) = r
5189 sv.seek.of(max, len, from, buf, Bytes.find(tail, "\r\n\r\n"))
5190
5191# Only the new bytes, and the 3 before them, can finish the blank line.
5192def sv.head.at(+max: Nat, +from: U32, buf: Bytes.Bytes) -> Turn:
5193 Bytes.Bytes{+len, b} = buf
5194 sv.seek(max, len, from, Bytes.slice(Bytes.Bytes{len, b}, from, (len - from : U32)))
5195
5196def sv.head(+max: Nat, buf: Bytes.Bytes, piece: Bytes.Bytes) -> Turn:
5197 Bytes.Bytes{+ol, ob} = buf
5198 sv.head.at(max, Bool.pick(U32, U32.is_lt(ol, 3), 0, (ol - 3 : U32)), Bytes.append(Bytes.Bytes{ol, ob}, piece))
5199
5200def sv.closed.pick(empty: Bool) -> Turn:
5201 match empty:
5202 case True{}:
5203 TurnClose{}
5204 case False{}:
5205 TurnFail{400}
5206
5207def sv.closed.head(buf: Bytes.Bytes) -> Turn:
5208 Bytes.Bytes{+len, b} = buf
5209 sv.closed.pick(U32.is_eq(len, 0))
5210
5211# A close mid-request is a request cut short (RFC 9112 §8).
5212def sv.step(closed: Bool, +max: Nat, sv: Sv, piece: Bytes.Bytes) -> Turn:
5213 match closed:
5214 case True{}:
5215 match sv:
5216 case SvHead{buf}:
5217 sv.closed.head(buf)
5218 case SvLen{req, v11, left, parts}:
5219 TurnFail{400}
5220 case SvChunk{req, v11, n, st, parts}:
5221 TurnFail{400}
5222 case False{}:
5223 match sv:
5224 case SvHead{buf}:
5225 sv.head(max, buf, piece)
5226 case SvLen{req, +v11, +left, parts}:
5227 sv.len(req, v11, left, parts, piece)
5228 case SvChunk{req, +v11, +n, st, parts}:
5229 sv.chunk(max, req, v11, n, st, parts, piece)
5230
5231def sv.frame.req(t: Turn) -> Maybe<&1, String & String>:
5232 match t:
5233 case TurnReq{req, rest, v11}:
5234 Req{method, path, headers, body} = req
5235 Some{(Bytes.to_string(body), Bytes.to_string(rest))}
5236 case TurnMore{sv, c}:
5237 None{}
5238 case TurnFail{s}:
5239 None{}
5240 case TurnClose{}:
5241 None{}
5242
5243def sv.frame.go(xs: List<&2, String>, t: Turn) -> Maybe<&1, String & String>:
5244 match xs:
5245 case Nil{}:
5246 sv.frame.req(t)
5247 case Con{+x, rest}:
5248 match t:
5249 case TurnMore{sv, c}:
5250 sv.frame.go(rest, sv.step(False{}, serve.max(), sv, Bytes.from_string(x)))
5251 case TurnReq{req, r, v11}:
5252 sv.frame.req(TurnReq{req, r, v11})
5253 case TurnFail{s}:
5254 None{}
5255 case TurnClose{}:
5256 None{}
5257
5258# The body and the bytes after it, once the pieces make a whole request; None otherwise.
5259def serve.frame(xs: List<&2, String>) -> Maybe<&1, String & String>:
5260 sv.frame.go(xs, TurnMore{sv.none(), False{}})
5261
5262def talk.piece(+max: Nat, sv: Sv, p: U32 & Array<U32>) -> Turn:
5263 (+len, buf) = p
5264 sv.step(U32.is_eq(len, 0), max, sv, Bytes.Bytes{len, buf})
5265
5266def talk.next(+max: Nat, sv: Sv, m: Socket & Result<&1, &1, U32 & String, U32 & Array<U32>>) -> Socket & Turn:
5267 (s, r) = m
5268 match r:
5269 case Fail{e}:
5270 (s, TurnClose{})
5271 case Done{p}:
5272 (s, talk.piece(max, sv, p))
5273
5274def talk.after.pick(empty: Bool, +max: Nat, rest: Bytes.Bytes) -> Turn:
5275 match empty:
5276 case True{}:
5277 TurnMore{sv.none(), False{}}
5278 case False{}:
5279 sv.step(False{}, max, sv.none(), rest)
5280
5281def talk.after.rest(+max: Nat, rest: Bytes.Bytes, s: Socket) -> Socket & Turn:
5282 Bytes.Bytes{+len, buf} = rest
5283 (s, talk.after.pick(U32.is_eq(len, 0), max, Bytes.Bytes{len, buf}))
5284
5285def talk.after.keep(keep: Bool, +max: Nat, rest: Bytes.Bytes, s: Socket) -> Socket & Turn:
5286 match keep:
5287 case False{}:
5288 (s, TurnClose{})
5289 case True{}:
5290 talk.after.rest(max, rest, s)
5291
5292def talk.after(+max: Nat, keep: Bool, rest: Bytes.Bytes, m: Socket & Result<&1, &1, U32 & String, Unit>) -> Socket & Turn:
5293 (s, r) = m
5294 match r:
5295 case Fail{e}:
5296 (s, TurnClose{})
5297 case Done{u}:
5298 talk.after.keep(keep, max, rest, s)
5299
5300def talk.send(+max: Nat, s: Socket, rest: Bytes.Bytes, +headers: Map<&2, List<&2, String>>, v11: Bool, +head: Bool, res: Res) -> IO(Socket & Turn):
5301 Res{+status, +rh, body} = res
5302 +keep = serve.keep(headers, v11, status, rh)
5303 do IO<Socket & Turn>:
5304 sent : Socket & Result<&1, &1, U32 & String, Unit> <- io.send.bytes(False{}, s, reply.bytes(Res{status, rh, body}, head, Bool.not(keep)))
5305 return talk.after(max, keep, rest, sent)
5306
5307def talk.cont.sent(m: Socket & Result<&1, &1, U32 & String, Unit>) -> Socket:
5308 (s, r) = m
5309 s
5310
5311def talk.cont(cont: Bool, s: Socket) -> IO(Socket):
5312 match cont:
5313 case False{}:
5314 IO.pure(Socket, s)
5315 case True{}:
5316 do IO<Socket>:
5317 sent : Socket & Result<&1, &1, U32 & String, Unit> <-
5318 io.send.bytes(False{}, s, Bytes.from_string("HTTP/1.1 100 Continue\r\n\r\n"))
5319 return talk.cont.sent(sent)
5320
5321@unsafe
5322def talk(~h: Req -> IO(Res), +max: Nat, st: Socket & Turn) -> IO(Unit):
5323 (s, t) = st
5324 match t:
5325 case TurnMore{sv, cont}:
5326 do IO<Unit>:
5327 s2 : Socket <- talk.cont(cont, s)
5328 m : Socket & Result<&1, &1, U32 & String, U32 & Array<U32>> <- Wire.recv.words(s2, 65536, 30000)
5329 talk(~h, max, talk.next(max, sv, m))
5330 case TurnReq{req, rest, v11}:
5331 Req{+method, path, +headers, body} = req
5332 do IO<Unit>:
5333 res : Res <- h(Req{method, path, headers, body})
5334 next : Socket & Turn <- talk.send(max, s, rest, headers, v11, String.eq(method, "HEAD"), res)
5335 talk(~h, max, next)
5336 case TurnFail{status}:
5337 reply_fail(s, status)
5338 case TurnClose{}:
5339 Socket.close(s)
5340
5341def conn(~h: Req -> IO(Res), +max: Nat, m: Listener & Result<&1, &1, U32 & String, Socket>) -> IO(Listener):
5342 (l, r) = m
5343 do IO<Listener>:
5344 s : Socket <- IO.pass(Socket, r)
5345 IO.spawn(Unit, talk(~h, max, (s, TurnMore{sv.none(), False{}})))
5346 return l
5347
5348@unsafe
5349def loop(~h: Req -> IO(Res), +max: Nat, l: Listener) -> IO(Unit):
5350 do IO<Unit>:
5351 m : Listener & Result<&1, &1, U32 & String, Socket> <- TCP.accept(l)
5352 l2 : Listener <- conn(~h, max, m)
5353 loop(~h, max, l2)
5354
5355def serve.on.with(~h: Req -> IO(Res), host: String, +port: U32, +max: Nat) -> IO(Unit):
5356 do IO<Unit>:
5357 l : Listener <- IO.try(Listener, TCP.listen(host, port))
5358 loop(~h, max, l)
5359
5360def serve.on(~h: Req -> IO(Res), host: String, +port: U32) -> IO(Unit):
5361 serve.on.with(~h, host, port, serve.max())
5362
5363def serve.with(~h: Req -> IO(Res), +port: U32, +max: Nat) -> IO(Unit):
5364 serve.on.with(~h, "0.0.0.0", port, max)
5365
5366def serve(~h: Req -> IO(Res), +port: U32) -> IO(Unit):
5367 serve.with(~h, port, serve.max())
5368
5369def serve.stream.nonempty(~S: Type, ~piece: S -> Bytes.Bytes -> IO(S & Bool), empty: Bool, state: S, b: Bytes.Bytes) -> IO(S & Bool):
5370 match empty:
5371 case True{}:
5372 IO.pure(S & Bool, (state, False{}))
5373 case False{}:
5374 piece(state, b)
5375
5376# The piece callback returns True to discard the rest of this request body.
5377def serve.stream.one(~S: Type, ~piece: S -> Bytes.Bytes -> IO(S & Bool), drop: Bool, state: S, b: Bytes.Bytes) -> IO(S & Bool):
5378 match drop:
5379 case True{}:
5380 IO.pure(S & Bool, (state, True{}))
5381 case False{}:
5382 Bytes.Bytes{+len, buf} = b
5383 serve.stream.nonempty(~S, ~piece, U32.is_eq(len, 0), state, Bytes.Bytes{len, buf})
5384
5385def serve.stream.parts(~S: Type, ~piece: S -> Bytes.Bytes -> IO(S & Bool), xs: List<&1, Bytes.Bytes>, st: S & Bool) -> IO(S & Bool):
5386 match xs:
5387 case Nil{}:
5388 IO.pure(S & Bool, st)
5389 case Con{b, rest}:
5390 (state, drop) = st
5391 do IO<S & Bool>:
5392 next : S & Bool <- serve.stream.one(~S, ~piece, drop, state, b)
5393 serve.stream.parts(~S, ~piece, rest, next)
5394
5395def serve.stream.feed(~S: Type, ~start: Req -> IO(S), ~piece: S -> Bytes.Bytes -> IO(S & Bool), req: Req, m: Maybe<&1, S & Bool>, parts: List<&1, Bytes.Bytes>) -> IO(S & Bool):
5396 match m:
5397 case None{}:
5398 do IO<S & Bool>:
5399 state : S <- start(req)
5400 serve.stream.parts(~S, ~piece, parts, (state, False{}))
5401 case Some{st}:
5402 serve.stream.parts(~S, ~piece, parts, st)
5403
5404def serve.stream.recv(+max: Nat, s: Socket, sv: Sv, cont: Bool) -> IO(Socket & Turn):
5405 do IO<Socket & Turn>:
5406 s2 : Socket <- talk.cont(cont, s)
5407 m : Socket & Result<&1, &1, U32 & String, U32 & Array<U32>> <- Wire.recv.words(s2, 65536, 30000)
5408 return talk.next(max, sv, m)
5409
5410def serve.stream.respond(~S: Type, ~finish: S -> IO(Res), +max: Nat, s: Socket, rest: Bytes.Bytes, +headers: Map<&2, List<&2, String>>, v11: Bool, +method: String, st: S & Bool) -> IO(Socket & Turn):
5411 (state, dropped) = st
5412 do IO<Socket & Turn>:
5413 res : Res <- finish(state)
5414 talk.send(max, s, rest, headers, v11, String.eq(method, "HEAD"), res)
5415
5416@unsafe
5417def serve.stream.talk(
5418 ~S: Type, ~start: Req -> IO(S), ~piece: S -> Bytes.Bytes -> IO(S & Bool),
5419 ~finish: S -> IO(Res), +max: Nat, st: Socket & Turn, m: Maybe<&1, S & Bool>
5420) -> IO(Unit):
5421 (s, t) = st
5422 match t:
5423 case TurnClose{}:
5424 Socket.close(s)
5425 case TurnFail{status}:
5426 reply_fail(s, status)
5427 case TurnReq{req, rest, v11}:
5428 Req{+method, path, +headers, body} = req
5429 do IO<Unit>:
5430 next : S & Bool <- serve.stream.feed(~S, ~start, ~piece,
5431 Req{method, path, headers, Bytes.new(0)}, m, [body])
5432 after : Socket & Turn <- serve.stream.respond(~S, ~finish, max, s, rest, headers, v11, method, next)
5433 serve.stream.talk(~S, ~start, ~piece, ~finish, max, after, None{})
5434 case TurnMore{sv, cont}:
5435 match sv:
5436 case SvHead{buf}:
5437 do IO<Unit>:
5438 next : Socket & Turn <- serve.stream.recv(max, s, SvHead{buf}, cont)
5439 serve.stream.talk(~S, ~start, ~piece, ~finish, max, next, m)
5440 case SvLen{req, +v11, +left, parts}:
5441 Req{+method, +path, +headers, body} = req
5442 do IO<Unit>:
5443 next : S & Bool <- serve.stream.feed(~S, ~start, ~piece,
5444 Req{method, path, headers, body}, m, List.reverse(&1, Bytes.Bytes, parts))
5445 more : Socket & Turn <- serve.stream.recv(max, s,
5446 SvLen{Req{method, path, headers, Bytes.new(0)}, v11, left, Nil{}}, cont)
5447 serve.stream.talk(~S, ~start, ~piece, ~finish, max, more, Some{next})
5448 case SvChunk{req, +v11, +n, st, parts}:
5449 Req{+method, +path, +headers, body} = req
5450 do IO<Unit>:
5451 next : S & Bool <- serve.stream.feed(~S, ~start, ~piece,
5452 Req{method, path, headers, body}, m, List.reverse(&1, Bytes.Bytes, parts))
5453 more : Socket & Turn <- serve.stream.recv(max, s,
5454 SvChunk{Req{method, path, headers, Bytes.new(0)}, v11, n, st, Nil{}}, cont)
5455 serve.stream.talk(~S, ~start, ~piece, ~finish, max, more, Some{next})
5456
5457
5458def serve.stream.conn(
5459 ~S: Type, ~start: Req -> IO(S), ~piece: S -> Bytes.Bytes -> IO(S & Bool),
5460 ~finish: S -> IO(Res), +max: Nat, m: Listener & Result<&1, &1, U32 & String, Socket>
5461) -> IO(Listener):
5462 (l, r) = m
5463 do IO<Listener>:
5464 s : Socket <- IO.pass(Socket, r)
5465 IO.spawn(Unit, serve.stream.talk(~S, ~start, ~piece, ~finish, max,
5466 (s, TurnMore{sv.none(), False{}}), None{}))
5467 return l
5468
5469@unsafe
5470def serve.stream.loop(
5471 ~S: Type, ~start: Req -> IO(S), ~piece: S -> Bytes.Bytes -> IO(S & Bool),
5472 ~finish: S -> IO(Res), +max: Nat, l: Listener
5473) -> IO(Unit):
5474 do IO<Unit>:
5475 m : Listener & Result<&1, &1, U32 & String, Socket> <- TCP.accept(l)
5476 l2 : Listener <- serve.stream.conn(~S, ~start, ~piece, ~finish, max, m)
5477 serve.stream.loop(~S, ~start, ~piece, ~finish, max, l2)
5478
5479def serve.stream.on.with(
5480 ~S: Type, ~start: Req -> IO(S), ~piece: S -> Bytes.Bytes -> IO(S & Bool),
5481 ~finish: S -> IO(Res), host: String, +port: U32, +max: Nat
5482) -> IO(Unit):
5483 do IO<Unit>:
5484 l : Listener <- IO.try(Listener, TCP.listen(host, port))
5485 serve.stream.loop(~S, ~start, ~piece, ~finish, max, l)
5486
5487def serve.stream.with(
5488 ~S: Type, ~start: Req -> IO(S), ~piece: S -> Bytes.Bytes -> IO(S & Bool),
5489 ~finish: S -> IO(Res), +port: U32, +max: Nat
5490) -> IO(Unit):
5491 serve.stream.on.with(~S, ~start, ~piece, ~finish, "0.0.0.0", port, max)