summaryrefslogtreecommitdiff
path: root/Propellor/Types.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Propellor/Types.hs')
-rw-r--r--Propellor/Types.hs153
1 files changed, 0 insertions, 153 deletions
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)