diff options
Diffstat (limited to 'main.scm')
| -rw-r--r-- | main.scm | 72 |
1 files changed, 48 insertions, 24 deletions
@@ -1,5 +1,5 @@ (import - scheme (chicken base) (chicken foreign) (chicken file posix) + scheme (chicken base) (chicken foreign) (chicken file posix) (chicken file) (chicken format) (chicken port) (chicken io) (chicken random) (chicken time) (chicken process-context) (chicken irregex) (chicken condition) (chicken blob) spiffy intarweb uri-common html-parser spiffy-request-vars multipart-form-data @@ -99,15 +99,23 @@ post-id) [(exn sqlite3) #f])) - -(define (get-child-posts post-id) +(define (get-child-posts post-id . opts) + (let* ([page (or (and (not (null-list? opts)) (car opts)) 0)] + [limit 25] +; [start (* limit page)] +; [end (* limit (add1 page))] + ) (map-row list db - "SELECT p.id, p.user_id, p.content, p.created_at, p.parent_id, count(c.id), p.jpeg_image is not null as has_image - FROM posts p - LEFT JOIN posts c ON c.parent_id = p.id - WHERE p.parent_id = ? - GROUP BY p.id, p.user_id, p.content, p.created_at, p.parent_id - ORDER BY count(c.id) DESC, p.created_at ASC LIMIT 25" post-id)) + "SELECT p.id, p.user_id, p.content, p.created_at, p.parent_id, count(c.id), + p.jpeg_image is not null as has_image + FROM posts p + LEFT JOIN posts c ON c.parent_id = p.id + WHERE p.parent_id = ? + GROUP BY p.id, p.user_id, p.content, p.created_at, p.parent_id + ORDER BY count(c.id) DESC, p.created_at ASC " ;LIMIT ?, ?" + post-id + ; start end + ))) (define (get-user-posts user-id) (map-row list db @@ -153,10 +161,11 @@ ((foreign-lambda void "setExifOrientation" nonnull-c-string unsigned-int) file-path orientation) - (let - ([port (open-input-file file-path #:binary)]) - (u8vector->blob/shared (read-u8vector #f port))) - )) + (let* + ([port (open-input-file file-path #:binary)] + [result (u8vector->blob/shared (read-u8vector #f port))]) + (delete-file file-path) + result))) (define dim-max 512) @@ -200,9 +209,11 @@ (define apikeys (make-hash-table)) (define (login username password) - (let ([apikey (number->string (pseudo-random-integer 340282366920938463463374607431768211455))]) - (hash-table-set! apikeys apikey username) - apikey)) + (let ([pw-in-db (hash-table-ref/default users username #f)]) + (and password (equal? password pw-in-db) + (let ([apikey (number->string (pseudo-random-integer 340282366920938463463374607431768211455))]) + (hash-table-set! apikeys apikey username) + apikey)))) (define (lookup-user apikey) (hash-table-ref/default apikeys apikey #f)) @@ -300,7 +311,9 @@ [value ""] [rows "5"] [cols "50"]))) - (div (@ [class "image-upload"]) + (div (@ [class "image-upload"] + [style "display:none;"] + ) (label (@ [for "image"] [style "margin-right:0.1em"]) "Add Image") @@ -376,6 +389,12 @@ (map (cut post current-user <>) posts)) ))) +(define (dialog text) + `(dialog (@ [open "true"] [style "min-width:30vw"]) + (p ,text) + (form (@ [method "dialog"]) + (button "OK")))) + (define (posts-page current-user displayed-posts) (posts-page-outer "/" current-user `(span @@ -467,11 +486,13 @@ [username (cdr (assv 'username form-data))] [password (cdr (assv 'password form-data))] [apikey (login username password)]) - (send-response - headers: `((location "/") - (set-cookie - #(("apikey" . ,apikey) ()))) - status: 'see-other)))) + (if apikey + (send-response + headers: `((location "/") + (set-cookie + #(("apikey" . ,apikey) ()))) + status: 'see-other) + (send-status 'unauthorized))))) (GET (/ "logout") ,(lambda (rt) (send-response @@ -517,7 +538,9 @@ [post-image-string (and post-image (blob->string post-image))]) (if post-image-string (send-response - headers: '((content-type image/jpeg)) + headers: '((content-type image/jpeg) + (cache-control + (max-age . 604800) public immutable)) status: 'ok body: post-image-string) (send-status 'not-found "This image no longer exists!"))))) @@ -526,7 +549,8 @@ (let* ([current-user (get-current-user)] [post-id (get-route-param rt "id")] [post (get-post post-id)] - [comments (if post (get-child-posts post-id) #f)]) + [page-num ((request-vars 'query-string) 'page as-number)] + [comments (and post (get-child-posts post-id page-num))]) (if post (send-response headers: '((content-type text/html)) |