Commits (4)
......@@ -16,7 +16,7 @@
(put 'with-context 'scheme-indent-function 1)
(put 'with-context* 'scheme-indent-function nil)
(put 'match 'scheme-indent-function 1)
(put 'with-transaction 'scheme-indent-function 1)
(put 'with-transaction 'scheme-indent-function 0)
(put 'test-check 'scheme-indent-function 1)
(put 'call-with-cursor 'scheme-indent-function 1)
(put 'with-cnx 'scheme-indent-function 1)
* CSRF protections
* security
** CSRF protections
** timeseries
** fail2ban
* web: signin: add support for next
The follow ``/signin?next=/?query=/publish message ...'' must redirect 'next'
* add transactions to all queries
* add tags
* add post
* add link
* add code
* add search from culturia.one's ``ix.scm''
* rename handler to router
* rename index to route/index etc...
* check if I can use and-let* from srfi-2
* replace /template with /sxml
......@@ -146,12 +146,25 @@ form > div.form-field > p.error {
form input[type="text"],
form input[type="password"] {
form input[type="password"],
form textarea {
width: 100%;
border: 1px solid hsla(0, 0%, 70%, 1);
border-radius: 2px;
background: white;
padding: 5px 10px;
box-sizing: border-box;
form textarea {
padding: 10px 50px;
form input[type="text"]:focus,
form input[type="password"]:focus,
textarea:focus {
box-shadow: 0px 0px 2px rgb(0, 0, 255);
border: 1px solid rgb(0, 0, 255);
form .error input[type="text"],
......@@ -191,12 +191,57 @@ exec guile -L $(pwd) -e '(@ (web) main)' -s "$0" "$@"
(define (request-query request)
(and=> ((compose uri-query request-uri) request) decode))
(define (message-publish message user)
(if (not user)
(redirect "/signin")
(redirect (string-append "/message/create?body=" (uri-encode message)))))
(define (query-message-create body user)
(let ((message (grf3:save
(grf3:create-vertex `((type . item)
(subtype . message)
(created-at . ,(current-time))
(body . ,body))))))
(grf3:save (grf3:create-edge message user `((type . created-by))))
(define (route/message-create/sxml body)
(template "message-create"
`(form (@ (method "POST"))
(div (@ (form "form-field")) (textarea (@ (name "body")) ,body))
,(form/submit "submit"))))
(define (route/message-create/get app request)
(let ((user (request-user request app)))
(let ((body (ref (request-query request) "body")))
(if (not body)
(redirect "/")
(sxml->response (route/message-create/sxml (car body)))))))
(define (not-empty value)
(and (or (not value)
(eq? (string-length (car value)) 0))
"must not be empty."))
(define %message-validator `(("body" . ,not-empty)))
(define (route/message-create/post app request body)
(let ((user (request-user request app)))
(let ((form (decode body)))
(if (null? (validate %message-validator form))
(let ((message (query-message-create (ref form "body") user)))
(redirect (format #f "/item/~a/" (grf3:vertex-uid message))))
(redirect "/")))))
(define (query->maybe-response query user)
((not query) (values #f #f))
((null? query) (values #f #f))
((string=? (car query) "/signin") (redirect "/signin"))
((string=? (car query) "/signup") (redirect "/signup"))))
(if (or (not query) (null? query))
(values #f #f)
(match (string-split (car query) #\space)
(("/message" "publish" message ...)
(message-publish (string-join message " ") user))
(("/signin") (redirect "/signin"))
(("/signup") (redirect "/signup")))))
(define (index app request)
(let ((query (assoc-ref (request-query request) "query"))
......@@ -461,6 +506,8 @@ user vertex"
('(POST "signin") (signin/post app request body))
('(GET "signup") (signup/get request))
('(POST "signup") (signup/post app request body))
('(GET "message" "create") (route/message-create/get app request))
('(POST "message" "create") (route/message-create/post app request body))
(('GET "static" path ...) (render-static-asset path))
(_ (not-found (uri-path (request-uri request)))))))