syndicate-lang
/
syndicate-rkt
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Move federation protocol a step closer to client/server protocol

This commit is contained in:
Tony Garnock-Jones 2019-05-05 15:54:28 +01:00
parent 924512f7de
commit aad3fb6866
2 changed files with 26 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
syndicate/broker/federation.rkt
View File

@ -1,7 +1,7 @@
#lang imperative-syndicate #lang imperative-syndicate
(provide (struct-out Subscribe) (provide (struct-out Assert)
(struct-out Unsubscribe) (struct-out Clear)
(struct-out Add) (struct-out Add)
(struct-out Del) (struct-out Del)
(struct-out Msg) (struct-out Msg)
@ -36,14 +36,14 @@
;; BIDIRECTIONAL, travelling in both directions along edges linking ;; BIDIRECTIONAL, travelling in both directions along edges linking
;; peer nodes. ;; peer nodes.
;; Actions - like Asserts, but only for `(observe $spec)` assertions. ;; Actions - like the client/server protocol, but lacking Message
(message-struct Subscribe (subscription-id spec)) (message-struct Assert (endpoint-name assertion))
(message-struct Unsubscribe (subscription-id)) (message-struct Clear (endpoint-name))
;; Events ;; Events
(message-struct Add (subscription-id captures)) (message-struct Add (endpoint-name captures))
(message-struct Del (subscription-id captures)) (message-struct Del (endpoint-name captures))
(message-struct Msg (subscription-id captures)) (message-struct Msg (endpoint-name captures))
;; Connection protocol ;; Connection protocol
(assertion-struct router-connection (node-id connection-id)) (assertion-struct router-connection (node-id connection-id))
@ -108,9 +108,9 @@
(match (hash-count new-holders) (match (hash-count new-holders)
[0 (for [(peer (in-set (peers)))] [0 (for [(peer (in-set (peers)))]
(when (not (equal? peer connid)) (when (not (equal? peer connid))
(send! (router-outbound peer (Unsubscribe localid)))))] (send! (router-outbound peer (Clear localid)))))]
[1 (for [(peer (in-hash-keys new-holders))] ;; there will only be one, ≠ connid [1 (for [(peer (in-hash-keys new-holders))] ;; there will only be one, ≠ connid
(send! (router-outbound peer (Unsubscribe localid))))] (send! (router-outbound peer (Clear localid))))]
[_ (void)])))) [_ (void)]))))
(define (adjust-matches localid connid captures delta expected-outcome ctor) (define (adjust-matches localid connid captures delta expected-outcome ctor)
@ -142,7 +142,7 @@
nodeid connid (conn-matches)))) nodeid connid (conn-matches))))
(on-start (for ([(spec localid) (in-hash (specs))]) (on-start (for ([(spec localid) (in-hash (specs))])
(send! (router-outbound connid (Subscribe localid spec))))) (send! (router-outbound connid (Assert localid (observe spec))))))
(on-stop (for ([item (in-bag (conn-matches))]) (on-stop (for ([item (in-bag (conn-matches))])
(match-define (cons localid captures) item) (match-define (cons localid captures) item)
@ -150,7 +150,7 @@
(for ([localid (in-hash-values (conn-subs))]) (for ([localid (in-hash-values (conn-subs))])
(unsubscribe! localid connid))) (unsubscribe! localid connid)))
(on (message (router-inbound connid (Subscribe $subid $spec))) (on (message (router-inbound connid (Assert $subid (observe $spec))))
(define known? (hash-has-key? (specs) spec)) (define known? (hash-has-key? (specs) spec))
(define localid (if known? (hash-ref (specs) spec) (make-localid))) (define localid (if known? (hash-ref (specs) spec) (make-localid)))
(define sub (define sub
@ -181,10 +181,10 @@
[(not known?) [(not known?)
(for [(peer (in-set (peers)))] (for [(peer (in-set (peers)))]
(when (not (equal? peer connid)) (when (not (equal? peer connid))
(send! (router-outbound peer (Subscribe localid spec)))))] (send! (router-outbound peer (Assert localid (observe spec))))))]
[(= (hash-count holders) 1) [(= (hash-count holders) 1)
(for [(peer (in-hash-keys holders))] ;; there will only be one, ≠ connid (for [(peer (in-hash-keys holders))] ;; there will only be one, ≠ connid
(send! (router-outbound peer (Subscribe localid spec))))] (send! (router-outbound peer (Assert localid (observe spec)))))]
[else [else
(void)]) (void)])
@ -195,7 +195,7 @@
])) ]))
(on (message (router-inbound connid (Unsubscribe $subid))) (on (message (router-inbound connid (Clear $subid)))
(match (hash-ref (conn-subs) subid #f) (match (hash-ref (conn-subs) subid #f)
[#f (log-syndicate/federation-error [#f (log-syndicate/federation-error
"Mention of nonexistent subscription ID ~v from connection ~v. Ignoring." "Mention of nonexistent subscription ID ~v from connection ~v. Ignoring."

20
syndicate/broker/tf.rkt
View File

@ -26,10 +26,12 @@
(during (router-connection node name) (during (router-connection node name)
(on-start (on-start
(send! (router-inbound name (Subscribe (gensym (format "~a-P-" name)) (present C)))) (send!
(send! (router-inbound name (Subscribe (gensym (format "~a-S-" name)) (says C C))))) (router-inbound name (Assert (gensym (format "~a-P-" name)) (observe (present C)))))
(send!
(router-inbound name (Assert (gensym (format "~a-S-" name)) (observe (says C C))))))
(on (message (router-outbound name (Subscribe $x (says C C)))) (on (message (router-outbound name (Assert $x (observe (says C C)))))
(sleep 2) (sleep 2)
;; We won't see our own one of these, because routers expect us to have done ;; We won't see our own one of these, because routers expect us to have done
;; local delivery ourselves. OHHH I am starting to get some insight into what is ;; local delivery ourselves. OHHH I am starting to get some insight into what is
@ -38,10 +40,10 @@
;; you're in ~leaf mode, you will! ;; you're in ~leaf mode, you will!
(send! (router-inbound name (Msg x (list name "Hello world!"))))) (send! (router-inbound name (Msg x (list name "Hello world!")))))
(on (message (router-outbound name (Subscribe $x (present C)))) (on (message (router-outbound name (Assert $x (observe (present C)))))
(react (react
(field [present? #t]) (field [present? #t])
(stop-when (message (router-outbound name (Unsubscribe x)))) (stop-when (message (router-outbound name (Clear x))))
(begin/dataflow (begin/dataflow
;; We won't see our own one of these either! For the same reasons as ;; We won't see our own one of these either! For the same reasons as
;; explained above. ;; explained above.
@ -103,7 +105,7 @@
(assert (from-broker node what))) (assert (from-broker node what)))
(during (router-connection node name) (during (router-connection node name)
(on (message (router-outbound name (Subscribe $subid $spec))) (on (message (router-outbound name (Assert $subid (observe $spec))))
(react (react
(let ((! (lambda (ctor) (let ((! (lambda (ctor)
(lambda (cs) (send! (router-inbound name (ctor subid cs))))))) (lambda (cs) (send! (router-inbound name (ctor subid cs)))))))
@ -112,12 +114,12 @@
#:on-remove (! Del) #:on-remove (! Del)
#:on-message (! Msg))) #:on-message (! Msg)))
(assert (from-broker node (observe spec))) (assert (from-broker node (observe spec)))
(stop-when (message (router-outbound name (Unsubscribe subid)))))) (stop-when (message (router-outbound name (Clear subid))))))
(during (observe ($ pat (from-broker node $spec))) (during (observe ($ pat (from-broker node $spec)))
(define ep (gensym 'ep)) (define ep (gensym 'ep))
(on-start (send! (router-inbound name (Subscribe ep spec)))) (on-start (send! (router-inbound name (Assert ep (observe spec)))))
(on-stop (send! (router-inbound name (Unsubscribe ep)))) (on-stop (send! (router-inbound name (Clear ep))))
(assert (from-broker node (observe spec))) ;; more self-signalling (assert (from-broker node (observe spec))) ;; more self-signalling
(on (message (router-outbound name (Add ep $captures))) (on (message (router-outbound name (Add ep $captures)))
(react (assert (instantiate-term->value pat captures)) (react (assert (instantiate-term->value pat captures))