remove image-uploading and cleanup

1 files changed, 17 insertions, 89 deletions

diff --git a/main.scm b/main.scm
index 80b52d7..f356d3f 100644
--- a/main.scm
+++ b/main.scm
@@ -1,13 +1,12 @@
 (import
-  scheme (chicken base) (chicken foreign) (chicken file posix) (chicken file)
-  (chicken format) (chicken port) (chicken io) (chicken random) (chicken time)
+  scheme (chicken base)
+  (chicken format) (chicken port) (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
   sqlite3 sql-null
   srfi-69 ;hash tables
   srfi-1 ;list functions
   srfi-4 ;u8vector
-  stb-image stb-image-resize stb-image-write
 )
 
 
@@ -21,8 +20,7 @@
                     user_id TEXT,
                     content TEXT,
                     created_at DATETIME default current_timestamp,
-                    parent_id TEXT,
-                    jpeg_image BLOB
+                    parent_id TEXT
                 )")
     (execute db "CREATE TABLE flush_votes (
                     user_id TEXT PRIMARY KEY,
@@ -34,22 +32,19 @@
   (+ (pseudo-random-integer 65536)
      (* (current-seconds) 100000)))
 
-(define (create-post user content parent-id image)
+(define (create-post user content parent-id)
 
   (let ([id (gen-id)]
         [parent-id-or-null (if (or (not parent-id) (eof-object? parent-id) (equal? "" parent-id))
                                 (sql-null)
                                 parent-id)]
-        [image-or-null (if (or (not image) (eof-object? image) (equal? "" image))
-                            (sql-null)
-                            image)]
         [content-or-empty (if (or (not content) (eof-object? content))
                             ""
                             content)])
       (execute db "insert into posts
-                    (id, user_id, content, parent_id, jpeg_image)
-                    values (?, ?, ?, ?, ?)"
-               id user content-or-empty parent-id-or-null image-or-null)))
+                    (id, user_id, content, parent_id)
+                    values (?, ?, ?, ?)"
+               id user content-or-empty parent-id-or-null)))
 
 (define (vote-to-flush user)
     (execute db "insert or ignore into flush_votes (user_id) values (?)"
@@ -64,16 +59,8 @@
                                         "SELECT count(*) FROM flush_votes WHERE user_id = ?"
                                         user)))
 
-;;
-
-;(define (read-request-string request)
-;  (let* ((p (request-port request))
-;        (len (header-value 'content-length (request-headers request)))
-;        (port (request-port request)))
-;                    (read-u8vector len port)))
-
 (define (top-posts) (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
+            "SELECT p.id, p.user_id, p.content, p.created_at, p.parent_id, count(c.id)
                 FROM posts p
                 LEFT JOIN posts c ON c.parent_id = p.id
                 WHERE p.parent_id IS NULL
@@ -82,7 +69,7 @@
 
 (define (get-post post-id)
    (condition-case (first-row 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
+                "SELECT p.id, p.user_id, p.content, p.created_at, p.parent_id, count(c.id)
                     FROM posts p
                     LEFT JOIN posts c ON c.parent_id = p.id
                     WHERE p.id = ?
@@ -91,35 +78,21 @@
                 post-id)
     [(exn sqlite3) #f]))
 
-(define (get-post-image post-id)
-  (condition-case (first-result db
-                                "SELECT p.jpeg_image
-                                FROM posts p
-                                WHERE p.id = ?"
-                                post-id)
-                  [(exn sqlite3) #f]))
-
-(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))]
-         )
+
+(define (get-child-posts post-id)
     (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
+             "SELECT p.id, p.user_id, p.content, p.created_at, p.parent_id, count(c.id)
                  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 ?, ?"
+                 ORDER BY count(c.id) DESC, p.created_at ASC "
              post-id
-            ; start end
-             )))
+             ))
 
 (define (get-user-posts user-id)
   (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
+            "SELECT p.id, p.user_id, p.content, p.created_at, p.parent_id, count(c.id)
                 FROM posts p
                 LEFT JOIN posts c ON c.parent_id = p.id
                 WHERE p.parent_id IS NULL AND p.user_id = ?
@@ -226,8 +199,6 @@
   (let ([apikey (get-cookie "apikey")])
     (if apikey (lookup-user apikey) #f)))
 
-(define (get-prev-path) (get-cookie "prev"))
-
 (define (post-path id)
   (if
     (and id
@@ -281,11 +252,6 @@
                                  [class "delete-button"])
                               "[delete]")
                           '())
-            ,(if (has-image? p)
-                `(img (@ [src ,(string-append "/posts/image/" (id p))]
-                         [style "max-width:100%;"]
-                         [loading "lazy"]))
-                '())
             (div (@ [class "content-container"]) ,(content->sxml (content p)))
             (div (@ [class "post-info"])
                  (em "- " (a (@ [href ,(user-path (user p))]) ,(user p)))
@@ -311,16 +277,6 @@
                    [value ""]
                    [rows "5"]
                    [cols "50"])))
-  (div (@ [class "image-upload"]
-          [style "display:none;"]
-          )
-      (label (@ [for "image"]
-                [style "margin-right:0.1em"])
-             "Add Image")
-      (input (@ [type "file"]
-                [id "image"]
-                [accept "image/jpeg"]
-                [name "image"])))
   (input (@ [id "submit"] [type "submit"] [value "Post"]))
   ))
 
@@ -354,8 +310,6 @@
     (list-ref prompts (pseudo-random-integer (length prompts)))))
 
 (define (current-request-path) (uri-path (request-uri (current-request))))
-(define (current-request-path-string)
-    (apply string-append (cons "/" (intersperse (cdr (current-request-path)) "/"))))
 
 (define (get-route-param route param)
   (let ([pattern (second route)]
@@ -389,12 +343,6 @@
                           (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
@@ -447,10 +395,6 @@
       p
       "/")))
 
-(define (get-image-u8vector image-multipart)
-  (and (multipart-file? image-multipart)
-       (read-u8vector #f (multipart-file-port image-multipart))))
-
 (define routes
   `(
     (GET (/ "style.css") ,(lambda (rt)
@@ -506,10 +450,8 @@
                     (let* ([form-data (read-multipart-form-data (current-request))]
                            [content (cdr (assv 'content form-data))]
                            [parent-id (cdr (assv 'parent_id form-data))]
-                           [image-multipart (cdr (assv 'image form-data))]
-                           [image (img->jpeg-blob (get-image-u8vector image-multipart))]
                            [user (get-current-user)]
-                           [success? (and user (create-post user content parent-id image))])
+                           [success? (and user (create-post user content parent-id))])
                         (send-response
                                headers: `((location ,(post-path parent-id)))
                                status: 'see-other
@@ -532,25 +474,11 @@
                                       status: 'ok
                                       body: (user-page current-user user-id posts)))))
 
-    (GET (/ "posts" "image" ":id") ,(lambda (rt)
-                              (let* ([post-id (get-route-param rt "id")]
-                                     [post-image (and post (get-post-image post-id))]
-                                     [post-image-string (and post-image (blob->string post-image))])
-                                (if post-image-string
-                                    (send-response
-                                      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!")))))
-
     (GET (/ "posts" ":id") ,(lambda (rt)
                               (let* ([current-user (get-current-user)]
                                      [post-id (get-route-param rt "id")]
                                      [post (get-post post-id)]
-                                     [page-num ((request-vars 'query-string) 'page as-number)]
-                                     [comments (and post (get-child-posts post-id page-num))])
+                                     [comments (and post (get-child-posts post-id))])
                                 (if post
                                     (send-response
                                       headers:  '((content-type text/html))