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