{-# LANGUAGE PackageImports #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}

module Propellor.PrivData (
	withPrivData,
	withSomePrivData,
	addPrivData,
	setPrivData,
	unsetPrivData,
	unsetPrivDataUnused,
	dumpPrivData,
	editPrivData,
	filterPrivData,
	listPrivDataFields,
	makePrivDataDir,
	decryptPrivData,
	readPrivData,
	readPrivDataFile,
	PrivMap,
	PrivInfo,
	forceHostContext,
) where

import System.IO
import Data.Maybe
import Data.List
import Data.Typeable
import Control.Monad
import Control.Monad.IfElse
import "mtl" Control.Monad.Reader
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Lazy as L
import Control.Applicative
import Data.Monoid
import Data.Semigroup as Sem
import Prelude

import Propellor.Types
import Propellor.Types.PrivData
import Propellor.Types.MetaTypes
import Propellor.Types.Info
import Propellor.Message
import Propellor.Info
import Propellor.Gpg
import Propellor.PrivData.Paths
import Utility.Monad
import Utility.PartialPrelude
import Utility.Exception
import Utility.Tmp
import Utility.SafeCommand
import Utility.Process.NonConcurrent
import Utility.Misc
import Utility.FileMode
import Utility.Env
import Utility.Table
import Utility.Directory

-- | Allows a Property to access the value of a specific PrivDataField,
-- for use in a specific Context or HostContext.
--
-- Example use:
--
-- > withPrivData (PrivFile pemfile) (Context "joeyh.name") $ \getdata ->
-- >     property "joeyh.name ssl cert" $ getdata $ \privdata ->
-- >       liftIO $ writeFile pemfile (privDataVal privdata)
-- >   where pemfile = "/etc/ssl/certs/web.pem"
-- 
-- Note that if the value is not available, the action is not run
-- and instead it prints a message to help the user make the necessary
-- private data available.
--
-- The resulting Property includes Info about the PrivDataField
-- being used, which is necessary to ensure that the privdata is sent to
-- the remote host by propellor.
withPrivData
	::
		( IsContext c
		, IsPrivDataSource s
		, IncludesInfo metatypes ~ 'True
		)
	=> s
	-> c
	-> (((PrivData -> Propellor Result) -> Propellor Result) -> Property metatypes)
	-> Property metatypes
withPrivData :: s
-> c
-> (((PrivData -> Propellor Result) -> Propellor Result)
    -> Property metatypes)
-> Property metatypes
withPrivData s
s = ((PrivDataField, PrivData) -> PrivData)
-> [s]
-> c
-> (((PrivData -> Propellor Result) -> Propellor Result)
    -> Property metatypes)
-> Property metatypes
forall c s metatypes v.
(IsContext c, IsPrivDataSource s,
 IncludesInfo metatypes ~ 'True) =>
((PrivDataField, PrivData) -> v)
-> [s]
-> c
-> (((v -> Propellor Result) -> Propellor Result)
    -> Property metatypes)
-> Property metatypes
withPrivData' (PrivDataField, PrivData) -> PrivData
forall a b. (a, b) -> b
snd [s
s]

-- Like withPrivData, but here any one of a list of PrivDataFields can be used.
withSomePrivData
	::
		( IsContext c
		, IsPrivDataSource s
		, IncludesInfo metatypes ~ 'True
		)
	=> [s]
	-> c
	-> ((((PrivDataField, PrivData) -> Propellor Result) -> Propellor Result) -> Property metatypes)
	-> Property metatypes
withSomePrivData :: [s]
-> c
-> ((((PrivDataField, PrivData) -> Propellor Result)
     -> Propellor Result)
    -> Property metatypes)
-> Property metatypes
withSomePrivData = ((PrivDataField, PrivData) -> (PrivDataField, PrivData))
-> [s]
-> c
-> ((((PrivDataField, PrivData) -> Propellor Result)
     -> Propellor Result)
    -> Property metatypes)
-> Property metatypes
forall c s metatypes v.
(IsContext c, IsPrivDataSource s,
 IncludesInfo metatypes ~ 'True) =>
((PrivDataField, PrivData) -> v)
-> [s]
-> c
-> (((v -> Propellor Result) -> Propellor Result)
    -> Property metatypes)
-> Property metatypes
withPrivData' (PrivDataField, PrivData) -> (PrivDataField, PrivData)
forall a. a -> a
id

withPrivData' 
	::
		( IsContext c
		, IsPrivDataSource s
		, IncludesInfo metatypes ~ 'True
		)
	=> ((PrivDataField, PrivData) -> v)
	-> [s]
	-> c
	-> (((v -> Propellor Result) -> Propellor Result) -> Property metatypes)
	-> Property metatypes
withPrivData' :: ((PrivDataField, PrivData) -> v)
-> [s]
-> c
-> (((v -> Propellor Result) -> Propellor Result)
    -> Property metatypes)
-> Property metatypes
withPrivData' (PrivDataField, PrivData) -> v
feed [s]
srclist c
c ((v -> Propellor Result) -> Propellor Result) -> Property metatypes
mkprop = Property metatypes -> Property metatypes
addinfo (Property metatypes -> Property metatypes)
-> Property metatypes -> Property metatypes
forall a b. (a -> b) -> a -> b
$ ((v -> Propellor Result) -> Propellor Result) -> Property metatypes
mkprop (((v -> Propellor Result) -> Propellor Result)
 -> Property metatypes)
-> ((v -> Propellor Result) -> Propellor Result)
-> Property metatypes
forall a b. (a -> b) -> a -> b
$ \v -> Propellor Result
a ->
	Propellor Result
-> ((PrivDataField, PrivData) -> Propellor Result)
-> Maybe (PrivDataField, PrivData)
-> Propellor Result
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Propellor Result
missing (v -> Propellor Result
a (v -> Propellor Result)
-> ((PrivDataField, PrivData) -> v)
-> (PrivDataField, PrivData)
-> Propellor Result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PrivDataField, PrivData) -> v
feed) (Maybe (PrivDataField, PrivData) -> Propellor Result)
-> Propellor (Maybe (PrivDataField, PrivData)) -> Propellor Result
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (PrivDataField -> Propellor (Maybe (PrivDataField, PrivData)))
-> [PrivDataField] -> Propellor (Maybe (PrivDataField, PrivData))
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m (Maybe b)
getM PrivDataField -> Propellor (Maybe (PrivDataField, PrivData))
get [PrivDataField]
fieldlist
  where
  	get :: PrivDataField -> Propellor (Maybe (PrivDataField, PrivData))
get PrivDataField
field = do
		Context
context <- HostContext -> HostName -> Context
mkHostContext HostContext
hc (HostName -> Context) -> Propellor HostName -> Propellor Context
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Host -> HostName) -> Propellor HostName
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Host -> HostName
hostName
		Maybe (PrivDataField, PrivData)
-> (PrivData -> Maybe (PrivDataField, PrivData))
-> Maybe PrivData
-> Maybe (PrivDataField, PrivData)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe (PrivDataField, PrivData)
forall a. Maybe a
Nothing (\PrivData
privdata -> (PrivDataField, PrivData) -> Maybe (PrivDataField, PrivData)
forall a. a -> Maybe a
Just (PrivDataField
field, PrivData
privdata))
			(Maybe PrivData -> Maybe (PrivDataField, PrivData))
-> Propellor (Maybe PrivData)
-> Propellor (Maybe (PrivDataField, PrivData))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe PrivData) -> Propellor (Maybe PrivData)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (PrivDataField -> Context -> IO (Maybe PrivData)
getLocalPrivData PrivDataField
field Context
context)
	missing :: Propellor Result
missing = do
		Context HostName
cname <- HostContext -> HostName -> Context
mkHostContext HostContext
hc (HostName -> Context) -> Propellor HostName -> Propellor Context
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Host -> HostName) -> Propellor HostName
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Host -> HostName
hostName
		HostName -> Propellor ()
forall (m :: * -> *). MonadIO m => HostName -> m ()
warningMessage (HostName -> Propellor ()) -> HostName -> Propellor ()
forall a b. (a -> b) -> a -> b
$ HostName
"Missing privdata " HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ HostName -> [HostName] -> HostName
forall a. [a] -> [[a]] -> [a]
intercalate HostName
" or " [HostName]
fieldnames HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ HostName
" (for " HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ HostName
cname HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ HostName
")"
		[HostName] -> Propellor ()
forall (m :: * -> *). MonadIO m => [HostName] -> m ()
infoMessage ([HostName] -> Propellor ()) -> [HostName] -> Propellor ()
forall a b. (a -> b) -> a -> b
$ 
			HostName
"Fix this by running:" HostName -> [HostName] -> [HostName]
forall a. a -> [a] -> [a]
:
			[(PrivDataField, Context, Maybe HostName)] -> [HostName]
showSet ((s -> (PrivDataField, Context, Maybe HostName))
-> [s] -> [(PrivDataField, Context, Maybe HostName)]
forall a b. (a -> b) -> [a] -> [b]
map (\s
s -> (s -> PrivDataField
forall s. IsPrivDataSource s => s -> PrivDataField
privDataField s
s, HostName -> Context
Context HostName
cname, s -> Maybe HostName
forall s. IsPrivDataSource s => s -> Maybe HostName
describePrivDataSource s
s)) [s]
srclist)
		Result -> Propellor Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
FailedChange
	addinfo :: Property metatypes -> Property metatypes
addinfo Property metatypes
p = Property metatypes
p Property metatypes -> Info -> Property metatypes
forall metatypes.
(IncludesInfo metatypes ~ 'True) =>
Property metatypes -> Info -> Property metatypes
`addInfoProperty` (PrivInfo -> Info
forall v. IsInfo v => v -> Info
toInfo PrivInfo
privset)
	privset :: PrivInfo
privset = Set (PrivDataField, Maybe HostName, HostContext) -> PrivInfo
PrivInfo (Set (PrivDataField, Maybe HostName, HostContext) -> PrivInfo)
-> Set (PrivDataField, Maybe HostName, HostContext) -> PrivInfo
forall a b. (a -> b) -> a -> b
$ [(PrivDataField, Maybe HostName, HostContext)]
-> Set (PrivDataField, Maybe HostName, HostContext)
forall a. Ord a => [a] -> Set a
S.fromList ([(PrivDataField, Maybe HostName, HostContext)]
 -> Set (PrivDataField, Maybe HostName, HostContext))
-> [(PrivDataField, Maybe HostName, HostContext)]
-> Set (PrivDataField, Maybe HostName, HostContext)
forall a b. (a -> b) -> a -> b
$
		(s -> (PrivDataField, Maybe HostName, HostContext))
-> [s] -> [(PrivDataField, Maybe HostName, HostContext)]
forall a b. (a -> b) -> [a] -> [b]
map (\s
s -> (s -> PrivDataField
forall s. IsPrivDataSource s => s -> PrivDataField
privDataField s
s, s -> Maybe HostName
forall s. IsPrivDataSource s => s -> Maybe HostName
describePrivDataSource s
s, HostContext
hc)) [s]
srclist
	fieldnames :: [HostName]
fieldnames = (PrivDataField -> HostName) -> [PrivDataField] -> [HostName]
forall a b. (a -> b) -> [a] -> [b]
map PrivDataField -> HostName
forall a. Show a => a -> HostName
show [PrivDataField]
fieldlist
	fieldlist :: [PrivDataField]
fieldlist = (s -> PrivDataField) -> [s] -> [PrivDataField]
forall a b. (a -> b) -> [a] -> [b]
map s -> PrivDataField
forall s. IsPrivDataSource s => s -> PrivDataField
privDataField [s]
srclist
	hc :: HostContext
hc = c -> HostContext
forall c. IsContext c => c -> HostContext
asHostContext c
c

showSet :: [(PrivDataField, Context, Maybe PrivDataSourceDesc)] -> [String]
showSet :: [(PrivDataField, Context, Maybe HostName)] -> [HostName]
showSet = ((PrivDataField, Context, Maybe HostName) -> [HostName])
-> [(PrivDataField, Context, Maybe HostName)] -> [HostName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (PrivDataField, Context, Maybe HostName) -> [HostName]
forall a. Show a => (a, Context, Maybe HostName) -> [HostName]
go
  where
	go :: (a, Context, Maybe HostName) -> [HostName]
go (a
f, Context HostName
c, Maybe HostName
md) = [Maybe HostName] -> [HostName]
forall a. [Maybe a] -> [a]
catMaybes
		[ HostName -> Maybe HostName
forall a. a -> Maybe a
Just (HostName -> Maybe HostName) -> HostName -> Maybe HostName
forall a b. (a -> b) -> a -> b
$ HostName
"  propellor --set '" HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ a -> HostName
forall a. Show a => a -> HostName
show a
f HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ HostName
"' '" HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ HostName
c HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ HostName
"' \\"
		, Maybe HostName
-> (HostName -> Maybe HostName) -> Maybe HostName -> Maybe HostName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe HostName
forall a. Maybe a
Nothing (\HostName
d -> HostName -> Maybe HostName
forall a. a -> Maybe a
Just (HostName -> Maybe HostName) -> HostName -> Maybe HostName
forall a b. (a -> b) -> a -> b
$ HostName
"    " HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ HostName
d) Maybe HostName
md
		, HostName -> Maybe HostName
forall a. a -> Maybe a
Just HostName
""
		]

addPrivData :: (PrivDataField, Maybe PrivDataSourceDesc, HostContext) -> Property (HasInfo + UnixLike)
addPrivData :: (PrivDataField, Maybe HostName, HostContext)
-> Property (HasInfo + UnixLike)
addPrivData (PrivDataField, Maybe HostName, HostContext)
v = HostName -> PrivInfo -> Property (HasInfo + UnixLike)
forall v.
IsInfo v =>
HostName -> v -> Property (HasInfo + UnixLike)
pureInfoProperty ((PrivDataField, Maybe HostName, HostContext) -> HostName
forall a. Show a => a -> HostName
show (PrivDataField, Maybe HostName, HostContext)
v) (Set (PrivDataField, Maybe HostName, HostContext) -> PrivInfo
PrivInfo ((PrivDataField, Maybe HostName, HostContext)
-> Set (PrivDataField, Maybe HostName, HostContext)
forall a. a -> Set a
S.singleton (PrivDataField, Maybe HostName, HostContext)
v))

{- Gets the requested field's value, in the specified context if it's
 - available, from the host's local privdata cache. -}
getLocalPrivData :: PrivDataField -> Context -> IO (Maybe PrivData)
getLocalPrivData :: PrivDataField -> Context -> IO (Maybe PrivData)
getLocalPrivData PrivDataField
field Context
context =
	PrivDataField -> Context -> PrivMap -> Maybe PrivData
getPrivData PrivDataField
field Context
context (PrivMap -> Maybe PrivData)
-> (Maybe PrivMap -> PrivMap) -> Maybe PrivMap -> Maybe PrivData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrivMap -> Maybe PrivMap -> PrivMap
forall a. a -> Maybe a -> a
fromMaybe PrivMap
forall k a. Map k a
M.empty (Maybe PrivMap -> Maybe PrivData)
-> IO (Maybe PrivMap) -> IO (Maybe PrivData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe PrivMap)
localcache
  where
	localcache :: IO (Maybe PrivMap)
localcache = Maybe PrivMap -> IO (Maybe PrivMap) -> IO (Maybe PrivMap)
forall (m :: * -> *) a. MonadCatch m => a -> m a -> m a
catchDefaultIO Maybe PrivMap
forall a. Maybe a
Nothing (IO (Maybe PrivMap) -> IO (Maybe PrivMap))
-> IO (Maybe PrivMap) -> IO (Maybe PrivMap)
forall a b. (a -> b) -> a -> b
$ HostName -> Maybe PrivMap
forall a. Read a => HostName -> Maybe a
readish (HostName -> Maybe PrivMap) -> IO HostName -> IO (Maybe PrivMap)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HostName -> IO HostName
readFile HostName
privDataLocal

type PrivMap = M.Map (PrivDataField, Context) String

-- | Get only the set of PrivData that the Host's Info says it uses.
filterPrivData :: Host -> PrivMap -> PrivMap
filterPrivData :: Host -> PrivMap -> PrivMap
filterPrivData Host
host = ((PrivDataField, Context) -> HostName -> Bool)
-> PrivMap -> PrivMap
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey (\(PrivDataField, Context)
k HostName
_v -> (PrivDataField, Context) -> Set (PrivDataField, Context) -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member (PrivDataField, Context)
k Set (PrivDataField, Context)
used)
  where
	used :: Set (PrivDataField, Context)
used = ((PrivDataField, Maybe HostName, HostContext)
 -> (PrivDataField, Context))
-> Set (PrivDataField, Maybe HostName, HostContext)
-> Set (PrivDataField, Context)
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (\(PrivDataField
f, Maybe HostName
_, HostContext
c) -> (PrivDataField
f, HostContext -> HostName -> Context
mkHostContext HostContext
c (Host -> HostName
hostName Host
host))) (Set (PrivDataField, Maybe HostName, HostContext)
 -> Set (PrivDataField, Context))
-> Set (PrivDataField, Maybe HostName, HostContext)
-> Set (PrivDataField, Context)
forall a b. (a -> b) -> a -> b
$
		PrivInfo -> Set (PrivDataField, Maybe HostName, HostContext)
fromPrivInfo (PrivInfo -> Set (PrivDataField, Maybe HostName, HostContext))
-> PrivInfo -> Set (PrivDataField, Maybe HostName, HostContext)
forall a b. (a -> b) -> a -> b
$ Info -> PrivInfo
forall v. IsInfo v => Info -> v
fromInfo (Info -> PrivInfo) -> Info -> PrivInfo
forall a b. (a -> b) -> a -> b
$ Host -> Info
hostInfo Host
host

getPrivData :: PrivDataField -> Context -> PrivMap -> Maybe PrivData
getPrivData :: PrivDataField -> Context -> PrivMap -> Maybe PrivData
getPrivData PrivDataField
field Context
context PrivMap
m = do
	HostName
s <- (PrivDataField, Context) -> PrivMap -> Maybe HostName
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (PrivDataField
field, Context
context) PrivMap
m
	PrivData -> Maybe PrivData
forall (m :: * -> *) a. Monad m => a -> m a
return (HostName -> PrivData
PrivData HostName
s)

setPrivData :: PrivDataField -> Context -> IO ()
setPrivData :: PrivDataField -> Context -> IO ()
setPrivData PrivDataField
field Context
context = do
	HostName -> IO ()
putStrLn HostName
"Enter private data on stdin; ctrl-D when done:"
	PrivDataField -> Context -> PrivData -> IO ()
setPrivDataTo PrivDataField
field Context
context (PrivData -> IO ()) -> (HostName -> PrivData) -> HostName -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HostName -> PrivData
PrivData (HostName -> IO ()) -> IO HostName -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Handle -> IO HostName
hGetContentsStrict Handle
stdin

unsetPrivData :: PrivDataField -> Context -> IO ()
unsetPrivData :: PrivDataField -> Context -> IO ()
unsetPrivData PrivDataField
field Context
context = do
	(PrivMap -> PrivMap) -> IO ()
modifyPrivData ((PrivMap -> PrivMap) -> IO ()) -> (PrivMap -> PrivMap) -> IO ()
forall a b. (a -> b) -> a -> b
$ (PrivDataField, Context) -> PrivMap -> PrivMap
forall k a. Ord k => k -> Map k a -> Map k a
M.delete (PrivDataField
field, Context
context)
	PrivDataField -> Context -> IO ()
descUnset PrivDataField
field Context
context

descUnset :: PrivDataField -> Context -> IO ()
descUnset :: PrivDataField -> Context -> IO ()
descUnset PrivDataField
field Context
context =
	HostName -> IO ()
putStrLn (HostName -> IO ()) -> HostName -> IO ()
forall a b. (a -> b) -> a -> b
$ HostName
"Private data unset: " HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ PrivDataField -> HostName
forall a. Show a => a -> HostName
show PrivDataField
field HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ HostName
" " HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ Context -> HostName
forall a. Show a => a -> HostName
show Context
context

unsetPrivDataUnused :: [Host] -> IO ()
unsetPrivDataUnused :: [Host] -> IO ()
unsetPrivDataUnused [Host]
hosts = do
	[(PrivDataField, Context)]
deleted <- (PrivMap -> (PrivMap, [(PrivDataField, Context)]))
-> IO [(PrivDataField, Context)]
forall a. (PrivMap -> (PrivMap, a)) -> IO a
modifyPrivData' ((PrivMap -> (PrivMap, [(PrivDataField, Context)]))
 -> IO [(PrivDataField, Context)])
-> (PrivMap -> (PrivMap, [(PrivDataField, Context)]))
-> IO [(PrivDataField, Context)]
forall a b. (a -> b) -> a -> b
$ \PrivMap
m ->
		let (PrivMap
keep, PrivMap
del) = ((PrivDataField, Context) -> HostName -> Bool)
-> PrivMap -> (PrivMap, PrivMap)
forall k a. (k -> a -> Bool) -> Map k a -> (Map k a, Map k a)
M.partitionWithKey (\(PrivDataField, Context)
k HostName
_ -> (PrivDataField, Context)
k (PrivDataField, Context)
-> Map (PrivDataField, Context) [HostName] -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.member` Map (PrivDataField, Context) [HostName]
usedby) PrivMap
m
		in (PrivMap
keep, PrivMap -> [(PrivDataField, Context)]
forall k a. Map k a -> [k]
M.keys PrivMap
del)
	((PrivDataField, Context) -> IO ())
-> [(PrivDataField, Context)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((PrivDataField -> Context -> IO ())
-> (PrivDataField, Context) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry PrivDataField -> Context -> IO ()
descUnset) [(PrivDataField, Context)]
deleted
  where
	usedby :: Map (PrivDataField, Context) [HostName]
usedby = [Host] -> Map (PrivDataField, Context) [HostName]
mkUsedByMap [Host]
hosts

dumpPrivData :: PrivDataField -> Context -> IO ()
dumpPrivData :: PrivDataField -> Context -> IO ()
dumpPrivData PrivDataField
field Context
context = do
	IO () -> (PrivData -> IO ()) -> Maybe PrivData -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (HostName -> IO ()
forall a. HasCallStack => HostName -> a
error HostName
"Requested privdata is not set.")
		(Handle -> ByteString -> IO ()
L.hPut Handle
stdout (ByteString -> IO ())
-> (PrivData -> ByteString) -> PrivData -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrivData -> ByteString
privDataByteString)
		(Maybe PrivData -> IO ()) -> IO (Maybe PrivData) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (PrivDataField -> Context -> PrivMap -> Maybe PrivData
getPrivData PrivDataField
field Context
context (PrivMap -> Maybe PrivData) -> IO PrivMap -> IO (Maybe PrivData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO PrivMap
decryptPrivData)

editPrivData :: PrivDataField -> Context -> IO ()
editPrivData :: PrivDataField -> Context -> IO ()
editPrivData PrivDataField
field Context
context = do
	Maybe PrivData
v <- PrivDataField -> Context -> PrivMap -> Maybe PrivData
getPrivData PrivDataField
field Context
context (PrivMap -> Maybe PrivData) -> IO PrivMap -> IO (Maybe PrivData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO PrivMap
decryptPrivData
	PrivData
v' <- HostName -> (HostName -> Handle -> IO PrivData) -> IO PrivData
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
HostName -> (HostName -> Handle -> m a) -> m a
withTmpFile HostName
"propellorXXXX" ((HostName -> Handle -> IO PrivData) -> IO PrivData)
-> (HostName -> Handle -> IO PrivData) -> IO PrivData
forall a b. (a -> b) -> a -> b
$ \HostName
f Handle
th -> do
		Handle -> IO ()
hClose Handle
th
		IO () -> (PrivData -> IO ()) -> Maybe PrivData -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO ()
forall (m :: * -> *). Monad m => m ()
noop (\PrivData
p -> HostName -> (Handle -> IO ()) -> IO ()
writeFileProtected' HostName
f (Handle -> ByteString -> IO ()
`L.hPut` PrivData -> ByteString
privDataByteString PrivData
p)) Maybe PrivData
v
		HostName
editor <- HostName -> HostName -> IO HostName
getEnvDefault HostName
"EDITOR" HostName
"vi"
		IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (HostName -> [CommandParam] -> IO Bool
boolSystemNonConcurrent HostName
editor [HostName -> CommandParam
File HostName
f]) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
			HostName -> IO ()
forall a. HasCallStack => HostName -> a
error HostName
"Editor failed; aborting."
		HostName -> PrivData
PrivData (HostName -> PrivData) -> IO HostName -> IO PrivData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HostName -> IO HostName
readFile HostName
f
	PrivDataField -> Context -> PrivData -> IO ()
setPrivDataTo PrivDataField
field Context
context PrivData
v'

listPrivDataFields :: [Host] -> IO ()
listPrivDataFields :: [Host] -> IO ()
listPrivDataFields [Host]
hosts = do
	PrivMap
m <- IO PrivMap
decryptPrivData
	
	HostName -> IO ()
section HostName
"Currently set data:"
	[[HostName]] -> IO ()
showtable ([[HostName]] -> IO ()) -> [[HostName]] -> IO ()
forall a b. (a -> b) -> a -> b
$ ((PrivDataField, Context) -> [HostName])
-> [(PrivDataField, Context)] -> [[HostName]]
forall a b. (a -> b) -> [a] -> [b]
map (PrivDataField, Context) -> [HostName]
mkrow (PrivMap -> [(PrivDataField, Context)]
forall k a. Map k a -> [k]
M.keys PrivMap
m)
	let missing :: [(PrivDataField, Context)]
missing = PrivMap -> [(PrivDataField, Context)]
forall k a. Map k a -> [k]
M.keys (PrivMap -> [(PrivDataField, Context)])
-> PrivMap -> [(PrivDataField, Context)]
forall a b. (a -> b) -> a -> b
$ PrivMap -> PrivMap -> PrivMap
forall k a b. Ord k => Map k a -> Map k b -> Map k a
M.difference PrivMap
wantedmap PrivMap
m
	
	Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(PrivDataField, Context)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(PrivDataField, Context)]
missing) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
		HostName -> IO ()
section HostName
"Missing data that would be used if set:"
		[[HostName]] -> IO ()
showtable ([[HostName]] -> IO ()) -> [[HostName]] -> IO ()
forall a b. (a -> b) -> a -> b
$ ((PrivDataField, Context) -> [HostName])
-> [(PrivDataField, Context)] -> [[HostName]]
forall a b. (a -> b) -> [a] -> [b]
map (PrivDataField, Context) -> [HostName]
mkrow [(PrivDataField, Context)]
missing

		HostName -> IO ()
section HostName
"How to set missing data:"
		(HostName -> IO ()) -> [HostName] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ HostName -> IO ()
putStrLn ([HostName] -> IO ()) -> [HostName] -> IO ()
forall a b. (a -> b) -> a -> b
$ [(PrivDataField, Context, Maybe HostName)] -> [HostName]
showSet ([(PrivDataField, Context, Maybe HostName)] -> [HostName])
-> [(PrivDataField, Context, Maybe HostName)] -> [HostName]
forall a b. (a -> b) -> a -> b
$
			((PrivDataField, Context)
 -> (PrivDataField, Context, Maybe HostName))
-> [(PrivDataField, Context)]
-> [(PrivDataField, Context, Maybe HostName)]
forall a b. (a -> b) -> [a] -> [b]
map (\(PrivDataField
f, Context
c) -> (PrivDataField
f, Context
c, Maybe (Maybe HostName) -> Maybe HostName
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe HostName) -> Maybe HostName)
-> Maybe (Maybe HostName) -> Maybe HostName
forall a b. (a -> b) -> a -> b
$ (PrivDataField, Context)
-> Map (PrivDataField, Context) (Maybe HostName)
-> Maybe (Maybe HostName)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (PrivDataField
f, Context
c) Map (PrivDataField, Context) (Maybe HostName)
descmap)) [(PrivDataField, Context)]
missing
  where
	header :: [HostName]
header = [HostName
"Field", HostName
"Context", HostName
"Used by"]
	mkrow :: (PrivDataField, Context) -> [HostName]
mkrow k :: (PrivDataField, Context)
k@(PrivDataField
field, Context HostName
context) =
		[ HostName -> HostName
shellEscape (HostName -> HostName) -> HostName -> HostName
forall a b. (a -> b) -> a -> b
$ PrivDataField -> HostName
forall a. Show a => a -> HostName
show PrivDataField
field
		, HostName -> HostName
shellEscape HostName
context
		, HostName -> [HostName] -> HostName
forall a. [a] -> [[a]] -> [a]
intercalate HostName
", " ([HostName] -> HostName) -> [HostName] -> HostName
forall a b. (a -> b) -> a -> b
$ [HostName] -> [HostName]
forall a. Ord a => [a] -> [a]
sort ([HostName] -> [HostName]) -> [HostName] -> [HostName]
forall a b. (a -> b) -> a -> b
$ [HostName] -> Maybe [HostName] -> [HostName]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [HostName] -> [HostName]) -> Maybe [HostName] -> [HostName]
forall a b. (a -> b) -> a -> b
$ (PrivDataField, Context)
-> Map (PrivDataField, Context) [HostName] -> Maybe [HostName]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (PrivDataField, Context)
k Map (PrivDataField, Context) [HostName]
usedby
		]
	usedby :: Map (PrivDataField, Context) [HostName]
usedby = [Host] -> Map (PrivDataField, Context) [HostName]
mkUsedByMap [Host]
hosts
	wantedmap :: PrivMap
wantedmap = [((PrivDataField, Context), HostName)] -> PrivMap
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([((PrivDataField, Context), HostName)] -> PrivMap)
-> [((PrivDataField, Context), HostName)] -> PrivMap
forall a b. (a -> b) -> a -> b
$ [(PrivDataField, Context)]
-> [HostName] -> [((PrivDataField, Context), HostName)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Map (PrivDataField, Context) [HostName]
-> [(PrivDataField, Context)]
forall k a. Map k a -> [k]
M.keys Map (PrivDataField, Context) [HostName]
usedby) (HostName -> [HostName]
forall a. a -> [a]
repeat HostName
"")
	descmap :: Map (PrivDataField, Context) (Maybe HostName)
descmap = [Map (PrivDataField, Context) (Maybe HostName)]
-> Map (PrivDataField, Context) (Maybe HostName)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions ([Map (PrivDataField, Context) (Maybe HostName)]
 -> Map (PrivDataField, Context) (Maybe HostName))
-> [Map (PrivDataField, Context) (Maybe HostName)]
-> Map (PrivDataField, Context) (Maybe HostName)
forall a b. (a -> b) -> a -> b
$ (Host -> Map (PrivDataField, Context) (Maybe HostName))
-> [Host] -> [Map (PrivDataField, Context) (Maybe HostName)]
forall a b. (a -> b) -> [a] -> [b]
map (Host
-> (Maybe HostName -> Maybe HostName)
-> Map (PrivDataField, Context) (Maybe HostName)
forall a.
Host -> (Maybe HostName -> a) -> Map (PrivDataField, Context) a
`mkPrivDataMap` Maybe HostName -> Maybe HostName
forall a. a -> a
id) [Host]
hosts
	section :: HostName -> IO ()
section HostName
desc = HostName -> IO ()
putStrLn (HostName -> IO ()) -> HostName -> IO ()
forall a b. (a -> b) -> a -> b
$ HostName
"\n" HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ HostName
desc
	showtable :: [[HostName]] -> IO ()
showtable [[HostName]]
rows = do
		HostName -> IO ()
putStr (HostName -> IO ()) -> HostName -> IO ()
forall a b. (a -> b) -> a -> b
$ [HostName] -> HostName
unlines ([HostName] -> HostName) -> [HostName] -> HostName
forall a b. (a -> b) -> a -> b
$ [[HostName]] -> [HostName]
formatTable ([[HostName]] -> [HostName]) -> [[HostName]] -> [HostName]
forall a b. (a -> b) -> a -> b
$ [HostName] -> [[HostName]] -> [[HostName]]
tableWithHeader [HostName]
header [[HostName]]
rows

mkUsedByMap :: [Host] -> M.Map (PrivDataField, Context) [HostName]
mkUsedByMap :: [Host] -> Map (PrivDataField, Context) [HostName]
mkUsedByMap = ([HostName] -> [HostName] -> [HostName])
-> [Map (PrivDataField, Context) [HostName]]
-> Map (PrivDataField, Context) [HostName]
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
M.unionsWith [HostName] -> [HostName] -> [HostName]
forall a. [a] -> [a] -> [a]
(++) ([Map (PrivDataField, Context) [HostName]]
 -> Map (PrivDataField, Context) [HostName])
-> ([Host] -> [Map (PrivDataField, Context) [HostName]])
-> [Host]
-> Map (PrivDataField, Context) [HostName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Host -> Map (PrivDataField, Context) [HostName])
-> [Host] -> [Map (PrivDataField, Context) [HostName]]
forall a b. (a -> b) -> [a] -> [b]
map (\Host
h -> Host
-> (Maybe HostName -> [HostName])
-> Map (PrivDataField, Context) [HostName]
forall a.
Host -> (Maybe HostName -> a) -> Map (PrivDataField, Context) a
mkPrivDataMap Host
h ((Maybe HostName -> [HostName])
 -> Map (PrivDataField, Context) [HostName])
-> (Maybe HostName -> [HostName])
-> Map (PrivDataField, Context) [HostName]
forall a b. (a -> b) -> a -> b
$ [HostName] -> Maybe HostName -> [HostName]
forall a b. a -> b -> a
const [Host -> HostName
hostName Host
h])

mkPrivDataMap :: Host -> (Maybe PrivDataSourceDesc -> a) -> M.Map (PrivDataField, Context) a
mkPrivDataMap :: Host -> (Maybe HostName -> a) -> Map (PrivDataField, Context) a
mkPrivDataMap Host
host Maybe HostName -> a
mkv = [((PrivDataField, Context), a)] -> Map (PrivDataField, Context) a
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([((PrivDataField, Context), a)] -> Map (PrivDataField, Context) a)
-> [((PrivDataField, Context), a)]
-> Map (PrivDataField, Context) a
forall a b. (a -> b) -> a -> b
$
	((PrivDataField, Maybe HostName, HostContext)
 -> ((PrivDataField, Context), a))
-> [(PrivDataField, Maybe HostName, HostContext)]
-> [((PrivDataField, Context), a)]
forall a b. (a -> b) -> [a] -> [b]
map (\(PrivDataField
f, Maybe HostName
d, HostContext
c) -> ((PrivDataField
f, HostContext -> HostName -> Context
mkHostContext HostContext
c (Host -> HostName
hostName Host
host)), Maybe HostName -> a
mkv Maybe HostName
d))
		(Set (PrivDataField, Maybe HostName, HostContext)
-> [(PrivDataField, Maybe HostName, HostContext)]
forall a. Set a -> [a]
S.toList (Set (PrivDataField, Maybe HostName, HostContext)
 -> [(PrivDataField, Maybe HostName, HostContext)])
-> Set (PrivDataField, Maybe HostName, HostContext)
-> [(PrivDataField, Maybe HostName, HostContext)]
forall a b. (a -> b) -> a -> b
$ PrivInfo -> Set (PrivDataField, Maybe HostName, HostContext)
fromPrivInfo (PrivInfo -> Set (PrivDataField, Maybe HostName, HostContext))
-> PrivInfo -> Set (PrivDataField, Maybe HostName, HostContext)
forall a b. (a -> b) -> a -> b
$ Info -> PrivInfo
forall v. IsInfo v => Info -> v
fromInfo (Info -> PrivInfo) -> Info -> PrivInfo
forall a b. (a -> b) -> a -> b
$ Host -> Info
hostInfo Host
host)

setPrivDataTo :: PrivDataField -> Context -> PrivData -> IO ()
setPrivDataTo :: PrivDataField -> Context -> PrivData -> IO ()
setPrivDataTo PrivDataField
field Context
context (PrivData HostName
value) = do
	(PrivMap -> PrivMap) -> IO ()
modifyPrivData PrivMap -> PrivMap
set
	HostName -> IO ()
putStrLn HostName
"Private data set."
  where
	set :: PrivMap -> PrivMap
set = (PrivDataField, Context) -> HostName -> PrivMap -> PrivMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (PrivDataField
field, Context
context) HostName
value

modifyPrivData :: (PrivMap -> PrivMap) -> IO ()
modifyPrivData :: (PrivMap -> PrivMap) -> IO ()
modifyPrivData PrivMap -> PrivMap
f = (PrivMap -> (PrivMap, ())) -> IO ()
forall a. (PrivMap -> (PrivMap, a)) -> IO a
modifyPrivData' (\PrivMap
m -> (PrivMap -> PrivMap
f PrivMap
m, ()))

modifyPrivData' :: (PrivMap -> (PrivMap, a)) -> IO a
modifyPrivData' :: (PrivMap -> (PrivMap, a)) -> IO a
modifyPrivData' PrivMap -> (PrivMap, a)
f = do
	IO ()
makePrivDataDir
	PrivMap
m <- IO PrivMap
decryptPrivData
	let (PrivMap
m', a
r) = PrivMap -> (PrivMap, a)
f PrivMap
m
	HostName
privdata <- IO HostName
privDataFile
	HostName -> HostName -> IO ()
gpgEncrypt HostName
privdata (PrivMap -> HostName
forall a. Show a => a -> HostName
show PrivMap
m')
	IO Bool -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ HostName -> [CommandParam] -> IO Bool
boolSystem HostName
"git" [HostName -> CommandParam
Param HostName
"add", HostName -> CommandParam
File HostName
privdata]
	a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r

decryptPrivData :: IO PrivMap
decryptPrivData :: IO PrivMap
decryptPrivData = HostName -> PrivMap
readPrivData (HostName -> PrivMap) -> IO HostName -> IO PrivMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HostName -> IO HostName
gpgDecrypt (HostName -> IO HostName) -> IO HostName -> IO HostName
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO HostName
privDataFile)

readPrivData :: String -> PrivMap
readPrivData :: HostName -> PrivMap
readPrivData = PrivMap -> Maybe PrivMap -> PrivMap
forall a. a -> Maybe a -> a
fromMaybe PrivMap
forall k a. Map k a
M.empty (Maybe PrivMap -> PrivMap)
-> (HostName -> Maybe PrivMap) -> HostName -> PrivMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HostName -> Maybe PrivMap
forall a. Read a => HostName -> Maybe a
readish

readPrivDataFile :: FilePath -> IO PrivMap
readPrivDataFile :: HostName -> IO PrivMap
readPrivDataFile HostName
f = HostName -> PrivMap
readPrivData (HostName -> PrivMap) -> IO HostName -> IO PrivMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HostName -> IO HostName
readFileStrict HostName
f

makePrivDataDir :: IO ()
makePrivDataDir :: IO ()
makePrivDataDir = Bool -> HostName -> IO ()
createDirectoryIfMissing Bool
False HostName
privDataDir

newtype PrivInfo = PrivInfo
	{ PrivInfo -> Set (PrivDataField, Maybe HostName, HostContext)
fromPrivInfo :: S.Set (PrivDataField, Maybe PrivDataSourceDesc, HostContext) }
	deriving (PrivInfo -> PrivInfo -> Bool
(PrivInfo -> PrivInfo -> Bool)
-> (PrivInfo -> PrivInfo -> Bool) -> Eq PrivInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrivInfo -> PrivInfo -> Bool
$c/= :: PrivInfo -> PrivInfo -> Bool
== :: PrivInfo -> PrivInfo -> Bool
$c== :: PrivInfo -> PrivInfo -> Bool
Eq, Eq PrivInfo
Eq PrivInfo
-> (PrivInfo -> PrivInfo -> Ordering)
-> (PrivInfo -> PrivInfo -> Bool)
-> (PrivInfo -> PrivInfo -> Bool)
-> (PrivInfo -> PrivInfo -> Bool)
-> (PrivInfo -> PrivInfo -> Bool)
-> (PrivInfo -> PrivInfo -> PrivInfo)
-> (PrivInfo -> PrivInfo -> PrivInfo)
-> Ord PrivInfo
PrivInfo -> PrivInfo -> Bool
PrivInfo -> PrivInfo -> Ordering
PrivInfo -> PrivInfo -> PrivInfo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PrivInfo -> PrivInfo -> PrivInfo
$cmin :: PrivInfo -> PrivInfo -> PrivInfo
max :: PrivInfo -> PrivInfo -> PrivInfo
$cmax :: PrivInfo -> PrivInfo -> PrivInfo
>= :: PrivInfo -> PrivInfo -> Bool
$c>= :: PrivInfo -> PrivInfo -> Bool
> :: PrivInfo -> PrivInfo -> Bool
$c> :: PrivInfo -> PrivInfo -> Bool
<= :: PrivInfo -> PrivInfo -> Bool
$c<= :: PrivInfo -> PrivInfo -> Bool
< :: PrivInfo -> PrivInfo -> Bool
$c< :: PrivInfo -> PrivInfo -> Bool
compare :: PrivInfo -> PrivInfo -> Ordering
$ccompare :: PrivInfo -> PrivInfo -> Ordering
$cp1Ord :: Eq PrivInfo
Ord, Int -> PrivInfo -> HostName -> HostName
[PrivInfo] -> HostName -> HostName
PrivInfo -> HostName
(Int -> PrivInfo -> HostName -> HostName)
-> (PrivInfo -> HostName)
-> ([PrivInfo] -> HostName -> HostName)
-> Show PrivInfo
forall a.
(Int -> a -> HostName -> HostName)
-> (a -> HostName) -> ([a] -> HostName -> HostName) -> Show a
showList :: [PrivInfo] -> HostName -> HostName
$cshowList :: [PrivInfo] -> HostName -> HostName
show :: PrivInfo -> HostName
$cshow :: PrivInfo -> HostName
showsPrec :: Int -> PrivInfo -> HostName -> HostName
$cshowsPrec :: Int -> PrivInfo -> HostName -> HostName
Show, Typeable, b -> PrivInfo -> PrivInfo
NonEmpty PrivInfo -> PrivInfo
PrivInfo -> PrivInfo -> PrivInfo
(PrivInfo -> PrivInfo -> PrivInfo)
-> (NonEmpty PrivInfo -> PrivInfo)
-> (forall b. Integral b => b -> PrivInfo -> PrivInfo)
-> Semigroup PrivInfo
forall b. Integral b => b -> PrivInfo -> PrivInfo
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> PrivInfo -> PrivInfo
$cstimes :: forall b. Integral b => b -> PrivInfo -> PrivInfo
sconcat :: NonEmpty PrivInfo -> PrivInfo
$csconcat :: NonEmpty PrivInfo -> PrivInfo
<> :: PrivInfo -> PrivInfo -> PrivInfo
$c<> :: PrivInfo -> PrivInfo -> PrivInfo
Sem.Semigroup, Semigroup PrivInfo
PrivInfo
Semigroup PrivInfo
-> PrivInfo
-> (PrivInfo -> PrivInfo -> PrivInfo)
-> ([PrivInfo] -> PrivInfo)
-> Monoid PrivInfo
[PrivInfo] -> PrivInfo
PrivInfo -> PrivInfo -> PrivInfo
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [PrivInfo] -> PrivInfo
$cmconcat :: [PrivInfo] -> PrivInfo
mappend :: PrivInfo -> PrivInfo -> PrivInfo
$cmappend :: PrivInfo -> PrivInfo -> PrivInfo
mempty :: PrivInfo
$cmempty :: PrivInfo
$cp1Monoid :: Semigroup PrivInfo
Monoid)

-- PrivInfo always propagates out of containers, so that propellor
-- can see which hosts need it.
instance IsInfo PrivInfo where
	propagateInfo :: PrivInfo -> PropagateInfo
propagateInfo PrivInfo
_ = PropagateInfo
PropagatePrivData

-- | Sets the context of any privdata that uses HostContext to the
-- provided name.
forceHostContext :: String -> PrivInfo -> PrivInfo
forceHostContext :: HostName -> PrivInfo -> PrivInfo
forceHostContext HostName
name PrivInfo
i = Set (PrivDataField, Maybe HostName, HostContext) -> PrivInfo
PrivInfo (Set (PrivDataField, Maybe HostName, HostContext) -> PrivInfo)
-> Set (PrivDataField, Maybe HostName, HostContext) -> PrivInfo
forall a b. (a -> b) -> a -> b
$ ((PrivDataField, Maybe HostName, HostContext)
 -> (PrivDataField, Maybe HostName, HostContext))
-> Set (PrivDataField, Maybe HostName, HostContext)
-> Set (PrivDataField, Maybe HostName, HostContext)
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (PrivDataField, Maybe HostName, HostContext)
-> (PrivDataField, Maybe HostName, HostContext)
go (PrivInfo -> Set (PrivDataField, Maybe HostName, HostContext)
fromPrivInfo PrivInfo
i)
  where
	go :: (PrivDataField, Maybe HostName, HostContext)
-> (PrivDataField, Maybe HostName, HostContext)
go (PrivDataField
f, Maybe HostName
d, HostContext HostName -> Context
ctx) = (PrivDataField
f, Maybe HostName
d, (HostName -> Context) -> HostContext
HostContext (Context -> HostName -> Context
forall a b. a -> b -> a
const (Context -> HostName -> Context) -> Context -> HostName -> Context
forall a b. (a -> b) -> a -> b
$ HostName -> Context
ctx HostName
name))