simplified record accessors

This commit is contained in:
Joey Hess 2014-05-31 20:48:23 -04:00
parent e133536c3f
commit 58c8d74b4c
8 changed files with 12 additions and 22 deletions

View File

@ -15,9 +15,6 @@ import Control.Applicative
pureAttrProperty :: Desc -> Attr -> Property
pureAttrProperty desc = Property ("has " ++ desc) (return NoChange)
getHostName :: Propellor HostName
getHostName = asks _hostName
os :: System -> Property
os system = pureAttrProperty ("Operating " ++ show system) $
mempty { _os = Just system }
@ -63,14 +60,8 @@ sshPubKey k = pureAttrProperty ("ssh pubkey known") $
getSshPubKey :: Propellor (Maybe String)
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 l = M.fromList $ zip (map _hostName l) l
hostMap l = M.fromList $ zip (map hostName l) l
findHost :: [Host] -> HostName -> Maybe Host
findHost l hn = M.lookup hn (hostMap l)

View File

@ -32,7 +32,7 @@ ensureProperties ps = ensure ps NoChange
where
ensure [] rs = return rs
ensure (l:ls) rs = do
hn <- getHostName
hn <- asks hostName
r <- actionMessageOn hn (propertyDesc l) (ensureProperty l)
ensure ls (r <> rs)

View File

@ -13,7 +13,6 @@ import Control.Monad
import "mtl" Control.Monad.Reader
import Propellor.Types
import Propellor.Attr
import Propellor.Message
import Utility.Monad
import Utility.PartialPrelude
@ -30,7 +29,7 @@ withPrivData :: PrivDataField -> (String -> Propellor Result) -> Propellor Resul
withPrivData field a = maybe missing a =<< liftIO (getPrivData field)
where
missing = do
host <- getHostName
host <- asks hostName
let host' = if ".docker" `isSuffixOf` host
then "$parent_host"
else host

View File

@ -352,11 +352,11 @@ genZone hosts zdomain soa =
-- so warn.
hostips :: Host -> [Either WarningMessage (BindDomain, Record)]
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
where
attr = hostAttr h
l = zip (repeat $ AbsDomain $ _hostName h)
l = zip (repeat $ AbsDomain $ hostName h)
(map Address $ getAddresses attr)
-- Any host, whether its hostname is in the zdomain or not,
@ -387,7 +387,7 @@ genZone hosts zdomain soa =
hostrecords h = map Right l
where
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))
inDomain :: Domain -> BindDomain -> Bool

View File

@ -72,7 +72,7 @@ docked hosts cn = RevertableProperty
(go "undocked" teardown)
where
go desc a = property (desc ++ " " ++ cn) $ do
hn <- getHostName
hn <- asks hostName
let cid = ContainerId hn cn
ensureProperties [findContainer mhost cid cn $ a cid]

View File

@ -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
-- standard at least on Debian to set the FDQN (127.0.0.1 is localhost).
sane :: Property
sane = property ("sane hostname") (ensureProperty . setTo =<< getHostName)
sane = property ("sane hostname") (ensureProperty . setTo =<< asks hostName)
setTo :: HostName -> Property
setTo hn = combineProperties desc go

View File

@ -16,7 +16,7 @@ satellite :: Property
satellite = setup `requires` installed
where
setup = trivial $ property "postfix satellite system" $ do
hn <- getHostName
hn <- asks hostName
ensureProperty $ Apt.reConfigure "postfix"
[ ("postfix/main_mailer_type", "select", "Satellite system")
, ("postfix/root_address", "string", "root")

View File

@ -36,9 +36,9 @@ import Propellor.Types.Dns
-- | Everything Propellor knows about a system: Its hostname,
-- properties and attributes.
data Host = Host
{ _hostName :: HostName
, _hostProps :: [Property]
, _hostAttr :: Attr
{ hostName :: HostName
, hostProperties :: [Property]
, hostAttr :: Attr
}
-- | Propellor's monad provides read-only access to the host it's running