summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/Mysql.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Propellor/Property/Mysql.hs')
-rw-r--r--src/Propellor/Property/Mysql.hs34
1 files changed, 25 insertions, 9 deletions
diff --git a/src/Propellor/Property/Mysql.hs b/src/Propellor/Property/Mysql.hs
index 0d6161f3..8ed95f16 100644
--- a/src/Propellor/Property/Mysql.hs
+++ b/src/Propellor/Property/Mysql.hs
@@ -211,8 +211,9 @@ userGrantedOnDatabase
-> c
-> RevertableProperty (HasInfo + DebianLike) UnixLike
userGrantedOnDatabase user@(User username) (Database dbname) privs context =
- userGranted' user privs context setupDesc setupSql userGrants
+ userGranted' user privs withPassword setupDesc setupSql userGrants
where
+ withPassword = withPasswordFromPrivData user context
setupDesc = "user " ++ username ++ " granted on database " ++ dbname
setupSql quser hash privList =
"GRANT " ++ privList ++ " ON " ++ privLevel
@@ -235,8 +236,9 @@ userGranted
-> c
-> RevertableProperty (HasInfo + DebianLike) UnixLike
userGranted user@(User username) privs context =
- userGranted' user privs context setupDesc setupSql userGrants
+ userGranted' user privs withPassword setupDesc setupSql userGrants
where
+ withPassword = withPasswordFromPrivData user context
setupDesc = "user " ++ username ++ " granted"
setupSql quser hash privList =
"GRANT " ++ privList ++ " ON *.*"
@@ -247,17 +249,31 @@ userGranted user@(User username) privs context =
"GRANT " ++ privList ++ " ON *.* TO " ++ quser
++ " IDENTIFIED BY PASSWORD '" ++ hash ++ "'\n"
--- | Common code to grant or remove an user.
-userGranted'
+-- | Common code to get password from private data.
+withPasswordFromPrivData
:: IsContext c
=> User
- -> [Privilege]
-> c
+ -> ((((String -> Propellor Result) -> Propellor Result)
+ -> Property (HasInfo + UnixLike))
+ -> Property (HasInfo + UnixLike))
+withPasswordFromPrivData (User username) context = \mkprop ->
+ withPrivData (Password username) context
+ $ \getdata -> mkprop
+ $ (\a -> getdata $ \priv -> a $ privDataVal priv)
+
+-- | Common code to grant or remove an user.
+userGranted'
+ :: User
+ -> [Privilege]
+ -> ((((String -> Propellor Result) -> Propellor Result)
+ -> Property (HasInfo + UnixLike))
+ -> Property (HasInfo + UnixLike))
-> String
-> (String -> String -> String -> String)
-> (String -> String -> String -> String)
-> RevertableProperty (HasInfo + DebianLike) UnixLike
-userGranted' (User username) privs context setupDesc setupSql userGrants =
+userGranted' (User username) privs withPassword setupDesc setupSql userGrants =
setup <!> cleanup
where
setup :: Property (HasInfo + DebianLike)
@@ -268,9 +284,9 @@ userGranted' (User username) privs context setupDesc setupSql userGrants =
-- Check user grants and reset them if needed.
setup' :: Property (HasInfo + UnixLike)
- setup' = withPrivData (Password username) context $ \getpassword ->
- property' setupDesc $ \w -> getpassword $ \priv -> do
- hash <- liftIO $ hashPassword $ privDataVal priv
+ setup' = withPassword $ \getpassword ->
+ property' setupDesc $ \w -> getpassword $ \password -> do
+ hash <- liftIO $ hashPassword $ password
curGrants <- liftIO $ getUserGrants
let match = curGrants ==
(userGrants quser hash privList)