From 40ee3b4ca7eeee0dae554240284a1fed40feb928 Mon Sep 17 00:00:00 2001
From: Tony Garnock-Jones <tonygarnockjones@gmail.com>
Date: Fri, 3 May 2019 17:53:24 +0100
Subject: [PATCH] Test and fix for observation visibility in broker

---
 syndicate/broker/server.rkt                   |  7 +++--
 .../test/broker/observation-visibility.rkt    | 31 +++++++++++++++++++
 2 files changed, 35 insertions(+), 3 deletions(-)
 create mode 100644 syndicate/test/broker/observation-visibility.rkt

diff --git a/syndicate/broker/server.rkt b/syndicate/broker/server.rkt
index 797e67b..1f6a1c0 100644
--- a/syndicate/broker/server.rkt
+++ b/syndicate/broker/server.rkt
@@ -29,11 +29,12 @@
 
                 (field [assertion a])
 
+                (assert (server-envelope scope (assertion)))
+
                 (define (recompute-endpoint)
                   (define a (assertion))
                   (if (observe? a)
-                      (let* ((pattern (observe-specification a))
-                             (spec (server-envelope scope pattern)))
+                      (let ((spec (server-envelope scope (observe-specification a))))
                         (values (observe spec)
                                 (term->skeleton-interest
                                  spec
@@ -44,7 +45,7 @@
                                      (lambda ()
                                        (define ctor (match op ['+ Add] ['- Del] ['! Msg]))
                                        (send! (server-outbound id (ctor ep captured-values))))))))))
-                      (values (server-envelope scope a) #f)))
+                      (values (void) #f)))
                 (add-endpoint! (current-facet) "server" #t recompute-endpoint)
 
                 (on (message (server-inbound id (Assert ep $new-a)))
diff --git a/syndicate/test/broker/observation-visibility.rkt b/syndicate/test/broker/observation-visibility.rkt
new file mode 100644
index 0000000..ec24446
--- /dev/null
+++ b/syndicate/test/broker/observation-visibility.rkt
@@ -0,0 +1,31 @@
+#lang imperative-syndicate/test-implementation
+;; A client observing some part of the server's dataspace should cause
+;; creation of an assertion of observation in that server's dataspace.
+
+(require (only-in imperative-syndicate/lang activate))
+(require imperative-syndicate/broker)
+
+(assertion-struct presence (who))
+
+(define test-address (broker-loopback-connection "test"))
+
+(test-case
+    [(activate imperative-syndicate/broker)
+
+     (spawn #:name 'producer
+            (during (broker-connected test-address)
+              (assert (to-broker test-address (presence 'producer)))))
+
+     (spawn #:name 'consumer
+            (during (broker-connected test-address)
+              (on (asserted (from-broker test-address (presence $who)))
+                  (printf "~a joined\n" who))))
+
+     (spawn #:name 'metaconsumer
+            (during (broker-connected test-address)
+              (on (asserted (from-broker test-address (observe (presence _))))
+                  (printf "Someone cares about presence!\n"))))
+     ]
+  no-crashes
+  (expected-output (set "producer joined"
+                        "Someone cares about presence!")))