summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/Parted/Types.hs
blob: 11e0947c1f3189d275c13ce5b7096286d3df7927 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
module Propellor.Property.Parted.Types where

import qualified Propellor.Property.Partition as Partition
import Utility.DataUnits

import Data.Char
import qualified Data.Semigroup as Sem
import Data.Monoid
import Prelude

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 Alignment [Partition]
	deriving (Show)

instance Sem.Semigroup PartTable where
	-- | uses the TableType of the second parameter
	-- and the larger alignment,
	PartTable _l1 a1 ps1 <> PartTable l2 a2 ps2 =
		PartTable l2 (max a1 a2) (ps1 ++ ps2)

instance Monoid PartTable where
	-- | default TableType is MSDOS, with a `safeAlignment`.
	mempty = PartTable MSDOS safeAlignment []
	mappend = (Sem.<>)

-- | A partition on the disk.
data Partition = Partition
	{ partType :: PartType
	, partSize :: PartSize
	, partFs :: Maybe 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 :: Maybe 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"

-- | Size of a partition.
data PartSize
	-- Since disk sizes are typically given in MB, not MiB, this
	-- uses SI MegaBytes (powers of 10).
	= MegaBytes Integer
	-- For more control, the partition size can be given in bytes.
	-- Note that this will prevent any automatic alignment from 
	-- being done.
	| Bytes Integer
	deriving (Show)

-- | Rounds up to the nearest MegaByte.
toPartSize :: ByteSize -> PartSize
toPartSize = toPartSize' ceiling

toPartSize' :: (Double -> Integer) -> ByteSize -> PartSize
toPartSize' rounder b = MegaBytes $ rounder (fromInteger b / 1000000 :: Double)

fromPartSize :: PartSize -> ByteSize
fromPartSize (MegaBytes b) = b * 1000000
fromPartSize (Bytes n) = n

instance Sem.Semigroup PartSize where
	MegaBytes a <> MegaBytes b = MegaBytes (a + b)
	Bytes a <> b = Bytes (a + fromPartSize b)
	a <> Bytes b = Bytes (b + fromPartSize a)

instance Monoid PartSize where
	mempty = MegaBytes 0
	mappend = (Sem.<>)

reducePartSize :: PartSize -> PartSize -> PartSize
reducePartSize (MegaBytes a) (MegaBytes b) = MegaBytes (a - b)
reducePartSize (Bytes a) b = Bytes (a - fromPartSize b)
reducePartSize a (Bytes b) = Bytes (fromPartSize a - b)

-- | Partitions need to be aligned for optimal efficiency.
-- The alignment is a number of bytes.
newtype Alignment = Alignment ByteSize
	deriving (Show, Eq, Ord)

-- | 4MiB alignment is optimal for inexpensive flash drives and
-- is a good safe default for all drives.
safeAlignment :: Alignment
safeAlignment = Alignment (4*1024*1024)

fromAlignment :: Alignment -> ByteSize
fromAlignment (Alignment n) = n

-- | Flags that can be set on a partition.
data PartFlag = BootFlag | RootFlag | SwapFlag | HiddenFlag | RaidFlag | LvmFlag | LbaFlag | LegacyBootFlag | IrstFlag | EspFlag | PaloFlag | BiosGrubFlag
	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"
	pval BiosGrubFlag = "bios_grub"

instance PartedVal Bool where
	pval True = "on"
	pval False = "off"

-- This is used for creating partitions, not formatting partitions,
-- so it's ok to use eg, fat32 for both FAT and VFAT.
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 = "fat32"
	pval Partition.VFAT = "fat32"
	pval Partition.NTFS = "ntfs"
	pval Partition.LinuxSwap = "linux-swap"