#lang racket (provide secured-dispatch fapg-url) (require web-server/dispatch web-server/http web-server/formlets web-server/http/basic-auth "views.rkt" "formlets.rkt" "models/user.rkt" "models/nutrient.rkt" "models/nutrient-measurement.rkt" "models/nutrient-target.rkt" "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-values (fapg-dispatch fapg-url) (dispatch-rules [("index") #:method "get" index] ;; Ferti [("ferti" "index") #:method "get" ferti-index] [("ferti" "measurements") #:method "get" ferti-measurements] [("ferti" "targets") #:method "get" ferti-targets] [("ferti" "recipe") #:method "get" ferti-recipe] [("ferti" "fertilizers") #:method "get" ferti-fertilizers] ;; Nutrient measurements [("ferti" "measurement" "new") #:method "get" new-measurement] [("ferti" "measurement" "create") #:method "post" create-measurement] [("ferti" "measurement" (integer-arg)) #:method "get" show-measurement] [("ferti" "measurement" (integer-arg)) #:method "delete" destroy-measurement] ;; Nutrient targets [("ferti" "target" "new") #:method "get" new-target] [("ferti" "target" "create") #:method "post" create-target] [("ferti" "target" (integer-arg)) #:method "get" show-target] [("ferti" "target" (integer-arg)) #:method "delete" destroy-target] ;; Fertilizer products [("ferti" "fertilizer" "new") #:method "get" new-fertilizer] [("ferti" "fertilizer" "create") #:method "post" create-fertilizer] [("ferti" "fertilizer" (integer-arg)) #:method "get" show-fertilizer] [("ferti" "fertilizer" "destroy" (integer-arg)) #:method "get" destroy-fertilizer] ;; Default [("") #:method "get" index] [else fallback])) (define (render-page xexpr) (response/xexpr #:preamble #"" xexpr)) ;; Index (define (index _) (define user (get-current-user)) (render-page (index-page user))) ;; Ferti (define (ferti-index _) (render-page (ferti-index-page))) (define (ferti-measurements _) (define nutrients (get-nutrients)) (define measurements (get-nutrient-measurements)) (render-page (ferti-measurements-page nutrients measurements))) (define (ferti-targets _) (define latest-measurement-hash (get-latest-nutrient-measurement-hash)) (define latest-target-hash (get-latest-nutrient-target-hash)) (render-page (ferti-targets-page latest-measurement-hash latest-target-hash))) (define (ferti-recipe _) (define ferti-recipe (find-ferti-recipe)) (render-page (ferti-recipe-page ferti-recipe))) (define (ferti-fertilizers _) (define fertilizers (get-fertilizer-products)) (render-page (ferti-fertilizers-page fertilizers))) ;; Nutrient measurements (define (new-measurement _) (render-page (new-measurement-page))) (define (create-measurement req) (define-values (measurement-date nutrient-values) (formlet-process (measurements-formlet) req)) (create-nutrient-measurement! measurement-date nutrient-values) (redirect-to "/ferti/measurements")) (define (show-measurement _ id) (define nm (get-nutrient-measurement #:id id)) (render-page (show-measurement-page nm))) (define (destroy-measurement _ id) (delete-nutrient-measurement! id) (redirect-to "/ferti/index")) ;; Nutrient targets (define (new-target _) (render-page (new-target-page))) (define (create-target req) (define-values (effective-on nutrient-values) (formlet-process (targets-formlet) req)) (create-nutrient-target! effective-on nutrient-values) (redirect-to "/ferti/targets")) (define (show-target _ id) (define nt (get-nutrient-target #:id id)) (render-page (show-target-page nt))) (define (destroy-target _ id) (delete-nutrient-target! id) (redirect-to "/ferti/targets")) ;; Fertilizer products (define (new-fertilizer _) (render-page (new-fertilizer-page))) (define (create-fertilizer req) (define-values (canonical-name brand-name nutrient-values) (formlet-process (fertilizer-formlet) req)) (create-fertilizer-product! canonical-name brand-name nutrient-values) (redirect-to "/ferti/fertilizers")) (define (show-fertilizer _ id) (define fp (get-fertilizer-product #:id id)) (render-page (show-fertilizer-page fp))) (define (destroy-fertilizer _ id) (delete-fertilizer-product! id) (redirect-to "/ferti/fertilizers")) ;; Fallback (define (fallback _) (render-page (fallback-page 404)))