summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoey Hess2017-07-21 16:05:50 -0400
committerJoey Hess2017-07-21 16:05:50 -0400
commit5bd4c6e679ed605f1b37c201affb27096662c29f (patch)
treed4eba0149eaeb6e2522ce79d396b14007eb9bdbe
parent1fecbbd450b973018fc059ffc166e927698890cd (diff)
calcPartTable using PartSpec DSL
* 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. This commit was sponsored by Thomas Hochstein on Patreon.
-rw-r--r--debian/changelog10
-rw-r--r--propellor.cabal4
-rw-r--r--src/Propellor/Property/DiskImage.hs16
-rw-r--r--src/Propellor/Property/DiskImage/PartSpec.hs84
-rw-r--r--src/Propellor/Property/Parted.hs198
-rw-r--r--src/Propellor/Property/Parted/Types.hs119
-rw-r--r--src/Propellor/Types/PartSpec.hs66
7 files changed, 294 insertions, 203 deletions
diff --git a/debian/changelog b/debian/changelog
index 7ad30b40..4a9775db 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,5 +1,11 @@
-propellor (4.4.1) UNRELEASED; urgency=medium
-
+propellor (4.5.0) UNRELEASED; 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> Mon, 17 Jul 2017 16:51:11 -0400
diff --git a/propellor.cabal b/propellor.cabal
index d4417578..f175a3fa 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -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 @@ Library
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 @@ Library
Propellor.Types.Info
Propellor.Types.MetaTypes
Propellor.Types.OS
+ Propellor.Types.PartSpec
Propellor.Types.PrivData
Propellor.Types.Result
Propellor.Types.ResultCheck
diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs
index f8754f85..4d10f300 100644
--- a/src/Propellor/Property/DiskImage.hs
+++ b/src/Propellor/Property/DiskImage.hs
@@ -20,12 +20,12 @@ import Propellor.Base
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.Types.Bootloader
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 @@ type DiskImage = FilePath
-- > & 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,7 +159,7 @@ cachesCleaned = "cache cleaned" ==> (Apt.cacheCleaned `pickOS` skipit)
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
@@ -214,10 +214,10 @@ partitionsPopulated chrootdir mnts mntopts devs = property' desc $ \w ->
-- 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
diff --git a/src/Propellor/Property/DiskImage/PartSpec.hs b/src/Propellor/Property/DiskImage/PartSpec.hs
index 2b14baa0..6a29af4e 100644
--- a/src/Propellor/Property/DiskImage/PartSpec.hs
+++ b/src/Propellor/Property/DiskImage/PartSpec.hs
@@ -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 @@ defSz = MegaBytes 128
-- 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)
diff --git a/src/Propellor/Property/Parted.hs b/src/Propellor/Property/Parted.hs
index f7ac379f..970f5b9a 100644
--- a/src/Propellor/Property/Parted.hs
+++ b/src/Propellor/Property/Parted.hs
@@ -1,6 +1,7 @@
{-# LANGUAGE FlexibleContexts #-}
module Propellor.Property.Parted (
+ -- * Types
TableType(..),
PartTable(..),
partTableSize,
@@ -15,137 +16,30 @@ module Propellor.Property.Parted (
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 @@ parted YesReallyDeleteDiskContents disk ps = p `requires` installed
-- | 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)
diff --git a/src/Propellor/Property/Parted/Types.hs b/src/Propellor/Property/Parted/Types.hs
new file mode 100644
index 00000000..3350e008
--- /dev/null
+++ b/src/Propellor/Property/Parted/Types.hs
@@ -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"
diff --git a/src/Propellor/Types/PartSpec.hs b/src/Propellor/Types/PartSpec.hs
new file mode 100644
index 00000000..2b0a8787
--- /dev/null
+++ b/src/Propellor/Types/PartSpec.hs
@@ -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