summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoey Hess2014-03-30 15:31:57 -0400
committerJoey Hess2014-03-30 15:38:08 -0400
commit90efcd3203d64c2c5691e30ccc23307aae8d20c8 (patch)
tree183f38a857a81a3cb1a301b94f827f8a807dc961
parent8d31a6226ac9e1dfc75ec7521f039a43e749ed82 (diff)
refactor
-rw-r--r--Common.hs18
-rw-r--r--Propellor.hs3
-rw-r--r--Property.hs142
-rw-r--r--Property/Apt.hs7
-rw-r--r--Property/Cmd.hs28
-rw-r--r--Property/File.hs26
-rw-r--r--Property/GitHome.hs15
-rw-r--r--Property/Hostname.hs3
-rw-r--r--Property/Reboot.hs2
-rw-r--r--Property/Ssh.hs12
-rw-r--r--Property/Tor.hs3
-rw-r--r--Property/User.hs7
12 files changed, 130 insertions, 136 deletions
diff --git a/Common.hs b/Common.hs
new file mode 100644
index 00000000..10594d3c
--- /dev/null
+++ b/Common.hs
@@ -0,0 +1,18 @@
+module Common (module X) where
+
+import Property as X
+import Property.Cmd as X
+
+import Control.Applicative as X
+import Control.Monad as X
+import Utility.Process as X
+import System.Directory as X
+import System.IO as X
+import Utility.Exception as X
+import Utility.Env as X
+import Utility.Directory as X
+import Utility.Tmp as X
+import System.FilePath as X
+import Data.Maybe as X
+import Data.Either as X
+import Utility.Monad as X
diff --git a/Propellor.hs b/Propellor.hs
index ea2188f7..9e50b2f6 100644
--- a/Propellor.hs
+++ b/Propellor.hs
@@ -1,6 +1,5 @@
-import Property
+import Common
import HostName
-import Utility.SafeCommand
import qualified Property.File as File
import qualified Property.Apt as Apt
import qualified Property.Ssh as Ssh
diff --git a/Property.hs b/Property.hs
index f00ddfa2..4055ab2a 100644
--- a/Property.hs
+++ b/Property.hs
@@ -1,7 +1,6 @@
module Property where
import System.Directory
-import Control.Applicative
import Control.Monad
import System.Console.ANSI
import System.Exit
@@ -9,23 +8,18 @@ import System.IO
import Utility.Monad
import Utility.Exception
-import Utility.SafeCommand
-import Utility.Tmp
-import Utility.Env
--- Ensures that the system has some property.
--- Actions must be idempotent; will be run repeatedly.
-data Property
- = FileProperty Desc FilePath ([Line] -> [Line])
- | CmdProperty Desc String [CommandParam] [(String, String)]
- | IOProperty Desc (IO Result)
+data Property = Property
+ { propertyDesc :: Desc
+ -- must be idempotent; may run repeatedly
+ , propertySatisfy :: IO Result
+ }
+
+type Desc = String
data Result = NoChange | MadeChange | FailedChange
deriving (Show, Eq)
-type Line = String
-type Desc = String
-
combineResult :: Result -> Result -> Result
combineResult FailedChange _ = FailedChange
combineResult _ FailedChange = FailedChange
@@ -33,10 +27,11 @@ combineResult MadeChange _ = MadeChange
combineResult _ MadeChange = MadeChange
combineResult NoChange NoChange = NoChange
-propertyDesc :: Property -> Desc
-propertyDesc (FileProperty d _ _) = d
-propertyDesc (CmdProperty d _ _ _) = d
-propertyDesc (IOProperty d _) = d
+makeChange :: IO () -> IO Result
+makeChange a = a >> return MadeChange
+
+noChange :: IO Result
+noChange = return NoChange
{- Combines a list of properties, resulting in a single property
- that when run will run each property in the list in turn,
@@ -44,12 +39,12 @@ propertyDesc (IOProperty d _) = d
- on failure; does propigate overall success/failure.
-}
propertyList :: Desc -> [Property] -> Property
-propertyList desc ps = IOProperty desc $ ensureProperties' ps
+propertyList desc ps = Property desc $ ensureProperties' ps
{- Combines a list of properties, resulting in one property that
- ensures each in turn, stopping on failure. -}
combineProperties :: Desc -> [Property] -> Property
-combineProperties desc ps = IOProperty desc $ go ps NoChange
+combineProperties desc ps = Property desc $ go ps NoChange
where
go [] rs = return rs
go (l:ls) rs = do
@@ -58,26 +53,45 @@ combineProperties desc ps = IOProperty desc $ go ps NoChange
FailedChange -> return FailedChange
_ -> go ls (combineResult r rs)
-ensureProperty :: Property -> IO Result
-ensureProperty = catchDefaultIO FailedChange . ensureProperty'
-
-ensureProperty' :: Property -> IO Result
-ensureProperty' (FileProperty _ f a) = go =<< doesFileExist f
+{- Makes a perhaps non-idempotent Property be idempotent by using a flag
+ - file to indicate whether it has run before.
+ - Use with caution. -}
+flagFile :: Property -> FilePath -> Property
+flagFile property flagfile = Property (propertyDesc property) $
+ go =<< doesFileExist flagfile
where
- go True = do
- ls <- lines <$> readFile f
- let ls' = a ls
- if ls' == ls
- then noChange
- else makeChange $ viaTmp writeFile f (unlines ls')
- go False = makeChange $ writeFile f (unlines $ a [])
-ensureProperty' (CmdProperty _ cmd params env) = do
- env' <- addEntries env <$> getEnvironment
- ifM (boolSystemEnv cmd params (Just env'))
- ( return MadeChange
- , return FailedChange
- )
-ensureProperty' (IOProperty _ a) = a
+ go True = return NoChange
+ go False = do
+ r <- ensureProperty property
+ when (r == MadeChange) $
+ writeFile flagfile ""
+ return r
+
+{- Whenever a change has to be made for a Property, causes a hook
+ - Property to also be run, but not otherwise. -}
+onChange :: Property -> Property -> Property
+property `onChange` hook = Property (propertyDesc property) $ do
+ r <- ensureProperty property
+ case r of
+ MadeChange -> do
+ r' <- ensureProperty hook
+ return $ combineResult r r'
+ _ -> return r
+
+{- Indicates that the first property can only be satisfied once
+ - the second is. -}
+requires :: Property -> Property -> Property
+x `requires` y = combineProperties (propertyDesc x) [y, x]
+
+{- Makes a Property only be performed when a test succeeds. -}
+check :: IO Bool -> Property -> Property
+check c property = Property (propertyDesc property) $ ifM c
+ ( ensureProperty property
+ , return NoChange
+ )
+
+ensureProperty :: Property -> IO Result
+ensureProperty = catchDefaultIO FailedChange . propertySatisfy
ensureProperties :: [Property] -> IO ()
ensureProperties ps = do
@@ -109,55 +123,3 @@ ensureProperties' ps = ensure ps NoChange
putStrLn "done"
setSGR []
ensure ls (combineResult r rs)
-
-makeChange :: IO () -> IO Result
-makeChange a = a >> return MadeChange
-
-noChange :: IO Result
-noChange = return NoChange
-
-cmdProperty :: String -> [CommandParam] -> Property
-cmdProperty cmd params = cmdProperty' cmd params []
-
-cmdProperty' :: String -> [CommandParam] -> [(String, String)] -> Property
-cmdProperty' cmd params env = CmdProperty desc cmd params env
- where
- desc = unwords $ cmd : map showp params
- showp (Params s) = s
- showp (Param s) = s
- showp (File s) = s
-
-{- Makes a perhaps non-idempotent Property be idempotent by using a flag
- - file to indicate whether it has run before.
- - Use with caution. -}
-flagFile :: Property -> FilePath -> Property
-flagFile property flagfile = IOProperty (propertyDesc property) $
- go =<< doesFileExist flagfile
- where
- go True = return NoChange
- go False = do
- r <- ensureProperty property
- when (r == MadeChange) $
- writeFile flagfile ""
- return r
-
-{- Whenever a change has to be made for a Property, causes a hook
- - Property to also be run, but not otherwise. -}
-onChange :: Property -> Property -> Property
-property `onChange` hook = IOProperty (propertyDesc property) $ do
- r <- ensureProperty property
- case r of
- MadeChange -> do
- r' <- ensureProperty hook
- return $ combineResult r r'
- _ -> return r
-
-requires :: Property -> Property -> Property
-x `requires` y = combineProperties (propertyDesc x) [y, x]
-
-{- Makes a Property only be performed when a test succeeds. -}
-check :: IO Bool -> Property -> Property
-check c property = IOProperty (propertyDesc property) $ ifM c
- ( ensureProperty property
- , return NoChange
- )
diff --git a/Property/Apt.hs b/Property/Apt.hs
index 653c0fca..a5720e72 100644
--- a/Property/Apt.hs
+++ b/Property/Apt.hs
@@ -6,10 +6,9 @@ import Data.List
import System.IO
import Control.Monad
-import Property
+import Common
import qualified Property.File as File
-import Utility.SafeCommand
-import Utility.Process
+import Property.File (Line)
sourcesList :: FilePath
sourcesList = "/etc/apt/sources.list"
@@ -109,7 +108,7 @@ unattendedUpgrades enabled = installed ["unattended-upgrades"]
reConfigure :: Package -> [(String, String, String)] -> Property
reConfigure package vals = reconfigure `requires` setselections
where
- setselections = IOProperty "preseed" $ makeChange $
+ setselections = Property "preseed" $ makeChange $
withHandle StdinHandle createProcessSuccess
(proc "debconf-set-selections" []) $ \h -> do
forM_ vals $ \(template, tmpltype, value) ->
diff --git a/Property/Cmd.hs b/Property/Cmd.hs
new file mode 100644
index 00000000..c78adaeb
--- /dev/null
+++ b/Property/Cmd.hs
@@ -0,0 +1,28 @@
+module Property.Cmd (
+ cmdProperty,
+ cmdProperty',
+ module Utility.SafeCommand
+) where
+
+import Control.Applicative
+
+import Property
+import Utility.Monad
+import Utility.SafeCommand
+import Utility.Env
+
+cmdProperty :: String -> [CommandParam] -> Property
+cmdProperty cmd params = cmdProperty' cmd params []
+
+cmdProperty' :: String -> [CommandParam] -> [(String, String)] -> Property
+cmdProperty' cmd params env = Property desc $ do
+ env' <- addEntries env <$> getEnvironment
+ ifM (boolSystemEnv cmd params (Just env'))
+ ( return MadeChange
+ , return FailedChange
+ )
+ where
+ desc = unwords $ cmd : map showp params
+ showp (Params s) = s
+ showp (Param s) = s
+ showp (File s) = s
diff --git a/Property/File.hs b/Property/File.hs
index 9d07f130..55ca4fec 100644
--- a/Property/File.hs
+++ b/Property/File.hs
@@ -1,18 +1,17 @@
module Property.File where
-import System.Directory
+import Common
-import Property
-import Utility.Directory
+type Line = String
{- Replaces all the content of a file. -}
hasContent :: FilePath -> [Line] -> Property
-f `hasContent` newcontent = FileProperty ("replace " ++ f)
- f (\_oldcontent -> newcontent)
+f `hasContent` newcontent = fileProperty ("replace " ++ f)
+ (\_oldcontent -> newcontent) f
{- Ensures that a line is present in a file, adding it to the end if not. -}
containsLine :: FilePath -> Line -> Property
-f `containsLine` l = FileProperty (f ++ " contains:" ++ l) f go
+f `containsLine` l = fileProperty (f ++ " contains:" ++ l) go f
where
go ls
| l `elem` ls = ls
@@ -22,9 +21,20 @@ f `containsLine` l = FileProperty (f ++ " contains:" ++ l) f go
- Note that the file is ensured to exist, so if it doesn't, an empty
- file will be written. -}
lacksLine :: FilePath -> Line -> Property
-f `lacksLine` l = FileProperty (f ++ " remove: " ++ l) f (filter (/= l))
+f `lacksLine` l = fileProperty (f ++ " remove: " ++ l) (filter (/= l)) f
{- Note: Does not remove symlinks or non-plain-files. -}
notPresent :: FilePath -> Property
-notPresent f = check (doesFileExist f) $ IOProperty (f ++ " not present") $
+notPresent f = check (doesFileExist f) $ Property (f ++ " not present") $
makeChange $ nukeFile f
+
+fileProperty :: Desc -> ([Line] -> [Line]) -> FilePath -> Property
+fileProperty desc a f = Property desc $ go =<< doesFileExist f
+ where
+ go True = do
+ ls <- lines <$> catchDefaultIO [] (readFile f)
+ let ls' = a ls
+ if ls' == ls
+ then noChange
+ else makeChange $ viaTmp writeFile f (unlines ls')
+ go False = makeChange $ writeFile f (unlines $ a [])
diff --git a/Property/GitHome.hs b/Property/GitHome.hs
index 09d21326..99402b8e 100644
--- a/Property/GitHome.hs
+++ b/Property/GitHome.hs
@@ -1,22 +1,13 @@
module Property.GitHome where
-import System.FilePath
-import System.Directory
-import Control.Applicative
-import Control.Monad
-
-import Property
-import Property.User
-import Utility.SafeCommand
-import Utility.Directory
-import Utility.Monad
-import Utility.Exception
+import Common
import qualified Property.Apt as Apt
+import Property.User
{- Clones Joey Hess's git home directory, and runs its fixups script. -}
installedFor :: UserName -> Property
installedFor user = check (not <$> hasGitDir user) $
- IOProperty ("githome " ++ user) (go =<< homedir user)
+ Property ("githome " ++ user) (go =<< homedir user)
`requires` Apt.installed ["git", "myrepos"]
where
go Nothing = noChange
diff --git a/Property/Hostname.hs b/Property/Hostname.hs
index 38e9dbe8..8bc7a6b8 100644
--- a/Property/Hostname.hs
+++ b/Property/Hostname.hs
@@ -1,8 +1,7 @@
module Property.Hostname where
-import Property
+import Common
import qualified Property.File as File
-import Utility.SafeCommand
type HostName = String
diff --git a/Property/Reboot.hs b/Property/Reboot.hs
index b6e3030e..79aa6010 100644
--- a/Property/Reboot.hs
+++ b/Property/Reboot.hs
@@ -1,6 +1,6 @@
module Property.Reboot where
-import Property
+import Common
now :: Property
now = cmdProperty "reboot" []
diff --git a/Property/Ssh.hs b/Property/Ssh.hs
index 98149bcb..1b0a6c53 100644
--- a/Property/Ssh.hs
+++ b/Property/Ssh.hs
@@ -1,14 +1,8 @@
module Property.Ssh where
-import Control.Applicative
-import Control.Monad
-import System.FilePath
-
-import Property
-import Property.User
+import Common
import qualified Property.File as File
-import Utility.SafeCommand
-import Utility.Exception
+import Property.User
sshBool :: Bool -> String
sshBool True = "yes"
@@ -48,7 +42,7 @@ uniqueHostKeys :: Property
uniqueHostKeys = flagFile prop "/etc/ssh/.unique_host_keys"
`onChange` restartSshd
where
- prop = IOProperty "ssh unique host keys" $ do
+ prop = Property "ssh unique host keys" $ do
void $ boolSystem "sh"
[ Param "-c"
, Param "rm -f /etc/ssh/ssh_host_*"
diff --git a/Property/Tor.hs b/Property/Tor.hs
index 7f7e7245..a4184edf 100644
--- a/Property/Tor.hs
+++ b/Property/Tor.hs
@@ -1,7 +1,6 @@
module Property.Tor where
-import Property
-import Utility.SafeCommand
+import Common
import qualified Property.File as File
import qualified Property.Apt as Apt
diff --git a/Property/User.hs b/Property/User.hs
index 3cd74964..733e26ea 100644
--- a/Property/User.hs
+++ b/Property/User.hs
@@ -1,13 +1,8 @@
module Property.User where
import System.Posix
-import Control.Applicative
-import Data.Maybe
-import Property
-import Utility.SafeCommand
-import Utility.Exception
-import Utility.Process
+import Common
type UserName = String