1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
|
(import
scheme (chicken base)
(chicken port) (chicken random) (chicken time)
(chicken process-context)
spiffy intarweb uri-common
sqlite3
medea
srfi-1 ;list functions
)
;; db open and create
(define db (open-database (or (get-environment-variable "DB_FILE") "/tmp/comments.db")))
; Creates table automatically on initial run
(execute db "CREATE TABLE IF NOT EXISTS comments (
id TEXT PRIMARY KEY,
page_id TEXT,
content TEXT,
deletion_key TEXT,
created_at DATETIME default current_timestamp
)")
; creates a new almost-certainly-unique & chronologically ordered id
(define (gen-id)
(+ (pseudo-random-integer 65536)
(* (current-seconds) 100000)))
; inserts comment into db
(define (create-comment page-id content deletion-key)
(let ([id (gen-id)]
[content-or-empty (if (or (not content) (eof-object? content))
""
content)])
(execute db "INSERT INTO comments
(id, page_id, content, deletion_key)
VALUES (?, ?, ?, ?)"
id page-id content-or-empty deletion-key)
id))
; turns db row into list of key-value pairs
(define (comment-row->alist id page-id content created-at)
`((id . ,id)
(page_id . ,page-id)
(created_at . ,created-at)
(content . ,content)))
; selects all comments with the given page-id
(define (get-comments page-id)
(map-row comment-row->alist db
"SELECT c.id, c.page_id, c.content, c.created_at
FROM comments c
WHERE c.page_id = ?
ORDER BY c.created_at DESC"
page-id
))
; deletes any comment with the comment-id and deletion-key given, if any exist
(define (delete-comment comment-id deletion-key)
(execute db "DELETE FROM comments
WHERE id = ?
AND deletion_key = ?"
comment-id deletion-key))
; get query string parameter
(define (get-req-var k)
(alist-ref k (uri-query (request-uri (current-request)))))
; get page_id query string parameter
(define (get-page-id)
(get-req-var 'page_id))
; read current-request body as json. Arrays represented as lists, objects as alists
(define (read-json-body)
(read-json (request-port (current-request)) consume-trailing-whitespace: #f))
; get alist value with key of k
(define (json-value-ref json-alist k)
(and (list? json-alist) (alist-ref k json-alist equal? #f)))
; headers to always add to responses
(define base-headers
'((access-control-allow-origin *)
(access-control-allow-credentials true)
(access-control-allow-methods GET POST OPTIONS DELETE)
(access-control-allow-headers content-type)))
; list of allowed routes, first item is method, second is uri, third is handler function
(define routes
`(
(OPTIONS (/ "comments") ,(lambda ()
(send-response
status: 'ok
headers: base-headers)))
(POST (/ "comments") ,(lambda ()
(let* ([json-body (read-json-body)]
[page-id (json-value-ref json-body 'page_id)]
[content (json-value-ref json-body 'content)]
[deletion-key (json-value-ref json-body 'deletion_key)]
[bot? (not (equal? "no" (json-value-ref json-body 'bot)))])
(if bot?
(send-status 'bad-request)
(send-response
status: 'ok
body: (number->string
(create-comment page-id content deletion-key))
headers: base-headers)))))
(GET (/ "comments") ,(lambda ()
(let* ([page-id (get-page-id)]
[comments (list->vector (get-comments page-id))])
(send-response
headers: (cons
'(content-type application/json)
base-headers)
status: 'ok
body: (with-output-to-string
(lambda () (write-json comments))))
)))
(DELETE (/ "comments") ,(lambda ()
(let (
[comment-id (get-req-var 'comment)]
[deletion-key (get-req-var 'deletion_key)])
(delete-comment comment-id deletion-key)
(send-response
status: 'no-content
headers: base-headers)
)))
))
; find route with matching uri and method, or return #f
(define (find-route uri method)
(find
(lambda (r)
(and
(equal?
method
(first r))
(equal?
(uri-path uri)
(second r))))
routes))
; handle a new HTTP request
(define (handle continue)
(let* ([req (current-request)]
[uri (request-uri req)]
[method (request-method req)]
[route (find-route uri method)])
(if route
((third route))
(begin (display uri) (display method) (send-status 'not-found "Page Not Found")))))
(root-path ".")
(vhost-map `((".*" . ,handle)))
(start-server port: 7060)
|
