{-# LANGUAGE DataKinds, TypeFamilies #-}

module Propellor.Container where

import Propellor.Types
import Propellor.Types.Core
import Propellor.Types.MetaTypes
import Propellor.Types.Info
import Propellor.Info
import Propellor.PrivData
import Propellor.PropAccum

class IsContainer c where
	containerProperties :: c -> [ChildProperty]
	containerInfo :: c -> Info
	setContainerProperties :: c -> [ChildProperty] -> c

instance IsContainer Host where
	containerProperties :: Host -> [ChildProperty]
containerProperties = Host -> [ChildProperty]
hostProperties
	containerInfo :: Host -> Info
containerInfo = Host -> Info
hostInfo
	setContainerProperties :: Host -> [ChildProperty] -> Host
setContainerProperties Host
h [ChildProperty]
ps = HostName -> Props Any -> Host
forall metatypes. HostName -> Props metatypes -> Host
host (Host -> HostName
hostName Host
h) ([ChildProperty] -> Props Any
forall metatypes. [ChildProperty] -> Props metatypes
Props [ChildProperty]
ps)

-- | Note that the metatype of a container's properties is not retained,
-- so this defaults to UnixLike. So, using this with setContainerProps can
-- add properties to a container that conflict with properties already in it.
-- Use caution when using this; only add properties that do not have
-- restricted targets.
containerProps :: IsContainer c => c -> Props UnixLike
containerProps :: c -> Props UnixLike
containerProps = [ChildProperty] -> Props UnixLike
forall metatypes. [ChildProperty] -> Props metatypes
Props ([ChildProperty] -> Props UnixLike)
-> (c -> [ChildProperty]) -> c -> Props UnixLike
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> [ChildProperty]
forall c. IsContainer c => c -> [ChildProperty]
containerProperties

setContainerProps :: IsContainer c => c -> Props metatypes -> c
setContainerProps :: c -> Props metatypes -> c
setContainerProps c
c (Props [ChildProperty]
ps) = c -> [ChildProperty] -> c
forall c. IsContainer c => c -> [ChildProperty] -> c
setContainerProperties c
c [ChildProperty]
ps

-- | Adjust the provided Property, adding to its
-- propertyChidren the properties of the provided container.
-- 
-- The Info of the propertyChildren is adjusted to only include 
-- info that should be propagated out to the Property.
--
-- Any PrivInfo that uses HostContext is adjusted to use the name
-- of the container as its context.
propagateContainer
	::
		-- Since the children being added probably have info,
		-- require the Property's metatypes to have info.
		-- -Wredundant-constraints is turned off because
		-- this constraint appears redundant, but is actually
		-- crucial.
		( IncludesInfo metatypes ~ 'True
		, IsContainer c
		)
	=> String
	-> c
	-> (PropagateInfo -> Bool)
	-> Property metatypes
	-> Property metatypes
propagateContainer :: HostName
-> c
-> (PropagateInfo -> Bool)
-> Property metatypes
-> Property metatypes
propagateContainer HostName
containername c
c PropagateInfo -> Bool
wanted Property metatypes
prop = Property metatypes
prop
	Property metatypes -> [ChildProperty] -> Property metatypes
forall p. IsProp p => p -> [ChildProperty] -> p
`addChildren` (ChildProperty -> ChildProperty)
-> [ChildProperty] -> [ChildProperty]
forall a b. (a -> b) -> [a] -> [b]
map ChildProperty -> ChildProperty
convert (c -> [ChildProperty]
forall c. IsContainer c => c -> [ChildProperty]
containerProperties c
c)
  where
	convert :: ChildProperty -> ChildProperty
convert ChildProperty
p = 
		let n :: Property UnixLike
n = HostName -> Maybe (Propellor Result) -> Property UnixLike
forall k (metatypes :: k).
SingI metatypes =>
HostName
-> Maybe (Propellor Result) -> Property (MetaTypes metatypes)
property'' (ChildProperty -> HostName
forall p. IsProp p => p -> HostName
getDesc ChildProperty
p) (ChildProperty -> Maybe (Propellor Result)
forall p. IsProp p => p -> Maybe (Propellor Result)
getSatisfy ChildProperty
p) :: Property UnixLike
		    n' :: Property
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
n' = Property UnixLike
n
		    	Property UnixLike
-> Info
-> Property
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall k (metatypes' :: k) metatypes.
(MetaTypes metatypes' ~ (HasInfo + metatypes), SingI metatypes') =>
Property metatypes -> Info -> Property (MetaTypes metatypes')
`setInfoProperty` (PrivInfo -> PrivInfo) -> Info -> Info
forall v. IsInfo v => (v -> v) -> Info -> Info
mapInfo (HostName -> PrivInfo -> PrivInfo
forceHostContext HostName
containername)
				((PropagateInfo -> Bool) -> Info -> Info
propagatableInfo PropagateInfo -> Bool
wanted (ChildProperty -> Info
forall p. IsProp p => p -> Info
getInfo ChildProperty
p))
		   	Property
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> [ChildProperty]
-> Property
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall p. IsProp p => p -> [ChildProperty] -> p
`addChildren` (ChildProperty -> ChildProperty)
-> [ChildProperty] -> [ChildProperty]
forall a b. (a -> b) -> [a] -> [b]
map ChildProperty -> ChildProperty
convert (ChildProperty -> [ChildProperty]
forall p. IsProp p => p -> [ChildProperty]
getChildren ChildProperty
p)
		in Property
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> ChildProperty
forall p. IsProp p => p -> ChildProperty
toChildProperty Property
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
n'

-- | Filters out parts of the Info that should not propagate out of a
-- container.
propagatableInfo :: (PropagateInfo -> Bool) -> Info -> Info
propagatableInfo :: (PropagateInfo -> Bool) -> Info -> Info
propagatableInfo PropagateInfo -> Bool
wanted (Info [InfoEntry]
l) = [InfoEntry] -> Info
Info ([InfoEntry] -> Info) -> [InfoEntry] -> Info
forall a b. (a -> b) -> a -> b
$
	(InfoEntry -> Bool) -> [InfoEntry] -> [InfoEntry]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(InfoEntry v
a) -> PropagateInfo -> Bool
wanted (v -> PropagateInfo
forall v. IsInfo v => v -> PropagateInfo
propagateInfo v
a)) [InfoEntry]
l

normalContainerInfo :: PropagateInfo -> Bool
normalContainerInfo :: PropagateInfo -> Bool
normalContainerInfo PropagateInfo
PropagatePrivData = Bool
True
normalContainerInfo (PropagateInfo Bool
b) = Bool
b

onlyPrivData :: PropagateInfo -> Bool
onlyPrivData :: PropagateInfo -> Bool
onlyPrivData PropagateInfo
PropagatePrivData = Bool
True
onlyPrivData (PropagateInfo Bool
_) = Bool
False