gdritter repos new-inf-blog / e83fc1a
Add caching functions to the database Getty Ritter 5 years ago
1 changed file(s) with 26 addition(s) and 6 deletion(s). Collapse all Expand all
44
55 import Control.Monad (forM)
66 import qualified Data.ByteString as BS
7 import qualified Data.Text as T
7 import qualified Data.Text as TS
8 import qualified Data.Text.Lazy as T
89 import qualified Data.Time as Time
910
1011 import qualified Inf.DB.Monad as DB
1213
1314 submitPost :: User -> RawPost -> DB.DB ()
1415 submitPost uname rp = case rpId rp of
15 Just (PostId n) | uname == rpAuthor rp ->
16 Just (PostId n) | uname == rpAuthor rp -> do
17 invalidateCachedMarkup (PostId n)
1618 DB.execute
1719 "UPDATE posts \
1820 \ SET title = ?, author = ?, contents = ? \
2729 now <- DB.io Time.getCurrentTime
2830 prev <- fmap (fmap DB.fromOnly) (DB.queryMb "SELECT id FROM posts ORDER BY time DESC LIMIT 1" [])
2931 DB.execute
30 "INSERT INTO posts \
32 "INSERT INTO posts \
3133 \ (title, contents, author, time, next, prev) \
3234 \ VALUES (?, ?, ?, ?, ?, ?)"
3335 [DB.f (rpTitle rp), DB.f (rpContents rp), DB.f (rpAuthor rp), DB.f now, DB.f (Nothing :: Maybe Int), DB.f (prev :: Maybe Int)]
114116 vals <- DB.queryOne "SELECT id FROM posts ORDER BY time ASC LIMIT 1" []
115117 postRefById (DB.fromOnly vals)
116118
117 staticPage :: T.Text -> DB.DB Page
119 staticPage :: TS.Text -> DB.DB Page
118120 staticPage name = do
119121 pg <- DB.queryMb "SELECT title, contents FROM pages WHERE slug = ?"
120122 [DB.f name]
147149 ]
148150
149151
150 postByDateAndSlug :: T.Text -> T.Text -> T.Text -> DB.DB Post
152 postByDateAndSlug :: TS.Text -> TS.Text -> TS.Text -> DB.DB Post
151153 postByDateAndSlug year month slug = do
152154 values <- DB.queryMb
153155 "SELECT post_id FROM lookup WHERE year = ? AND month = ? AND slug = ?"
176178 }
177179
178180
179 userAuthData :: T.Text -> DB.DB (Maybe BS.ByteString)
181 userAuthData :: TS.Text -> DB.DB (Maybe BS.ByteString)
180182 userAuthData user =
181183 fmap DB.fromOnly <$>
182184 DB.queryMb "SELECT password FROM snap_auth_user WHERE login = ?"
183185 [DB.f user]
186
187
188 cachedMarkup :: PostId -> DB.DB (Maybe T.Text)
189 cachedMarkup pId = do
190 fmap DB.fromOnly <$>
191 DB.queryMb
192 "SELECT prerendered FROM postcache WHERE post_id = ?"
193 [DB.f pId]
194
195 storeCachedMarkup :: PostId -> T.Text -> DB.DB ()
196 storeCachedMarkup pId prerendered = do
197 DB.execute
198 "INSERT INTO postcache (prerendered, post_id) VALUES (?, ?)"
199 [DB.f prerendered, DB.f pId]
200
201 invalidateCachedMarkup :: PostId -> DB.DB ()
202 invalidateCachedMarkup pId = do
203 DB.execute "DELETE FROM postcache WHERE post_id = ?" [DB.f pId]