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 (Int -> TableType -> ShowS
[TableType] -> ShowS
TableType -> String
(Int -> TableType -> ShowS)
-> (TableType -> String)
-> ([TableType] -> ShowS)
-> Show TableType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TableType] -> ShowS
$cshowList :: [TableType] -> ShowS
show :: TableType -> String
$cshow :: TableType -> String
showsPrec :: Int -> TableType -> ShowS
$cshowsPrec :: Int -> TableType -> ShowS
Show)

instance PartedVal TableType where
	pval :: TableType -> String
pval = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ShowS -> (TableType -> String) -> TableType -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableType -> String
forall a. Show a => a -> String
show

-- | A disk's partition table.
data PartTable = PartTable TableType Alignment [Partition]
	deriving (Int -> PartTable -> ShowS
[PartTable] -> ShowS
PartTable -> String
(Int -> PartTable -> ShowS)
-> (PartTable -> String)
-> ([PartTable] -> ShowS)
-> Show PartTable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PartTable] -> ShowS
$cshowList :: [PartTable] -> ShowS
show :: PartTable -> String
$cshow :: PartTable -> String
showsPrec :: Int -> PartTable -> ShowS
$cshowsPrec :: Int -> PartTable -> ShowS
Show)

instance Sem.Semigroup PartTable where
	-- | uses the TableType of the second parameter
	-- and the larger alignment,
	PartTable _l1 :: TableType
_l1 a1 :: Alignment
a1 ps1 :: [Partition]
ps1 <> :: PartTable -> PartTable -> PartTable
<> PartTable l2 :: TableType
l2 a2 :: Alignment
a2 ps2 :: [Partition]
ps2 =
		TableType -> Alignment -> [Partition] -> PartTable
PartTable TableType
l2 (Alignment -> Alignment -> Alignment
forall a. Ord a => a -> a -> a
max Alignment
a1 Alignment
a2) ([Partition]
ps1 [Partition] -> [Partition] -> [Partition]
forall a. [a] -> [a] -> [a]
++ [Partition]
ps2)

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

-- | A partition on the disk.
data Partition = Partition
	{ Partition -> PartType
partType :: PartType
	, Partition -> PartSize
partSize :: PartSize
	, Partition -> Maybe Fs
partFs :: Maybe Partition.Fs
	, Partition -> MkfsOpts
partMkFsOpts :: Partition.MkfsOpts
	, Partition -> [(PartFlag, Bool)]
partFlags :: [(PartFlag, Bool)] -- ^ flags can be set or unset (parted may set some flags by default)
	, Partition -> Maybe String
partName :: Maybe String -- ^ optional name for partition (only works for GPT, PC98, MAC)
	}
	deriving (Int -> Partition -> ShowS
[Partition] -> ShowS
Partition -> String
(Int -> Partition -> ShowS)
-> (Partition -> String)
-> ([Partition] -> ShowS)
-> Show Partition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Partition] -> ShowS
$cshowList :: [Partition] -> ShowS
show :: Partition -> String
$cshow :: Partition -> String
showsPrec :: Int -> Partition -> ShowS
$cshowsPrec :: Int -> Partition -> ShowS
Show)

-- | Makes a Partition with defaults for non-important values.
mkPartition :: Maybe Partition.Fs -> PartSize -> Partition
mkPartition :: Maybe Fs -> PartSize -> Partition
mkPartition fs :: Maybe Fs
fs sz :: PartSize
sz = Partition :: PartType
-> PartSize
-> Maybe Fs
-> MkfsOpts
-> [(PartFlag, Bool)]
-> Maybe String
-> Partition
Partition
	{ partType :: PartType
partType = PartType
Primary
	, partSize :: PartSize
partSize = PartSize
sz
	, partFs :: Maybe Fs
partFs = Maybe Fs
fs
	, partMkFsOpts :: MkfsOpts
partMkFsOpts = []
	, partFlags :: [(PartFlag, Bool)]
partFlags = []
	, partName :: Maybe String
partName = Maybe String
forall a. Maybe a
Nothing
	}

-- | Type of a partition.
data PartType = Primary | Logical | Extended
	deriving (Int -> PartType -> ShowS
[PartType] -> ShowS
PartType -> String
(Int -> PartType -> ShowS)
-> (PartType -> String) -> ([PartType] -> ShowS) -> Show PartType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PartType] -> ShowS
$cshowList :: [PartType] -> ShowS
show :: PartType -> String
$cshow :: PartType -> String
showsPrec :: Int -> PartType -> ShowS
$cshowsPrec :: Int -> PartType -> ShowS
Show)

instance PartedVal PartType where
	pval :: PartType -> String
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 (Int -> PartSize -> ShowS
[PartSize] -> ShowS
PartSize -> String
(Int -> PartSize -> ShowS)
-> (PartSize -> String) -> ([PartSize] -> ShowS) -> Show PartSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PartSize] -> ShowS
$cshowList :: [PartSize] -> ShowS
show :: PartSize -> String
$cshow :: PartSize -> String
showsPrec :: Int -> PartSize -> ShowS
$cshowsPrec :: Int -> PartSize -> ShowS
Show)

-- | Rounds up to the nearest MegaByte.
toPartSize :: ByteSize -> PartSize
toPartSize :: ByteSize -> PartSize
toPartSize = (Double -> ByteSize) -> ByteSize -> PartSize
toPartSize' Double -> ByteSize
forall a b. (RealFrac a, Integral b) => a -> b
ceiling

toPartSize' :: (Double -> Integer) -> ByteSize -> PartSize
toPartSize' :: (Double -> ByteSize) -> ByteSize -> PartSize
toPartSize' rounder :: Double -> ByteSize
rounder b :: ByteSize
b = ByteSize -> PartSize
MegaBytes (ByteSize -> PartSize) -> ByteSize -> PartSize
forall a b. (a -> b) -> a -> b
$ Double -> ByteSize
rounder (ByteSize -> Double
forall a. Num a => ByteSize -> a
fromInteger ByteSize
b Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ 1000000 :: Double)

fromPartSize :: PartSize -> ByteSize
fromPartSize :: PartSize -> ByteSize
fromPartSize (MegaBytes b :: ByteSize
b) = ByteSize
b ByteSize -> ByteSize -> ByteSize
forall a. Num a => a -> a -> a
* 1000000
fromPartSize (Bytes n :: ByteSize
n) = ByteSize
n

instance Sem.Semigroup PartSize where
	MegaBytes a :: ByteSize
a <> :: PartSize -> PartSize -> PartSize
<> MegaBytes b :: ByteSize
b = ByteSize -> PartSize
MegaBytes (ByteSize
a ByteSize -> ByteSize -> ByteSize
forall a. Num a => a -> a -> a
+ ByteSize
b)
	Bytes a :: ByteSize
a <> b :: PartSize
b = ByteSize -> PartSize
Bytes (ByteSize
a ByteSize -> ByteSize -> ByteSize
forall a. Num a => a -> a -> a
+ PartSize -> ByteSize
fromPartSize PartSize
b)
	a :: PartSize
a <> Bytes b :: ByteSize
b = ByteSize -> PartSize
Bytes (ByteSize
b ByteSize -> ByteSize -> ByteSize
forall a. Num a => a -> a -> a
+ PartSize -> ByteSize
fromPartSize PartSize
a)

instance Monoid PartSize where
	mempty :: PartSize
mempty = ByteSize -> PartSize
MegaBytes 0
	mappend :: PartSize -> PartSize -> PartSize
mappend = PartSize -> PartSize -> PartSize
forall a. Semigroup a => a -> a -> a
(Sem.<>)

reducePartSize :: PartSize -> PartSize -> PartSize
reducePartSize :: PartSize -> PartSize -> PartSize
reducePartSize (MegaBytes a :: ByteSize
a) (MegaBytes b :: ByteSize
b) = ByteSize -> PartSize
MegaBytes (ByteSize
a ByteSize -> ByteSize -> ByteSize
forall a. Num a => a -> a -> a
- ByteSize
b)
reducePartSize (Bytes a :: ByteSize
a) b :: PartSize
b = ByteSize -> PartSize
Bytes (ByteSize
a ByteSize -> ByteSize -> ByteSize
forall a. Num a => a -> a -> a
- PartSize -> ByteSize
fromPartSize PartSize
b)
reducePartSize a :: PartSize
a (Bytes b :: ByteSize
b) = ByteSize -> PartSize
Bytes (PartSize -> ByteSize
fromPartSize PartSize
a ByteSize -> ByteSize -> ByteSize
forall a. Num a => a -> a -> a
- ByteSize
b)

-- | Partitions need to be aligned for optimal efficiency.
-- The alignment is a number of bytes.
newtype Alignment = Alignment ByteSize
	deriving (Int -> Alignment -> ShowS
[Alignment] -> ShowS
Alignment -> String
(Int -> Alignment -> ShowS)
-> (Alignment -> String)
-> ([Alignment] -> ShowS)
-> Show Alignment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Alignment] -> ShowS
$cshowList :: [Alignment] -> ShowS
show :: Alignment -> String
$cshow :: Alignment -> String
showsPrec :: Int -> Alignment -> ShowS
$cshowsPrec :: Int -> Alignment -> ShowS
Show, Alignment -> Alignment -> Bool
(Alignment -> Alignment -> Bool)
-> (Alignment -> Alignment -> Bool) -> Eq Alignment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Alignment -> Alignment -> Bool
$c/= :: Alignment -> Alignment -> Bool
== :: Alignment -> Alignment -> Bool
$c== :: Alignment -> Alignment -> Bool
Eq, Eq Alignment
Eq Alignment =>
(Alignment -> Alignment -> Ordering)
-> (Alignment -> Alignment -> Bool)
-> (Alignment -> Alignment -> Bool)
-> (Alignment -> Alignment -> Bool)
-> (Alignment -> Alignment -> Bool)
-> (Alignment -> Alignment -> Alignment)
-> (Alignment -> Alignment -> Alignment)
-> Ord Alignment
Alignment -> Alignment -> Bool
Alignment -> Alignment -> Ordering
Alignment -> Alignment -> Alignment
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Alignment -> Alignment -> Alignment
$cmin :: Alignment -> Alignment -> Alignment
max :: Alignment -> Alignment -> Alignment
$cmax :: Alignment -> Alignment -> Alignment
>= :: Alignment -> Alignment -> Bool
$c>= :: Alignment -> Alignment -> Bool
> :: Alignment -> Alignment -> Bool
$c> :: Alignment -> Alignment -> Bool
<= :: Alignment -> Alignment -> Bool
$c<= :: Alignment -> Alignment -> Bool
< :: Alignment -> Alignment -> Bool
$c< :: Alignment -> Alignment -> Bool
compare :: Alignment -> Alignment -> Ordering
$ccompare :: Alignment -> Alignment -> Ordering
$cp1Ord :: Eq Alignment
Ord)

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

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

-- | Flags that can be set on a partition.
data PartFlag = BootFlag | RootFlag | SwapFlag | HiddenFlag | RaidFlag | LvmFlag | LbaFlag | LegacyBootFlag | IrstFlag | EspFlag | PaloFlag | BiosGrubFlag
	deriving (Int -> PartFlag -> ShowS
[PartFlag] -> ShowS
PartFlag -> String
(Int -> PartFlag -> ShowS)
-> (PartFlag -> String) -> ([PartFlag] -> ShowS) -> Show PartFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PartFlag] -> ShowS
$cshowList :: [PartFlag] -> ShowS
show :: PartFlag -> String
$cshow :: PartFlag -> String
showsPrec :: Int -> PartFlag -> ShowS
$cshowsPrec :: Int -> PartFlag -> ShowS
Show)

instance PartedVal PartFlag where
	pval :: PartFlag -> String
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 :: Bool -> String
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 :: Fs -> String
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"