propellor/src/Propellor/Host.hs

65 lines
1.8 KiB
Haskell
Raw Normal View History

{-# LANGUAGE PackageImports #-}
module Propellor.Host where
import Data.Monoid
import qualified Data.Set as S
import Propellor.Types
import Propellor.Info
import Propellor.Property
import Propellor.PrivData
-- | Starts accumulating the properties of a Host.
--
-- > host "example.com"
-- > & someproperty
-- > ! oldproperty
-- > & otherproperty
host :: HostName -> Host
host hn = Host hn [] mempty
-- | Something that can accumulate properties.
class Hostlike h where
-- | Adds a property.
--
-- Can add Properties and RevertableProperties
(&) :: IsProp p => h -> p -> h
-- | Like (&), but adds the property as the
-- first property of the host. Normally, property
-- order should not matter, but this is useful
-- when it does.
(&^) :: IsProp p => h -> p -> h
getHost :: h -> Host
instance Hostlike Host where
(Host hn ps is) & p = Host hn (ps ++ [toProp p]) (is <> getInfo p)
(Host hn ps is) &^ p = Host hn ([toProp p] ++ ps) (getInfo p <> is)
getHost h = h
-- | Adds a property in reverted form.
(!) :: Hostlike h => h -> RevertableProperty -> h
h ! p = h & revert p
infixl 1 &^
infixl 1 &
infixl 1 !
-- | When eg, docking a container, some of the Info about the container
-- should propigate out to the Host it's on. This includes DNS info,
-- so that eg, aliases of the container are reflected in the dns for the
-- host where it runs.
--
-- This adjusts the Property that docks a container, to include such info
-- from the container.
propigateInfo :: Hostlike hl => hl -> Property -> (Info -> Info) -> Property
propigateInfo hl p f = combineProperties (propertyDesc p) $
p' : dnsprops ++ privprops
where
p' = p { propertyInfo = f (propertyInfo p) }
i = hostInfo (getHost hl)
dnsprops = map addDNS (S.toList $ _dns i)
privprops = map addPrivDataField (S.toList $ _privDataFields i)