diff of 3ae9a52e0dac4e9b5492ef8c2840dea0fb80134d
3ae9a52e0dac4e9b5492ef8c2840dea0fb80134d
diff --git a/aggressive-murja.asd b/aggressive-murja.asd
index 9c8449d..d454b01 100644
--- a/aggressive-murja.asd
+++ b/aggressive-murja.asd
@@ -18,7 +18,10 @@
"cl-fad"
"log4cl"
"cl-advice"
- "xml-emitter")
+ "xml-emitter"
+ "drakma"
+ "xmls"
+ "cl-date-time-parser")
:description "A rewrite of the <a href=\"https://github.com/feuery/murja-blog/\">murja blogging engine</a> in lisp"
:components ((:module "src"
:components
@@ -41,6 +44,10 @@
:components
((:file "media-db")))
+ (:module "rss"
+ :components
+ ((:file "reader-db")))
+
(:module "routes"
:components
((:file "settings-routes")
@@ -48,6 +55,7 @@
(:file "post-routes")
(:file "media-routes")
(:file "rss-routes")
+ (:file "rss-reader-routes")
(:file "root-routes")))
(:file "main"))))
:in-order-to ((test-op (test-op "pichunter/tests"))))
diff --git a/elm-frontti/elm.json b/elm-frontti/elm.json
index a61175b..f1094e1 100644
--- a/elm-frontti/elm.json
+++ b/elm-frontti/elm.json
@@ -16,6 +16,7 @@
"elm/html": "1.0.0",
"elm/http": "2.0.0",
"elm/json": "1.1.3",
+ "elm/random": "1.0.0",
"elm/time": "1.0.0",
"elm/url": "1.0.0",
"elm-community/dict-extra": "2.4.0",
@@ -30,7 +31,6 @@
"danfishgold/base64-bytes": "1.1.0",
"elm/bytes": "1.0.8",
"elm/parser": "1.1.0",
- "elm/random": "1.0.0",
"elm/regex": "1.0.0",
"elm/virtual-dom": "1.0.2",
"justinmimbs/timezone-data": "2.1.4",
diff --git a/elm-frontti/src/Ajax_cmds.elm b/elm-frontti/src/Ajax_cmds.elm
index 5536ab4..ed1aea4 100644
--- a/elm-frontti/src/Ajax_cmds.elm
+++ b/elm-frontti/src/Ajax_cmds.elm
@@ -3,6 +3,7 @@ module Ajax_cmds exposing (..)
import Article
import User
import Page
+import Feeds
import Message exposing (..)
import Http exposing (..)
import Image as Image
@@ -138,3 +139,14 @@ loadPreviousArticle post_id =
Http.get
{ url = "/api/posts/post/" ++ (String.fromInt post_id)
, expect = Http.expectJson PreviousPostReceived Article.articleDecoder}
+
+getFeeds =
+ Http.get
+ { url = "/api/user/feeds"
+ , expect = Http.expectJson FeedsReceived (Json.list Feeds.feedDecoder)}
+
+addFeed newFeed =
+ Http.post
+ { url = "/api/user/feeds"
+ , body = Http.jsonBody (Feeds.newFeedEncoder newFeed)
+ , expect = Http.expectWhatever FeedAdded }
diff --git a/elm-frontti/src/FeedView.elm b/elm-frontti/src/FeedView.elm
new file mode 100644
index 0000000..fd5115c
--- /dev/null
+++ b/elm-frontti/src/FeedView.elm
@@ -0,0 +1,37 @@
+module FeedView exposing (..)
+
+import DateFormat as Df
+import Feeds exposing (NewFeed)
+import Message exposing (..)
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (onInput, onClick)
+import Button exposing (murja_button)
+import UUID
+
+import Random
+
+feeds fs new_feed =
+ let new_feed_state = Maybe.withDefault (NewFeed "" "") new_feed
+ in
+ div []
+ [ ul [ class "feed-list" ]
+ (List.map (\feed ->
+ li [ class "feed" ]
+ [ header [] [ text feed.name ]
+ , a [ href feed.url ] [ text feed.url ]]) fs)
+ , h3 [] [ text "Add new feed?"]
+ , div []
+ [ label [ for "name" ] [ text "Feed name" ]
+ , input [ id "name"
+ , onInput SetFeedName
+ , value new_feed_state.name
+ , type_ "text"] []
+
+ , label [ for "url" ] [ text "Url to feed" ]
+ , input [ id "url"
+ , onInput SetFeedUrl
+ , value new_feed_state.url
+ , type_ "text"] []
+ , murja_button [ onClick (AddFeed new_feed_state)] [ text "Add a feed"]]]
+
diff --git a/elm-frontti/src/Feeds.elm b/elm-frontti/src/Feeds.elm
new file mode 100644
index 0000000..dd97bcb
--- /dev/null
+++ b/elm-frontti/src/Feeds.elm
@@ -0,0 +1,47 @@
+module Feeds exposing (..)
+
+import Json.Encode as Json exposing (..)
+import Json.Encode.Extra exposing (..)
+import Json.Decode as Decode exposing (Decoder, succeed)
+import Json.Decode.Pipeline exposing (required)
+import Json.Decode.Extra as Extra
+
+import UUID exposing (UUID)
+
+import Article exposing (decodeApply)
+import Creator exposing (Creator)
+
+type alias Feed =
+ { id: UUID
+ , name: String
+ , url: String
+ , creator: Creator}
+
+type alias NewFeed =
+ { name: String
+ , url: String}
+
+creatorDecoder = Decode.field "creator" Creator.creatorDecoder
+urlDecoder = Decode.field "url" Decode.string
+nameDecoder = (Decode.field "name" Decode.string)
+idDecoder = (Decode.field "id" UUID.jsonDecoder)
+
+feedDecoder: Decoder Feed
+feedDecoder =
+ Decode.succeed Feed
+ |> decodeApply idDecoder
+ |> decodeApply nameDecoder
+ |> decodeApply urlDecoder
+ |> decodeApply creatorDecoder
+
+newFeedDecoder: Decoder NewFeed
+newFeedDecoder =
+ Decode.succeed NewFeed
+ |> decodeApply nameDecoder
+ |> decodeApply urlDecoder
+
+newFeedEncoder o =
+ Json.object
+ [ ("name", Json.string o.name)
+ , ("url", Json.string o.url) ]
+
diff --git a/elm-frontti/src/Main.elm b/elm-frontti/src/Main.elm
index 35a0816..475ed4a 100644
--- a/elm-frontti/src/Main.elm
+++ b/elm-frontti/src/Main.elm
@@ -43,6 +43,8 @@ import Date_utils exposing (int_to_month_string)
import UUID
import File exposing (mime)
+import FeedView
+import Feeds exposing (NewFeed)
-- MAIN
@@ -65,7 +67,7 @@ subscriptions _ = Sub.batch
[ tags ReceivedTag
, aceStateUpdate AceStateUpdate]
-initialModel url key viewstate = Model viewstate Nothing False False [] Nothing LoggedOut key url Nothing Time.utc [] []
+initialModel url key viewstate = Model viewstate Nothing False False [] Nothing LoggedOut key url Nothing Time.utc [] [] Nothing
viewStatePerUrl : Url.Url -> (ViewState, List (Cmd Msg))
viewStatePerUrl url =
@@ -110,6 +112,9 @@ viewStatePerUrl url =
RouteParser.SettingsEditor -> (Loading, [ getSession
, getSettingsAdmin
, getTitles])
+ RouteParser.FeedReader -> (Loading, [ getSession
+ , getSettings
+ , getFeeds ])
init _ url key =
let (viewstate, cmds) = (viewStatePerUrl url)
@@ -563,7 +568,40 @@ update msg model =
ClosePreviousPostPreviewModal ->
( model
, closePreviousPostsModal ())
-
+ FeedsReceived result ->
+ case result of
+ Ok feeds ->
+ ( { model | view_state = Feeds feeds}
+ , Cmd.none)
+ Err error ->
+ ( { model | view_state = ShowError (errToString error) }
+ , Cmd.none)
+ SetFeedName name ->
+ let new_feed = (Maybe.withDefault (NewFeed "" "") model.new_feed)
+ in
+ ({ model
+ | new_feed = Just { new_feed
+ | name = name}}
+ , Cmd.none)
+ SetFeedUrl url ->
+ let new_feed = (Maybe.withDefault (NewFeed "" "") model.new_feed)
+ in
+ ({ model
+ | new_feed = Just { new_feed
+ | url = url}}
+ , Cmd.none)
+ AddFeed new_feed ->
+ ({ model
+ | new_feed = Nothing}
+ , addFeed new_feed)
+ FeedAdded r ->
+ case r of
+ Ok _ ->
+ ( model
+ , getFeeds)
+ Err error ->
+ ( { model | view_state = ShowError (errToString error) }
+ , Cmd.none)
doGoHome_ model other_cmds =
(model, Cmd.batch (List.append [ getSettings
, getTitles
@@ -654,7 +692,8 @@ view model =
PostEditor.postEditor post tag_index model.showImageModal model.loadedImages model.draggingImages editorSettings settings model.zone model.loginState model.searchedPosts
Nothing -> [ div [] [ text "No post loaded" ]]
MediaList -> [ medialist model.loadedImages model.medialist_state ]
- SettingsEditor -> [ SettingsEditor.editor settings])
+ SettingsEditor -> [ SettingsEditor.editor settings]
+ Feeds feeds -> [ FeedView.feeds feeds model.new_feed ])
, div [id "sidebar"] [ User.loginView model.loginState
, (sidebarHistory model.titles )
, (case model.view_state of
diff --git a/elm-frontti/src/Message.elm b/elm-frontti/src/Message.elm
index 67837cf..11d383e 100644
--- a/elm-frontti/src/Message.elm
+++ b/elm-frontti/src/Message.elm
@@ -12,6 +12,7 @@ import Browser.Navigation as Nav
import Settings
import Url
import Title
+import Feeds
import Image exposing (Image, ReferencingPost)
import File exposing (File)
@@ -29,6 +30,7 @@ type ViewState
| MediaList -- list all the image blobs in db
| TaggedPostsView (List Article.Article)
| SettingsEditor
+ | Feeds (List Feeds.Feed)
type alias User =
{ username : String
@@ -74,7 +76,8 @@ type alias Model =
, postEditorSettings: Maybe PostEditorSettings
, zone : Time.Zone
, titles : List Article.Title
- , searchedPosts : List Article.PreviousArticle}
+ , searchedPosts : List Article.PreviousArticle
+ , new_feed: Maybe Feeds.NewFeed}
type Msg
= PageReceived (Result Http.Error P.Page)
@@ -142,6 +145,11 @@ type Msg
| LoadPreviouslyPreview Article.PreviousArticle
| PreviousPostReceived (Result Http.Error Article.Article)
| ClosePreviousPostPreviewModal
+ | FeedsReceived (Result Http.Error (List Feeds.Feed))
+ | SetFeedUrl String
+ | SetFeedName String
+ | AddFeed Feeds.NewFeed
+ | FeedAdded (Result Http.Error ())
-- ports
port reallySetupAce : String -> Cmd msg
diff --git a/elm-frontti/src/RouteParser.elm b/elm-frontti/src/RouteParser.elm
index 2ea17a7..e40ea92 100644
--- a/elm-frontti/src/RouteParser.elm
+++ b/elm-frontti/src/RouteParser.elm
@@ -12,7 +12,8 @@ type Route
| PostEditor Int
| TaggedPosts String
| PostVersion Int Int
- | SettingsEditor
+ | SettingsEditor
+ | FeedReader
| Home
| NotFound
@@ -27,7 +28,8 @@ routeParser =
, map MediaManager (s "blog" </> (s "mediamanager"))
, map SettingsEditor (s "blog" </> (s "settings"))
, map TaggedPosts (s "blog" </> (s "tags" </> string))
- , map PostAdmin (s "blog" </> (s "postadmin"))]
+ , map PostAdmin (s "blog" </> (s "postadmin"))
+ , map FeedReader (s "blog" </> (s "feeds"))]
url_to_route url =
Maybe.withDefault NotFound (parse routeParser url)
diff --git a/elm-frontti/src/Topbar.elm b/elm-frontti/src/Topbar.elm
index a8e0993..fe49d1b 100644
--- a/elm-frontti/src/Topbar.elm
+++ b/elm-frontti/src/Topbar.elm
@@ -16,6 +16,7 @@ import Button exposing (murja_button)
topbar_list =
[ li [] [ murja_button [ onClick GoHome, attribute "data-testid" "home"]
[text "Home"]]
+ , li [] [ murja_button [ onClick (PushUrl "/blog/feeds") ] [ text "RSS Feeds" ]]
, li [] [ murja_button [ onClick (PushUrl "/blog/postadmin"), attribute "data-testid" "manage-posts-btn" ]
[text "Manage posts"]]
, li [] [ murja_button [ onClick (PushUrl "/blog/mediamanager")]
diff --git a/resources/css/murja.css b/resources/css/murja.css
index deac910..c3e3c10 100644
--- a/resources/css/murja.css
+++ b/resources/css/murja.css
@@ -285,6 +285,20 @@ header {
font-size: 1.3em;
}
+.feed {
+ list-style: none;
+ width: 100%;
+ margin-bottom: 100px;
+}
+
+.feed-list {
+ display: block;
+}
+
+.feed header {
+ display: block;
+}
+
@media only screen and (max-device-width:480px)
{
body {
diff --git a/resources/sql/020-rss-reader-stuff.sql b/resources/sql/020-rss-reader-stuff.sql
new file mode 100644
index 0000000..034a338
--- /dev/null
+++ b/resources/sql/020-rss-reader-stuff.sql
@@ -0,0 +1,27 @@
+CREATE TABLE IF NOT EXISTS blog.feed_subscription
+(
+ ID UUID PRIMARY KEY DEFAULT gen_random_uuid(),
+ name TEXT NOT NULL,
+ url TEXT NOT NULL,
+ owner INT NOT NULL,
+ FOREIGN KEY (owner) REFERENCES blog.Users(id)
+ on delete cascade
+ on update cascade
+);
+
+CREATE TABLE IF NOT EXISTS blog.feed_item
+(
+ ID UUID PRIMARY KEY DEFAULT gen_random_uuid(),
+ fetched TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP,
+ title TEXT NOT NULL,
+ description TEXT NOT NULL,
+ link TEXT NOT NULL,
+ feed UUID NOT NULL,
+ author TEXT NOT NULL,
+ pubdate TIMESTAMP NOT NULL,
+ FOREIGN KEY (feed) REFERENCES blog.feed_subscription (ID)
+ on delete cascade
+ on update cascade,
+ UNIQUE (link, feed)
+);
+
diff --git a/resources/sql/reader-fns.sql b/resources/sql/reader-fns.sql
new file mode 100644
index 0000000..5bd6af1
--- /dev/null
+++ b/resources/sql/reader-fns.sql
@@ -0,0 +1,31 @@
+-- name: get-user-feeds*
+-- returns: :array-hash
+SELECT fs.id, fs.name, fs.url,
+ json_build_object( 'username',
+ u.Username,
+ 'nickname',
+ u.Nickname,
+ 'img_location',
+ u.Img_location) as "creator"
+FROM blog.feed_subscription fs
+JOIN blog.Users u ON u.ID = fs.owner
+WHERE owner = $1;
+
+-- name: get-all-feeds
+-- returns: :array-hash
+SELECT fs.id, fs.name, fs.url,
+ json_build_object( 'username',
+ u.Username,
+ 'nickname',
+ u.Nickname,
+ 'img_location',
+ u.Img_location) as "creator"
+FROM blog.feed_subscription fs
+JOIN blog.Users u ON u.ID = fs.owner;
+
+-- name: insert-feed @execute
+INSERT INTO blog.feed_subscription(name, url, owner) VALUES ($1, $2, $3);
+
+-- name: insert-feed-item @execute
+INSERT INTO blog.feed_item(title, link, description, author, pubdate, feed)
+VALUES ($1, $2, $3, $4, to_timestamp($5), $6);
diff --git a/src/migration-list.lisp b/src/migration-list.lisp
index 4a4bd61..411322b 100644
--- a/src/migration-list.lisp
+++ b/src/migration-list.lisp
@@ -24,6 +24,7 @@
(defmigration "017-settings-in-db")
(defmigration "018-previously")
(defmigration "019-rss-settings")
+(defmigration "020-rss-reader-stuff")
(defun prepare-e2e-migration ()
(postmodern:execute "DELETE FROM blog.Users")
diff --git a/src/routes/root-routes.lisp b/src/routes/root-routes.lisp
index b10713b..3f586e1 100644
--- a/src/routes/root-routes.lisp
+++ b/src/routes/root-routes.lisp
@@ -118,3 +118,6 @@
(defroute ddddddd ("/blog/page/:page" :method :get) ()
*root*)
+
+(defroute sdfdsfopsf ("/blog/feeds" :method :get) ()
+ *root*)
diff --git a/src/routes/rss-reader-routes.lisp b/src/routes/rss-reader-routes.lisp
new file mode 100644
index 0000000..25ce0b7
--- /dev/null
+++ b/src/routes/rss-reader-routes.lisp
@@ -0,0 +1,38 @@
+(defpackage murja.routes.rss-reader-routes
+ (:use :cl)
+ (:import-from :easy-routes :defroute)
+ (:import-from :com.inuoe.jzon :stringify :parse)
+ (:import-from :murja.middleware.db :@transaction)
+ (:import-from :murja.middleware.auth :@authenticated :*user* :@can?)
+ (:import-from :murja.middleware.json :@json)
+ (:import-from :murja.rss.reader-db :update-feeds :get-user-feeds :subscribe-to-feed))
+
+(in-package :murja.routes.rss-reader-routes)
+
+(defroute user-feeds-route ("/api/user/feeds"
+ :method :get
+ :decorators (@json
+ @transaction
+ @authenticated)) ()
+ (assert (not (null *user*)))
+ (assert (not (null (gethash "id" *user*))))
+
+ (let ((feeds (or (get-user-feeds (gethash "id" *user*)) #())))
+ (com.inuoe.jzon:stringify feeds)))
+
+(defroute user-feeds-saving ("/api/user/feeds"
+ :method :post
+ :decorators (@transaction @authenticated)) ()
+ (let* ((request-body (parse (hunchentoot:raw-post-data :force-text t)))
+ (name (gethash "name" request-body))
+ (url (gethash "url" request-body)))
+ (assert (not (null *user*)))
+ (subscribe-to-feed name url *user*)
+ (setf (hunchentoot:return-code*) 204)
+ ""))
+
+;; This will be called by cron/curl
+(defroute update-feeds-rotue ("/api/rss/update" :method :get) ()
+ (update-feeds)
+ (setf (hunchentoot:return-code*) 204)
+ "")
diff --git a/src/rss/reader-db.lisp b/src/rss/reader-db.lisp
new file mode 100644
index 0000000..39b4d7b
--- /dev/null
+++ b/src/rss/reader-db.lisp
@@ -0,0 +1,82 @@
+(defpackage murja.rss.reader-db
+ (:use :cl :postmodern :binding-arrows)
+ (:import-from :halisql :defqueries)
+ (:import-from :lisp-fixup :partial)
+ (:import-from :cl-date-time-parser :parse-date-time)
+ (:export :get-user-feeds :subscribe-to-feed))
+
+(in-package :murja.rss.reader-db)
+
+(defqueries "reader-fns")
+
+(defun parse (key hashmap)
+ (setf (gethash key hashmap)
+ (com.inuoe.jzon:parse (gethash key hashmap)))
+ hashmap)
+
+(defun get-user-feeds (user-id)
+ (let ((feeds (coerce (get-user-feeds* user-id) 'list)))
+ (mapcar (partial #'parse "creator") feeds)))
+
+(defun subscribe-to-feed (feed-name feed-url owner)
+ (insert-feed feed-name feed-url (gethash "id" owner)))
+
+(defun download (url)
+ "Drakma decides to return either strings or array<byte>s based on random
+(can't find the documentation about this logic) whims. This function performs
+the http-request through drakma, checks which is returned, and in case of array<byte>s,
+pipes it through trivial-utf-8:utf-8-bytes-to-string"
+ (let ((result (drakma:http-request url)))
+ (if (and (arrayp result)
+ (not (stringp result)))
+ (trivial-utf-8:utf-8-bytes-to-string result)
+ result)))
+
+;; (setf drakma:*header-stream* *standard-output*)
+(defun get-child-item-value (name children)
+ (some->>
+ children
+ (remove-if-not (lambda (node)
+ (string= (xmls:node-name node)
+ name)))
+ first
+ xmls:node-children
+ first))
+
+(defun update-feed (feed)
+ (let* ((url (gethash "url" feed))
+ (feed-id (gethash "id" feed))
+ (feed-contents (download url))
+ (feed-parsed (xmls:parse feed-contents))
+ (channel (first (xmls:node-children feed-parsed))))
+ (dolist (item (remove-if-not (lambda (item)
+ (string= (xmls:node-name item) "item"))
+ (xmls:node-children channel)))
+ (let ((title (or (get-child-item-value "title" (xmls:node-children item)) ""))
+ (link (get-child-item-value "link" (xmls:node-children item)))
+ (description (get-child-item-value "description" (xmls:node-children item)))
+ (author (or
+ (get-child-item-value "author" (xmls:node-children item))
+ ;; author seems to be optional value, let's get title from <channel> if missing
+ (get-child-item-value "title" (xmls:node-children channel))))
+ (pubDate (parse-date-time (get-child-item-value "pubDate" (xmls:node-children item)))))
+ (insert-feed-item title link description author pubDate feed-id)))))
+
+(defun current-hour ()
+ (multiple-value-bind (second minute hour) (decode-universal-time (get-universal-time))
+ hour))
+
+(defun current-minute ()
+ (multiple-value-bind (second minute hour) (decode-universal-time (get-universal-time))
+ hour))
+
+(defvar *last-updated* nil)
+
+(defun update-feeds ()
+ (when (or (not *last-updated*)
+ ;; hourly rate limit
+ (> (- (current-hour) *last-updated*) 1))
+ (dolist (feed (coerce (get-all-feeds) 'list))
+ (update-feed feed))
+
+ (setf *last-updated* (current-hour))))