diff --git a/README.md b/README.md index 7579f1c..5b27657 100644 --- a/README.md +++ b/README.md @@ -1,25 +1,28 @@ # sTodo Stuce's simple todo is a web app that let's you self host a simple todolist. The goal is to provide a minimalistic and fast todo list that is self hostable. +## Usage +- can be used as is for a single user behind a vpn (for ex, wireguard) +- can be setup for multi user with a reverse proxy and an authentification provider that supports trusted sso (for ex, nginx + authelia) ## Next goals - Make multi user support - - [x] Get user by trusted header - - [ ] Add option to enable single user (usefull for vpn single user easy setup) - - [ ] Add menu to add other users to the group - - [ ] make the code more readable by renaming/moving the handlers better - [ ] write a minimal step by step guide to install with nix, - [ ] add some css to make it look nicer - [ ] add htmx to make more agreable without making js manadatory -## Version 0.0.0 -Simple todo list for **single user only** at the moment. + - [x] make api to allow usage with native app (a way to get every list that has been modified since date $date belonging from the user in a json or similar format) + - [ ] use getRep and provideRep to make text/javascript response as alternatives to html + - [ ] document api to help create clients +## Version 0.0.3 +Simple todo list webapp. Features : - - add and delete (and soon share) groups that contain a list of todolists + - add and delete groups that contain a list of todolists - add and delete todolists inside groups - add todolist items or edit complete list via text for easy manipulation + - api to allow creating native clients with offline capability - possibility to deploy easily via nix module with a flake - that's it, the goal is to keep it minimal !!! - -## Haskell Setup (I sadly don't use nix develop at the moment) +# Development +## Haskell Setup 1. If you haven't already, [install Stack](https://haskell-lang.org/get-started) * On POSIX systems, this is usually `curl -sSL https://get.haskellstack.org/ | sh` diff --git a/client_session_key.aes b/client_session_key.aes new file mode 100644 index 0000000..70e3c9c --- /dev/null +++ b/client_session_key.aes @@ -0,0 +1 @@ +:M^O2I蚑4,pe8ķ,CI(q7/gGuL'(ɜwq1I#pYW)2L{2;v_i[ʳY \ No newline at end of file diff --git a/config/models.persistentmodels b/config/models.persistentmodels index bb9d354..07df491 100644 --- a/config/models.persistentmodels +++ b/config/models.persistentmodels @@ -8,12 +8,15 @@ TodolistItem Todolist groupId GroupId OnDeleteCascade title Text + lastModified UTCTime UniqueListPair groupId title User name Text + lastModified UTCTime UniqueName name Group group Text + lastModified UTCTime GroupUser user UserId - groupId GroupId OnDeleteCascade \ No newline at end of file + groupId GroupId OnDeleteCascade diff --git a/config/routes.yesodroutes b/config/routes.yesodroutes index 86f2549..b310a04 100644 --- a/config/routes.yesodroutes +++ b/config/routes.yesodroutes @@ -6,7 +6,7 @@ /favicon.ico FaviconR GET /robots.txt RobotsR GET -/ HomeR GET +/ GroupR GET /group/#GroupId TodolistR GET /add AddGroupR POST @@ -26,3 +26,4 @@ /delete DeleteGroupR POST /delete/group/#GroupId DeleteTodolistR POST +/api/#Int ApiR GET diff --git a/flake.nix b/flake.nix index 8cc4ad4..293bdfa 100644 --- a/flake.nix +++ b/flake.nix @@ -10,8 +10,8 @@ nixpkgs, }: let tarball = fetchTarball { - url = "https://git.stuce.ch/stuce/sTodo/releases/download/r3/release2.tar.gz"; - sha256 = "1h72drqsk690d5i53czpzgs4761wydk49cvz6fq0hgc3q3z214ha"; + url = "https://git.stuce.ch/stuce/sTodo/releases/download/r3/r3.tar.gz"; + sha256 = "1imgbbgbgx2r8qr90mpxlwfy9hcfpdz0sa4nir05jhqx8q1rl0y1"; }; in { packages.x86_64-linux.sTodo = with nixpkgs.legacyPackages.x86_64-linux; @@ -19,11 +19,12 @@ pname = "sTodo"; version = "1.0.0"; src = tarball; - buildInputs = [zlib gmp libffi]; + buildInputs = [libz gmp libffi]; nativeBuildInputs = [openssl]; installPhase = '' mkdir -p $out/bin cp $src/sTodo $out/bin + chmod ugo+x $out/bin/sTodo ''; mainProgram = "sTodo"; }; diff --git a/src/Application.hs b/src/Application.hs index 667b72d..7be018c 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -44,7 +44,10 @@ import System.Log.FastLogger (defaultBufSize, newStdoutLoggerSet, -- Import all relevant handler modules here. -- Don't forget to add new modules to your cabal file! import Handler.Common -import Handler.TodoEntry +import Handler.Group +import Handler.Todolist +import Handler.TodolistItem +import Handler.Api -- This line actually creates our YesodDispatch instance. It is the second half -- of the call to mkYesodData which occurs in Foundation.hs. Please see the diff --git a/src/Foundation.hs b/src/Foundation.hs index 2c365fe..80b5326 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -1,49 +1,53 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE ExplicitForAll #-} +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE ExplicitForAll #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE NoImplicitPrelude #-} module Foundation where -import Import.NoFoundation -import Data.Kind (Type) -import Database.Persist.Sql (ConnectionPool, runSqlPool) -import Text.Hamlet (hamletFile) -import Text.Jasmine (minifym) import Control.Monad.Logger (LogSource) +import Data.Kind (Type) +import Data.Text qualified as Text (intercalate, pack) +import Database.Persist.Sql (ConnectionPool, rawSql, runSqlPool) +import Import.NoFoundation +import Text.Hamlet (hamletFile) +import Text.Jasmine (minifym) -import Yesod.Default.Util (addStaticContentExternal) -import Yesod.Core.Types (Logger) -import qualified Yesod.Core.Unsafe as Unsafe -import qualified Data.CaseInsensitive as CI -import qualified Data.Text.Encoding as TE +import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds) +import Yesod.Core.Types (Logger) +import Yesod.Core.Unsafe qualified as Unsafe +import Yesod.Default.Util (addStaticContentExternal) --- | The foundation datatype for your application. This can be a good place to --- keep settings and values requiring initialization before your application --- starts running, such as database connections. Every handler will have --- access to the data present here. +{- | The foundation datatype for your application. This can be a good place to +keep settings and values requiring initialization before your application +starts running, such as database connections. Every handler will have +access to the data present here. +-} data App = App - { appSettings :: AppSettings - , appStatic :: Static -- ^ Settings for static file serving. - , appConnPool :: ConnectionPool -- ^ Database connection pool. - , appHttpManager :: Manager - , appLogger :: Logger - } + { appSettings :: AppSettings + , appStatic :: Static + -- ^ Settings for static file serving. + , appConnPool :: ConnectionPool + -- ^ Database connection pool. + , appHttpManager :: Manager + , appLogger :: Logger + } data MenuItem = MenuItem - { menuItemLabel :: Text - , menuItemRoute :: Route App - , menuItemAccessCallback :: Bool - } + { menuItemLabel :: Text + , menuItemRoute :: Route App + , menuItemAccessCallback :: Bool + } data MenuTypes - = NavbarLeft MenuItem - | NavbarRight MenuItem + = NavbarLeft MenuItem + | NavbarRight MenuItem -- This is where we define all of the routes in our application. For a full -- explanation of the syntax, please see: @@ -63,123 +67,128 @@ mkYesodData "App" $(parseRoutesFile "config/routes.yesodroutes") type Form x = Html -> MForm (HandlerFor App) (FormResult x, Widget) -- | A convenient synonym for database access functions. -type DB a = forall (m :: Type -> Type). - (MonadUnliftIO m) => ReaderT SqlBackend m a +type DB a = + forall (m :: Type -> Type). + (MonadUnliftIO m) => + ReaderT SqlBackend m a -- Please see the documentation for the Yesod typeclass. There are a number -- of settings which can be configured by overriding methods here. instance Yesod App where - -- Controls the base of generated URLs. For more information on modifying, - -- see: https://github.com/yesodweb/yesod/wiki/Overriding-approot - approot :: Approot App - approot = ApprootRequest $ \app req -> - case appRoot $ appSettings app of - Nothing -> getApprootText guessApproot app req - Just root -> root + -- Controls the base of generated URLs. For more information on modifying, + -- see: https://github.com/yesodweb/yesod/wiki/Overriding-approot + approot :: Approot App + approot = ApprootRequest $ \app req -> + case appRoot $ appSettings app of + Nothing -> getApprootText guessApproot app req + Just root -> root - -- Store session data on the client in encrypted cookies, - -- default session idle timeout is 120 minutes - makeSessionBackend :: App -> IO (Maybe SessionBackend) - makeSessionBackend app = Just <$> defaultClientSessionBackend - 120 -- timeout in minutes - (appSessionKey $ appSettings app) + -- -- Store session data on the client in encrypted cookies, + -- -- default session idle timeout is 120 minutes + -- makeSessionBackend :: App -> IO (Maybe SessionBackend) + -- makeSessionBackend app = Just <$> defaultClientSessionBackend + -- 120 -- timeout in minutes + -- (appSessionKey $ appSettings app) - -- Yesod Middleware allows you to run code before and after each handler function. - -- The defaultYesodMiddleware adds the response header "Vary: Accept, Accept-Language" and performs authorization checks. - -- Some users may also want to add the defaultCsrfMiddleware, which: - -- a) Sets a cookie with a CSRF token in it. - -- b) Validates that incoming write requests include that token in either a header or POST parameter. - -- To add it, chain it together with the defaultMiddleware: yesodMiddleware = defaultYesodMiddleware . defaultCsrfMiddleware - -- For details, see the CSRF documentation in the Yesod.Core.Handler module of the yesod-core package. - yesodMiddleware :: ToTypedContent res => Handler res -> Handler res - yesodMiddleware = defaultYesodMiddleware . defaultCsrfMiddleware + -- Yesod Middleware allows you to run code before and after each handler function. + -- The defaultYesodMiddleware adds the response header "Vary: Accept, Accept-Language" and performs authorization checks. + -- Some users may also want to add the defaultCsrfMiddleware, which: + -- a) Sets a cookie with a CSRF token in it. + -- b) Validates that incoming write requests include that token in either a header or POST parameter. + -- To add it, chain it together with the defaultMiddleware: yesodMiddleware = defaultYesodMiddleware . defaultCsrfMiddleware + -- For details, see the CSRF documentation in the Yesod.Core.Handler module of the yesod-core package. + -- yesodMiddleware :: ToTypedContent res => Handler res -> Handler res + -- yesodMiddleware = defaultYesodMiddleware . defaultCsrfMiddleware - defaultLayout :: Widget -> Handler Html - defaultLayout widget = do - master <- getYesod - mmsg <- getMessage + defaultLayout :: Widget -> Handler Html + defaultLayout widget = do + master <- getYesod + mmsg <- getMessage - mcurrentRoute <- getCurrentRoute + -- mcurrentRoute <- getCurrentRoute - -- We break up the default layout into two components: - -- default-layout is the contents of the body tag, and - -- default-layout-wrapper is the entire page. Since the final - -- value passed to hamletToRepHtml cannot be a widget, this allows - -- you to use normal widget features in default-layout. + -- We break up the default layout into two components: + -- default-layout is the contents of the body tag, and + -- default-layout-wrapper is the entire page. Since the final + -- value passed to hamletToRepHtml cannot be a widget, this allows + -- you to use normal widget features in default-layout. - pc <- widgetToPageContent $ do - $(widgetFile "default-layout") - withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet") + pc <- widgetToPageContent $ do + $(widgetFile "default-layout") + withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet") - isAuthorized - :: Route App -- ^ The route the user is visiting. - -> Bool -- ^ Whether or not this is a "write" request. - -> Handler AuthResult - -- Routes not requiring authentication. - -- TODO: check this bullshit if need to change it or not (prolly authelia problem) - isAuthorized _ _ = return Authorized + -- isAuthorized + -- :: Route App -- ^ The route the user is visiting. + -- -> Bool -- ^ Whether or not this is a "write" request. + -- -> Handler AuthResult + -- -- Routes not requiring authentication. + -- isAuthorized _ _ = return Authorized + -- This function creates static content files in the static folder + -- and names them based on a hash of their content. This allows + -- expiration dates to be set far in the future without worry of + -- users receiving stale content. + addStaticContent :: + Text -> + -- \^ The file extension + Text -> + -- \^ The MIME content type + LByteString -> + -- \^ The contents of the file + Handler (Maybe (Either Text (Route App, [(Text, Text)]))) + addStaticContent ext mime content = do + master <- getYesod + let staticDir = appStaticDir $ appSettings master + addStaticContentExternal + minifym + genFileName + staticDir + (StaticR . flip StaticRoute []) + ext + mime + content + where + -- Generate a unique filename based on the content itself + genFileName lbs = "autogen-" ++ base64md5 lbs - -- This function creates static content files in the static folder - -- and names them based on a hash of their content. This allows - -- expiration dates to be set far in the future without worry of - -- users receiving stale content. - addStaticContent - :: Text -- ^ The file extension - -> Text -- ^ The MIME content type - -> LByteString -- ^ The contents of the file - -> Handler (Maybe (Either Text (Route App, [(Text, Text)]))) - addStaticContent ext mime content = do - master <- getYesod - let staticDir = appStaticDir $ appSettings master - addStaticContentExternal - minifym - genFileName - staticDir - (StaticR . flip StaticRoute []) - ext - mime - content - where - -- Generate a unique filename based on the content itself - genFileName lbs = "autogen-" ++ base64md5 lbs + -- What messages should be logged. The following includes all messages when + -- in development, and warnings and errors in production. + shouldLogIO :: App -> LogSource -> LogLevel -> IO Bool + shouldLogIO app _source level = + return + $ appShouldLogAll (appSettings app) + || level + == LevelWarn + || level + == LevelError - -- What messages should be logged. The following includes all messages when - -- in development, and warnings and errors in production. - shouldLogIO :: App -> LogSource -> LogLevel -> IO Bool - shouldLogIO app _source level = - return $ - appShouldLogAll (appSettings app) - || level == LevelWarn - || level == LevelError - - makeLogger :: App -> IO Logger - makeLogger = return . appLogger + makeLogger :: App -> IO Logger + makeLogger = return . appLogger -- How to run database actions. instance YesodPersist App where - type YesodPersistBackend App = SqlBackend - runDB :: SqlPersistT Handler a -> Handler a - runDB action = do - master <- getYesod - runSqlPool action $ appConnPool master + type YesodPersistBackend App = SqlBackend + runDB :: SqlPersistT Handler a -> Handler a + runDB action = do + master <- getYesod + runSqlPool action $ appConnPool master instance YesodPersistRunner App where - getDBRunner :: Handler (DBRunner App, Handler ()) - getDBRunner = defaultGetDBRunner appConnPool + getDBRunner :: Handler (DBRunner App, Handler ()) + getDBRunner = defaultGetDBRunner appConnPool -- This instance is required to use forms. You can modify renderMessage to -- achieve customized and internationalized form validation messages. instance RenderMessage App FormMessage where - renderMessage :: App -> [Lang] -> FormMessage -> Text - renderMessage _ _ = defaultFormMessage + renderMessage :: App -> [Lang] -> FormMessage -> Text + renderMessage _ _ = defaultFormMessage -- Useful when writing code that is re-usable outside of the Handler context. -- An example is background jobs that send email. -- This can also be useful for writing code that works across multiple Yesod applications. instance HasHttpManager App where - getHttpManager :: App -> Manager - getHttpManager = appHttpManager + getHttpManager :: App -> Manager + getHttpManager = appHttpManager unsafeHandler :: App -> Handler a -> IO a unsafeHandler = Unsafe.fakeHandlerGetLogger appLogger @@ -191,3 +200,50 @@ unsafeHandler = Unsafe.fakeHandlerGetLogger appLogger -- https://github.com/yesodweb/yesod/wiki/Sending-email -- https://github.com/yesodweb/yesod/wiki/Serve-static-files-from-a-separate-domain -- https://github.com/yesodweb/yesod/wiki/i18n-messages-in-the-scaffolding + +-- TODO: complete implementation should short circuit if multi user is on but no user exist, to enforce policy safely +getUserId :: HandlerFor App (Key User) +getUserId = do + mName <- lookupHeader "Remote-User" + currentTime <- liftIO getCurrentTime + mUser <- case mName of + -- 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 ? + Just name -> runDB $ insertBy $ User (decodeUtf8 name) currentTime + Nothing -> runDB $ insertBy $ User "single-user" currentTime + case mUser of + Left (Entity userId _) -> return userId + Right userId -> return userId + +dbIfAuth :: GroupId -> ReaderT SqlBackend (HandlerFor App) b -> HandlerFor App b +dbIfAuth groupId action = do + -- TODO: decide if we prefer fast (rawSql) or safe (type safe persist query) after in production latency tests + user <- getUserId + result <- runDB $ selectFirst [GroupUserUser ==. user, GroupUserGroupId ==. groupId] [] + if isNothing result + then permissionDenied "you are not logged in or you dont have access to this group" + else runDB action + +getGroups :: Key User -> Handler [Entity Group] +getGroups userId = + let sql = "SELECT ?? FROM \"group\" JOIN group_user gu ON \"group\".id = gu.group_id WHERE gu.user = ?" + in runDB $ rawSql sql [toPersistValue userId] + +todolistItemToCSV :: Entity TodolistItem -> Text +todolistItemToCSV item = "i," <> fieldToText item +todolistToCSV :: Entity Todolist -> Text +todolistToCSV list = "l," <> fieldToText list +groupToCSV :: Entity Group -> Text +groupToCSV group = "g," <> fieldToText group +userToCSV :: Entity User -> Text +userToCSV user = "u," <> fieldToText user + +-- TODO: error management ? (maybe use Either Text Text and then propagate left to handler and send error ?) +fieldToText :: (PersistEntity record) => Entity record -> Text +fieldToText field = Text.intercalate "," (map persistValueToText $ entityValues field) + +persistValueToText :: PersistValue -> Text +persistValueToText (PersistText s) = s +persistValueToText (PersistInt64 i) = Text.pack $ show i +persistValueToText (PersistUTCTime d) = Text.pack $ show $ floor (utcTimeToPOSIXSeconds d) +persistValueToText (PersistBool b) = if b then "T" else "F" +persistValueToText _ = error "Wrong input type" diff --git a/src/Handler/Api.hs b/src/Handler/Api.hs new file mode 100644 index 0000000..912575c --- /dev/null +++ b/src/Handler/Api.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NoImplicitPrelude #-} + +module Handler.Api where + +import Data.Time.Clock.POSIX (posixSecondsToUTCTime) +import Database.Persist.Sql (rawSql) +import Import + +getApiR :: Int -> Handler TypedContent +getApiR time = do + -- TODO: use only one runDB (or use joins ?) + userId <- getUserId + let utcTime = posixSecondsToUTCTime (fromIntegral time) + -- condition : parent user or group changed + let sqlUpdatedGroups = "select ?? from \"group\" join group_user gu on \"group\".id = gu.group_id where gu.user = ? where \"group\".last_modified > ? or user.last_modified > ?;" + -- condition : parent group or list changed + let sqlUpdatedLists = "select ?? from todolist join group_user on todolist.group_id = group_user.group_id and group_user.user = ? join \"group\" as g on g.id = todolist.id where list.last_modified > ? or g.last_modified > ?;" + -- condition : parent list changed + let sqlUpdatedItems = "select ?? from todolist where todolist.last_modified > ? join group_user on todolist.group_id = group_user.group_id and group_user.user = ? join todolist_item on todolist_item.todolist_id = todolist.id;" + runDB $ do + user <- selectList [UserId ==. userId, UserLastModified >. utcTime] [] + groups <- rawSql sqlUpdatedGroups [toPersistValue userId, toPersistValue utcTime, toPersistValue utcTime] + lists <- rawSql sqlUpdatedLists [toPersistValue userId, toPersistValue utcTime, toPersistValue utcTime] + items <- rawSql sqlUpdatedItems [toPersistValue utcTime, toPersistValue userId] + let t = + unlines + $ map userToCSV user + <> map groupToCSV groups + <> map todolistToCSV lists + <> map todolistItemToCSV items + return $ TypedContent typePlain $ toContent t diff --git a/src/Handler/Group.hs b/src/Handler/Group.hs new file mode 100644 index 0000000..5219c0e --- /dev/null +++ b/src/Handler/Group.hs @@ -0,0 +1,73 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} + +module Handler.Group where + +import Database.Persist.Sql (fromSqlKey, toSqlKey) +import Import +import Text.Read + +getGroupR :: Handler TypedContent +getGroupR = do + userId <- getUserId + groups <- getGroups userId + selectRep $ do + provideRep + $ defaultLayout + $ do + setTitle "Groups" + $(widgetFile "group") + provideRep $ return $ unlines $ map groupToCSV groups + +postAddGroupR :: Handler TypedContent +postAddGroupR = do + g <- runInputPost $ ireq textField "group" + -- TODO: in a newer version, put insertUnique_ + user <- getUserId + _ <- runDB $ do + currentTime <- liftIO getCurrentTime + gId <- insert $ Group g currentTime + success <- insertUnique $ GroupUser user gId + when (isNothing success) $ delete gId + redirect GroupR + +getEditGroupR :: Handler Html +getEditGroupR = do + userId <- getUserId + groups <- getGroups userId + defaultLayout $ do + let a e = pack $ show $ fromSqlKey $ entityKey e :: Text + setTitle "Groups" + $(widgetFile "edit-group") +postEditGroupR :: Handler TypedContent +postEditGroupR = do + -- TODO: not implemented yet + -- title <- runInputPost $ ireq textField "title" + -- users <- runInputPost $ ireq textField "users" + -- id <- runInputPost $ ireq intField "id" + -- let key = toSqlKey id + -- runDB $ update key [GroupGroup =. title] + redirect EditGroupR +postDeleteGroupR :: Handler Html +postDeleteGroupR = do + text <- lookupPostParams "ids" + let ints = map (read . unpack) text :: [Int64] + let ids = map toSqlKey ints :: [GroupId] + userId <- getUserId + currentTime <- liftIO getCurrentTime + -- TODO: test this and maybe change it to sql to be more efficient ? + when (ids /= []) + $ runDB + $ do + update userId [UserLastModified =. currentTime] + deleteWhere [GroupUserGroupId <-. ids, GroupUserUser ==. userId] + nonOrphans <- selectList [GroupUserGroupId <-. ids] [] + let nonOrphansIds = map (groupUserGroupId . entityVal) nonOrphans + deleteWhere [GroupId <-. ids, GroupId /<-. nonOrphansIds] + redirect EditGroupR diff --git a/src/Handler/TodoEntry.hs b/src/Handler/TodoEntry.hs deleted file mode 100644 index b7a747b..0000000 --- a/src/Handler/TodoEntry.hs +++ /dev/null @@ -1,301 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE FlexibleContexts #-} -{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} -{-# HLINT ignore "Replace case with fromMaybe" #-} -module Handler.TodoEntry where - -import Import -import Text.Read -import Database.Persist.Sql (rawExecute, fromSqlKey, toSqlKey, rawSql) --- TODO: move this back to another handler -getHomeR :: Handler Html -getHomeR = do - userId <- getUserId - groups <- getGroups userId - mToken <- fmap reqToken getRequest - defaultLayout $ do - setTitle "Groups" - [whamlet| - Home -