diff options
| -rw-r--r-- | authentication.rkt | 33 | ||||
| -rw-r--r-- | handlers.rkt | 35 | ||||
| -rw-r--r-- | main.rkt | 2 |
3 files changed, 38 insertions, 32 deletions
diff --git a/authentication.rkt b/authentication.rkt new file mode 100644 index 0000000..9e9400b --- /dev/null +++ b/authentication.rkt @@ -0,0 +1,33 @@ +#lang racket + +(provide make-auth-dispatch) + +(require web-server/http + web-server/http/basic-auth) + +(define ferti-user + (or (getenv "FERTI_USER") (error 'authentication "FERTI_USER environment variable is not set"))) +(define ferti-pass + (or (getenv "FERTI_PASS") (error 'authentication "FERTI_PASS environment variable is not set"))) + +(define (make-auth-dispatch handler) + (lambda (req) + (if (authorized? req) + (handler req) + (unauthorized-response)))) + +(define (authorized? req) + (match (request->basic-credentials req) + [(cons user-b pass-b) + (define user (bytes->string/utf-8 user-b)) + (define pass (bytes->string/utf-8 pass-b)) + (and (string=? user ferti-user) (string=? pass ferti-pass))] + [_ #f])) + +(define (unauthorized-response) + (response 401 + #"Unauthorized" + (current-seconds) + TEXT/HTML-MIME-TYPE + (list (make-basic-auth-header (format "Basic Auth Test: ~a" (gensym)))) + void)) diff --git a/handlers.rkt b/handlers.rkt index 6141426..001d5a1 100644 --- a/handlers.rkt +++ b/handlers.rkt @@ -1,12 +1,12 @@ #lang racket -(provide secured-dispatch +(provide production-dispatch fapg-url) (require web-server/dispatch web-server/http web-server/formlets - web-server/http/basic-auth + "authentication.rkt" "views.rkt" "formlets.rkt" "models/user.rkt" @@ -17,35 +17,8 @@ "models/fertilizer-product.rkt" "services/nnls.rkt") -(define ferti-user - (or (getenv "FERTI_USER") (error 'ferti "FERTI_USER environment variable is not set"))) -(define ferti-pass - (or (getenv "FERTI_PASS") (error 'ferti "FERTI_PASS environment variable is not set"))) - -(define (secured-dispatch) - (wrap-basic-auth fapg-dispatch)) - -(define (wrap-basic-auth handler) - (lambda (req) - (if (authorized? req) - (handler req) - (unauthorized-response)))) - -(define (authorized? req) - (match (request->basic-credentials req) - [(cons user-b pass-b) - (define user (bytes->string/utf-8 user-b)) - (define pass (bytes->string/utf-8 pass-b)) - (and (string=? user ferti-user) (string=? pass ferti-pass))] - [_ #f])) - -(define (unauthorized-response) - (response 401 - #"Unauthorized" - (current-seconds) - TEXT/HTML-MIME-TYPE - (list (make-basic-auth-header (format "Basic Auth Test: ~a" (gensym)))) - void)) +(define (production-dispatch) + (make-auth-dispatch fapg-dispatch)) (define-values (fapg-dispatch fapg-url) (dispatch-rules @@ -15,4 +15,4 @@ (connect! #:path development-db-path) (migrate-all!) (seed-database!) - (serve/dispatch (secured-dispatch)))) + (serve/dispatch (production-dispatch)))) |