refactoring volgens skill
This commit is contained in:
+296
-260
@@ -3,6 +3,7 @@
|
||||
(require json
|
||||
net/url
|
||||
racket-audio
|
||||
racket/contract
|
||||
racket/file
|
||||
racket/path
|
||||
racket/port
|
||||
@@ -17,6 +18,15 @@
|
||||
|
||||
(struct exn:fail:agent-denied exn:fail () #:transparent)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Expose the small procedure-based interface of a running agent.
|
||||
; pre : Constructor fields are lifecycle/query procedures and a stable ID.
|
||||
; post : Creating or recognizing a value changes no external state.
|
||||
; result : player-agent-runtime? recognizes values returned by the factory.
|
||||
; internals:
|
||||
; Procedures keep the mutable audio and polling state private without
|
||||
; introducing a class or a second generic backend abstraction.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(struct player-agent-runtime
|
||||
(start! reconnect! shutdown! snapshot current-track running? app-id)
|
||||
#:transparent)
|
||||
@@ -29,26 +39,27 @@
|
||||
(combine-url/relative (base-url base) path))
|
||||
|
||||
(define (post-json base path data)
|
||||
(define input
|
||||
(post-pure-port
|
||||
(endpoint-url base path)
|
||||
(jsexpr->bytes data)
|
||||
(list "Content-Type: application/json"
|
||||
"Cache-Control: no-store")))
|
||||
(dynamic-wind
|
||||
void
|
||||
(lambda ()
|
||||
(define response (read-json input))
|
||||
(when (and (hash? response)
|
||||
(string? (hash-ref response 'error #f)))
|
||||
(if (equal? (hash-ref response 'code #f) "agent-not-authorized")
|
||||
(raise
|
||||
(exn:fail:agent-denied
|
||||
(hash-ref response 'error)
|
||||
(current-continuation-marks)))
|
||||
(error 'player-agent (hash-ref response 'error))))
|
||||
response)
|
||||
(lambda () (close-input-port input))))
|
||||
(let ((input
|
||||
(post-pure-port
|
||||
(endpoint-url base path)
|
||||
(jsexpr->bytes data)
|
||||
(list "Content-Type: application/json"
|
||||
"Cache-Control: no-store"))))
|
||||
(dynamic-wind
|
||||
void
|
||||
(λ ()
|
||||
(let ((response (read-json input)))
|
||||
(when (and (hash? response)
|
||||
(string? (hash-ref response 'error #f)))
|
||||
(if (equal? (hash-ref response 'code #f)
|
||||
"agent-not-authorized")
|
||||
(raise
|
||||
(exn:fail:agent-denied
|
||||
(hash-ref response 'error)
|
||||
(current-continuation-marks)))
|
||||
(error 'player-agent (hash-ref response 'error))))
|
||||
response))
|
||||
(λ () (close-input-port input)))))
|
||||
|
||||
(define (normal-state state)
|
||||
(cond
|
||||
@@ -59,49 +70,69 @@
|
||||
(define (safe-delete-file file)
|
||||
(when (and file (file-exists? file))
|
||||
(with-handlers ((exn:fail?
|
||||
(lambda (exception)
|
||||
(λ (exception)
|
||||
(warn-player-agent
|
||||
"Could not remove temporary media file ~a: ~a"
|
||||
file
|
||||
(exn-message exception)))))
|
||||
(delete-file file))))
|
||||
|
||||
(define (make-player-agent-runtime initial-server-url
|
||||
initial-name
|
||||
app-id
|
||||
#:status-callback
|
||||
[status-callback void]
|
||||
#:denied-callback
|
||||
[denied-callback void])
|
||||
(define server-url initial-server-url)
|
||||
(define assigned-name initial-name)
|
||||
(define state-lock (make-semaphore 1))
|
||||
(define worker #f)
|
||||
(define command-worker #f)
|
||||
(define executing-command-id 0)
|
||||
(define running #f)
|
||||
(define authorization-notified? #f)
|
||||
(define audio #f)
|
||||
(define current-media-key #f)
|
||||
(define cached-media (make-hash))
|
||||
(define prefetched-track #f)
|
||||
(define auto-started-key #f)
|
||||
(define pending-auto-music-id #f)
|
||||
(define music-tracks (make-hash))
|
||||
(define current-track-value #f)
|
||||
(define acknowledged-command 0)
|
||||
(define ended-counter 0)
|
||||
(define logical-volume 50)
|
||||
(define agent-state
|
||||
(hasheq 'state "stopped"
|
||||
'position 0
|
||||
'duration 'null
|
||||
'rate 'null
|
||||
'channels 'null
|
||||
'bits 'null
|
||||
'format ""
|
||||
'volume logical-volume
|
||||
'error 'null))
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Provided functions
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Create the headless polling and audio runtime for one agent.
|
||||
; pre : Server URL, display name and application ID are strings; callbacks
|
||||
; accept the status/denial messages supplied to them.
|
||||
; post : Mutable state is initialized but no worker thread or audio backend
|
||||
; is started until the returned start! procedure is called.
|
||||
; result : A player-agent-runtime containing its lifecycle/query procedures.
|
||||
; internals:
|
||||
; One closure owns the simple mutable state shared by polling,
|
||||
; command and audio callbacks. Keeping these procedures together
|
||||
; makes their synchronization and cleanup order directly visible.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define/contract (make-player-agent-runtime initial-server-url
|
||||
initial-name
|
||||
app-id
|
||||
#:status-callback
|
||||
[status-callback void]
|
||||
#:denied-callback
|
||||
[denied-callback void])
|
||||
(->* (string? string? string?)
|
||||
(#:status-callback (-> string? any/c)
|
||||
#:denied-callback (-> string? any/c))
|
||||
player-agent-runtime?)
|
||||
(let* ((server-url initial-server-url)
|
||||
(assigned-name initial-name)
|
||||
(state-lock (make-semaphore 1))
|
||||
(worker #f)
|
||||
(command-worker #f)
|
||||
(executing-command-id 0)
|
||||
(running #f)
|
||||
(authorization-notified? #f)
|
||||
(audio #f)
|
||||
(current-media-key #f)
|
||||
(cached-media (make-hash))
|
||||
(prefetched-track #f)
|
||||
(auto-started-key #f)
|
||||
(pending-auto-music-id #f)
|
||||
(music-tracks (make-hash))
|
||||
(current-track-value #f)
|
||||
(acknowledged-command 0)
|
||||
(ended-counter 0)
|
||||
(logical-volume 50)
|
||||
(agent-state
|
||||
(hasheq 'state "stopped"
|
||||
'position 0
|
||||
'duration 'null
|
||||
'rate 'null
|
||||
'channels 'null
|
||||
'bits 'null
|
||||
'format ""
|
||||
'volume logical-volume
|
||||
'error 'null)))
|
||||
|
||||
(define (with-agent-state proc)
|
||||
(call-with-semaphore state-lock proc))
|
||||
@@ -110,98 +141,98 @@
|
||||
(if (eq? value #f) fallback value))
|
||||
|
||||
(define (snapshot)
|
||||
(with-agent-state (lambda () agent-state)))
|
||||
(with-agent-state (λ () agent-state)))
|
||||
|
||||
(define (current-track)
|
||||
(with-agent-state (lambda () current-track-value)))
|
||||
(with-agent-state (λ () current-track-value)))
|
||||
|
||||
(define (set-agent-error! message)
|
||||
(with-agent-state
|
||||
(lambda ()
|
||||
(λ ()
|
||||
(set! agent-state (hash-set agent-state 'error message)))))
|
||||
|
||||
(define (clear-agent-error!)
|
||||
(with-agent-state
|
||||
(lambda ()
|
||||
(λ ()
|
||||
(set! agent-state (hash-set agent-state 'error 'null)))))
|
||||
|
||||
(define (update-from-audio! state full-state)
|
||||
(with-agent-state
|
||||
(lambda ()
|
||||
(define audible-music-id (hash-ref full-state 'at-music-id #f))
|
||||
(set! agent-state
|
||||
(hasheq
|
||||
'state (normal-state state)
|
||||
'position (state-value (hash-ref full-state 'at-second #f) 0)
|
||||
'duration (state-value (hash-ref full-state 'duration #f) 'null)
|
||||
'rate (state-value (hash-ref full-state 'rate #f) 'null)
|
||||
'channels (state-value (hash-ref full-state 'channels #f) 'null)
|
||||
'bits (state-value (hash-ref full-state 'bits #f) 'null)
|
||||
'format (let ((decoder (hash-ref full-state 'decoder #f)))
|
||||
(if decoder (format "~a" decoder) ""))
|
||||
'volume logical-volume
|
||||
'error 'null))
|
||||
(when (and pending-auto-music-id
|
||||
(number? audible-music-id)
|
||||
(= pending-auto-music-id audible-music-id))
|
||||
(define audible-track
|
||||
(hash-ref music-tracks audible-music-id #f))
|
||||
(when audible-track
|
||||
(set! current-track-value audible-track)
|
||||
(hash-clear! music-tracks)
|
||||
(hash-set! music-tracks audible-music-id audible-track))
|
||||
(set! pending-auto-music-id #f)
|
||||
(set! ended-counter (+ ended-counter 1))))))
|
||||
(λ ()
|
||||
(let ((audible-music-id (hash-ref full-state 'at-music-id #f)))
|
||||
(set! agent-state
|
||||
(hasheq
|
||||
'state (normal-state state)
|
||||
'position (state-value (hash-ref full-state 'at-second #f) 0)
|
||||
'duration (state-value (hash-ref full-state 'duration #f) 'null)
|
||||
'rate (state-value (hash-ref full-state 'rate #f) 'null)
|
||||
'channels (state-value (hash-ref full-state 'channels #f) 'null)
|
||||
'bits (state-value (hash-ref full-state 'bits #f) 'null)
|
||||
'format (let ((decoder (hash-ref full-state 'decoder #f)))
|
||||
(if decoder (format "~a" decoder) ""))
|
||||
'volume logical-volume
|
||||
'error 'null))
|
||||
(when (and pending-auto-music-id
|
||||
(number? audible-music-id)
|
||||
(= pending-auto-music-id audible-music-id))
|
||||
(let ((audible-track
|
||||
(hash-ref music-tracks audible-music-id #f)))
|
||||
(when audible-track
|
||||
(set! current-track-value audible-track)
|
||||
(hash-clear! music-tracks)
|
||||
(hash-set! music-tracks audible-music-id audible-track)))
|
||||
(set! pending-auto-music-id #f)
|
||||
(set! ended-counter (+ ended-counter 1)))))))
|
||||
|
||||
(define (ensure-audio!)
|
||||
(unless audio
|
||||
(set! audio
|
||||
(make-audio-player
|
||||
(lambda (_handle state full-state)
|
||||
(λ (_handle state full-state)
|
||||
(update-from-audio! state full-state))
|
||||
(lambda (handle)
|
||||
(λ (handle)
|
||||
(advance-at-decoder-eof! handle))))
|
||||
(audio-ao-buf-ms! audio 500)
|
||||
(audio-buf-seconds! audio 4 10)
|
||||
(define scaled (/ logical-volume 100.0))
|
||||
(audio-volume! audio (* 100.0 scaled scaled)))
|
||||
(let ((scaled (/ logical-volume 100.0)))
|
||||
(audio-volume! audio (* 100.0 scaled scaled))))
|
||||
audio)
|
||||
|
||||
(define (download-media! token filename)
|
||||
(define extension
|
||||
(or (path-get-extension (string->path filename)) #""))
|
||||
(define target
|
||||
(make-temporary-file
|
||||
(string-append "rkt-player-agent-~a"
|
||||
(bytes->string/utf-8 extension))))
|
||||
(define path (format "/api/agent/media/~a/~a" app-id token))
|
||||
(define input (get-pure-port (endpoint-url server-url path)))
|
||||
(with-handlers ((exn:fail?
|
||||
(lambda (exception)
|
||||
(close-input-port input)
|
||||
(safe-delete-file target)
|
||||
(raise exception))))
|
||||
(call-with-output-file
|
||||
target
|
||||
(lambda (output) (copy-port input output))
|
||||
#:exists 'truncate/replace)
|
||||
(close-input-port input)
|
||||
target))
|
||||
(let* ((extension
|
||||
(or (path-get-extension (string->path filename)) #""))
|
||||
(target
|
||||
(make-temporary-file
|
||||
(string-append "rkt-player-agent-~a"
|
||||
(bytes->string/utf-8 extension))))
|
||||
(path (format "/api/agent/media/~a/~a" app-id token))
|
||||
(input (get-pure-port (endpoint-url server-url path))))
|
||||
(with-handlers ((exn:fail?
|
||||
(λ (exception)
|
||||
(close-input-port input)
|
||||
(safe-delete-file target)
|
||||
(raise exception))))
|
||||
(call-with-output-file
|
||||
target
|
||||
(λ (output) (copy-port input output))
|
||||
#:exists 'truncate/replace)
|
||||
(close-input-port input)
|
||||
target)))
|
||||
|
||||
(define (command-cache-key data)
|
||||
(hash-ref data 'cacheKey (hash-ref data 'mediaToken)))
|
||||
|
||||
(define (ensure-media-cached! data)
|
||||
(define key (command-cache-key data))
|
||||
(define found (hash-ref cached-media key #f))
|
||||
(if (and found (file-exists? found))
|
||||
found
|
||||
(let ((downloaded
|
||||
(download-media!
|
||||
(hash-ref data 'mediaToken)
|
||||
(hash-ref data 'filename "track"))))
|
||||
(hash-set! cached-media key downloaded)
|
||||
downloaded)))
|
||||
(let* ((key (command-cache-key data))
|
||||
(found (hash-ref cached-media key #f)))
|
||||
(if (and found (file-exists? found))
|
||||
found
|
||||
(let ((downloaded
|
||||
(download-media!
|
||||
(hash-ref data 'mediaToken)
|
||||
(hash-ref data 'filename "track"))))
|
||||
(hash-set! cached-media key downloaded)
|
||||
downloaded))))
|
||||
|
||||
(define (discard-unused-media! keep-key)
|
||||
(for ((entry (in-list (hash->list cached-media))))
|
||||
@@ -212,130 +243,134 @@
|
||||
;; Decoder EOF occurs before audible EOF. Queueing the prefetched decoder at
|
||||
;; this point appends it behind racket-audio's remaining output buffer.
|
||||
(define (advance-at-decoder-eof! handle)
|
||||
(define prepared
|
||||
(with-agent-state
|
||||
(lambda ()
|
||||
(define value prefetched-track)
|
||||
(set! prefetched-track #f)
|
||||
value)))
|
||||
(cond
|
||||
(prepared
|
||||
(define data (car prepared))
|
||||
(define path (cdr prepared))
|
||||
(define key (command-cache-key data))
|
||||
(with-handlers
|
||||
((exn:fail?
|
||||
(lambda (exception)
|
||||
(warn-player-agent "Could not start prefetched track: ~a"
|
||||
(exn-message exception))
|
||||
(set-agent-error! (exn-message exception))
|
||||
(let ((prepared
|
||||
(with-agent-state
|
||||
(λ ()
|
||||
(let ((value prefetched-track))
|
||||
(set! prefetched-track #f)
|
||||
value)))))
|
||||
(cond
|
||||
(prepared
|
||||
(let* ((data (car prepared))
|
||||
(path (cdr prepared))
|
||||
(key (command-cache-key data)))
|
||||
(with-handlers
|
||||
((exn:fail?
|
||||
(λ (exception)
|
||||
(warn-player-agent "Could not start prefetched track: ~a"
|
||||
(exn-message exception))
|
||||
(set-agent-error! (exn-message exception))
|
||||
(with-agent-state
|
||||
(λ () (set! ended-counter (+ ended-counter 1)))))))
|
||||
(let ((music-id (audio-play! handle path)))
|
||||
(info-player-agent "Queued prefetched track ~a as music id ~a"
|
||||
(hash-ref data 'filename "track")
|
||||
music-id)
|
||||
(set! current-media-key key)
|
||||
(discard-unused-media! key)
|
||||
(with-agent-state
|
||||
(lambda () (set! ended-counter (+ ended-counter 1)))))))
|
||||
(define music-id (audio-play! handle path))
|
||||
(info-player-agent "Queued prefetched track ~a as music id ~a"
|
||||
(hash-ref data 'filename "track")
|
||||
music-id)
|
||||
(set! current-media-key key)
|
||||
(discard-unused-media! key)
|
||||
(λ ()
|
||||
(hash-set! music-tracks music-id data)
|
||||
(set! auto-started-key key)
|
||||
(set! pending-auto-music-id music-id)))))))
|
||||
(else
|
||||
(warn-player-agent
|
||||
"Decoder reached EOF before the next track was prefetched")
|
||||
(with-agent-state
|
||||
(lambda ()
|
||||
(hash-set! music-tracks music-id data)
|
||||
(set! auto-started-key key)
|
||||
(set! pending-auto-music-id music-id)))))
|
||||
(else
|
||||
(warn-player-agent
|
||||
"Decoder reached EOF before the next track was prefetched")
|
||||
(with-agent-state
|
||||
(lambda () (set! ended-counter (+ ended-counter 1)))))))
|
||||
(λ () (set! ended-counter (+ ended-counter 1))))))))
|
||||
|
||||
(define (execute-command! command)
|
||||
(define action (hash-ref command 'action ""))
|
||||
(define data (hash-ref command 'data (hasheq)))
|
||||
(info-player-agent "Executing command ~a" action)
|
||||
(cond
|
||||
((string=? action "play")
|
||||
(define next-key (command-cache-key data))
|
||||
(define already-started?
|
||||
(let ((action (hash-ref command 'action ""))
|
||||
(data (hash-ref command 'data (hasheq))))
|
||||
(info-player-agent "Executing command ~a" action)
|
||||
(cond
|
||||
((string=? action "play")
|
||||
(let* ((next-key (command-cache-key data))
|
||||
(already-started?
|
||||
(with-agent-state
|
||||
(λ ()
|
||||
(let ((matches?
|
||||
(and auto-started-key
|
||||
(equal? auto-started-key next-key))))
|
||||
(when matches?
|
||||
(set! auto-started-key #f))
|
||||
matches?)))))
|
||||
(with-agent-state
|
||||
(λ () (set! current-track-value data)))
|
||||
(unless already-started?
|
||||
(with-agent-state
|
||||
(λ ()
|
||||
(set! prefetched-track #f)
|
||||
(set! auto-started-key #f)
|
||||
(set! pending-auto-music-id #f)
|
||||
(set! agent-state
|
||||
(hash-set
|
||||
(hash-set agent-state 'state "starting")
|
||||
'error 'null))))
|
||||
(let* ((next-media (ensure-media-cached! data))
|
||||
;; audio-play! interrupts and closes the previous decoder.
|
||||
(music-id (audio-play! (ensure-audio!) next-media)))
|
||||
(with-agent-state
|
||||
(λ ()
|
||||
(hash-clear! music-tracks)
|
||||
(hash-set! music-tracks music-id data)))
|
||||
(set! current-media-key next-key)
|
||||
(discard-unused-media! next-key)))))
|
||||
((string=? action "prefetch")
|
||||
(let ((key (command-cache-key data))
|
||||
(path (ensure-media-cached! data)))
|
||||
(with-agent-state
|
||||
(λ () (set! prefetched-track (cons data path))))
|
||||
(info-player-agent "Prefetched ~a"
|
||||
(hash-ref data 'filename "track"))
|
||||
(for ((entry (in-list (hash->list cached-media))))
|
||||
(unless (or (equal? (car entry) current-media-key)
|
||||
(equal? (car entry) key))
|
||||
(safe-delete-file (cdr entry))
|
||||
(hash-remove! cached-media (car entry))))))
|
||||
((string=? action "pause")
|
||||
(audio-pause! (ensure-audio!) #t))
|
||||
((string=? action "resume")
|
||||
(audio-pause! (ensure-audio!) #f))
|
||||
((string=? action "stop")
|
||||
(with-agent-state
|
||||
(lambda ()
|
||||
(define matches?
|
||||
(and auto-started-key (equal? auto-started-key next-key)))
|
||||
(when matches? (set! auto-started-key #f))
|
||||
matches?)))
|
||||
(with-agent-state
|
||||
(lambda () (set! current-track-value data)))
|
||||
(unless already-started?
|
||||
(with-agent-state
|
||||
(lambda ()
|
||||
(λ ()
|
||||
(set! prefetched-track #f)
|
||||
(set! auto-started-key #f)
|
||||
(set! pending-auto-music-id #f)
|
||||
(set! agent-state
|
||||
(hash-set
|
||||
(hash-set agent-state 'state "starting")
|
||||
'error 'null))))
|
||||
(define next-media (ensure-media-cached! data))
|
||||
;; audio-play! interrupts and closes the previous decoder itself.
|
||||
(define music-id (audio-play! (ensure-audio!) next-media))
|
||||
(set! pending-auto-music-id #f)))
|
||||
(when audio
|
||||
(audio-stop! audio)))
|
||||
((string=? action "seek")
|
||||
(audio-seek! (ensure-audio!) (hash-ref data 'percentage 0)))
|
||||
((string=? action "volume")
|
||||
(set! logical-volume (min 100 (max 0 (hash-ref data 'value 50))))
|
||||
(let ((scaled (/ logical-volume 100.0)))
|
||||
(audio-volume! (ensure-audio!) (* 100.0 scaled scaled)))
|
||||
(with-agent-state
|
||||
(lambda ()
|
||||
(hash-clear! music-tracks)
|
||||
(hash-set! music-tracks music-id data)))
|
||||
(set! current-media-key next-key)
|
||||
(discard-unused-media! next-key)))
|
||||
((string=? action "prefetch")
|
||||
(define key (command-cache-key data))
|
||||
(define path (ensure-media-cached! data))
|
||||
(with-agent-state
|
||||
(lambda () (set! prefetched-track (cons data path))))
|
||||
(info-player-agent "Prefetched ~a" (hash-ref data 'filename "track"))
|
||||
(for ((entry (in-list (hash->list cached-media))))
|
||||
(unless (or (equal? (car entry) current-media-key)
|
||||
(equal? (car entry) key))
|
||||
(safe-delete-file (cdr entry))
|
||||
(hash-remove! cached-media (car entry)))))
|
||||
((string=? action "pause")
|
||||
(audio-pause! (ensure-audio!) #t))
|
||||
((string=? action "resume")
|
||||
(audio-pause! (ensure-audio!) #f))
|
||||
((string=? action "stop")
|
||||
(with-agent-state
|
||||
(lambda ()
|
||||
(set! prefetched-track #f)
|
||||
(set! auto-started-key #f)
|
||||
(set! pending-auto-music-id #f)))
|
||||
(when audio (audio-stop! audio)))
|
||||
((string=? action "seek")
|
||||
(audio-seek! (ensure-audio!) (hash-ref data 'percentage 0)))
|
||||
((string=? action "volume")
|
||||
(set! logical-volume (min 100 (max 0 (hash-ref data 'value 50))))
|
||||
(define scaled (/ logical-volume 100.0))
|
||||
(audio-volume! (ensure-audio!) (* 100.0 scaled scaled))
|
||||
(with-agent-state
|
||||
(lambda ()
|
||||
(set! agent-state
|
||||
(hash-set agent-state 'volume logical-volume)))))
|
||||
(else
|
||||
(error 'player-agent "unknown command: ~a" action))))
|
||||
(λ ()
|
||||
(set! agent-state
|
||||
(hash-set agent-state 'volume logical-volume)))))
|
||||
(else
|
||||
(error 'player-agent "unknown command: ~a" action)))))
|
||||
|
||||
(define (poll-loop)
|
||||
(with-handlers
|
||||
((exn:fail:agent-denied?
|
||||
(lambda (exception)
|
||||
(define message (format (tr 'denied-message) app-id))
|
||||
(warn-player-agent "Agent authorization refused: ~a"
|
||||
(exn-message exception))
|
||||
(set-agent-error! message)
|
||||
(status-callback
|
||||
(tr 'unauthorized-status))
|
||||
(unless authorization-notified?
|
||||
(set! authorization-notified? #t)
|
||||
(denied-callback message))
|
||||
(when running
|
||||
(sleep 3)
|
||||
(poll-loop))))
|
||||
(λ (exception)
|
||||
(let ((message (format (tr 'denied-message) app-id)))
|
||||
(warn-player-agent "Agent authorization refused: ~a"
|
||||
(exn-message exception))
|
||||
(set-agent-error! message)
|
||||
(status-callback
|
||||
(tr 'unauthorized-status))
|
||||
(unless authorization-notified?
|
||||
(set! authorization-notified? #t)
|
||||
(denied-callback message))
|
||||
(when running
|
||||
(sleep 3)
|
||||
(poll-loop)))))
|
||||
(exn:fail?
|
||||
(lambda (exception)
|
||||
(λ (exception)
|
||||
(warn-player-agent "Connection cycle failed: ~a"
|
||||
(exn-message exception))
|
||||
(set-agent-error! (exn-message exception))
|
||||
@@ -352,34 +387,35 @@
|
||||
(info-player-agent "Registered at ~a as ~a" server-url assigned-name)
|
||||
(let loop ()
|
||||
(when running
|
||||
(define response
|
||||
(post-json
|
||||
server-url
|
||||
"/api/agent/poll"
|
||||
(hasheq 'appId app-id
|
||||
'name assigned-name
|
||||
'ack acknowledged-command
|
||||
'endedCounter ended-counter
|
||||
'state (snapshot))))
|
||||
(define command (hash-ref response 'command 'null))
|
||||
(when (and (hash? command)
|
||||
(> (hash-ref command 'id 0) acknowledged-command)
|
||||
(not (= (hash-ref command 'id 0) executing-command-id)))
|
||||
(set! executing-command-id (hash-ref command 'id))
|
||||
(set! command-worker
|
||||
(thread
|
||||
(lambda ()
|
||||
(with-handlers
|
||||
((exn:fail?
|
||||
(lambda (exception)
|
||||
(warn-player-agent "Command failed: ~a"
|
||||
(exn-message exception))
|
||||
(set-agent-error! (exn-message exception)))))
|
||||
(clear-agent-error!)
|
||||
(execute-command! command))
|
||||
(set! acknowledged-command (hash-ref command 'id))
|
||||
(set! executing-command-id 0)
|
||||
(set! command-worker #f)))))
|
||||
(let* ((response
|
||||
(post-json
|
||||
server-url
|
||||
"/api/agent/poll"
|
||||
(hasheq 'appId app-id
|
||||
'name assigned-name
|
||||
'ack acknowledged-command
|
||||
'endedCounter ended-counter
|
||||
'state (snapshot))))
|
||||
(command (hash-ref response 'command 'null)))
|
||||
(when (and (hash? command)
|
||||
(> (hash-ref command 'id 0) acknowledged-command)
|
||||
(not (= (hash-ref command 'id 0)
|
||||
executing-command-id)))
|
||||
(set! executing-command-id (hash-ref command 'id))
|
||||
(set! command-worker
|
||||
(thread
|
||||
(λ ()
|
||||
(with-handlers
|
||||
((exn:fail?
|
||||
(λ (exception)
|
||||
(warn-player-agent "Command failed: ~a"
|
||||
(exn-message exception))
|
||||
(set-agent-error! (exn-message exception)))))
|
||||
(clear-agent-error!)
|
||||
(execute-command! command))
|
||||
(set! acknowledged-command (hash-ref command 'id))
|
||||
(set! executing-command-id 0)
|
||||
(set! command-worker #f))))))
|
||||
(sleep 1)
|
||||
(loop)))))
|
||||
|
||||
@@ -421,5 +457,5 @@
|
||||
shutdown!
|
||||
snapshot
|
||||
current-track
|
||||
(lambda () running)
|
||||
app-id))
|
||||
(λ () running)
|
||||
app-id)))
|
||||
|
||||
Reference in New Issue
Block a user