Split out assert-control
This commit is contained in:
parent
210e983c8d
commit
b64b111a45
|
@ -5,6 +5,7 @@
|
|||
(provide (all-from-out syndicate/schemas/gen/tcp)
|
||||
spawn-tcp-driver
|
||||
accept-connection
|
||||
assert-control
|
||||
establish-connection
|
||||
send-credit
|
||||
send-lines-credit
|
||||
|
@ -215,19 +216,22 @@
|
|||
#:on-data on-data
|
||||
#:on-eof [on-eof void]
|
||||
#:on-credit [on-credit void])
|
||||
(when initial-credit (send-credit conn initial-credit initial-mode))
|
||||
(assert-control conn
|
||||
#:on-data on-data
|
||||
#:on-eof on-eof
|
||||
#:on-credit on-credit))
|
||||
|
||||
(define (assert-control conn
|
||||
#:on-data on-data
|
||||
#:on-eof [on-eof void]
|
||||
#:on-credit [on-credit void])
|
||||
(at conn
|
||||
(assert (ActiveSocket-controller
|
||||
(object #:name 'inbound-socket-controller
|
||||
[#:asserted (Socket-credit amount mode) (on-credit amount mode)]
|
||||
[#:asserted (Socket-data data mode) (on-data data mode)]
|
||||
[#:asserted (Socket-eof) (on-eof)]))))
|
||||
(when initial-credit (send-credit conn initial-credit initial-mode))
|
||||
(lambda (#:on-data [new-on-data #f]
|
||||
#:on-eof [new-on-eof #f]
|
||||
#:on-credit [new-on-credit #f])
|
||||
(when new-on-data (set! on-data new-on-data))
|
||||
(when new-on-eof (set! on-eof new-on-eof))
|
||||
(when new-on-credit (set! on-credit new-on-credit))))
|
||||
[#:message (Socket-credit amount mode) (on-credit amount mode)]
|
||||
[#:message (Socket-data data mode) (on-data data mode)]
|
||||
[#:message (Socket-eof) (on-eof)])))))
|
||||
|
||||
(define (establish-connection ds spec
|
||||
#:initial-credit [initial-credit (CreditAmount-unbounded)]
|
||||
|
|
Loading…
Reference in New Issue