propellor spin

This commit is contained in:
Joey Hess 2014-05-31 17:22:35 -04:00
parent 6383d8c388
commit c742c2eb1b
Failed to extract signature
4 changed files with 19 additions and 19 deletions

View File

@ -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)

View File

@ -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

View File

@ -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

View File

@ -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.