256 lines
8.3 KiB
Racket
256 lines
8.3 KiB
Racket
#lang racket/base
|
|
|
|
(require json
|
|
racket/contract
|
|
racket/file
|
|
racket/port
|
|
racket/runtime-path
|
|
racket-mimetypes
|
|
racket/string
|
|
net/url
|
|
web-server/dispatch
|
|
web-server/http
|
|
web-server/http/json
|
|
web-server/servlet-env
|
|
"library.rkt"
|
|
"player.rkt"
|
|
"users.rkt")
|
|
|
|
(provide serve-player)
|
|
|
|
(define-runtime-path public-directory "../public")
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; HTTP handlers
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define current-player #f)
|
|
(define current-auth #f)
|
|
|
|
(define (json-response value #:code [code 200] #:headers [headers '()])
|
|
(response/jsexpr
|
|
value
|
|
#:code code
|
|
#:headers (cons (header #"Cache-Control" #"no-store") headers)))
|
|
|
|
(define (error-response exception)
|
|
(json-response
|
|
(hasheq 'error (exn-message exception))
|
|
#:code 400))
|
|
|
|
(define (agent-error-response exception)
|
|
(json-response
|
|
(hasheq 'error (exn-message exception)
|
|
'code "agent-not-authorized")
|
|
#:code 403))
|
|
|
|
(define (request-jsexpr request)
|
|
(let ((body (request-post-data/raw request)))
|
|
(if (and body (positive? (bytes-length body)))
|
|
(bytes->jsexpr body)
|
|
(hasheq))))
|
|
|
|
(define (auth-status-handler request)
|
|
(let ((user (auth-request-user current-auth request)))
|
|
(json-response
|
|
(hasheq 'enabled (auth-enabled? current-auth)
|
|
'local (auth-request-local? current-auth request)
|
|
'authenticated (and user #t)
|
|
'username (or user 'null)))))
|
|
|
|
(define (auth-login-handler request)
|
|
(with-handlers ((exn:fail? error-response))
|
|
(let* ((data (request-jsexpr request))
|
|
(username (hash-ref data 'username #f))
|
|
(password (hash-ref data 'password #f)))
|
|
(unless (and (string? username) (string? password))
|
|
(raise-arguments-error
|
|
'login
|
|
"username and password must be strings"))
|
|
(let ((result (auth-login! current-auth request username password)))
|
|
(cond
|
|
((eq? result 'rate-limited)
|
|
(json-response
|
|
(hasheq 'error "Te veel mislukte aanmeldpogingen; probeer het over enkele minuten opnieuw"
|
|
'code "login-rate-limited")
|
|
#:code 429))
|
|
((not result)
|
|
(json-response
|
|
(hasheq 'error "Ongeldige gebruikersnaam of wachtwoord"
|
|
'code "invalid-credentials")
|
|
#:code 401))
|
|
(else
|
|
(json-response
|
|
(hasheq 'authenticated #t
|
|
'username (string-downcase (string-trim username)))
|
|
#:headers
|
|
(list (header #"Set-Cookie"
|
|
(auth-session-cookie current-auth result))))))))))
|
|
|
|
(define (auth-logout-handler request)
|
|
(auth-logout! current-auth request)
|
|
(json-response
|
|
(hasheq 'authenticated #f)
|
|
#:headers
|
|
(list (header #"Set-Cookie" (auth-expired-cookie)))))
|
|
|
|
(define (state-handler _request)
|
|
(json-response (player-state->jsexpr current-player)))
|
|
|
|
(define (discover-handler _request)
|
|
(player-discover! current-player)
|
|
(json-response (player-state->jsexpr current-player)))
|
|
|
|
(define (command-handler request command)
|
|
(with-handlers
|
|
((exn:fail? error-response))
|
|
(json-response
|
|
(player-command!
|
|
current-player
|
|
command
|
|
(request-jsexpr request)))))
|
|
|
|
(define (agent-register-handler request)
|
|
(with-handlers
|
|
((exn:fail:agent-denied? agent-error-response)
|
|
(exn:fail? error-response))
|
|
(json-response
|
|
(player-agent-register!
|
|
current-player
|
|
(request-jsexpr request)))))
|
|
|
|
(define (agent-poll-handler request)
|
|
(with-handlers
|
|
((exn:fail:agent-denied? agent-error-response)
|
|
(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 (artwork-handler _request artwork-id)
|
|
(let ((value (player-track-artwork current-player artwork-id)))
|
|
(if value
|
|
(response/output
|
|
(λ (output)
|
|
(write-bytes (artwork-data value) output))
|
|
#:mime-type
|
|
(string->bytes/utf-8 (artwork-mime-type value))
|
|
#:headers
|
|
(list
|
|
(header #"Content-Length"
|
|
(string->bytes/utf-8
|
|
(number->string
|
|
(bytes-length (artwork-data value)))))
|
|
(header #"Cache-Control" #"private, max-age=3600")))
|
|
(json-response
|
|
(hasheq 'error "track artwork is unavailable")
|
|
#:code 404))))
|
|
|
|
(define-values (api-dispatch _url)
|
|
(dispatch-rules
|
|
[("api" "auth" "status") #:method "get" auth-status-handler]
|
|
[("api" "auth" "login") #:method "post" auth-login-handler]
|
|
[("api" "auth" "logout") #:method "post" auth-logout-handler]
|
|
[("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" "artwork" (string-arg)) #:method "get" artwork-handler]
|
|
[("api" "command" (string-arg))
|
|
#:method "post"
|
|
command-handler]))
|
|
|
|
(define (request-path request)
|
|
(url->string (request-uri request)))
|
|
|
|
(define (json-request? request)
|
|
(let ((content-type
|
|
(headers-assq* #"Content-Type" (request-headers/raw request))))
|
|
(and content-type
|
|
(regexp-match? #px#"(?i:^application/json(?:;|$))"
|
|
(header-value content-type)))))
|
|
|
|
(define (public-api-request? request)
|
|
(regexp-match? #px"^/api/(?:auth|agent)(?:/|$)"
|
|
(request-path request)))
|
|
|
|
(define (dispatch request)
|
|
(cond
|
|
((and (bytes=? (request-method request) #"POST")
|
|
(not (json-request? request)))
|
|
(json-response
|
|
(hasheq 'error "Content-Type application/json is vereist"
|
|
'code "json-required")
|
|
#:code 415))
|
|
((or (public-api-request? request)
|
|
(auth-request-user current-auth request))
|
|
(api-dispatch request))
|
|
(else
|
|
(json-response
|
|
(hasheq 'error "Aanmelden is vereist"
|
|
'code "authentication-required")
|
|
#:code 401))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Provided functions
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Serve the web interface and JSON player API.
|
|
; pre : Value is a player, listen-ip is a string, and port is valid.
|
|
; post : Static files and API routes are served until the server stops.
|
|
; result : The result returned by serve/servlet.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(define/contract (serve-player value
|
|
#:auth-manager
|
|
[auth-manager (make-auth-manager '())]
|
|
#:listen-ip [listen-ip "127.0.0.1"]
|
|
#:port [port 8080]
|
|
#:launch-browser? [launch-browser? #t])
|
|
(->* (any/c)
|
|
(#:auth-manager auth-manager?
|
|
#:listen-ip string?
|
|
#:port exact-positive-integer?
|
|
#:launch-browser? boolean?)
|
|
any)
|
|
(set! current-player value)
|
|
(set! current-auth auth-manager)
|
|
(serve/servlet
|
|
dispatch
|
|
#:listen-ip listen-ip
|
|
#:port port
|
|
#:connection-close? #t
|
|
#:launch-browser? launch-browser?
|
|
#:quit? #f
|
|
#:banner? #t
|
|
#:servlet-regexp #rx"^/api(?:/|$)"
|
|
#:extra-files-paths (list public-directory)))
|