Commit f09df9cd authored by amirouche's avatar amirouche

web: wip publish message

parent ea1ffb24
......@@ -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,10 +191,55 @@ 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)
(with-transaction
(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))))
message)))
(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)
(if (or (not query) (null? query))
(values #f #f)
(match query
(match (string-split (car query) #\space)
(("/message" "publish" message ...)
(message-publish (string-join message " ") user))
(("/signin") (redirect "/signin"))
(("/signup") (redirect "/signup")))))
......@@ -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)))))))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment