{-# LANGUAGE FlexibleInstances, DeriveDataTypeable, GeneralizedNewtypeDeriving, TypeFamilies #-}
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 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 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 =
forall {k} (metatypes :: k).
SingI metatypes =>
HostName
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList HostName
desc (forall {k} (metatypes :: k).
[Property (MetaTypes metatypes)] -> Props (MetaTypes metatypes)
toProps forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall setupmetatypes undometatypes.
RevertableProperty setupmetatypes undometatypes
-> Property setupmetatypes
setupRevertableProperty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c.
Conductable c =>
c -> RevertableProperty (HasInfo + UnixLike) (HasInfo + UnixLike)
conducts) [Host]
hs)
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!>
forall {k} (metatypes :: k).
SingI metatypes =>
HostName
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList HostName
desc (forall {k} (metatypes :: k).
[Property (MetaTypes metatypes)] -> Props (MetaTypes metatypes)
toProps forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall setupmetatypes undometatypes.
RevertableProperty setupmetatypes undometatypes
-> Property undometatypes
undoRevertableProperty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c.
Conductable c =>
c -> RevertableProperty (HasInfo + UnixLike) (HasInfo + UnixLike)
conducts) [Host]
hs)
where
desc :: HostName
desc = HostName -> HostName
cdesc forall a b. (a -> b) -> a -> b
$ [HostName] -> HostName
unwords forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Host -> HostName
hostName [Host]
hs
data Orchestra
= Conductor Host [Orchestra]
| Conducted Host
instance Show Orchestra where
show :: Orchestra -> HostName
show (Conductor Host
h [Orchestra]
l) = HostName
"Conductor " forall a. [a] -> [a] -> [a]
++ Host -> HostName
hostName Host
h forall a. [a] -> [a] -> [a]
++ HostName
" (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> HostName
show [Orchestra]
l forall a. [a] -> [a] -> [a]
++ HostName
")"
show (Conducted Host
h) = HostName
"Conducted " forall a. [a] -> [a] -> [a]
++ Host -> HostName
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 forall a. a -> [a] -> [a]
: forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Orchestra -> [Host]
allHosts [Orchestra]
l
mkOrchestra :: Host -> Orchestra
mkOrchestra :: Host -> Orchestra
mkOrchestra = forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set HostName -> Host -> Maybe Orchestra
go forall a. Set a
S.empty
where
go :: Set HostName -> Host -> Maybe Orchestra
go Set HostName
seen Host
h
| forall a. Ord a => a -> Set a -> Bool
S.member (Host -> HostName
hostName Host
h) Set HostName
seen = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ case 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 HostName
seen' = forall a. Ord a => a -> Set a -> Set a
S.insert (Host -> HostName
hostName Host
h) Set HostName
seen
in Host -> [Orchestra] -> Orchestra
Conductor Host
h (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Set HostName -> Host -> Maybe Orchestra
go Set HostName
seen') [Host]
l)
combineOrchestras :: Orchestra -> Orchestra -> Maybe Orchestra
combineOrchestras :: Orchestra -> Orchestra -> Maybe Orchestra
combineOrchestras Orchestra
a Orchestra
b = Orchestra -> Orchestra -> Maybe Orchestra
combineOrchestras' Orchestra
a Orchestra
b 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) = forall a. a -> Maybe a
Just Orchestra
b
| Bool
otherwise = forall a. Maybe a
Nothing
combineOrchestras' (Conductor Host
h [Orchestra]
os) (Conductor Host
h' [Orchestra]
os')
| Host -> Host -> Bool
sameHost Host
h Host
h' = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Host -> [Orchestra] -> Orchestra
Conductor Host
h (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 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' = forall a. a -> Maybe a
Just Orchestra
a
combineOrchestras' (Conductor Host
h [Orchestra]
os) Orchestra
b
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall a. [Maybe a] -> [a]
catMaybes (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Orchestra, Maybe Orchestra)]
osgrafts)) = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Host -> [Orchestra] -> Orchestra
Conductor Host
h (forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. a -> Maybe a -> a
fromMaybe) [(Orchestra, Maybe Orchestra)]
osgrafts)
where
osgrafts :: [(Orchestra, Maybe Orchestra)]
osgrafts = forall a b. [a] -> [b] -> [(a, b)]
zip [Orchestra]
os (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 -> HostName
hostName Host
a forall a. Eq a => a -> a -> Bool
== Host -> HostName
hostName Host
b
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 forall a b. (a -> b) -> a -> b
$
forall a b. (a, b) -> a
fst 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 forall a. a -> [a] -> [a]
: [Orchestra]
l) [Orchestra]
rest Bool
True
| Bool
otherwise = [Orchestra] -> [Orchestra] -> Bool -> ([Orchestra], Bool)
seekh (Host -> Orchestra
Conducted Host
hforall 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' 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' forall a. a -> [a] -> [a]
: [Orchestra]
l) [Orchestra]
rest Bool
seen'
extractOrchestras :: [Host] -> [Orchestra]
= forall a. (a -> Bool) -> [a] -> [a]
filter Orchestra -> Bool
fullOrchestra forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Orchestra] -> [Orchestra] -> [Orchestra]
go [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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' = forall a b. [a] -> [b] -> [(a, b)]
zip [Orchestra]
os (forall a b. (a -> b) -> [a] -> [b]
map (Orchestra -> Orchestra -> Maybe Orchestra
combineOrchestras Orchestra
o) [Orchestra]
os)
in case forall a. [Maybe a] -> [a]
catMaybes (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Orchestra, Maybe Orchestra)]
os') of
[] -> [Orchestra] -> [Orchestra] -> [Orchestra]
go (Orchestra
oforall a. a -> [a] -> [a]
:[Orchestra]
os) [Orchestra]
rest
[Orchestra
_] -> [Orchestra] -> [Orchestra] -> [Orchestra]
go (forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. a -> Maybe a -> a
fromMaybe) [(Orchestra, Maybe Orchestra)]
os') [Orchestra]
rest
[Orchestra]
_ -> forall a. HasCallStack => HostName -> a
error HostName
"Bug: Host somehow ended up in multiple Orchestras!"
orchestrate :: [Host] -> [Host]
orchestrate :: [Host] -> [Host]
orchestrate [Host]
hs = forall a b. (a -> b) -> [a] -> [b]
map Host -> Host
go [Host]
hs
where
go :: Host -> Host
go Host
h
| Orchestrated -> Bool
isOrchestrated (forall v. IsInfo v => Info -> v
fromInfo (Host -> Info
hostInfo Host
h)) = Host
h
| Bool
otherwise = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Host -> Orchestra -> Host
orchestrate' (Host -> Host
removeold Host
h) (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 = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall {c}. IsContainer c => c -> Host -> c
removeold' Host
h (Host -> [Host]
oldconductorsof Host
h)
removeold' :: c -> Host -> c
removeold' c
h Host
oldconductor = forall c metatypes. IsContainer c => c -> Props metatypes -> c
setContainerProps c
h forall a b. (a -> b) -> a -> b
$ forall c. IsContainer c => c -> Props UnixLike
containerProps c
h
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 = forall a b. [a] -> [b] -> [(a, b)]
zip [Host]
hs (forall a b. (a -> b) -> [a] -> [b]
map (forall v. IsInfo v => Info -> v
fromInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Host -> Info
hostInfo) [Host]
hs)
oldconductorsof :: Host -> [Host]
oldconductorsof Host
h = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [(Host, NotConductorFor)]
oldconductors forall a b. (a -> b) -> a -> b
$
\(Host
oldconductor, NotConductorFor [Host]
l) ->
if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Host -> Host -> Bool
sameHost Host
h) [Host]
l
then forall a. a -> Maybe a
Just Host
oldconductor
else 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 forall a b. (a -> b) -> a -> b
$ Host -> [Host] -> Host
addConductorPrivData Host
h (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Orchestra -> [Host]
allHosts [Orchestra]
l)
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Host -> Host -> Bool
sameHost Host
h) (forall a b. (a -> b) -> [a] -> [b]
map Orchestra -> Host
topHost [Orchestra]
l) = Host -> Host
cont forall a b. (a -> b) -> a -> b
$
forall c metatypes. IsContainer c => c -> Props metatypes -> c
setContainerProps Host
h forall a b. (a -> b) -> a -> b
$ forall c. IsContainer c => c -> Props UnixLike
containerProps Host
h
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' = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Host -> Orchestra -> Host
orchestrate' Host
h' [Orchestra]
l
conductorFor :: Host -> Property (HasInfo + UnixLike)
conductorFor :: Host -> Property (HasInfo + UnixLike)
conductorFor Host
h = Property UnixLike
go
forall {k} (metatypes' :: k) metatypes.
(MetaTypes metatypes' ~ (HasInfo + metatypes), SingI metatypes') =>
Property metatypes -> Info -> Property (MetaTypes metatypes')
`setInfoProperty` (forall v. IsInfo v => v -> Info
toInfo ([Host] -> ConductorFor
ConductorFor [Host
h]))
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` forall setupmetatypes undometatypes.
RevertableProperty setupmetatypes undometatypes
-> Property setupmetatypes
setupRevertableProperty (Host -> RevertableProperty UnixLike UnixLike
conductorKnownHost Host
h)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property UnixLike
Ssh.installed
where
desc :: HostName
desc = HostName -> HostName
cdesc (Host -> HostName
hostName Host
h)
go :: Property UnixLike
go :: Property UnixLike
go = forall {k} (metatypes :: k).
SingI metatypes =>
HostName -> Propellor Result -> Property (MetaTypes metatypes)
property HostName
desc forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (Orchestrated -> Bool
isOrchestrated forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall v. IsInfo v => Propellor v
askInfo)
( do
PrivMap
pm <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Host -> PrivMap -> PrivMap
filterPrivData Host
h
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HostName -> IO PrivMap
readPrivDataFile HostName
privDataLocal
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Maybe PrivMap -> Maybe HostName -> HostName -> Host -> IO ()
spin' (forall a. a -> Maybe a
Just PrivMap
pm) forall a. Maybe a
Nothing (Host -> HostName
hostName Host
h) Host
h
Propellor Result
noChange
, do
forall (m :: * -> *). MonadIO m => HostName -> m ()
warningMessage HostName
"Can't conduct; either orchestrate has not been used, or there is a conductor loop."
forall (m :: * -> *) a. Monad m => a -> m a
return Result
FailedChange
)
notConductorFor :: Host -> Property (HasInfo + UnixLike)
notConductorFor :: Host -> Property (HasInfo + UnixLike)
notConductorFor Host
h = (forall {k} (t :: k). SingI t => Property (MetaTypes t)
doNothing :: Property UnixLike)
forall {k} (metatypes' :: k) metatypes.
(MetaTypes metatypes' ~ (HasInfo + metatypes), SingI metatypes') =>
Property metatypes -> Info -> Property (MetaTypes metatypes')
`setInfoProperty` (forall v. IsInfo v => v -> Info
toInfo ([Host] -> NotConductorFor
NotConductorFor [Host
h]))
forall p. IsProp p => p -> HostName -> p
`describe` HostName
desc
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` forall setupmetatypes undometatypes.
RevertableProperty setupmetatypes undometatypes
-> Property undometatypes
undoRevertableProperty (Host -> RevertableProperty UnixLike UnixLike
conductorKnownHost Host
h)
where
desc :: HostName
desc = HostName
"not " forall a. [a] -> [a] -> [a]
++ HostName -> HostName
cdesc (Host -> HostName
hostName Host
h)
conductorKnownHost :: Host -> RevertableProperty UnixLike UnixLike
conductorKnownHost :: Host -> RevertableProperty UnixLike UnixLike
conductorKnownHost Host
h =
([Host] -> HostName -> User -> Property UnixLike)
-> Property UnixLike
mk [Host] -> HostName -> User -> Property UnixLike
Ssh.knownHost
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!>
([Host] -> HostName -> User -> Property UnixLike)
-> Property UnixLike
mk [Host] -> HostName -> User -> Property UnixLike
Ssh.unknownHost
where
mk :: ([Host] -> HostName -> User -> Property UnixLike)
-> Property UnixLike
mk [Host] -> HostName -> User -> Property UnixLike
p = [Host] -> HostName -> User -> Property UnixLike
p [Host
h] (Host -> HostName
hostName Host
h) (HostName -> User
User HostName
"root")
addConductorPrivData :: Host -> [Host] -> Host
addConductorPrivData :: Host -> [Host] -> Host
addConductorPrivData Host
h [Host]
hs = Host
h { hostInfo :: Info
hostInfo = Host -> Info
hostInfo Host
h forall a. Semigroup a => a -> a -> a
<> Info
i }
where
i :: Info
i = forall a. Monoid a => a
mempty
forall v. IsInfo v => Info -> v -> Info
`addInfo` forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map Host -> PrivInfo
privinfo [Host]
hs)
forall v. IsInfo v => Info -> v -> Info
`addInfo` Any -> Orchestrated
Orchestrated (Bool -> Any
Any Bool
True)
privinfo :: Host -> PrivInfo
privinfo Host
h' = HostName -> PrivInfo -> PrivInfo
forceHostContext (Host -> HostName
hostName Host
h') forall a b. (a -> b) -> a -> b
$ forall v. IsInfo v => Info -> v
fromInfo (Host -> Info
hostInfo Host
h')
conductedBy :: Host -> RevertableProperty UnixLike UnixLike
conductedBy :: Host -> RevertableProperty UnixLike UnixLike
conductedBy Host
h = (CombinedType (Property UnixLike) (Property UnixLike)
setup forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property UnixLike
teardown)
forall p. IsProp p => p -> HostName -> p
`describe` (HostName
"conducted by " forall a. [a] -> [a] -> [a]
++ Host -> HostName
hostName Host
h)
where
setup :: CombinedType (Property UnixLike) (Property UnixLike)
setup = HostName -> User
User HostName
"root" User -> (User, Host) -> Property UnixLike
`Ssh.authorizedKeysFrom` (HostName -> User
User HostName
"root", Host
h)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property UnixLike
Ssh.installed
teardown :: Property UnixLike
teardown = HostName -> User
User HostName
"root" User -> (User, Host) -> Property UnixLike
`Ssh.unauthorizedKeysFrom` (HostName -> User
User HostName
"root", Host
h)
cdesc :: String -> Desc
cdesc :: HostName -> HostName
cdesc HostName
n = HostName
"conducting " forall a. [a] -> [a] -> [a]
++ HostName
n
newtype ConductorFor = ConductorFor [Host]
deriving (Typeable, NonEmpty ConductorFor -> ConductorFor
ConductorFor -> ConductorFor -> 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 :: forall b. Integral b => 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
[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
Monoid)
newtype NotConductorFor = NotConductorFor [Host]
deriving (Typeable, NonEmpty NotConductorFor -> NotConductorFor
NotConductorFor -> NotConductorFor -> 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 :: forall b. Integral b => 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
[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
Monoid)
instance Show ConductorFor where
show :: ConductorFor -> HostName
show (ConductorFor [Host]
l) = HostName
"ConductorFor " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> HostName
show (forall a b. (a -> b) -> [a] -> [b]
map Host -> HostName
hostName [Host]
l)
instance Show NotConductorFor where
show :: NotConductorFor -> HostName
show (NotConductorFor [Host]
l) = HostName
"NotConductorFor " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> HostName
show (forall a b. (a -> b) -> [a] -> [b]
map Host -> HostName
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
newtype Orchestrated = Orchestrated Any
deriving (Typeable, NonEmpty Orchestrated -> Orchestrated
Orchestrated -> Orchestrated -> 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 :: forall b. Integral b => 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
[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
Monoid, Int -> Orchestrated -> HostName -> HostName
[Orchestrated] -> HostName -> HostName
Orchestrated -> HostName
forall a.
(Int -> a -> HostName -> HostName)
-> (a -> HostName) -> ([a] -> HostName -> HostName) -> Show a
showList :: [Orchestrated] -> HostName -> HostName
$cshowList :: [Orchestrated] -> HostName -> HostName
show :: Orchestrated -> HostName
$cshow :: Orchestrated -> HostName
showsPrec :: Int -> Orchestrated -> HostName -> HostName
$cshowsPrec :: Int -> Orchestrated -> HostName -> HostName
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