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

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

addPrivData :: (PrivDataField, Maybe PrivDataSourceDesc, HostContext) -> Property (HasInfo + UnixLike)
addPrivData :: (PrivDataField, Maybe PrivDataSourceDesc, HostContext)
-> Property (HasInfo + UnixLike)
addPrivData (PrivDataField, Maybe PrivDataSourceDesc, HostContext)
v = forall v.
IsInfo v =>
PrivDataSourceDesc -> v -> Property (HasInfo + UnixLike)
pureInfoProperty (forall a. Show a => a -> PrivDataSourceDesc
show (PrivDataField, Maybe PrivDataSourceDesc, HostContext)
v) (Set (PrivDataField, Maybe PrivDataSourceDesc, HostContext)
-> PrivInfo
PrivInfo (forall a. a -> Set a
S.singleton (PrivDataField, Maybe PrivDataSourceDesc, 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe forall k a. Map k a
M.empty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe PrivMap)
localcache
  where
	localcache :: IO (Maybe PrivMap)
localcache = forall (m :: * -> *) a. MonadCatch m => a -> m a -> m a
catchDefaultIO forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ forall a. Read a => PrivDataSourceDesc -> Maybe a
readish forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrivDataSourceDesc -> IO PrivDataSourceDesc
readFile PrivDataSourceDesc
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 = forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey (\(PrivDataField, Context)
k PrivDataSourceDesc
_v -> forall a. Ord a => a -> Set a -> Bool
S.member (PrivDataField, Context)
k Set (PrivDataField, Context)
used)
  where
	used :: Set (PrivDataField, Context)
used = forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (\(PrivDataField
f, Maybe PrivDataSourceDesc
_, HostContext
c) -> (PrivDataField
f, HostContext -> PrivDataSourceDesc -> Context
mkHostContext HostContext
c (Host -> PrivDataSourceDesc
hostName Host
host))) forall a b. (a -> b) -> a -> b
$
		PrivInfo
-> Set (PrivDataField, Maybe PrivDataSourceDesc, HostContext)
fromPrivInfo forall a b. (a -> b) -> a -> b
$ forall v. IsInfo v => Info -> v
fromInfo 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
	PrivDataSourceDesc
s <- forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (PrivDataField
field, Context
context) PrivMap
m
	forall (m :: * -> *) a. Monad m => a -> m a
return (PrivDataSourceDesc -> PrivData
PrivData PrivDataSourceDesc
s)

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

unsetPrivData :: PrivDataField -> Context -> IO ()
unsetPrivData :: PrivDataField -> Context -> IO ()
unsetPrivData PrivDataField
field Context
context = do
	(PrivMap -> PrivMap) -> IO ()
modifyPrivData forall a b. (a -> b) -> a -> b
$ 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 =
	PrivDataSourceDesc -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ PrivDataSourceDesc
"Private data unset: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> PrivDataSourceDesc
show PrivDataField
field forall a. [a] -> [a] -> [a]
++ PrivDataSourceDesc
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> PrivDataSourceDesc
show Context
context

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

dumpPrivData :: PrivDataField -> Context -> IO ()
dumpPrivData :: PrivDataField -> Context -> IO ()
dumpPrivData PrivDataField
field Context
context = do
	forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. HasCallStack => PrivDataSourceDesc -> a
error PrivDataSourceDesc
"Requested privdata is not set.")
		(Handle -> ByteString -> IO ()
L.hPut Handle
stdout forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrivData -> ByteString
privDataByteString)
		forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (PrivDataField -> Context -> PrivMap -> Maybe PrivData
getPrivData PrivDataField
field Context
context 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO PrivMap
decryptPrivData
	PrivData
v' <- forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
PrivDataSourceDesc -> (PrivDataSourceDesc -> Handle -> m a) -> m a
withTmpFile PrivDataSourceDesc
"propellorXXXX" forall a b. (a -> b) -> a -> b
$ \PrivDataSourceDesc
f Handle
th -> do
		Handle -> IO ()
hClose Handle
th
		forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (m :: * -> *). Monad m => m ()
noop (\PrivData
p -> PrivDataSourceDesc -> (Handle -> IO ()) -> IO ()
writeFileProtected' PrivDataSourceDesc
f (Handle -> ByteString -> IO ()
`L.hPut` PrivData -> ByteString
privDataByteString PrivData
p)) Maybe PrivData
v
		PrivDataSourceDesc
editor <- PrivDataSourceDesc -> PrivDataSourceDesc -> IO PrivDataSourceDesc
getEnvDefault PrivDataSourceDesc
"EDITOR" PrivDataSourceDesc
"vi"
		forall {m :: * -> *}. Monad m => m Bool -> m () -> m ()
unlessM (PrivDataSourceDesc -> [CommandParam] -> IO Bool
boolSystemNonConcurrent PrivDataSourceDesc
editor [PrivDataSourceDesc -> CommandParam
File PrivDataSourceDesc
f]) forall a b. (a -> b) -> a -> b
$
			forall a. HasCallStack => PrivDataSourceDesc -> a
error PrivDataSourceDesc
"Editor failed; aborting."
		PrivDataSourceDesc -> PrivData
PrivData forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrivDataSourceDesc -> IO PrivDataSourceDesc
readFile PrivDataSourceDesc
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
	
	PrivDataSourceDesc -> IO ()
section PrivDataSourceDesc
"Currently set data:"
	[[PrivDataSourceDesc]] -> IO ()
showtable forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (PrivDataField, Context) -> [PrivDataSourceDesc]
mkrow (forall k a. Map k a -> [k]
M.keys PrivMap
m)
	let missing :: [(PrivDataField, Context)]
missing = forall k a. Map k a -> [k]
M.keys forall a b. (a -> b) -> a -> b
$ forall k a b. Ord k => Map k a -> Map k b -> Map k a
M.difference PrivMap
wantedmap PrivMap
m
	
	forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(PrivDataField, Context)]
missing) forall a b. (a -> b) -> a -> b
$ do
		PrivDataSourceDesc -> IO ()
section PrivDataSourceDesc
"Missing data that would be used if set:"
		[[PrivDataSourceDesc]] -> IO ()
showtable forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (PrivDataField, Context) -> [PrivDataSourceDesc]
mkrow [(PrivDataField, Context)]
missing

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

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

mkPrivDataMap :: Host -> (Maybe PrivDataSourceDesc -> a) -> M.Map (PrivDataField, Context) a
mkPrivDataMap :: forall a.
Host
-> (Maybe PrivDataSourceDesc -> a)
-> Map (PrivDataField, Context) a
mkPrivDataMap Host
host Maybe PrivDataSourceDesc -> a
mkv = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$
	forall a b. (a -> b) -> [a] -> [b]
map (\(PrivDataField
f, Maybe PrivDataSourceDesc
d, HostContext
c) -> ((PrivDataField
f, HostContext -> PrivDataSourceDesc -> Context
mkHostContext HostContext
c (Host -> PrivDataSourceDesc
hostName Host
host)), Maybe PrivDataSourceDesc -> a
mkv Maybe PrivDataSourceDesc
d))
		(forall a. Set a -> [a]
S.toList forall a b. (a -> b) -> a -> b
$ PrivInfo
-> Set (PrivDataField, Maybe PrivDataSourceDesc, HostContext)
fromPrivInfo forall a b. (a -> b) -> a -> b
$ forall v. IsInfo v => Info -> v
fromInfo 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 PrivDataSourceDesc
value) = do
	(PrivMap -> PrivMap) -> IO ()
modifyPrivData PrivMap -> PrivMap
set
	PrivDataSourceDesc -> IO ()
putStrLn PrivDataSourceDesc
"Private data set."
  where
	set :: PrivMap -> PrivMap
set = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (PrivDataField
field, Context
context) PrivDataSourceDesc
value

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

modifyPrivData' :: (PrivMap -> (PrivMap, a)) -> IO a
modifyPrivData' :: forall a. (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
	PrivDataSourceDesc
privdata <- IO PrivDataSourceDesc
privDataFile
	PrivDataSourceDesc -> PrivDataSourceDesc -> IO ()
gpgEncrypt PrivDataSourceDesc
privdata (forall a. Show a => a -> PrivDataSourceDesc
show PrivMap
m')
	forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ PrivDataSourceDesc -> [CommandParam] -> IO Bool
boolSystem PrivDataSourceDesc
"git" [PrivDataSourceDesc -> CommandParam
Param PrivDataSourceDesc
"add", PrivDataSourceDesc -> CommandParam
File PrivDataSourceDesc
privdata]
	forall (m :: * -> *) a. Monad m => a -> m a
return a
r

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

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

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

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

newtype PrivInfo = PrivInfo
	{ PrivInfo
-> Set (PrivDataField, Maybe PrivDataSourceDesc, HostContext)
fromPrivInfo :: S.Set (PrivDataField, Maybe PrivDataSourceDesc, HostContext) }
	deriving (PrivInfo -> PrivInfo -> Bool
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
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
Ord, Int -> PrivInfo -> PrivDataSourceDesc -> PrivDataSourceDesc
[PrivInfo] -> PrivDataSourceDesc -> PrivDataSourceDesc
PrivInfo -> PrivDataSourceDesc
forall a.
(Int -> a -> PrivDataSourceDesc -> PrivDataSourceDesc)
-> (a -> PrivDataSourceDesc)
-> ([a] -> PrivDataSourceDesc -> PrivDataSourceDesc)
-> Show a
showList :: [PrivInfo] -> PrivDataSourceDesc -> PrivDataSourceDesc
$cshowList :: [PrivInfo] -> PrivDataSourceDesc -> PrivDataSourceDesc
show :: PrivInfo -> PrivDataSourceDesc
$cshow :: PrivInfo -> PrivDataSourceDesc
showsPrec :: Int -> PrivInfo -> PrivDataSourceDesc -> PrivDataSourceDesc
$cshowsPrec :: Int -> PrivInfo -> PrivDataSourceDesc -> PrivDataSourceDesc
Show, Typeable, NonEmpty PrivInfo -> PrivInfo
PrivInfo -> PrivInfo -> 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 :: forall b. Integral b => 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
[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
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 :: PrivDataSourceDesc -> PrivInfo -> PrivInfo
forceHostContext PrivDataSourceDesc
name PrivInfo
i = Set (PrivDataField, Maybe PrivDataSourceDesc, HostContext)
-> PrivInfo
PrivInfo forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (PrivDataField, Maybe PrivDataSourceDesc, HostContext)
-> (PrivDataField, Maybe PrivDataSourceDesc, HostContext)
go (PrivInfo
-> Set (PrivDataField, Maybe PrivDataSourceDesc, HostContext)
fromPrivInfo PrivInfo
i)
  where
	go :: (PrivDataField, Maybe PrivDataSourceDesc, HostContext)
-> (PrivDataField, Maybe PrivDataSourceDesc, HostContext)
go (PrivDataField
f, Maybe PrivDataSourceDesc
d, HostContext PrivDataSourceDesc -> Context
ctx) = (PrivDataField
f, Maybe PrivDataSourceDesc
d, (PrivDataSourceDesc -> Context) -> HostContext
HostContext (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ PrivDataSourceDesc -> Context
ctx PrivDataSourceDesc
name))