move utility funcitons to Util module
This commit is contained in:
parent
645f378bec
commit
853d825951
2 changed files with 18 additions and 21 deletions
|
@ -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!"
|
||||
}
|
||||
|
|
20
src/Util.hs
20
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
|
||||
|
|
Loading…
Reference in a new issue