Reuse create-resource protocol for session monitors and accounts.

examples/webchat/server/TODO.md

@@ -0,0 +1,36 @@
+✓ Remove delete-account, use delete-resource of an account instead
+
+✓ Reimplement spawn-session-monitor and end-session to work in terms
+of create-resource and delete-resource, but leave login-link
+idiosyncratic
+
+Factor out resource management into its own module. Introduce a macro
+for describing resources, their cascading deletion conditions, and
+their potential automatic expiries.
+
+Build a persistent resource management module. Adjust
+`immediate-query` to be able to use an alternative `flush!` routine.
+
+  NOTE that automatic expiry in the direct implementation is as simple
+  as `stop-when-timeout`, but cannot be this simple in a persistent
+  implementation: instead, I plan on producing a special "expiries"
+  table, each entry of which specifies a message to send upon expiry.
+
+  NOTE that the trick of producing a base `p:follow` grant record on
+  account creation has to be done differently when there's no
+  always-on account process.
+
+  NOTE that the trick of deleting an `invitation` when a matching
+  `in-conversation` appears also has to be done differently, similarly
+  to the `p:follow` grant mentioned above. However, this might be able
+  to be automated: if there's some kind of `(stop-when E)` where `E`
+  mentions some field or fields of a resource, matching resources can
+  be deleted from the persistent store by an auxiliary process. This
+  would require fairly hairy syntactic analysis though, so it might be
+  better to have some kind of `cascading-delete-when` form to spell
+  out what should be removed on a given event. (Then the `p:follow`
+  case above can be implemented with some kind of
+  `cascading-insert-when`?)
+
+  NOTE that these differences are OK: this is the first time Syndicate
+  has tackled persistence at all in any interesting way.

examples/webchat/server/account.rkt

@@ -3,24 +3,25 @@
 (require racket/set)
 
 (require/activate syndicate/reload)
+(require/activate syndicate/supervise)
 
 (require "protocol.rkt")
+(require "duplicate.rkt")
 
 (actor #:name 'account-manager
        (stop-when-reloaded)
        (define/query-set accounts (account $e) e)
-       (on (message (create-resource (account $e)))
-           (when (not (set-member? (accounts) e))
-             (spawn-account e)))
        (on (asserted (session $email _))
            (when (not (set-member? (accounts) email))
-             (spawn-account email))))
+             (send! (create-resource (account email))))))
 
-(define (spawn-account email)
-  (actor #:name (list 'account email)
-         (stop-when-reloaded)
-         (on-start (log-info "Account ~s created." email))
-         (on-stop (log-info "Account ~s deleted." email))
-         (assert (account email))
-         (assert (grant email email email (p:follow email) #t))
-         (stop-when (message (delete-resource (account email))))))
+(actor #:name 'account-factory
+       (stop-when-reloaded)
+       (on (message (create-resource ($ a (account $email))))
+           (actor #:name (list 'account email)
+                  (on-start (log-info "Account ~s created." email))
+                  (on-stop (log-info "Account ~s deleted." email))
+                  (assert a)
+                  (assert (grant email email email (p:follow email) #t))
+                  (stop-when-duplicate a)
+                  (stop-when (message (delete-resource a))))))

examples/webchat/server/pages.rkt

@@ -9,12 +9,14 @@
 (require net/uri-codec)
 
 (require/activate syndicate/reload)
+(require/activate syndicate/supervise)
 (require/activate syndicate/drivers/config)
 (require/activate syndicate/drivers/smtp)
 (require/activate syndicate/drivers/timestate)
 (require/activate syndicate/drivers/web)
 
 (require "protocol.rkt")
+(require "duplicate.rkt")
 (require "session-cookie.rkt")
 
 (define (page #:head [extra-head '()]
@@ -250,7 +252,7 @@
            (match (immediate-query (query-value #f (login-link $email sid) email))
              [#f (login-link-expired-page id)]
              [email
-              (spawn-session-monitor email sid)
+              (send! (create-resource (session email sid)))
               (web-redirect! id "/" #:headers (list (format-cookie (session-id->cookie sid))))])))
 
 (define (login-link-expired-page id)
@@ -261,11 +263,16 @@
                     `(p ((class "lead"))
                         "Please " (a ((href "/")) "return to the main page") ".")))))
 
-(define (spawn-session-monitor email sid)
-  (actor #:name (list 'session-monitor email sid)
-         (on-start (log-info "Session ~s for ~s started." sid email))
-         (on-stop (log-info "Session ~s for ~s stopped." sid email))
-         (assert (session email sid))
-         (stop-when (message (end-session sid)))
-         (stop-when (message (delete-resource (account email))))
-         (stop-when-timeout (* 7 86400 1000)))) ;; 1 week
+(supervise
+ (actor #:name 'session-monitor-factory
+        (stop-when-reloaded)
+        (on (message (create-resource ($ s (session $email $sid))))
+            (actor #:name (list 'session-monitor email sid)
+                   (on-start (log-info "Session ~s for ~s started." sid email))
+                   (on-stop (log-info "Session ~s for ~s stopped." sid email))
+                   (assert s)
+                   (stop-when-duplicate s)
+                   (stop-when (message (delete-resource s)))
+                   (stop-when (message (delete-resource (account email))))
+                   (stop-when (message (end-session sid)))
+                   (stop-when-timeout (* 7 86400 1000)))))) ;; 1 week