Properties can now be satisfied differently on different operating systems.

Propellor/Attr.hs

@@ -21,6 +21,13 @@ hostname name = pureAttrProperty ("hostname " ++ name) $
 getHostName :: Propellor HostName
 getHostName = asks _hostname
 
+os :: System -> AttrProperty
+os system = pureAttrProperty ("OS " ++ show system) $
+	\d -> d { _os = Just system }
+
+getOS :: Propellor (Maybe System)
+getOS = asks _os
+
 cname :: Domain -> AttrProperty
 cname domain = pureAttrProperty ("cname " ++ domain) (addCName domain)
 

Propellor/Message.hs

@@ -29,7 +29,7 @@ actionMessage desc a = do
 	return r
 
 warningMessage :: MonadIO m => String -> m ()
-warningMessage s = liftIO $ colorLine Vivid Red $ "** warning: " ++ s
+warningMessage s = liftIO $ colorLine Vivid Magenta $ "** warning: " ++ s
 
 colorLine :: ColorIntensity -> Color -> String -> IO ()
 colorLine intensity color msg = do
@@ -43,7 +43,7 @@ colorLine intensity color msg = do
 
 errorMessage :: String -> IO a
 errorMessage s = do
-	warningMessage s
+	liftIO $ colorLine Vivid Red $ "** error: " ++ s
 	error "Cannot continue!"
 
 -- | Causes a debug message to be displayed when PROPELLOR_DEBUG=1

Propellor/Property.hs

@@ -10,6 +10,7 @@ import "mtl" Control.Monad.Reader
 
 import Propellor.Types
 import Propellor.Types.Attr
+import Propellor.Attr
 import Propellor.Engine
 import Utility.Monad
 import System.FilePath
@@ -91,6 +92,13 @@ check c property = Property (propertyDesc property) $ ifM (liftIO c)
 	, return NoChange
 	)
 
+-- | Makes a property that is satisfied differently depending on the host's
+-- operating system. 
+--
+-- Note that the operating system may not be declared for some hosts.
+withOS :: Desc -> (Maybe System -> Propellor Result) -> Property
+withOS desc a = Property desc $ a =<< getOS
+
 boolProperty :: Desc -> IO Bool -> Property
 boolProperty desc a = Property desc $ ifM (liftIO a)
 	( return MadeChange

Propellor/Types.hs

@@ -6,8 +6,6 @@ module Propellor.Types
 	( Host(..)
 	, Attr
 	, HostName
-	, UserName
-	, GroupName
 	, Propellor(..)
 	, Property(..)
 	, RevertableProperty(..)
@@ -19,16 +17,12 @@ module Propellor.Types
 	, requires
 	, Desc
 	, Result(..)
-	, System(..)
-	, Distribution(..)
-	, DebianSuite(..)
-	, Release
-	, Architecture
 	, ActionResult(..)
 	, CmdLine(..)
 	, PrivDataField(..)
 	, GpgKeyId
 	, SshKeyType(..)
+	, module Propellor.Types.OS
 	) where
 
 import Data.Monoid
@@ -38,12 +32,10 @@ import "mtl" Control.Monad.Reader
 import "MonadCatchIO-transformers" Control.Monad.CatchIO
 
 import Propellor.Types.Attr
+import Propellor.Types.OS
 
 data Host = Host [Property] (Attr -> Attr)
 
-type UserName = String
-type GroupName = String
-
 -- | Propellor's monad provides read-only access to attributes of the
 -- system.
 newtype Propellor p = Propellor { runWithAttr :: ReaderT Attr IO p }
@@ -119,22 +111,6 @@ instance Monoid Result where
 	mappend _ MadeChange = MadeChange
 	mappend NoChange NoChange = NoChange
 
--- | High level descritption of a operating system.
-data System = System Distribution Architecture
-	deriving (Show)
-
-data Distribution
-	= Debian DebianSuite
-	| Ubuntu Release
-	deriving (Show)
-
-data DebianSuite = Experimental | Unstable | Testing | Stable | DebianRelease Release
-	deriving (Show, Eq)
-
-type Release = String
-
-type Architecture = String
-
 -- | Results of actions, with color.
 class ActionResult a where
 	getActionResult :: a -> (String, ColorIntensity, Color)

Propellor/Types/Attr.hs

@@ -1,11 +1,14 @@
 module Propellor.Types.Attr where
 
+import Propellor.Types.OS
+
 import qualified Data.Set as S
 
 -- | The attributes of a host. For example, its hostname.
 data Attr = Attr
 	{ _hostname :: HostName
 	, _cnames :: S.Set Domain
+	, _os :: Maybe System
 	, _sshPubKey :: Maybe String
 
 	, _dockerImage :: Maybe String
@@ -16,6 +19,7 @@ instance Eq Attr where
 	x == y = and
 		[ _hostname x == _hostname y
 		, _cnames x == _cnames y
+		, _os x == _os y
 		, _sshPubKey x == _sshPubKey y
 
 		, _dockerImage x == _dockerImage y
@@ -27,13 +31,14 @@ instance Show Attr where
 	show a = unlines
 		[ "hostname " ++ _hostname a
 		, "cnames " ++ show (_cnames a)
+		, "OS " ++ show (_os a)
 		, "sshPubKey " ++ show (_sshPubKey a)
 		, "docker image " ++ show (_dockerImage a)
 		, "docker run params " ++ show (map (\mk -> mk "") (_dockerRunParams a))
 		]
 
 newAttr :: HostName -> Attr
-newAttr hn = Attr hn S.empty Nothing Nothing []
+newAttr hn = Attr hn S.empty Nothing Nothing Nothing []
 
 type HostName = String
 type Domain = String

Propellor/Types/OS.hs

@@ -0,0 +1,19 @@
+module Propellor.Types.OS where
+
+type UserName = String
+type GroupName = String
+
+-- | High level descritption of a operating system.
+data System = System Distribution Architecture
+	deriving (Show, Eq)
+
+data Distribution
+	= Debian DebianSuite
+	| Ubuntu Release
+	deriving (Show, Eq)
+
+data DebianSuite = Experimental | Unstable | Testing | Stable | DebianRelease Release
+	deriving (Show, Eq)
+
+type Release = String
+type Architecture = String

config-joey.hs

@@ -29,7 +29,7 @@ hosts =
 		& Apt.buildDep ["git-annex"] `period` Daily
 
 	-- Nothing super-important lives here.
-	, standardSystem "clam.kitenet.net" Unstable
+	, standardSystem "clam.kitenet.net" Unstable "amd64"
 		& cleanCloudAtCost
 		& Apt.unattendedUpgrades
 		& Network.ipv6to4
@@ -53,7 +53,7 @@ hosts =
 		& Apt.installed ["git-annex", "mtr", "screen"]
 	
 	-- Orca is the main git-annex build box.
-	, standardSystem "orca.kitenet.net" Unstable
+	, standardSystem "orca.kitenet.net" Unstable "amd64"
 		& Hostname.sane
 		& Apt.unattendedUpgrades
 		& Docker.configured
@@ -65,7 +65,7 @@ hosts =
 		& Apt.buildDep ["git-annex"] `period` Daily
 	
 	-- Important stuff that needs not too much memory or CPU.
-  	, standardSystem "diatom.kitenet.net" Stable
+  	, standardSystem "diatom.kitenet.net" Stable "amd64"
 		& Hostname.sane
 		& Ssh.hostKey SshDsa
 		& Ssh.hostKey SshRsa
@@ -142,8 +142,9 @@ gitAnnexBuilder arch buildminute = Docker.container (arch ++ "-git-annex-builder
 	& Apt.unattendedUpgrades
 
 -- This is my standard system setup.
-standardSystem :: HostName -> DebianSuite -> Host
-standardSystem hn suite = host hn
+standardSystem :: HostName -> DebianSuite -> Architecture -> Host
+standardSystem hn suite arch = host hn
+	& os (System (Debian suite) arch)
 	& Apt.stdSourcesList suite `onChange` Apt.upgrade
 	& Apt.installed ["etckeeper"]
 	& Apt.installed ["ssh"]
@@ -166,6 +167,7 @@ standardSystem hn suite = host hn
 -- This is my standard container setup, featuring automatic upgrades.
 standardContainer :: Docker.ContainerName -> DebianSuite -> Architecture -> Host
 standardContainer name suite arch = Docker.container name (image system)
+	& os (System (Debian suite) arch)
 	& Apt.stdSourcesList suite
 	& Apt.unattendedUpgrades
   where

debian/changelog

@@ -4,6 +4,8 @@ propellor (0.3.1) UNRELEASED; urgency=medium
   * Support for provisioning hosts with ssh and gpg keys.
   * Obnam support.
   * Apache support.
+  * Properties can now be satisfied differently on different operating
+    systems.
 
  -- Joey Hess <joeyh@debian.org>  Fri, 11 Apr 2014 15:00:11 -0400
 

propellor.cabal

@@ -97,6 +97,7 @@ Library
     Propellor.Engine
     Propellor.Exception
     Propellor.Types
+    Propellor.Types.OS
   Other-Modules:
     Propellor.Types.Attr
     Propellor.CmdLine