From be02ef96aa89a6af554a622f266d700ac0c98fdf Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@debian.org>
Date: Fri, 11 Apr 2014 01:19:05 -0400
Subject: propellor (0.3.0) unstable; urgency=medium

  * ipv6to4: Ensure interface is brought up automatically on boot.
  * Enabling unattended upgrades now ensures that cron is installed and
    running to perform them.
  * Properties can be scheduled to only be checked after a given time period.
  * Fix bootstrapping of dependencies.
  * Fix compilation on Debian stable.
  * Include security updates in sources.list for stable and testing.
  * Use ssh connection caching, especially when bootstrapping.
  * Properties now run in a Propellor monad, which provides access to
    attributes of the host.

# imported from the archive
---
 Propellor/Types.hs | 170 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 170 insertions(+)
 create mode 100644 Propellor/Types.hs

(limited to 'Propellor/Types.hs')

diff --git a/Propellor/Types.hs b/Propellor/Types.hs
new file mode 100644
index 00000000..e6e02126
--- /dev/null
+++ b/Propellor/Types.hs
@@ -0,0 +1,170 @@
+{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE ExistentialQuantification #-}
+
+module Propellor.Types
+	( Host(..)
+	, Attr
+	, HostName
+	, UserName
+	, GroupName
+	, Propellor(..)
+	, Property(..)
+	, RevertableProperty(..)
+	, AttrProperty(..)
+	, IsProp
+	, describe
+	, toProp
+	, getAttr
+	, requires
+	, Desc
+	, Result(..)
+	, System(..)
+	, Distribution(..)
+	, DebianSuite(..)
+	, Release
+	, Architecture
+	, ActionResult(..)
+	, CmdLine(..)
+	, PrivDataField(..)
+	) where
+
+import Data.Monoid
+import Control.Applicative
+import System.Console.ANSI
+import "mtl" Control.Monad.Reader
+import "MonadCatchIO-transformers" Control.Monad.CatchIO
+
+import Propellor.Types.Attr
+
+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 }
+	deriving
+		( Monad
+		, Functor
+		, Applicative
+		, MonadReader Attr 
+		, MonadIO
+		, MonadCatchIO
+		)
+
+-- | The core data type of Propellor, this represents a property
+-- that the system should have, and an action to ensure it has the
+-- property.
+data Property = Property
+	{ propertyDesc :: Desc
+	-- | must be idempotent; may run repeatedly
+	, propertySatisfy :: Propellor Result
+	}
+
+-- | A property that can be reverted.
+data RevertableProperty = RevertableProperty Property Property
+
+-- | A property that affects the Attr.
+data AttrProperty = forall p. IsProp p => AttrProperty p (Attr -> Attr)
+
+class IsProp p where
+	-- | Sets description.
+	describe :: p -> Desc -> p
+	toProp :: p -> Property
+	-- | Indicates that the first property can only be satisfied
+	-- once the second one is.
+	requires :: p -> Property -> p
+	getAttr :: p -> (Attr -> Attr)
+
+instance IsProp Property where
+	describe p d = p { propertyDesc = d }
+	toProp p = p
+	x `requires` y = Property (propertyDesc x) $ do
+		r <- propertySatisfy y
+		case r of
+			FailedChange -> return FailedChange
+			_ -> propertySatisfy x
+	getAttr _ = id
+
+instance IsProp RevertableProperty where
+	-- | Sets the description of both sides.
+	describe (RevertableProperty p1 p2) d = 
+		RevertableProperty (describe p1 d) (describe p2 ("not " ++ d))
+	toProp (RevertableProperty p1 _) = p1
+	(RevertableProperty p1 p2) `requires` y =
+		RevertableProperty (p1 `requires` y) p2
+	getAttr _ = id
+
+instance IsProp AttrProperty where
+	describe (AttrProperty p a) d = AttrProperty (describe p d) a
+	toProp (AttrProperty p _) = toProp p
+	(AttrProperty p a) `requires` y = AttrProperty (p `requires` y) a
+	getAttr (AttrProperty _ a) = a
+
+type Desc = String
+
+data Result = NoChange | MadeChange | FailedChange
+	deriving (Read, Show, Eq)
+
+instance Monoid Result where
+	mempty = NoChange
+
+	mappend FailedChange _ = FailedChange
+	mappend _ FailedChange = FailedChange
+	mappend MadeChange _ = MadeChange
+	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)
+
+instance ActionResult Bool where
+	getActionResult False = ("failed", Vivid, Red)
+	getActionResult True = ("done", Dull, Green)
+
+instance ActionResult Result where
+	getActionResult NoChange = ("ok", Dull, Green)
+	getActionResult MadeChange = ("done", Vivid, Green)
+	getActionResult FailedChange = ("failed", Vivid, Red)
+
+data CmdLine
+	= Run HostName
+	| Spin HostName
+	| Boot HostName
+	| Set HostName PrivDataField
+	| AddKey String
+	| Continue CmdLine
+	| Chain HostName
+	| Docker HostName
+  deriving (Read, Show, Eq)
+
+-- | Note that removing or changing field names will break the
+-- serialized privdata files, so don't do that!
+-- It's fine to add new fields.
+data PrivDataField
+	= DockerAuthentication
+	| SshPrivKey UserName
+	| Password UserName
+	| PrivFile FilePath
+	deriving (Read, Show, Ord, Eq)
+
+
-- 
cgit v1.3-2-g0d8e