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

fix: fix #571

Browse Source
This commit is contained in:
Gregor Kleen 2020-02-14 12:48:29 +01:00
parent fefe604592
commit aefb7e0b42
1 changed files with 6 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/Foundation.hs
View File

@ -24,6 +24,7 @@ import Auth.Dummy
import qualified Network.Wai as W (pathInfo) import qualified Network.Wai as W (pathInfo)
import Yesod.Core.Types (HandlerContents)
import qualified Yesod.Core.Unsafe as Unsafe import qualified Yesod.Core.Unsafe as Unsafe
import qualified Data.CaseInsensitive as CI import qualified Data.CaseInsensitive as CI
@ -205,10 +206,13 @@ navAccess = execStateT $ do
guardM $ not . null <$> use _navChildren guardM $ not . null <$> use _navChildren
navLinkAccess :: forall m. (MonadHandler m, HandlerSite m ~ UniWorX, MonadCatch m) => NavLink -> m Bool navLinkAccess :: forall m. (MonadHandler m, HandlerSite m ~ UniWorX, MonadCatch m) => NavLink -> m Bool
navLinkAccess NavLink{..} = liftHandler navAccess' `and2M` accessCheck navType navRoute navLinkAccess NavLink{..} = handle shortCircuit $ liftHandler navAccess' `and2M` accessCheck navType navRoute
where where
shortCircuit :: HandlerContents -> m Bool
shortCircuit _ = return False
accessCheck :: HasRoute UniWorX route => NavType -> route -> m Bool accessCheck :: HasRoute UniWorX route => NavType -> route -> m Bool
accessCheck nt (urlRoute -> route) = handleAll (\_ -> return False) $ bool hasWriteAccessTo hasReadAccessTo (is _NavTypeLink nt) route accessCheck nt (urlRoute -> route) = bool hasWriteAccessTo hasReadAccessTo (is _NavTypeLink nt) route
getTimeLocale' :: [Lang] -> TimeLocale getTimeLocale' :: [Lang] -> TimeLocale