blob: 6458e9a952f0b70914f16f9e1fc7613adb5eddf3 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
|
#lang racket
(provide secured-dispatch)
(require web-server/dispatch
web-server/http
web-server/formlets
web-server/http/basic-auth
"views.rkt"
"formlets.rkt"
"models/user.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 app-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 (app-dispatch _)
(dispatch-rules [("ferti") #:method "get" ferti]
[("measurement" "new") #:method "get" new-measurement]
[("measurement" "create") #:method "post" create-measurement]
[("measurement" "destroy") #:method "post" destroy-measurement]
[("target" "new") #:method "get" new-target]
[("target" "create") #:method "post" create-target]
[("fertilizer" "new") #:method "get" new-fertilizer]
[("fertilizer" "create") #:method "post" create-fertilizer]
[("") #:method "get" index]
[else fallback]))
(define (render-page xexpr)
(response/xexpr #:preamble #"<!DOCTYPE html>" xexpr))
(define (ferti _)
(define ferti-recipe (find-ferti-recipe))
(define latest-measurement-hash (get-latest-nutrient-measurement-hash))
(define latest-target-hash (get-latest-nutrient-target-hash))
(define latest-measurements (take (get-nutrient-measurements) 10))
(render-page
(ferti-page ferti-recipe latest-measurement-hash latest-target-hash latest-measurements)))
(define (index _)
(define user (get-current-user))
(render-page (index-page user)))
;; Nutrient measurements
(define (new-measurement _)
(render-page (new-measurement-page)))
(define (create-measurement req)
(define-values (measured-on nutrient-values) (formlet-process (measurements-formlet) req))
(create-nutrient-measurement! measured-on nutrient-values)
(redirect-to "/ferti"))
(define (destroy-measurement req)
(delete-nutrient-measurement! req)
(redirect-to "/"))
;; 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"))
;; 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"))
;; Fallback
(define (fallback _)
(render-page (fallback-page 404)))
|
