Compare commits

...

2 commits

Author SHA1 Message Date
20ce55f22a Merge branch 'main' of git.stuce.ch:stuce/sTodo 2025-06-25 17:03:08 +01:00
81ca02948b qol improvements 2025-06-25 17:03:00 +01:00
2 changed files with 56 additions and 24 deletions

View file

@ -16,8 +16,11 @@
/check/group/#GroupId/todolist/#TodolistId/#TodolistItemId CheckTodolistItemR POST /check/group/#GroupId/todolist/#TodolistId/#TodolistItemId CheckTodolistItemR POST
/edit/group/#GroupId/todolist/#TodolistId EditTodolistItemsR GET POST /edit/group/#GroupId/todolist/#TodolistId EditTodolistItemsR GET POST
/sort/group/#GroupId/todolist/#TodolistId SortTodolistItemsR POST
/trim/group/#GroupId/todolist/#TodolistId TrimTodolistItemsR POST
/edit/group/#GroupId EditTodolistR GET POST /edit/group/#GroupId EditTodolistR GET POST
/adduser/group/#GroupId AddUserR POST
/edit EditGroupR GET POST /edit EditGroupR GET POST
/delete DeleteGroupR POST /delete DeleteGroupR POST

View file

@ -12,6 +12,7 @@ module Handler.TodoEntry where
import Import import Import
import Text.Read import Text.Read
import Database.Persist.Sql (rawExecute, fromSqlKey, toSqlKey) import Database.Persist.Sql (rawExecute, fromSqlKey, toSqlKey)
import GHC.RTS.Flags (TraceFlags(user))
-- TODO: move this back to another handler -- TODO: move this back to another handler
getHomeR :: Handler Html getHomeR :: Handler Html
getHomeR = do getHomeR = do
@ -71,12 +72,21 @@ getTodolistR groupId = do
$maybe token <- mToken $maybe token <- mToken
<input type="hidden" name="_token" value="#{token}"> <input type="hidden" name="_token" value="#{token}">
<button type="submit">add <button type="submit">add
<form action=@{AddUserR groupId} method="post">
<input type="text" name="user" placeholder="new user">
$maybe token <- mToken
<input type="hidden" name="_token" value="#{token}">
<button type="submit">share
<a href=@{EditTodolistR groupId}>Edit <a href=@{EditTodolistR groupId}>Edit
|] |]
getTodolistItemsR :: GroupId -> TodolistId -> Handler Html getTodolistItemsR :: GroupId -> TodolistId -> Handler Html
getTodolistItemsR groupId todolistId = do getTodolistItemsR groupId todolistId = do
items <- dbIfAuth groupId (selectList [TodolistItemTodolistId ==. todolistId] []) mSortOption <- lookupSession "sort"
items <- case mSortOption of
(Just "value") -> dbIfAuth groupId (selectList [TodolistItemTodolistId ==. todolistId] [Desc TodolistItemValue, Asc TodolistItemId])
_ -> dbIfAuth groupId (selectList [TodolistItemTodolistId ==. todolistId] [Asc TodolistItemId])
mToken <- fmap reqToken getRequest mToken <- fmap reqToken getRequest
defaultLayout $ do defaultLayout $ do
setTitle "items" setTitle "items"
@ -97,7 +107,15 @@ getTodolistItemsR groupId todolistId = do
$maybe token <- mToken $maybe token <- mToken
<input type="hidden" name="_token" value="#{token}"> <input type="hidden" name="_token" value="#{token}">
<button type="submit">add <button type="submit">add
<a href=@{EditTodolistItemsR groupId todolistId}>Edit list <form action=@{TrimTodolistItemsR groupId todolistId} method="post">
$maybe token <- mToken
<input type="hidden" name="_token" value="#{token}">
<button type="submit">trim
<form action=@{SortTodolistItemsR groupId todolistId} method="post">
$maybe token <- mToken
<input type="hidden" name="_token" value="#{token}">
<button type="submit">sort
<a href=@{EditTodolistItemsR groupId todolistId}>Edit
|] |]
@ -132,11 +150,14 @@ getEditTodolistItemsR groupId todolistId = do
|] |]
postEditTodolistItemsR :: GroupId -> TodolistId -> Handler Html postEditTodolistItemsR :: GroupId -> TodolistId -> Handler Html
postEditTodolistItemsR groupId todolistId = do postEditTodolistItemsR groupId todolistId = do
text <- runInputPost $ ireq textField "text" mText <- runInputPost $ iopt textField "text"
let xs = getItems text todolistId let xs = case mText of
(Just text) -> getItems text todolistId
Nothing -> []
dbIfAuth groupId (do dbIfAuth groupId (do
deleteWhere [TodolistItemTodolistId ==. todolistId] deleteWhere [TodolistItemTodolistId ==. todolistId]
insertMany_ xs) insertMany_ xs)
redirect $ TodolistItemsR groupId todolistId redirect $ TodolistItemsR groupId todolistId
getEditTodolistR :: GroupId -> Handler Html getEditTodolistR :: GroupId -> Handler Html
@ -206,10 +227,15 @@ postDeleteGroupR = do
text <- lookupPostParams "ids" text <- lookupPostParams "ids"
let ints = map (read . unpack) text :: [Int64] let ints = map (read . unpack) text :: [Int64]
let ids = map toSqlKey ints :: [GroupId] let ids = map toSqlKey ints :: [GroupId]
-- TODO: make sure the user has access to it aswell (this only works now for single user) -- TODO: make sure the user has access to it aswell (this only works now for single user), and handle group owned by many
runDB $ deleteWhere [GroupId <-. ids] runDB $ deleteWhere [GroupId <-. ids]
redirect EditGroupR redirect EditGroupR
postAddUserR :: GroupId -> Handler Html
postAddUserR groupId= do
-- DB action
redirect $ TodolistR groupId
getText :: Entity TodolistItem -> Text getText :: Entity TodolistItem -> Text
getText item = getText item =
if value then "[x] " <> name if value then "[x] " <> name
@ -231,29 +257,32 @@ getItems text todolistId = map read (lines text)
"" -> error "empty name" "" -> error "empty name"
something -> filter (/= '\r') something something -> filter (/= '\r') something
TodolistItem todolistId value name TodolistItem todolistId value name
postTrimTodolistItemsR :: GroupId -> TodolistId -> Handler Html
postTrimTodolistItemsR groupId todolistId = do
dbIfAuth groupId (deleteWhere [TodolistItemTodolistId ==. todolistId, TodolistItemValue ==. True])
redirect $ TodolistItemsR groupId todolistId
postSortTodolistItemsR :: GroupId -> TodolistId -> Handler Html
postSortTodolistItemsR groupId todolistId = do
mSession <- lookupSession "sort"
case mSession of
(Just "value") -> setSession "sort" "id"
_ -> setSession "sort" "value"
redirect $ TodolistItemsR groupId todolistId
-- TODO: complete implementation should short circuit if multi user is on but no user exist -- TODO: complete implementation should short circuit if multi user is on but no user exist
getUserId :: HandlerFor App (Key User)
-- getUserId :: Handler (Key User)
-- getUserId = do
-- mUser <- runDB $ getBy $ UniqueName "Stuce"
-- case mUser of
-- Nothing -> runDB $ insert $ User "Stuce"
-- Just u -> return $ entityKey u
-- TODO: use yesodAuth and clean this mess
getUserId :: Handler (Key User)
getUserId = do getUserId = do
mName <- lookupHeader "Remote-User" mName <- lookupHeader "Remote-User"
case mName of mUser <- case mName of
-- TODO: if this temporary solution stays, we need here a way to use authDummy somehow in developpement -- TODO: make remote user an argument to make it usable not only with authelia, and maybe do a check for good mesure when nothing is found ?
Nothing -> permissionDenied "no trusted header found !" Just name -> runDB $ insertBy $ User (decodeUtf8 name)
Just name -> do Nothing -> runDB $ insertBy $ User "single-user"
mUser <- runDB $ getBy $ UniqueName (decodeUtf8 name)
case mUser of case mUser of
Nothing -> runDB $ insert $ User (decodeUtf8 name) Left (Entity userId _) -> return userId
Just u -> return $ entityKey u Right userId -> return userId
dbIfAuth :: GroupId -> ReaderT SqlBackend (HandlerFor App) b -> HandlerFor App b
dbIfAuth groupId action = do dbIfAuth groupId action = do
-- TODO: decide if we prefer fast (rawSql) or safe (type safe persist query) after in production latency tests -- TODO: decide if we prefer fast (rawSql) or safe (type safe persist query) after in production latency tests
-- TODO: optimize the persist implementation anyway -- TODO: optimize the persist implementation anyway