2017-08-10 19:17:28 +00:00
|
|
|
#lang syndicate
|
2016-11-30 05:08:35 +00:00
|
|
|
|
|
|
|
|
(require racket/set)
|
|
|
|
|
|
|
|
|
|
(require/activate syndicate/reload)
|
2017-01-06 19:51:03 +00:00
|
|
|
(require/activate syndicate/supervise)
|
2016-11-30 05:08:35 +00:00
|
|
|
|
|
|
|
|
(require "protocol.rkt")
|
2017-01-06 19:51:03 +00:00
|
|
|
(require "duplicate.rkt")
|
2016-11-30 05:08:35 +00:00
|
|
|
|
2017-02-20 17:54:52 +00:00
|
|
|
(spawn #:name 'account-manager
|
2016-11-30 05:08:35 +00:00
|
|
|
(stop-when-reloaded)
|
|
|
|
|
(define/query-set accounts (account $e) e)
|
|
|
|
|
(on (asserted (session $email _))
|
|
|
|
|
(when (not (set-member? (accounts) email))
|
2017-01-06 19:51:03 +00:00
|
|
|
(send! (create-resource (account email))))))
|
2016-11-30 05:08:35 +00:00
|
|
|
|
2017-02-20 17:54:52 +00:00
|
|
|
(spawn #:name 'account-factory
|
2017-01-06 19:51:03 +00:00
|
|
|
(stop-when-reloaded)
|
|
|
|
|
(on (message (create-resource ($ a (account $email))))
|
2017-02-20 17:54:52 +00:00
|
|
|
(spawn #:name (list 'account email)
|
2017-01-06 19:51:03 +00:00
|
|
|
(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))))))
|
