{-# LANGUAGE FlexibleInstances, DeriveDataTypeable, GeneralizedNewtypeDeriving, TypeFamilies #-}

-- | This module adds conductors to propellor. A conductor is a Host that
-- is responsible for running propellor on other hosts
--
-- This eliminates the need to manually run propellor --spin to
-- update the conducted hosts, and can be used to orchestrate updates
-- to hosts.
--
-- The conductor needs to be able to ssh to the hosts it conducts,
-- and run propellor, as root. To this end, 
-- the `Propellor.Property.Ssh.knownHost` property is automatically
-- added to the conductor, so it knows the host keys of the relevant hosts.
-- Also, each conducted host is configured to let its conductor
-- ssh in as root, by automatically adding the
-- `Propellor.Property.Ssh.authorizedKeysFrom` property.
--
-- It's left up to you to use `Propellor.Property.Ssh.userKeys` to
-- configure the ssh keys for the root user on conductor hosts,
-- and to use `Ssh.hostKeys` to configure the host keys for the 
-- conducted hosts.
--
-- For example, if you have some webservers and a dnsserver,
-- and want the master host to conduct all of them:
--
-- > import Propellor
-- > import Propellor.Property.Conductor
-- > import qualified Propellor.Property.Ssh as Ssh
-- > import qualified Propellor.Property.Cron as Cron
-- > 
-- > main = defaultMain (orchestrate hosts)
-- >
-- > hosts =
-- > 	[ master
-- >	, dnsserver
-- >	] ++ webservers
-- > 
-- > dnsserver = host "dns.example.com"
-- >	& Ssh.hostKeys hostContext [(SshEd25519, "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIB3BJ2GqZiTR2LEoDXyYFgh/BduWefjdKXAsAtzS9zeI")]
-- >	& ...
-- > 
-- > webservers =
-- >    [ host "www1.example.com"
-- >		& Ssh.hostKeys hostContext [(SshEd25519, "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAICfFntnesZcYz2B2T41ay45igfckXRSh5uVffkuCQkLv")]
-- >		& ...
-- >	, ...
-- >	]
-- >
-- > master = host "master.example.com"
-- >	& Ssh.userKeys (User "root") [(SshEd25519, "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIFWD0Hau5FDLeNrDHKilNMKm9c68R3WD+NJOp2jPWvJV")]
-- >	& conducts webservers
-- >		`before` conducts dnsserver
-- >	& Cron.runPropellor
--
-- Notice that, in the above example, the the webservers are conducted
-- first. Only once the webservers have successfully been set up is the
-- dnsserver updated. This way, when adding a new web server, the dns
-- won't list it until it's ready.
--
-- There can be multiple conductors, and conductors can conduct other
-- conductors if you need such a hierarchy. (Loops in the hierarchy, such
-- as a host conducting itself, are detected and automatically broken.)
--
-- While it's allowed for a single host to be conducted by
-- multiple conductors, the results can be discordent.
-- Since only one propellor process can be run on a host at a time,
-- one of the conductors will fail to communicate with it.
--
-- Note that a conductor can see all PrivData of the hosts it conducts.

module Propellor.Property.Conductor (
	orchestrate,
	Conductable(..),
) where

import Propellor.Base
import Propellor.Container
import Propellor.Spin (spin')
import Propellor.PrivData.Paths
import Propellor.Types.Info
import qualified Propellor.Property.Ssh as Ssh

import qualified Data.Set as S
import qualified Data.Semigroup as Sem

-- | Class of things that can be conducted.
--
-- There are instances for single hosts, and for lists of hosts.
-- With a list, each listed host will be conducted in turn. Failure to conduct
-- one host does not prevent conducting subsequent hosts in the list, but
-- will be propagated as an overall failure of the property.
class Conductable c where
	conducts :: c -> RevertableProperty (HasInfo + UnixLike) (HasInfo + UnixLike)

instance Conductable Host where
	conducts :: Host
-> RevertableProperty (HasInfo + UnixLike) (HasInfo + UnixLike)
conducts Host
h = Host -> Property (HasInfo + UnixLike)
conductorFor Host
h Property
  (Sing
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
     (Sing
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> RevertableProperty
     (Sing
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
     (Sing
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Host -> Property (HasInfo + UnixLike)
notConductorFor Host
h

instance Conductable [Host] where
	conducts :: [Host]
-> RevertableProperty (HasInfo + UnixLike) (HasInfo + UnixLike)
conducts [Host]
hs = 
		Desc
-> Props
     (Sing
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
     (Sing
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall k (metatypes :: k).
SingI metatypes =>
Desc
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList Desc
desc ([Property
   (Sing
      '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])]
-> Props
     (Sing
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall k (metatypes :: k).
[Property (MetaTypes metatypes)] -> Props (MetaTypes metatypes)
toProps ([Property
    (Sing
       '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
          'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])]
 -> Props
      (Sing
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> [Property
      (Sing
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])]
-> Props
     (Sing
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall a b. (a -> b) -> a -> b
$ (Host
 -> Property
      (Sing
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> [Host]
-> [Property
      (Sing
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])]
forall a b. (a -> b) -> [a] -> [b]
map (RevertableProperty
  (Sing
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
  (Sing
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
     (Sing
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall setupmetatypes undometatypes.
RevertableProperty setupmetatypes undometatypes
-> Property setupmetatypes
setupRevertableProperty (RevertableProperty
   (Sing
      '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
   (Sing
      '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
 -> Property
      (Sing
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> (Host
    -> RevertableProperty
         (Sing
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
         (Sing
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> Host
-> Property
     (Sing
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Host
-> RevertableProperty
     (Sing
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
     (Sing
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall c.
Conductable c =>
c -> RevertableProperty (HasInfo + UnixLike) (HasInfo + UnixLike)
conducts) [Host]
hs)
			Property
  (Sing
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
     (Sing
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> RevertableProperty
     (Sing
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
     (Sing
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!>
		Desc
-> Props
     (Sing
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
     (Sing
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall k (metatypes :: k).
SingI metatypes =>
Desc
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList Desc
desc ([Property
   (Sing
      '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])]
-> Props
     (Sing
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall k (metatypes :: k).
[Property (MetaTypes metatypes)] -> Props (MetaTypes metatypes)
toProps ([Property
    (Sing
       '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
          'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])]
 -> Props
      (Sing
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> [Property
      (Sing
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])]
-> Props
     (Sing
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall a b. (a -> b) -> a -> b
$ (Host
 -> Property
      (Sing
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> [Host]
-> [Property
      (Sing
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])]
forall a b. (a -> b) -> [a] -> [b]
map (RevertableProperty
  (Sing
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
  (Sing
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
     (Sing
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall setupmetatypes undometatypes.
RevertableProperty setupmetatypes undometatypes
-> Property undometatypes
undoRevertableProperty (RevertableProperty
   (Sing
      '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
   (Sing
      '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
 -> Property
      (Sing
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> (Host
    -> RevertableProperty
         (Sing
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
         (Sing
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> Host
-> Property
     (Sing
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Host
-> RevertableProperty
     (Sing
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
     (Sing
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall c.
Conductable c =>
c -> RevertableProperty (HasInfo + UnixLike) (HasInfo + UnixLike)
conducts) [Host]
hs)
	  where
		desc :: Desc
desc = Desc -> Desc
cdesc (Desc -> Desc) -> Desc -> Desc
forall a b. (a -> b) -> a -> b
$ [Desc] -> Desc
unwords ([Desc] -> Desc) -> [Desc] -> Desc
forall a b. (a -> b) -> a -> b
$ (Host -> Desc) -> [Host] -> [Desc]
forall a b. (a -> b) -> [a] -> [b]
map Host -> Desc
hostName [Host]
hs

data Orchestra
	= Conductor Host [Orchestra]
	| Conducted Host

instance Show Orchestra where
	show :: Orchestra -> Desc
show (Conductor Host
h [Orchestra]
l) = Desc
"Conductor " Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Host -> Desc
hostName Host
h Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
" (" Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ [Orchestra] -> Desc
forall a. Show a => a -> Desc
show [Orchestra]
l Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
")"
	show (Conducted Host
h) = Desc
"Conducted " Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Host -> Desc
hostName Host
h

fullOrchestra :: Orchestra -> Bool
fullOrchestra :: Orchestra -> Bool
fullOrchestra (Conductor Host
_ [Orchestra]
_) = Bool
True
fullOrchestra (Conducted Host
_) = Bool
False

topHost :: Orchestra -> Host
topHost :: Orchestra -> Host
topHost (Conducted Host
h) = Host
h
topHost (Conductor Host
h [Orchestra]
_) = Host
h

allHosts :: Orchestra -> [Host]
allHosts :: Orchestra -> [Host]
allHosts (Conducted Host
h) = [Host
h]
allHosts (Conductor Host
h [Orchestra]
l) = Host
h Host -> [Host] -> [Host]
forall a. a -> [a] -> [a]
: (Orchestra -> [Host]) -> [Orchestra] -> [Host]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Orchestra -> [Host]
allHosts [Orchestra]
l

-- Makes an Orchestra for the host, and any hosts it's conducting.
mkOrchestra :: Host -> Orchestra
mkOrchestra :: Host -> Orchestra
mkOrchestra = Maybe Orchestra -> Orchestra
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Orchestra -> Orchestra)
-> (Host -> Maybe Orchestra) -> Host -> Orchestra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Desc -> Host -> Maybe Orchestra
go Set Desc
forall a. Set a
S.empty
  where
	go :: Set Desc -> Host -> Maybe Orchestra
go Set Desc
seen Host
h
		| Desc -> Set Desc -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member (Host -> Desc
hostName Host
h) Set Desc
seen = Maybe Orchestra
forall a. Maybe a
Nothing -- break loop
		| Bool
otherwise = Orchestra -> Maybe Orchestra
forall a. a -> Maybe a
Just (Orchestra -> Maybe Orchestra) -> Orchestra -> Maybe Orchestra
forall a b. (a -> b) -> a -> b
$ case Info -> ConductorFor
forall v. IsInfo v => Info -> v
fromInfo (Host -> Info
hostInfo Host
h) of
			ConductorFor [] -> Host -> Orchestra
Conducted Host
h
			ConductorFor [Host]
l -> 
				let seen' :: Set Desc
seen' = Desc -> Set Desc -> Set Desc
forall a. Ord a => a -> Set a -> Set a
S.insert (Host -> Desc
hostName Host
h) Set Desc
seen
				in Host -> [Orchestra] -> Orchestra
Conductor Host
h ((Host -> Maybe Orchestra) -> [Host] -> [Orchestra]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Set Desc -> Host -> Maybe Orchestra
go Set Desc
seen') [Host]
l)

-- Combines the two orchestras, if there's a place, or places where they
-- can be grafted together.
combineOrchestras :: Orchestra -> Orchestra -> Maybe Orchestra
combineOrchestras :: Orchestra -> Orchestra -> Maybe Orchestra
combineOrchestras Orchestra
a Orchestra
b = Orchestra -> Orchestra -> Maybe Orchestra
combineOrchestras' Orchestra
a Orchestra
b Maybe Orchestra -> Maybe Orchestra -> Maybe Orchestra
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Orchestra -> Orchestra -> Maybe Orchestra
combineOrchestras' Orchestra
b Orchestra
a

combineOrchestras' :: Orchestra -> Orchestra -> Maybe Orchestra
combineOrchestras' :: Orchestra -> Orchestra -> Maybe Orchestra
combineOrchestras' (Conducted Host
h) Orchestra
b
	| Host -> Host -> Bool
sameHost Host
h (Orchestra -> Host
topHost Orchestra
b) = Orchestra -> Maybe Orchestra
forall a. a -> Maybe a
Just Orchestra
b
	| Bool
otherwise = Maybe Orchestra
forall a. Maybe a
Nothing
combineOrchestras' (Conductor Host
h [Orchestra]
os) (Conductor Host
h' [Orchestra]
os')
	| Host -> Host -> Bool
sameHost Host
h Host
h' = Orchestra -> Maybe Orchestra
forall a. a -> Maybe a
Just (Orchestra -> Maybe Orchestra) -> Orchestra -> Maybe Orchestra
forall a b. (a -> b) -> a -> b
$ Host -> [Orchestra] -> Orchestra
Conductor Host
h ((Orchestra -> [Orchestra]) -> [Orchestra] -> [Orchestra]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Orchestra -> [Orchestra]
combineos [Orchestra]
os')
  where
	combineos :: Orchestra -> [Orchestra]
combineos Orchestra
o = case (Orchestra -> Maybe Orchestra) -> [Orchestra] -> [Orchestra]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Orchestra -> Orchestra -> Maybe Orchestra
`combineOrchestras` Orchestra
o) [Orchestra]
os of
		[] -> [Orchestra
o]
		[Orchestra]
os'' -> [Orchestra]
os''
combineOrchestras' a :: Orchestra
a@(Conductor Host
h [Orchestra]
_) (Conducted Host
h')
	| Host -> Host -> Bool
sameHost Host
h Host
h' = Orchestra -> Maybe Orchestra
forall a. a -> Maybe a
Just Orchestra
a
combineOrchestras' (Conductor Host
h [Orchestra]
os) Orchestra
b
	| [Orchestra] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Maybe Orchestra] -> [Orchestra]
forall a. [Maybe a] -> [a]
catMaybes (((Orchestra, Maybe Orchestra) -> Maybe Orchestra)
-> [(Orchestra, Maybe Orchestra)] -> [Maybe Orchestra]
forall a b. (a -> b) -> [a] -> [b]
map (Orchestra, Maybe Orchestra) -> Maybe Orchestra
forall a b. (a, b) -> b
snd [(Orchestra, Maybe Orchestra)]
osgrafts)) = Maybe Orchestra
forall a. Maybe a
Nothing
	| Bool
otherwise = Orchestra -> Maybe Orchestra
forall a. a -> Maybe a
Just (Orchestra -> Maybe Orchestra) -> Orchestra -> Maybe Orchestra
forall a b. (a -> b) -> a -> b
$ Host -> [Orchestra] -> Orchestra
Conductor Host
h (((Orchestra, Maybe Orchestra) -> Orchestra)
-> [(Orchestra, Maybe Orchestra)] -> [Orchestra]
forall a b. (a -> b) -> [a] -> [b]
map ((Orchestra -> Maybe Orchestra -> Orchestra)
-> (Orchestra, Maybe Orchestra) -> Orchestra
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Orchestra -> Maybe Orchestra -> Orchestra
forall a. a -> Maybe a -> a
fromMaybe) [(Orchestra, Maybe Orchestra)]
osgrafts)
  where
	osgrafts :: [(Orchestra, Maybe Orchestra)]
osgrafts = [Orchestra] -> [Maybe Orchestra] -> [(Orchestra, Maybe Orchestra)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Orchestra]
os ((Orchestra -> Maybe Orchestra) -> [Orchestra] -> [Maybe Orchestra]
forall a b. (a -> b) -> [a] -> [b]
map (Orchestra -> Orchestra -> Maybe Orchestra
`combineOrchestras` Orchestra
b) [Orchestra]
os)

sameHost :: Host -> Host -> Bool
sameHost :: Host -> Host -> Bool
sameHost Host
a Host
b = Host -> Desc
hostName Host
a Desc -> Desc -> Bool
forall a. Eq a => a -> a -> Bool
== Host -> Desc
hostName Host
b

-- Removes any loops that may be present in the Orchestra involving
-- the passed Host. This is a matter of traversing the Orchestra
-- top-down, and removing all occurrances of the host after the first
-- one seen.
deloop :: Host -> Orchestra -> Orchestra
deloop :: Host -> Orchestra -> Orchestra
deloop Host
_ (Conducted Host
h) = Host -> Orchestra
Conducted Host
h
deloop Host
thehost (Conductor Host
htop [Orchestra]
ostop) = Host -> [Orchestra] -> Orchestra
Conductor Host
htop ([Orchestra] -> Orchestra) -> [Orchestra] -> Orchestra
forall a b. (a -> b) -> a -> b
$
	([Orchestra], Bool) -> [Orchestra]
forall a b. (a, b) -> a
fst (([Orchestra], Bool) -> [Orchestra])
-> ([Orchestra], Bool) -> [Orchestra]
forall a b. (a -> b) -> a -> b
$ [Orchestra] -> [Orchestra] -> Bool -> ([Orchestra], Bool)
seekh [] [Orchestra]
ostop (Host -> Host -> Bool
sameHost Host
htop Host
thehost)
  where
	seekh :: [Orchestra] -> [Orchestra] -> Bool -> ([Orchestra], Bool)
seekh [Orchestra]
l [] Bool
seen = ([Orchestra]
l, Bool
seen)
	seekh [Orchestra]
l ((Conducted Host
h) : [Orchestra]
rest) Bool
seen
		| Host -> Host -> Bool
sameHost Host
h Host
thehost = 
			if Bool
seen
				then [Orchestra] -> [Orchestra] -> Bool -> ([Orchestra], Bool)
seekh [Orchestra]
l [Orchestra]
rest Bool
seen
				else [Orchestra] -> [Orchestra] -> Bool -> ([Orchestra], Bool)
seekh (Host -> Orchestra
Conducted Host
h Orchestra -> [Orchestra] -> [Orchestra]
forall a. a -> [a] -> [a]
: [Orchestra]
l) [Orchestra]
rest Bool
True
		| Bool
otherwise = [Orchestra] -> [Orchestra] -> Bool -> ([Orchestra], Bool)
seekh (Host -> Orchestra
Conducted Host
hOrchestra -> [Orchestra] -> [Orchestra]
forall a. a -> [a] -> [a]
:[Orchestra]
l) [Orchestra]
rest Bool
seen
	seekh [Orchestra]
l ((Conductor Host
h [Orchestra]
os) : [Orchestra]
rest) Bool
seen
		| Host -> Host -> Bool
sameHost Host
h Host
thehost =
			if Bool
seen
				then [Orchestra] -> [Orchestra] -> Bool -> ([Orchestra], Bool)
seekh [Orchestra]
l [Orchestra]
rest Bool
seen
				else 
					let ([Orchestra]
os', Bool
_seen') = [Orchestra] -> [Orchestra] -> Bool -> ([Orchestra], Bool)
seekh [] [Orchestra]
os Bool
True
					in [Orchestra] -> [Orchestra] -> Bool -> ([Orchestra], Bool)
seekh (Host -> [Orchestra] -> Orchestra
Conductor Host
h [Orchestra]
os' Orchestra -> [Orchestra] -> [Orchestra]
forall a. a -> [a] -> [a]
: [Orchestra]
l) [Orchestra]
rest Bool
True
		| Bool
otherwise = 
			let ([Orchestra]
os', Bool
seen') = [Orchestra] -> [Orchestra] -> Bool -> ([Orchestra], Bool)
seekh [] [Orchestra]
os Bool
seen
			in [Orchestra] -> [Orchestra] -> Bool -> ([Orchestra], Bool)
seekh (Host -> [Orchestra] -> Orchestra
Conductor Host
h [Orchestra]
os' Orchestra -> [Orchestra] -> [Orchestra]
forall a. a -> [a] -> [a]
: [Orchestra]
l) [Orchestra]
rest Bool
seen'

-- Extracts the Orchestras from a list of hosts.
--
-- Method: For each host that is a conductor, check the
-- list of orchesteras to see if any already contain that host, or
-- any of the hosts it conducts. If so, add the host to that
-- orchestra. If not, start a new orchestra.
--
-- The result is a set of orchestras, which are each fully disconnected
-- from the other. Some may contain loops.
extractOrchestras :: [Host] -> [Orchestra]
extractOrchestras :: [Host] -> [Orchestra]
extractOrchestras = (Orchestra -> Bool) -> [Orchestra] -> [Orchestra]
forall a. (a -> Bool) -> [a] -> [a]
filter Orchestra -> Bool
fullOrchestra ([Orchestra] -> [Orchestra])
-> ([Host] -> [Orchestra]) -> [Host] -> [Orchestra]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Orchestra] -> [Orchestra] -> [Orchestra]
go [] ([Orchestra] -> [Orchestra])
-> ([Host] -> [Orchestra]) -> [Host] -> [Orchestra]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Host -> Orchestra) -> [Host] -> [Orchestra]
forall a b. (a -> b) -> [a] -> [b]
map Host -> Orchestra
mkOrchestra
  where
	go :: [Orchestra] -> [Orchestra] -> [Orchestra]
go [Orchestra]
os [] = [Orchestra]
os
	go [Orchestra]
os (Orchestra
o:[Orchestra]
rest) = 
		let os' :: [(Orchestra, Maybe Orchestra)]
os' = [Orchestra] -> [Maybe Orchestra] -> [(Orchestra, Maybe Orchestra)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Orchestra]
os ((Orchestra -> Maybe Orchestra) -> [Orchestra] -> [Maybe Orchestra]
forall a b. (a -> b) -> [a] -> [b]
map (Orchestra -> Orchestra -> Maybe Orchestra
combineOrchestras Orchestra
o) [Orchestra]
os)
		in case [Maybe Orchestra] -> [Orchestra]
forall a. [Maybe a] -> [a]
catMaybes (((Orchestra, Maybe Orchestra) -> Maybe Orchestra)
-> [(Orchestra, Maybe Orchestra)] -> [Maybe Orchestra]
forall a b. (a -> b) -> [a] -> [b]
map (Orchestra, Maybe Orchestra) -> Maybe Orchestra
forall a b. (a, b) -> b
snd [(Orchestra, Maybe Orchestra)]
os') of
			[] -> [Orchestra] -> [Orchestra] -> [Orchestra]
go (Orchestra
oOrchestra -> [Orchestra] -> [Orchestra]
forall a. a -> [a] -> [a]
:[Orchestra]
os) [Orchestra]
rest
			[Orchestra
_] -> [Orchestra] -> [Orchestra] -> [Orchestra]
go (((Orchestra, Maybe Orchestra) -> Orchestra)
-> [(Orchestra, Maybe Orchestra)] -> [Orchestra]
forall a b. (a -> b) -> [a] -> [b]
map ((Orchestra -> Maybe Orchestra -> Orchestra)
-> (Orchestra, Maybe Orchestra) -> Orchestra
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Orchestra -> Maybe Orchestra -> Orchestra
forall a. a -> Maybe a -> a
fromMaybe) [(Orchestra, Maybe Orchestra)]
os') [Orchestra]
rest
			[Orchestra]
_ -> Desc -> [Orchestra]
forall a. HasCallStack => Desc -> a
error Desc
"Bug: Host somehow ended up in multiple Orchestras!"

-- | Pass this a list of all your hosts; it will finish setting up
-- orchestration as configured by the `conducts` properties you add to
-- hosts.
--
-- > main = defaultMain $ orchestrate hosts
orchestrate :: [Host] -> [Host]
orchestrate :: [Host] -> [Host]
orchestrate [Host]
hs = (Host -> Host) -> [Host] -> [Host]
forall a b. (a -> b) -> [a] -> [b]
map Host -> Host
go [Host]
hs
  where
	go :: Host -> Host
go Host
h
		| Orchestrated -> Bool
isOrchestrated (Info -> Orchestrated
forall v. IsInfo v => Info -> v
fromInfo (Host -> Info
hostInfo Host
h)) = Host
h
		| Bool
otherwise = (Host -> Orchestra -> Host) -> Host -> [Orchestra] -> Host
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Host -> Orchestra -> Host
orchestrate' (Host -> Host
removeold Host
h) ((Orchestra -> Orchestra) -> [Orchestra] -> [Orchestra]
forall a b. (a -> b) -> [a] -> [b]
map (Host -> Orchestra -> Orchestra
deloop Host
h) [Orchestra]
os)
	os :: [Orchestra]
os = [Host] -> [Orchestra]
extractOrchestras [Host]
hs

	removeold :: Host -> Host
removeold Host
h = (Host -> Host -> Host) -> Host -> [Host] -> Host
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Host -> Host -> Host
forall c. IsContainer c => c -> Host -> c
removeold' Host
h (Host -> [Host]
oldconductorsof Host
h)
	removeold' :: c -> Host -> c
removeold' c
h Host
oldconductor = c -> Props UnixLike -> c
forall c metatypes. IsContainer c => c -> Props metatypes -> c
setContainerProps c
h (Props UnixLike -> c) -> Props UnixLike -> c
forall a b. (a -> b) -> a -> b
$ c -> Props UnixLike
forall c. IsContainer c => c -> Props UnixLike
containerProps c
h
		Props UnixLike
-> RevertableProperty UnixLike UnixLike
-> Props
     (MetaTypes
        (Combine
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
forall a k (x :: [a]) (z :: [a]) (y :: k).
CheckCombinableNote x z (NoteFor ('Text "!")) =>
Props (MetaTypes x)
-> RevertableProperty (MetaTypes y) (MetaTypes z)
-> Props (MetaTypes (Combine x z))
! Host -> RevertableProperty UnixLike UnixLike
conductedBy Host
oldconductor

	oldconductors :: [(Host, NotConductorFor)]
oldconductors = [Host] -> [NotConductorFor] -> [(Host, NotConductorFor)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Host]
hs ((Host -> NotConductorFor) -> [Host] -> [NotConductorFor]
forall a b. (a -> b) -> [a] -> [b]
map (Info -> NotConductorFor
forall v. IsInfo v => Info -> v
fromInfo (Info -> NotConductorFor)
-> (Host -> Info) -> Host -> NotConductorFor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Host -> Info
hostInfo) [Host]
hs)
	oldconductorsof :: Host -> [Host]
oldconductorsof Host
h = (((Host, NotConductorFor) -> Maybe Host)
 -> [(Host, NotConductorFor)] -> [Host])
-> [(Host, NotConductorFor)]
-> ((Host, NotConductorFor) -> Maybe Host)
-> [Host]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Host, NotConductorFor) -> Maybe Host)
-> [(Host, NotConductorFor)] -> [Host]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [(Host, NotConductorFor)]
oldconductors (((Host, NotConductorFor) -> Maybe Host) -> [Host])
-> ((Host, NotConductorFor) -> Maybe Host) -> [Host]
forall a b. (a -> b) -> a -> b
$ 
		\(Host
oldconductor, NotConductorFor [Host]
l) ->
			if (Host -> Bool) -> [Host] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Host -> Host -> Bool
sameHost Host
h) [Host]
l
				then Host -> Maybe Host
forall a. a -> Maybe a
Just Host
oldconductor
				else Maybe Host
forall a. Maybe a
Nothing

orchestrate' :: Host -> Orchestra -> Host
orchestrate' :: Host -> Orchestra -> Host
orchestrate' Host
h (Conducted Host
_) = Host
h
orchestrate' Host
h (Conductor Host
c [Orchestra]
l)
	| Host -> Host -> Bool
sameHost Host
h Host
c = Host -> Host
cont (Host -> Host) -> Host -> Host
forall a b. (a -> b) -> a -> b
$ Host -> [Host] -> Host
addConductorPrivData Host
h ((Orchestra -> [Host]) -> [Orchestra] -> [Host]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Orchestra -> [Host]
allHosts [Orchestra]
l)
	| (Host -> Bool) -> [Host] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Host -> Host -> Bool
sameHost Host
h) ((Orchestra -> Host) -> [Orchestra] -> [Host]
forall a b. (a -> b) -> [a] -> [b]
map Orchestra -> Host
topHost [Orchestra]
l) = Host -> Host
cont (Host -> Host) -> Host -> Host
forall a b. (a -> b) -> a -> b
$
		Host -> Props UnixLike -> Host
forall c metatypes. IsContainer c => c -> Props metatypes -> c
setContainerProps Host
h (Props UnixLike -> Host) -> Props UnixLike -> Host
forall a b. (a -> b) -> a -> b
$ Host -> Props UnixLike
forall c. IsContainer c => c -> Props UnixLike
containerProps Host
h
			Props UnixLike
-> RevertableProperty UnixLike UnixLike
-> Props
     (MetaTypes
        (Combine
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
forall a p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
 CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& Host -> RevertableProperty UnixLike UnixLike
conductedBy Host
c
	| Bool
otherwise = Host -> Host
cont Host
h
  where
	cont :: Host -> Host
cont Host
h' = (Host -> Orchestra -> Host) -> Host -> [Orchestra] -> Host
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Host -> Orchestra -> Host
orchestrate' Host
h' [Orchestra]
l

-- 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 + UnixLike)
conductorFor :: Host -> Property (HasInfo + UnixLike)
conductorFor Host
h = Property UnixLike
go
	Property UnixLike
-> Info
-> Property
     (Sing
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall k (metatypes' :: k) metatypes.
(MetaTypes metatypes' ~ (HasInfo + metatypes), SingI metatypes') =>
Property metatypes -> Info -> Property (MetaTypes metatypes')
`setInfoProperty` (ConductorFor -> Info
forall v. IsInfo v => v -> Info
toInfo ([Host] -> ConductorFor
ConductorFor [Host
h]))
	Property
  (Sing
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property UnixLike
-> CombinedType
     (Property
        (Sing
           '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
     (Property UnixLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` RevertableProperty UnixLike UnixLike -> Property UnixLike
forall setupmetatypes undometatypes.
RevertableProperty setupmetatypes undometatypes
-> Property setupmetatypes
setupRevertableProperty (Host -> RevertableProperty UnixLike UnixLike
conductorKnownHost Host
h)
	Property
  (Sing
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property UnixLike
-> CombinedType
     (Property
        (Sing
           '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
     (Property UnixLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property UnixLike
Ssh.installed
  where
	desc :: Desc
desc = Desc -> Desc
cdesc (Host -> Desc
hostName Host
h)

	go :: Property UnixLike
	go :: Property UnixLike
go = Desc -> Propellor Result -> Property UnixLike
forall k (metatypes :: k).
SingI metatypes =>
Desc -> Propellor Result -> Property (MetaTypes metatypes)
property Desc
desc (Propellor Result -> Property UnixLike)
-> Propellor Result -> Property UnixLike
forall a b. (a -> b) -> a -> b
$ Propellor Bool
-> (Propellor Result, Propellor Result) -> Propellor Result
forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (Orchestrated -> Bool
isOrchestrated (Orchestrated -> Bool) -> Propellor Orchestrated -> Propellor Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Propellor Orchestrated
forall v. IsInfo v => Propellor v
askInfo)
		( do
			PrivMap
pm <- IO PrivMap -> Propellor PrivMap
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PrivMap -> Propellor PrivMap)
-> IO PrivMap -> Propellor PrivMap
forall a b. (a -> b) -> a -> b
$ Host -> PrivMap -> PrivMap
filterPrivData Host
h
				(PrivMap -> PrivMap) -> IO PrivMap -> IO PrivMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Desc -> IO PrivMap
readPrivDataFile Desc
privDataLocal
			IO () -> Propellor ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Propellor ()) -> IO () -> Propellor ()
forall a b. (a -> b) -> a -> b
$ Maybe PrivMap -> Maybe Desc -> Desc -> Host -> IO ()
spin' (PrivMap -> Maybe PrivMap
forall a. a -> Maybe a
Just PrivMap
pm) Maybe Desc
forall a. Maybe a
Nothing (Host -> Desc
hostName Host
h) Host
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.
			Propellor Result
noChange
		, do
			Desc -> Propellor ()
forall (m :: * -> *). MonadIO m => Desc -> m ()
warningMessage Desc
"Can't conduct; either orchestrate has not been used, or there is a conductor loop."
			Result -> Propellor Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
FailedChange
		)

-- Reverts conductorFor.
notConductorFor :: Host -> Property (HasInfo + UnixLike)
notConductorFor :: Host -> Property (HasInfo + UnixLike)
notConductorFor Host
h = (Property UnixLike
forall k (t :: k). SingI t => Property (MetaTypes t)
doNothing :: Property UnixLike)
	Property UnixLike
-> Info
-> Property
     (Sing
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall k (metatypes' :: k) metatypes.
(MetaTypes metatypes' ~ (HasInfo + metatypes), SingI metatypes') =>
Property metatypes -> Info -> Property (MetaTypes metatypes')
`setInfoProperty` (NotConductorFor -> Info
forall v. IsInfo v => v -> Info
toInfo ([Host] -> NotConductorFor
NotConductorFor [Host
h]))
	Property
  (Sing
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Desc
-> Property
     (Sing
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall p. IsProp p => p -> Desc -> p
`describe` Desc
desc
	Property
  (Sing
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property UnixLike
-> CombinedType
     (Property
        (Sing
           '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
     (Property UnixLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` RevertableProperty UnixLike UnixLike -> Property UnixLike
forall setupmetatypes undometatypes.
RevertableProperty setupmetatypes undometatypes
-> Property undometatypes
undoRevertableProperty (Host -> RevertableProperty UnixLike UnixLike
conductorKnownHost Host
h)
  where
	desc :: Desc
desc = Desc
"not " Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc -> Desc
cdesc (Host -> Desc
hostName Host
h)

conductorKnownHost :: Host -> RevertableProperty UnixLike UnixLike
conductorKnownHost :: Host -> RevertableProperty UnixLike UnixLike
conductorKnownHost Host
h = 
	([Host] -> Desc -> User -> Property UnixLike) -> Property UnixLike
mk [Host] -> Desc -> User -> Property UnixLike
Ssh.knownHost
		Property UnixLike
-> Property UnixLike -> RevertableProperty UnixLike UnixLike
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!>
	([Host] -> Desc -> User -> Property UnixLike) -> Property UnixLike
mk [Host] -> Desc -> User -> Property UnixLike
Ssh.unknownHost
  where
	mk :: ([Host] -> Desc -> User -> Property UnixLike) -> Property UnixLike
mk [Host] -> Desc -> User -> Property UnixLike
p = [Host] -> Desc -> User -> Property UnixLike
p [Host
h] (Host -> Desc
hostName Host
h) (Desc -> User
User Desc
"root")

-- Gives a conductor access to all the PrivData of the specified hosts.
-- This allows it to send it on the the hosts when conducting it.
--
-- This is not done in conductorFor, so that it can be added
-- at the orchestration stage, and so is not added when there's a loop.
addConductorPrivData :: Host -> [Host] -> Host
addConductorPrivData :: Host -> [Host] -> Host
addConductorPrivData Host
h [Host]
hs = Host
h { hostInfo :: Info
hostInfo = Host -> Info
hostInfo Host
h Info -> Info -> Info
forall a. Semigroup a => a -> a -> a
<> Info
i }
  where
	i :: Info
i = Info
forall a. Monoid a => a
mempty 
		Info -> PrivInfo -> Info
forall v. IsInfo v => Info -> v -> Info
`addInfo` [PrivInfo] -> PrivInfo
forall a. Monoid a => [a] -> a
mconcat ((Host -> PrivInfo) -> [Host] -> [PrivInfo]
forall a b. (a -> b) -> [a] -> [b]
map Host -> PrivInfo
privinfo [Host]
hs)
		Info -> Orchestrated -> Info
forall v. IsInfo v => Info -> v -> Info
`addInfo` Any -> Orchestrated
Orchestrated (Bool -> Any
Any Bool
True)
	privinfo :: Host -> PrivInfo
privinfo Host
h' = Desc -> PrivInfo -> PrivInfo
forceHostContext (Host -> Desc
hostName Host
h') (PrivInfo -> PrivInfo) -> PrivInfo -> PrivInfo
forall a b. (a -> b) -> a -> b
$ Info -> PrivInfo
forall v. IsInfo v => Info -> v
fromInfo (Host -> Info
hostInfo Host
h')

-- Use this property to let the specified conductor ssh in and run propellor.
conductedBy :: Host -> RevertableProperty UnixLike UnixLike
conductedBy :: Host -> RevertableProperty UnixLike UnixLike
conductedBy Host
h = (CombinedType (Property UnixLike) (Property UnixLike)
Property UnixLike
setup Property UnixLike
-> Property UnixLike -> RevertableProperty UnixLike UnixLike
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property UnixLike
teardown)
	RevertableProperty UnixLike UnixLike
-> Desc -> RevertableProperty UnixLike UnixLike
forall p. IsProp p => p -> Desc -> p
`describe` (Desc
"conducted by " Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Host -> Desc
hostName Host
h)
  where
	setup :: CombinedType (Property UnixLike) (Property UnixLike)
setup = Desc -> User
User Desc
"root" User -> (User, Host) -> Property UnixLike
`Ssh.authorizedKeysFrom` (Desc -> User
User Desc
"root", Host
h)
		Property UnixLike
-> Property UnixLike
-> CombinedType (Property UnixLike) (Property UnixLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property UnixLike
Ssh.installed
	teardown :: Property UnixLike
teardown = Desc -> User
User Desc
"root" User -> (User, Host) -> Property UnixLike
`Ssh.unauthorizedKeysFrom` (Desc -> User
User Desc
"root", Host
h)

cdesc :: String -> Desc
cdesc :: Desc -> Desc
cdesc Desc
n = Desc
"conducting " Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
n

-- A Host's Info indicates when it's a conductor for hosts, and when it's
-- stopped being a conductor.
newtype ConductorFor = ConductorFor [Host]
	deriving (Typeable, b -> ConductorFor -> ConductorFor
NonEmpty ConductorFor -> ConductorFor
ConductorFor -> ConductorFor -> ConductorFor
(ConductorFor -> ConductorFor -> ConductorFor)
-> (NonEmpty ConductorFor -> ConductorFor)
-> (forall b. Integral b => b -> ConductorFor -> ConductorFor)
-> Semigroup ConductorFor
forall b. Integral b => b -> ConductorFor -> ConductorFor
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> ConductorFor -> ConductorFor
$cstimes :: forall b. Integral b => b -> ConductorFor -> ConductorFor
sconcat :: NonEmpty ConductorFor -> ConductorFor
$csconcat :: NonEmpty ConductorFor -> ConductorFor
<> :: ConductorFor -> ConductorFor -> ConductorFor
$c<> :: ConductorFor -> ConductorFor -> ConductorFor
Sem.Semigroup, Semigroup ConductorFor
ConductorFor
Semigroup ConductorFor
-> ConductorFor
-> (ConductorFor -> ConductorFor -> ConductorFor)
-> ([ConductorFor] -> ConductorFor)
-> Monoid ConductorFor
[ConductorFor] -> ConductorFor
ConductorFor -> ConductorFor -> ConductorFor
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [ConductorFor] -> ConductorFor
$cmconcat :: [ConductorFor] -> ConductorFor
mappend :: ConductorFor -> ConductorFor -> ConductorFor
$cmappend :: ConductorFor -> ConductorFor -> ConductorFor
mempty :: ConductorFor
$cmempty :: ConductorFor
$cp1Monoid :: Semigroup ConductorFor
Monoid)
newtype NotConductorFor = NotConductorFor [Host]
	deriving (Typeable, b -> NotConductorFor -> NotConductorFor
NonEmpty NotConductorFor -> NotConductorFor
NotConductorFor -> NotConductorFor -> NotConductorFor
(NotConductorFor -> NotConductorFor -> NotConductorFor)
-> (NonEmpty NotConductorFor -> NotConductorFor)
-> (forall b.
    Integral b =>
    b -> NotConductorFor -> NotConductorFor)
-> Semigroup NotConductorFor
forall b. Integral b => b -> NotConductorFor -> NotConductorFor
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> NotConductorFor -> NotConductorFor
$cstimes :: forall b. Integral b => b -> NotConductorFor -> NotConductorFor
sconcat :: NonEmpty NotConductorFor -> NotConductorFor
$csconcat :: NonEmpty NotConductorFor -> NotConductorFor
<> :: NotConductorFor -> NotConductorFor -> NotConductorFor
$c<> :: NotConductorFor -> NotConductorFor -> NotConductorFor
Sem.Semigroup, Semigroup NotConductorFor
NotConductorFor
Semigroup NotConductorFor
-> NotConductorFor
-> (NotConductorFor -> NotConductorFor -> NotConductorFor)
-> ([NotConductorFor] -> NotConductorFor)
-> Monoid NotConductorFor
[NotConductorFor] -> NotConductorFor
NotConductorFor -> NotConductorFor -> NotConductorFor
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [NotConductorFor] -> NotConductorFor
$cmconcat :: [NotConductorFor] -> NotConductorFor
mappend :: NotConductorFor -> NotConductorFor -> NotConductorFor
$cmappend :: NotConductorFor -> NotConductorFor -> NotConductorFor
mempty :: NotConductorFor
$cmempty :: NotConductorFor
$cp1Monoid :: Semigroup NotConductorFor
Monoid)

instance Show ConductorFor where
	show :: ConductorFor -> Desc
show (ConductorFor [Host]
l) = Desc
"ConductorFor " Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ [Desc] -> Desc
forall a. Show a => a -> Desc
show ((Host -> Desc) -> [Host] -> [Desc]
forall a b. (a -> b) -> [a] -> [b]
map Host -> Desc
hostName [Host]
l)
instance Show NotConductorFor where
	show :: NotConductorFor -> Desc
show (NotConductorFor [Host]
l) = Desc
"NotConductorFor " Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ [Desc] -> Desc
forall a. Show a => a -> Desc
show ((Host -> Desc) -> [Host] -> [Desc]
forall a b. (a -> b) -> [a] -> [b]
map Host -> Desc
hostName [Host]
l)

instance IsInfo ConductorFor where
	propagateInfo :: ConductorFor -> PropagateInfo
propagateInfo ConductorFor
_ = Bool -> PropagateInfo
PropagateInfo Bool
False
instance IsInfo NotConductorFor where
	propagateInfo :: NotConductorFor -> PropagateInfo
propagateInfo NotConductorFor
_ = Bool -> PropagateInfo
PropagateInfo Bool
False

-- Added to Info when a host has been orchestrated.
newtype Orchestrated = Orchestrated Any
	deriving (Typeable, b -> Orchestrated -> Orchestrated
NonEmpty Orchestrated -> Orchestrated
Orchestrated -> Orchestrated -> Orchestrated
(Orchestrated -> Orchestrated -> Orchestrated)
-> (NonEmpty Orchestrated -> Orchestrated)
-> (forall b. Integral b => b -> Orchestrated -> Orchestrated)
-> Semigroup Orchestrated
forall b. Integral b => b -> Orchestrated -> Orchestrated
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Orchestrated -> Orchestrated
$cstimes :: forall b. Integral b => b -> Orchestrated -> Orchestrated
sconcat :: NonEmpty Orchestrated -> Orchestrated
$csconcat :: NonEmpty Orchestrated -> Orchestrated
<> :: Orchestrated -> Orchestrated -> Orchestrated
$c<> :: Orchestrated -> Orchestrated -> Orchestrated
Sem.Semigroup, Semigroup Orchestrated
Orchestrated
Semigroup Orchestrated
-> Orchestrated
-> (Orchestrated -> Orchestrated -> Orchestrated)
-> ([Orchestrated] -> Orchestrated)
-> Monoid Orchestrated
[Orchestrated] -> Orchestrated
Orchestrated -> Orchestrated -> Orchestrated
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Orchestrated] -> Orchestrated
$cmconcat :: [Orchestrated] -> Orchestrated
mappend :: Orchestrated -> Orchestrated -> Orchestrated
$cmappend :: Orchestrated -> Orchestrated -> Orchestrated
mempty :: Orchestrated
$cmempty :: Orchestrated
$cp1Monoid :: Semigroup Orchestrated
Monoid, Int -> Orchestrated -> Desc -> Desc
[Orchestrated] -> Desc -> Desc
Orchestrated -> Desc
(Int -> Orchestrated -> Desc -> Desc)
-> (Orchestrated -> Desc)
-> ([Orchestrated] -> Desc -> Desc)
-> Show Orchestrated
forall a.
(Int -> a -> Desc -> Desc)
-> (a -> Desc) -> ([a] -> Desc -> Desc) -> Show a
showList :: [Orchestrated] -> Desc -> Desc
$cshowList :: [Orchestrated] -> Desc -> Desc
show :: Orchestrated -> Desc
$cshow :: Orchestrated -> Desc
showsPrec :: Int -> Orchestrated -> Desc -> Desc
$cshowsPrec :: Int -> Orchestrated -> Desc -> Desc
Show)
instance IsInfo Orchestrated where
	propagateInfo :: Orchestrated -> PropagateInfo
propagateInfo Orchestrated
_ = Bool -> PropagateInfo
PropagateInfo Bool
False

isOrchestrated :: Orchestrated -> Bool
isOrchestrated :: Orchestrated -> Bool
isOrchestrated (Orchestrated Any
v) = Any -> Bool
getAny Any
v