test/test-fetch-bytes.sgl

1;;; Tests for (sigil http client) http-fetch-bytes — the byte-faithful fetch

2;;; and its internals (assembly, header alist, chunked decode, content-length).

4(import (sigil test)

5 (sigil core)

6 (sigil io)

7 (sigil string)

8 (sigil time)

9 (sigil socket)

10 (sigil http client))

12;; Content-compare two bytevectors (assert-equal on bytevectors is not

13;; guaranteed structural, so compare bytes explicitly).

14(define (bv=? a b)

15 (and (= (bytevector-length a) (bytevector-length b))

16 (let loop ((i 0))

17 (cond

18 ((>= i (bytevector-length a)) #t)

19 ((= (bytevector-u8-ref a i) (bytevector-u8-ref b i)) (loop (+ i 1)))

20 (else #f)))))

22;; ============================================================

23;; fetch-assemble — single-allocation concat

24;; ============================================================

25;; The regression that motivated this: a multi-MB body arrives as hundreds of

26;; chunks, and `(apply bytevector-append <hundreds of args>)` silently returned

27;; an EMPTY bytevector. The single-allocation assemble must produce the full

28;; length with correct content regardless of chunk count.

30(test-group "fetch-assemble"

32 (test "empty list -> empty bytevector"

33 (assert-equal (bytevector-length (fetch-assemble '())) 0))

35 (test "single chunk preserved"

36 (assert-true (bv=? (fetch-assemble (list (string->utf8 "hello")))

37 (string->utf8 "hello"))))

39 (test "chunks concatenated in order"

40 (assert-true (bv=? (fetch-assemble (list (string->utf8 "ab")

41 (string->utf8 "c")

42 (string->utf8 "def")))

43 (string->utf8 "abcdef"))))

45 (test "hundreds of chunks assemble to full length (no splat truncation)"

46 (let* ((chunk (make-bytevector 1024 65)) ; 1 KB of 'A'

47 (n 500)

48 (chunks (let build ((i 0) (acc '()))

49 (if (>= i n) acc (build (+ i 1) (cons chunk acc)))))

50 (out (fetch-assemble chunks)))

51 (assert-equal (bytevector-length out) (* n 1024))

52 (assert-equal (bytevector-u8-ref out 0) 65)

53 (assert-equal (bytevector-u8-ref out (- (* n 1024) 1)) 65))))

55;; ============================================================

56;; fetch-parse-headers — ordered alist, dups + order preserved, lowercased

57;; ============================================================

59(test-group "fetch-parse-headers"

61 (test "name lowercased, value trimmed"

62 (let ((h (fetch-parse-headers (list "Content-Type: text/html"

63 "Content-Length: 5"))))

64 (assert-equal (length h) 2)

65 (assert-equal (car (car h)) "content-type")

66 (assert-equal (cdr (car h)) "text/html")

67 (assert-equal (cdr (cadr h)) "5")))

69 (test "duplicate headers preserved, in order"

70 (let ((h (fetch-parse-headers (list "Set-Cookie: a=1"

71 "Set-Cookie: b=2"))))

72 (assert-equal (length h) 2)

73 (assert-equal (cdr (car h)) "a=1")

74 (assert-equal (cdr (cadr h)) "b=2")))

76 (test "line without a colon is skipped"

77 (assert-equal (length (fetch-parse-headers (list "garbage-no-colon" "X: 1"))) 1)))

79;; ============================================================

80;; fetch-content-length

81;; ============================================================

83(test-group "fetch-content-length"

85 (test "present -> integer"

86 (assert-equal (fetch-content-length (list (cons "content-length" "42"))) 42))

88 (test "absent -> #f"

89 (assert-false (fetch-content-length (list (cons "content-type" "x")))))

91 (test "non-numeric -> #f"

92 (assert-false (fetch-content-length (list (cons "content-length" "abc"))))))

94;; ============================================================

95;; fetch-dechunk — byte-exact chunked-transfer decode

96;; ============================================================

98(test-group "fetch-dechunk"

100 (test "single chunk"

101 (assert-true (bv=? (fetch-dechunk (string->utf8 "5\r\nhello\r\n0\r\n\r\n"))

102 (string->utf8 "hello"))))

103

104 (test "multiple chunks concatenated"

105 (assert-true (bv=? (fetch-dechunk (string->utf8 "5\r\nhello\r\n6\r\n world\r\n0\r\n\r\n"))

106 (string->utf8 "hello world"))))

107

108 (test "hex chunk size"

109 (assert-true (bv=? (fetch-dechunk (string->utf8 "a\r\n0123456789\r\n0\r\n\r\n"))

110 (string->utf8 "0123456789")))))

111

112;; ============================================================

113;; http-fetch-bytes — unreachable upstream returns #f (no server needed)

114;; ============================================================

115

116(test-group "http-fetch-bytes"

117

118 (test "connection refused -> #f"

119 (assert-false (http-fetch-bytes 'GET "http://127.0.0.1:9/" timeout: 2))))