From 7956a6f6565a44ef773df428e8eb9bdf0dbf51ed Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 16 Oct 2015 15:02:32 -0400 Subject: improve types and add example --- src/Propellor/Property/Spin.hs | 69 ++++++++++++++++++++++++++++-------------- 1 file changed, 47 insertions(+), 22 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/Spin.hs b/src/Propellor/Property/Spin.hs index d590e319..92753aa5 100644 --- a/src/Propellor/Property/Spin.hs +++ b/src/Propellor/Property/Spin.hs @@ -1,28 +1,62 @@ {-# LANGUAGE FlexibleInstances #-} -module Propellor.Property.Spin (Controlled(..), controller) where +module Propellor.Property.Spin (Spinnable(..), controller) where import Propellor.Base import Propellor.Spin (spin) import Propellor.Types.CmdLine (ControllerChain(..)) import Propellor.Types.Info -class Controlled t where - controlledHosts :: t -> [Host] +-- | A class of things that can be spinned. +class Spinnable t where + toSpin :: t -> Property NoInfo -instance Controlled Host where - controlledHosts h = [h] +instance Spinnable Host where + toSpin h = property (cdesc (hostName h)) $ do + ControllerChain cc <- getControllerChain + if hostName h `elem` cc + then noChange -- avoid loop + else do + liftIO $ spin (hostName h) Nothing (ControllerChain cc) h + -- Don't know if the spin made a change to the + -- remote host or not, but in any case, the + -- local host was not changed. + noChange -instance Controlled [Host] where - controlledHosts = id +-- | Each Host in the list is spinned in turn. Does not stop on spin +-- failure; does propigate overall success/failure. +instance Spinnable [Host] where + toSpin l = propertyList (cdesc $ unwords $ map hostName l) (map toSpin l) --- | The Host that has this Property is in control of some other Hosts. +-- | The Host that has this Property is in control of running propellor on +-- some other Hosts. -- -- Making a host a controller eliminates the need to manually run -- propellor --spin to update the controlled hosts. Each time -- propellor is run on the controller host, it will in turn run -- propellor on the controlled Hosts. -- +-- For example, if you have some webservers and some dnsservers, +-- and want a master that runs propellor on all of them, and only updates +-- the dnsservers once all the webservers are successfully updated: +-- +-- > import Propellor +-- > import qualified Propellor.Property.Spin as Spin +-- > import qualified Propellor.Property.Cron as Cron +-- > +-- > main = defaultMain hosts +-- > +-- > hosts = master : webservers ++ dnsservers +-- > +-- > webservers = ... +-- > +-- > dnsservers = ... +-- > +-- > master = host "master.example.com" +-- > & Cron.runPropellor +-- > & Spin.controller dnsservers +-- > `requires` Spin.controller webservers +-- -- Multiple controllers can control the same hosts. However, if -- propellor is already running on a host, its controller will fail -- to run it a second time. So, if two controllers both try to @@ -30,20 +64,11 @@ instance Controlled [Host] where -- -- Chains of controllers are supported; host A can control host B which -- controls host C. Loops of controllers are automatically prevented. -controller :: Controlled h => h -> Property NoInfo -controller h = propertyList "controller" (map controller' (controlledHosts h)) - -controller' :: Host -> Property NoInfo -controller' h = property ("controller for " ++ hostName h) $ do - ControllerChain cc <- getControllerChain - if hostName h `elem` cc - then noChange -- avoid loop - else do - liftIO $ spin (hostName h) Nothing (ControllerChain cc) h - -- Don't know if the spin made a change to the - -- remote host or not, but in any case, the - -- local host was not changed. - noChange +controller :: Spinnable h => h -> Property NoInfo +controller = toSpin + +cdesc :: String -> Desc +cdesc n = "controller for " ++ n getControllerChain :: Propellor ControllerChain getControllerChain = do -- cgit v1.2.3