From 062ad337c3da609fbf243f1362cb4c7f0f4354d3 Mon Sep 17 00:00:00 2001 From: nek0 Date: Sun, 19 Jul 2020 08:27:15 +0200 Subject: [PATCH] start implementing roles --- app/Main.hs | 8 ++++ src/API.hs | 33 +++++++++++++++++ src/Control/Role.hs | 38 +++++++++++++++++++ src/Model/Role.hs | 89 +++++++++++++++++++++++++++++++-------------- src/Types.hs | 1 + src/Types/Role.hs | 26 +++++++++++++ 6 files changed, 167 insertions(+), 28 deletions(-) create mode 100644 src/Control/Role.hs diff --git a/app/Main.hs b/app/Main.hs index a78bfc1..5108941 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -207,6 +207,14 @@ app block_registration initState = avatarUpdate :<|> avatarList :<|> + roleList :<|> + roleNew :<|> + roleUpdate :<|> + roleDelete :<|> + roleAssociationList :<|> + roleAssociationSubmit :<|> + roleAssociationDelete :<|> + metaGet ) diff --git a/src/API.hs b/src/API.hs index 01b5a88..2f09dde 100644 --- a/src/API.hs +++ b/src/API.hs @@ -68,6 +68,23 @@ type MateAPI = "v1" :> ( :> ReqBody '[JSON] AvatarData :> Patch '[JSON] () :<|> "avatar" :> "list" :> Get '[JSON] [Avatar] + :<|> "role" :> "list" + :> Get '[JSON] [Role] + :<|> "role" :> AuthProtect "header-auth" :> ReqBody '[JSON] RoleSubmit + :> Post '[JSON] Int + :<|> "role" :> AuthProtect "header-auth" :> ReqBody '[JSON] Role + :> Patch '[JSON] () + :<|> "role" :> AuthProtect "header-auth" :> ReqBody '[JSON] Int + :> Delete '[JSON] () + :<|> "role" :> "assiciation" :> "list" + :> Get '[JSON] [RoleAssociation] + :<|> "role" :> "association" :> AuthProtect "header-auth" + :> ReqBody '[JSON] RoleAssociationSubmit + :> Post '[JSON] Int + :<|> "role" :> "association" :> AuthProtect "header-auth" + :> ReqBody '[JSON] Int + :> Delete '[JSON] () + :<|> "meta" :> Get '[JSON] MetaInformation ) @@ -104,6 +121,14 @@ avaterInsertLink :: Link avatarUpdateLink :: Int -> Link avatarListLink :: Link +roleListLink :: Link +roleNewLink :: Link +roleUpdateLink :: Link +roleDeleteLink :: Link +roleAssociationListLink :: Link +roleAssociationSubmitLink :: Link +roleAssociationDeleteLink :: Link + metaGetLink :: Link ( authGetLink :<|> @@ -138,5 +163,13 @@ metaGetLink :: Link avatarUpdateLink :<|> avatarListLink :<|> + roleListLink :<|> + roleNewLink :<|> + roleUpdateLink :<|> + roleDeleteLink :<|> + roleAssociationListLink :<|> + roleAssociationSubmitLink :<|> + roleAssociationDeleteLink :<|> + metaGetLink ) = allLinks (Proxy :: Proxy MateAPI) diff --git a/src/Control/Role.hs b/src/Control/Role.hs new file mode 100644 index 0000000..6229a1d --- /dev/null +++ b/src/Control/Role.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE OverloadedStrings #-} +module Control.Role where + +import Servant + +import Control.Monad (void, when) + +import Control.Monad.Reader (asks) + +import Control.Monad.IO.Class (liftIO) + +import qualified Data.Text as T + +-- internal imports + +import Types +import Model + +roleList :: MateHandler [Role] +roleList = do + conn <- asks rsConnection + selectAllRoles conn + +roleNew = notImpelemented + +roleUpdate = notImpelemented + +roleDelete = notImpelemented + +roleAssociationList = notImpelemented + +roleAssociationSubmit = notImpelemented + +roleAssociationDelete = notImpelemented + +notImplemented = throwError $ err501 + { errBody = "Function has not yet been implemented!" + } diff --git a/src/Model/Role.hs b/src/Model/Role.hs index fd74da3..7d955a6 100644 --- a/src/Model/Role.hs +++ b/src/Model/Role.hs @@ -161,6 +161,35 @@ runInsertInitialRoles conn = do } return $ a ++ b +selectAllRoles + :: PGS.Connection + -> MateHandler [Role] +selectAllRoles conn = do + rawRoles <- liftIO $ runSelect conn ( + 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 + + queryRoleIdByName :: T.Text -> PGS.Connection @@ -170,20 +199,22 @@ queryRoleIdByName name con = do keepWhen (\(_, rname, _, _, _, _, _, _, _, _, _, _, _) -> C.constant name == rname) <<< queryTable roleTable ) :: MateHandler - ( Int - , T.Text - , Bool - , Bool - , Bool - , Bool - , Bool - , Bool - , Bool - , Bool - , Bool - , Bool - , Bool - ) + [ + ( Int + , T.Text + , Bool + , Bool + , Bool + , Bool + , Bool + , Bool + , Bool + , Bool + , Bool + , Bool + , Bool + ) + ] return $ (\(rid, _, _, _, _, _, _, _, _, _, _, _, _) -> rid) (head roles) queryRoleIdByCapabilities @@ -196,20 +227,22 @@ queryRoleIdByName caps con = do C.constant caps == (c1, c2, c3, vc4, c5, c6, c7, c8, c9, c10, c11)) <<< queryTable roleTable ) :: MateHandler - ( Int - , T.Text - , Bool - , Bool - , Bool - , Bool - , Bool - , Bool - , Bool - , Bool - , Bool - , Bool - , Bool - ) + [ + ( Int + , T.Text + , Bool + , Bool + , Bool + , Bool + , Bool + , Bool + , Bool + , Bool + , Bool + , Bool + , Bool + ) + ] return $ (\(rid, _, _, _, _, _, _, _, _, _, _, _, _) -> rid) (head roles) associateUserToRole diff --git a/src/Types.hs b/src/Types.hs index 1cd36e5..56ffe0b 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -11,4 +11,5 @@ import Types.Purchase as T import Types.Amount as T import Types.Journal as T import Types.Avatar as T +import Types.Role as T import Types.Meta as T diff --git a/src/Types/Role.hs b/src/Types/Role.hs index f493a38..b3e3636 100644 --- a/src/Types/Role.hs +++ b/src/Types/Role.hs @@ -17,3 +17,29 @@ data Role = Role , roleCanManageSuppliers :: Bool , roleCanManageSettings :: Bool } + +data RoleSubmit = RoleSubmit + { roleSubmitName :: T.Text + , roleSubmitCanRefillStock :: Bool + , roleSubmitCanAddProduct :: Bool + , roleSubmitCanViewJournal :: Bool + , roleSubmitCanPayInvoice :: Bool + , roleSubmitCanPayOut :: Bool + , roleSubmitCanManageProducts :: Bool + , roleSubmitCanManageJournal :: Bool + , roleSubmitCanManageUsers :: Bool + , roleSubmitCanManageRoles :: Bool + , roleSubmitCanManageSuppliers :: Bool + , roleSubmitCanManageSettings :: Bool + } + +data RoleAssociation = RoleAssociation + { roleAssociationId :: Int + , roleAssociationUser :: Int + , roleAssociationRole :: Int + } + +data RoleAssociationSubmit = RoleAssociationSubmit + { roleAssociationSubmitUser :: Int + , roleAssociationSubmitRole :: Int + }