Services and service activation

This commit is contained in:
Tony Garnock-Jones 2021-06-17 14:57:06 +02:00
parent 373fb77fc3
commit 0ab3526cba
19 changed files with 312 additions and 240 deletions

View File

@ -8,7 +8,7 @@
(assertion-struct box-state (value))
(module+ main
(actor-system/dataspace (ds)
(standard-actor-system/no-services (ds)
(spawn #:name 'box
(define-field current-value 0)
(at ds

View File

@ -27,6 +27,6 @@
(module+ main
(time
(actor-system/dataspace (ds)
(standard-actor-system (ds)
(box ds 500000 100000)
(client ds))))

View File

@ -19,9 +19,6 @@
[("--port" "-p") port-number "Set port number to connect to"
(set! port (string->number port-number))])
(actor-system/dataspace (ds)
(spawn-racket-event-driver ds)
(spawn-tcp-driver ds)
(spawn
(standard-actor-system (ds)
(at ds
(assert (StreamConnection (port-lines-source ds) (port-sink) (TcpRemote host port)))))))
(assert (StreamConnection (port-lines-source ds) (port-sink) (TcpRemote host port))))))

View File

@ -17,10 +17,8 @@
[("--port" "-p") port-number "Set port number to connect to"
(set! port (string->number port-number))])
(actor-system/dataspace (ds)
(spawn-racket-event-driver ds)
(spawn-tcp-driver ds)
(spawn
(standard-actor-system (ds)
(with-services [syndicate/drivers/racket-event]
(establish-connection
ds (TcpRemote host port)
#:initial-mode (Mode-lines (LineMode-lf))

View File

@ -15,9 +15,7 @@
[("--port" "-p") port-number "Set port number to listen on"
(set! port (string->number port-number))])
(actor-system/dataspace (ds)
(spawn-tcp-driver ds)
(spawn
(standard-actor-system (ds)
(at ds
(assert (StreamListener (TcpLocal host port)
(make-connection-handler
@ -25,4 +23,4 @@
(handle-connection source sink
#:on-data
(lambda (data mode)
(send-data sink data mode)))))))))))
(send-data sink data mode))))))))))

View File

@ -15,11 +15,9 @@
[("--port" "-p") port-number "Set port number to listen on"
(set! port (string->number port-number))])
(actor-system/dataspace (ds)
(spawn-tcp-driver ds)
(spawn
(standard-actor-system (ds)
(at ds
(stop-on (asserted (TcpListenError (TcpLocal host port) $message)))
(during/spawn (StreamConnection $source $sink (TcpLocal host port))
(handle-connection source sink
#:on-data (lambda (data mode) (send-data sink data mode))))))))
#:on-data (lambda (data mode) (send-data sink data mode)))))))

View File

@ -17,13 +17,11 @@
(message-struct Line (text))
(actor-system/dataspace (ds)
(spawn-tcp-driver ds)
(spawn
(standard-actor-system (ds)
(at ds
(stop-on (asserted (TcpListenError (TcpLocal host port) $message)))
(during/spawn (StreamConnection $source $sink (TcpLocal host port))
(handle-connection source sink
#:initial-mode (Mode-lines (LineMode-lf))
#:on-data (lambda (data mode) (send! ds (Line data))))
(at ds (on (message (Line $data)) (send-line sink data))))))))
(at ds (on (message (Line $data)) (send-line sink data)))))))

View File

@ -5,11 +5,10 @@
(require syndicate/drivers/timer)
(module+ main
(actor-system/dataspace (ds)
(spawn-timer-driver ds)
(spawn (at ds
(standard-actor-system (ds)
(at ds
(log-info "waiting...")
(on (timeout 1000)
(log-info "still waiting..."))
(stop-on (timeout 2000)
(log-info "done!"))))))
(log-info "done!")))))

View File

@ -9,13 +9,18 @@
dataspace
actor-system/dataspace)
(require (for-syntax racket/base))
(require (for-syntax syntax/parse))
(require racket/pretty)
(require racket/match)
(require preserves)
(require "bag.rkt")
(require "main.rkt")
(require "actor.rkt")
(require "syntax.rkt")
(require "syntax-classes.rkt")
(require "skeleton.rkt")
(require "schemas/gen/dataspace.rkt")
@ -67,11 +72,11 @@
(send-assertion! this-turn skeleton message))))
(ref ds-e))
(define-syntax actor-system/dataspace
(syntax-rules ()
[(_ (ds) expr ...)
(actor-system
#:name 'dataspace
(define-syntax (actor-system/dataspace stx)
(syntax-parse stx
[(_ (ds) name:<name> expr ...)
#'(actor-system
#:name name.N
(facet-prevent-inert-check! this-facet)
(define ds (dataspace))
expr ...)]))

View File

@ -14,7 +14,7 @@
(require syndicate/drivers/tcp)
(module+ main
(actor-system/dataspace (ds)
(standard-actor-system (ds)
(define ds-oid "syndicate")
(define ds-key (make-bytes KEY_LENGTH))
(at ds (assert (Bind ds-oid ds-key ds)))
@ -24,8 +24,6 @@
(newline)
(displayln (bytes->hex-string (sturdy-encode (->preserve root-cap))))
(spawn-tcp-driver ds)
(spawn #:name 'tcp-server
(define spec (TcpLocal "0.0.0.0" 5999))
(at ds
(stop-on (asserted (TcpListenError spec _)))
@ -47,4 +45,4 @@
(reverse (SturdyRef-caveatChain sturdyref))))
(define attenuated-target
(apply attenuate-entity-ref target attenuation))
(at observer (assert (embedded attenuated-target)))))])))))))
(at observer (assert (embedded attenuated-target)))))]))))))

View File

@ -4,8 +4,7 @@
;; Generic Racket events.
(provide (all-from-out syndicate/schemas/gen/racket-event)
spawn-racket-event-driver)
(provide (all-from-out syndicate/schemas/gen/racket-event))
(require syndicate/driver-support)
(require syndicate/schemas/gen/racket-event)
@ -13,15 +12,11 @@
(define-logger syndicate/drivers/racket-event)
(define (spawn-racket-event-driver ds)
(spawn #:name 'racket-event-driver
#:daemon? #t
(provide-service [ds]
(at ds
(during/spawn (Observe (:pattern (RacketEvent ,(DLit $embedded-event) ,_)) _)
#:name (embedded-value embedded-event)
(define event (embedded-value embedded-event))
(on-start (log-syndicate/drivers/racket-event-debug "started listening: ~v" event))
(on-stop (log-syndicate/drivers/racket-event-debug "stopped listening: ~v" event))
(linked-thread
#:name (list event 'thread)
(lambda (facet)
@ -29,4 +24,4 @@
(sync (handle-evt event
(lambda args
(turn! facet (lambda () (send! ds (RacketEvent event args))))
(loop)))))))))))
(loop))))))))))

View File

@ -8,12 +8,14 @@
(require (only-in racket/port read-line-evt))
(require "tcp.rkt") ;; ugh, lots of tcp.rkt actually belongs in this file
(require "racket-event.rkt")
(require syndicate/drivers/racket-event)
(require syndicate/service)
(define (port-lines-source ds [port (current-input-port)]
#:initial-credit [initial-credit 0]
#:name [name (list 'port-lines-source (object-name port))]
#:line-mode [line-mode (LineMode-lf)])
(at ds (assert (RequireService 'syndicate/drivers/racket-event)))
(define-field credit initial-credit)
(define-field sink #f)
(at ds

View File

@ -4,7 +4,6 @@
(provide (all-from-out syndicate/schemas/gen/stream)
(all-from-out syndicate/schemas/gen/tcp)
spawn-tcp-driver
handle-connection
make-source
@ -35,11 +34,7 @@
(define-logger syndicate/drivers/tcp)
(define (spawn-tcp-driver ds)
(spawn
#:name 'tcp-driver
#:daemon? #t
(provide-service [ds]
(at ds
(during/spawn (Observe (:pattern (StreamConnection ,_ ,_ ,$spec-pat)) _)
#:name (list 'simple-listener spec-pat)
@ -56,6 +51,7 @@
(during/spawn (StreamConnection $app-source $app-sink $spec)
#:name (list 'simple-connection spec)
(at ds
(during (StreamSpecConnectable spec)
(assert (StreamConnect spec
(object #:name 'connection-peer
[(ConnectionHandler-connected sys-source sys-sink)
@ -66,7 +62,7 @@
"Connection to ~a rejected: ~a" spec message)
(at app-source (assert (StreamError message)))
(at app-sink (assert (StreamError message)))
(stop-current-facet)])))))
(stop-current-facet)]))))))
;; I translate interest in StreamListener with a particular spec-pattern into a facet
;; that reacts to interest in StreamSpecListenable with a spec matching the spec-pattern
@ -102,7 +98,7 @@
(during/spawn (StreamConnect (TcpRemote $host $port) $peer)
#:name (TcpRemote host port)
(run-outbound ds peer host port)))))
(run-outbound ds peer host port))))
(define (run-listener ds peer host port)
(on-start (log-syndicate/drivers/tcp-info "+listener on ~v ~v" host port))
@ -134,6 +130,7 @@
(and remote-end (TcpRemote remote-host remote-port))))
(tcp-ends i))
(define name (format "[~a:~a::~a:~a]" local-host local-port remote-host remote-port))
(log-syndicate/drivers/tcp-info "Connection ~a established" name)
(spawn #:name name
(actor-add-exit-hook! this-actor (lambda ()
(close-input-port i)

View File

@ -3,7 +3,6 @@
;;; SPDX-FileCopyrightText: Copyright © 2018-2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
(provide (all-from-out syndicate/schemas/gen/timer)
spawn-timer-driver
timeout)
(require syndicate/driver-support)
@ -14,11 +13,7 @@
(define-logger syndicate/drivers/timer)
(define (spawn-timer-driver ds)
(spawn
#:name 'timer-driver
#:daemon? #t
(provide-service [ds]
(define control-ch (make-channel))
(linked-thread
@ -101,7 +96,7 @@
(on-start (send! (SetTimer timer-id msecs (TimerKind-absolute))))
(on-stop (send! (SetTimer timer-id msecs (TimerKind-clear))))
(on (message (TimerExpired timer-id _))
(react (assert (LaterThan msecs))))))))
(react (assert (LaterThan msecs)))))))
(define-event-expander timeout
(syntax-rules ()

View File

@ -6,6 +6,7 @@
(provide (except-out (all-from-out "actor.rkt") current-turn)
(struct-out entity-ref)
(all-from-out "syntax.rkt")
(all-from-out "service.rkt")
(all-from-out "event-expander.rkt")
(all-from-out preserves)
(all-from-out preserves-schema)
@ -18,6 +19,7 @@
(require "actor.rkt")
(require "entity-ref.rkt")
(require "syntax.rkt")
(require "service.rkt")
(require "event-expander.rkt")
(require preserves)
(require preserves-schema)

View File

@ -0,0 +1,5 @@
version 1 .
embeddedType EntityRef.Ref .
RequireService = <require-service @service-name any>.
ServiceRunning = <service-running @service-name any>.

86
syndicate/service.rkt Normal file
View File

@ -0,0 +1,86 @@
#lang racket/base
;;; SPDX-License-Identifier: LGPL-3.0-or-later
;;; SPDX-FileCopyrightText: Copyright © 2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
(provide (all-from-out syndicate/schemas/gen/service)
with-services
provide-service
standard-actor-system
standard-actor-system/no-services)
(require racket/stxparam)
(require (for-syntax racket/base))
(require syndicate/syntax)
(require syndicate/pattern)
(require syndicate/dataspace)
(require syndicate/schemas/gen/service)
(define-logger syndicate/service)
(define-syntax-parameter registry-dataspace
(lambda (stx)
(raise-syntax-error 'registry-dataspace "Illegal use" stx)))
(define-syntax with-services
(syntax-rules ()
[(_ [] body ...)
(begin body ...)]
[(_ [service-name more-services ...] body ...)
(at registry-dataspace
(during (ServiceRunning 'service-name)
(with-services [more-services ...] body ...)))]))
(define-syntax provide-service
(syntax-rules ()
[(_ [dataspace] body ...)
(module+ #%service
(provide #%service)
(define (#%service service-name dataspace)
(syntax-parameterize ([registry-dataspace (make-rename-transformer #'dataspace)])
(at dataspace (assert (ServiceRunning service-name)))
body ...)))]))
(define-syntax standard-actor-system/no-services
(syntax-rules ()
[(_ [dataspace] body ...)
(actor-system/dataspace (dataspace)
#:name 'standard-actor-system
(syntax-parameterize ([registry-dataspace (make-rename-transformer #'dataspace)])
(spawn-service-manager dataspace)
body ...))]))
(define-syntax standard-actor-system
(syntax-rules ()
[(_ [dataspace] body ...)
(standard-actor-system/no-services [dataspace]
(with-services [syndicate/drivers/tcp
syndicate/drivers/timer]
body ...))]))
(define (spawn-service-manager ds)
(spawn #:name 'syndicate/service
#:daemon? #t
(at ds
(during (Observe (:pattern (ServiceRunning ,(DLit $service-name))) _)
(assert (RequireService service-name)))
(during/spawn (RequireService $service-name)
#:name service-name
#:daemon? #t
(log-syndicate/service-info "Starting service ~a" service-name)
(define boot
(dynamic-require `(submod ,service-name #%service)
'#%service
(lambda () (error service-name "No service provided"))))
(boot service-name ds)
(on-stop (log-syndicate/service-info "Stopping service ~a" service-name))))))
;;---------------------------------------------------------------------------
;;; Local Variables:
;;; eval: (put 'provide-service 'racket-indent-function 1)
;;; eval: (put 'standard-actor-system 'racket-indent-function 1)
;;; eval: (put 'standard-actor-system/no-services 'racket-indent-function 1)
;;; End:

View File

@ -5,8 +5,7 @@
(require syndicate/drivers/timer)
(module+ test
(actor-system/dataspace (ds)
(spawn-timer-driver ds)
(standard-actor-system (ds)
(spawn (at ds
(assert 'item)
(on (timeout 50) (stop-current-facet))))

View File

@ -3,7 +3,7 @@
;;; SPDX-FileCopyrightText: Copyright © 2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
(module+ test
(actor-system/dataspace (ds)
(standard-actor-system (ds)
(spawn
(define (loop n)
(log-info "loop ~v" n)