start implementing roles

app/Main.hs

@@ -207,6 +207,14 @@ app block_registration initState =
         avatarUpdate :<|>
         avatarList :<|>
 
+        roleList :<|>
+        roleNew :<|>
+        roleUpdate :<|>
+        roleDelete :<|>
+        roleAssociationList :<|>
+        roleAssociationSubmit :<|>
+        roleAssociationDelete :<|>
+
         metaGet
       )
 

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)

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!"
+  }

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

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

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
+  }