diff --git a/config/routes.yesodroutes b/config/routes.yesodroutes index 86f2549..9d7e398 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 diff --git a/src/Application.hs b/src/Application.hs index 667b72d..fd6e107 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -44,7 +44,9 @@ 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 -- 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..ffb4191 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -191,3 +191,25 @@ 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 +getUserId :: HandlerFor App (Key User) +getUserId = do + mName <- lookupHeader "Remote-User" + 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) + Nothing -> runDB $ insertBy $ User "single-user" + 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 + -- TODO: optimize the persist implementation anyway + 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 \ No newline at end of file diff --git a/src/Handler/Group.hs b/src/Handler/Group.hs new file mode 100644 index 0000000..c2f4bb5 --- /dev/null +++ b/src/Handler/Group.hs @@ -0,0 +1,88 @@ +{-# 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.Group where + +import Import +import Text.Read +import Database.Persist.Sql (fromSqlKey, toSqlKey, rawSql) +getGroupR :: Handler Html +getGroupR = do + userId <- getUserId + groups <- getGroups userId + mToken <- fmap reqToken getRequest + defaultLayout $ do + setTitle "Groups" + [whamlet| + Home +