From 924512f7dece288ff3c1d97dcf2a46ff66636aa4 Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Sun, 5 May 2019 12:55:16 +0100 Subject: [PATCH] Make internal broker isolation protocol asymmetric, to support the needs of federation --- syndicate/broker/server.rkt | 16 ++++++++++++++-- syndicate/test/broker/nesting-confusion.rkt | 18 +++++++++--------- 2 files changed, 23 insertions(+), 11 deletions(-) diff --git a/syndicate/broker/server.rkt b/syndicate/broker/server.rkt index 9b8542d..1f111c9 100644 --- a/syndicate/broker/server.rkt +++ b/syndicate/broker/server.rkt @@ -3,6 +3,7 @@ (provide (struct-out server-connection) (struct-out server-inbound) (struct-out server-outbound) + (struct-out server-proposal) (struct-out server-envelope)) (require "wire-protocol.rkt") @@ -15,9 +16,20 @@ (assertion-struct server-outbound (connection-id body)) ;; Internal isolation -(assertion-struct server-envelope (scope body)) +(assertion-struct server-proposal (scope body)) ;; suggestions (~ actions) +(assertion-struct server-envelope (scope body)) ;; decisions (~ events) (spawn #:name 'server-connection-factory + + (during/spawn (server-connection _ _) + ;; Previously, we just had server-envelope. Now, we have both + ;; server-envelope and server-proposal. While not everything + ;; decided is (locally) suggested, it is true that everything + ;; suggested is decided (in this implementation at least), + ;; and the following clause reflects this: + (during (server-proposal $scope $assertion) + (assert (server-envelope scope assertion)))) + (during/spawn (server-connection $id $scope) (define endpoints (set)) @@ -29,7 +41,7 @@ (field [assertion a]) - (assert (server-envelope scope (assertion))) + (assert (server-proposal scope (assertion))) (let ((! (lambda (ctor) (lambda (cs) (send! (server-outbound id (ctor ep cs))))))) (add-observer-endpoint! (lambda () diff --git a/syndicate/test/broker/nesting-confusion.rkt b/syndicate/test/broker/nesting-confusion.rkt index 01117c9..fe743d3 100644 --- a/syndicate/test/broker/nesting-confusion.rkt +++ b/syndicate/test/broker/nesting-confusion.rkt @@ -26,15 +26,15 @@ [(activate imperative-syndicate/broker) (spawn #:name 'tony - (assert (server-envelope "test" (researcher "Tony" "Computering"))) - (assert (server-envelope "test" (researcher "Tony" "Bicycling")))) + (assert (server-proposal "test" (researcher "Tony" "Computering"))) + (assert (server-proposal "test" (researcher "Tony" "Bicycling")))) (spawn #:name 'alice - (assert (server-envelope "test" (researcher "Alice" "Cryptography"))) - (assert (server-envelope "test" (researcher "Alice" "Bicycling")))) + (assert (server-proposal "test" (researcher "Alice" "Cryptography"))) + (assert (server-proposal "test" (researcher "Alice" "Bicycling")))) (spawn #:name 'eve - (assert (server-envelope "test" (researcher "Eve" "Cryptography"))) - (assert (server-envelope "test" (researcher "Eve" "Computering"))) - (assert (server-envelope "test" (researcher "Eve" "Evil")))) + (assert (server-proposal "test" (researcher "Eve" "Cryptography"))) + (assert (server-proposal "test" (researcher "Eve" "Computering"))) + (assert (server-proposal "test" (researcher "Eve" "Evil")))) (spawn #:name 'all-topics (during (broker-connected test-address) @@ -65,7 +65,7 @@ [(activate imperative-syndicate/broker) (spawn #:name 'claimant - (assert (server-envelope "test" (claim 123))) + (assert (server-proposal "test" (claim 123))) (on-start (for [(i 100)] (flush!)) (stop-current-facet))) (spawn #:name 'monitor (during (broker-connected test-address) @@ -89,7 +89,7 @@ (on-start (printf "Inner saw claim asserted\n")) (on-stop (printf "Inner saw claim retracted\n"))))) (spawn #:name 'claimant - (assert (server-envelope "test" (claim 123))) + (assert (server-proposal "test" (claim 123))) (on-start (printf "Outer claimant started\n")) (on-stop (printf "Outer claimant stopped\n")) (on-start (for [(i 100)] (flush!))