From 4de00a258b4c0b35cdfa09911b614d8bac457f4f Mon Sep 17 00:00:00 2001 From: nek0 Date: Sun, 19 Jul 2020 07:01:53 +0200 Subject: [PATCH] make role queries and associate new users with no cap role --- src/Control/User.hs | 3 ++ src/Model/Role.hs | 70 +++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 73 insertions(+) diff --git a/src/Control/User.hs b/src/Control/User.hs index 104dd71..59a416a 100644 --- a/src/Control/User.hs +++ b/src/Control/User.hs @@ -28,6 +28,9 @@ userNew (UserSubmit ident email passhash) = do conn <- asks rsConnection uid <- insertUser ident email (utctDay now) 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 userGet diff --git a/src/Model/Role.hs b/src/Model/Role.hs index 60f0f02..fd74da3 100644 --- a/src/Model/Role.hs +++ b/src/Model/Role.hs @@ -160,3 +160,73 @@ runInsertInitialRoles conn = do , iOnConflict = Nothing } 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 + }