diff --git a/README.md b/README.md index 5b27657..7579f1c 100644 --- a/README.md +++ b/README.md @@ -1,28 +1,25 @@ # 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 - - [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. +## Version 0.0.0 +Simple todo list for **single user only** at the moment. Features : - - add and delete groups that contain a list of todolists + - add and delete (and soon share) 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 !!! -# Development -## Haskell Setup + +## Haskell Setup (I sadly don't use nix develop at the moment) 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 deleted file mode 100644 index 70e3c9c..0000000 --- a/client_session_key.aes +++ /dev/null @@ -1 +0,0 @@ -: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 07df491..bb9d354 100644 --- a/config/models.persistentmodels +++ b/config/models.persistentmodels @@ -8,15 +8,12 @@ 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 + groupId GroupId OnDeleteCascade \ No newline at end of file diff --git a/config/routes.yesodroutes b/config/routes.yesodroutes index b310a04..86f2549 100644 --- a/config/routes.yesodroutes +++ b/config/routes.yesodroutes @@ -6,7 +6,7 @@ /favicon.ico FaviconR GET /robots.txt RobotsR GET -/ GroupR GET +/ HomeR GET /group/#GroupId TodolistR GET /add AddGroupR POST @@ -26,4 +26,3 @@ /delete DeleteGroupR POST /delete/group/#GroupId DeleteTodolistR POST -/api/#Int ApiR GET diff --git a/flake.nix b/flake.nix index 293bdfa..8cc4ad4 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/r3.tar.gz"; - sha256 = "1imgbbgbgx2r8qr90mpxlwfy9hcfpdz0sa4nir05jhqx8q1rl0y1"; + url = "https://git.stuce.ch/stuce/sTodo/releases/download/r3/release2.tar.gz"; + sha256 = "1h72drqsk690d5i53czpzgs4761wydk49cvz6fq0hgc3q3z214ha"; }; in { packages.x86_64-linux.sTodo = with nixpkgs.legacyPackages.x86_64-linux; @@ -19,12 +19,11 @@ pname = "sTodo"; version = "1.0.0"; src = tarball; - buildInputs = [libz gmp libffi]; + buildInputs = [zlib 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 7be018c..667b72d 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -44,10 +44,7 @@ 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.Group -import Handler.Todolist -import Handler.TodolistItem -import Handler.Api +import Handler.TodoEntry -- 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 80b5326..2c365fe 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -1,53 +1,49 @@ -{-# LANGUAGE ExplicitForAll #-} -{-# LANGUAGE ImportQualifiedPost #-} -{-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ExplicitForAll #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE InstanceSigs #-} module Foundation where -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 Data.Kind (Type) +import Database.Persist.Sql (ConnectionPool, runSqlPool) +import Text.Hamlet (hamletFile) +import Text.Jasmine (minifym) +import Control.Monad.Logger (LogSource) -import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds) -import Yesod.Core.Types (Logger) -import Yesod.Core.Unsafe qualified as Unsafe -import Yesod.Default.Util (addStaticContentExternal) +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 -{- | 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: @@ -67,128 +63,123 @@ 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. - -- 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. + -- TODO: check this bullshit if need to change it or not (prolly authelia problem) + 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 - -- 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 + -- 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 - makeLogger :: App -> IO Logger - makeLogger = return . appLogger + -- 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 -- 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 @@ -200,50 +191,3 @@ 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 deleted file mode 100644 index 912575c..0000000 --- a/src/Handler/Api.hs +++ /dev/null @@ -1,33 +0,0 @@ -{-# 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 deleted file mode 100644 index 5219c0e..0000000 --- a/src/Handler/Group.hs +++ /dev/null @@ -1,73 +0,0 @@ -{-# 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 new file mode 100644 index 0000000..b7a747b --- /dev/null +++ b/src/Handler/TodoEntry.hs @@ -0,0 +1,301 @@ +{-# 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 +