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

Make internal broker isolation protocol asymmetric, to support the needs of federation

This commit is contained in:
Tony Garnock-Jones 2019-05-05 12:55:16 +01:00
parent a3a229532a
commit 924512f7de
2 changed files with 23 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
syndicate/broker/server.rkt
View File

@ -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 ()

18
syndicate/test/broker/nesting-confusion.rkt
View File

@ -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!))