2016-11-30 05:08:35 +00:00
|
|
|
#lang syndicate/actor
|
|
|
|
|
|
|
|
|
|
(require racket/set)
|
|
|
|
|
|
|
|
|
|
(require/activate syndicate/reload)
|
|
|
|
|
|
|
|
|
|
(require "protocol.rkt")
|
|
|
|
|
|
|
|
|
|
(actor #:name 'account-manager
|
|
|
|
|
(stop-when-reloaded)
|
|
|
|
|
(define/query-set accounts (account $e) e)
|
2016-12-06 21:10:05 +00:00
|
|
|
(on (message (create-resource (account $e)))
|
|
|
|
|
(when (not (set-member? (accounts) e))
|
|
|
|
|
(spawn-account e)))
|
2016-11-30 05:08:35 +00:00
|
|
|
(on (asserted (session $email _))
|
|
|
|
|
(when (not (set-member? (accounts) email))
|
|
|
|
|
(spawn-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))
|
2016-12-06 02:04:41 +00:00
|
|
|
(assert (grant email email email (p:follow email) #t))
|
2017-01-05 01:57:26 +00:00
|
|
|
(stop-when (message (delete-resource (account email))))))
|
