Adding a local player agent

private/server.rkt

@@ -2,7 +2,10 @@
 
 (require json
          racket/contract
+         racket/file
+         racket/port
          racket/runtime-path
+         racket-mimetypes
          web-server/dispatch
          web-server/http
          web-server/http/json
@@ -52,10 +55,55 @@
       command
       (request-jsexpr request)))))
 
+(define (agent-register-handler request)
+  (with-handlers
+      ((exn:fail? error-response))
+    (json-response
+     (player-agent-register!
+      current-player
+      (request-jsexpr request)))))
+
+(define (agent-poll-handler request)
+  (with-handlers
+      ((exn:fail? error-response))
+    (json-response
+     (player-agent-poll!
+      current-player
+      (request-jsexpr request)))))
+
+(define (agent-media-handler _request app-id token)
+  (let ((file (player-agent-media current-player app-id token)))
+    (if (and file (file-exists? file))
+        (response/output
+         (λ (output)
+           (call-with-input-file
+            file
+            (λ (input)
+              (copy-port input output))))
+         #:mime-type
+         (let ((mime (mimetype-for-ext file)))
+           (if (string? mime)
+               (string->bytes/utf-8 mime)
+               #"application/octet-stream"))
+         #:headers
+         (list
+          (header #"Content-Length"
+                  (string->bytes/utf-8
+                   (number->string (file-size file))))
+          (header #"Cache-Control" #"no-store")))
+        (json-response
+         (hasheq 'error "media token is invalid or expired")
+         #:code 404))))
+
 (define-values (dispatch _url)
   (dispatch-rules
    [("api" "state") #:method "get" state-handler]
    [("api" "discover") #:method "post" discover-handler]
+   [("api" "agent" "register") #:method "post" agent-register-handler]
+   [("api" "agent" "poll") #:method "post" agent-poll-handler]
+   [("api" "agent" "media" (string-arg) (string-arg))
+    #:method "get"
+    agent-media-handler]
    [("api" "command" (string-arg))
     #:method "post"
     command-handler]))