mateamt/src/Control/Role.hs

106 lines
2.7 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
module Control.Role where
import Servant
import Control.Monad
import Control.Monad.Reader (asks)
-- internal imports
import Types
import Model
import Util
roleList :: MateHandler [Role]
roleList = do
conn <- asks rsConnection
selectAllRoles conn
roleNew
:: Maybe (Int, AuthMethod)
-> RoleSubmit
-> MateHandler Int
roleNew (Just (uid, auth)) (RoleSubmit name c1 c2 c3 c4 c5 c6 c7 c8 c9 c10) =
do
isRoleManager <- checkCapability uid roleCanManageRoles
unless isRoleManager throwUnauthAccess
if auth `elem` [PrimaryPass, ChallengeResponse]
then
insertRole name c1 c2 c3 c4 c5 c6 c7 c8 c9 c10 =<< asks rsConnection
else
throwUnauthAccess
roleNew Nothing _ =
throwMissingAuth
roleUpdate
:: Maybe (Int, AuthMethod)
-> Int
-> RoleSubmit
-> MateHandler NoContent
roleUpdate (Just (uid, auth)) id_ roleSubmit = do
isRoleManager <- checkCapability uid roleCanManageRoles
unless isRoleManager throwUnauthAccess
if auth `elem` [PrimaryPass, ChallengeResponse]
then do
void $ updateRole id_ roleSubmit =<< asks rsConnection
return NoContent
else
throwUnauthAccess
roleUpdate Nothing _ _ =
throwMissingAuth
roleDelete
:: Maybe (Int, AuthMethod)
-> Int
-> MateHandler NoContent
roleDelete (Just (uid, auth)) id_ = do
isRoleManager <- checkCapability uid roleCanManageRoles
unless isRoleManager throwUnauthAccess
if auth `elem` [PrimaryPass, ChallengeResponse]
then do
void $ deleteRole id_ =<< asks rsConnection
return NoContent
else
throwUnauthAccess
roleDelete Nothing _ =
throwMissingAuth
roleAssociationList
:: MateHandler [RoleAssociation]
roleAssociationList =
selectAllRoleAssociations =<< asks rsConnection
roleAssociationSubmit
:: Maybe (Int, AuthMethod)
-> RoleAssociationSubmit
-> MateHandler NoContent
roleAssociationSubmit (Just (uid, auth)) (RoleAssociationSubmit auid arid) = do
isRoleManager <- checkCapability uid roleCanManageRoles
unless isRoleManager throwUnauthAccess
if auth `elem` [PrimaryPass, ChallengeResponse]
then do
associateUserToRole auid arid =<< asks rsConnection
return NoContent
else
throwUnauthAccess
roleAssociationSubmit Nothing _ =
throwMissingAuth
roleAssociationDelete
:: Maybe (Int, AuthMethod)
-> RoleAssociation
-> MateHandler NoContent
roleAssociationDelete (Just (uid, auth)) (RoleAssociation auid arid) = do
isRoleManager <- checkCapability uid roleCanManageRoles
unless isRoleManager throwUnauthAccess
if auth `elem` [PrimaryPass, ChallengeResponse]
then do
void $ deleteAssociation auid arid =<< asks rsConnection
return NoContent
else
throwUnauthAccess
roleAssociationDelete Nothing _ =
throwMissingAuth