propellor spin
This commit is contained in:
parent
6383d8c388
commit
c742c2eb1b
|
@ -83,22 +83,17 @@ sshPubKey k = pureAttrProperty ("ssh pubkey known") $
|
|||
getSshPubKey :: Propellor (Maybe String)
|
||||
getSshPubKey = asks _sshPubKey
|
||||
|
||||
hostnameless :: Attr
|
||||
hostnameless = newAttr (error "hostname Attr not specified")
|
||||
|
||||
hostAttr :: Host -> Attr
|
||||
hostAttr (Host _ mkattrs) = mkattrs hostnameless
|
||||
hostAttr (Host hn _ mkattrs) = mkattrs (newAttr hn)
|
||||
|
||||
hostProperties :: Host -> [Property]
|
||||
hostProperties (Host ps _) = ps
|
||||
hostProperties (Host _ ps _) = ps
|
||||
|
||||
hostMap :: [Host] -> M.Map HostName Host
|
||||
hostMap l = M.fromList $ zip (map (_hostname . hostAttr) l) l
|
||||
hostMap l = M.fromList $ zip (map _hostName l) l
|
||||
|
||||
hostAttrMap :: [Host] -> M.Map HostName Attr
|
||||
hostAttrMap l = M.fromList $ zip (map _hostname attrs) attrs
|
||||
where
|
||||
attrs = map hostAttr l
|
||||
hostAttrMap l = M.fromList $ zip (map _hostName l) (map hostAttr l)
|
||||
|
||||
findHost :: [Host] -> HostName -> Maybe Host
|
||||
findHost l hn = M.lookup hn (hostMap l)
|
||||
|
|
|
@ -130,19 +130,19 @@ revert (RevertableProperty p1 p2) = RevertableProperty p2 p1
|
|||
-- > ! oldproperty
|
||||
-- > & otherproperty
|
||||
host :: HostName -> Host
|
||||
host hn = Host [] (\_ -> newAttr hn)
|
||||
host hn = Host hn [] (\_ -> newAttr hn)
|
||||
|
||||
-- | Adds a property to a Host
|
||||
--
|
||||
-- Can add Properties and RevertableProperties
|
||||
(&) :: IsProp p => Host -> p -> Host
|
||||
(Host ps as) & p = Host (ps ++ [toProp p]) (setAttr p . as)
|
||||
(Host hn ps as) & p = Host hn (ps ++ [toProp p]) (setAttr p . as)
|
||||
|
||||
infixl 1 &
|
||||
|
||||
-- | Adds a property to the Host in reverted form.
|
||||
(!) :: Host -> RevertableProperty -> Host
|
||||
(Host ps as) ! p = Host (ps ++ [toProp q]) (setAttr q . as)
|
||||
(Host hn ps as) ! p = Host hn (ps ++ [toProp q]) (setAttr q . as)
|
||||
where
|
||||
q = revert p
|
||||
|
||||
|
|
|
@ -46,9 +46,10 @@ type ContainerName = String
|
|||
-- > & Apt.installed {"apache2"]
|
||||
-- > & ...
|
||||
container :: ContainerName -> Image -> Host
|
||||
container cn image = Host [] (\_ -> attr)
|
||||
container cn image = Host hn [] (\_ -> attr)
|
||||
where
|
||||
attr = (newAttr (cn2hn cn)) { _dockerImage = Just image }
|
||||
attr = (newAttr hn) { _dockerImage = Just image }
|
||||
hn = cn2hn cn
|
||||
|
||||
cn2hn :: ContainerName -> HostName
|
||||
cn2hn cn = cn ++ ".docker"
|
||||
|
@ -67,7 +68,7 @@ docked
|
|||
-> ContainerName
|
||||
-> RevertableProperty
|
||||
docked hosts cn = RevertableProperty
|
||||
(go "docked" setup)
|
||||
((maybe id exposeDnsAttrs mhost) (go "docked" setup))
|
||||
(go "undocked" teardown)
|
||||
where
|
||||
go desc a = property (desc ++ " " ++ cn) $ do
|
||||
|
@ -95,7 +96,7 @@ docked hosts cn = RevertableProperty
|
|||
]
|
||||
|
||||
exposeDnsAttrs :: Host -> Property -> Property
|
||||
exposeDnsAttrs (Host _ containerattr) p = combineProperties (propertyDesc p) $
|
||||
exposeDnsAttrs (Host _ _ containerattr) p = combineProperties (propertyDesc p) $
|
||||
p : map addDNS (S.toList containerdns)
|
||||
where
|
||||
containerdns = _dns $ containerattr $ newAttr undefined
|
||||
|
|
|
@ -34,9 +34,13 @@ import Propellor.Types.Attr
|
|||
import Propellor.Types.OS
|
||||
import Propellor.Types.Dns
|
||||
|
||||
-- | Everything Propellor knows about a system: Its properties and
|
||||
-- attributes.
|
||||
data Host = Host [Property] SetAttr
|
||||
-- | Everything Propellor knows about a system: Its hostname,
|
||||
-- properties and attributes.
|
||||
data Host = Host
|
||||
{ _hostName :: HostName
|
||||
, _hostProps :: [Property]
|
||||
, _hostAttrs :: SetAttr
|
||||
}
|
||||
|
||||
-- | Propellor's monad provides read-only access to attributes of the
|
||||
-- system.
|
||||
|
|
Loading…
Reference in New Issue