Add caching functions to the database
Getty Ritter
6 years ago
| 4 | 4 | |
| 5 | 5 | import Control.Monad (forM) |
| 6 | 6 | 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 | |
| 8 | 9 | import qualified Data.Time as Time |
| 9 | 10 | |
| 10 | 11 | import qualified Inf.DB.Monad as DB |
| 12 | 13 | |
| 13 | 14 | submitPost :: User -> RawPost -> DB.DB () |
| 14 | 15 | 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) | |
| 16 | 18 | DB.execute |
| 17 | 19 | "UPDATE posts \ |
| 18 | 20 | \ SET title = ?, author = ?, contents = ? \ |
| 27 | 29 | now <- DB.io Time.getCurrentTime |
| 28 | 30 | prev <- fmap (fmap DB.fromOnly) (DB.queryMb "SELECT id FROM posts ORDER BY time DESC LIMIT 1" []) |
| 29 | 31 | DB.execute |
| 30 |
|
|
| 32 | "INSERT INTO posts \ | |
| 31 | 33 | \ (title, contents, author, time, next, prev) \ |
| 32 | 34 | \ VALUES (?, ?, ?, ?, ?, ?)" |
| 33 | 35 | [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)] |
| 114 | 116 | vals <- DB.queryOne "SELECT id FROM posts ORDER BY time ASC LIMIT 1" [] |
| 115 | 117 | postRefById (DB.fromOnly vals) |
| 116 | 118 | |
| 117 |
staticPage :: T |
|
| 119 | staticPage :: TS.Text -> DB.DB Page | |
| 118 | 120 | staticPage name = do |
| 119 | 121 | pg <- DB.queryMb "SELECT title, contents FROM pages WHERE slug = ?" |
| 120 | 122 | [DB.f name] |
| 147 | 149 | ] |
| 148 | 150 | |
| 149 | 151 | |
| 150 |
postByDateAndSlug :: T |
|
| 152 | postByDateAndSlug :: TS.Text -> TS.Text -> TS.Text -> DB.DB Post | |
| 151 | 153 | postByDateAndSlug year month slug = do |
| 152 | 154 | values <- DB.queryMb |
| 153 | 155 | "SELECT post_id FROM lookup WHERE year = ? AND month = ? AND slug = ?" |
| 176 | 178 | } |
| 177 | 179 | |
| 178 | 180 | |
| 179 |
userAuthData :: T |
|
| 181 | userAuthData :: TS.Text -> DB.DB (Maybe BS.ByteString) | |
| 180 | 182 | userAuthData user = |
| 181 | 183 | fmap DB.fromOnly <$> |
| 182 | 184 | DB.queryMb "SELECT password FROM snap_auth_user WHERE login = ?" |
| 183 | 185 | [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] | |