diff of 97252c3affd359f5feee11669ab3a6eab22fa8bf
97252c3affd359f5feee11669ab3a6eab22fa8bf
diff --git a/aggressive-murja.asd b/aggressive-murja.asd
index 7f7c47b..8c6a6f8 100644
--- a/aggressive-murja.asd
+++ b/aggressive-murja.asd
@@ -25,6 +25,7 @@
"cl-date-time-parser"
;; transforms those to unix time
"cl-epoch"
+ "alexandria"
)
:description "A rewrite of the <a href=\"https://github.com/feuery/murja-blog/\">murja blogging engine</a> in lisp"
:components ((:module "src"
diff --git a/resources/sql/post-fns.sql b/resources/sql/post-fns.sql
index a0be523..a857c4c 100644
--- a/resources/sql/post-fns.sql
+++ b/resources/sql/post-fns.sql
@@ -82,6 +82,7 @@ ORDER BY p.created_at DESC
-- $1 == page-id
-- $2 == page-size
-- $3 == show-hidden?
+-- $4 == modified-since
-- name: get-page*
-- returns: :array-hash
SELECT p.ID, p.Title, p.Content, p.created_at, p.tags, COUNT(c.ID) AS "amount-of-comments", json_build_object('username', u.Username, 'nickname', u.Nickname, 'img_location', u.Img_location) as "creator", json_agg(DISTINCT version) as "versions", p.hidden, p.unlisted,
@@ -93,6 +94,7 @@ LEFT JOIN blog.Post_History ph ON (ph.id = p.id AND ((not ph.unlisted) OR $3) AN
LEFT JOIN blog.Previously_Link_Titles pl ON p.id = pl.referencee_id
WHERE ((NOT p.unlisted) OR $3)
AND ((NOT p.hidden) OR $3)
+ AND (($4::timestamp IS NULL) OR p.created_at > $4::timestamp)
GROUP BY p.ID, u.ID
ORDER BY p.created_at DESC
LIMIT $2
diff --git a/src/local-lib/lisp-fixup.lisp b/src/local-lib/lisp-fixup.lisp
index 7d3caf1..ca6efaf 100644
--- a/src/local-lib/lisp-fixup.lisp
+++ b/src/local-lib/lisp-fixup.lisp
@@ -1,6 +1,9 @@
(defpackage lisp-fixup
(:use :cl)
- (:export :*rfc822* :sha-512 :partial :compose :drop :slurp-bytes :slurp-utf-8))
+ (:export :if-modified-since->simpledate-timestamp :*rfc822*
+ :sha-512 :partial
+ :compose :drop
+ :slurp-bytes :slurp-utf-8))
(in-package :lisp-fixup)
@@ -76,6 +79,22 @@
(12 "Dec")
(t "")))
+(defun month->ordinal (month)
+ (alexandria:switch (month :test #'equal)
+ ("January" 1)
+ ("February" 2)
+ ("March" 3)
+ ("April" 4)
+ ("May" 5)
+ ("June" 6)
+ ("July" 7)
+ ("August" 8)
+ ("September" 9)
+ ("October" 10)
+ ("November" 11)
+ ("December" 12)
+ (t "")))
+
(defun fix-timestamp (timestamp)
"Fixes timestamps returned from postmodern to a json-format elm can parse"
(multiple-value-bind (year month day hour minute second millisec)
@@ -90,3 +109,16 @@
year
hour minute second)
(format nil "~d-~2,'0d-~2,'0dT~2,'0d:~2,'0d:~2,'0dZ" year month day hour minute second)))))
+
+;; Wed, 30 March 2016 08:09:00 GMT
+(defun if-modified-since->simpledate-timestamp (header)
+ (let* ((header (str:trim (second (str:split #\, header)))))
+ (destructuring-bind (day month year timestamp gmt ) (str:split #\Space header)
+ (destructuring-bind (h m sec) (str:split #\: timestamp)
+ (let ((month (month->ordinal month)))
+ (apply #'simple-date:encode-timestamp
+ (mapcar (lambda (e)
+ (if (stringp e)
+ (parse-integer e)
+ e))
+ (list year month day h m sec))))))))
diff --git a/src/posts/post-db.lisp b/src/posts/post-db.lisp
index b9b4b85..ab24843 100644
--- a/src/posts/post-db.lisp
+++ b/src/posts/post-db.lisp
@@ -36,13 +36,15 @@
(fix-timestamp (gethash "created_at" post)))
post)
-(defun get-page (page page-size &key allow-hidden?)
- (let ((page (if (< page 1)
- 1
- page))
- (resulting-page (coerce
- (get-page* (* (1- page) page-size)
- page-size allow-hidden?) 'list)))
+(defun get-page (page page-size &key allow-hidden? modified-since)
+ (let* ((page (if (< page 1)
+ 1
+ page))
+ (resulting-page (coerce
+ (get-page* (* (1- page) page-size)
+ page-size allow-hidden? (if modified-since
+ modified-since
+ :null)) 'list)))
(mapcar #'fix-post
resulting-page)))
diff --git a/src/routes/rss-routes.lisp b/src/routes/rss-routes.lisp
index d17bb0c..3702252 100644
--- a/src/routes/rss-routes.lisp
+++ b/src/routes/rss-routes.lisp
@@ -34,7 +34,12 @@
:decorators ( @transaction)) ()
(let ((lisp-fixup:*rfc822* t))
(let* ((settings (get-settings))
+ (if-modified-since (when (hunchentoot:header-in* :if-modified-since)
+ (lisp-fixup:if-modified-since->simpledate-timestamp
+ (hunchentoot:header-in* :if-modified-since))))
(page-size (gethash "recent-post-count" settings))
- (page (get-page 1 page-size :allow-hidden? nil)))
+ (page (get-page 1 page-size :allow-hidden? nil
+ :modified-since if-modified-since)))
+
(setf (hunchentoot:content-type*) "application/rss+xml")
(posts->rss page))))
diff --git a/test/tests.lisp b/test/tests.lisp
index a65f302..6560b52 100644
--- a/test/tests.lisp
+++ b/test/tests.lisp
@@ -16,23 +16,24 @@
(format nil "http://localhost:~d" *test-port*))
(def-fixture prepare-db-and-server ()
- (let ((murja.middleware.db:*automatic-tests-on?* t))
- (murja.middleware.db:with-db
+ ;; easy-route handlers don't inherit this value as t in their environment if changed with only let here
+ (setf murja.middleware.db:*automatic-tests-on?* t)
+ (murja.middleware.db:with-db
+ (unwind-protect
+ (progn
+ (postmodern:execute "DROP SCHEMA IF EXISTS blog CASCADE;")
+ (postmodern:execute "DROP TABLE IF EXISTS public.ragtime_migrations")
+ (postmodern:execute "DROP TABLE IF EXISTS public.migrations_tracker")
+ (setf *test-server* (murja:start-server :port *test-port*))
+ (format t "Starting the test &body~%")
+ (&body))
+
(postmodern:execute "DROP SCHEMA IF EXISTS blog CASCADE;")
(postmodern:execute "DROP TABLE IF EXISTS public.ragtime_migrations")
(postmodern:execute "DROP TABLE IF EXISTS public.migrations_tracker")
-
- (unwind-protect
- (progn
- (setf *test-server* (murja:start-server :port *test-port*))
- (format t "Starting the test &body~%")
- (&body))
-
- (postmodern:execute "DROP SCHEMA IF EXISTS blog CASCADE;")
- (postmodern:execute "DROP TABLE IF EXISTS public.ragtime_migrations")
- (postmodern:execute "DROP TABLE IF EXISTS public.migrations_tracker")
- (hunchentoot:stop *test-server*)
- (setf *test-server* nil)))))
+ (hunchentoot:stop *test-server*)
+ (setf *test-server* nil)
+ (setf murja.middleware.db:*automatic-tests-on?* nil))))
(def-test multiple-migrations (:fixture prepare-db-and-server)
(let ((successfully-migrated nil))
@@ -162,6 +163,59 @@
(is (equalp 4
(length (remove-duplicates pages)))))))))))))
+(defun drakma->string (result)
+ (if (and (arrayp result)
+ (not (stringp result)))
+ (trivial-utf-8:utf-8-bytes-to-string result)
+ result))
+
+(def-test rss-server-tests (:fixture prepare-db-and-server)
+ (let* ((user-id (register-user "test-user" "Test User" "" "passu"))
+ (feed-id (caar (postmodern:query "INSERT INTO blog.feed_subscription(name, url, owner) VALUES ($1, $2, $3) returning id;" "test-feed" "http://localhost/rss" user-id)))
+ (dada "Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Sed posuere interdum sem. Quisque ligula eros ullamcorper quis, lacinia quis facilisis sed sapien. Mauris varius diam vitae arcu. Sed arcu lectus auctor vitae, consectetuer et venenatis eget velit. Sed augue orci, lacinia eu tincidunt et eleifend nec lacus. Donec ultricies nisl ut felis, suspendisse potenti. Lorem ipsum ligula ut hendrerit mollis, ipsum erat vehicula risus, eu suscipit sem libero nec erat. Aliquam erat volutpat. Sed congue augue vitae neque. Nulla consectetuer porttitor pede. Fusce purus morbi tortor magna condimentum vel, placerat id blandit sit amet tortor.\n\nMauris sed libero. Suspendisse facilisis nulla in lacinia laoreet, lorem velit accumsan velit vel mattis libero nisl et sem. Proin interdum maecenas massa turpis sagittis in, interdum non lobortis vitae massa. Quisque purus lectus, posuere eget imperdiet nec sodales id arcu. Vestibulum elit pede dictum eu, viverra non tincidunt eu ligula.\n\nNam molestie nec tortor. Donec placerat leo sit amet velit. Vestibulum id justo ut vitae massa. Proin in dolor mauris consequat aliquam. Donec ipsum, vestibulum ullamcorper venenatis augue. Aliquam tempus nisi in auctor vulputate, erat felis pellentesque augue nec, pellentesque lectus justo nec erat. Aliquam et nisl. Quisque sit amet dolor in justo pretium condimentum.\n\nVivamus placerat lacus vel vehicula scelerisque, dui enim adipiscing lacus sit amet sagittis, libero enim vitae mi. In neque magna posuere, euismod ac tincidunt tempor est. Ut suscipit nisi eu purus. Proin ut pede mauris eget ipsum. Integer vel quam nunc commodo consequat. Integer ac eros eu tellus dignissim viverra. Maecenas erat aliquam erat volutpat. Ut venenatis ipsum quis turpis. Integer cursus scelerisque lorem. Sed nec mauris id quam blandit consequat. Cras nibh mi hendrerit vitae, dapibus et aliquam et magna. Nulla vitae elit. Mauris consectetuer odio vitae augue.")
+
+ (pubdates (vector (simple-date:encode-timestamp 2015 8 25)
+ (simple-date:encode-timestamp 2015 10 12)
+ (simple-date:encode-timestamp 2016 4 1)
+ (simple-date:encode-timestamp 2017 1 12)))
+ (dada-list (str:split #\Space dada))
+ (size (length dada-list)))
+
+ (literal
+
+ Let us delete the old crap from blog.Post
+
+ !L
+ (progn
+ (postmodern:execute "delete from blog.post")
+ (format t "deleted every post~%"))
+
+ and populate the database with pre-existing posts with obviously distinct pubdates
+ !L
+ (dotimes (x 4)
+ (let* ((pubdate (aref pubdates x)))
+ (postmodern:execute
+ "insert into blog.post (title, content, creator_id, tags, hidden, unlisted, created_at)
+values ($1, $2, $3, $4, $5, $6, $7) returning id;"
+ (first (lisp-fixup:drop (random size) dada-list))
+ dada
+ user-id
+ #()
+ nil nil
+ pubdate)))
+
+
+ And then we shall see that if we are querying the rss api with http/drakma with if-modified-since header set - only the newer titles are returned
+
+ !L
+ (let* ((result (drakma->string (drakma:http-request (format nil "~a/api/rss" (url))
+ :additional-headers `(("if-modified-since" . "Wed, 30 March 2016 08:09:00 GMT")))))
+ (result-per-line (str:split #\Newline result))
+ (pubdates (remove-if-not (lisp-fixup:partial #'str:contains? "<pubDate>") result-per-line)))
+
+ (is (every (lambda (line) (not (str:contains? "2015" line))) pubdates))
+ (is (= 2 (length pubdates)))))))
+
;; (setf fiveam:*run-test-when-defined* t)
(if (and (sb-ext:posix-getenv "GHA")