summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/Debootstrap.hs
diff options
context:
space:
mode:
authorJoey Hess2016-03-25 16:04:31 -0400
committerJoey Hess2016-03-25 16:04:31 -0400
commit4694a4c36cca1c7b52421297a62548d8bbb2ec0b (patch)
tree1e01ac4a71ce151c017f5f7d9e8feeb76059f3a9 /src/Propellor/Property/Debootstrap.hs
parente28f49b7d1ae361e42809977bf12d3f126c3d90d (diff)
continued porting
Diffstat (limited to 'src/Propellor/Property/Debootstrap.hs')
-rw-r--r--src/Propellor/Property/Debootstrap.hs31
1 files changed, 17 insertions, 14 deletions
diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs
index 5716be38..7cbf3d98 100644
--- a/src/Propellor/Property/Debootstrap.hs
+++ b/src/Propellor/Property/Debootstrap.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE FlexibleContexts #-}
-
module Propellor.Property.Debootstrap (
Url,
DebootstrapConfig(..),
@@ -48,14 +46,15 @@ toParams (c1 :+ c2) = toParams c1 <> toParams c2
--
-- The System can be any OS and architecture that debootstrap
-- and the kernel support.
-built :: FilePath -> System -> DebootstrapConfig -> Property HasInfo
-built target system config = built' (toProp installed) target system config
+built :: FilePath -> System -> DebootstrapConfig -> Property Linux
+built target system config = built' (setupRevertableProperty installed) target system config
-built' :: (Combines (Property NoInfo) (Property i)) => Property i -> FilePath -> System -> DebootstrapConfig -> Property (CInfo NoInfo i)
+built' :: Property Linux -> FilePath -> System -> DebootstrapConfig -> Property Linux
built' installprop target system@(System _ arch) config =
check (unpopulated target <||> ispartial) setupprop
`requires` installprop
where
+ setupprop :: Property Linux
setupprop = property ("debootstrapped " ++ target) $ liftIO $ do
createDirectoryIfMissing True target
-- Don't allow non-root users to see inside the chroot,
@@ -99,20 +98,21 @@ extractSuite (System (FreeBSD _) _) = Nothing
-- When necessary, falls back to installing debootstrap from source.
-- Note that installation from source is done by downloading the tarball
-- from a Debian mirror, with no cryptographic verification.
-installed :: RevertableProperty NoInfo
+installed :: RevertableProperty Linux Linux
installed = install <!> remove
where
- install = withOS "debootstrap installed" $ \o ->
+ install = withOS "debootstrap installed" $ \o os ->
ifM (liftIO $ isJust <$> programPath)
( return NoChange
- , ensureProperty (installon o)
+ , ensureProperty o (installon os)
)
installon (Just (System (Debian _) _)) = aptinstall
installon (Just (System (Buntish _) _)) = aptinstall
installon _ = sourceInstall
- remove = withOS "debootstrap removed" $ ensureProperty . removefrom
+ remove = withOS "debootstrap removed" $ \o os ->
+ ensureProperty o (removefrom os)
removefrom (Just (System (Debian _) _)) = aptremove
removefrom (Just (System (Buntish _) _)) = aptremove
removefrom _ = sourceRemove
@@ -120,18 +120,21 @@ installed = install <!> remove
aptinstall = Apt.installed ["debootstrap"]
aptremove = Apt.removed ["debootstrap"]
-sourceInstall :: Property NoInfo
-sourceInstall = property "debootstrap installed from source" (liftIO sourceInstall')
+sourceInstall :: Property Linux
+sourceInstall = go
`requires` perlInstalled
`requires` arInstalled
+ where
+ go :: Property Linux
+ go = property "debootstrap installed from source" (liftIO sourceInstall')
-perlInstalled :: Property NoInfo
+perlInstalled :: Property Linux
perlInstalled = check (not <$> inPath "perl") $ property "perl installed" $
liftIO $ toResult . isJust <$> firstM id
[ yumInstall "perl"
]
-arInstalled :: Property NoInfo
+arInstalled :: Property Linux
arInstalled = check (not <$> inPath "ar") $ property "ar installed" $
liftIO $ toResult . isJust <$> firstM id
[ yumInstall "binutils"
@@ -175,7 +178,7 @@ sourceInstall' = withTmpDir "debootstrap" $ \tmpd -> do
return MadeChange
_ -> errorMessage "debootstrap tar file did not contain exactly one dirctory"
-sourceRemove :: Property NoInfo
+sourceRemove :: Property Linux
sourceRemove = property "debootstrap not installed from source" $ liftIO $
ifM (doesDirectoryExist sourceInstallDir)
( do