summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJoey Hess2015-01-25 14:45:14 -0400
committerJoey Hess2015-01-25 14:47:57 -0400
commite9d5d9aff1cc2046149d3e5dcd9f4ef0f2a334a1 (patch)
tree24b5bc62ac3851c317023d79080eb0ed8176cdba /src
parent334abae31277b9f47b85813d7b2fd783e5b3b12d (diff)
remove toSimpleProp
It didn't do what I thought it did with a RevertableProperty; it always returned Nothing because even if the input properties to <!> are NoInfo, it casts them to HasInfo. Even if it had worked, it lost type safety. Better to export the Property NoInfo that is used in a RevertableProperty, so it can be used directly.
Diffstat (limited to 'src')
-rw-r--r--src/Propellor/Property/Apt.hs25
-rw-r--r--src/Propellor/Property/Debootstrap.hs41
-rw-r--r--src/Propellor/Property/OS.hs4
-rw-r--r--src/Propellor/Property/Obnam.hs2
-rw-r--r--src/Propellor/Types.hs4
5 files changed, 41 insertions, 35 deletions
diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs
index d567d0ec..75c59772 100644
--- a/src/Propellor/Property/Apt.hs
+++ b/src/Propellor/Property/Apt.hs
@@ -266,17 +266,24 @@ data AptKey = AptKey
}
trustsKey :: AptKey -> RevertableProperty
-trustsKey k = trust <!> untrust
+trustsKey k = trustsKey' k <!> untrustKey k
+
+trustsKey' :: AptKey -> Property NoInfo
+trustsKey' k = check (not <$> doesFileExist f) $ property desc $ makeChange $ do
+ withHandle StdinHandle createProcessSuccess
+ (proc "gpg" ["--no-default-keyring", "--keyring", f, "--import", "-"]) $ \h -> do
+ hPutStr h (pubkey k)
+ hClose h
+ nukeFile $ f ++ "~" -- gpg dropping
where
desc = "apt trusts key " ++ keyname k
- f = "/etc/apt/trusted.gpg.d" </> keyname k ++ ".gpg"
- untrust = File.notPresent f
- trust = check (not <$> doesFileExist f) $ property desc $ makeChange $ do
- withHandle StdinHandle createProcessSuccess
- (proc "gpg" ["--no-default-keyring", "--keyring", f, "--import", "-"]) $ \h -> do
- hPutStr h (pubkey k)
- hClose h
- nukeFile $ f ++ "~" -- gpg dropping
+ f = aptKeyFile k
+
+untrustKey :: AptKey -> Property NoInfo
+untrustKey = File.notPresent . aptKeyFile
+
+aptKeyFile :: AptKey -> FilePath
+aptKeyFile k = "/etc/apt/trusted.gpg.d" </> keyname k ++ ".gpg"
-- | Cleans apt's cache of downloaded packages to avoid using up disk
-- space.
diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs
index 3feb280c..d4947ab7 100644
--- a/src/Propellor/Property/Debootstrap.hs
+++ b/src/Propellor/Property/Debootstrap.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE FlexibleContexts #-}
+
module Propellor.Property.Debootstrap (
Url,
DebootstrapConfig(..),
@@ -56,18 +58,18 @@ toParams (c1 :+ c2) = toParams c1 <> toParams c2
-- Note that reverting this property does not stop any processes
-- currently running in the chroot.
built :: FilePath -> System -> DebootstrapConfig -> RevertableProperty
-built = built' (toProp installed)
-
-built' :: Property HasInfo -> FilePath -> System -> DebootstrapConfig -> RevertableProperty
-built' installprop target system@(System _ arch) config = setup <!> teardown
+built target system config = built' (toProp installed) target system config <!> teardown
where
- setup = check (unpopulated target <||> ispartial) setupprop
- `requires` installprop
-
teardown = check (not <$> unpopulated target) teardownprop
- unpopulated d = null <$> catchDefaultIO [] (dirContents d)
+ teardownprop = property ("removed debootstrapped " ++ target) $
+ makeChange (removetarget target)
+built' :: (Combines (Property NoInfo) (Property i)) => Property i -> FilePath -> System -> DebootstrapConfig -> Property (CInfo NoInfo i)
+built' installprop target system@(System _ arch) config =
+ check (unpopulated target <||> ispartial) setupprop
+ `requires` installprop
+ where
setupprop = property ("debootstrapped " ++ target) $ liftIO $ do
createDirectoryIfMissing True target
-- Don't allow non-root users to see inside the chroot,
@@ -92,24 +94,25 @@ built' installprop target system@(System _ arch) config = setup <!> teardown
, return FailedChange
)
- teardownprop = property ("removed debootstrapped " ++ target) $
- makeChange removetarget
-
- removetarget = do
- submnts <- filter (\p -> simplifyPath p /= simplifyPath target)
- . filter (dirContains target)
- <$> mountPoints
- forM_ submnts umountLazy
- removeDirectoryRecursive target
-
-- A failed debootstrap run will leave a debootstrap directory;
-- recover by deleting it and trying again.
ispartial = ifM (doesDirectoryExist (target </> "debootstrap"))
( do
- removetarget
+ removetarget target
return True
, return False
)
+
+unpopulated :: FilePath -> IO Bool
+unpopulated d = null <$> catchDefaultIO [] (dirContents d)
+
+removetarget :: FilePath -> IO ()
+removetarget target = do
+ submnts <- filter (\p -> simplifyPath p /= simplifyPath target)
+ . filter (dirContains target)
+ <$> mountPoints
+ forM_ submnts umountLazy
+ removeDirectoryRecursive target
extractSuite :: System -> Maybe String
extractSuite (System (Debian s) _) = Just $ Apt.showSuite s
diff --git a/src/Propellor/Property/OS.hs b/src/Propellor/Property/OS.hs
index 710428d4..7a6857fb 100644
--- a/src/Propellor/Property/OS.hs
+++ b/src/Propellor/Property/OS.hs
@@ -89,10 +89,10 @@ cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $
(Just u@(System (Ubuntu _) _)) -> debootstrap u
_ -> error "os is not declared to be Debian or Ubuntu"
- debootstrap targetos = ensureProperty $ fromJust $ toSimpleProp $
+ debootstrap targetos = ensureProperty $
-- Ignore the os setting, and install debootstrap from
-- source, since we don't know what OS we're running in yet.
- Debootstrap.built' (toProp Debootstrap.sourceInstall)
+ Debootstrap.built' Debootstrap.sourceInstall
newOSDir targetos Debootstrap.DefaultConfig
-- debootstrap, I wish it was faster..
-- TODO eatmydata to speed it up
diff --git a/src/Propellor/Property/Obnam.hs b/src/Propellor/Property/Obnam.hs
index 9d283527..adaf255c 100644
--- a/src/Propellor/Property/Obnam.hs
+++ b/src/Propellor/Property/Obnam.hs
@@ -118,7 +118,7 @@ latestVersion :: Property NoInfo
latestVersion = withOS "obnam latest version" $ \o -> case o of
(Just (System (Debian suite) _)) | isStable suite -> ensureProperty $
Apt.setSourcesListD (stablesources suite) "obnam"
- `requires` (fromJust (toSimpleProp (Apt.trustsKey key)))
+ `requires` Apt.trustsKey' key
_ -> noChange
where
stablesources suite =
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index 9a0e22ab..ba63cf9d 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -179,7 +179,6 @@ class IsProp p where
-- | Sets description.
describe :: p -> Desc -> p
toProp :: p -> Property HasInfo
- toSimpleProp :: p -> Maybe (Property NoInfo)
getDesc :: p -> Desc
-- | Gets the info of the property, combined with all info
-- of all children properties.
@@ -188,7 +187,6 @@ class IsProp p where
instance IsProp (Property HasInfo) where
describe (IProperty _ a i cs) d = IProperty d a i cs
toProp = id
- toSimpleProp _ = Nothing
getDesc = propertyDesc
getInfoRecursive (IProperty _ _ i cs) =
i <> mconcat (map getInfoRecursive cs)
@@ -196,7 +194,6 @@ instance IsProp (Property NoInfo) where
describe (SProperty _ a cs) d = SProperty d a cs
toProp = toIProperty
getDesc = propertyDesc
- toSimpleProp = Just
getInfoRecursive _ = mempty
instance IsProp RevertableProperty where
@@ -205,7 +202,6 @@ instance IsProp RevertableProperty where
RevertableProperty (describe p1 d) (describe p2 ("not " ++ d))
getDesc (RevertableProperty p1 _) = getDesc p1
toProp (RevertableProperty p1 _) = p1
- toSimpleProp = toSimpleProp . toProp
-- | Return the Info of the currently active side.
getInfoRecursive (RevertableProperty p1 _p2) = getInfoRecursive p1