simplified record accessors
This commit is contained in:
parent
e133536c3f
commit
58c8d74b4c
|
@ -15,9 +15,6 @@ import Control.Applicative
|
||||||
pureAttrProperty :: Desc -> Attr -> Property
|
pureAttrProperty :: Desc -> Attr -> Property
|
||||||
pureAttrProperty desc = Property ("has " ++ desc) (return NoChange)
|
pureAttrProperty desc = Property ("has " ++ desc) (return NoChange)
|
||||||
|
|
||||||
getHostName :: Propellor HostName
|
|
||||||
getHostName = asks _hostName
|
|
||||||
|
|
||||||
os :: System -> Property
|
os :: System -> Property
|
||||||
os system = pureAttrProperty ("Operating " ++ show system) $
|
os system = pureAttrProperty ("Operating " ++ show system) $
|
||||||
mempty { _os = Just system }
|
mempty { _os = Just system }
|
||||||
|
@ -63,14 +60,8 @@ sshPubKey k = pureAttrProperty ("ssh pubkey known") $
|
||||||
getSshPubKey :: Propellor (Maybe String)
|
getSshPubKey :: Propellor (Maybe String)
|
||||||
getSshPubKey = asks (_sshPubKey . hostAttr)
|
getSshPubKey = asks (_sshPubKey . hostAttr)
|
||||||
|
|
||||||
hostAttr :: Host -> Attr
|
|
||||||
hostAttr (Host _ _ attr) = attr
|
|
||||||
|
|
||||||
hostProperties :: Host -> [Property]
|
|
||||||
hostProperties (Host _ ps _) = ps
|
|
||||||
|
|
||||||
hostMap :: [Host] -> M.Map HostName Host
|
hostMap :: [Host] -> M.Map HostName Host
|
||||||
hostMap l = M.fromList $ zip (map _hostName l) l
|
hostMap l = M.fromList $ zip (map hostName l) l
|
||||||
|
|
||||||
findHost :: [Host] -> HostName -> Maybe Host
|
findHost :: [Host] -> HostName -> Maybe Host
|
||||||
findHost l hn = M.lookup hn (hostMap l)
|
findHost l hn = M.lookup hn (hostMap l)
|
||||||
|
|
|
@ -32,7 +32,7 @@ ensureProperties ps = ensure ps NoChange
|
||||||
where
|
where
|
||||||
ensure [] rs = return rs
|
ensure [] rs = return rs
|
||||||
ensure (l:ls) rs = do
|
ensure (l:ls) rs = do
|
||||||
hn <- getHostName
|
hn <- asks hostName
|
||||||
r <- actionMessageOn hn (propertyDesc l) (ensureProperty l)
|
r <- actionMessageOn hn (propertyDesc l) (ensureProperty l)
|
||||||
ensure ls (r <> rs)
|
ensure ls (r <> rs)
|
||||||
|
|
||||||
|
|
|
@ -13,7 +13,6 @@ import Control.Monad
|
||||||
import "mtl" Control.Monad.Reader
|
import "mtl" Control.Monad.Reader
|
||||||
|
|
||||||
import Propellor.Types
|
import Propellor.Types
|
||||||
import Propellor.Attr
|
|
||||||
import Propellor.Message
|
import Propellor.Message
|
||||||
import Utility.Monad
|
import Utility.Monad
|
||||||
import Utility.PartialPrelude
|
import Utility.PartialPrelude
|
||||||
|
@ -30,7 +29,7 @@ withPrivData :: PrivDataField -> (String -> Propellor Result) -> Propellor Resul
|
||||||
withPrivData field a = maybe missing a =<< liftIO (getPrivData field)
|
withPrivData field a = maybe missing a =<< liftIO (getPrivData field)
|
||||||
where
|
where
|
||||||
missing = do
|
missing = do
|
||||||
host <- getHostName
|
host <- asks hostName
|
||||||
let host' = if ".docker" `isSuffixOf` host
|
let host' = if ".docker" `isSuffixOf` host
|
||||||
then "$parent_host"
|
then "$parent_host"
|
||||||
else host
|
else host
|
||||||
|
|
|
@ -352,11 +352,11 @@ genZone hosts zdomain soa =
|
||||||
-- so warn.
|
-- so warn.
|
||||||
hostips :: Host -> [Either WarningMessage (BindDomain, Record)]
|
hostips :: Host -> [Either WarningMessage (BindDomain, Record)]
|
||||||
hostips h
|
hostips h
|
||||||
| null l = [Left $ "no IP address defined for host " ++ _hostName h]
|
| null l = [Left $ "no IP address defined for host " ++ hostName h]
|
||||||
| otherwise = map Right l
|
| otherwise = map Right l
|
||||||
where
|
where
|
||||||
attr = hostAttr h
|
attr = hostAttr h
|
||||||
l = zip (repeat $ AbsDomain $ _hostName h)
|
l = zip (repeat $ AbsDomain $ hostName h)
|
||||||
(map Address $ getAddresses attr)
|
(map Address $ getAddresses attr)
|
||||||
|
|
||||||
-- Any host, whether its hostname is in the zdomain or not,
|
-- Any host, whether its hostname is in the zdomain or not,
|
||||||
|
@ -387,7 +387,7 @@ genZone hosts zdomain soa =
|
||||||
hostrecords h = map Right l
|
hostrecords h = map Right l
|
||||||
where
|
where
|
||||||
attr = hostAttr h
|
attr = hostAttr h
|
||||||
l = zip (repeat $ AbsDomain $ _hostName h)
|
l = zip (repeat $ AbsDomain $ hostName h)
|
||||||
(S.toList $ S.filter (\r -> isNothing (getIPAddr r) && isNothing (getCNAME r)) (_dns attr))
|
(S.toList $ S.filter (\r -> isNothing (getIPAddr r) && isNothing (getCNAME r)) (_dns attr))
|
||||||
|
|
||||||
inDomain :: Domain -> BindDomain -> Bool
|
inDomain :: Domain -> BindDomain -> Bool
|
||||||
|
|
|
@ -72,7 +72,7 @@ docked hosts cn = RevertableProperty
|
||||||
(go "undocked" teardown)
|
(go "undocked" teardown)
|
||||||
where
|
where
|
||||||
go desc a = property (desc ++ " " ++ cn) $ do
|
go desc a = property (desc ++ " " ++ cn) $ do
|
||||||
hn <- getHostName
|
hn <- asks hostName
|
||||||
let cid = ContainerId hn cn
|
let cid = ContainerId hn cn
|
||||||
ensureProperties [findContainer mhost cid cn $ a cid]
|
ensureProperties [findContainer mhost cid cn $ a cid]
|
||||||
|
|
||||||
|
|
|
@ -9,7 +9,7 @@ import qualified Propellor.Property.File as File
|
||||||
-- A FQDN also configures /etc/hosts, with an entry for 127.0.1.1, which is
|
-- A FQDN also configures /etc/hosts, with an entry for 127.0.1.1, which is
|
||||||
-- standard at least on Debian to set the FDQN (127.0.0.1 is localhost).
|
-- standard at least on Debian to set the FDQN (127.0.0.1 is localhost).
|
||||||
sane :: Property
|
sane :: Property
|
||||||
sane = property ("sane hostname") (ensureProperty . setTo =<< getHostName)
|
sane = property ("sane hostname") (ensureProperty . setTo =<< asks hostName)
|
||||||
|
|
||||||
setTo :: HostName -> Property
|
setTo :: HostName -> Property
|
||||||
setTo hn = combineProperties desc go
|
setTo hn = combineProperties desc go
|
||||||
|
|
|
@ -16,7 +16,7 @@ satellite :: Property
|
||||||
satellite = setup `requires` installed
|
satellite = setup `requires` installed
|
||||||
where
|
where
|
||||||
setup = trivial $ property "postfix satellite system" $ do
|
setup = trivial $ property "postfix satellite system" $ do
|
||||||
hn <- getHostName
|
hn <- asks hostName
|
||||||
ensureProperty $ Apt.reConfigure "postfix"
|
ensureProperty $ Apt.reConfigure "postfix"
|
||||||
[ ("postfix/main_mailer_type", "select", "Satellite system")
|
[ ("postfix/main_mailer_type", "select", "Satellite system")
|
||||||
, ("postfix/root_address", "string", "root")
|
, ("postfix/root_address", "string", "root")
|
||||||
|
|
|
@ -36,9 +36,9 @@ import Propellor.Types.Dns
|
||||||
-- | Everything Propellor knows about a system: Its hostname,
|
-- | Everything Propellor knows about a system: Its hostname,
|
||||||
-- properties and attributes.
|
-- properties and attributes.
|
||||||
data Host = Host
|
data Host = Host
|
||||||
{ _hostName :: HostName
|
{ hostName :: HostName
|
||||||
, _hostProps :: [Property]
|
, hostProperties :: [Property]
|
||||||
, _hostAttr :: Attr
|
, hostAttr :: Attr
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Propellor's monad provides read-only access to the host it's running
|
-- | Propellor's monad provides read-only access to the host it's running
|
||||||
|
|
Loading…
Reference in New Issue