remove now redundant _hostname field of Attr

Now that Host includes _hostName, it's redundant to also keep it in Attr.

This requires changing the reader monad to operate on the whole Host.

src/Propellor/Attr.hs

@@ -14,19 +14,15 @@ import Control.Applicative
 pureAttrProperty :: Desc -> SetAttr -> Property 
 pureAttrProperty desc = Property ("has " ++ desc) (return NoChange)
 
-hostname :: HostName -> Property
-hostname name = pureAttrProperty ("hostname " ++ name) $
-	\d -> d { _hostname = name }
-
 getHostName :: Propellor HostName
-getHostName = asks _hostname
+getHostName = asks _hostName
 
 os :: System -> Property
 os system = pureAttrProperty ("Operating " ++ show system) $
 	\d -> d { _os = Just system }
 
 getOS :: Propellor (Maybe System)
-getOS = asks _os
+getOS = asks (_os . hostAttr)
 
 -- | Indidate that a host has an A record in the DNS.
 --
@@ -74,17 +70,17 @@ addNamedConf conf d = d { _namedconf = new }
 		_  -> M.insert domain conf m
 
 getNamedConf :: Propellor (M.Map Domain NamedConf)
-getNamedConf = asks _namedconf
+getNamedConf = asks (_namedconf . hostAttr)
 
 sshPubKey :: String -> Property
 sshPubKey k = pureAttrProperty ("ssh pubkey known") $
 	\d -> d { _sshPubKey = Just k }
 
 getSshPubKey :: Propellor (Maybe String)
-getSshPubKey = asks _sshPubKey
+getSshPubKey = asks (_sshPubKey . hostAttr)
 
 hostAttr :: Host -> Attr
-hostAttr (Host hn _ mkattrs) = mkattrs (newAttr hn)
+hostAttr (Host _ _ mkattrs) = mkattrs newAttr
 
 hostProperties :: Host -> [Property]
 hostProperties (Host _ ps _) = ps
@@ -92,9 +88,6 @@ hostProperties (Host _ ps _) = ps
 hostMap :: [Host] -> M.Map HostName Host
 hostMap l = M.fromList $ zip (map _hostName l) l 
 
-hostAttrMap :: [Host] -> M.Map HostName Attr
-hostAttrMap l = M.fromList $ zip (map _hostName l) (map hostAttr l)
-
 findHost :: [Host] -> HostName -> Maybe Host
 findHost l hn = M.lookup hn (hostMap l)
 
@@ -105,12 +98,3 @@ hostAddresses :: HostName -> [Host] -> [IPAddr]
 hostAddresses hn hosts = case hostAttr <$> findHost hosts hn of
 	Nothing -> []
 	Just attr -> mapMaybe getIPAddr $ S.toList $ _dns attr
-
--- | Lifts an action into a different host.
---
--- For example, `fromHost hosts "otherhost" getSshPubKey`
-fromHost :: [Host] -> HostName -> Propellor a -> Propellor (Maybe a)
-fromHost l hn getter = case findHost l hn of
-	Nothing -> return Nothing
-	Just h -> liftIO $ Just <$>
-		runReaderT (runWithAttr getter) (hostAttr h)

src/Propellor/CmdLine.hs

@@ -67,24 +67,21 @@ defaultMain hostlist = do
 	go _ (Continue cmdline) = go False cmdline
 	go _ (Set hn field) = setPrivData hn field
 	go _ (AddKey keyid) = addKey keyid
-	go _ (Chain hn) = withprops hn $ \attr ps -> do
+	go _ (Chain hn) = withhost hn $ \h -> do
-		r <- runPropellor attr $ ensureProperties ps
+		r <- runPropellor h $ ensureProperties $ hostProperties h
 		putStrLn $ "\n" ++ show r
 	go _ (Docker hn) = Docker.chain hn
 	go True cmdline@(Spin _) = buildFirst cmdline $ go False cmdline
 	go True cmdline = updateFirst cmdline $ go False cmdline
-	go False (Spin hn) = withprops hn $ const . const $ spin hn
+	go False (Spin hn) = withhost hn $ const $ spin hn
 	go False (Run hn) = ifM ((==) 0 <$> getRealUserID)
-		( onlyProcess $ withprops hn mainProperties
+		( onlyProcess $ withhost hn mainProperties
 		, go True (Spin hn)
 		)
-	go False (Boot hn) = onlyProcess $ withprops hn boot
+	go False (Boot hn) = onlyProcess $ withhost hn boot
 
-	withprops :: HostName -> (Attr -> [Property] -> IO ()) -> IO ()
+	withhost :: HostName -> (Host -> IO ()) -> IO ()
-	withprops hn a = maybe
+	withhost hn a = maybe (unknownhost hn) a (findHost hostlist hn)
-		(unknownhost hn)
-		(\h -> a (hostAttr h) (hostProperties h))
-		(findHost hostlist hn)
 
 onlyProcess :: IO a -> IO a
 onlyProcess a = bracket lock unlock (const a)
@@ -279,15 +276,15 @@ fromMarked marker s
 	len = length marker
 	matches = filter (marker `isPrefixOf`) $ lines s
 
-boot :: Attr -> [Property] -> IO ()
+boot :: Host -> IO ()
-boot attr ps = do
+boot h = do
 	sendMarked stdout statusMarker $ show Ready
 	reply <- hGetContentsStrict stdin
 
 	makePrivDataDir
 	maybe noop (writeFileProtected privDataLocal) $
 		fromMarked privDataMarker reply
-	mainProperties attr ps
+	mainProperties h
 
 addKey :: String -> IO ()
 addKey keyid = exitBool =<< allM id [ gpg, gitadd, gitconfig, gitcommit ]

src/Propellor/Engine.hs

@@ -5,20 +5,22 @@ module Propellor.Engine where
 import System.Exit
 import System.IO
 import Data.Monoid
+import Control.Applicative
 import System.Console.ANSI
 import "mtl" Control.Monad.Reader
 
 import Propellor.Types
 import Propellor.Message
 import Propellor.Exception
+import Propellor.Attr
 
-runPropellor :: Attr -> Propellor a -> IO a
+runPropellor :: Host -> Propellor a -> IO a
-runPropellor attr a = runReaderT (runWithAttr a) attr
+runPropellor host a = runReaderT (runWithHost a) host
 
-mainProperties :: Attr -> [Property] -> IO ()
+mainProperties :: Host -> IO ()
-mainProperties attr ps = do
+mainProperties host = do
-	r <- runPropellor attr $
+	r <- runPropellor host $
-		ensureProperties [Property "overall" (ensureProperties ps) id]
+		ensureProperties [Property "overall" (ensureProperties $ hostProperties host) id]
 	setTitle "propellor: done"
 	hFlush stdout
 	case r of
@@ -35,3 +37,12 @@ ensureProperties ps = ensure ps NoChange
 
 ensureProperty :: Property -> Propellor Result
 ensureProperty = catchPropellor . propertySatisfy
+
+-- | Lifts an action into a different host.
+--
+-- For example, `fromHost hosts "otherhost" getSshPubKey`
+fromHost :: [Host] -> HostName -> Propellor a -> Propellor (Maybe a)
+fromHost l hn getter = case findHost l hn of
+	Nothing -> return Nothing
+	Just h -> liftIO $ Just <$>
+		runReaderT (runWithHost getter) h

src/Propellor/Property.hs

@@ -130,7 +130,7 @@ revert (RevertableProperty p1 p2) = RevertableProperty p2 p1
 -- > 	! oldproperty
 -- > 	& otherproperty
 host :: HostName -> Host
-host hn = Host hn [] (\_ -> newAttr hn)
+host hn = Host hn [] (\_ -> newAttr)
 
 -- | Adds a property to a Host
 --

src/Propellor/Property/Dns.hs

@@ -129,9 +129,9 @@ secondaryFor masters hosts domain = RevertableProperty setup cleanup
 
 otherServers :: DnsServerType -> [Host] -> Domain -> [HostName]
 otherServers wantedtype hosts domain =
-	M.keys $ M.filter wanted $ hostAttrMap hosts
+	M.keys $ M.filter wanted $ hostMap hosts
   where
-	wanted attr = case M.lookup domain (_namedconf attr) of
+	wanted h = case M.lookup domain (_namedconf $ hostAttr h) of
 		Nothing -> False
 		Just conf -> confDnsServerType conf == wantedtype
 			&& confDomain conf == domain
@@ -341,7 +341,7 @@ genZone hosts zdomain soa =
 		]
 	in (Zone zdomain soa (nub zhosts), warnings)
   where
-	m = hostAttrMap hosts
+	m = hostMap hosts
 	-- Known hosts with hostname located in the zone's domain.
 	inzdomain = M.elems $ M.filterWithKey (\hn _ -> inDomain zdomain $ AbsDomain $ hn) m
 	
@@ -350,12 +350,13 @@ genZone hosts zdomain soa =
 	--
 	-- If a host lacks any IPAddr, it's probably a misconfiguration,
 	-- so warn.
-	hostips :: Attr -> [Either WarningMessage (BindDomain, Record)]
+	hostips :: Host -> [Either WarningMessage (BindDomain, Record)]
-	hostips attr
+	hostips h
-		| null l = [Left $ "no IP address defined for host " ++ _hostname attr]
+		| null l = [Left $ "no IP address defined for host " ++ _hostName h]
 		| otherwise = map Right l
 	  where
-		l = zip (repeat $ AbsDomain $ _hostname attr)
+		attr = hostAttr h
+		l = zip (repeat $ AbsDomain $ _hostName h)
 			(map Address $ getAddresses attr)
 
 	-- Any host, whether its hostname is in the zdomain or not,
@@ -370,10 +371,11 @@ genZone hosts zdomain soa =
 	--
 	-- We typically know the host's IPAddrs anyway.
 	-- So we can just use the IPAddrs.
-	addcnames :: Attr -> [Either WarningMessage (BindDomain, Record)]
+	addcnames :: Host -> [Either WarningMessage (BindDomain, Record)]
-	addcnames attr = concatMap gen $ filter (inDomain zdomain) $
+	addcnames h = concatMap gen $ filter (inDomain zdomain) $
 		mapMaybe getCNAME $ S.toList (_dns attr)
 	  where
+		attr = hostAttr h
 		gen c = case getAddresses attr of
 			[] -> [ret (CNAME c)]
 			l -> map (ret . Address) l
@@ -381,10 +383,11 @@ genZone hosts zdomain soa =
 		  	ret record = Right (c, record)
 	
 	-- Adds any other DNS records for a host located in the zdomain.
-	hostrecords :: Attr -> [Either WarningMessage (BindDomain, Record)]
+	hostrecords :: Host -> [Either WarningMessage (BindDomain, Record)]
-	hostrecords attr = map Right l
+	hostrecords h = map Right l
 	  where
-		l = zip (repeat $ AbsDomain $ _hostname attr)
+		attr = hostAttr h
+		l = zip (repeat $ AbsDomain $ _hostName h)
 			(S.toList $ S.filter (\r -> isNothing (getIPAddr r) && isNothing (getCNAME r)) (_dns attr))
 
 inDomain :: Domain -> BindDomain -> Bool

src/Propellor/Property/Docker.hs

@@ -48,7 +48,7 @@ type ContainerName = String
 container :: ContainerName -> Image -> Host
 container cn image = Host hn [] (\_ -> attr)
   where
-	attr = (newAttr hn) { _dockerImage = Just image }
+	attr = newAttr { _dockerImage = Just image }
 	hn = cn2hn cn
 
 cn2hn :: ContainerName -> HostName
@@ -99,7 +99,7 @@ exposeDnsAttrs :: Host -> Property -> Property
 exposeDnsAttrs (Host _ _ containerattr) p = combineProperties (propertyDesc p) $
 	p : map addDNS (S.toList containerdns)
   where
-	containerdns = _dns $ containerattr $ newAttr undefined
+	containerdns = _dns $ containerattr newAttr
 
 findContainer
 	:: Maybe Host

src/Propellor/Types.hs

@@ -42,14 +42,14 @@ data Host = Host
 	, _hostAttrs :: SetAttr
 	}
 
--- | Propellor's monad provides read-only access to attributes of the
+-- | Propellor's monad provides read-only access to the host it's running
--- system.
+-- on, including its attributes.
-newtype Propellor p = Propellor { runWithAttr :: ReaderT Attr IO p }
+newtype Propellor p = Propellor { runWithHost :: ReaderT Host IO p }
 	deriving
 		( Monad
 		, Functor
 		, Applicative
-		, MonadReader Attr 
+		, MonadReader Host
 		, MonadIO
 		, MonadCatchIO
 		)

src/Propellor/Types/Attr.hs

@@ -6,10 +6,9 @@ import qualified Propellor.Types.Dns as Dns
 import qualified Data.Set as S
 import qualified Data.Map as M
 
--- | The attributes of a host. For example, its hostname.
+-- | The attributes of a host.
 data Attr = Attr
-	{ _hostname :: HostName
+	{ _os :: Maybe System
-	, _os :: Maybe System
 	, _sshPubKey :: Maybe String
 	, _dns :: S.Set Dns.Record
 	, _namedconf :: M.Map Dns.Domain Dns.NamedConf
@@ -20,8 +19,7 @@ data Attr = Attr
 
 instance Eq Attr where
 	x == y = and
-		[ _hostname x == _hostname y
+		[ _os x == _os y
-		, _os x == _os y
 		, _dns x == _dns y
 		, _namedconf x == _namedconf y
 		, _sshPubKey x == _sshPubKey y
@@ -33,8 +31,7 @@ instance Eq Attr where
 
 instance Show Attr where
 	show a = unlines
-		[ "hostname " ++ _hostname a
+		[ "OS " ++ show (_os a)
-		, "OS " ++ show (_os a)
 		, "sshPubKey " ++ show (_sshPubKey a)
 		, "dns " ++ show (_dns a)
 		, "namedconf " ++ show (_namedconf a)
@@ -42,7 +39,7 @@ instance Show Attr where
 		, "docker run params " ++ show (map (\mk -> mk "") (_dockerRunParams a))
 		]
 
-newAttr :: HostName -> Attr
+newAttr :: Attr
-newAttr hn = Attr hn Nothing Nothing S.empty M.empty Nothing []
+newAttr = Attr Nothing Nothing S.empty M.empty Nothing []
 
 type SetAttr = Attr -> Attr