fixed some database calls to be more generic

Mast3rwaf1z · Mast3rwaf1z · commit e151aedc41cc · 2024-11-06T22:09:24.000+01:00
diff --git a/app/Api/Api.hs b/app/Api/Api.hs
@@ -2,7 +2,7 @@
 
 module Api.Api where
 
-import Database.Database (getGuestbook, getVisits, runDb, uuidExists, validateToken, AdminTable (getData))
+import Database.Database (runDb, AdminTable (getData), toList, validateToken)
 import Pages.Projects.Brainfuck (code)
 import qualified Tables as T (Credentials (Credentials, EmptyCredentials), GuestbookEntry (EmptyGuestbook, GuestbookEntry), LeaderboardEntry (EmptyLeaderboard, LeaderboardEntry))
 import Utils (getDefault, unpackBS)
@@ -23,8 +23,8 @@ import Data.ByteString.Lazy (fromStrict, toStrict)
 import Data.Password.Bcrypt (PasswordCheck (PasswordCheckFail, PasswordCheckSuccess), PasswordHash (PasswordHash), checkPassword, mkPassword)
 import Data.Text (intercalate, pack, unpack, Text)
 import Data.Text.Array (Array (ByteArray))
-import Database.Persist (Entity (Entity), Filter (Filter), FilterValue (FilterValue), PersistFilter (BackendSpecificFilter), insertEntity, selectList, PersistQueryWrite (deleteWhere), (==.))
-import Database.Schema (EntityField (TokenName, UserName, UserIndex, VisitIndex, GuestbookEntryIndex, SnakeIndex, TokenIndex), GuestbookEntry (GuestbookEntry, guestbookEntryContent, guestbookEntryName, guestbookEntryParentId, guestbookEntryIndex, guestbookEntryTimestamp), Snake (Snake), Token (Token, tokenToken), User (User, userName, userPassword), Visit (Visit))
+import Database.Persist (Entity (Entity), Filter (Filter), FilterValue (FilterValue), PersistFilter (BackendSpecificFilter), insertEntity, selectList, PersistQueryWrite (deleteWhere), (==.), (=.))
+import Database.Schema (EntityField (TokenName, UserName, UserIndex, VisitIndex, GuestbookEntryIndex, SnakeIndex, TokenIndex, VisitUuid, TokenToken), GuestbookEntry (GuestbookEntry, guestbookEntryContent, guestbookEntryName, guestbookEntryParentId, guestbookEntryIndex, guestbookEntryTimestamp), Snake (Snake), Token (Token, tokenToken), User (User, userName, userPassword), Visit (Visit))
 import Logger (info)
 import Text.StringRandom (stringRandomIO)
 
@@ -63,7 +63,7 @@ apiMap = [
     ("POST", [
         ("^/visits/new(/|)$", \r -> do
             body <- getRequestBodyChunk r
-            result <- uuidExists $ unpackBS body
+            result <- null <$> getData [VisitUuid ==. unpackBS body] []
             res <- if result then do
                 time <- fmap round getPOSIXTime :: IO Int
                 uuid <- nextRandom
@@ -79,7 +79,7 @@ apiMap = [
             case credentials of
                 (T.Credentials username password) -> do
                     let pass = mkPassword $ pack password
-                    rows <- getData [UserName ==. username]
+                    rows <- getData [UserName ==. username] []
                     case rows of
                         [user] -> case checkPassword pass (PasswordHash $ pack (userPassword user)) of
                             PasswordCheckSuccess -> do
@@ -117,12 +117,13 @@ apiMap = [
             return (status200, j2s [aesonQQ|#{apiData}|], jsonHeaders)
         ),
         ("^/visits/get(/|)$", \_ -> do
-            visits <- show . length <$> getVisits
+            visits <- show . length <$> (getData [] [] :: IO [Visit])
             return (status200, j2s [aesonQQ|{"visits":#{visits}}|], jsonHeaders)
         ),
         ("^/guestbook/get(/|)$", \_ -> do
-            entries <- getGuestbook
-            return (status200, j2s [aesonQQ|{"entries":#{unpackBS $ toStrict $ encode $ show entries}}|], jsonHeaders)
+            entries <- getData [] [] :: IO [GuestbookEntry]
+            let l = map toList entries
+            return (status200, j2s [aesonQQ|{"entries":#{l}}|], jsonHeaders)
         ),
         ("^/editor/sidebar(/|)$", \_ -> do
             editor_root <- getEditorRoot
diff --git a/app/Index.hs b/app/Index.hs
@@ -4,12 +4,12 @@ import IHP.HSX.QQ (hsx)
 import Text.Blaze.Html (Html)
 
 import CodeBlock (hsxIntroCodeBlock, introCodeIndex)
-import Database.Database (getVisits, AdminTable (getData))
+import Database.Database (AdminTable (getData))
 import Layout (layout)
 import Page (Page, PageSetting (Description, EmbedImage, EmbedText, Route))
 import Section (section)
 import Database.Schema (EntityField(VisitTimestamp), Visit (Visit, visitTimestamp))
-import Database.Persist ((>.))
+import Database.Persist ((>.), SelectOpt (LimitTo, Asc, Desc))
 
 intro :: Html
 intro = section [hsx|
@@ -42,9 +42,10 @@ intro = section [hsx|
 
 page :: IO Html
 page = do
-    visits <- show . length <$> getVisits
-    lastVisit <- foldr max 0 <$> fmap (map visitTimestamp) (getData [] :: IO [Visit])
-    visitsToday <- show . length <$> getData [VisitTimestamp >. lastVisit-(24*60*60)]
+    visits <- show . length <$> (getData [] [] :: IO [Visit])
+    lastVisit <- visitTimestamp . head <$> getData [] [Desc VisitTimestamp, LimitTo 1]
+    print lastVisit
+    visitsToday <- show . length <$> getData [VisitTimestamp >. lastVisit-(24*60*60)] []
     return [hsx|
         <h1>Skademaskinen</h1>
         <img src="/static/icon.png" style="border-radius:50%">
diff --git a/app/Pages/Admin/Admin.hs b/app/Pages/Admin/Admin.hs
@@ -2,7 +2,7 @@ module Pages.Admin.Admin where
 
 import CodeBlock (codeBlock)
 import Data.Text (Text, unpack, pack)
-import Database.Database (getGuestbookEntries, getLeaderboard, getTokens, getUsers, getVisits, prettyPrintSchema, tokenToUsername, validateToken, runDb, AdminTable (button, toList, getData))
+import Database.Database (prettyPrintSchema, validateToken, runDb, AdminTable (button, toList, getData))
 import Database.Schema (GuestbookEntry (GuestbookEntry, guestbookEntryIndex), Snake (Snake, snakeIndex), Token (Token, tokenIndex), User (User, userIndex), Visit (Visit, visitIndex), defs, EntityField (UserName, TokenToken))
 import IHP.HSX.QQ (hsx)
 import Layout (layout)
@@ -16,11 +16,11 @@ import Logger (warning)
 
 panel :: IO Html
 panel = do 
-    visits <- getData [] :: IO [Visit]
-    guestbook <- getData [] :: IO [GuestbookEntry]
-    snake <- getData [] :: IO [Snake]
-    users <- getData [] :: IO [User]
-    valid_tokens <- getData [] :: IO [Token]
+    visits <- getData [] [] :: IO [Visit]
+    guestbook <- getData [] [] :: IO [GuestbookEntry]
+    snake <- getData [] [] :: IO [Snake]
+    users <- getData [] [] :: IO [User]
+    valid_tokens <- getData [] [] :: IO [Token]
     return [hsx|
         Here are actions when logged in
         <br>
@@ -89,23 +89,23 @@ browse table = do
     where
         getTableData :: String -> IO [([String], Html)]
         getTableData "visits" = do
-            tableData <- getData [] :: IO [Visit]
+            tableData <- getData [] []:: IO [Visit]
             let columnNames = getColumnNames "visits"
             return $ zip (map toList tableData) (map button tableData)
         getTableData "guestbook" = do
-            tableData <- getData [] :: IO [GuestbookEntry]
+            tableData <- getData [] [] :: IO [GuestbookEntry]
             let columnNames = getColumnNames "guestbook"
             return $ zip (map toList tableData) (map button tableData)
         getTableData "snake" = do
-            tableData <- getData [] :: IO [Snake]
+            tableData <- getData [] [] :: IO [Snake]
             let columnNames = getColumnNames "snake"
             return $ zip (map toList tableData) (map button tableData)
         getTableData "users" = do 
-            tableData <- getData [] :: IO [User]
+            tableData <- getData [] [] :: IO [User]
             let columnNames = getColumnNames "users"
             return $ zip (map toList tableData) (map button tableData)
         getTableData "valid_tokens" = do
-            tableData <- getData [] :: IO [Token]
+            tableData <- getData [] [] :: IO [Token]
             let columnNames = getColumnNames "valid_tokens"
             return $ zip (map toList tableData) (map button tableData)
         getTableData _ = do
diff --git a/app/Pages/Guestbook/Guestbook.hs b/app/Pages/Guestbook/Guestbook.hs
@@ -3,7 +3,6 @@ module Pages.Guestbook.Guestbook where
 import IHP.HSX.QQ (hsx)
 import Text.Blaze.Html (Html)
 
-import Database.Database (getGuestbook)
 import Section (section)
 
 import Data.List (filter)
@@ -14,6 +13,7 @@ import Database.Schema (GuestbookEntry (GuestbookEntry))
 import Layout (layout)
 import Page (Page, PageSetting (Description, Route))
 import Tree (Tree (Tree))
+import Database.Database (AdminTable(getData))
 
 type Guestbook = [(Int, Int, String, String, Int)]
 
@@ -60,6 +60,16 @@ guestbookInput parent True = [hsx|
     </div>
 |]
 
+guestbookToTree :: [GuestbookEntry] -> Int -> [Tree GuestbookEntry]
+guestbookToTree entries targetParent = [Tree (GuestbookEntry id timestamp name content parent) $ guestbookToTree entries id | (GuestbookEntry id timestamp name content parent) <- entries, parent == targetParent]
+
+getGuestbook :: IO [Tree GuestbookEntry]
+getGuestbook = do
+    entries <- getData [] [] :: IO [GuestbookEntry]
+    return $ guestbookToTree entries (-1)
+
+
+page :: IO Html
 page = do
     guestbook <- getGuestbook
     return [hsx|
diff --git a/app/Pages/Projects/Snake.hs b/app/Pages/Projects/Snake.hs
@@ -3,11 +3,11 @@ module Pages.Projects.Snake where
 import IHP.HSX.QQ (hsx)
 import Text.Blaze.Html (Html)
 
-import Database.Database (getLeaderboard)
 import Database.Schema (Snake (Snake))
 import Layout (layout)
 import Page (Page, PageSetting (Description, Route))
 import Utils (forEach)
+import Database.Database (AdminTable(getData))
 
 tile :: Int -> Html
 tile id = [hsx|
@@ -98,7 +98,7 @@ leaderboardEntry (Snake id timestamp name score speed fruits) = [hsx|
 
 page :: IO Html
 page = do
-    l <- getLeaderboard
+    l <- getData [] [] :: IO [Snake]
     return [hsx|
         <table class="common-table">
             <tr>
diff --git a/lib/Database/Database.hs b/lib/Database/Database.hs
@@ -8,10 +8,10 @@ import Settings (getDatabaseName, getDatabaseUser)
 import Control.Monad.Logger (NoLoggingT (runNoLoggingT))
 import Data.List (inits, intercalate)
 import Data.Text (Text, pack, unpack)
-import Database.Persist.MySQL (ConnectInfo (ConnectInfo, connectDatabase, connectUser), Entity (Entity), EntityNameDB (unEntityNameDB), FieldDef (FieldDef), FieldNameHS (unFieldNameHS), Filter (Filter), FilterValue (FilterValue), PersistFilter (BackendSpecificFilter), PersistStoreWrite (insert_), SqlPersistT, defaultConnectInfo, fieldDBName, getEntityDBName, getEntityFields, runMigration, runSqlConn, selectList, withMySQLConn)
+import Database.Persist.MySQL (ConnectInfo (ConnectInfo, connectDatabase, connectUser), Entity (Entity), EntityNameDB (unEntityNameDB), FieldDef (FieldDef), FieldNameHS (unFieldNameHS), Filter (Filter), FilterValue (FilterValue), PersistFilter (BackendSpecificFilter), PersistStoreWrite (insert_), SqlPersistT, defaultConnectInfo, fieldDBName, getEntityDBName, getEntityFields, runMigration, runSqlConn, selectList, withMySQLConn, SelectOpt)
 import Database.Persist.TH (mkMigrate, mkPersist, persistLowerCase, share, sqlSettings)
 import Database.Persist.Types (EntityDef, FieldDef (fieldSqlType), fieldHaskell)
-import Database.Persist ((==.))
+import Database.Persist ((==.), (=.))
 import Database.Schema (EntityField (TokenToken, VisitUuid), GuestbookEntry (GuestbookEntry, guestbookEntryIndex), Snake (Snake, snakeIndex), Token (tokenName, tokenToken, Token, tokenIndex), User (userName, User, userIndex), Visit (Visit, visitIndex), defs, migrateAll)
 import Logger (info)
 import Tree (Tree (Tree))
@@ -34,53 +34,8 @@ runDb cmd = do
 doMigration :: IO ()
 doMigration = runDb $ runMigration migrateAll
 
--- utils
-guestbookToTree :: [GuestbookEntry] -> Int -> [Tree GuestbookEntry]
-guestbookToTree entries targetParent = [Tree (GuestbookEntry id timestamp name content parent) $ guestbookToTree entries id | (GuestbookEntry id timestamp name content parent) <- entries, parent == targetParent]
-
 -- getters
 
-getVisits :: IO [Visit]
-getVisits = do
-    visits <- runDb $ selectList [] []
-    return $ map (\(Entity _ u) -> u) visits
-
-getGuestbook :: IO [Tree GuestbookEntry]
-getGuestbook = do
-    entries <- runDb $ selectList [] [] :: IO [Entity GuestbookEntry]
-    return $ guestbookToTree (map (\(Entity _ entry) -> entry) entries) (-1)
-
-getGuestbookEntries :: IO [GuestbookEntry]
-getGuestbookEntries = do
-    entries <- runDb $ selectList [] []
-    return $ map (\(Entity _ e) -> e) entries
-
-getLeaderboard :: IO [Snake]
-getLeaderboard = do
-    entries <- runDb $ selectList [] []
-    return $ map (\(Entity _ e) -> e) entries
-
-getUsers :: IO [User]
-getUsers = do
-    entries <- runDb $ selectList [] []
-    return $ map (\(Entity _ e) -> e) entries
-
-getTokens :: IO [Token]
-getTokens = do
-    entries <- runDb $ selectList [] []
-    return $ map (\(Entity _ e) -> e) entries
-
-uuidExists :: String -> IO Bool
-uuidExists uuid = do
-    visits <- runDb $ selectList [VisitUuid ==. uuid] [] :: IO [Entity Visit]
-    print visits
-    return (null visits)
-
-tokenToUsername :: String -> IO String
-tokenToUsername token = do
-    (Entity _ token : _) <- runDb $ selectList [TokenToken ==. token] []
-    return $ tokenName token
-
 -- schema
 prettyPrintSchema :: String
 prettyPrintSchema =
@@ -95,29 +50,29 @@ prettyPrintSchema =
         fieldType field = show $ fieldSqlType field
 
 validateToken :: String -> IO Bool
-validateToken token = any (\x -> tokenToken x == token) <$> getTokens
+validateToken token = any (\x -> tokenToken x == token) <$> (getData [] [] :: IO [Token])
 
 class AdminTable a where
     toList :: a -> [String]
     button :: a -> Html
-    getData :: [Filter a] -> IO [a] 
+    getData :: [Filter a] -> [SelectOpt a] -> IO [a] 
 instance AdminTable Visit where
     toList (Visit rid timestamp uuid) = [show rid, show timestamp, uuid]
     button a = [hsx|<button id={"visits::"++(show $ visitIndex a)} onclick="delete_row(this.id)">Delete</button>|]
-    getData f = map (\(Entity _ e) -> e) <$> runDb (selectList f []) :: IO [Visit]  
+    getData f o = map (\(Entity _ e) -> e) <$> runDb (selectList f o) :: IO [Visit]  
 instance AdminTable GuestbookEntry where
     toList (GuestbookEntry rid timestamp name content parentId) = [show rid, show timestamp, name, content, show parentId]
     button a = [hsx|<button id={"guestbook::"++(show $ guestbookEntryIndex a)} onclick="delete_row(this.id)">Delete</button>|]
-    getData f = map (\(Entity _ e) -> e) <$> runDb (selectList f []) :: IO [GuestbookEntry] 
+    getData f o = map (\(Entity _ e) -> e) <$> runDb (selectList f o) :: IO [GuestbookEntry] 
 instance AdminTable Snake where
     toList (Snake rid timestamp name score speed fruits) = [show rid, show timestamp, name, show score, show speed, show fruits]
     button a = [hsx|<button id={"snake::"++(show $ snakeIndex a)} onclick="delete_row(this.id)">Delete</button>|]
-    getData f = map (\(Entity _ e) -> e) <$> runDb (selectList f []) :: IO [Snake] 
+    getData f o = map (\(Entity _ e) -> e) <$> runDb (selectList f o) :: IO [Snake] 
 instance AdminTable User where
     toList (User rid name password) = [show rid, name, password]
-    button a = [hsx||<button id={"users::"++(show $ userIndex a)} onclick="delete_row(this.id)">Delete</button>|]
-    getData f = map (\(Entity _ e) -> e) <$> runDb (selectList f []) :: IO [User] 
+    button a = [hsx|<button id={"users::"++(show $ userIndex a)} onclick="delete_row(this.id)">Delete</button>|]
+    getData f o = map (\(Entity _ e) -> e) <$> runDb (selectList f o) :: IO [User] 
 instance AdminTable Token where
     toList (Token rid token name) = [show rid, token, name]
     button a = [hsx|<button id={"valid_tokens::"++(show $ tokenIndex a)} onclick="delete_row(this.id)">Delete</button>|]
-    getData f = map (\(Entity _ e) -> e) <$> runDb (selectList f []) :: IO [Token] 
+    getData f o = map (\(Entity _ e) -> e) <$> runDb (selectList f o) :: IO [Token] 
diff --git a/lib/Database/Schema.hs b/lib/Database/Schema.hs
@@ -20,32 +20,32 @@ import Database.Persist.TH (mkEntityDefList, mkMigrate, mkPersist, persistLowerC
 
 share [mkPersist sqlSettings, mkMigrate "migrateAll", mkEntityDefList "defs"] [persistLowerCase|
     Visit                                   sql=visits
-        index                      Int         sql=id
+        index                   Int         sql=id
         timestamp               Int         sql=timestamp
         uuid                    String      sql=uuid
         deriving Eq Show
     GuestbookEntry                          sql=guestbook
-        index                      Int         sql=id
+        index                   Int         sql=id
         timestamp               Int         sql=timestamp
         name                    String      sql=name
         content                 String      sql=content
         parentId                Int         sql=parentId
         deriving Eq Show
     Snake                                   sql=snake
-        index                      Int         sql=id
+        index                   Int         sql=id
         timestamp               Int         sql=timestamp
         name                    String      sql=name
         score                   Int         sql=score
         speed                   Int         sql=speed
         fruits                  Int         sql=fruits
         deriving Eq Show
     User                                    sql=users
-        index                      Int         sql=id
+        index                   Int         sql=id
         name                    String      sql=username
         password                String      sql=password
         deriving Eq Show
     Token                                   sql=valid_tokens
-        index                      Int         sql=id
+        index                   Int         sql=id
         token                   String      sql=token
         name                    String      sql=username
         deriving Eq Show
