module Data.Vhd.Batmap ( BatmapHeader(..) , KeyHash(..) , batmapSetKeyHash , batmapClearKeyHash ) where import Control.Applicative import qualified Data.ByteString as B import Data.Serialize import Data.Word import Data.Vhd.Serialize import Data.Vhd.Types import Data.Vhd.Checksum data BatmapHeader = BatmapHeader { batmapHeaderCookie :: Cookie , batmapHeaderOffset :: PhysicalByteAddress , batmapHeaderSize :: Word32 , batmapHeaderVersion :: Version , batmapHeaderChecksum :: Checksum , batmapHeaderMarker :: Word8 , batmapHeaderKeyHash :: KeyHash , batmapHeaderReserved :: B.ByteString } deriving (Show, Eq) newtype KeyHash = KeyHash (Maybe (B.ByteString, B.ByteString)) deriving (Show,Eq) instance Serialize BatmapHeader where get = BatmapHeader <$> getCookie <*> getDataOffset <*> getWord32be <*> getVersion <*> get <*> getWord8 <*> get <*> getByteString 418 put b = do putCookie $ batmapHeaderCookie b putDataOffset $ batmapHeaderOffset b putWord32be $ batmapHeaderSize b putVersion $ batmapHeaderVersion b put $ batmapHeaderChecksum b putWord8 $ batmapHeaderMarker b put $ batmapHeaderKeyHash b putByteString $ batmapHeaderReserved b instance Serialize KeyHash where get = do c <- getWord8 if c /= 1 then return $ KeyHash Nothing else do nonce <- getByteString 32 hash <- getByteString 32 return $ KeyHash (Just (nonce, hash)) put (KeyHash Nothing) = putByteString $ B.replicate (32+32+1) 0 put (KeyHash (Just (nonce, hash))) = do putWord8 1 putByteString nonce putByteString hash instance Sized BatmapHeader where sized _ = 512 batmapClearKeyHash :: BatmapHeader -> BatmapHeader batmapClearKeyHash bhdr = bhdr { batmapHeaderKeyHash = KeyHash Nothing } batmapSetKeyHash :: B.ByteString -> B.ByteString -> BatmapHeader -> BatmapHeader batmapSetKeyHash nonce hash bhdr | B.length nonce /= 32 || B.length hash /= 32 = error "not valid keyhash" | otherwise = bhdr { batmapHeaderKeyHash = KeyHash (Just (nonce, hash)) }