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

Support loading of test data

This commit is contained in:
Tony Garnock-Jones 2016-12-07 10:10:05 +13:00
parent bf20d84935
commit f13fc9cad3
3 changed files with 32 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
examples/webchat/server/account.rkt
View File

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

6
examples/webchat/server/config.rkt
View File

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

23
examples/webchat/server/testdata.rkt Normal file
View File

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