fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

feat(course material): runDB für cid nur einmal

Browse Source
This commit is contained in:
ros 2021-06-21 16:17:52 +02:00 committed by Gregor Kleen
parent 08ec676616
commit c09acbbf8a
2 changed files with 14 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/Application.hs
View File

@ -709,9 +709,4 @@ addPWEntry :: User
addPWEntry User{ userAuthentication = _, ..} (Text.encodeUtf8 -> pw) = db' $ do addPWEntry User{ userAuthentication = _, ..} (Text.encodeUtf8 -> pw) = db' $ do
PWHashConf{..} <- getsYesod $ view _appAuthPWHash PWHashConf{..} <- getsYesod $ view _appAuthPWHash
(AuthPWHash . Text.decodeUtf8 -> userAuthentication) <- liftIO $ makePasswordWith pwHashAlgorithm pw pwHashStrength (AuthPWHash . Text.decodeUtf8 -> userAuthentication) <- liftIO $ makePasswordWith pwHashAlgorithm pw pwHashStrength
void $ insert User{..} void $ insert User{..}

26
src/Handler/Material.hs
View File

@ -81,16 +81,6 @@ fetchMaterial tid ssh csh mnm =
getMaterialListR :: TermId -> SchoolId -> CourseShorthand -> Handler Html getMaterialListR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
getMaterialListR tid ssh csh = do getMaterialListR tid ssh csh = do
cid <- runDB . getKeyBy404 $ TermSchoolCourseShort tid ssh csh
let typeOptions :: HandlerFor UniWorX (OptionList Text)
typeOptions = do
previouslyUsed <- runDB $
E.select $ E.from $ \material ->
E.distinctOnOrderBy [E.asc $ material E.^. MaterialType] $ do
E.where_ $ material E.^. MaterialCourse E.==. E.val cid
E.&&. E.not_ (E.isNothing $ material E.^. MaterialType)
return $ material E.^. MaterialType
return . mkOptionList . map (\(CI.original -> t) -> Option t t t) . Set.toAscList . Set.fromList $ mapMaybe E.unValue previouslyUsed
let matLink :: MaterialName -> Route UniWorX let matLink :: MaterialName -> Route UniWorX
matLink = CourseR tid ssh csh . flip MaterialR MShowR matLink = CourseR tid ssh csh . flip MaterialR MShowR
@ -107,6 +97,16 @@ getMaterialListR tid ssh csh = do
seeAllModificationTimestamps <- hasWriteAccessTo $ CourseR tid ssh csh MaterialNewR -- ordinary users should not see modification dates older than visibility seeAllModificationTimestamps <- hasWriteAccessTo $ CourseR tid ssh csh MaterialNewR -- ordinary users should not see modification dates older than visibility
MsgRenderer mr <- getMsgRenderer MsgRenderer mr <- getMsgRenderer
table <- runDB $ do table <- runDB $ do
cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
let typeOptions :: HandlerFor UniWorX (OptionList Text)
typeOptions = do
previouslyUsed <- runDB $
E.select $ E.from $ \material ->
E.distinctOnOrderBy [E.asc $ material E.^. MaterialType] $ do
E.where_ $ material E.^. MaterialCourse E.==. E.val cid
E.&&. E.not_ (E.isNothing $ material E.^. MaterialType)
return $ material E.^. MaterialType
return . mkOptionList $ map (\t -> Option t t t) (map CI.original (Set.toAscList (Set.fromList (mapMaybe E.unValue previouslyUsed))))
let row2material = view $ _dbrOutput . _1 . _entityVal let row2material = view $ _dbrOutput . _1 . _entityVal
psValidator = def & defaultSorting [SortDescBy "last-edit"] psValidator = def & defaultSorting [SortDescBy "last-edit"]
& forceFilter "may-access" (Any True) & forceFilter "may-access" (Any True)
@ -148,9 +148,9 @@ getMaterialListR tid ssh csh = do
, ( "last-edit" , SortColumn (E.^. MaterialLastEdit) ) , ( "last-edit" , SortColumn (E.^. MaterialLastEdit) )
] ]
, dbtFilter = mconcat , dbtFilter = mconcat
[ singletonMap "may-access" . mkFilterProjectedPost $ \(Any b) dbr [ (singletonMap "may-access" . mkFilterProjectedPost $ \(Any b) dbr
-> (== b) <$> hasReadAccessTo (matLink . materialName $ row2material dbr) :: DB Bool -> (== b) <$> hasReadAccessTo (matLink . materialName $ row2material dbr) :: DB Bool)
, (singletonMap "searchName" . FilterColumn $ \material criterion -> case getLast (criterion :: Last Text) of , (singletonMap "searchName". FilterColumn $ \material criterion -> case getLast (criterion :: Last Text) of
Nothing -> E.val True :: E.SqlExpr (E.Value Bool) Nothing -> E.val True :: E.SqlExpr (E.Value Bool)
Just needle -> (E.castString (material E.^. MaterialName) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%))) Just needle -> (E.castString (material E.^. MaterialName) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%)))
, (singletonMap "searchTypeAndDescription". FilterColumn $ \material criterion -> case getLast (criterion :: Last Text) of , (singletonMap "searchTypeAndDescription". FilterColumn $ \material criterion -> case getLast (criterion :: Last Text) of