module B9.DiskImages where
import Control.Applicative
import Data.Data
import Data.Semigroup
import System.FilePath
import qualified Text.PrettyPrint.Boxes as Boxes
data ImageTarget = ImageTarget
ImageDestination
ImageSource
MountPoint
deriving (Read, Show, Typeable, Data, Eq)
data MountPoint = MountPoint FilePath | NotMounted
deriving (Show, Read, Typeable, Data, Eq)
data ImageDestination = Share String ImageType ImageResize
| LiveInstallerImage String FilePath ImageResize
| LocalFile Image ImageResize
| Transient
deriving (Read, Show, Typeable, Data,Eq)
data ImageSource = EmptyImage String FileSystem ImageType ImageSize
| CopyOnWrite Image
| SourceImage Image Partition ImageResize
| From String ImageResize
deriving (Show,Read,Typeable,Data,Eq)
data Partition = NoPT
| Partition Int
deriving (Eq, Show, Read, Typeable, Data)
data Image = Image FilePath ImageType FileSystem
deriving (Eq, Show, Read, Typeable, Data)
data ImageType = Raw | QCow2 | Vmdk
deriving (Eq,Read,Typeable,Data,Show)
data FileSystem = NoFileSystem | Ext4 | ISO9660 | VFAT
deriving (Eq,Show,Read,Typeable,Data)
data ImageSize = ImageSize Int SizeUnit
deriving (Eq, Show, Read, Typeable, Data)
data SizeUnit = B | KB | MB | GB
deriving (Eq, Show, Read, Ord, Typeable, Data)
data ImageResize = ResizeImage ImageSize
| Resize ImageSize
| ShrinkToMinimum
| KeepSize
deriving (Eq, Show, Read, Typeable, Data)
type Mounted a = (a, MountPoint)
imageFileName :: Image -> FilePath
imageFileName (Image f _ _) = f
getImageDestinationOutputFiles :: ImageTarget -> [FilePath]
getImageDestinationOutputFiles (ImageTarget d _ _) =
case d of
LiveInstallerImage liName liPath _ ->
let path = liPath </> "machines" </> liName </> "disks" </> "raw"
in [path </> "0.raw", path </> "0.size", path </> "VERSION"]
LocalFile (Image lfPath _ _) _ -> [lfPath]
_ -> []
itImageDestination :: ImageTarget -> ImageDestination
itImageDestination (ImageTarget d _ _) = d
itImageMountPoint :: ImageTarget -> MountPoint
itImageMountPoint (ImageTarget _ _ m) = m
isPartitioned :: Partition -> Bool
isPartitioned p | p == NoPT = False
| otherwise = True
getPartition :: Partition -> Int
getPartition (Partition p) = p
getPartition NoPT = error "No partitions!"
imageFileExtension :: ImageType -> String
imageFileExtension Raw = "raw"
imageFileExtension QCow2 = "qcow2"
imageFileExtension Vmdk = "vmdk"
changeImageFormat :: ImageType -> Image -> Image
changeImageFormat fmt' (Image img _ fs) = Image img' fmt' fs
where img' = replaceExtension img (imageFileExtension fmt')
changeImageDirectory :: FilePath -> Image -> Image
changeImageDirectory dir (Image img fmt fs) = Image img' fmt fs
where img' = dir </> takeFileName img
data SharedImage = SharedImage SharedImageName
SharedImageDate
SharedImageBuildId
ImageType
FileSystem
deriving (Eq,Read,Show)
siName :: SharedImage -> SharedImageName
siName (SharedImage n _ _ _ _) = n
siDate :: SharedImage -> SharedImageDate
siDate (SharedImage _ n _ _ _) = n
siBuildId :: SharedImage -> SharedImageBuildId
siBuildId (SharedImage _ _ n _ _) = n
instance Ord SharedImage where
compare (SharedImage n d b _ _) (SharedImage n' d' b' _ _) =
compare n n' <> compare d d' <> compare b b'
newtype SharedImageName = SharedImageName String deriving (Eq,Ord,Read,Show)
newtype SharedImageDate = SharedImageDate String deriving (Eq,Ord,Read,Show)
newtype SharedImageBuildId = SharedImageBuildId String deriving (Eq,Ord,Read,Show)
prettyPrintSharedImages :: [SharedImage] -> String
prettyPrintSharedImages imgs = Boxes.render table
where
table = Boxes.hsep 1 Boxes.left cols
where
cols = [nameC, dateC, idC]
where
nameC = col "Name" ((\(SharedImageName n) -> n) . siName)
dateC = col "Date" ((\(SharedImageDate n) -> n) . siDate)
idC = col "ID" ((\(SharedImageBuildId n) -> n) . siBuildId)
col title accessor =
(Boxes.text title) Boxes.// (Boxes.vcat Boxes.left cells)
where
cells = Boxes.text <$> accessor <$> imgs
sharedImageImage :: SharedImage -> Image
sharedImageImage (SharedImage (SharedImageName n)
_
(SharedImageBuildId bid)
sharedImageType
sharedImageFileSystem) =
Image (n ++ "_" ++ bid <.> imageFileExtension sharedImageType)
sharedImageType
sharedImageFileSystem
sharedImageFileName :: SharedImage -> FilePath
sharedImageFileName (SharedImage (SharedImageName n)
_
(SharedImageBuildId bid)
_
_) =
n ++ "_" ++ bid <.> sharedImageFileExtension
sharedImagesRootDirectory :: FilePath
sharedImagesRootDirectory = "b9_shared_images"
sharedImageFileExtension :: String
sharedImageFileExtension = "b9si"