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