From b80fc8786b285389c6e6aab2f0c41b668e914ff7 Mon Sep 17 00:00:00 2001 From: nek0 Date: Fri, 24 Jul 2020 07:47:35 +0200 Subject: [PATCH] fixing stuff and start adding authorization check --- src/API.hs | 5 ++-- src/Control/Role.hs | 43 +++++++++++++++++++++++++----- src/Model/Role.hs | 64 ++++++++++++++++++++++++++++++++++++++++----- 3 files changed, 97 insertions(+), 15 deletions(-) diff --git a/src/API.hs b/src/API.hs index c1db490..7d9c271 100644 --- a/src/API.hs +++ b/src/API.hs @@ -72,7 +72,8 @@ type MateAPI = "v1" :> ( :> Get '[JSON] [Role] :<|> "role" :> AuthProtect "header-auth" :> ReqBody '[JSON] RoleSubmit :> Post '[JSON] Int - :<|> "role" :> AuthProtect "header-auth" :> ReqBody '[JSON] Role + :<|> "role" :> AuthProtect "header-auth" :> Capture "rid" Int + :> ReqBody '[JSON] RoleSubmit :> Patch '[JSON] () :<|> "role" :> AuthProtect "header-auth" :> ReqBody '[JSON] Int :> Delete '[JSON] () @@ -123,7 +124,7 @@ avatarListLink :: Link roleListLink :: Link roleNewLink :: Link -roleUpdateLink :: Link +roleUpdateLink :: Int -> Link roleDeleteLink :: Link roleAssociationListLink :: Link roleAssociationSubmitLink :: Link diff --git a/src/Control/Role.hs b/src/Control/Role.hs index fa1c45f..479d452 100644 --- a/src/Control/Role.hs +++ b/src/Control/Role.hs @@ -25,20 +25,36 @@ roleNew :: Maybe (Int, AuthMethod) -> RoleSubmit -> MateHandler Int -roleNew (Just (_, auth)) (RoleSubmit name c1 c2 c3 c4 c5 c6 c7 c8 c9 c10 c11) = - insertRole name c1 c2 c3 c4 c5 c6 c7 c8 c9 c10 c11 =<< asks rsConnection -roleNew Nothing _ -> +roleNew (Just (uid, auth)) (RoleSubmit name c1 c2 c3 c4 c5 c6 c7 c8 c9 c10 c11) = + do + isRoleManager <- checkCapability uid roleCanManageRoles + if (auth `elem` [PrimaryPass, ChallengeResponse] && isRoleManager) + then + insertRole name c1 c2 c3 c4 c5 c6 c7 c8 c9 c10 c11 =<< asks rsConnection + else + throwError $ err401 + { errBody = "You are not authorized for this action." + } +roleNew Nothing _ = throwError $ err401 { errBody = "No Authentication present." } roleUpdate :: Maybe (Int, AuthMethod) - -> Role + -> Int + -> RoleSubmit -> MateHandler () -roleUpdate Just (_, auth) role = - updateRole role =<< asks rsConnection -roleUpdate Nothing _ -> +roleUpdate (Just (uid, auth)) id_ roleSubmit = do + isRoleManager <- checkCapability uid roleCanManageRoles + if (auth `elem` [PrimaryPass, ChallengeResponse] && isRoleManager) + then + void $ updateRole id_ roleSubmit =<< asks rsConnection + else + throwError $ err401 + { errBody = "You are not authorized for this action." + } +roleUpdate Nothing _ _ = throwError $ err401 { errBody = "No Authentication present." } @@ -54,6 +70,19 @@ roleAssociationSubmit _ _ = notImplemented roleAssociationDelete _ _ = notImplemented +-- | 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/Model/Role.hs b/src/Model/Role.hs index 4161ce4..050ed0d 100644 --- a/src/Model/Role.hs +++ b/src/Model/Role.hs @@ -10,6 +10,8 @@ import Data.Profunctor.Product (p2, p13) import qualified Data.Text as T +import Data.Int (Int64) + import Opaleye as O hiding (null, not) import Opaleye.Constant as C @@ -194,6 +196,38 @@ selectAllRoles conn = do rawRoles +selectRoleList + :: [Int] + -> PGS.Connection + -> MateHandler [Role] +selectRoleList ids conn = do + rawRoles <- liftIO $ runSelect conn ( + (keepWhen (\(id_, _, _, _, _, _, _, _, _, _, _, _, _) -> + in_ (map C.constant ids) id_)) + <<< queryTable roleTable + ) :: MateHandler + [ + ( Int + , T.Text + , Bool + , Bool + , Bool + , Bool + , Bool + , Bool + , Bool + , Bool + , Bool + , Bool + , Bool + ) + ] + return $ map + (\(id_, name, c1, c2, c3, c4, c5, c6, c7, c8, c9 ,c10, c11) -> + Role id_ name c1 c2 c3 c4 c5 c6 c7 c8 c9 c10 c11) + rawRoles + + insertRole :: T.Text -> Bool @@ -319,6 +353,23 @@ selectAllRoleAssociations conn = do rawRoleAssocs +selectUserAssociations + :: Int + -> PGS.Connection + -> MateHandler [RoleAssociation] +selectUserAssociations uid conn = do + rawAssocs <- liftIO $ runSelect conn( + keepWhen (\(auid, _) -> auid .== C.constant uid) + <<< queryTable userToRoleTable + ) :: MateHandler + [ + ( Int + , Int + ) + ] + return $ map (\(auid, arid) -> RoleAssociation auid arid) rawAssocs + + associateUserToRole :: Int -- ^ User id -> Int -- ^ Role id @@ -339,13 +390,14 @@ associateUserToRole uid rid conn = updateRole - :: Role -- The role with already updated info + :: Int -- ID of the updated role + -> RoleSubmit -- The role with already updated info -> PGS.Connection - -> MateHandler () -updateRole role@(Role idnr name c1 c2 c3 c4 c5 c6 c7 c8 c9 c10 c11) conn = + -> MateHandler Int64 +updateRole rid role@(RoleSubmit name c1 c2 c3 c4 c5 c6 c7 c8 c9 c10 c11) conn = liftIO $ runUpdate_ conn $ Update { uTable = roleTable - , uUpadteWith = updateEasy (\(id_, _, _, _, _, _, _, _, _, _, _, _, _) -> + , uUpdateWith = updateEasy (\(id_, _, _, _, _, _, _, _, _, _, _, _, _) -> ( id_ , C.constant name , C.constant c1 @@ -361,7 +413,7 @@ updateRole role@(Role idnr name c1 c2 c3 c4 c5 c6 c7 c8 c9 c10 c11) conn = , C.constant c11 ) ) - , uWhere = \(id_, _, _, _, _, _, _, _, _, _, _, _, _) .> - id_ .== C.constant idnr + , uWhere = \(id_, _, _, _, _, _, _, _, _, _, _, _, _) -> + id_ .== C.constant rid , uReturning = rCount }