Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
A
asylum
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
2
Issues
2
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
a-guile-mind
asylum
Compare Revisions
a2599b0170826736eafb6a1cde35b2243bc7531f...f09df9cd0505d3d610888ca3ce4d0429e577d1d1
Source
f09df9cd0505d3d610888ca3ce4d0429e577d1d1
Select Git revision
...
Target
a2599b0170826736eafb6a1cde35b2243bc7531f
Select Git revision
Compare
Commits (4)
web: query->maybe-response: rework to use match
· 3ad9c689
amirouche
authored
Feb 04, 2018
3ad9c689
.dir-locals.el: fix with-transaction
· 29ee275b
amirouche
authored
Feb 04, 2018
29ee275b
TODO++
· ea1ffb24
amirouche
authored
Feb 04, 2018
ea1ffb24
web: wip publish message
· f09df9cd
amirouche
authored
Feb 04, 2018
f09df9cd
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
85 additions
and
8 deletions
+85
-8
.dir-locals.el
.dir-locals.el
+1
-1
TODO.org
TODO.org
+18
-1
main.css
src/static/main.css
+14
-1
web.scm
src/web.scm
+52
-5
No files found.
.dir-locals.el
View file @
f09df9cd
...
...
@@ -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
)
...
...
TODO.org
View file @
f09df9cd
* 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
src/static/main.css
View file @
f09df9cd
...
...
@@ -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"
],
...
...
src/web.scm
View file @
f09df9cd
...
...
@@ -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
)
(
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
)
(
cond
((
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
)))))))
...
...