Improved error signalling
This commit is contained in:
parent
c0ff69f67e
commit
c17eb4caa0
|
@ -72,8 +72,13 @@
|
||||||
(on (message (server-packet address (Ping)))
|
(on (message (server-packet address (Ping)))
|
||||||
(w (Pong)))
|
(w (Pong)))
|
||||||
|
|
||||||
(on (message (server-packet address (Err $detail)))
|
(on (message (server-packet address (Err $detail $context)))
|
||||||
(log-syndicate/distributed-error "Error from ~a: ~v" address detail)
|
(log-syndicate/distributed-error "Error from ~a: ~v~a"
|
||||||
|
address
|
||||||
|
detail
|
||||||
|
(if context
|
||||||
|
(format " ~v" context)
|
||||||
|
""))
|
||||||
(stop-current-facet))
|
(stop-current-facet))
|
||||||
|
|
||||||
(on (message (server-packet address (Turn $items)))
|
(on (message (server-packet address (Turn $items)))
|
||||||
|
|
|
@ -313,8 +313,9 @@
|
||||||
[link-matches (hash)] ;; (Hash LocalID (Set (Listof Assertion)))
|
[link-matches (hash)] ;; (Hash LocalID (Set (Listof Assertion)))
|
||||||
)
|
)
|
||||||
|
|
||||||
(define (err! detail)
|
(define (err! detail [context #f])
|
||||||
(send! (server-proposal management-scope (message-server->poa linkid (Err detail))))
|
(send! (server-proposal management-scope (message-server->poa linkid
|
||||||
|
(Err detail context))))
|
||||||
(reset-turn! turn)
|
(reset-turn! turn)
|
||||||
(stop-current-facet))
|
(stop-current-facet))
|
||||||
|
|
||||||
|
@ -362,7 +363,7 @@
|
||||||
(log-syndicate/federation-error
|
(log-syndicate/federation-error
|
||||||
"Duplicate subscription ~a, ID ~a, from link ~a."
|
"Duplicate subscription ~a, ID ~a, from link ~a."
|
||||||
spec subid linkid)
|
spec subid linkid)
|
||||||
(err! 'duplicate-subscription)]
|
(err! 'duplicate-endpoint item)]
|
||||||
[else
|
[else
|
||||||
(link-subs (hash-set (link-subs) subid localid))
|
(link-subs (hash-set (link-subs) subid localid))
|
||||||
(when (not known?) (specs (hash-set (specs) spec localid)))
|
(when (not known?) (specs (hash-set (specs) spec localid)))
|
||||||
|
@ -404,7 +405,7 @@
|
||||||
[#f (log-syndicate/federation-error
|
[#f (log-syndicate/federation-error
|
||||||
"Mention of nonexistent subscription ID ~v from link ~v."
|
"Mention of nonexistent subscription ID ~v from link ~v."
|
||||||
subid linkid)
|
subid linkid)
|
||||||
(err! 'nonexistent-subscription)]
|
(err! 'nonexistent-endpoint item)]
|
||||||
[localid
|
[localid
|
||||||
(link-subs (hash-remove (link-subs) subid))
|
(link-subs (hash-remove (link-subs) subid))
|
||||||
(unsubscribe! localid linkid)])]
|
(unsubscribe! localid linkid)])]
|
||||||
|
@ -416,7 +417,7 @@
|
||||||
(define matches (hash-ref (link-matches) localid set))
|
(define matches (hash-ref (link-matches) localid set))
|
||||||
(cond
|
(cond
|
||||||
[(set-member? matches captures)
|
[(set-member? matches captures)
|
||||||
(err! 'duplicate-capture)]
|
(err! 'duplicate-capture item)]
|
||||||
[else
|
[else
|
||||||
(link-matches (hash-set (link-matches) localid (set-add matches captures)))
|
(link-matches (hash-set (link-matches) localid (set-add matches captures)))
|
||||||
(call-with-sub
|
(call-with-sub
|
||||||
|
@ -439,7 +440,7 @@
|
||||||
[(Del localid captures)
|
[(Del localid captures)
|
||||||
(define matches (hash-ref (link-matches) localid set))
|
(define matches (hash-ref (link-matches) localid set))
|
||||||
(if (not (set-member? matches captures))
|
(if (not (set-member? matches captures))
|
||||||
(err! 'nonexistent-capture)
|
(err! 'nonexistent-capture item)
|
||||||
(let ((new-matches (set-remove matches captures)))
|
(let ((new-matches (set-remove matches captures)))
|
||||||
(link-matches (if (set-empty? new-matches)
|
(link-matches (if (set-empty? new-matches)
|
||||||
(hash-remove (link-matches) localid)
|
(hash-remove (link-matches) localid)
|
||||||
|
|
|
@ -27,7 +27,7 @@
|
||||||
(on-start
|
(on-start
|
||||||
(match (let-event [(message (message-poa->server id $p))] p)
|
(match (let-event [(message (message-poa->server id $p))] p)
|
||||||
[(Connect scope) (react (connected id scope root-facet))]
|
[(Connect scope) (react (connected id scope root-facet))]
|
||||||
[_ (send! (message-server->poa id (Err 'connection-not-setup)))]))))
|
[_ (send! (message-server->poa id (Err 'connection-not-setup #f)))]))))
|
||||||
|
|
||||||
(define (connected id scope root-facet)
|
(define (connected id scope root-facet)
|
||||||
(define endpoints (hash))
|
(define endpoints (hash))
|
||||||
|
@ -36,8 +36,8 @@
|
||||||
|
|
||||||
(assert (server-active scope))
|
(assert (server-active scope))
|
||||||
|
|
||||||
(define (send-error! detail)
|
(define (send-error! detail [context #f])
|
||||||
(send! (message-server->poa id (Err detail)))
|
(send! (message-server->poa id (Err detail context)))
|
||||||
(reset-turn! turn)
|
(reset-turn! turn)
|
||||||
(stop-facet root-facet))
|
(stop-facet root-facet))
|
||||||
|
|
||||||
|
@ -48,7 +48,7 @@
|
||||||
(match item
|
(match item
|
||||||
[(Assert ep a)
|
[(Assert ep a)
|
||||||
(if (hash-has-key? endpoints ep)
|
(if (hash-has-key? endpoints ep)
|
||||||
(send-error! 'duplicate-endpoint)
|
(send-error! 'duplicate-endpoint item)
|
||||||
(react
|
(react
|
||||||
(define ep-facet (current-facet))
|
(define ep-facet (current-facet))
|
||||||
(set! endpoints (hash-set endpoints ep ep-facet))
|
(set! endpoints (hash-set endpoints ep ep-facet))
|
||||||
|
@ -65,7 +65,7 @@
|
||||||
#:on-message (! Msg)))))]
|
#:on-message (! Msg)))))]
|
||||||
[(Clear ep)
|
[(Clear ep)
|
||||||
(match (hash-ref endpoints ep #f)
|
(match (hash-ref endpoints ep #f)
|
||||||
[#f (send-error! 'unknown-endpoint)]
|
[#f (send-error! 'nonexistent-endpoint item)]
|
||||||
[ep-facet (stop-facet ep-facet (extend-turn! turn (End ep)))])]
|
[ep-facet (stop-facet ep-facet (extend-turn! turn (End ep)))])]
|
||||||
[(Message body)
|
[(Message body)
|
||||||
(send! (server-proposal scope body))]))]
|
(send! (server-proposal scope body))]))]
|
||||||
|
@ -74,4 +74,4 @@
|
||||||
[(Pong)
|
[(Pong)
|
||||||
(void)]
|
(void)]
|
||||||
[_
|
[_
|
||||||
(send-error! 'invalid-message)])))
|
(send-error! 'invalid-message p)])))
|
||||||
|
|
|
@ -22,7 +22,7 @@
|
||||||
(message-struct Del (endpoint-name captures))
|
(message-struct Del (endpoint-name captures))
|
||||||
(message-struct Msg (endpoint-name captures))
|
(message-struct Msg (endpoint-name captures))
|
||||||
(message-struct End (endpoint-name))
|
(message-struct End (endpoint-name))
|
||||||
(message-struct Err (detail))
|
(message-struct Err (detail context))
|
||||||
|
|
||||||
;; Transport-related; Bidirectional
|
;; Transport-related; Bidirectional
|
||||||
(message-struct Ping ())
|
(message-struct Ping ())
|
||||||
|
|
Loading…
Reference in New Issue