diff --git a/examples/webchat/server/TODO.md b/examples/webchat/server/TODO.md new file mode 100644 index 0000000..e1e6218 --- /dev/null +++ b/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. diff --git a/examples/webchat/server/account.rkt b/examples/webchat/server/account.rkt index 14cae89..409a5ba 100644 --- a/examples/webchat/server/account.rkt +++ b/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)))))) diff --git a/examples/webchat/server/pages.rkt b/examples/webchat/server/pages.rkt index 58e5e1e..2ddf185 100644 --- a/examples/webchat/server/pages.rkt +++ b/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