make role queries and associate new users with no cap role

This commit is contained in:
nek0 2020-07-19 07:01:53 +02:00
parent e8d7c4b840
commit 4de00a258b
2 changed files with 73 additions and 0 deletions

View file

@ -28,6 +28,9 @@ userNew (UserSubmit ident email passhash) = do
conn <- asks rsConnection conn <- asks rsConnection
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
(False, False, False, False, False, False, False, False, False, False, False)
void $ assiciateuserToRole uid baseRoleId
return uid return uid
userGet userGet

View file

@ -160,3 +160,73 @@ runInsertInitialRoles conn = do
, iOnConflict = Nothing , iOnConflict = Nothing
} }
return $ a ++ b return $ a ++ b
queryRoleIdByName
:: T.Text
-> PGS.Connection
-> MateHandler Int
queryRoleIdByName name con = do
roles <- liftIO $ runSelect conn (
keepWhen (\(_, rname, _, _, _, _, _, _, _, _, _, _, _) ->
C.constant name == rname) <<< queryTable roleTable
) :: MateHandler
( Int
, T.Text
, Bool
, Bool
, Bool
, Bool
, Bool
, Bool
, Bool
, Bool
, Bool
, Bool
, Bool
)
return $ (\(rid, _, _, _, _, _, _, _, _, _, _, _, _) -> rid) (head roles)
queryRoleIdByCapabilities
:: (Bool, Bool, Bool, Bool, Bool, Bool, Bool, Bool, Bool, Bool, Bool)
-> PGS.Connection
-> MateHandler Int
queryRoleIdByName caps con = do
roles <- liftIO $ runSelect conn (
keepWhen (\(_, _, c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11) ->
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
)
return $ (\(rid, _, _, _, _, _, _, _, _, _, _, _, _) -> rid) (head roles)
associateUserToRole
:: Int -- ^ User id
:: Int -- ^ Role id
:: PGS.Connection
:: Matehandler Int -- ^ Resulting UserToRole id
associateUserToRole uid rid conn =
a <- runInsert_ conn $ Insert
{ iTable = userToRoleTable
, iRows =
[
( C.constant (Nothing :: Maybe Int)
, C.constant uid
, C.constant rid
)
]
, iReturning = rReturning (\(id_, _, _) -> id_ )
, iOnConflict = Nothing
}