module Data.VHD.Types where import Control.Exception import Control.Monad import qualified Data.ByteString as B import Data.Word import System.Random import Text.Printf import Data.List import Data.Text.Encoding import qualified Data.Text as T data Header = Header { headerCookie :: Cookie , headerDataOffset :: Offset , headerTableOffset :: Offset , headerVersion :: Version , headerMaxTableEntries :: EntryCount , headerBlockSize :: BlockSize , headerCheckSum :: CheckSum , headerParentUniqueId :: UniqueId , headerParentTimeStamp :: TimeStamp , headerReserved1 :: B.ByteString , headerParentUnicodeName :: ParentUnicodeName , headerParentLocatorEntries :: ParentLocatorEntries } deriving (Show,Eq) data Footer = Footer { footerCookie :: Cookie , footerIsTemporaryDisk :: Bool , footerFormatVersion :: Version , footerDataOffset :: Offset , footerTimeStamp :: TimeStamp , footerCreatorApplication :: CreatorApplication , footerCreatorVersion :: Version , footerCreatorHostOs :: CreatorHostOs , footerOriginalSize :: Size , footerCurrentSize :: Size , footerDiskGeometry :: DiskGeometry , footerDiskType :: DiskType , footerCheckSum :: CheckSum , footerUniqueId :: UniqueId , footerIsSavedState :: Bool } deriving (Show,Eq) data BatmapHeader = BatmapHeader { batmapHeaderCookie :: Cookie , batmapHeaderOffset :: Offset , batmapHeaderSize :: Word32 , batmapHeaderVersion :: Version , batmapHeaderCheckSum :: CheckSum } deriving (Show,Eq) type BlockSize = Word32 type DiskGeometryCylinders = Word16 type DiskGeometryHeads = Word8 type DiskGeometrySectorsPerTrack = Word8 type CheckSum = Word32 type EntryCount = Word32 type Offset = Word64 type Size = Word64 type TimeStamp = Word32 data Version = Version VersionMajor VersionMinor deriving (Show,Eq) type VersionMajor = Word16 type VersionMinor = Word16 data CreatorHostOs = CreatorHostOsUnknown | CreatorHostOsWindows | CreatorHostOsMacintosh deriving (Show,Eq) data DiskGeometry = DiskGeometry DiskGeometryCylinders DiskGeometryHeads DiskGeometrySectorsPerTrack deriving (Show,Eq) data DiskType = DiskTypeFixed | DiskTypeDynamic | DiskTypeDifferencing deriving (Show,Eq) newtype Cookie = Cookie B.ByteString deriving (Show,Eq) newtype CreatorApplication = CreatorApplication B.ByteString deriving (Show,Eq) newtype ParentLocatorEntry = ParentLocatorEntry B.ByteString deriving (Show,Eq) newtype ParentUnicodeName = ParentUnicodeName String deriving (Show,Eq) newtype UniqueId = UniqueId B.ByteString deriving (Eq) instance Show UniqueId where show (UniqueId b) = intercalate "-" $ map disp [[0..3],[4,5],[6,7],[8,9],[10..15]] where disp = concatMap (printf "%02x" . B.index b) newtype ParentLocatorEntries = ParentLocatorEntries [ParentLocatorEntry] deriving (Show,Eq) cookie c = assert (B.length c == 8) $ Cookie c creatorApplication a = assert (B.length a == 4) $ CreatorApplication a parentLocatorEntries e = assert ( length e == 8) $ ParentLocatorEntries e parentLocatorEntry e = assert (B.length e == 24) $ ParentLocatorEntry e uniqueId i = assert (B.length i == 16) $ UniqueId i parentUnicodeName n | encodedLength > 512 = error "parent unicode name length need to be < 512 bytes" | otherwise = ParentUnicodeName n where encodedLength = B.length $ encodeUtf16BE $ T.pack n randomUniqueId :: IO UniqueId randomUniqueId = liftM (uniqueId . B.pack) $ replicateM 16 $ liftM fromIntegral $ randomRIO (0 :: Int, 255)