#lang racket/base
(require racket/class
racket/string
net/url
web-server/http
web-server/http/bindings
web-server/templates
"net.rkt"
"oauth2.rkt"
web-server/servlet-env)
(provide oauth2/request-auth-code/browser)
(define (oauth2/request-auth-code/browser auth-server client scopes)
(let ([oauth2 (new oauth2%
(auth-server auth-server)
(client client))])
(let ([auth-code (request-auth-code/web oauth2 scopes)])
(send oauth2 acquire-token/auth-code!
auth-code
#:redirect-uri "http://localhost:8000/oauth2/response"
#:who 'oauth2/request-access/web)
oauth2)))
(define (request-auth-code/web oauth2 scopes
#:who [who 'request-access/web])
(let ([chan (make-channel)]
[server-cust (make-custodian)])
(parameterize ((current-custodian server-cust))
(thread
(lambda ()
(serve/servlet (make-servlet oauth2 scopes chan)
#:launch-browser? #t
#:quit? #t
#:banner? #f
#:port 8000
#:servlet-path "/oauth2/init"
#:servlet-regexp #rx"^/oauth2/"
#:extra-files-paths null))))
(begin0 (channel-get chan)
(custodian-shutdown-all server-cust))))
(define (make-servlet oauth2 scopes chan)
(lambda (req)
(let ([path (string-join (map path/param-path (url-path (request-uri req))) "/")])
(cond [(equal? path "oauth2/init")
(redirect-to
(let ([auth-server (send oauth2 get-auth-server)]
[client (send oauth2 get-client)])
(send auth-server get-auth-request-url
#:client client
#:scopes scopes
#:redirect-uri "http://localhost:8000/oauth2/response")))]
[(equal? path "oauth2/response")
(let ([bindings (request-bindings/raw req)])
(cond [(bindings-assq #"code" bindings)
=> (lambda (code-b)
(channel-put chan
(bytes->string/utf-8
(binding:form-value code-b)))
(response/full
200 #"Okay"
(current-seconds) TEXT/HTML-MIME-TYPE
null
(list (string->bytes/utf-8
(include-template "static-got-auth-code.html")))))]
[(bindings-assq #"error" bindings)
=> (lambda (err-b)
(error "Failed: ~s" (binding:form-value err-b)))]
[else (error "Bad response!")]))]
[else (error "Invalid URL: ~s" path)]))))