summaryrefslogtreecommitdiff
path: root/src/Propellor
diff options
context:
space:
mode:
authorFĂ©lix Sipma2016-05-24 12:57:44 +0200
committerJoey Hess2016-06-13 23:24:16 -0400
commit6b4432c5884d7187140d5fde771444f7c8301438 (patch)
tree602119ae6d239e59fc9b6679c9dc4d7308aea0e6 /src/Propellor
parenta0ef4e9e957cd11c53df66ce2e8c3f8e716f5501 (diff)
convert Architecture to a sumtype
TODO: remove ANDROID (used in GitAnnexBuilder) TODO: add other architectures TODO: rename ARMHF TODO: rename ARMEL (cherry picked from commit 6f36f6cade4e1d8b15c714565e223562c6573099)
Diffstat (limited to 'src/Propellor')
-rw-r--r--src/Propellor/DotDir.hs14
-rw-r--r--src/Propellor/Info.hs2
-rw-r--r--src/Propellor/Property/Chroot.hs2
-rw-r--r--src/Propellor/Property/DebianMirror.hs2
-rw-r--r--src/Propellor/Property/Debootstrap.hs2
-rw-r--r--src/Propellor/Property/DiskImage.hs38
-rw-r--r--src/Propellor/Property/FreeBSD/Poudriere.hs11
-rw-r--r--src/Propellor/Property/OS.hs24
-rw-r--r--src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs26
-rw-r--r--src/Propellor/Property/Systemd.hs8
-rw-r--r--src/Propellor/Types/OS.hs17
11 files changed, 79 insertions, 67 deletions
diff --git a/src/Propellor/DotDir.hs b/src/Propellor/DotDir.hs
index 79b0b43f..c73420b0 100644
--- a/src/Propellor/DotDir.hs
+++ b/src/Propellor/DotDir.hs
@@ -166,7 +166,7 @@ setup = do
buildPropellor Nothing
sayLn ""
sayLn "Great! Propellor is bootstrapped."
-
+
section
sayLn "Propellor can use gpg to encrypt private data about the systems it manages,"
sayLn "and to sign git commits."
@@ -273,7 +273,7 @@ minimalConfig = do
, " Extensions: TypeOperators"
, " Build-Depends: propellor >= 3.0, base >= 3"
]
- configcontent =
+ configcontent =
[ "-- This is the main configuration file for Propellor, and is used to build"
, "-- the propellor program. https://propellor.branchable.com/"
, ""
@@ -295,7 +295,7 @@ minimalConfig = do
, "-- An example host."
, "mybox :: Host"
, "mybox = host \"mybox.example.com\" $ props"
- , " & osDebian Unstable \"amd64\""
+ , " & osDebian Unstable X86_64"
, " & Apt.stdSourcesList"
, " & Apt.unattendedUpgrades"
, " & Apt.installed [\"etckeeper\"]"
@@ -354,7 +354,7 @@ checkRepoUpToDate :: IO ()
checkRepoUpToDate = whenM (gitbundleavail <&&> dotpropellorpopulated) $ do
headrev <- takeWhile (/= '\n') <$> readFile disthead
changeWorkingDirectory =<< dotPropellor
- headknown <- catchMaybeIO $
+ headknown <- catchMaybeIO $
withQuietOutput createProcessSuccess $
proc "git" ["log", headrev]
if (headknown == Nothing)
@@ -397,19 +397,19 @@ setupUpstreamMaster newref = do
let cleantmprepo = void $ catchMaybeIO $ removeDirectoryRecursive tmprepo
cleantmprepo
git ["clone", "--quiet", ".", tmprepo]
-
+
changeWorkingDirectory tmprepo
git ["fetch", distrepo, "--quiet"]
git ["reset", "--hard", oldref, "--quiet"]
git ["merge", newref, "-s", "recursive", "-Xtheirs", "--quiet", "-m", "merging upstream version"]
-
+
void $ fetchUpstreamBranch tmprepo
cleantmprepo
warnoutofdate True
getoldrev = takeWhile (/= '\n')
<$> readProcess "git" ["show-ref", upstreambranch, "--hash"]
-
+
git = run "git"
run cmd ps = unlessM (boolSystem cmd (map Param ps)) $
error $ "Failed to run " ++ cmd ++ " " ++ show ps
diff --git a/src/Propellor/Info.hs b/src/Propellor/Info.hs
index b87369c3..f6c46192 100644
--- a/src/Propellor/Info.hs
+++ b/src/Propellor/Info.hs
@@ -77,7 +77,7 @@ askInfo = asks (fromInfo . hostInfo)
-- It also lets the type checker know that all the properties of the
-- host must support Debian.
--
--- > & osDebian (Stable "jessie") "amd64"
+-- > & osDebian (Stable "jessie") X86_64
osDebian :: DebianSuite -> Architecture -> Property (HasInfo + Debian)
osDebian suite arch = tightenTargets $ os (System (Debian suite) arch)
diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs
index 09047ce5..bcb7ff47 100644
--- a/src/Propellor/Property/Chroot.hs
+++ b/src/Propellor/Property/Chroot.hs
@@ -105,7 +105,7 @@ instance ChrootBootstrapper Debootstrapped where
-- to bootstrap.
--
-- > debootstrapped Debootstrap.BuildD "/srv/chroot/ghc-dev" $ props
--- > & osDebian Unstable "amd64"
+-- > & osDebian Unstable X86_64
-- > & Apt.installed ["ghc", "haskell-platform"]
-- > & ...
debootstrapped :: Debootstrap.DebootstrapConfig -> FilePath -> Props metatypes -> Chroot
diff --git a/src/Propellor/Property/DebianMirror.hs b/src/Propellor/Property/DebianMirror.hs
index b86d8e0b..d8a9c423 100644
--- a/src/Propellor/Property/DebianMirror.hs
+++ b/src/Propellor/Property/DebianMirror.hs
@@ -141,7 +141,7 @@ mirror mirror' = propertyList ("Debian mirror " ++ dir) $ props
rsyncextraarg res = intercalate "," $ map showRsyncExtra res
args =
[ "--dist" , suitearg
- , "--arch", architecturearg $ _debianMirrorArchitectures mirror'
+ , "--arch", architecturearg $ map architectureToDebianArchString (_debianMirrorArchitectures mirror')
, "--section", intercalate "," $ _debianMirrorSections mirror'
, "--limit-priority", "\"" ++ priorityRegex (_debianMirrorPriorities mirror') ++ "\""
]
diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs
index 87f30776..1503f223 100644
--- a/src/Propellor/Property/Debootstrap.hs
+++ b/src/Propellor/Property/Debootstrap.hs
@@ -67,7 +67,7 @@ built' installprop target system@(System _ arch) config =
Nothing -> errorMessage $ "don't know how to debootstrap " ++ show system
Just s -> pure s
let params = toParams config ++
- [ Param $ "--arch=" ++ arch
+ [ Param $ "--arch=" ++ architectureToDebianArchString arch
, Param suite
, Param target
]
diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs
index afeaa287..06dfa69c 100644
--- a/src/Propellor/Property/DiskImage.hs
+++ b/src/Propellor/Property/DiskImage.hs
@@ -1,4 +1,4 @@
--- | Disk image generation.
+-- | Disk image generation.
--
-- This module is designed to be imported unqualified.
@@ -56,7 +56,7 @@ type DiskImage = FilePath
-- > import Propellor.Property.DiskImage
--
-- > let chroot d = Chroot.debootstrapped mempty d
--- > & osDebian Unstable "amd64"
+-- > & osDebian Unstable X86_64
-- > & Apt.installed ["linux-image-amd64"]
-- > & User.hasPassword (User "root")
-- > & User.accountFor (User "demo")
@@ -91,7 +91,7 @@ imageRebuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -
imageRebuilt = imageBuilt' True
imageBuilt' :: Bool -> DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty (HasInfo + Linux) Linux
-imageBuilt' rebuild img mkchroot tabletype final partspec =
+imageBuilt' rebuild img mkchroot tabletype final partspec =
imageBuiltFrom img chrootdir tabletype final partspec
`requires` Chroot.provisioned chroot
`requires` (cleanrebuild <!> (doNothing :: Property UnixLike))
@@ -132,7 +132,7 @@ imageBuiltFrom img chrootdir tabletype final partspec = mkimg <!> rmimg
-- unmount helper filesystems such as proc from the chroot
-- before getting sizes
liftIO $ unmountBelow chrootdir
- szm <- M.mapKeys (toSysDir chrootdir) . M.map toPartSize
+ szm <- M.mapKeys (toSysDir chrootdir) . M.map toPartSize
<$> liftIO (dirSizes chrootdir)
let calcsz mnts = maybe defSz fudge . getMountSz szm mnts
-- tie the knot!
@@ -151,7 +151,7 @@ imageBuiltFrom img chrootdir tabletype final partspec = mkimg <!> rmimg
rmimg = File.notPresent img
partitionsPopulated :: FilePath -> [Maybe MountPoint] -> [MountOpts] -> [LoopDev] -> Property Linux
-partitionsPopulated chrootdir mnts mntopts devs = property' desc $ \w ->
+partitionsPopulated chrootdir mnts mntopts devs = property' desc $ \w ->
mconcat $ zipWith3 (go w) mnts mntopts devs
where
desc = "partitions populated from " ++ chrootdir
@@ -165,11 +165,11 @@ partitionsPopulated chrootdir mnts mntopts devs = property' desc $ \w ->
syncDirFiltered (filtersfor mnt) (chrootdir ++ mnt) tmpdir
else return FailedChange
- filtersfor mnt =
+ filtersfor mnt =
let childmnts = map (drop (length (dropTrailingPathSeparator mnt))) $
filter (\m -> m /= mnt && addTrailingPathSeparator mnt `isPrefixOf` m)
(catMaybes mnts)
- in concatMap (\m ->
+ in concatMap (\m ->
-- Include the child mount point, but exclude its contents.
[ Include (Pattern m)
, Exclude (filesUnder m)
@@ -185,8 +185,8 @@ fitChrootSize tt l basesizes = (mounts, mountopts, parttable)
(mounts, mountopts, sizers) = unzip3 l
parttable = PartTable tt (zipWith id sizers basesizes)
--- | Generates a map of the sizes of the contents of
--- every directory in a filesystem tree.
+-- | Generates a map of the sizes of the contents of
+-- every directory in a filesystem tree.
--
-- (Hard links are counted multiple times for simplicity)
--
@@ -201,7 +201,7 @@ dirSizes top = go M.empty top [top]
if isDirectory s
then do
subm <- go M.empty i =<< dirContents i
- let sz' = M.foldr' (+) sz
+ let sz' = M.foldr' (+) sz
(M.filterWithKey (const . subdirof i) subm)
go (M.insertWith (+) i sz' (M.union m subm)) dir is
else go (M.insertWith (+) dir sz m) dir is
@@ -209,13 +209,13 @@ dirSizes top = go M.empty top [top]
getMountSz :: (M.Map FilePath PartSize) -> [Maybe MountPoint] -> Maybe MountPoint -> Maybe PartSize
getMountSz _ _ Nothing = Nothing
-getMountSz szm l (Just mntpt) =
+getMountSz szm l (Just mntpt) =
fmap (`reducePartSize` childsz) (M.lookup mntpt szm)
where
childsz = mconcat $ mapMaybe (getMountSz szm l) (filter (isChild mntpt) l)
-- | Ensures that a disk image file of the specified size exists.
---
+--
-- If the file doesn't exist, or is too small, creates a new one, full of 0's.
--
-- If the file is too large, truncates it down to the specified size.
@@ -223,7 +223,7 @@ imageExists :: FilePath -> ByteSize -> Property Linux
imageExists img sz = property ("disk image exists" ++ img) $ liftIO $ do
ms <- catchMaybeIO $ getFileStatus img
case ms of
- Just s
+ Just s
| toInteger (fileSize s) == toInteger sz -> return NoChange
| toInteger (fileSize s) > toInteger sz -> do
setFileSize img (fromInteger sz)
@@ -239,15 +239,15 @@ imageExists img sz = property ("disk image exists" ++ img) $ liftIO $ do
-- with its populated partition tree mounted in the provided
-- location from the provided loop devices. This will typically
-- take care of installing the boot loader to the image.
---
+--
-- It's ok if the second property leaves additional things mounted
-- in the partition tree.
type Finalization = (Property Linux, (FilePath -> [LoopDev] -> Property Linux))
imageFinalized :: Finalization -> [Maybe MountPoint] -> [MountOpts] -> [LoopDev] -> PartTable -> Property Linux
-imageFinalized (_, final) mnts mntopts devs (PartTable _ parts) =
+imageFinalized (_, final) mnts mntopts devs (PartTable _ parts) =
property' "disk image finalized" $ \w ->
- withTmpDir "mnt" $ \top ->
+ withTmpDir "mnt" $ \top ->
go w top `finally` liftIO (unmountall top)
where
go w top = do
@@ -255,12 +255,12 @@ imageFinalized (_, final) mnts mntopts devs (PartTable _ parts) =
liftIO $ writefstab top
liftIO $ allowservices top
ensureProperty w $ final top devs
-
+
-- Ordered lexographically by mount point, so / comes before /usr
-- comes before /usr/local
orderedmntsdevs :: [(Maybe MountPoint, (MountOpts, LoopDev))]
orderedmntsdevs = sortBy (compare `on` fst) $ zip mnts (zip mntopts devs)
-
+
swaps = map (SwapPartition . partitionLoopDev . snd) $
filter ((== LinuxSwap) . partFs . fst) $
zip parts devs
@@ -276,7 +276,7 @@ imageFinalized (_, final) mnts mntopts devs (PartTable _ parts) =
unmountall top = do
unmountBelow top
umountLazy top
-
+
writefstab top = do
let fstab = top ++ "/etc/fstab"
old <- catchDefaultIO [] $ filter (not . unconfigured) . lines
diff --git a/src/Propellor/Property/FreeBSD/Poudriere.hs b/src/Propellor/Property/FreeBSD/Poudriere.hs
index fcad9e87..58477468 100644
--- a/src/Propellor/Property/FreeBSD/Poudriere.hs
+++ b/src/Propellor/Property/FreeBSD/Poudriere.hs
@@ -9,7 +9,6 @@ module Propellor.Property.FreeBSD.Poudriere where
import Propellor.Base
import Propellor.Types.Info
import Data.List
-import Data.String (IsString(..))
import qualified Propellor.Property.FreeBSD.Pkg as Pkg
import qualified Propellor.Property.ZFS as ZFS
@@ -27,7 +26,7 @@ poudriereConfigured :: PoudriereConfigured -> Bool
poudriereConfigured (PoudriereConfigured _) = True
setConfigured :: Property (HasInfo + FreeBSD)
-setConfigured = tightenTargets $
+setConfigured = tightenTargets $
pureInfoProperty "Poudriere Configured" (PoudriereConfigured "")
poudriere :: Poudriere -> Property (HasInfo + FreeBSD)
@@ -106,10 +105,10 @@ instance Show PoudriereArch where
show I386 = "i386"
show AMD64 = "amd64"
-instance IsString PoudriereArch where
- fromString "i386" = I386
- fromString "amd64" = AMD64
- fromString _ = error "Not a valid Poudriere architecture."
+fromArchitecture :: Architecture -> PoudriereArch
+fromArchitecture X86_64 = AMD64
+fromArchitecture X86_32 = I386
+fromArchitecture _ = error "Not a valid Poudriere architecture."
yesNoProp :: Bool -> String
yesNoProp b = if b then "yes" else "no"
diff --git a/src/Propellor/Property/OS.hs b/src/Propellor/Property/OS.hs
index 5a3ccc70..f651ed52 100644
--- a/src/Propellor/Property/OS.hs
+++ b/src/Propellor/Property/OS.hs
@@ -22,7 +22,7 @@ import Control.Exception (throw)
-- | Replaces whatever OS was installed before with a clean installation
-- of the OS that the Host is configured to have.
---
+--
-- This is experimental; use with caution!
--
-- This can replace one Linux distribution with different one.
@@ -35,7 +35,7 @@ import Control.Exception (throw)
-- This property only runs once. The cleanly installed system will have
-- a file </etc/propellor-cleaninstall>, which indicates it was cleanly
-- installed.
---
+--
-- The files from the old os will be left in </old-os>
--
-- After the OS is installed, and if all properties of the host have
@@ -46,7 +46,7 @@ import Control.Exception (throw)
-- install succeeds, to bootstrap from the cleanly installed system to
-- a fully working system. For example:
--
--- > & osDebian Unstable "amd64"
+-- > & osDebian Unstable X86_64
-- > & cleanInstallOnce (Confirmed "foo.example.com")
-- > `onChange` propertyList "fixing up after clean install"
-- > [ preserveNetwork
@@ -68,7 +68,7 @@ cleanInstallOnce :: Confirmation -> Property Linux
cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $
go `requires` confirmed "clean install confirmed" confirmation
where
- go =
+ go =
finalized
`requires`
-- easy to forget and system may not boot without shadow pw!
@@ -90,14 +90,14 @@ cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $
(Just u@(System (Buntish _) _)) -> ensureProperty w $
debootstrap u
_ -> unsupportedOS'
-
+
debootstrap :: System -> Property Linux
debootstrap targetos =
-- Install debootstrap from source, since we don't know
-- what OS we're currently running in.
Debootstrap.built' Debootstrap.sourceInstall
newOSDir targetos Debootstrap.DefaultConfig
- -- debootstrap, I wish it was faster..
+ -- debootstrap, I wish it was faster..
-- TODO eatmydata to speed it up
-- Problem: Installing eatmydata on some random OS like
-- Fedora may be difficult. Maybe configure dpkg to not
@@ -120,7 +120,7 @@ cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $
createDirectoryIfMissing True oldOSDir
massRename (renamesout ++ renamesin)
removeDirectoryRecursive newOSDir
-
+
-- Prepare environment for running additional properties,
-- overriding old OS's environment.
void $ setEnv "PATH" stdPATH True
@@ -150,15 +150,15 @@ cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $
-- git repo url, which all need to be arranged to
-- be present in /old-os's /usr/local/propellor)
-- TODO
-
+
finalized :: Property UnixLike
finalized = property "clean OS installed" $ do
liftIO $ writeFile flagfile ""
return MadeChange
flagfile = "/etc/propellor-cleaninstall"
-
- trickydirs =
+
+ trickydirs =
-- /tmp can contain X's sockets, which prevent moving it
-- so it's left as-is.
[ "/tmp"
@@ -195,7 +195,7 @@ confirmed desc (Confirmed c) = property desc $ do
return FailedChange
else return NoChange
--- | </etc/network/interfaces> is configured to bring up the network
+-- | </etc/network/interfaces> is configured to bring up the network
-- interface that currently has a default route configured, using
-- the same (static) IP address.
preserveNetwork :: Property DebianLike
@@ -210,7 +210,7 @@ preserveNetwork = go `requires` Network.cleanInterfacesFile
ensureProperty w $ Network.static iface
_ -> do
warningMessage "did not find any default ipv4 route"
- return FailedChange
+ return FailedChange
-- | </etc/resolv.conf> is copied from the old OS
preserveResolvConf :: Property Linux
diff --git a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
index b4812c7e..bd596298 100644
--- a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
+++ b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
@@ -32,7 +32,7 @@ autobuilder arch crontimes timeout = combineProperties "gitannexbuilder" $ props
("git pull ; timeout " ++ timeout ++ " ./autobuild")
& rsyncpassword
where
- context = Context ("gitannexbuilder " ++ arch)
+ context = Context ("gitannexbuilder " ++ architectureToDebianArchString arch)
pwfile = homedir </> "rsyncpassword"
-- The builduser account does not have a password set,
-- instead use the password privdata to hold the rsync server
@@ -55,11 +55,11 @@ tree buildarch flavor = combineProperties "gitannexbuilder tree" $ props
& gitannexbuildercloned
& builddircloned
where
- gitannexbuildercloned = check (not <$> (doesDirectoryExist (gitbuilderdir </> ".git"))) $
+ gitannexbuildercloned = check (not <$> (doesDirectoryExist (gitbuilderdir </> ".git"))) $
userScriptProperty (User builduser)
[ "git clone git://git.kitenet.net/gitannexbuilder " ++ gitbuilderdir
, "cd " ++ gitbuilderdir
- , "git checkout " ++ buildarch ++ fromMaybe "" flavor
+ , "git checkout " ++ architectureToDebianArchString buildarch ++ fromMaybe "" flavor
]
`assume` MadeChange
`describe` "gitbuilder setup"
@@ -85,7 +85,7 @@ buildDepsNoHaskellLibs = Apt.installed
]
haskellPkgsInstalled :: String -> Property DebianLike
-haskellPkgsInstalled dir = tightenTargets $
+haskellPkgsInstalled dir = tightenTargets $
flagFile go ("/haskellpkgsinstalled")
where
go = userScriptProperty (User builduser)
@@ -109,7 +109,7 @@ autoBuilderContainer mkprop suite arch flavor crontime timeout =
& mkprop suite arch flavor
& autobuilder arch crontime timeout
where
- name = arch ++ fromMaybe "" flavor ++ "-git-annex-builder"
+ name = architectureToDebianArchString arch ++ fromMaybe "" flavor ++ "-git-annex-builder"
type Flavor = Maybe String
@@ -141,15 +141,15 @@ stackAutoBuilder suite arch flavor =
stackInstalled :: Property Linux
stackInstalled = withOS "stack installed" $ \w o ->
case o of
- (Just (System (Debian (Stable "jessie")) "i386")) ->
- ensureProperty w $ manualinstall "i386"
+ (Just (System (Debian (Stable "jessie")) X86_32)) ->
+ ensureProperty w $ manualinstall X86_32
_ -> ensureProperty w $ Apt.installed ["haskell-stack"]
where
-- Warning: Using a binary downloaded w/o validation.
manualinstall :: Architecture -> Property Linux
manualinstall arch = tightenTargets $ check (not <$> doesFileExist binstack) $
propertyList "stack installed from upstream tarball" $ props
- & cmdProperty "wget" ["https://www.stackage.org/stack/linux-" ++ arch, "-O", tmptar]
+ & cmdProperty "wget" ["https://www.stackage.org/stack/linux-" ++ architectureToDebianArchString arch, "-O", tmptar]
`assume` MadeChange
& File.dirExists tmpdir
& cmdProperty "tar" ["xf", tmptar, "-C", tmpdir, "--strip-components=1"]
@@ -163,7 +163,7 @@ stackInstalled = withOS "stack installed" $ \w o ->
tmpdir = "/root/stack"
armAutoBuilder :: DebianSuite -> Architecture -> Flavor -> Property (HasInfo + Debian)
-armAutoBuilder suite arch flavor =
+armAutoBuilder suite arch flavor =
propertyList "arm git-annex autobuilder" $ props
& standardAutoBuilder suite arch flavor
& buildDepsNoHaskellLibs
@@ -177,7 +177,7 @@ armAutoBuilder suite arch flavor =
androidAutoBuilderContainer :: Times -> TimeOut -> Systemd.Container
androidAutoBuilderContainer crontimes timeout =
androidAutoBuilderContainer' "android-git-annex-builder"
- (tree "android" Nothing) builddir crontimes timeout
+ (tree ANDROID Nothing) builddir crontimes timeout
-- Android is cross-built in a Debian i386 container, using the Android NDK.
androidAutoBuilderContainer'
@@ -187,9 +187,9 @@ androidAutoBuilderContainer'
-> Times
-> TimeOut
-> Systemd.Container
-androidAutoBuilderContainer' name setupgitannexdir gitannexdir crontimes timeout =
+androidAutoBuilderContainer' name setupgitannexdir gitannexdir crontimes timeout =
Systemd.container name $ \d -> bootstrap d $ props
- & osDebian (Stable "jessie") "i386"
+ & osDebian (Stable "jessie") X86_32
& Apt.stdSourcesList
& User.accountFor (User builduser)
& File.dirExists gitbuilderdir
@@ -199,7 +199,7 @@ androidAutoBuilderContainer' name setupgitannexdir gitannexdir crontimes timeout
& haskellPkgsInstalled "android"
& Apt.unattendedUpgrades
& buildDepsNoHaskellLibs
- & autobuilder "android" crontimes timeout
+ & autobuilder ANDROID crontimes timeout
where
-- Use git-annex's android chroot setup script, which will install
-- ghc-android and the NDK, all build deps, etc, in the home
diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs
index e11c991e..dd7dfe05 100644
--- a/src/Propellor/Property/Systemd.hs
+++ b/src/Propellor/Property/Systemd.hs
@@ -217,11 +217,11 @@ machined = withOS "machined installed" $ \w o ->
-- to bootstrap.
--
-- > container "webserver" $ \d -> Chroot.debootstrapped mempty d $ props
--- > & osDebian Unstable "amd64"
+-- > & osDebian Unstable X86_64
-- > & Apt.installedRunning "apache2"
-- > & ...
container :: MachineName -> (FilePath -> Chroot.Chroot) -> Container
-container name mkchroot =
+container name mkchroot =
let c = Container name chroot h
in setContainerProps c $ containerProps c
&^ resolvConfed
@@ -238,7 +238,7 @@ container name mkchroot =
-- to bootstrap.
--
-- > debContainer "webserver" $ props
--- > & osDebian Unstable "amd64"
+-- > & osDebian Unstable X86_64
-- > & Apt.installedRunning "apache2"
-- > & ...
debContainer :: MachineName -> Props metatypes -> Container
@@ -447,7 +447,7 @@ instance Publishable (Proto, Bound Port) where
-- >
-- > webserver :: Systemd.container
-- > webserver = Systemd.container "webserver" (Chroot.debootstrapped mempty)
--- > & os (System (Debian Testing) "amd64")
+-- > & os (System (Debian Testing) X86_64)
-- > & Systemd.privateNetwork
-- > & Systemd.running Systemd.networkd
-- > & Systemd.publish (Port 80 ->- Port 8080)
diff --git a/src/Propellor/Types/OS.hs b/src/Propellor/Types/OS.hs
index d7df5490..662983b2 100644
--- a/src/Propellor/Types/OS.hs
+++ b/src/Propellor/Types/OS.hs
@@ -9,7 +9,8 @@ module Propellor.Types.OS (
FBSDVersion(..),
isStable,
Release,
- Architecture,
+ Architecture(..),
+ architectureToDebianArchString,
HostName,
UserName,
User(..),
@@ -75,7 +76,19 @@ isStable (Stable _) = True
isStable _ = False
type Release = String
-type Architecture = String
+data Architecture = X86_64 | X86_32 | ARMHF | ARMEL | ANDROID
+ deriving (Show, Eq)
+-- TODO: remove ANDROID (used in GitAnnexBuilder)
+-- TODO: add other architectures
+-- TODO: rename ARMHF
+-- TODO: rename ARMEL
+
+architectureToDebianArchString :: Architecture -> String
+architectureToDebianArchString X86_64 = "amd64"
+architectureToDebianArchString X86_32 = "i386"
+architectureToDebianArchString ARMHF = "armhf"
+architectureToDebianArchString ARMEL = "armel"
+architectureToDebianArchString ANDROID = "android"
type UserName = String