summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/Apt.hs
diff options
context:
space:
mode:
authorJoey Hess2014-10-10 11:27:54 -0400
committerJoey Hess2014-10-10 11:27:54 -0400
commit79ee61d958cdea43aec9ce7e63cbe88254641472 (patch)
tree3e37882a29c8b6ff7637533153456bec0737a662 /src/Propellor/Property/Apt.hs
parent1e22e178b4080e70efc262e42943e615abfdb3b9 (diff)
stable suite changes
* Avoid encoding the current stable suite in propellor's code, since that poses a difficult transition around the release, and can easily be wrong if an older version of propellor is used. Instead, the os property for a stable system includes the suite name to use, eg Stable "wheezy". * stdSourcesList uses the stable suite name, to avoid unwanted immediate upgrades to the next stable release.
Diffstat (limited to 'src/Propellor/Property/Apt.hs')
-rw-r--r--src/Propellor/Property/Apt.hs32
1 files changed, 19 insertions, 13 deletions
diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs
index 7e02a335..d82eaed3 100644
--- a/src/Propellor/Property/Apt.hs
+++ b/src/Propellor/Property/Apt.hs
@@ -20,14 +20,14 @@ type Section = String
type SourcesGenerator = DebianSuite -> [Line]
showSuite :: DebianSuite -> String
-showSuite Stable = "stable"
+showSuite (Stable s) = s
showSuite Testing = "testing"
showSuite Unstable = "unstable"
showSuite Experimental = "experimental"
-showSuite (DebianRelease r) = r
-backportSuite :: String
-backportSuite = showSuite stableRelease ++ "-backports"
+backportSuite :: DebianSuite -> Maybe String
+backportSuite (Stable s) = Just (s ++ "-backports")
+backportSuite _ = Nothing
debLine :: String -> Url -> [Section] -> Line
debLine suite mirror sections = unwords $
@@ -42,12 +42,17 @@ stdSections :: [Section]
stdSections = ["main", "contrib", "non-free"]
binandsrc :: String -> SourcesGenerator
-binandsrc url suite
- | isStable suite = [l, srcLine l, bl, srcLine bl]
- | otherwise = [l, srcLine l]
+binandsrc url suite = catMaybes
+ [ Just l
+ , Just $ srcLine l
+ , bl
+ , srcLine <$> bl
+ ]
where
l = debLine (showSuite suite) url stdSections
- bl = debLine backportSuite url stdSections
+ bl = do
+ bs <- backportSuite suite
+ return $ debLine bs url stdSections
debCdn :: SourcesGenerator
debCdn = binandsrc "http://cdn.debian.net/debian"
@@ -128,13 +133,14 @@ installed' params ps = robustly $ check (isInstallable ps) go
installedBackport :: [Package] -> Property
installedBackport ps = trivial $ withOS desc $ \o -> case o of
Nothing -> error "cannot install backports; os not declared"
- (Just (System (Debian suite) _))
- | isStable suite ->
- ensureProperty $ runApt $
- ["install", "-t", backportSuite, "-y"] ++ ps
- _ -> error $ "backports not supported on " ++ show o
+ (Just (System (Debian suite) _)) -> case backportSuite suite of
+ Nothing -> notsupported o
+ Just bs -> ensureProperty $ runApt $
+ ["install", "-t", bs, "-y"] ++ ps
+ _ -> notsupported o
where
desc = (unwords $ "apt installed backport":ps)
+ notsupported o = error $ "backports not supported on " ++ show o
-- | Minimal install of package, without recommends.
installedMin :: [Package] -> Property