started fixing roles and database communication
This commit is contained in:
parent
b69acb3dbf
commit
dc2a1018b1
10 changed files with 89 additions and 122 deletions
|
@ -84,6 +84,9 @@ library
|
||||||
, Types.Avatar
|
, Types.Avatar
|
||||||
, Types.Meta
|
, Types.Meta
|
||||||
, Types.Role
|
, Types.Role
|
||||||
|
, Classes
|
||||||
|
, Classes.FromDatabase
|
||||||
|
, Classes.ToDatabase
|
||||||
, Util
|
, Util
|
||||||
-- other-extensions:
|
-- other-extensions:
|
||||||
build-depends: base >=4.12.0.0 && < 5
|
build-depends: base >=4.12.0.0 && < 5
|
||||||
|
|
6
src/Classes.hs
Normal file
6
src/Classes.hs
Normal file
|
@ -0,0 +1,6 @@
|
||||||
|
module Classes
|
||||||
|
( module C
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Classes.FromDatabase as C
|
||||||
|
import Classes.ToDatabase as C
|
8
src/Classes/FromDatabase.hs
Normal file
8
src/Classes/FromDatabase.hs
Normal file
|
@ -0,0 +1,8 @@
|
||||||
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
|
module Classes.FromDatabase where
|
||||||
|
|
||||||
|
class FromDatabase a where
|
||||||
|
|
||||||
|
type OutTuple a :: *
|
||||||
|
|
||||||
|
fromDatabase :: OutTuple a -> a
|
8
src/Classes/ToDatabase.hs
Normal file
8
src/Classes/ToDatabase.hs
Normal file
|
@ -0,0 +1,8 @@
|
||||||
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
|
module Classes.ToDatabase where
|
||||||
|
|
||||||
|
class ToDatabase a where
|
||||||
|
|
||||||
|
type InTuple a :: *
|
||||||
|
|
||||||
|
toDatabase :: a -> InTuple a
|
|
@ -19,10 +19,7 @@ journalShow
|
||||||
-> Maybe Int
|
-> Maybe Int
|
||||||
-> MateHandler [JournalEntry]
|
-> MateHandler [JournalEntry]
|
||||||
journalShow (Just (uid, method)) mlimit moffset = do
|
journalShow (Just (uid, method)) mlimit moffset = do
|
||||||
maySeeJournal <- anyM
|
if method `elem` [PrimaryPass, ChallengeResponse]
|
||||||
(checkCapability uid)
|
|
||||||
[roleCanViewJournal, roleCanManageJournal]
|
|
||||||
if method `elem` [PrimaryPass, ChallengeResponse] && maySeeJournal
|
|
||||||
then do
|
then do
|
||||||
conn <- asks rsConnection
|
conn <- asks rsConnection
|
||||||
selectJournalEntries mlimit moffset conn
|
selectJournalEntries mlimit moffset conn
|
||||||
|
|
|
@ -25,12 +25,12 @@ roleNew
|
||||||
:: Maybe (Int, AuthMethod)
|
:: Maybe (Int, AuthMethod)
|
||||||
-> RoleSubmit
|
-> RoleSubmit
|
||||||
-> MateHandler Int
|
-> MateHandler Int
|
||||||
roleNew (Just (uid, auth)) (RoleSubmit name c1 c2 c3 c4 c5 c6 c7 c8 c9) =
|
roleNew (Just (uid, auth)) (RoleSubmit name c1 c2 c3 c4 c5 c6 c7 c8 c9 c10) =
|
||||||
do
|
do
|
||||||
isRoleManager <- checkCapability uid roleCanManageRoles
|
isRoleManager <- checkCapability uid roleCanManageRoles
|
||||||
if auth `elem` [PrimaryPass, ChallengeResponse] && isRoleManager
|
if auth `elem` [PrimaryPass, ChallengeResponse] && isRoleManager
|
||||||
then
|
then
|
||||||
insertRole name c1 c2 c3 c4 c5 c6 c7 c8 c9 =<< asks rsConnection
|
insertRole name c1 c2 c3 c4 c5 c6 c7 c8 c9 c10 =<< asks rsConnection
|
||||||
else
|
else
|
||||||
throwError $ err401
|
throwError $ err401
|
||||||
{ errBody = "You are not authorized for this action."
|
{ errBody = "You are not authorized for this action."
|
||||||
|
|
|
@ -30,7 +30,7 @@ userNew (UserSubmit ident email passhash) = do
|
||||||
uid <- insertUser ident email (utctDay now) conn
|
uid <- insertUser ident email (utctDay now) conn
|
||||||
void $ putUserAuthInfo uid PrimaryPass "Initial password" passhash conn
|
void $ putUserAuthInfo uid PrimaryPass "Initial password" passhash conn
|
||||||
baseRoleId <- queryRoleIdByCapabilities
|
baseRoleId <- queryRoleIdByCapabilities
|
||||||
(False, False, False, False, False, False, False, False, False)
|
(False, False, False, False, False, False, False, False, False, False)
|
||||||
conn
|
conn
|
||||||
void $ associateUserToRole uid baseRoleId conn
|
void $ associateUserToRole uid baseRoleId conn
|
||||||
return uid
|
return uid
|
||||||
|
|
|
@ -5,7 +5,7 @@ module Model.Role where
|
||||||
|
|
||||||
import qualified Database.PostgreSQL.Simple as PGS
|
import qualified Database.PostgreSQL.Simple as PGS
|
||||||
|
|
||||||
import Data.Profunctor.Product (p2, p11)
|
import Data.Profunctor.Product (p2, p12)
|
||||||
|
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
|
|
||||||
|
@ -22,6 +22,7 @@ import Control.Monad.IO.Class (liftIO)
|
||||||
-- internal imports
|
-- internal imports
|
||||||
|
|
||||||
import Types
|
import Types
|
||||||
|
import Classes
|
||||||
|
|
||||||
initRole :: PGS.Query
|
initRole :: PGS.Query
|
||||||
initRole = mconcat
|
initRole = mconcat
|
||||||
|
@ -29,15 +30,13 @@ initRole = mconcat
|
||||||
, "role_id SERIAL NOT NULL,"
|
, "role_id SERIAL NOT NULL,"
|
||||||
, "role_name TEXT NOT NULL,"
|
, "role_name TEXT NOT NULL,"
|
||||||
, "role_can_refill_stock BOOLEAN NOT NULL,"
|
, "role_can_refill_stock BOOLEAN NOT NULL,"
|
||||||
-- , "role_can_add_product BOOLEAN NOT NULL,"
|
|
||||||
, "role_can_view_journal BOOLEAN NOT NULL,"
|
|
||||||
, "role_can_pay_invoice BOOLEAN NOT NULL,"
|
, "role_can_pay_invoice BOOLEAN NOT NULL,"
|
||||||
, "role_can_pay_out BOOLEAN NOT NULL,"
|
, "role_can_pay_out BOOLEAN NOT NULL,"
|
||||||
, "role_can_manage_products BOOLEAN NOT NULL,"
|
, "role_can_manage_products BOOLEAN NOT NULL,"
|
||||||
, "role_can_manage_journal BOOLEAN NOT NULL,"
|
, "role_can_manage_journal BOOLEAN NOT NULL,"
|
||||||
-- , "role_can_manage_users BOOLEAN NOT NULL,"
|
|
||||||
, "role_can_manage_roles BOOLEAN NOT NULL,"
|
, "role_can_manage_roles BOOLEAN NOT NULL,"
|
||||||
, "role_can_manage_suppliers BOOLEAN NOT NULL,"
|
, "role_can_manage_suppliers BOOLEAN NOT NULL,"
|
||||||
|
, "role_can_manage_avatars BOOLEAN NOT NULL,"
|
||||||
, "role_can_manage_settings BOOLEAN NOT NULL,"
|
, "role_can_manage_settings BOOLEAN NOT NULL,"
|
||||||
, "PRIMARY KEY (role_id),"
|
, "PRIMARY KEY (role_id),"
|
||||||
, "UNIQUE (role_name)"
|
, "UNIQUE (role_name)"
|
||||||
|
@ -57,13 +56,12 @@ roleTable :: Table
|
||||||
( Maybe (Field SqlInt4)
|
( Maybe (Field SqlInt4)
|
||||||
, Field SqlText
|
, Field SqlText
|
||||||
, Field SqlBool
|
, Field SqlBool
|
||||||
-- , Field SqlBool
|
|
||||||
, Field SqlBool
|
, Field SqlBool
|
||||||
, Field SqlBool
|
, Field SqlBool
|
||||||
, Field SqlBool
|
, Field SqlBool
|
||||||
, Field SqlBool
|
, Field SqlBool
|
||||||
, Field SqlBool
|
, Field SqlBool
|
||||||
-- , Field SqlBool
|
, Field SqlBool
|
||||||
, Field SqlBool
|
, Field SqlBool
|
||||||
, Field SqlBool
|
, Field SqlBool
|
||||||
, Field SqlBool
|
, Field SqlBool
|
||||||
|
@ -71,31 +69,29 @@ roleTable :: Table
|
||||||
( Field SqlInt4
|
( Field SqlInt4
|
||||||
, Field SqlText
|
, Field SqlText
|
||||||
, Field SqlBool
|
, Field SqlBool
|
||||||
-- , Field SqlBool
|
|
||||||
, Field SqlBool
|
, Field SqlBool
|
||||||
, Field SqlBool
|
, Field SqlBool
|
||||||
, Field SqlBool
|
, Field SqlBool
|
||||||
, Field SqlBool
|
, Field SqlBool
|
||||||
, Field SqlBool
|
, Field SqlBool
|
||||||
-- , Field SqlBool
|
, Field SqlBool
|
||||||
, Field SqlBool
|
, Field SqlBool
|
||||||
, Field SqlBool
|
, Field SqlBool
|
||||||
, Field SqlBool
|
, Field SqlBool
|
||||||
)
|
)
|
||||||
roleTable = table "role" (
|
roleTable = table "role" (
|
||||||
p11
|
p12
|
||||||
( tableField "role_id"
|
( tableField "role_id"
|
||||||
, tableField "role_name"
|
, tableField "role_name"
|
||||||
, tableField "role_can_refill_stock"
|
, tableField "role_can_refill_stock"
|
||||||
-- , tableField "role_can_add_product"
|
|
||||||
, tableField "role_can_view_journal"
|
, tableField "role_can_view_journal"
|
||||||
, tableField "role_can_pay_invoice"
|
, tableField "role_can_pay_invoice"
|
||||||
, tableField "role_can_pay_out"
|
, tableField "role_can_pay_out"
|
||||||
, tableField "role_can_manage_products"
|
, tableField "role_can_manage_products"
|
||||||
, tableField "role_can_manage_journal"
|
, tableField "role_can_manage_journal"
|
||||||
-- , tableField "role_can_manage_users"
|
|
||||||
, tableField "role_can_manage_roles"
|
, tableField "role_can_manage_roles"
|
||||||
, tableField "role_can_manage_suppliers"
|
, tableField "role_can_manage_suppliers"
|
||||||
|
, tableField "role_can_manage_avatars"
|
||||||
, tableField "role_can_manage_settings"
|
, tableField "role_can_manage_settings"
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
@ -127,19 +123,18 @@ runInsertInitialRoles conn = do
|
||||||
( C.constant (Nothing :: Maybe Int)
|
( C.constant (Nothing :: Maybe Int)
|
||||||
, C.constant ("Administrator" :: String)
|
, C.constant ("Administrator" :: String)
|
||||||
, C.constant True
|
, C.constant True
|
||||||
-- , C.constant True
|
|
||||||
, C.constant True
|
, C.constant True
|
||||||
, C.constant True
|
, C.constant True
|
||||||
, C.constant True
|
, C.constant True
|
||||||
, C.constant True
|
, C.constant True
|
||||||
, C.constant True
|
, C.constant True
|
||||||
-- , C.constant True
|
, C.constant True
|
||||||
, C.constant True
|
, C.constant True
|
||||||
, C.constant True
|
, C.constant True
|
||||||
, C.constant True
|
, C.constant True
|
||||||
)
|
)
|
||||||
]
|
]
|
||||||
, iReturning = rReturning (\(id_, _, _, _, _, _, _, _, _, _, _) -> id_ )
|
, iReturning = rReturning (\(id_, _, _, _, _, _, _, _, _, _, _, _) -> id_ )
|
||||||
, iOnConflict = Nothing
|
, iOnConflict = Nothing
|
||||||
}
|
}
|
||||||
b <- runInsert_ conn $ Insert
|
b <- runInsert_ conn $ Insert
|
||||||
|
@ -149,19 +144,18 @@ runInsertInitialRoles conn = do
|
||||||
( C.constant (Nothing :: Maybe Int)
|
( C.constant (Nothing :: Maybe Int)
|
||||||
, C.constant ("User" :: String)
|
, C.constant ("User" :: String)
|
||||||
, C.constant False
|
, C.constant False
|
||||||
-- , C.constant False
|
|
||||||
, C.constant False
|
, C.constant False
|
||||||
, C.constant False
|
, C.constant False
|
||||||
, C.constant False
|
, C.constant False
|
||||||
, C.constant False
|
, C.constant False
|
||||||
, C.constant False
|
, C.constant False
|
||||||
-- , C.constant False
|
, C.constant False
|
||||||
, C.constant False
|
, C.constant False
|
||||||
, C.constant False
|
, C.constant False
|
||||||
, C.constant False
|
, C.constant False
|
||||||
)
|
)
|
||||||
]
|
]
|
||||||
, iReturning = rReturning (\(id_, _, _, _, _, _, _, _, _, _, _) -> id_ )
|
, iReturning = rReturning (\(id_, _, _, _, _, _, _, _, _, _, _, _) -> id_ )
|
||||||
, iOnConflict = Nothing
|
, iOnConflict = Nothing
|
||||||
}
|
}
|
||||||
return $ a ++ b
|
return $ a ++ b
|
||||||
|
@ -170,79 +164,36 @@ selectAllRoles
|
||||||
:: PGS.Connection
|
:: PGS.Connection
|
||||||
-> MateHandler [Role]
|
-> MateHandler [Role]
|
||||||
selectAllRoles conn = do
|
selectAllRoles conn = do
|
||||||
rawRoles <- liftIO $ runSelect conn (
|
liftIO $ map fromDatabase <$> runSelect conn (
|
||||||
queryTable roleTable
|
queryTable roleTable
|
||||||
) :: MateHandler
|
) :: MateHandler [Role]
|
||||||
[
|
|
||||||
( 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) ->
|
|
||||||
Role id_ name c1 c2 c3 c4 c5 c6 c7 c8 c9)
|
|
||||||
rawRoles
|
|
||||||
|
|
||||||
|
|
||||||
selectRoleList
|
selectRoleList
|
||||||
:: [Int]
|
:: [Int]
|
||||||
-> PGS.Connection
|
-> PGS.Connection
|
||||||
-> MateHandler [Role]
|
-> MateHandler [Role]
|
||||||
selectRoleList ids conn = do
|
selectRoleList ids conn = do
|
||||||
rawRoles <- liftIO $ runSelect conn (
|
liftIO $ map fromDatabase <$> runSelect conn (
|
||||||
keepWhen (\(id_, _, _, _, _, _, _, _, _, _, _) ->
|
keepWhen (\(id_, _, _, _, _, _, _, _, _, _, _, _) ->
|
||||||
in_ (map C.constant ids) id_)
|
in_ (map C.constant ids) id_)
|
||||||
<<< queryTable roleTable
|
<<< queryTable roleTable
|
||||||
) :: MateHandler
|
) :: MateHandler [Role]
|
||||||
[
|
|
||||||
( 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) ->
|
|
||||||
Role id_ name c1 c2 c3 c4 c5 c6 c7 c8 c9)
|
|
||||||
rawRoles
|
|
||||||
|
|
||||||
|
|
||||||
insertRole
|
insertRole
|
||||||
:: T.Text
|
:: T.Text
|
||||||
-> Bool
|
-> Bool
|
||||||
-- -> Bool
|
|
||||||
-> Bool
|
-> Bool
|
||||||
-> Bool
|
-> Bool
|
||||||
-> Bool
|
-> Bool
|
||||||
-> Bool
|
-> Bool
|
||||||
-> Bool
|
-> Bool
|
||||||
-- -> Bool
|
-> Bool
|
||||||
-> Bool
|
-> Bool
|
||||||
-> Bool
|
-> Bool
|
||||||
-> Bool
|
-> Bool
|
||||||
-> PGS.Connection
|
-> PGS.Connection
|
||||||
-> MateHandler Int
|
-> MateHandler Int
|
||||||
insertRole name c1 c2 c3 c4 c5 c6 c7 c8 c9 conn = do
|
insertRole name c1 c2 c3 c4 c5 c6 c7 c8 c9 c10 conn = do
|
||||||
head <$> liftIO (runInsert_ conn $ Insert
|
head <$> liftIO (runInsert_ conn $ Insert
|
||||||
{ iTable = roleTable
|
{ iTable = roleTable
|
||||||
, iRows =
|
, iRows =
|
||||||
|
@ -258,9 +209,10 @@ insertRole name c1 c2 c3 c4 c5 c6 c7 c8 c9 conn = do
|
||||||
, C.constant c7
|
, C.constant c7
|
||||||
, C.constant c8
|
, C.constant c8
|
||||||
, C.constant c9
|
, C.constant c9
|
||||||
|
, C.constant c10
|
||||||
)
|
)
|
||||||
]
|
]
|
||||||
, iReturning = rReturning (\(id_, _, _, _, _, _, _, _, _, _, _) -> id_ )
|
, iReturning = rReturning (\(id_, _, _, _, _, _, _, _, _, _, _, _) -> id_ )
|
||||||
, iOnConflict = Nothing
|
, iOnConflict = Nothing
|
||||||
})
|
})
|
||||||
|
|
||||||
|
@ -270,34 +222,19 @@ queryRoleIdByName
|
||||||
-> PGS.Connection
|
-> PGS.Connection
|
||||||
-> MateHandler Int
|
-> MateHandler Int
|
||||||
queryRoleIdByName name conn = do
|
queryRoleIdByName name conn = do
|
||||||
roles <- liftIO $ runSelect conn (
|
liftIO $ roleID . fromDatabase . head <$> runSelect conn (
|
||||||
keepWhen (\(_, rname, _, _, _, _, _, _, _, _, _) ->
|
keepWhen (\(_, rname, _, _, _, _, _, _, _, _, _, _) ->
|
||||||
C.constant name .== rname) <<< queryTable roleTable
|
C.constant name .== rname) <<< queryTable roleTable
|
||||||
) :: MateHandler
|
) :: MateHandler Int
|
||||||
[
|
|
||||||
( Int
|
|
||||||
, T.Text
|
|
||||||
, Bool
|
|
||||||
, Bool
|
|
||||||
, Bool
|
|
||||||
, Bool
|
|
||||||
, Bool
|
|
||||||
, Bool
|
|
||||||
, Bool
|
|
||||||
, Bool
|
|
||||||
, Bool
|
|
||||||
)
|
|
||||||
]
|
|
||||||
return $ (\(rid, _, _, _, _, _, _, _, _, _, _) -> rid) (head roles)
|
|
||||||
|
|
||||||
queryRoleIdByCapabilities
|
queryRoleIdByCapabilities
|
||||||
:: (Bool, Bool, Bool, Bool, Bool, Bool, Bool, Bool, Bool)
|
:: (Bool, Bool, Bool, Bool, Bool, Bool, Bool, Bool, Bool, Bool)
|
||||||
-> PGS.Connection
|
-> PGS.Connection
|
||||||
-> MateHandler Int
|
-> MateHandler Int
|
||||||
queryRoleIdByCapabilities (p1, p2, p3, p4, p5, p6, p7, p8, p9) conn =
|
queryRoleIdByCapabilities (p1, p2, p3, p4, p5, p6, p7, p8, p9, p10) conn =
|
||||||
do
|
do
|
||||||
roles <- liftIO $ runSelect conn (
|
liftIO $ roleID . fromDatabase . head <$> runSelect conn (
|
||||||
keepWhen (\(_, _, c1, c2, c3, c4, c5, c6, c7, c8, c9) ->
|
keepWhen (\(_, _, c1, c2, c3, c4, c5, c6, c7, c8, c9, c10) ->
|
||||||
C.constant p1 .== c1 .&&
|
C.constant p1 .== c1 .&&
|
||||||
C.constant p2 .== c2 .&&
|
C.constant p2 .== c2 .&&
|
||||||
C.constant p3 .== c3 .&&
|
C.constant p3 .== c3 .&&
|
||||||
|
@ -306,25 +243,11 @@ queryRoleIdByCapabilities (p1, p2, p3, p4, p5, p6, p7, p8, p9) conn =
|
||||||
C.constant p6 .== c6 .&&
|
C.constant p6 .== c6 .&&
|
||||||
C.constant p7 .== c7 .&&
|
C.constant p7 .== c7 .&&
|
||||||
C.constant p8 .== c8 .&&
|
C.constant p8 .== c8 .&&
|
||||||
C.constant p9 .== c9
|
C.constant p9 .== c9 .&&
|
||||||
|
C.constant p10 .== c10
|
||||||
)
|
)
|
||||||
<<< queryTable roleTable
|
<<< queryTable roleTable
|
||||||
) :: MateHandler
|
) :: MateHandler Int
|
||||||
[
|
|
||||||
( Int
|
|
||||||
, T.Text
|
|
||||||
, Bool
|
|
||||||
, Bool
|
|
||||||
, Bool
|
|
||||||
, Bool
|
|
||||||
, Bool
|
|
||||||
, Bool
|
|
||||||
, Bool
|
|
||||||
, Bool
|
|
||||||
, Bool
|
|
||||||
)
|
|
||||||
]
|
|
||||||
return $ (\(rid, _, _, _, _, _, _, _, _, _, _) -> rid) (head roles)
|
|
||||||
|
|
||||||
|
|
||||||
selectAllRoleAssociations
|
selectAllRoleAssociations
|
||||||
|
@ -399,10 +322,10 @@ updateRole
|
||||||
-> RoleSubmit -- The role with already updated info
|
-> RoleSubmit -- The role with already updated info
|
||||||
-> PGS.Connection
|
-> PGS.Connection
|
||||||
-> MateHandler Int64
|
-> MateHandler Int64
|
||||||
updateRole rid role@(RoleSubmit name c1 c2 c3 c4 c5 c6 c7 c8 c9) conn =
|
updateRole rid role@(RoleSubmit name c1 c2 c3 c4 c5 c6 c7 c8 c9 c10) conn =
|
||||||
liftIO $ runUpdate_ conn $ Update
|
liftIO $ runUpdate_ conn $ Update
|
||||||
{ uTable = roleTable
|
{ uTable = roleTable
|
||||||
, uUpdateWith = updateEasy (\(id_, _, _, _, _, _, _, _, _, _, _) ->
|
, uUpdateWith = updateEasy (\(id_, _, _, _, _, _, _, _, _, _, _, _) ->
|
||||||
( id_
|
( id_
|
||||||
, C.constant name
|
, C.constant name
|
||||||
, C.constant c1
|
, C.constant c1
|
||||||
|
@ -414,9 +337,10 @@ updateRole rid role@(RoleSubmit name c1 c2 c3 c4 c5 c6 c7 c8 c9) conn =
|
||||||
, C.constant c7
|
, C.constant c7
|
||||||
, C.constant c8
|
, C.constant c8
|
||||||
, C.constant c9
|
, C.constant c9
|
||||||
|
, C.constant c10
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
, uWhere = \(id_, _, _, _, _, _, _, _, _, _, _) ->
|
, uWhere = \(id_, _, _, _, _, _, _, _, _, _, _, _) ->
|
||||||
id_ .== C.constant rid
|
id_ .== C.constant rid
|
||||||
, uReturning = rCount
|
, uReturning = rCount
|
||||||
}
|
}
|
||||||
|
@ -429,6 +353,6 @@ deleteRole rid conn =
|
||||||
liftIO $ runDelete_ conn $ Delete
|
liftIO $ runDelete_ conn $ Delete
|
||||||
{ dTable = roleTable
|
{ dTable = roleTable
|
||||||
, dWhere =
|
, dWhere =
|
||||||
\(id_, _, _, _, _, _, _, _, _, _, _) -> id_ .== C.constant rid
|
\(id_, _, _, _, _, _, _, _, _, _, _, _) -> id_ .== C.constant rid
|
||||||
, dReturning = rCount
|
, dReturning = rCount
|
||||||
}
|
}
|
||||||
|
|
|
@ -10,6 +10,7 @@ import GHC.Generics
|
||||||
data MetaInformation = MetaInformation
|
data MetaInformation = MetaInformation
|
||||||
{ metaInfoVersion :: T.Text
|
{ metaInfoVersion :: T.Text
|
||||||
, metaInfoCurrency :: T.Text
|
, metaInfoCurrency :: T.Text
|
||||||
|
, metaInfoDecimals :: Int
|
||||||
}
|
}
|
||||||
deriving (Show, Generic)
|
deriving (Show, Generic)
|
||||||
|
|
||||||
|
|
|
@ -1,4 +1,5 @@
|
||||||
{-# LANGUAGE DeriveGeneric #-}
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
module Types.Role where
|
module Types.Role where
|
||||||
|
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
|
@ -6,12 +7,15 @@ import Data.Aeson
|
||||||
|
|
||||||
import GHC.Generics
|
import GHC.Generics
|
||||||
|
|
||||||
|
-- internal imports
|
||||||
|
|
||||||
|
import Classes.ToDatabase
|
||||||
|
import Classes.FromDatabase
|
||||||
|
|
||||||
data Role = Role
|
data Role = Role
|
||||||
{ roleID :: Int
|
{ roleID :: Int
|
||||||
, roleName :: T.Text
|
, roleName :: T.Text
|
||||||
, roleCanRefillStock :: Bool
|
, roleCanRefillStock :: Bool
|
||||||
-- , roleCanAddProduct :: Bool
|
|
||||||
-- , roleCanViewJournal :: Bool
|
|
||||||
-- | paying invoice only adds to user funds
|
-- | paying invoice only adds to user funds
|
||||||
, roleCanPayInvoice :: Bool
|
, roleCanPayInvoice :: Bool
|
||||||
-- | paying out actually removes money from the cashier
|
-- | paying out actually removes money from the cashier
|
||||||
|
@ -21,6 +25,7 @@ data Role = Role
|
||||||
, roleCanManageUsers :: Bool
|
, roleCanManageUsers :: Bool
|
||||||
, roleCanManageRoles :: Bool
|
, roleCanManageRoles :: Bool
|
||||||
, roleCanManageSuppliers :: Bool
|
, roleCanManageSuppliers :: Bool
|
||||||
|
, roleCanManageAvatars :: Bool
|
||||||
, roleCanManageSettings :: Bool
|
, roleCanManageSettings :: Bool
|
||||||
}
|
}
|
||||||
deriving (Generic, Show)
|
deriving (Generic, Show)
|
||||||
|
@ -30,11 +35,25 @@ instance ToJSON Role where
|
||||||
|
|
||||||
instance FromJSON Role
|
instance FromJSON Role
|
||||||
|
|
||||||
|
instance ToDatabase Role where
|
||||||
|
|
||||||
|
type InTuple Role =
|
||||||
|
(Int, T.Text, Bool, Bool, Bool, Bool, Bool, Bool, Bool, Bool, Bool, Bool)
|
||||||
|
|
||||||
|
toDatabase (Role id_ name c1 c2 c3 c4 c5 c6 c7 c8 c9 c10) =
|
||||||
|
(id_, name, c1, c2, c3, c4, c5, c6, c7, c8, c9, c10)
|
||||||
|
|
||||||
|
instance FromDatabase Role where
|
||||||
|
|
||||||
|
type OutTuple Role =
|
||||||
|
(Int, T.Text, Bool, Bool, Bool, Bool, Bool, Bool, Bool, Bool, Bool, Bool)
|
||||||
|
|
||||||
|
fromDatabase (id_, name, c1, c2, c3, c4, c5, c6, c7, c8, c9, c10) =
|
||||||
|
Role id_ name c1 c2 c3 c4 c5 c6 c7 c8 c9 c10
|
||||||
|
|
||||||
data RoleSubmit = RoleSubmit
|
data RoleSubmit = RoleSubmit
|
||||||
{ roleSubmitName :: T.Text
|
{ roleSubmitName :: T.Text
|
||||||
, roleSubmitCanRefillStock :: Bool
|
, roleSubmitCanRefillStock :: Bool
|
||||||
-- , roleSubmitCanAddProduct :: Bool
|
|
||||||
-- , roleSubmitCanViewJournal :: Bool
|
|
||||||
, roleSubmitCanPayInvoice :: Bool
|
, roleSubmitCanPayInvoice :: Bool
|
||||||
, roleSubmitCanPayOut :: Bool
|
, roleSubmitCanPayOut :: Bool
|
||||||
, roleSubmitCanManageProducts :: Bool
|
, roleSubmitCanManageProducts :: Bool
|
||||||
|
@ -42,6 +61,7 @@ data RoleSubmit = RoleSubmit
|
||||||
, roleSubmitCanManageUsers :: Bool
|
, roleSubmitCanManageUsers :: Bool
|
||||||
, roleSubmitCanManageRoles :: Bool
|
, roleSubmitCanManageRoles :: Bool
|
||||||
, roleSubmitCanManageSuppliers :: Bool
|
, roleSubmitCanManageSuppliers :: Bool
|
||||||
|
, roleSubmitCanManageAvatars :: Bool
|
||||||
, roleSubmitCanManageSettings :: Bool
|
, roleSubmitCanManageSettings :: Bool
|
||||||
}
|
}
|
||||||
deriving (Generic, Show)
|
deriving (Generic, Show)
|
||||||
|
|
Loading…
Reference in a new issue