diff options
| -rw-r--r-- | db/migrations.rkt | 30 | ||||
| -rw-r--r-- | handlers.rkt | 4 | ||||
| -rw-r--r-- | models/user.rkt | 33 | ||||
| -rw-r--r-- | views.rkt | 15 |
4 files changed, 77 insertions, 5 deletions
diff --git a/db/migrations.rkt b/db/migrations.rkt index e0a1ef2..d639116 100644 --- a/db/migrations.rkt +++ b/db/migrations.rkt @@ -27,6 +27,36 @@ (set-box! migrations-box (append migrations (list (cons name-symbol sql))))))) +;;;;;;;; +;; USERS +;;;;;;;; + +(define-migration "create table users" + (list + (create-table #:if-not-exists + users + #:columns + [id integer #:not-null] + [name text #:not-null] + [role_id integer] + #:constraints + (primary-key id) + (unique name) + (foreign-key role_id + #:references (user_roles id))))) + +(define-migration "create table user_roles" + (list + (create-table #:if-not-exists + user_roles + #:columns + [id integer #:not-null] + [name text #:not-null] + #:constraints + (primary-key id) + (unique name)))) + + ;;;;;;;;;;;; ;; NUTRIENTS ;;;;;;;;;;;; diff --git a/handlers.rkt b/handlers.rkt index 924b2f3..2df82ea 100644 --- a/handlers.rkt +++ b/handlers.rkt @@ -7,6 +7,7 @@ web-server/formlets "views.rkt" "formlets.rkt" + "models/users.rkt" "models/nutrient-measurement.rkt" "models/nutrient-target.rkt" "models/crop-requirement.rkt" @@ -35,9 +36,10 @@ (ferti-page measurements ferti-recipe))) (define (index _) + (define user (get-current-user)) (response/xexpr #:preamble #"<!DOCTYPE html>" - (index-page))) + (index-page user))) ;; Nutrient measurements diff --git a/models/user.rkt b/models/user.rkt new file mode 100644 index 0000000..2cbf4fe --- /dev/null +++ b/models/user.rkt @@ -0,0 +1,33 @@ +#lang racket + +(provide + ;; Struct definitions + user + user? + user-id + user-name + user-role + ;; SQL CRUD + (contract-out + [get-current-user (-> (or/c user? #f))] + #; [delete-user! (-> user? void?)])) + +(require racket/contract + db + sql + "../db/conn.rkt") + +(struct user (id name role) #:transparent) + +(define (get-current-user) + (define current-user-id "foobar") + (define query (select id name role_id + #:from users + #:where (= id ,current-user-id) + #:limit 1)) + (define row (query-maybe-row (current-conn) query)) + (cond + [(false? row) #f] + [else + (match-define (vector id name role_id) row) + (user id name role_id)])) @@ -6,8 +6,10 @@ new-target-page fallback-page) -(require web-server/formlets +(require gregor + web-server/formlets "formlets.rkt" + "models/users.rkt" "models/nutrient.rkt" "models/nutrient-measurement.rkt" "models/nutrient-target.rkt" @@ -202,11 +204,16 @@ [method "POST"]) ,@(formlet-display (targets-formlet))))))) -(define (index-page) +(define (index-page user) (page-template "Bienvenue à la FAPG" - `((a ([class "btn btn-primary mb-3"] [href "/ferti"]) "Accéder à Ferti")))) - + `((h1 ([class "display-1 mb-3"]) + ,(format "~a, ~a." + (if (<= (->hours (current-time #:tz "Europe/Paris")) 17) + "Bonjour" + "Bonsoir") + (if user (user-name user) "et bienvenue"))) + (a ([class "btn btn-primary mb-3"] [href "/ferti"]) "Accéder à Ferti")))) (define (fallback-page request-code) (page-template |