diff options
| author | Joey Hess <joeyh@joeyh.name> | 2016-03-26 21:38:39 -0400 |
|---|---|---|
| committer | Joey Hess <joeyh@joeyh.name> | 2016-03-26 21:38:39 -0400 |
| commit | 46fc5467e633a9c1f149cb0cd7ee03af1e9e0aa1 (patch) | |
| tree | 85d0136a1bc612a998259ab8690d20916d5ba704 /src/Propellor/Property/Conductor.hs | |
| parent | 530b0dde35e143df1ba8cb8f4828e0a3bc0b4ffb (diff) | |
ported docker
Also, implemented modifyHostProps to add properties to an existing host.
Using it bypasses some type safety. Its use in docker is safe though.
But, in Conductor, the use of it was not really safe, because it was used
with a DebianLike property. Fixed that by making Ssh.installed
target all unix's, although it will fail on non-DebianLike ones.
Diffstat (limited to 'src/Propellor/Property/Conductor.hs')
| -rw-r--r-- | src/Propellor/Property/Conductor.hs | 21 |
1 files changed, 8 insertions, 13 deletions
diff --git a/src/Propellor/Property/Conductor.hs b/src/Propellor/Property/Conductor.hs index 8fe607bc..005fc804 100644 --- a/src/Propellor/Property/Conductor.hs +++ b/src/Propellor/Property/Conductor.hs @@ -83,7 +83,7 @@ import qualified Data.Set as S -- | Class of things that can be conducted. class Conductable c where - conducts :: c -> RevertableProperty (HasInfo + DebianLike) (HasInfo + UnixLike) + conducts :: c -> RevertableProperty (HasInfo + UnixLike) (HasInfo + UnixLike) instance Conductable Host where -- | Conduct the specified host. @@ -219,8 +219,8 @@ orchestrate hs = map go hs os = extractOrchestras hs removeold h = foldl removeold' h (oldconductorsof h) - removeold' h oldconductor = addPropHost h $ - undoRevertableProperty $ conductedBy oldconductor + removeold' h oldconductor = modifyHostProps h $ hostProps h + ! conductedBy oldconductor oldconductors = zip hs (map (fromInfo . hostInfo) hs) oldconductorsof h = flip mapMaybe oldconductors $ @@ -233,22 +233,17 @@ orchestrate' :: Host -> Orchestra -> Host orchestrate' h (Conducted _) = h orchestrate' h (Conductor c l) | sameHost h c = cont $ addConductorPrivData h (concatMap allHosts l) - | any (sameHost h) (map topHost l) = cont $ addPropHost h $ - setupRevertableProperty $ conductedBy c + | any (sameHost h) (map topHost l) = cont $ + modifyHostProps h $ hostProps h + & conductedBy c | otherwise = cont h where cont h' = foldl orchestrate' h' l -addPropHost :: Host -> Property i -> Host -addPropHost (Host hn ps i) p = Host hn ps' i' - where - ps' = ps ++ [toChildProperty p] - i' = i <> getInfoRecursive p - -- The host this property is added to becomes the conductor for the -- specified Host. Note that `orchestrate` must be used for this property -- to have any effect. -conductorFor :: Host -> Property (HasInfo + DebianLike) +conductorFor :: Host -> Property (HasInfo + UnixLike) conductorFor h = go `addInfoProperty` (toInfo (ConductorFor [h])) `requires` setupRevertableProperty (conductorKnownHost h) @@ -302,7 +297,7 @@ addConductorPrivData h hs = h { hostInfo = hostInfo h <> i } privinfo h' = forceHostContext (hostName h') $ fromInfo (hostInfo h') -- Use this property to let the specified conductor ssh in and run propellor. -conductedBy :: Host -> RevertableProperty DebianLike UnixLike +conductedBy :: Host -> RevertableProperty UnixLike UnixLike conductedBy h = (setup <!> teardown) `describe` ("conducted by " ++ hostName h) where |
