laten zien hoe downloads en zo gaan
This commit is contained in:
@@ -9,7 +9,8 @@
|
||||
racket/port
|
||||
racket/string
|
||||
simple-log
|
||||
"player-agent-translate.rkt")
|
||||
"player-agent-translate.rkt"
|
||||
"http-transfer.rkt")
|
||||
|
||||
(provide (struct-out player-agent-runtime)
|
||||
make-player-agent-runtime)
|
||||
@@ -44,27 +45,30 @@
|
||||
;;; Posts JSON to an agent API endpoint and reads its JSON response.
|
||||
;;; Authorization failures receive a distinct exception for poll-loop.
|
||||
(define (post-json base path data)
|
||||
(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)))))
|
||||
(call-with-http-timeout
|
||||
30
|
||||
(λ (_progress!)
|
||||
(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)))))))
|
||||
|
||||
;;; Converts racket-audio states to the state names sent to the web player.
|
||||
(define (normal-state state)
|
||||
@@ -267,7 +271,7 @@
|
||||
(bytes->string/utf-8 extension))))
|
||||
(path (format "/api/agent/media/~a/~a" app-id token))
|
||||
(input #f))
|
||||
(with-handlers ((exn:fail?
|
||||
(with-handlers ((exn?
|
||||
(λ (exception)
|
||||
(when input (close-input-port input))
|
||||
(safe-delete-file target)
|
||||
@@ -281,19 +285,23 @@
|
||||
(hasheq 'filename filename 'received 0
|
||||
'total (if (exact-nonnegative-integer? size)
|
||||
size 'null)))))
|
||||
(set! input (get-pure-port (endpoint-url server-url path)))
|
||||
(call-with-output-file
|
||||
target
|
||||
(λ (output)
|
||||
(copy-media-port
|
||||
input output
|
||||
(λ (received)
|
||||
(with-agent-state
|
||||
(λ ()
|
||||
(set! download-progress
|
||||
(hash-set download-progress 'received received)))))))
|
||||
#:exists 'truncate/replace)
|
||||
(close-input-port input)
|
||||
(call-with-http-timeout
|
||||
30
|
||||
(λ (progress!)
|
||||
(set! input (get-pure-port (endpoint-url server-url path)))
|
||||
(call-with-output-file
|
||||
target
|
||||
(λ (output)
|
||||
(copy-media-port
|
||||
input output
|
||||
(λ (received)
|
||||
(progress!)
|
||||
(with-agent-state
|
||||
(λ ()
|
||||
(set! download-progress
|
||||
(hash-set download-progress 'received received)))))))
|
||||
#:exists 'truncate/replace)
|
||||
(close-input-port input)))
|
||||
(when (and (exact-nonnegative-integer? size)
|
||||
(not (= (file-size target) size)))
|
||||
(error 'player-agent
|
||||
@@ -538,21 +546,23 @@
|
||||
(set! command-worker
|
||||
(thread
|
||||
(λ ()
|
||||
(with-handlers
|
||||
((exn:fail?
|
||||
(λ (exception)
|
||||
(warn-player-agent "Command failed: ~a"
|
||||
(exn-message exception))
|
||||
(with-agent-state
|
||||
(λ ()
|
||||
(set! loading-media-key #f)
|
||||
(trim-cache!)))
|
||||
(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))))))
|
||||
(with-handlers ((exn:break? void))
|
||||
(parameterize-break #t
|
||||
(with-handlers
|
||||
((exn:fail?
|
||||
(λ (exception)
|
||||
(warn-player-agent "Command failed: ~a"
|
||||
(exn-message exception))
|
||||
(with-agent-state
|
||||
(λ ()
|
||||
(set! loading-media-key #f)
|
||||
(trim-cache!)))
|
||||
(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)))))
|
||||
|
||||
@@ -561,15 +571,23 @@
|
||||
(unless running
|
||||
(set! running #t)
|
||||
(status-callback (tr 'connecting))
|
||||
(set! worker (thread poll-loop))))
|
||||
(set! worker
|
||||
(thread
|
||||
(λ ()
|
||||
(with-handlers ((exn:break? void))
|
||||
(parameterize-break #t (poll-loop))))))))
|
||||
|
||||
;;; Stops polling and command workers and clears their lifecycle state.
|
||||
(define (stop!)
|
||||
(set! running #f)
|
||||
(when (and worker (not (thread-dead? worker)))
|
||||
(kill-thread worker))
|
||||
(when (and command-worker (not (thread-dead? command-worker)))
|
||||
(kill-thread command-worker))
|
||||
(let ((poll-worker worker)
|
||||
(active-command command-worker))
|
||||
(when (and poll-worker (not (thread-dead? poll-worker)))
|
||||
(break-thread poll-worker)
|
||||
(thread-wait poll-worker))
|
||||
(when (and active-command (not (thread-dead? active-command)))
|
||||
(break-thread active-command)
|
||||
(thread-wait active-command)))
|
||||
(set! worker #f)
|
||||
(set! command-worker #f)
|
||||
(with-agent-state (λ () (set! download-progress 'null)))
|
||||
|
||||
Reference in New Issue
Block a user