diff --git a/src/Control/Role.hs b/src/Control/Role.hs index a10e7c1..e0fb968 100644 --- a/src/Control/Role.hs +++ b/src/Control/Role.hs @@ -11,6 +11,7 @@ import Control.Monad.Reader (asks) import Types import Model +import Util roleList :: MateHandler [Role] roleList = do @@ -113,21 +114,3 @@ roleAssociationDelete Nothing _ = throwError $ err401 { errBody = "No Authentication present." } - --- | This is the internal function to check a users authorization to do certain --- actions -checkCapability - :: Int -- ^ User Id to check - -> (Role -> Bool) -- ^ Predicate to check - -> MateHandler Bool -- ^ Result -checkCapability uid accessRule = do - conn <- asks rsConnection - assocs <- selectUserAssociations uid conn - let rids = map roleAssociationRole assocs - roles <- selectRoleList rids conn - return $ any accessRule roles - -notImplemented :: MateHandler a -notImplemented = throwError $ err501 - { errBody = "Function has not yet been implemented!" - } diff --git a/src/Util.hs b/src/Util.hs index ebba176..310bb68 100644 --- a/src/Util.hs +++ b/src/Util.hs @@ -30,11 +30,25 @@ import System.Directory (doesFileExist) -- internal imports import Model - import Types -import Control.User -import Types (UserDetails(userDetailsId)) +-- | This is the internal function to check a users authorization to do certain +-- actions +checkCapability + :: Int -- ^ User Id to check + -> (Role -> Bool) -- ^ Predicate to check + -> MateHandler Bool -- ^ Result +checkCapability uid accessRule = do + conn <- asks rsConnection + assocs <- selectUserAssociations uid conn + let rids = map roleAssociationRole assocs + roles <- selectRoleList rids conn + return $ any accessRule roles + +notImplemented :: MateHandler a +notImplemented = throwError $ err501 + { errBody = "Function has not yet been implemented!" + } printSql :: Default Unpackspec a a => Select a -> IO () printSql = putStrLn . fromMaybe "Empty query" . showSql