propellor

propellor config for hosts.
git clone git://git.ricketyspace.net/propellor.git
Log | Files | Refs | LICENSE

Types.hs (4504B)


      1 module Propellor.Property.Parted.Types where
      2 
      3 import qualified Propellor.Property.Partition as Partition
      4 import Utility.DataUnits
      5 
      6 import Data.Char
      7 import qualified Data.Semigroup as Sem
      8 import Data.Monoid
      9 import Prelude
     10 
     11 class PartedVal a where
     12 	pval :: a -> String
     13 
     14 -- | Types of partition tables supported by parted.
     15 data TableType = MSDOS | GPT | AIX | AMIGA | BSD | DVH | LOOP | MAC | PC98 | SUN
     16 	deriving (Show)
     17 
     18 instance PartedVal TableType where
     19 	pval = map toLower . show
     20 
     21 -- | A disk's partition table.
     22 data PartTable = PartTable TableType Alignment [Partition]
     23 	deriving (Show)
     24 
     25 instance Sem.Semigroup PartTable where
     26 	-- | uses the TableType of the second parameter
     27 	-- and the larger alignment,
     28 	PartTable _l1 a1 ps1 <> PartTable l2 a2 ps2 =
     29 		PartTable l2 (max a1 a2) (ps1 ++ ps2)
     30 
     31 instance Monoid PartTable where
     32 	-- | default TableType is MSDOS, with a `safeAlignment`.
     33 	mempty = PartTable MSDOS safeAlignment []
     34 	mappend = (Sem.<>)
     35 
     36 -- | A partition on the disk.
     37 data Partition = Partition
     38 	{ partType :: PartType
     39 	, partSize :: PartSize
     40 	, partFs :: Maybe Partition.Fs
     41 	, partMkFsOpts :: Partition.MkfsOpts
     42 	, partFlags :: [(PartFlag, Bool)] -- ^ flags can be set or unset (parted may set some flags by default)
     43 	, partName :: Maybe String -- ^ optional name for partition (only works for GPT, PC98, MAC)
     44 	}
     45 	deriving (Show)
     46 
     47 -- | Makes a Partition with defaults for non-important values.
     48 mkPartition :: Maybe Partition.Fs -> PartSize -> Partition
     49 mkPartition fs sz = Partition
     50 	{ partType = Primary
     51 	, partSize = sz
     52 	, partFs = fs
     53 	, partMkFsOpts = []
     54 	, partFlags = []
     55 	, partName = Nothing
     56 	}
     57 
     58 -- | Type of a partition.
     59 data PartType = Primary | Logical | Extended
     60 	deriving (Show)
     61 
     62 instance PartedVal PartType where
     63 	pval Primary = "primary"
     64 	pval Logical = "logical"
     65 	pval Extended = "extended"
     66 
     67 -- | Size of a partition.
     68 data PartSize
     69 	-- Since disk sizes are typically given in MB, not MiB, this
     70 	-- uses SI MegaBytes (powers of 10).
     71 	= MegaBytes Integer
     72 	-- For more control, the partition size can be given in bytes.
     73 	-- Note that this will prevent any automatic alignment from 
     74 	-- being done.
     75 	| Bytes Integer
     76 	deriving (Show)
     77 
     78 -- | Rounds up to the nearest MegaByte.
     79 toPartSize :: ByteSize -> PartSize
     80 toPartSize = toPartSize' ceiling
     81 
     82 toPartSize' :: (Double -> Integer) -> ByteSize -> PartSize
     83 toPartSize' rounder b = MegaBytes $ rounder (fromInteger b / 1000000 :: Double)
     84 
     85 fromPartSize :: PartSize -> ByteSize
     86 fromPartSize (MegaBytes b) = b * 1000000
     87 fromPartSize (Bytes n) = n
     88 
     89 instance Sem.Semigroup PartSize where
     90 	MegaBytes a <> MegaBytes b = MegaBytes (a + b)
     91 	Bytes a <> b = Bytes (a + fromPartSize b)
     92 	a <> Bytes b = Bytes (b + fromPartSize a)
     93 
     94 instance Monoid PartSize where
     95 	mempty = MegaBytes 0
     96 	mappend = (Sem.<>)
     97 
     98 reducePartSize :: PartSize -> PartSize -> PartSize
     99 reducePartSize (MegaBytes a) (MegaBytes b) = MegaBytes (a - b)
    100 reducePartSize (Bytes a) b = Bytes (a - fromPartSize b)
    101 reducePartSize a (Bytes b) = Bytes (fromPartSize a - b)
    102 
    103 -- | Partitions need to be aligned for optimal efficiency.
    104 -- The alignment is a number of bytes.
    105 newtype Alignment = Alignment ByteSize
    106 	deriving (Show, Eq, Ord)
    107 
    108 -- | 4MiB alignment is optimal for inexpensive flash drives and
    109 -- is a good safe default for all drives.
    110 safeAlignment :: Alignment
    111 safeAlignment = Alignment (4*1024*1024)
    112 
    113 fromAlignment :: Alignment -> ByteSize
    114 fromAlignment (Alignment n) = n
    115 
    116 -- | Flags that can be set on a partition.
    117 data PartFlag = BootFlag | RootFlag | SwapFlag | HiddenFlag | RaidFlag | LvmFlag | LbaFlag | LegacyBootFlag | IrstFlag | EspFlag | PaloFlag | BiosGrubFlag
    118 	deriving (Show)
    119 
    120 instance PartedVal PartFlag where
    121 	pval BootFlag = "boot"
    122 	pval RootFlag = "root"
    123 	pval SwapFlag = "swap"
    124 	pval HiddenFlag = "hidden"
    125 	pval RaidFlag = "raid"
    126 	pval LvmFlag = "lvm"
    127 	pval LbaFlag = "lba"
    128 	pval LegacyBootFlag = "legacy_boot"
    129 	pval IrstFlag = "irst"
    130 	pval EspFlag = "esp"
    131 	pval PaloFlag = "palo"
    132 	pval BiosGrubFlag = "bios_grub"
    133 
    134 instance PartedVal Bool where
    135 	pval True = "on"
    136 	pval False = "off"
    137 
    138 -- This is used for creating partitions, not formatting partitions,
    139 -- so it's ok to use eg, fat32 for both FAT and VFAT.
    140 instance PartedVal Partition.Fs where
    141 	pval Partition.EXT2 = "ext2"
    142 	pval Partition.EXT3 = "ext3"
    143 	pval Partition.EXT4 = "ext4"
    144 	pval Partition.BTRFS = "btrfs"
    145 	pval Partition.REISERFS = "reiserfs"
    146 	pval Partition.XFS = "xfs"
    147 	pval Partition.FAT = "fat32"
    148 	pval Partition.VFAT = "fat32"
    149 	pval Partition.NTFS = "ntfs"
    150 	pval Partition.LinuxSwap = "linux-swap"