From 7115d1ec162b4059b3e8e8f84bd8d5898c1db025 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 14 May 2014 19:41:05 -0400 Subject: moved source code to src This is to work around OSX's brain-damange regarding filename case insensitivity. Avoided moving config.hs, because it's a config file. Put in a symlink to make build work. --- Propellor/Types.hs | 153 ----------------------------------------------------- 1 file changed, 153 deletions(-) delete mode 100644 Propellor/Types.hs (limited to 'Propellor/Types.hs') diff --git a/Propellor/Types.hs b/Propellor/Types.hs deleted file mode 100644 index 22df9ddb..00000000 --- a/Propellor/Types.hs +++ /dev/null @@ -1,153 +0,0 @@ -{-# LANGUAGE PackageImports #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE ExistentialQuantification #-} - -module Propellor.Types - ( Host(..) - , Attr - , SetAttr - , Propellor(..) - , Property(..) - , RevertableProperty(..) - , IsProp - , describe - , toProp - , setAttr - , requires - , Desc - , Result(..) - , ActionResult(..) - , CmdLine(..) - , PrivDataField(..) - , GpgKeyId - , SshKeyType(..) - , module Propellor.Types.OS - , module Propellor.Types.Dns - ) 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 -import Propellor.Types.OS -import Propellor.Types.Dns - -data Host = Host [Property] SetAttr - --- | 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 - , propertySatisfy :: Propellor Result - -- ^ must be idempotent; may run repeatedly - , propertyAttr :: SetAttr - -- ^ a property can set an Attr on the host that has the property. - } - --- | A property that can be reverted. -data RevertableProperty = RevertableProperty Property Property - -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 - setAttr :: p -> SetAttr - -instance IsProp Property where - describe p d = p { propertyDesc = d } - toProp p = p - setAttr = propertyAttr - x `requires` y = Property (propertyDesc x) satisfy attr - where - attr = propertyAttr x . propertyAttr y - satisfy = do - r <- propertySatisfy y - case r of - FailedChange -> return FailedChange - _ -> propertySatisfy x - - -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 - -- | Return the SetAttr of the currently active side. - setAttr (RevertableProperty p1 _p2) = setAttr p1 - -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 - --- | 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 - | SshPubKey SshKeyType UserName - | SshPrivKey SshKeyType UserName - | SshAuthorizedKeys UserName - | Password UserName - | PrivFile FilePath - | GpgKey GpgKeyId - deriving (Read, Show, Ord, Eq) - -type GpgKeyId = String - -data SshKeyType = SshRsa | SshDsa | SshEcdsa | SshEd25519 - deriving (Read, Show, Ord, Eq) -- cgit v1.2.3