module Propellor.Types
( Host(..)
, Desc
, Property
, HasInfo
, NoInfo
, CInfo
, infoProperty
, simpleProperty
, adjustPropertySatisfy
, propertyInfo
, propertyDesc
, propertyChildren
, RevertableProperty(..)
, (<!>)
, IsProp(..)
, Combines(..)
, CombinedType
, before
, combineWith
, Info(..)
, Propellor(..)
, EndAction(..)
, module Propellor.Types.OS
, module Propellor.Types.Dns
, module Propellor.Types.Result
, propertySatisfy
, ignoreInfo
) where
import Data.Monoid
import Control.Applicative
import "mtl" Control.Monad.RWS.Strict
import Control.Monad.Catch
import qualified Data.Set as S
import qualified Data.Map as M
import Propellor.Types.OS
import Propellor.Types.Chroot
import Propellor.Types.Dns
import Propellor.Types.Docker
import Propellor.Types.PrivData
import Propellor.Types.Empty
import Propellor.Types.Val
import Propellor.Types.Result
import qualified Propellor.Types.Dns as Dns
data Host = Host
{ hostName :: HostName
, hostProperties :: [Property HasInfo]
, hostInfo :: Info
}
deriving (Show)
newtype Propellor p = Propellor { runWithHost :: RWST Host [EndAction] () IO p }
deriving
( Monad
, Functor
, Applicative
, MonadReader Host
, MonadWriter [EndAction]
, MonadIO
, MonadCatch
, MonadThrow
, MonadMask
)
instance Monoid (Propellor Result) where
mempty = return NoChange
mappend x y = do
rx <- x
case rx of
FailedChange -> return FailedChange
_ -> do
ry <- y
return (rx <> ry)
data EndAction = EndAction Desc (Result -> Propellor Result)
type Desc = String
data Property i where
IProperty :: Desc -> Propellor Result -> Info -> [Property HasInfo] -> Property HasInfo
SProperty :: Desc -> Propellor Result -> [Property NoInfo] -> Property NoInfo
data HasInfo
data NoInfo
type family CInfo x y
type instance CInfo HasInfo HasInfo = HasInfo
type instance CInfo HasInfo NoInfo = HasInfo
type instance CInfo NoInfo HasInfo = HasInfo
type instance CInfo NoInfo NoInfo = NoInfo
infoProperty
:: Desc
-> Propellor Result
-> Info
-> [Property i]
-> Property HasInfo
infoProperty d a i cs = IProperty d a i (map toIProperty cs)
simpleProperty :: Desc -> Propellor Result -> [Property NoInfo] -> Property NoInfo
simpleProperty = SProperty
toIProperty :: Property i -> Property HasInfo
toIProperty p@(IProperty {}) = p
toIProperty (SProperty d s cs) = IProperty d s mempty (map toIProperty cs)
toSProperty :: Property i -> Property NoInfo
toSProperty (IProperty d s _ cs) = SProperty d s (map toSProperty cs)
toSProperty p@(SProperty {}) = p
ignoreInfo :: Property i -> Property NoInfo
ignoreInfo = toSProperty
propertySatisfy :: Property i -> Propellor Result
propertySatisfy (IProperty _ a _ _) = a
propertySatisfy (SProperty _ a _) = a
instance Show (Property i) where
show p = "property " ++ show (propertyDesc p)
adjustPropertySatisfy :: Property i -> (Propellor Result -> Propellor Result) -> Property i
adjustPropertySatisfy (IProperty d s i cs) f = IProperty d (f s) i cs
adjustPropertySatisfy (SProperty d s cs) f = SProperty d (f s) cs
propertyInfo :: Property i -> Info
propertyInfo (IProperty _ _ i _) = i
propertyInfo (SProperty {}) = mempty
propertyDesc :: Property i -> Desc
propertyDesc (IProperty d _ _ _) = d
propertyDesc (SProperty d _ _) = d
propertyChildren :: Property i -> [Property i]
propertyChildren (IProperty _ _ _ cs) = cs
propertyChildren (SProperty _ _ cs) = cs
data RevertableProperty = RevertableProperty (Property HasInfo) (Property HasInfo)
(<!>) :: Property i1 -> Property i2 -> RevertableProperty
p1 <!> p2 = RevertableProperty (toIProperty p1) (toIProperty p2)
class IsProp p where
describe :: p -> Desc -> p
toProp :: p -> Property HasInfo
getDesc :: p -> Desc
getInfoRecursive :: p -> Info
instance IsProp (Property HasInfo) where
describe (IProperty _ a i cs) d = IProperty d a i cs
toProp = id
getDesc = propertyDesc
getInfoRecursive (IProperty _ _ i cs) =
i <> mconcat (map getInfoRecursive cs)
instance IsProp (Property NoInfo) where
describe (SProperty _ a cs) d = SProperty d a cs
toProp = toIProperty
getDesc = propertyDesc
getInfoRecursive _ = mempty
instance IsProp RevertableProperty where
describe (RevertableProperty p1 p2) d =
RevertableProperty (describe p1 d) (describe p2 ("not " ++ d))
getDesc (RevertableProperty p1 _) = getDesc p1
toProp (RevertableProperty p1 _) = p1
getInfoRecursive (RevertableProperty p1 _p2) = getInfoRecursive p1
type family CombinedType x y
type instance CombinedType (Property x) (Property y) = Property (CInfo x y)
type instance CombinedType RevertableProperty (Property NoInfo) = RevertableProperty
type instance CombinedType RevertableProperty (Property HasInfo) = RevertableProperty
type instance CombinedType RevertableProperty RevertableProperty = RevertableProperty
class Combines x y where
requires :: x -> y -> CombinedType x y
before :: (IsProp x, Combines y x, IsProp (CombinedType y x)) => x -> y -> CombinedType y x
before x y = (y `requires` x) `describe` (getDesc x)
combineWith
:: (Combines (Property x) (Property y))
=> (Propellor Result -> Propellor Result -> Propellor Result)
-> Property x
-> Property y
-> CombinedType (Property x) (Property y)
combineWith f x y = adjustPropertySatisfy (x `requires` y) $ \_ ->
f (propertySatisfy $ toSProperty x) (propertySatisfy $ toSProperty y)
instance Combines (Property HasInfo) (Property HasInfo) where
requires (IProperty d1 a1 i1 cs1) y@(IProperty _d2 a2 _i2 _cs2) =
IProperty d1 (a2 <> a1) i1 (y : cs1)
instance Combines (Property HasInfo) (Property NoInfo) where
requires (IProperty d1 a1 i1 cs1) y@(SProperty _d2 a2 _cs2) =
IProperty d1 (a2 <> a1) i1 (toIProperty y : cs1)
instance Combines (Property NoInfo) (Property HasInfo) where
requires (SProperty d1 a1 cs1) y@(IProperty _d2 a2 _i2 _cs2) =
IProperty d1 (a2 <> a1) mempty (y : map toIProperty cs1)
instance Combines (Property NoInfo) (Property NoInfo) where
requires (SProperty d1 a1 cs1) y@(SProperty _d2 a2 _cs2) =
SProperty d1 (a2 <> a1) (y : cs1)
instance Combines RevertableProperty (Property HasInfo) where
requires (RevertableProperty p1 p2) y =
RevertableProperty (p1 `requires` y) p2
instance Combines RevertableProperty (Property NoInfo) where
requires (RevertableProperty p1 p2) y =
RevertableProperty (p1 `requires` toIProperty y) p2
instance Combines RevertableProperty RevertableProperty where
requires (RevertableProperty x1 x2) (RevertableProperty y1 y2) =
RevertableProperty
(x1 `requires` y1)
(y2 `requires` x2)
data Info = Info
{ _os :: Val System
, _privData :: S.Set (PrivDataField, Maybe PrivDataSourceDesc, HostContext)
, _sshPubKey :: M.Map SshKeyType String
, _aliases :: S.Set HostName
, _dns :: S.Set Dns.Record
, _namedconf :: Dns.NamedConfMap
, _dockerinfo :: DockerInfo Host
, _chrootinfo :: ChrootInfo Host
}
deriving (Show)
instance Monoid Info where
mempty = Info mempty mempty mempty mempty mempty mempty mempty mempty
mappend old new = Info
{ _os = _os old <> _os new
, _privData = _privData old <> _privData new
, _sshPubKey = _sshPubKey new `M.union` _sshPubKey old
, _aliases = _aliases old <> _aliases new
, _dns = _dns old <> _dns new
, _namedconf = _namedconf old <> _namedconf new
, _dockerinfo = _dockerinfo old <> _dockerinfo new
, _chrootinfo = _chrootinfo old <> _chrootinfo new
}
instance Empty Info where
isEmpty i = and
[ isEmpty (_os i)
, isEmpty (_privData i)
, isEmpty (_sshPubKey i)
, isEmpty (_aliases i)
, isEmpty (_dns i)
, isEmpty (_namedconf i)
, isEmpty (_dockerinfo i)
, isEmpty (_chrootinfo i)
]