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

minor refactors

Browse Source
This commit is contained in:
SJost 2018-06-05 08:34:14 +02:00
parent e418ad2c91
commit 5e5c980459
3 changed files with 9 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/Foundation.hs
View File

@ -226,7 +226,7 @@ knownTags = -- should not throw exceptions, i.e. no getBy404 or requireAuthId
E.&&. course E.^. CourseTerm E.==. E.val tid E.&&. course E.^. CourseTerm E.==. E.val tid
E.&&. course E.^. CourseShorthand E.==. E.val csh E.&&. course E.^. CourseShorthand E.==. E.val csh
return (E.countRows :: E.SqlExpr (E.Value Int64)) return (E.countRows :: E.SqlExpr (E.Value Int64))
guardMExceptT (unauthorizedI MsgUnauthorizedLecturer) (c > 0) guardMExceptT (c>0) (unauthorizedI MsgUnauthorizedLecturer)
return Authorized return Authorized
_ -> exceptT return return $ do _ -> exceptT return return $ do
authId <- maybeExceptT AuthenticationRequired $ lift maybeAuthId authId <- maybeExceptT AuthenticationRequired $ lift maybeAuthId
@ -259,7 +259,7 @@ knownTags = -- should not throw exceptions, i.e. no getBy404 or requireAuthId
guard $ cid `Set.member` Map.keysSet resMap guard $ cid `Set.member` Map.keysSet resMap
return Authorized return Authorized
_ -> do _ -> do
guardMExceptT (unauthorizedI MsgUnauthorizedCorrectorAny) . not $ Map.null resMap guardMExceptT (not $ Map.null resMap) (unauthorizedI MsgUnauthorizedCorrectorAny)
return Authorized return Authorized
) )
,("time", APDB $ \case ,("time", APDB $ \case
@ -286,7 +286,7 @@ knownTags = -- should not throw exceptions, i.e. no getBy404 or requireAuthId
E.&&. course E.^. CourseTerm E.==. E.val tid E.&&. course E.^. CourseTerm E.==. E.val tid
E.&&. course E.^. CourseShorthand E.==. E.val csh E.&&. course E.^. CourseShorthand E.==. E.val csh
return (E.countRows :: E.SqlExpr (E.Value Int64)) return (E.countRows :: E.SqlExpr (E.Value Int64))
guardMExceptT (unauthorizedI MsgUnauthorizedParticipant) (c > 0) guardMExceptT (c > 0) (unauthorizedI MsgUnauthorizedParticipant)
return Authorized return Authorized
r -> do r -> do
$logErrorS "AccessControl" $ "'!registered' used on route that doesn't support it: " <> tshow r $logErrorS "AccessControl" $ "'!registered' used on route that doesn't support it: " <> tshow r

4
src/Utils.hs
View File

@ -85,7 +85,7 @@ maybeT :: Monad m => m a -> MaybeT m a -> m a
maybeT x m = runMaybeT m >>= maybe x return maybeT x m = runMaybeT m >>= maybe x return
catchIfMaybeT :: (MonadCatch m, Exception e) => (e -> Bool) -> m a -> MaybeT m a catchIfMaybeT :: (MonadCatch m, Exception e) => (e -> Bool) -> m a -> MaybeT m a
catchIfMaybeT pred act = catchIf pred (lift act) (const mzero) catchIfMaybeT p act = catchIf p (lift act) (const mzero)
--------------- ---------------
-- Exception -- -- Exception --
@ -113,7 +113,7 @@ exceptT :: Monad m => (e -> m b) -> (a -> m b) -> ExceptT e m a -> m b
exceptT f g = either f g <=< runExceptT exceptT f g = either f g <=< runExceptT
catchIfMExceptT :: (MonadCatch m, Exception e) => (e -> m e') -> (e -> Bool) -> m a -> ExceptT e' m a catchIfMExceptT :: (MonadCatch m, Exception e) => (e -> m e') -> (e -> Bool) -> m a -> ExceptT e' m a
catchIfMExceptT err pred act = catchIf pred (lift act) (throwE <=< lift . err) catchIfMExceptT err p act = catchIf p (lift act) (throwE <=< lift . err)
------------ ------------

8
src/Utils/Common.hs
View File

@ -5,10 +5,10 @@ module Utils.Common where
-- Common Utility Functions -- Common Utility Functions
import Language.Haskell.TH import Language.Haskell.TH
import Control.Monad -- import Control.Monad
import Control.Monad.Trans.Class -- import Control.Monad.Trans.Class
import Control.Monad.Trans.Maybe -- import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Except -- import Control.Monad.Trans.Except
------------ ------------
-- Tuples -- -- Tuples --