From 60ccbcc94bf66692bcc1c2db21d5244cc40146ee Mon Sep 17 00:00:00 2001 From: Marius Peter Date: Sun, 30 Nov 2025 18:39:57 +0100 Subject: Factor out authentication logic from handlers. --- authentication.rkt | 33 +++++++++++++++++++++++++++++++++ 1 file changed, 33 insertions(+) create mode 100644 authentication.rkt (limited to 'authentication.rkt') 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)) -- cgit v1.2.3