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