Feufochmar
/
feuforeve.v4
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Add users for the notepad (stored in a database), and add pages to list and display users.

This commit is contained in:
Feufochmar 2021-05-04 18:18:42 +02:00
parent 0c2028a0ee
commit a4ba3b5de3
2 changed files with 236 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

179
src/notepad/user.rkt Normal file
View File

@ -0,0 +1,179 @@
#lang racket/base
; User abstraction
; A user is stored in a database, so it uses the stored-class definitions.
(require
"stored-objects.rkt"
file/sha1
net/base64
net/cookies/server
racket/random
)
(provide
user-init-repository
hash-password
new-user get-user-by-name update-user-info remove-user get-all-users
user-name user-pseudo user-about user-icon
new-cookie update-cookie remove-cookie get-user-by-cookie remove-expired-cookies
)
; User definition
(stored-class user
(name : string?) ; User name
(hashpw : string?) ; hashed password
(pseudo : string?) ; Display name
(about : string?) ; About page of the user
(icon : string?) ; Icon/Avatar of the user
)
; User cookies
(stored-class usercookie
(value : bytes?)
(expires : integer?) ; Date of expiration
(user : integer?) ; (user?) Identifier of user
)
; Add the definitions to a repository
(define (user-init-repository repo)
(init-repository repo
user usercookie))
; Compute the password hash of a user
(define (hash-password username password)
(bytes->hex-string
(sha256-bytes
(string->bytes/utf-8
(string-append username password))))) ; TODO: add a salt
; Create a new user, and return it
(define (new-user name password)
(within-transaction (class-repository user)
(define usr (instanciate user))
(set-user-name! usr name)
(set-user-hashpw! usr (hash-password name password))
(set-user-pseudo! usr name)
(set-user-about! usr "")
(set-user-icon! usr "")
(save-instance usr)
usr))
; Get user by id
(define (get-user-by-id id)
(find-instance-by-id user id))
; Get user by name
(define (get-user-by-name name)
(define usrs (find-instances user `((name . ,name))))
(and (not (null? usrs))
(car usrs)))
; Update user information
(define (update-user-info usr
#:pseudo [pseudo #f]
#:about [about #f]
#:icon [icon #f])
(within-transaction (class-repository user)
(and pseudo (set-user-pseudo! usr pseudo))
(and about (set-user-about! usr pseudo))
(and icon (set-user-icon! usr icon))
(save-instance usr)
usr))
; Remove user
(define (remove-user usr)
(define usr-id (instance-identifier usr))
(within-transaction (class-repository user)
; Remove all cookies of user
(delete-instances usercookie `((user . ,usr-id)))
; Remove user
(delete-instance usr)))
; Expiration date in seconds, absolute
(define (new-cookie-expiration-date)
(+ (current-seconds) (* 10 24 60 60))) ; Cookie are valid for 10 days
; Get all users
(define (get-all-users)
(list-instances user))
; Create a cookie for a user
(define (new-cookie usr domain [dev? #f])
(define value (base64-encode (crypto-random-bytes 128) #""))
; TODO: race condition ?
(cond
((get-cookie-by-value value)
; A cookie with the same value already exist: try again
(new-cookie usr domain dev?))
(#t
; Create the cookie
(define expires (new-cookie-expiration-date))
(within-transaction (class-repository usercookie)
(define instance (instanciate usercookie))
(set-usercookie-value! instance value)
(set-usercookie-expires! instance expires)
(save-instance instance)
(make-cookie
"notepad"
value
#:expires (seconds->date expires)
#:domain domain
#:secure? (not dev?)
#:http-only? #t)))))
; Get cookie by value
(define (get-cookie-by-value value)
(define instances (find-instances usercookie `((value . ,value))))
(and (not (null? instances)) (car instances)))
; Update the expiration date of a cookie and return the cookie
(define (update-cookie value domain [dev? #f])
(within-transaction (class-repository usercookie)
(define cookie (get-cookie-by-value value))
(cond
(cookie
(define expires (new-cookie-expiration-date))
(set-usercookie-expires! cookie expires)
(save-instance cookie)
(make-cookie
"notepad"
value
#:expires (seconds->date expires)
#:domain domain
#:secure? (not dev?)
#:http-only? #t))
(#t
#f))))
; Remove a cookie from its value
(define (remove-cookie value)
(within-transaction (class-repository usercookie)
(define cookie (get-cookie-by-value value))
(when cookie
(delete-instance cookie))))
; Remove all expired cookies
(define (remove-expired-cookies)
(within-transaction (class-repository usercookie)
(for-each
delete-instance
(filter
(lambda (c)
(< (usercookie-expires c) (current-seconds)))
(list-instances usercookie)))))
; Get user by cookie
(define (get-user-by-cookie value)
(within-transaction (class-repository usercookie)
(define cookie (get-cookie-by-value value))
(cond
((and cookie (not (< (usercookie-expires cookie) (current-seconds))))
; Cookie exists and has not expired => return associated user
(get-user-by-id (usercookie-user cookie)))
(cookie
; Cookie exists but has expired => remove cookie, and return "user not found"
(delete-instance cookie)
#f)
(#t
; Cookie does not exists => user not found
#f))))

65
src/pages/notepad.rkt
View File

@ -6,17 +6,27 @@
"../webcontainer/weblets.rkt"
"../webcontainer/weblet-parameter.rkt"
(prefix-in scrib: scribble/reader)
"../notepad/user.rkt"
"../notepad/stored-objects.rkt"
)
(provide
pages:notepad:page-list
pages:notepad:page-show
pages:notepad:user-list
pages:notepad:user-show
)
; Notepad directory
(define notepad-dir "notepad")
; Database path
(define notepad-repo-path "notepad.db")
; Create / open database
(define notepad-repo (open-repository 'sqlite3 notepad-repo-path))
(user-init-repository notepad-repo)
; Page not found
(define (not-found page)
(define (not-found)
(make-immutable-hash
'((error-code . 404)
(author . "404")
@ -90,14 +100,14 @@
((title author date)
(hash-set! hsh (car parsed) (apply string-append (cdr parsed)))
#f)
; @link["path"]{Text} : content: link to another page
; @link[path]{Text} : content: link to another page
((link)
`(a ((href ,(cadr parsed)))
`(a ((href ,(symbol->string (cadr parsed))))
,@(recur (cddr parsed))))
; @image["path"]{Alt text} : content: image
; @image[path]{Alt text} : content: image
((image)
(define alt (apply string-append (cddr parsed)))
`(img ((src ,(cadr parsed))
`(img ((src ,(symbol->string (cadr parsed)))
(alt ,alt)
(title ,alt))))
; @strong{Text} : content : strong
@ -135,7 +145,7 @@
(hash-set! result 'content `(article ,@(collect-result parsed result)))
result)
(#t
(not-found page))))))
(not-found))))))
; /notes/new
; Create a new page. User must be logged in.
@ -163,12 +173,51 @@
; /user/list
; Lists all the users of the notepad.
(define pages:notepad:user-list
(pages:template
#:title "Utilisateurs du bloc-note."
#:author "feuforeve.fr"
#:content
(lambda (param)
(define users (get-all-users))
(if (null? users)
'(article "Pas d'utilisateurs.")
`(article
,@(map
(lambda (u)
`(div (a ((href ,(string-append "/user/show/" (user-name u)))) ,(user-pseudo u))))
users))))
))
; /user/show/xxx
; Show the page of user xxx.
(define pages:notepad:user-show
(pages:adaptable-template
(lambda (param)
(define usr (get-user-by-name (weblet-parameter-ref param 'name #f)))
(cond
(usr
(make-immutable-hash
`((author . ,(user-name usr))
(title . ,(string-append "À propos de " (user-pseudo usr)))
(content . (article
(hr)
,(user-about usr)
(hr)
(p
(a ((href ,(string-append "/user/login/" (user-name usr))))
"Se connecter en tant que " ,(user-pseudo usr)))
)))))
(#t
(not-found))))))
; /user/login
; Login page.
; /user/login/xxx
; Login page for user xxx.
; Method GET -> show the page, with a form if user is not logged in. Show an error and a link to the logout page if user is already logged in.
; Method POST -> redirect to the page in case of failure, redirect to user-show in case of success
; /user/edit/xxx
; Edit page for the user xxx. Must be logged in as user xxx.
; /user/logout
; Logout page.