Merge branch 'joeyconfig'

Conflicts:
	doc/todo/info_propigation_out_of_nested_properties.mdwn
	privdata.joey/privdata.gpg

1 files changed, 60 insertions, 31 deletions

diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs
index 6643d81d..71aa820d 100644
--- a/src/Propellor/PrivData.hs
+++ b/src/Propellor/PrivData.hs
@@ -1,6 +1,19 @@
 {-# LANGUAGE PackageImports #-}
+{-# LANGUAGE FlexibleContexts #-}
 
-module Propellor.PrivData where
+module Propellor.PrivData (
+	withPrivData,
+	withSomePrivData,
+	addPrivData,
+	setPrivData,
+	dumpPrivData,
+	editPrivData,
+	filterPrivData,
+	listPrivDataFields,
+	makePrivDataDir,
+	decryptPrivData,
+	PrivMap,
+) where
 
 import Control.Applicative
 import System.IO
@@ -48,29 +61,29 @@ import Utility.Table
 -- being used, which is necessary to ensure that the privdata is sent to
 -- the remote host by propellor.
 withPrivData
-	:: (IsContext c, IsPrivDataSource s)
+	:: (IsContext c, IsPrivDataSource s, IsProp (Property i))
 	=> s
 	-> c
-	-> (((PrivData -> Propellor Result) -> Propellor Result) -> Property)
-	-> Property
+	-> (((PrivData -> Propellor Result) -> Propellor Result) -> Property i)
+	-> Property HasInfo
 withPrivData s = withPrivData' snd [s]
 
 -- Like withPrivData, but here any one of a list of PrivDataFields can be used.
 withSomePrivData
-	:: (IsContext c, IsPrivDataSource s)
+	:: (IsContext c, IsPrivDataSource s, IsProp (Property i))
 	=> [s]
 	-> c
-	-> ((((PrivDataField, PrivData) -> Propellor Result) -> Propellor Result) -> Property)
-	-> Property
+	-> ((((PrivDataField, PrivData) -> Propellor Result) -> Propellor Result) -> Property i)
+	-> Property HasInfo
 withSomePrivData = withPrivData' id
 
 withPrivData' 
-	:: (IsContext c, IsPrivDataSource s)
+	:: (IsContext c, IsPrivDataSource s, IsProp (Property i))
 	=> ((PrivDataField, PrivData) -> v)
 	-> [s]
 	-> c
-	-> (((v -> Propellor Result) -> Propellor Result) -> Property)
-	-> Property
+	-> (((v -> Propellor Result) -> Propellor Result) -> Property i)
+	-> Property HasInfo
 withPrivData' feed srclist c mkprop = addinfo $ mkprop $ \a ->
 	maybe missing (a . feed) =<< getM get fieldlist
   where
@@ -82,20 +95,28 @@ withPrivData' feed srclist c mkprop = addinfo $ mkprop $ \a ->
 		Context cname <- mkHostContext hc <$> asks hostName
 		warningMessage $ "Missing privdata " ++ intercalate " or " fieldnames ++ " (for " ++ cname ++ ")"
 		liftIO $ putStrLn $ "Fix this by running:"
-		liftIO $ forM_ srclist $ \src -> do
-			putStrLn $ "  propellor --set '" ++ show (privDataField src) ++ "' '" ++ cname ++ "' \\"
-			maybe noop (\d -> putStrLn $ "    " ++ d) (describePrivDataSource src)
-			putStrLn ""
+		liftIO $ showSet $
+			map (\s -> (privDataField s, Context cname, describePrivDataSource s)) srclist
 		return FailedChange
-	addinfo p = p { propertyInfo = propertyInfo p <> mempty { _privDataFields = fieldset } }
+	addinfo p = infoProperty
+		(propertyDesc p)
+		(propertySatisfy p)
+		(propertyInfo p <> mempty { _privData = privset })
+		(propertyChildren p)
+	privset = S.fromList $ map (\s -> (privDataField s, describePrivDataSource s, hc)) srclist
 	fieldnames = map show fieldlist
-	fieldset = S.fromList $ zip fieldlist (repeat hc)
 	fieldlist = map privDataField srclist
 	hc = asHostContext c
 
-addPrivDataField :: (PrivDataField, HostContext) -> Property
-addPrivDataField v = pureInfoProperty (show v) $
-	mempty { _privDataFields = S.singleton v }
+showSet :: [(PrivDataField, Context, Maybe PrivDataSourceDesc)] -> IO ()
+showSet l = forM_ l $ \(f, Context c, md) -> do
+	putStrLn $ "  propellor --set '" ++ show f ++ "' '" ++ c ++ "' \\"
+	maybe noop (\d -> putStrLn $ "    " ++ d) md
+	putStrLn ""
+
+addPrivData :: (PrivDataField, Maybe PrivDataSourceDesc, HostContext) -> Property HasInfo
+addPrivData v = pureInfoProperty (show v) $
+	mempty { _privData = S.singleton v }
 
 {- Gets the requested field's value, in the specified context if it's
  - available, from the host's local privdata cache. -}
@@ -107,12 +128,12 @@ getLocalPrivData field context =
 
 type PrivMap = M.Map (PrivDataField, Context) PrivData
 
-{- Get only the set of PrivData that the Host's Info says it uses. -}
+-- | Get only the set of PrivData that the Host's Info says it uses.
 filterPrivData :: Host -> PrivMap -> PrivMap
 filterPrivData host = M.filterWithKey (\k _v -> S.member k used)
   where
-	used = S.map (\(f, c) -> (f, mkHostContext c (hostName host))) $
-		_privDataFields $ hostInfo host
+	used = S.map (\(f, _, c) -> (f, mkHostContext c (hostName host))) $
+		_privData $ hostInfo host
 
 getPrivData :: PrivDataField -> Context -> PrivMap -> Maybe PrivData
 getPrivData field context = M.lookup (field, context)
@@ -142,10 +163,17 @@ editPrivData field context = do
 listPrivDataFields :: [Host] -> IO ()
 listPrivDataFields hosts = do
 	m <- decryptPrivData
-	showtable "Currently set data:" $
-		map mkrow (M.keys m)
-	showtable "Data that would be used if set:" $
-		map mkrow (M.keys $ M.difference wantedmap m)
+	
+	section "Currently set data:"
+	showtable $ map mkrow (M.keys m)
+	let missing = M.keys $ M.difference wantedmap m
+	
+	unless (null missing) $ do
+		section "Missing data that would be used if set:"
+		showtable $ map mkrow missing
+
+		section "How to set missing data:"
+		showSet $ map (\(f, c) -> (f, c, join $ M.lookup (f, c) descmap)) missing
   where
 	header = ["Field", "Context", "Used by"]
 	mkrow k@(field, (Context context)) =
@@ -153,12 +181,13 @@ listPrivDataFields hosts = do
 		, shellEscape context
 		, intercalate ", " $ sort $ fromMaybe [] $ M.lookup k usedby
 		]
-	mkhostmap host = M.fromList $ map (\(f, c) -> ((f, mkHostContext c (hostName host)), [hostName host])) $
-		S.toList $ _privDataFields $ hostInfo host
-	usedby = M.unionsWith (++) $ map mkhostmap hosts
+	mkhostmap host mkv = M.fromList $ map (\(f, d, c) -> ((f, mkHostContext c (hostName host)), mkv d)) $
+		S.toList $ _privData $ hostInfo host
+	usedby = M.unionsWith (++) $ map (\h -> mkhostmap h $ const $ [hostName h]) hosts
 	wantedmap = M.fromList $ zip (M.keys usedby) (repeat "")
-	showtable desc rows = do
-		putStrLn $ "\n" ++ desc
+	descmap = M.unions $ map (\h -> mkhostmap h id) hosts
+	section desc = putStrLn $ "\n" ++ desc
+	showtable rows = do
 		putStr $ unlines $ formatTable $ tableWithHeader header rows
 
 setPrivDataTo :: PrivDataField -> Context -> PrivData -> IO ()