mateamt/src/Control/Role.hs

106 lines
2.7 KiB
Haskell
Raw Normal View History

2020-07-19 06:27:15 +00:00
{-# LANGUAGE OverloadedStrings #-}
module Control.Role where
import Servant
2022-07-30 23:43:46 +00:00
import Control.Monad
2022-04-15 18:51:22 +00:00
2020-07-19 06:27:15 +00:00
import Control.Monad.Reader (asks)
-- internal imports
import Types
import Model
2022-04-15 18:52:32 +00:00
import Util
2020-07-19 06:27:15 +00:00
roleList :: MateHandler [Role]
roleList = do
conn <- asks rsConnection
selectAllRoles conn
2020-07-19 18:48:58 +00:00
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
2022-07-30 23:43:46 +00:00
unless isRoleManager throwUnauthAccess
if auth `elem` [PrimaryPass, ChallengeResponse]
then
insertRole name c1 c2 c3 c4 c5 c6 c7 c8 c9 c10 =<< asks rsConnection
else
2022-07-30 23:43:46 +00:00
throwUnauthAccess
roleNew Nothing _ =
2022-07-30 23:43:46 +00:00
throwMissingAuth
2020-07-19 06:27:15 +00:00
2020-07-23 20:41:22 +00:00
roleUpdate
:: Maybe (Int, AuthMethod)
-> Int
-> RoleSubmit
2022-07-17 19:28:22 +00:00
-> MateHandler NoContent
roleUpdate (Just (uid, auth)) id_ roleSubmit = do
isRoleManager <- checkCapability uid roleCanManageRoles
2022-07-30 23:43:46 +00:00
unless isRoleManager throwUnauthAccess
if auth `elem` [PrimaryPass, ChallengeResponse]
2022-07-17 19:28:22 +00:00
then do
void $ updateRole id_ roleSubmit =<< asks rsConnection
2022-07-17 19:28:22 +00:00
return NoContent
else
2022-07-30 23:43:46 +00:00
throwUnauthAccess
roleUpdate Nothing _ _ =
2022-07-30 23:43:46 +00:00
throwMissingAuth
2020-07-19 06:27:15 +00:00
roleDelete
:: Maybe (Int, AuthMethod)
-> Int
2022-07-17 19:28:22 +00:00
-> MateHandler NoContent
roleDelete (Just (uid, auth)) id_ = do
isRoleManager <- checkCapability uid roleCanManageRoles
2022-07-30 23:43:46 +00:00
unless isRoleManager throwUnauthAccess
if auth `elem` [PrimaryPass, ChallengeResponse]
2022-07-17 19:28:22 +00:00
then do
void $ deleteRole id_ =<< asks rsConnection
2022-07-17 19:28:22 +00:00
return NoContent
else
2022-07-30 23:43:46 +00:00
throwUnauthAccess
roleDelete Nothing _ =
2022-07-30 23:43:46 +00:00
throwMissingAuth
2020-07-19 06:27:15 +00:00
2020-07-19 10:58:25 +00:00
roleAssociationList
:: MateHandler [RoleAssociation]
roleAssociationList =
selectAllRoleAssociations =<< asks rsConnection
2020-07-19 06:27:15 +00:00
roleAssociationSubmit
:: Maybe (Int, AuthMethod)
-> RoleAssociationSubmit
2022-07-17 19:28:22 +00:00
-> MateHandler NoContent
roleAssociationSubmit (Just (uid, auth)) (RoleAssociationSubmit auid arid) = do
isRoleManager <- checkCapability uid roleCanManageRoles
2022-07-30 23:43:46 +00:00
unless isRoleManager throwUnauthAccess
if auth `elem` [PrimaryPass, ChallengeResponse]
2022-07-17 19:28:22 +00:00
then do
associateUserToRole auid arid =<< asks rsConnection
2022-07-17 19:28:22 +00:00
return NoContent
else
2022-07-30 23:43:46 +00:00
throwUnauthAccess
roleAssociationSubmit Nothing _ =
2022-07-30 23:43:46 +00:00
throwMissingAuth
2020-07-19 06:27:15 +00:00
roleAssociationDelete
:: Maybe (Int, AuthMethod)
-> RoleAssociation
2022-07-17 19:28:22 +00:00
-> MateHandler NoContent
roleAssociationDelete (Just (uid, auth)) (RoleAssociation auid arid) = do
isRoleManager <- checkCapability uid roleCanManageRoles
2022-07-30 23:43:46 +00:00
unless isRoleManager throwUnauthAccess
if auth `elem` [PrimaryPass, ChallengeResponse]
2022-07-17 19:28:22 +00:00
then do
void $ deleteAssociation auid arid =<< asks rsConnection
2022-07-17 19:28:22 +00:00
return NoContent
else
2022-07-30 23:43:46 +00:00
throwUnauthAccess
roleAssociationDelete Nothing _ =
2022-07-30 23:43:46 +00:00
throwMissingAuth