Commit0b4617acRecorded27 Aug 2026Repositorysigil-http

Add incremental HTTP response streaming

Changed
 CHANGELOG.md              |  19 +++++++++++++++++
 package.sgl               |   2 +-
 src/sigil/http/client.sgl | 192 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
 test/test-client.sgl      |  39 ++++++++++++++++++++++++++++++++++
 4 files changed, 250 insertions(+), 2 deletions(-)
Diff
CHANGELOG.mdmodified
@@ -5,6 +5,25 @@ All notable changes to **sigil-http** are documented in this file.
5
The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.1.0/),
6
and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).
7
+8
## [0.18.5] - 2026-08-27
+9
+10
### Added
+11
+12
- **`http-stream-response`: incremental, byte-faithful HTTP response bodies.**
+13
The callback API publishes the parsed status and ordered response headers
+14
once, then publishes raw body bytevectors as they arrive. Content-Length and
+15
connection-close bodies are supported, and HTTP/1.1 chunk framing is decoded
+16
incrementally across arbitrary transport boundaries. Request construction,
+17
TLS, deadlines, and connection handling remain shared with the existing
+18
client rather than delegated to an external process.
+19
+20
### Fixed
+21
+22
- **Framed streaming reads tolerate both non-blocking would-block values.**
+23
Sigil's socket layer can surface a transient read as either `#f` or an EOF
+24
sentinel. Content-Length and chunked streams now retry both until their
+25
framing declares completion or the idle deadline expires.
+26
27
## [0.18.3] - 2026-08-04
28
29
### Changed
package.sglmodified
@@ -5,7 +5,7 @@
5
6
(package
7
name: "sigil-http"
−8
version: "0.18.4"
+8
version: "0.18.5"
9
sigil: "^0.19"
10
description: "HTTP client and server library for Sigil"
11
url: "https://codeberg.org/sigil/sigil-http"
src/sigil/http/client.sglmodified
@@ -54,6 +54,9 @@
54
;; Byte-faithful in-memory fetch (status + headers + raw body bytes)
55
http-fetch-bytes
56
+57
;; Incremental byte-faithful response streaming
+58
http-stream-response
+59
60
;; API client helpers
61
build-api-url
62
make-response-checker
@@ -77,7 +80,9 @@
80
fetch-parse-headers
81
fetch-content-length
82
fetch-assemble
−80
fetch-dechunk)
+83
fetch-dechunk
+84
stream-chunked-state
+85
stream-chunked-feed!)
86
87
(begin
88
@@ -1472,6 +1477,191 @@
1477
(fetch-safe-close conn)
1478
result)))))))))
1479
+1480
;;; Stream an HTTP response without buffering its body.
+1481
;;;
+1482
;;; `on-head` is called once with `#{ status: headers: }`. `on-chunk` is
+1483
;;; then called with each available BYTEVECTOR of decoded response-body
+1484
;;; data. HTTP/1.1 chunk framing is removed incrementally; arbitrary
+1485
;;; transport boundaries are preserved safely. Returns the head dict on a
+1486
;;; complete response, or #f on connect, framing, callback, or idle-timeout
+1487
;;; failure. As with `http-fetch-bytes`, timeout is an idle deadline.
+1488
(define (http-stream-response method url on-head on-chunk
+1489
(keys: (headers #{}) (body #f) (timeout #f)))
+1490
(let ((secs (if (and timeout (number? timeout) (> timeout 0))
+1491
timeout fetch-default-timeout)))
+1492
(guard (e (#t #f))
+1493
(let ((parsed (parse-url url)))
+1494
(and parsed
+1495
(let* ((https? (string=? (url-scheme parsed) "https"))
+1496
(conn (connect-to-server parsed
+1497
(and (or https? timeout) secs))))
+1498
(and conn
+1499
(guard (e (#t (begin (fetch-safe-close conn) #f)))
+1500
(conn-set-non-blocking! conn)
+1501
(write-all-data conn
+1502
(build-request-string method parsed headers body)
+1503
(timeout->deadline secs))
+1504
(let ((result (stream-read-response
+1505
conn method secs on-head on-chunk)))
+1506
(fetch-safe-close conn)
+1507
result)))))))))
+1508
+1509
(define (stream-read-response conn method timeout on-head on-chunk)
+1510
(let loop ((buf (make-bytevector 0)) (idle 0)
+1511
(deadline (+ (current-second) timeout)))
+1512
(cond
+1513
((or (>= (current-second) deadline) (> idle fetch-max-idle-polls)) #f)
+1514
(else
+1515
(let ((hidx (find-header-end-bytes buf)))
+1516
(if hidx
+1517
(stream-parse conn method timeout buf hidx on-head on-chunk)
+1518
(let ((chunk (guard (e (#t 'err))
+1519
(conn-read-bytes conn fetch-read-chunk))))
+1520
(cond
+1521
((eq? chunk 'err) #f)
+1522
((or (not chunk) (eof-object? chunk)
+1523
(zero? (bytevector-length chunk)))
+1524
(begin (sleep *read-poll-interval*)
+1525
(loop buf (+ idle 1) deadline)))
+1526
(else
+1527
(loop (bytevector-append buf chunk) 0
+1528
(+ (current-second) timeout)))))))))))
+1529
+1530
(define (stream-parse conn method timeout buf hidx on-head on-chunk)
+1531
(let* ((head-bytes (bytevector-copy buf 0 hidx))
+1532
(body0 (bytevector-copy buf (+ hidx 4) (bytevector-length buf)))
+1533
(lines (string-split (utf8->string head-bytes) "\r\n"))
+1534
(status (and (pair? lines)
+1535
(let ((si (parse-status-line (car lines))))
+1536
(and si (cadr si)))))
+1537
(hdrs (fetch-parse-headers (if (pair? lines) (cdr lines) '())))
+1538
(clen (fetch-content-length hdrs))
+1539
(te (fetch-header hdrs "transfer-encoding"))
+1540
(chunked? (and te (string-contains? (string-downcase te) "chunked")))
+1541
(head (and status #{ status: status headers: hdrs })))
+1542
(and head
+1543
(begin
+1544
(on-head head)
+1545
(cond
+1546
((no-body-expected? method status) head)
+1547
(chunked?
+1548
(and (stream-chunked-body conn timeout body0 on-chunk) head))
+1549
(clen
+1550
(and (stream-length-body conn timeout body0 clen on-chunk) head))
+1551
(else
+1552
(and (stream-until-close-body conn timeout body0 on-chunk) head)))))))
+1553
+1554
(define (stream-emit-prefix chunk count on-chunk)
+1555
(when (> count 0)
+1556
(on-chunk (if (= count (bytevector-length chunk))
+1557
chunk (bytevector-copy chunk 0 count)))))
+1558
+1559
(define (stream-length-body conn timeout body0 content-length on-chunk)
+1560
(let ((initial (if (< content-length (bytevector-length body0))
+1561
content-length (bytevector-length body0))))
+1562
(stream-emit-prefix body0 initial on-chunk)
+1563
(let loop ((have initial) (idle 0) (deadline (+ (current-second) timeout)))
+1564
(cond
+1565
((>= have content-length) #t)
+1566
((or (>= (current-second) deadline) (> idle fetch-max-idle-polls)) #f)
+1567
(else
+1568
(let ((chunk (guard (e (#t 'err))
+1569
(conn-read-bytes conn fetch-read-chunk))))
+1570
(cond
+1571
((eq? chunk 'err) #f)
+1572
;; Plain non-blocking socket reads use #f for would-block.
+1573
;; A framed body can safely retry it: completion is known
+1574
;; from Content-Length, not connection close.
+1575
((or (not chunk) (eof-object? chunk)
+1576
(zero? (bytevector-length chunk)))
+1577
(begin (sleep *read-poll-interval*)
+1578
(loop have (+ idle 1) deadline)))
+1579
(else
+1580
(let ((take (if (< (- content-length have)
+1581
(bytevector-length chunk))
+1582
(- content-length have)
+1583
(bytevector-length chunk))))
+1584
(stream-emit-prefix chunk take on-chunk)
+1585
(loop (+ have take) 0 (+ (current-second) timeout)))))))))))
+1586
+1587
(define (stream-until-close-body conn timeout body0 on-chunk)
+1588
(stream-emit-prefix body0 (bytevector-length body0) on-chunk)
+1589
(let loop ((idle 0) (deadline (+ (current-second) timeout)))
+1590
(cond
+1591
((or (>= (current-second) deadline) (> idle fetch-max-idle-polls)) #f)
+1592
(else
+1593
(let ((chunk (guard (e (#t 'err))
+1594
(conn-read-bytes conn fetch-read-chunk))))
+1595
(cond
+1596
((eq? chunk 'err) #f)
+1597
((or (not chunk) (eof-object? chunk)) #t)
+1598
((zero? (bytevector-length chunk))
+1599
(begin (sleep *read-poll-interval*)
+1600
(loop (+ idle 1) deadline)))
+1601
(else
+1602
(on-chunk chunk)
+1603
(loop 0 (+ (current-second) timeout)))))))))
+1604
+1605
;; Mutable incremental chunked-transfer decoder state:
+1606
;; #(pending-bytes remaining-payload-bytes-or-#f complete?)
+1607
(define (stream-chunked-state)
+1608
(vector (make-bytevector 0) #f #f))
+1609
+1610
(define (stream-chunked-feed! state incoming on-chunk)
+1611
(vector-set! state 0
+1612
(bytevector-append (vector-ref state 0) incoming))
+1613
(let loop ()
+1614
(let ((buf (vector-ref state 0))
+1615
(remaining (vector-ref state 1)))
+1616
(cond
+1617
((vector-ref state 2) #t)
+1618
(remaining
+1619
(if (< (bytevector-length buf) (+ remaining 2))
+1620
#f
+1621
(begin
+1622
(stream-emit-prefix buf remaining on-chunk)
+1623
(vector-set! state 0
+1624
(bytevector-copy buf (+ remaining 2) (bytevector-length buf)))
+1625
(vector-set! state 1 #f)
+1626
(loop))))
+1627
(else
+1628
(let ((line-end (fetch-find-crlf buf 0)))
+1629
(if (not line-end)
+1630
#f
+1631
(let ((size (fetch-hex
+1632
(utf8->string (bytevector-copy buf 0 line-end)))))
+1633
(if (not size)
+1634
(error "invalid HTTP chunk size")
+1635
(begin
+1636
(vector-set! state 0
+1637
(bytevector-copy buf (+ line-end 2)
+1638
(bytevector-length buf)))
+1639
(if (= size 0)
+1640
(begin (vector-set! state 2 #t) #t)
+1641
(begin (vector-set! state 1 size) (loop)))))))))))))
+1642
+1643
(define (stream-chunked-body conn timeout body0 on-chunk)
+1644
(let ((state (stream-chunked-state)))
+1645
(stream-chunked-feed! state body0 on-chunk)
+1646
(let loop ((idle 0) (deadline (+ (current-second) timeout)))
+1647
(cond
+1648
((vector-ref state 2) #t)
+1649
((or (>= (current-second) deadline) (> idle fetch-max-idle-polls)) #f)
+1650
(else
+1651
(let ((chunk (guard (e (#t 'err))
+1652
(conn-read-bytes conn fetch-read-chunk))))
+1653
(cond
+1654
((eq? chunk 'err) #f)
+1655
;; As above, #f may be transient would-block. Chunk framing
+1656
;; gives us an unambiguous terminator, so keep polling.
+1657
((or (not chunk) (eof-object? chunk)
+1658
(zero? (bytevector-length chunk)))
+1659
(begin (sleep *read-poll-interval*)
+1660
(loop (+ idle 1) deadline)))
+1661
(else
+1662
(stream-chunked-feed! state chunk on-chunk)
+1663
(loop 0 (+ (current-second) timeout))))))))))
+1664
1665
(define (fetch-safe-close conn)
1666
(guard (e (#t #f)) (conn-close conn)))
1667
test/test-client.sglmodified
@@ -467,4 +467,43 @@
467
(assert-true (eq? 'value (car outcome)))
468
(assert-false (cdr outcome)))))
469
+470
(test-group "incremental response-body streaming"
+471
+472
(test "chunked decoder survives every transport split and emits raw UTF-8 bytes"
+473
(let* ((payload "data: Γειά 👋\n\n")
+474
(payload-bytes (string->utf8 payload))
+475
(wire (bytevector-append
+476
(string->utf8
+477
(string-append (number->string (bytevector-length payload-bytes) 16)
+478
"\r\n"))
+479
payload-bytes
+480
(string->utf8 "\r\n0\r\n\r\n")))
+481
(wire-length (bytevector-length wire)))
+482
(let split-loop ((at 1))
+483
(when (< at wire-length)
+484
(let ((state (stream-chunked-state))
+485
(chunks (vector '())))
+486
(define (receive chunk)
+487
(vector-set! chunks 0 (append (vector-ref chunks 0) (list chunk))))
+488
(stream-chunked-feed! state (bytevector-copy wire 0 at) receive)
+489
(stream-chunked-feed! state (bytevector-copy wire at wire-length) receive)
+490
(assert-equal
+491
(utf8->string (fetch-assemble (vector-ref chunks 0))) payload)
+492
(split-loop (+ at 1)))))))
+493
+494
(test "chunked decoder emits multiple chunks in order and stops at terminator"
+495
(let ((state (stream-chunked-state))
+496
(chunks (vector '())))
+497
(stream-chunked-feed!
+498
state (string->utf8 "3\r\none\r\n3\r\ntwo\r\n0\r\n\r\n")
+499
(lambda (chunk)
+500
(vector-set! chunks 0 (append (vector-ref chunks 0) (list chunk)))))
+501
(assert-equal (utf8->string (fetch-assemble (vector-ref chunks 0))) "onetwo")))
+502
+503
(test "invalid chunk size is rejected"
+504
(assert-error
+505
(stream-chunked-feed! (stream-chunked-state)
+506
(string->utf8 "nope\r\n")
+507
(lambda (chunk) #t)))))
+508
509
(run-tests)