summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Schodet2019-03-29 20:31:41 +0100
committerNicolas Schodet2019-03-29 20:33:07 +0100
commitfc49e057d68e04a625b692ee7e5cc729634be0b9 (patch)
treee871dd4509d2b1781b48e1ce7e50b2d0b7e3c762
parent9e2b2cfca7c2c09b45a05d42d00e7db115e0faaa (diff)
WIP remove HasInfo when no privdata neededmysql-wip
-rw-r--r--src/Propellor/Property/Mysql.hs38
1 files changed, 20 insertions, 18 deletions
diff --git a/src/Propellor/Property/Mysql.hs b/src/Propellor/Property/Mysql.hs
index ae7b1a7d..66827df8 100644
--- a/src/Propellor/Property/Mysql.hs
+++ b/src/Propellor/Property/Mysql.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
-- | Maintainer: Nicolas Schodet <nico@ni.fr.eu.org>
--
-- Support for MySQL/MariaDB server.
@@ -22,6 +24,7 @@ module Propellor.Property.Mysql (
import Propellor
import Propellor.Base
+import Propellor.Types
import Data.List
import qualified Propellor.Property.Apt as Apt
@@ -223,7 +226,7 @@ userGrantedOnDatabaseWithPassword
-> Database
-> [Privilege]
-> String
- -> RevertableProperty (HasInfo + DebianLike) UnixLike
+ -> RevertableProperty DebianLike UnixLike
userGrantedOnDatabaseWithPassword user db privs password =
userGrantedOnDatabase' user db privs withPassword
where
@@ -231,13 +234,13 @@ userGrantedOnDatabaseWithPassword user db privs password =
-- | Common code between userGrantedOnDatabase*.
userGrantedOnDatabase'
- :: User
+ :: Combines (Property i) (Property UnixLike)
+ => User
-> Database
-> [Privilege]
-> ((((String -> Propellor Result) -> Propellor Result)
- -> Property (HasInfo + UnixLike))
- -> Property (HasInfo + UnixLike))
- -> RevertableProperty (HasInfo + DebianLike) UnixLike
+ -> Property i) -> Property i)
+ -> RevertableProperty (CombinedType (Property i) (Property UnixLike)) UnixLike
userGrantedOnDatabase' user@(User username) (Database dbname) privs withPassword =
userGrantedProp user privs withPassword setupDesc setupSql userGrants
where
@@ -272,7 +275,7 @@ userGrantedWithPassword
:: User
-> [Privilege]
-> String
- -> RevertableProperty (HasInfo + DebianLike) UnixLike
+ -> RevertableProperty DebianLike UnixLike
userGrantedWithPassword user privs password =
userGranted' user privs withPassword
where
@@ -280,12 +283,12 @@ userGrantedWithPassword user privs password =
-- | Common code between userGranted*.
userGranted'
- :: User
+ :: Combines (Property i) (Property UnixLike)
+ => User
-> [Privilege]
-> ((((String -> Propellor Result) -> Propellor Result)
- -> Property (HasInfo + UnixLike))
- -> Property (HasInfo + UnixLike))
- -> RevertableProperty (HasInfo + DebianLike) UnixLike
+ -> Property i) -> Property i)
+ -> RevertableProperty (CombinedType (Property i) (Property UnixLike)) UnixLike
userGranted' user@(User username) privs withPassword =
userGrantedProp user privs withPassword setupDesc setupSql userGrants
where
@@ -316,33 +319,32 @@ withPasswordFromPrivData (User username) context = \mkprop ->
withPasswordFromParameter
:: String
-> ((((String -> Propellor Result) -> Propellor Result)
- -> Property (HasInfo + UnixLike))
- -> Property (HasInfo + UnixLike))
+ -> Property UnixLike) -> Property UnixLike)
withPasswordFromParameter password = \mkprop ->
mkprop $ \a -> a password
-- | Common code to grant or remove an user.
userGrantedProp
- :: User
+ :: Combines (Property i) (Property UnixLike)
+ => User
-> [Privilege]
-> ((((String -> Propellor Result) -> Propellor Result)
- -> Property (HasInfo + UnixLike))
- -> Property (HasInfo + UnixLike))
+ -> Property i) -> Property i)
-> String
-> (String -> String -> String -> String)
-> (String -> String -> String -> String)
- -> RevertableProperty (HasInfo + DebianLike) UnixLike
+ -> RevertableProperty (CombinedType (Property i) (Property UnixLike)) UnixLike
userGrantedProp (User username) privs withPassword setupDesc setupSql userGrants =
setup <!> cleanup
where
- setup :: Property (HasInfo + DebianLike)
+ setup :: CombinedType (Property i) (Property UnixLike)
setup = setup' `requires` installedAndReady
cleanup :: Property UnixLike
cleanup = check isInstalled $ cleanup'
-- Check user grants and reset them if needed.
- setup' :: Property (HasInfo + UnixLike)
+ setup' :: Property i
setup' = withPassword $ \getpassword ->
property' setupDesc $ \w -> getpassword $ \password -> do
hash <- liftIO $ hashPassword $ password