From f13fc9cad39406636841d3df3f40b13595dcfc51 Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Wed, 7 Dec 2016 10:10:05 +1300 Subject: [PATCH] Support loading of test data --- examples/webchat/server/account.rkt | 3 +++ examples/webchat/server/config.rkt | 6 ++++++ examples/webchat/server/testdata.rkt | 23 +++++++++++++++++++++++ 3 files changed, 32 insertions(+) create mode 100644 examples/webchat/server/testdata.rkt diff --git a/examples/webchat/server/account.rkt b/examples/webchat/server/account.rkt index b65ff3d..fd63142 100644 --- a/examples/webchat/server/account.rkt +++ b/examples/webchat/server/account.rkt @@ -9,6 +9,9 @@ (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)))) diff --git a/examples/webchat/server/config.rkt b/examples/webchat/server/config.rkt index dd167ea..56a2071 100644 --- a/examples/webchat/server/config.rkt +++ b/examples/webchat/server/config.rkt @@ -4,6 +4,7 @@ (require racket/port) (require/activate syndicate/reload) +(require/activate syndicate/supervise) (require/activate syndicate/drivers/config) (require/activate syndicate/drivers/web) (require/activate syndicate/drivers/smtp) @@ -39,5 +40,10 @@ (during (config _ (list 'baseurl $u)) (assert (server-baseurl u))) (during (config _ (list 'listen $p)) (assert (web-virtual-host "http" _ p))) + (during/actor (config _ (list 'load $module-path)) + #:actor supervise/actor + #:name (list 'load module-path) + (reloader-mixin* module-path)) + (during (config _ (list 'smtp $h $u $p $m)) (assert (smtp-account-config 'smtp-service h #:user u #:password p #:ssl-mode m)))) diff --git a/examples/webchat/server/testdata.rkt b/examples/webchat/server/testdata.rkt new file mode 100644 index 0000000..1451536 --- /dev/null +++ b/examples/webchat/server/testdata.rkt @@ -0,0 +1,23 @@ +#lang syndicate/actor + +(require "protocol.rkt") + +(send! (create-resource (account "tonyg@ccs.neu.edu"))) +(send! (create-resource (account "me@here"))) +(send! (create-resource (account "also@here"))) + +(define (follow! A B) + (send! (create-resource (grant A A B (p:follow A) #f))) + (send! (create-resource (grant B B A (p:follow B) #f)))) + +(follow! "tonyg@ccs.neu.edu" "me@here") +(follow! "also@here" "me@here") +(follow! "tonyg@ccs.neu.edu" "also@here") + +(define (make-conversation! cid title creator . other-members) + (send! (create-resource (conversation cid title creator ""))) + (for [(who (in-list (cons creator other-members)))] + (send! (create-resource (in-conversation cid who))))) + +(make-conversation! "test" "Test Conversation" "tonyg@ccs.neu.edu" "me@here") +(make-conversation! "grouptest" "Group Conversation" "also@here" "me@here" "tonyg@ccs.neu.edu")