The Big Spawn/Actor Swap

This commit is contained in:
Tony Garnock-Jones 2017-02-20 17:32:22 -05:00
parent eaa1806728
commit ac4f15325f
8 changed files with 24 additions and 24 deletions

View File

@ -21,23 +21,23 @@
#:once-each
["--baseurl" baseurl "Specify the canonical base URL for this hub"
(actor #:name (list 'command-line-canonical-baseurl baseurl)
(spawn #:name (list 'command-line-canonical-baseurl baseurl)
(assert (config 'command-line (list 'canonical-baseurl baseurl))))]
#:multi
[("-l" "--listen") host port "Specify one HTTP listener"
(actor #:name (list 'command-line-http-listener host port)
(spawn #:name (list 'command-line-http-listener host port)
(assert (config 'command-line
(list 'http-listener host (string->number port)))))]
[("-o" "--option") key vals "Specify a single configuration option"
(actor #:name (list 'config-option key vals)
(spawn #:name (list 'config-option key vals)
(assert (config 'command-line
(cons (string->symbol key)
(port->list read (open-input-string vals))))))]
[("-f" "--config-file") filename "Specify a configuration file to load"
(spawn-configuration filename filename)])
(actor #:name 'main
(spawn #:name 'main
(during (config _ (list 'canonical-baseurl $u))
(assert (canonical-baseurl u)))

View File

@ -7,7 +7,7 @@
(require "../private/util.rkt")
(require "../protocol.rkt")
(actor #:name 'local-topic-manager
(spawn #:name 'local-topic-manager
(field [topics (set)])
@ -27,7 +27,7 @@
(retract! (local-topic-config topic ? ?)))
(web-respond/bytes! id #"")))
(during/actor (local-topic-demand $topic)
(during/spawn (local-topic-demand $topic)
#:name (list 'local-topic topic)
(local-topic-main topic)))

View File

@ -40,13 +40,13 @@
upstream-topic ;; Topic -- upstream topic (from discovery)
) #:prefab) ;; ASSERTION
(actor #:name 'remote-topic-manager
(during/actor (remote-topic-demand $requested-topic)
(spawn #:name 'remote-topic-manager
(during/spawn (remote-topic-demand $requested-topic)
#:name (list 'remote-topic requested-topic)
(remote-topic-main requested-topic)))
(actor #:name 'upstream-link-manager
(during/actor (upstream-link $requested-topic $upstream-hub $upstream-topic)
(spawn #:name 'upstream-link-manager
(during/spawn (upstream-link $requested-topic $upstream-hub $upstream-topic)
#:name (list 'upstream-link requested-topic upstream-hub upstream-topic)
(upstream-link-main requested-topic upstream-hub upstream-topic)))

View File

@ -14,7 +14,7 @@
(define-runtime-path htdocs-path "../htdocs")
(define path->mime-type (make-path->mime-type "/etc/mime.types")))
(actor #:name 'static-content-server
(spawn #:name 'static-content-server
(define url->path (make-url->path htdocs-path))
(during (http-listener $host-name $port)
(on (web-request-get (id req) (vh host-name port) ,_)

View File

@ -12,7 +12,7 @@
(require "../private/util.rkt")
(require "../protocol.rkt")
(actor #:name 'hub
(spawn #:name 'hub
(during (http-listener $host-name $port)
(during (canonical-baseurl $baseurl)
(on (web-request-incoming (id req) (vh host-name port) 'post ("hub" ()) $body)
@ -23,13 +23,13 @@
(retract! (subscription topic callback ?))
(when settings (assert! (subscription topic callback settings))))
(during/actor (subscription $topic $callback _)
(during/spawn (subscription $topic $callback _)
#:name (list 'subscription topic callback)
#:on-crash (retract! (subscription topic callback ?))
(subscription-main topic callback)))
(define (asynchronous-verification-of-intent id req body baseurl)
(actor* #:name 'verification-of-intent
(spawn* #:name 'verification-of-intent
(define params (make-immutable-hash (form-urlencoded->alist (bytes->string/utf-8 body))))
(define callback (hash-ref params 'hub.callback))
(define mode (match (hash-ref params 'hub.mode)

View File

@ -10,8 +10,8 @@
(require "../private/util.rkt")
(require "../protocol.rkt")
(actor #:name 'topic-demand-analyzer
(during/actor (topic-demand $full-topic _)
(spawn #:name 'topic-demand-analyzer
(during/spawn (topic-demand $full-topic _)
#:name (list 'topic-demand full-topic)
(define/query-value topic-baseurl #f (canonical-baseurl $b)

View File

@ -12,7 +12,7 @@
(require "../private/util.rkt")
(require "../protocol.rkt")
(actor #:name 'websocket-hub
(spawn #:name 'websocket-hub
(during (http-listener $host-name $port)
(during (canonical-baseurl $baseurl)
(on (web-request-get (id req) (vh host-name port) ("hub" ()))
@ -20,7 +20,7 @@
(websocket-subscription id req baseurl))))))
(define (websocket-subscription id req baseurl)
(actor* #:name (list 'websocket-subscription id)
(spawn* #:name (list 'websocket-subscription id)
(define params (web-request-header-query req))
(define requested-topic (dict-ref params 'hub.topic))
(define topic ;; TODO: abstract this expression out (see also subscription.rkt)

View File

@ -31,7 +31,7 @@
(define (print-prompt)
(printf "> ")
(flush-output))
(actor (on-start (print-prompt))
(spawn (on-start (print-prompt))
(stop-when (message (inbound (external-event e (list (? eof-object? _))))))
(assert 'shell-running)
(on (message (inbound (external-event e (list (? bytes? $bs)))))
@ -58,19 +58,19 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(actor #:name 'main
(spawn #:name 'main
(stop-when (retracted 'shell-running))
(assert vh)
(on (web-request-get (id req) vh ("" ()))
(actor*
(spawn*
(web-respond/xexpr! id
`(html
(body
(h1 "Poke running")))))))
(actor #:name 'sink
(spawn #:name 'sink
(on (web-request-incoming (id req) vh 'post ("sink" (,$sub-id ())) $body)
(printf "SINK POST ~a: ~v >>> ~v\n" sub-id req body)
(if (equal? body #"fail")
@ -81,7 +81,7 @@
(define challenge (dict-ref (web-request-header-query req) 'hub.challenge ""))
(web-respond/bytes! id (string->bytes/utf-8 challenge))))
(actor #:name 'incoming-tracer
(spawn #:name 'incoming-tracer
(assert (observe (web-response-complete _ _ _))) ;; :-( See journal for 30 Oct 2016
(on (web-request-incoming (id req) vh $verb ,$path $body)
(printf "~a ==> ~a ~v ~v\n" id verb path body)
@ -91,7 +91,7 @@
(printf "~a <== timeout\n" id)))))
(define (spawn-subscriber topic [sub-id (gensym 'sub)])
(actor #:name (list 'subscriber sub-id)
(spawn #:name (list 'subscriber sub-id)
(on-start
(request! 'post `("hub" ())