propellor 4.4.0 → 4.5.0

raw patch · 10 files changed

+332/−209 lines, 10 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG +12/−0
• debian/changelog +12/−0
• joeyconfig.hs +2/−0
• propellor.cabal +3/−1
• src/Propellor/Property/DiskImage.hs +10/−10
• src/Propellor/Property/DiskImage/PartSpec.hs +12/−72
• src/Propellor/Property/Parted.hs +78/−120
• src/Propellor/Property/Parted/Types.hs +119/−0
• src/Propellor/Property/Versioned.hs +18/−6
• src/Propellor/Types/PartSpec.hs +66/−0

@@ -1,3 +1,15 @@+propellor (4.5.0) unstable; urgency=medium++  * Generalized the PartSpec DSL, so it can be used for both+    disk image partitioning, and disk device partitioning, with+    different partition sizing methods as appropriate for the different+    uses. (minor API change)+  * Propellor.Property.Parted: Added calcPartTable function which uses+    PartSpec DiskPart, and a useDiskSpace combinator.+  * Generate a better description for versioned properties.++ -- Joey Hess <id@joeyh.name>  Fri, 21 Jul 2017 16:40:13 -0400+ propellor (4.4.0) unstable; urgency=medium    * Propellor.Property.Timezone: New module, contributed by Sean Whitton.

@@ -1,3 +1,15 @@+propellor (4.5.0) unstable; urgency=medium++  * Generalized the PartSpec DSL, so it can be used for both+    disk image partitioning, and disk device partitioning, with+    different partition sizing methods as appropriate for the different+    uses. (minor API change)+  * Propellor.Property.Parted: Added calcPartTable function which uses+    PartSpec DiskPart, and a useDiskSpace combinator.+  * Generate a better description for versioned properties.++ -- Joey Hess <id@joeyh.name>  Fri, 21 Jul 2017 16:40:13 -0400+ propellor (4.4.0) unstable; urgency=medium    * Propellor.Property.Timezone: New module, contributed by Sean Whitton.

@@ -83,6 +83,8 @@ 	& ipv6 "2001:4830:1600:187::2" 	& Aiccu.hasConfig "T18376" "JHZ2-SIXXS" +	& User.nuked (User "nosuchuser") User.YesReallyDeleteHome+ 	& JoeySites.dkimMilter 	& JoeySites.postfixSaslPasswordClient 	-- & JoeySites.alarmClock "*-*-* 7:30" (User "joey")

@@ -1,5 +1,5 @@ Name: propellor-Version: 4.4.0+Version: 4.5.0 Cabal-Version: >= 1.20 License: BSD2 Maintainer: Joey Hess <id@joeyh.name>@@ -135,6 +135,7 @@     Propellor.Property.OS     Propellor.Property.Pacman     Propellor.Property.Parted+    Propellor.Property.Parted.Types     Propellor.Property.Partition     Propellor.Property.Postfix     Propellor.Property.PropellorRepo@@ -193,6 +194,7 @@     Propellor.Types.Info     Propellor.Types.MetaTypes     Propellor.Types.OS+    Propellor.Types.PartSpec     Propellor.Types.PrivData     Propellor.Types.Result     Propellor.Types.ResultCheck

@@ -20,12 +20,12 @@ import Propellor.Property.DiskImage.PartSpec import Propellor.Property.Chroot (Chroot) import Propellor.Property.Chroot.Util (removeChroot)+import Propellor.Property.Mount import qualified Propellor.Property.Chroot as Chroot import qualified Propellor.Property.Grub as Grub import qualified Propellor.Property.File as File import qualified Propellor.Property.Apt as Apt import Propellor.Property.Parted-import Propellor.Property.Mount import Propellor.Property.Fstab (SwapPartition(..), genFstab) import Propellor.Property.Partition import Propellor.Property.Rsync@@ -34,7 +34,7 @@ import Propellor.Container import Utility.Path -import Data.List (isPrefixOf, isInfixOf, sortBy)+import Data.List (isPrefixOf, isInfixOf, sortBy, unzip4) import Data.Function (on) import qualified Data.Map.Strict as M import qualified Data.ByteString.Lazy as L@@ -109,16 +109,16 @@ -- >	& Apt.installed ["linux-image-amd64"] -- >	& Grub.installed PC -- >	& hasPassword (User "root")-imageBuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> [PartSpec] -> RevertableProperty (HasInfo + DebianLike) Linux+imageBuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> [PartSpec ()] -> RevertableProperty (HasInfo + DebianLike) Linux imageBuilt = imageBuilt' False  -- | Like 'built', but the chroot is deleted and rebuilt from scratch each -- time. This is more expensive, but useful to ensure reproducible results -- when the properties of the chroot have been changed.-imageRebuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> [PartSpec] -> RevertableProperty (HasInfo + DebianLike) Linux+imageRebuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> [PartSpec ()] -> RevertableProperty (HasInfo + DebianLike) Linux imageRebuilt = imageBuilt' True -imageBuilt' :: Bool -> DiskImage -> (FilePath -> Chroot) -> TableType -> [PartSpec] -> RevertableProperty (HasInfo + DebianLike) Linux+imageBuilt' :: Bool -> DiskImage -> (FilePath -> Chroot) -> TableType -> [PartSpec ()] -> RevertableProperty (HasInfo + DebianLike) Linux imageBuilt' rebuild img mkchroot tabletype partspec = 	imageBuiltFrom img chrootdir tabletype final partspec 		`requires` Chroot.provisioned chroot@@ -159,13 +159,13 @@ 	skipit = doNothing :: Property UnixLike  -- | Builds a disk image from the contents of a chroot.-imageBuiltFrom :: DiskImage -> FilePath -> TableType -> Finalization -> [PartSpec] -> RevertableProperty (HasInfo + DebianLike) UnixLike+imageBuiltFrom :: DiskImage -> FilePath -> TableType -> Finalization -> [PartSpec ()] -> RevertableProperty (HasInfo + DebianLike) UnixLike imageBuiltFrom img chrootdir tabletype final partspec = mkimg <!> rmimg   where 	desc = img ++ " built from " ++ chrootdir 	mkimg = property' desc $ \w -> do-		-- unmount helper filesystems such as proc from the chroot-		-- before getting sizes+		-- Unmount helper filesystems such as proc from the chroot+		-- first; don't want to include the contents of those. 		liftIO $ unmountBelow chrootdir 		szm <- M.mapKeys (toSysDir chrootdir) . M.map toPartSize 			<$> liftIO (dirSizes chrootdir)@@ -214,10 +214,10 @@  -- The constructor for each Partition is passed the size of the files -- from the chroot that will be put in that partition.-fitChrootSize :: TableType -> [PartSpec] -> [PartSize] -> ([Maybe MountPoint], [MountOpts], PartTable)+fitChrootSize :: TableType -> [PartSpec ()] -> [PartSize] -> ([Maybe MountPoint], [MountOpts], PartTable) fitChrootSize tt l basesizes = (mounts, mountopts, parttable)   where-	(mounts, mountopts, sizers) = unzip3 l+	(mounts, mountopts, sizers, _) = unzip4 l 	parttable = PartTable tt (zipWith id sizers basesizes)  -- | Generates a map of the sizes of the contents of

@@ -1,32 +1,24 @@ -- | Disk image partition specification and combinators. +-- Partitions in disk images default to being sized large enough to hold+-- the files that appear in the directory where the partition is to be+-- mounted. Plus a fudge factor, since filesystems have some space+-- overhead.+ module Propellor.Property.DiskImage.PartSpec (+	module Propellor.Types.PartSpec, 	module Propellor.Property.DiskImage.PartSpec,-	Partition,-	PartSize(..),-	PartFlag(..),-	TableType(..),-	Fs(..),-	MountPoint, ) where  import Propellor.Base import Propellor.Property.Parted-import Propellor.Property.Mount---- | Specifies a mount point, mount options, and a constructor for a Partition.--- --- The size that is eventually provided is the amount of space needed to --- hold the files that appear in the directory where the partition is to be--- mounted. Plus a fudge factor, since filesystems have some space--- overhead.-type PartSpec = (Maybe MountPoint, MountOpts, PartSize -> Partition)+import Propellor.Types.PartSpec --- | Partitions that are not to be mounted (ie, LinuxSwap), or that have--- no corresponding directory in the chroot will have 128 MegaBytes--- provided as a default size.-defSz :: PartSize-defSz = MegaBytes 128+-- | Adds additional free space to the partition.+addFreeSpace :: PartSpec t -> PartSize -> PartSpec t+addFreeSpace (mp, o, p, t) freesz = (mp, o, p', t)+  where+	p' = \sz -> p (sz <> freesz)  -- | Add 2% for filesystem overhead. Rationalle for picking 2%: -- A filesystem with 1% overhead might just sneak by as acceptable.@@ -35,55 +27,3 @@ -- Add an additional 200 mb for temp files, journals, etc. fudge :: PartSize -> PartSize fudge (MegaBytes n) = MegaBytes (n + n `div` 100 * 2 + 3 + 200)---- | Specifies a swap partition of a given size.-swapPartition :: PartSize -> PartSpec-swapPartition sz = (Nothing, mempty, const (mkPartition LinuxSwap sz))---- | Specifies a partition with a given filesystem.------ The partition is not mounted anywhere by default; use the combinators--- below to configure it.-partition :: Fs -> PartSpec-partition fs = (Nothing, mempty, mkPartition fs)---- | Specifies where to mount a partition.-mountedAt :: PartSpec -> FilePath -> PartSpec-mountedAt (_, o, p) mp = (Just mp, o, p)---- | Specifies a mount option, such as "noexec"-mountOpt :: ToMountOpts o => PartSpec -> o -> PartSpec-mountOpt (mp, o, p) o' = (mp, o <> toMountOpts o', p)---- | Mount option to make a partition be remounted readonly when there's an--- error accessing it.-errorReadonly :: MountOpts-errorReadonly = toMountOpts "errors=remount-ro"---- | Adds additional free space to the partition.-addFreeSpace :: PartSpec -> PartSize -> PartSpec-addFreeSpace (mp, o, p) freesz = (mp, o, \sz -> p (sz <> freesz))---- | Forced a partition to be a specific size, instead of scaling to the--- size needed for the files in the chroot.-setSize :: PartSpec -> PartSize -> PartSpec-setSize (mp, o, p) sz = (mp, o, const (p sz))---- | Sets the percent of the filesystem blocks reserved for the super-user.------ The default is 5% for ext2 and ext4. Some filesystems may not support--- this.-reservedSpacePercentage :: PartSpec -> Int -> PartSpec-reservedSpacePercentage s percent = adjustp s $ \p -> -	p { partMkFsOpts = ("-m"):show percent:partMkFsOpts p }---- | Sets a flag on the partition.-setFlag :: PartSpec -> PartFlag -> PartSpec-setFlag s f = adjustp s $ \p -> p { partFlags = (f, True):partFlags p }---- | Makes a MSDOS partition be Extended, rather than Primary.-extended :: PartSpec -> PartSpec-extended s = adjustp s $ \p -> p { partType = Extended }--adjustp :: PartSpec -> (Partition -> Partition) -> PartSpec-adjustp (mp, o, p) f = (mp, o, f . p)

@@ -1,6 +1,7 @@ {-# LANGUAGE FlexibleContexts #-}  module Propellor.Property.Parted (+	-- * Types 	TableType(..), 	PartTable(..), 	partTableSize,@@ -15,137 +16,30 @@ 	Partition.MkfsOpts, 	PartType(..), 	PartFlag(..),-	Eep(..),+	-- * Properties 	partitioned, 	parted,+	Eep(..), 	installed,+	-- * PartSpec combinators+	calcPartTable,+	DiskSize(..),+	DiskPart,+	module Propellor.Types.PartSpec,+	DiskSpaceUse(..),+	useDiskSpace, ) where  import Propellor.Base+import Propellor.Property.Parted.Types import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.Pacman as Pacman import qualified Propellor.Property.Partition as Partition+import Propellor.Types.PartSpec import Utility.DataUnits-import Data.Char-import System.Posix.Files -class PartedVal a where-	pval :: a -> String---- | Types of partition tables supported by parted.-data TableType = MSDOS | GPT | AIX | AMIGA | BSD | DVH | LOOP | MAC | PC98 | SUN-	deriving (Show)--instance PartedVal TableType where-	pval = map toLower . show---- | A disk's partition table.-data PartTable = PartTable TableType [Partition]-	deriving (Show)--instance Monoid PartTable where-	-- | default TableType is MSDOS-	mempty = PartTable MSDOS []-	-- | uses the TableType of the second parameter-	mappend (PartTable _l1 ps1) (PartTable l2 ps2) = PartTable l2 (ps1 ++ ps2)---- | Gets the total size of the disk specified by the partition table.-partTableSize :: PartTable -> ByteSize-partTableSize (PartTable _ ps) = fromPartSize $-	-- add 1 megabyte to hold the partition table itself-	mconcat (MegaBytes 1 : map partSize ps)---- | A partition on the disk.-data Partition = Partition-	{ partType :: PartType-	, partSize :: PartSize-	, partFs :: Partition.Fs-	, partMkFsOpts :: Partition.MkfsOpts-	, partFlags :: [(PartFlag, Bool)] -- ^ flags can be set or unset (parted may set some flags by default)-	, partName :: Maybe String -- ^ optional name for partition (only works for GPT, PC98, MAC)-	}-	deriving (Show)---- | Makes a Partition with defaults for non-important values.-mkPartition :: Partition.Fs -> PartSize -> Partition-mkPartition fs sz = Partition-	{ partType = Primary-	, partSize = sz-	, partFs = fs-	, partMkFsOpts = []-	, partFlags = []-	, partName = Nothing-	}---- | Type of a partition.-data PartType = Primary | Logical | Extended-	deriving (Show)--instance PartedVal PartType where-	pval Primary = "primary"-	pval Logical = "logical"-	pval Extended = "extended"---- | All partition sizing is done in megabytes, so that parted can--- automatically lay out the partitions.------ Note that these are SI megabytes, not mebibytes.-newtype PartSize = MegaBytes Integer-	deriving (Show)--instance PartedVal PartSize where-	pval (MegaBytes n)-		| n > 0 = val n ++ "MB"-		-- parted can't make partitions smaller than 1MB;-		-- avoid failure in edge cases-		| otherwise = "1MB"---- | Rounds up to the nearest MegaByte.-toPartSize :: ByteSize -> PartSize-toPartSize b = MegaBytes $ ceiling (fromInteger b / 1000000 :: Double)--fromPartSize :: PartSize -> ByteSize-fromPartSize (MegaBytes b) = b * 1000000--instance Monoid PartSize where-	mempty = MegaBytes 0-	mappend (MegaBytes a) (MegaBytes b) = MegaBytes (a + b)--reducePartSize :: PartSize -> PartSize -> PartSize-reducePartSize (MegaBytes a) (MegaBytes b) = MegaBytes (a - b)---- | Flags that can be set on a partition.-data PartFlag = BootFlag | RootFlag | SwapFlag | HiddenFlag | RaidFlag | LvmFlag | LbaFlag | LegacyBootFlag | IrstFlag | EspFlag | PaloFlag-	deriving (Show)--instance PartedVal PartFlag where-	pval BootFlag = "boot"-	pval RootFlag = "root"-	pval SwapFlag = "swap"-	pval HiddenFlag = "hidden"-	pval RaidFlag = "raid"-	pval LvmFlag = "lvm"-	pval LbaFlag = "lba"-	pval LegacyBootFlag = "legacy_boot"-	pval IrstFlag = "irst"-	pval EspFlag = "esp"-	pval PaloFlag = "palo"--instance PartedVal Bool where-	pval True = "on"-	pval False = "off"--instance PartedVal Partition.Fs where-	pval Partition.EXT2 = "ext2"-	pval Partition.EXT3 = "ext3"-	pval Partition.EXT4 = "ext4"-	pval Partition.BTRFS = "btrfs"-	pval Partition.REISERFS = "reiserfs"-	pval Partition.XFS = "xfs"-	pval Partition.FAT = "fat"-	pval Partition.VFAT = "vfat"-	pval Partition.NTFS = "ntfs"-	pval Partition.LinuxSwap = "linux-swap"+import System.Posix.Files+import Data.List (genericLength)  data Eep = YesReallyDeleteDiskContents @@ -202,3 +96,67 @@ -- | Gets parted installed. installed :: Property (DebianLike + ArchLinux) installed = Apt.installed ["parted"] `pickOS` Pacman.installed ["parted"]++-- | Gets the total size of the disk specified by the partition table.+partTableSize :: PartTable -> ByteSize+partTableSize (PartTable _ ps) = fromPartSize $+	mconcat (partitionTableOverhead : map partSize ps)++-- | Some disk is used to store the partition table itself. Assume less+-- than 1 mb.+partitionTableOverhead :: PartSize+partitionTableOverhead = MegaBytes 1++-- | Calculate a partition table, for a given size of disk.+--+-- For example:+--+-- >	calcPartTable (1024 * 1024 * 1024 * 100) MSDOS+-- > 		[ partition EXT2 `mountedAt` "/boot"+-- > 			`setSize` MegaBytes 256+-- > 			`setFlag` BootFlag+-- >		, partition EXT4 `mountedAt` "/"+-- >			`useDisk` RemainingSpace+-- >		]+calcPartTable :: DiskSize -> TableType -> [PartSpec DiskPart] -> PartTable+calcPartTable (DiskSize disksize) tt l = PartTable tt (map go l)+  where+	go (_, _, mkpart, FixedDiskPart) = mkpart defSz+	go (_, _, mkpart, DynamicDiskPart (Percent p)) = mkpart $ toPartSize $+		diskremainingafterfixed * fromIntegral p `div` 100+	go (_, _, mkpart, DynamicDiskPart RemainingSpace) = mkpart $ toPartSize $+		diskremaining `div` genericLength (filter isremainingspace l)+	diskremainingafterfixed = +		disksize - sumsizes (filter isfixed l)+	diskremaining =+		disksize - sumsizes (filter (not . isremainingspace) l)+	sumsizes = sum . map fromPartSize . (partitionTableOverhead :) .+		map (partSize . go)+	isfixed (_, _, _, FixedDiskPart) = True+	isfixed _ = False+	isremainingspace (_, _, _, DynamicDiskPart RemainingSpace) = True+	isremainingspace _ = False++-- | Size of a disk, in bytes.+newtype DiskSize = DiskSize ByteSize+	deriving (Show)++data DiskPart = FixedDiskPart | DynamicDiskPart DiskSpaceUse++data DiskSpaceUse = Percent Int | RemainingSpace++instance Monoid DiskPart+  where+	mempty = FixedDiskPart+	mappend FixedDiskPart FixedDiskPart = FixedDiskPart+	mappend (DynamicDiskPart (Percent a)) (DynamicDiskPart (Percent b)) = DynamicDiskPart (Percent (a + b))+	mappend (DynamicDiskPart RemainingSpace) (DynamicDiskPart RemainingSpace) = DynamicDiskPart RemainingSpace+	mappend (DynamicDiskPart (Percent a)) _ = DynamicDiskPart (Percent a)+	mappend _ (DynamicDiskPart (Percent b)) = DynamicDiskPart (Percent b)+	mappend (DynamicDiskPart RemainingSpace) _ = DynamicDiskPart RemainingSpace+	mappend _ (DynamicDiskPart RemainingSpace) = DynamicDiskPart RemainingSpace++-- | Make a partition use some percentage of the size of the disk+-- (less all fixed size partitions), or the remaining space in the disk.+useDiskSpace :: PartSpec DiskPart -> DiskSpaceUse -> PartSpec DiskPart+useDiskSpace (mp, o, p, _) diskuse = (mp, o, p, DynamicDiskPart diskuse)

@@ -0,0 +1,119 @@+module Propellor.Property.Parted.Types where++import Propellor.Base+import qualified Propellor.Property.Partition as Partition+import Utility.DataUnits++import Data.Char++class PartedVal a where+	pval :: a -> String++-- | Types of partition tables supported by parted.+data TableType = MSDOS | GPT | AIX | AMIGA | BSD | DVH | LOOP | MAC | PC98 | SUN+	deriving (Show)++instance PartedVal TableType where+	pval = map toLower . show++-- | A disk's partition table.+data PartTable = PartTable TableType [Partition]+	deriving (Show)++instance Monoid PartTable where+	-- | default TableType is MSDOS+	mempty = PartTable MSDOS []+	-- | uses the TableType of the second parameter+	mappend (PartTable _l1 ps1) (PartTable l2 ps2) = PartTable l2 (ps1 ++ ps2)++-- | A partition on the disk.+data Partition = Partition+	{ partType :: PartType+	, partSize :: PartSize+	, partFs :: Partition.Fs+	, partMkFsOpts :: Partition.MkfsOpts+	, partFlags :: [(PartFlag, Bool)] -- ^ flags can be set or unset (parted may set some flags by default)+	, partName :: Maybe String -- ^ optional name for partition (only works for GPT, PC98, MAC)+	}+	deriving (Show)++-- | Makes a Partition with defaults for non-important values.+mkPartition :: Partition.Fs -> PartSize -> Partition+mkPartition fs sz = Partition+	{ partType = Primary+	, partSize = sz+	, partFs = fs+	, partMkFsOpts = []+	, partFlags = []+	, partName = Nothing+	}++-- | Type of a partition.+data PartType = Primary | Logical | Extended+	deriving (Show)++instance PartedVal PartType where+	pval Primary = "primary"+	pval Logical = "logical"+	pval Extended = "extended"++-- | All partition sizing is done in megabytes, so that parted can+-- automatically lay out the partitions.+--+-- Note that these are SI megabytes, not mebibytes.+newtype PartSize = MegaBytes Integer+	deriving (Show)++instance PartedVal PartSize where+	pval (MegaBytes n)+		| n > 0 = val n ++ "MB"+		-- parted can't make partitions smaller than 1MB;+		-- avoid failure in edge cases+		| otherwise = "1MB"++-- | Rounds up to the nearest MegaByte.+toPartSize :: ByteSize -> PartSize+toPartSize b = MegaBytes $ ceiling (fromInteger b / 1000000 :: Double)++fromPartSize :: PartSize -> ByteSize+fromPartSize (MegaBytes b) = b * 1000000++instance Monoid PartSize where+	mempty = MegaBytes 0+	mappend (MegaBytes a) (MegaBytes b) = MegaBytes (a + b)++reducePartSize :: PartSize -> PartSize -> PartSize+reducePartSize (MegaBytes a) (MegaBytes b) = MegaBytes (a - b)++-- | Flags that can be set on a partition.+data PartFlag = BootFlag | RootFlag | SwapFlag | HiddenFlag | RaidFlag | LvmFlag | LbaFlag | LegacyBootFlag | IrstFlag | EspFlag | PaloFlag+	deriving (Show)++instance PartedVal PartFlag where+	pval BootFlag = "boot"+	pval RootFlag = "root"+	pval SwapFlag = "swap"+	pval HiddenFlag = "hidden"+	pval RaidFlag = "raid"+	pval LvmFlag = "lvm"+	pval LbaFlag = "lba"+	pval LegacyBootFlag = "legacy_boot"+	pval IrstFlag = "irst"+	pval EspFlag = "esp"+	pval PaloFlag = "palo"++instance PartedVal Bool where+	pval True = "on"+	pval False = "off"++instance PartedVal Partition.Fs where+	pval Partition.EXT2 = "ext2"+	pval Partition.EXT3 = "ext3"+	pval Partition.EXT4 = "ext4"+	pval Partition.BTRFS = "btrfs"+	pval Partition.REISERFS = "reiserfs"+	pval Partition.XFS = "xfs"+	pval Partition.FAT = "fat"+	pval Partition.VFAT = "vfat"+	pval Partition.NTFS = "ntfs"+	pval Partition.LinuxSwap = "linux-swap"

@@ -55,7 +55,10 @@ module Propellor.Property.Versioned (Versioned, version, (-->), (<|>)) where  import Propellor+import Propellor.Types.Core +import Data.List+ -- | Something that has multiple versions of type `v`. type Versioned v t = VersionedBy v -> t @@ -89,12 +92,21 @@ 	=> v 	-> VerSpec v metatypes 	-> RevertableProperty metatypes metatypes-processVerSpec v (Base (c, p))-	| c v = p-	| otherwise = revert p-processVerSpec v (More (c, p) vs)-	| c v = processVerSpec v vs `before` p-	| otherwise = revert p `before` processVerSpec v vs+processVerSpec v s = combinedp s+	`describe` intercalate " and " (combineddesc s [])+  where+	combinedp (Base (c, p))+		| c v = p+		| otherwise = revert p+	combinedp (More (c, p) vs)+		| c v = combinedp vs `before` p+		| otherwise = revert p `before` combinedp vs+	combineddesc (Base (c, p)) l+		| c v = getDesc p : l+		| otherwise = getDesc (revert p) : l+	combineddesc (More (c, p) vs) l+		| c v = getDesc p : combineddesc vs l+		| otherwise = getDesc (revert p) : combineddesc vs l  -- | Specify a function that checks the version, and what -- `RevertableProperty` to use if the version matches.

@@ -0,0 +1,66 @@+-- | Partition specification combinators.++module Propellor.Types.PartSpec where++import Propellor.Base+import Propellor.Property.Parted.Types+import Propellor.Property.Mount+import Propellor.Property.Partition++-- | Specifies a mount point, mount options, and a constructor for a+-- Partition that determines its size.+type PartSpec t = (Maybe MountPoint, MountOpts, PartSize -> Partition, t)++-- | Specifies a partition with a given filesystem.+--+-- The partition is not mounted anywhere by default; use the combinators+-- below to configure it.+partition :: Monoid t => Fs -> PartSpec t+partition fs = (Nothing, mempty, mkPartition fs, mempty)++-- | Specifies a swap partition of a given size.+swapPartition :: Monoid t => PartSize -> PartSpec t+swapPartition sz = (Nothing, mempty, const (mkPartition LinuxSwap sz), mempty)++-- | Specifies where to mount a partition.+mountedAt :: PartSpec t -> FilePath -> PartSpec t+mountedAt (_, o, p, t) mp = (Just mp, o, p, t)++-- | Specify a fixed size for a partition.+setSize :: PartSpec t -> PartSize -> PartSpec t+setSize (mp, o, p, t) sz = (mp, o, const (p sz), t)++-- | Specifies a mount option, such as "noexec"+mountOpt :: ToMountOpts o => PartSpec t -> o -> PartSpec t+mountOpt (mp, o, p, t) o' = (mp, o <> toMountOpts o', p, t)++-- | Mount option to make a partition be remounted readonly when there's an+-- error accessing it.+errorReadonly :: MountOpts+errorReadonly = toMountOpts "errors=remount-ro"++-- | Sets the percent of the filesystem blocks reserved for the super-user.+--+-- The default is 5% for ext2 and ext4. Some filesystems may not support+-- this.+reservedSpacePercentage :: PartSpec t -> Int -> PartSpec t+reservedSpacePercentage s percent = adjustp s $ \p -> +	p { partMkFsOpts = ("-m"):show percent:partMkFsOpts p }++-- | Sets a flag on the partition.+setFlag :: PartSpec t -> PartFlag -> PartSpec t+setFlag s f = adjustp s $ \p -> p { partFlags = (f, True):partFlags p }++-- | Makes a MSDOS partition be Extended, rather than Primary.+extended :: PartSpec t -> PartSpec t+extended s = adjustp s $ \p -> p { partType = Extended }++adjustp :: PartSpec t -> (Partition -> Partition) -> PartSpec t+adjustp (mp, o, p, t) f = (mp, o, f . p, t)++adjustt :: PartSpec t -> (t -> t) -> PartSpec t+adjustt (mp, o, p, t) f = (mp, o, p, f t)++-- | Default partition size when not otherwize specified is 128 MegaBytes.+defSz :: PartSize+defSz = MegaBytes 128