packages feed

bmp 1.1.2.1 → 1.2.0.1

raw patch · 11 files changed

+297/−137 lines, 11 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

- Codec.BMP: ErrorDodgyFileHeaderFieldFileSize :: Int -> Error
- Codec.BMP: ErrorFileIsTruncated :: Error
- Codec.BMP: ErrorLacksWholeNumberOfLines :: Error
- Codec.BMP: ErrorReadOfFileHeaderFailed :: Error
- Codec.BMP: ErrorReadOfImageDataFailed :: Error
- Codec.BMP: ErrorReadOfImageHeaderFailed :: Error
- Codec.BMP: ErrorUnexpectedImageSize :: Error
+ Codec.BMP: ErrorFileHeaderTruncated :: Error
+ Codec.BMP: ErrorImageDataTruncated :: Int -> Int -> Error
+ Codec.BMP: ErrorImageHeaderTruncated :: Error
+ Codec.BMP: ErrorImagePhysicalSizeMismatch :: Word32 -> Word32 -> Error
+ Codec.BMP: ErrorInternalErrorPleaseReport :: Error
+ Codec.BMP: errorBitmapHeaderSize :: Error -> Word32
+ Codec.BMP: errorBytesAvailable :: Error -> Int
+ Codec.BMP: errorBytesNeeded :: Error -> Int
+ Codec.BMP: errorColorDepth :: Error -> Word16
+ Codec.BMP: errorCompression :: Error -> Compression
+ Codec.BMP: errorFileHeaderOffset :: Error -> Word32
+ Codec.BMP: errorImageSizeFromHeader :: Error -> Word32
+ Codec.BMP: errorImageSizeOfBuffer :: Error -> Word32
+ Codec.BMP: errorPlanesCount :: Error -> Word16
- Codec.BMP: ErrorDodgyFileHeaderFieldOffset :: Int -> Error
+ Codec.BMP: ErrorDodgyFileHeaderFieldOffset :: Word32 -> Error
- Codec.BMP: ErrorUnhandledBitmapHeaderSize :: Int -> Error
+ Codec.BMP: ErrorUnhandledBitmapHeaderSize :: Word32 -> Error
- Codec.BMP: ErrorUnhandledColorDepth :: Int -> Error
+ Codec.BMP: ErrorUnhandledColorDepth :: Word16 -> Error
- Codec.BMP: ErrorUnhandledCompressionMode :: Error
+ Codec.BMP: ErrorUnhandledCompressionMode :: Compression -> Error
- Codec.BMP: ErrorUnhandledPlanesCount :: Int -> Error
+ Codec.BMP: ErrorUnhandledPlanesCount :: Word16 -> Error

Files

Codec/BMP.hs view
@@ -2,7 +2,8 @@  -- | Reading and writing uncompressed BMP files. -----   Reading works for both uncompressed 24bit RGB WindowsV3 and 32bit RGBA WindowsV4 formats.+--   Reading works for both uncompressed 24bit RGB and 32bit RGBA+--   WindowsV3, WindowsV4 and WindowsV5 formats. --  --   Writing is limited to the uncompressed 24bit RGB WindowsV3 format. --@@ -23,9 +24,13 @@ --  >    ...  --       -- Release Notes:++--  >  * bmp 1.2.0+--       Accept files with zero padding on the end.+--       Accept RGBA files with V3 headers. -- --  >  * bmp 1.1.2   ---  >    Handle files with the image size field set to zero.+--  >    Accept files with the image size field set to zero. -- module Codec.BMP 	( BMP		  (..)@@ -80,14 +85,12 @@ 		= BSL.splitAt (fromIntegral sizeOfFileHeader) buf 	 	if (fromIntegral $ BSL.length bufFileHeader) /= sizeOfFileHeader-	 then	return $ Left ErrorReadOfFileHeaderFailed+	 then	return $ Left ErrorFileHeaderTruncated 	 else	hGetBMP2 bufRest (decode bufFileHeader) 	 		 hGetBMP2 buf fileHeader  -- Check the magic before doing anything else.- --	If the specified file is not a BMP file then we'd prefer to get - --	this error than a `ReadOfImageHeaderFailed`.  | fileHeaderType fileHeader /= bmpMagic  = return $ Left $ ErrorBadMagic (fileHeaderType fileHeader) 	@@ -100,59 +103,58 @@ 	let (bufImageHeader, bufRest) 		= BSL.splitAt (fromIntegral sizeHeader) buf         -        -- How long we expect the image data to be.-        -- For uncompressed data without a colour table, all of the file that-        -- isn't the header should be image data. The length of the image data-        -- is sometimes recorded in the imageSize field of the header, but-        -- sometimes that field is zero, so we have to compute it like so..-        let expectedImageSize+        -- How much non-header data is present in the file.+        -- For uncompressed data without a colour table, the remaining data should+        -- be the image, but there may also be padding bytes on the end.+        let physicalBufferSize                 = (fromIntegral $ BSL.length bufRest) :: Word32  	if (fromIntegral $ BSL.length bufImageHeader) /= sizeHeader-	 then 	return $ Left ErrorReadOfImageHeaderFailed-	 else 	hGetBMP3 fileHeader bufImageHeader bufRest expectedImageSize+	 then 	return $ Left ErrorImageHeaderTruncated+	 else 	hGetBMP3 fileHeader bufImageHeader bufRest physicalBufferSize  			-hGetBMP3 fileHeader bufImageHeader bufRest expectedImageSize+hGetBMP3 fileHeader bufImageHeader bufRest physicalBufferSize 	| BSL.length bufImageHeader == 40  	= do	let info	= decode bufImageHeader-		case checkBitmapInfoV3 info expectedImageSize of+		case checkBitmapInfoV3 info physicalBufferSize of 		 Just err	-> return $ Left err-		 Nothing	-> hGetBMP4 fileHeader (InfoV3 info) bufRest-		                        (fromIntegral expectedImageSize)-{-					(fromIntegral $ dib3ImageSize info) -}+		 Nothing+                  | Just imageSize      <- imageSizeFromBitmapInfoV3 info+                  -> hGetBMP4 fileHeader (InfoV3 info) bufRest imageSize+                  | otherwise+                  -> return $ Left $ ErrorInternalErrorPleaseReport  	| BSL.length bufImageHeader == 108 	= do	let info	= decode bufImageHeader-		case checkBitmapInfoV4 info expectedImageSize of+		case checkBitmapInfoV4 info physicalBufferSize of 		 Just err	-> return $ Left err-		 Nothing	-> hGetBMP4 fileHeader (InfoV4 info) bufRest-                                        (fromIntegral expectedImageSize)-{-					(fromIntegral -						$ dib3ImageSize -						$ dib4InfoV3 info)--}		+		 Nothing	+                  | Just imageSize      <- imageSizeFromBitmapInfoV4 info+                  -> hGetBMP4 fileHeader (InfoV4 info) bufRest imageSize+                  | otherwise+                  -> return $ Left $ ErrorInternalErrorPleaseReport+		 	| BSL.length bufImageHeader == 124 	= do	let info	= decode bufImageHeader-		case checkBitmapInfoV5 info expectedImageSize of+		case checkBitmapInfoV5 info physicalBufferSize of 		 Just err	-> return $ Left err-		 Nothing	-> hGetBMP4 fileHeader (InfoV5 info) bufRest-                                        (fromIntegral expectedImageSize)-{-					(fromIntegral-					 	$ dib3ImageSize -						$ dib4InfoV3-						$ dib5InfoV4 info)--}+		 Nothing	+                  | Just imageSize      <- imageSizeFromBitmapInfoV5 info+                  -> hGetBMP4 fileHeader (InfoV5 info) bufRest imageSize+                  | otherwise+                  -> return $ Left $ ErrorInternalErrorPleaseReport 		 	| otherwise- 	= return -		$ Left -		$ ErrorUnhandledBitmapHeaderSize (fromIntegral $ BSL.length bufImageHeader)+ 	= return $ Left +		 $ ErrorUnhandledBitmapHeaderSize +                 $ fromIntegral $ BSL.length bufImageHeader   hGetBMP4 fileHeader imageHeader bufImage (sizeImage :: Int)- = if (fromIntegral $ BSL.length bufImage) /= sizeImage-	 then return $ Left ErrorReadOfImageDataFailed+ = let  bufLen  = fromIntegral $ BSL.length bufImage+   in   if bufLen < sizeImage+	 then return $ Left $ ErrorImageDataTruncated sizeImage bufLen 	 else return  		$ Right $ BMP  		{ bmpFileHeader 	= fileHeader
Codec/BMP/Base.hs view
@@ -1,11 +1,12 @@ {-# OPTIONS_HADDOCK hide #-} module Codec.BMP.Base-	(BMP	(..))+	( BMP	(..)) where import Codec.BMP.FileHeader import Codec.BMP.BitmapInfo import Data.ByteString + -- | A BMP image. --	For an uncompressed image, the image data contains triples of BGR component values. --	Each line may also have zero pad values on the end, to bring them up to a multiple@@ -16,8 +17,5 @@ 	, bmpBitmapInfo		:: BitmapInfo 	, bmpRawImageData	:: ByteString } 	deriving Show---  
Codec/BMP/BitmapInfo.hs view
@@ -18,6 +18,7 @@ 	| InfoV5 BitmapInfoV5 	deriving (Show) + instance Binary BitmapInfo where  get   = do	size	<- lookAhead getWord32le 
Codec/BMP/BitmapInfoV3.hs view
@@ -4,13 +4,16 @@ 	( BitmapInfoV3	(..) 	, Compression (..) 	, sizeOfBitmapInfoV3-	, checkBitmapInfoV3)+	, checkBitmapInfoV3+        , imageSizeFromBitmapInfoV3) where import Codec.BMP.Error+import Codec.BMP.Compression import Data.Binary import Data.Binary.Get	 import Data.Binary.Put + -- | Device Independent Bitmap (DIB) header for Windows V3. data BitmapInfoV3 	= BitmapInfoV3			@@ -53,17 +56,7 @@ 	} 	deriving (Show) -data Compression-	= CompressionRGB-	| CompressionRLE8-	| CompressionRLE4-	| CompressionBitFields-	| CompressionJPEG-	| CompressionPNG-	| CompressionUnknown Word32-	deriving (Show, Eq) - -- | Size of `BitmapInfoV3` header (in bytes) sizeOfBitmapInfoV3 :: Int sizeOfBitmapInfoV3 = 40@@ -109,54 +102,70 @@ 	putWord32le	$ dib3ColorsUsed header 	putWord32le	$ dib3ColorsImportant header 	-	-instance Binary Compression where- get-  = do	c	<- getWord32le-	case c of-	 0	-> return $ CompressionRGB-	 1	-> return $ CompressionRLE8-	 2	-> return $ CompressionRLE4-	 3	-> return $ CompressionBitFields-	 4	-> return $ CompressionJPEG-	 5	-> return $ CompressionPNG-	 _	-> return $ CompressionUnknown c-	- put c-  = case c of-	CompressionRGB		-> putWord32le 0-	CompressionRLE8		-> putWord32le 1-	CompressionRLE4		-> putWord32le 2-	CompressionBitFields	-> putWord32le 3-	CompressionJPEG		-> putWord32le 4-	CompressionPNG		-> putWord32le 5-	CompressionUnknown x	-> putWord32le x-	-	+		 -- | Check headers for problems and unsupported features.	 ---	With a V3 header we only support the uncompressed 24bit RGB format. checkBitmapInfoV3 :: BitmapInfoV3 -> Word32 -> Maybe Error-checkBitmapInfoV3 header expectedImageSize-		+checkBitmapInfoV3 header physicalBufferSize++        -- We only handle a single color plane. 	| dib3Planes header /= 1-	= Just	$ ErrorUnhandledPlanesCount -		$ fromIntegral $ dib3Planes header-	-	| dib3ImageSize header /= 0-	, dib3ImageSize header /= expectedImageSize-	= Just	$ ErrorUnexpectedImageSize+	= Just	$ ErrorUnhandledPlanesCount $ dib3Planes header 	-	| expectedImageSize `mod` dib3Height header /= 0-	= Just	$ ErrorLacksWholeNumberOfLines-+        -- We only handle 24 and 32 bit images. 	| dib3BitCount header /= 24-	= Just 	$ ErrorUnhandledColorDepth-		$ fromIntegral $ dib3BitCount header+        , dib3BitCount header /= 32+	= Just 	$ ErrorUnhandledColorDepth $ dib3BitCount header -	| dib3Compression header /= CompressionRGB-	= Just	$ ErrorUnhandledCompressionMode-	+        -- If the image size field in the header is non-zero, +        -- then it must be the same as the physical size of the image buffer.+        | headerImageSize               <- dib3ImageSize header+        , headerImageSize /= 0+        , fromIntegral headerImageSize /= physicalBufferSize+        = Just  $ ErrorImagePhysicalSizeMismatch+                        headerImageSize physicalBufferSize++        -- Check that the physical buffer contains enough image data.+        -- It may contain more, as some encoders put padding bytes+        -- on the end.+        | Just calculatedImageSize      <- imageSizeFromBitmapInfoV3 header+        , fromIntegral physicalBufferSize < calculatedImageSize+        = Just  $ ErrorImageDataTruncated +                        calculatedImageSize+                        (fromIntegral physicalBufferSize)++        -- We only handle uncompresssed images.+        | dib3Compression header /= CompressionRGB+        = Just  $ ErrorUnhandledCompressionMode (dib3Compression header)+ 	| otherwise 	= Nothing 	++-- | Compute the size of the image data from the header.+--+--   * We can't just use the 'dib3ImageSize' field because some encoders+--     set this to zero.+--+--   * We also can't use the physical size of the data in the file because+--     some encoders add zero padding bytes on the end.   +--+imageSizeFromBitmapInfoV3 :: BitmapInfoV3 -> Maybe Int+imageSizeFromBitmapInfoV3 header+        | dib3BitCount    header == 32+        , dib3Planes      header == 1+        , dib3Compression header == CompressionRGB+        = Just $ fromIntegral (dib3Width header * dib3Height header * 4)++        | dib3BitCount    header == 24+        , dib3Planes      header == 1+        , dib3Compression header == CompressionRGB+        = let   imageBytesPerLine = dib3Width header * 3+                tailBytesPerLine  = imageBytesPerLine `mod` 4+                padBytesPerLine   = if tailBytesPerLine > 0+                                        then 4 - tailBytesPerLine+                                        else 0+          in    Just $ fromIntegral (dib3Height header * imageBytesPerLine + padBytesPerLine)++        | otherwise+        = Nothing 
Codec/BMP/BitmapInfoV4.hs view
@@ -4,7 +4,8 @@ 	( BitmapInfoV4	(..) 	, CIEXYZ        (..) 	, sizeOfBitmapInfoV4-	, checkBitmapInfoV4)+	, checkBitmapInfoV4+        , imageSizeFromBitmapInfoV4) where import Codec.BMP.Error import Codec.BMP.CIEXYZ@@ -93,27 +94,43 @@ --	and the uncompressed 32bit RGBA format. -- checkBitmapInfoV4 :: BitmapInfoV4 -> Word32 -> Maybe Error-checkBitmapInfoV4 headerV4 expectedImageSize+checkBitmapInfoV4 headerV4 physicalBufferSize 		+        -- We only handle a single color plane. 	| dib3Planes headerV3 /= 1-	= Just	$ ErrorUnhandledPlanesCount -		$ fromIntegral $ dib3Planes headerV3+	= Just	$ ErrorUnhandledPlanesCount $ dib3Planes headerV3 -	| dib3ImageSize headerV3 /= 0-	, dib3ImageSize headerV3 /= expectedImageSize-	= Just	$ ErrorUnexpectedImageSize-		-	| expectedImageSize `mod` dib3Height headerV3 /= 0-	= Just	$ ErrorLacksWholeNumberOfLines+        -- We only handle 24 and 32 bit images.+        | dib3BitCount headerV3 /= 24+        , dib3BitCount headerV3 /= 32+        = Just  $ ErrorUnhandledColorDepth $ dib3BitCount headerV3 +        -- If the image size field in the header is non-zero, +        -- then it must be the same as physical size of the image buffer.+        | headerImageSize               <- dib3ImageSize headerV3+        , headerImageSize /= 0+        , fromIntegral headerImageSize /= physicalBufferSize+        = Just  $ ErrorImagePhysicalSizeMismatch+                        headerImageSize physicalBufferSize++        -- Check that the physical buffer contains enough image data.+        -- It may contain more, as some encoders put padding bytes+        -- on the end.+        | Just calculatedImageSize      <- imageSizeFromBitmapInfoV4 headerV4+        , fromIntegral physicalBufferSize < calculatedImageSize+        = Just  $ ErrorImageDataTruncated +                        calculatedImageSize+                        (fromIntegral physicalBufferSize)++ 	-- Check for valid compression modes ---- -	-- uncompressed 24bit RGB-	| dib3BitCount    headerV3 == 24 -	, dib3Compression headerV3 == CompressionRGB-	= Nothing+        -- uncompressed 32bit RGBA stated as CompressionRGB.+        | dib3BitCount    headerV3 == 32+        , dib3Compression headerV3 == CompressionRGB+        = Nothing 	-	-- uncompressed 32bit RGBA+	-- uncompressed 32bit RGBA stated as CompressionBitFields. 	| dib3BitCount    headerV3 == 32 	, dib3Compression headerV3 == CompressionBitFields 	, dib4AlphaMask   headerV4 == 0xff000000@@ -121,11 +138,53 @@ 	, dib4GreenMask   headerV4 == 0x0000ff00 	, dib4BlueMask    headerV4 == 0x000000ff 	= Nothing++        -- uncompressed 24bit RGB+        | dib3BitCount    headerV3 == 24 +        , dib3Compression headerV3 == CompressionRGB+        = Nothing 	 	-- Some unsupported compression mode ---- 	| otherwise-	= Just $ ErrorUnhandledCompressionMode+	= Just $ ErrorUnhandledCompressionMode (dib3Compression headerV3) 	 	where	headerV3 = dib4InfoV3 headerV4-	-	+++-- | Compute the size of the image data from the header.+--+--   * We can't just use the 'dib3ImageSize' field because some encoders+--     set this to zero.+--+--   * We also can't use the physical size of  the data in the file because+--     some encoders add zero padding bytes on the end.   +imageSizeFromBitmapInfoV4 :: BitmapInfoV4 -> Maybe Int+imageSizeFromBitmapInfoV4 headerV4+        | dib3BitCount    headerV3 == 32+        , dib3Planes      headerV3 == 1+        , dib3Compression headerV3 == CompressionRGB+        = Just $ fromIntegral (dib3Width headerV3 * dib3Height headerV3 * 4)++        | dib3BitCount    headerV3 == 32+        , dib3Planes      headerV3 == 1+        , dib3Compression headerV3 == CompressionBitFields+        , dib4AlphaMask   headerV4 == 0xff000000+        , dib4RedMask     headerV4 == 0x00ff0000+        , dib4GreenMask   headerV4 == 0x0000ff00+        , dib4BlueMask    headerV4 == 0x000000ff+        = Just $ fromIntegral (dib3Width headerV3 * dib3Height headerV3 * 4)        ++        | dib3BitCount    headerV3 == 24+        , dib3Planes      headerV3 == 1+        , dib3Compression headerV3 == CompressionRGB+        = let   imageBytesPerLine = dib3Width headerV3 * 3+                tailBytesPerLine  = imageBytesPerLine `mod` 4+                padBytesPerLine   = if tailBytesPerLine > 0+                                        then 4 - tailBytesPerLine+                                        else 0+          in    Just $ fromIntegral (dib3Height headerV3 * imageBytesPerLine + padBytesPerLine)++        | otherwise+        = Nothing++        where   headerV3 = dib4InfoV3 headerV4
Codec/BMP/BitmapInfoV5.hs view
@@ -2,7 +2,8 @@ module Codec.BMP.BitmapInfoV5 	( BitmapInfoV5	(..) 	, sizeOfBitmapInfoV5-	, checkBitmapInfoV5)+	, checkBitmapInfoV5+        , imageSizeFromBitmapInfoV5) where import Codec.BMP.Error import Codec.BMP.BitmapInfoV4@@ -64,5 +65,11 @@ checkBitmapInfoV5 :: BitmapInfoV5 -> Word32 -> Maybe Error checkBitmapInfoV5 header expectedImageSize 	= checkBitmapInfoV4 (dib5InfoV4 header) expectedImageSize+++-- | Compute the size of the image data from the header.+imageSizeFromBitmapInfoV5 :: BitmapInfoV5 -> Maybe Int+imageSizeFromBitmapInfoV5 +        = imageSizeFromBitmapInfoV4 . dib5InfoV4  
+ Codec/BMP/Compression.hs view
@@ -0,0 +1,43 @@+{-# OPTIONS_HADDOCK hide #-}+module Codec.BMP.Compression+        (Compression(..))+where+import Data.Word+import Data.Binary+import Data.Binary.Get  +import Data.Binary.Put+++data Compression+        = CompressionRGB+        | CompressionRLE8+        | CompressionRLE4+        | CompressionBitFields+        | CompressionJPEG+        | CompressionPNG+        | CompressionUnknown Word32+        deriving (Show, Eq)+++instance Binary Compression where+ get+  = do  c       <- getWord32le+        case c of+         0      -> return $ CompressionRGB+         1      -> return $ CompressionRLE8+         2      -> return $ CompressionRLE4+         3      -> return $ CompressionBitFields+         4      -> return $ CompressionJPEG+         5      -> return $ CompressionPNG+         _      -> return $ CompressionUnknown c+        + put c+  = case c of+        CompressionRGB          -> putWord32le 0+        CompressionRLE8         -> putWord32le 1+        CompressionRLE4         -> putWord32le 2+        CompressionBitFields    -> putWord32le 3+        CompressionJPEG         -> putWord32le 4+        CompressionPNG          -> putWord32le 5+        CompressionUnknown x    -> putWord32le x+        
Codec/BMP/Error.hs view
@@ -2,23 +2,59 @@ module Codec.BMP.Error 	(Error(..)) where+import Codec.BMP.Compression import Data.Word  -- | Things that can go wrong when loading a BMP file. data Error-	= ErrorReadOfFileHeaderFailed-	| ErrorReadOfImageHeaderFailed-	| ErrorReadOfImageDataFailed-	| ErrorBadMagic 			Word16++        -- | Magic number was not at the start of the file, +        --   so this probably isn't a BMP file.+        = ErrorBadMagic                         Word16++        -- | File is too short to contain a file header.+	| ErrorFileHeaderTruncated++        -- | File is too short to contain an image header.+	| ErrorImageHeaderTruncated++        -- | File is too short to contain the image data.+	| ErrorImageDataTruncated+        { errorBytesNeeded      :: Int+        , errorBytesAvailable   :: Int }++        -- | Reserved fields should be zero. 	| ErrorReservedFieldNotZero-	| ErrorDodgyFileHeaderFieldOffset	Int-	| ErrorDodgyFileHeaderFieldFileSize	Int-	| ErrorFileIsTruncated-	| ErrorUnhandledBitmapHeaderSize  	Int-	| ErrorUnhandledPlanesCount		Int-	| ErrorUnhandledColorDepth		Int++        -- | The offset to the image data from the file header doesn't+        --   point anywhere sensible.+	| ErrorDodgyFileHeaderFieldOffset+        { errorFileHeaderOffset :: Word32 }++        -- | We handle V3 V4 and V5 image headers, but the size of +        --   the header indicates it has some other format.+	| ErrorUnhandledBitmapHeaderSize+        { errorBitmapHeaderSize :: Word32 }++        -- | We only handle single color planes.+	| ErrorUnhandledPlanesCount+        { errorPlanesCount      :: Word16 }++        -- | We only handle 24 and 32 bit images.+	| ErrorUnhandledColorDepth+        { errorColorDepth       :: Word16 }++        -- | We only handle uncompressed images. 	| ErrorUnhandledCompressionMode-	| ErrorUnexpectedImageSize-	| ErrorLacksWholeNumberOfLines+        { errorCompression      :: Compression}++        -- | Mismatch between the image size stated in the header+        --   and that which is calculuated from the other fields.+        | ErrorImagePhysicalSizeMismatch +        { errorImageSizeFromHeader  :: Word32+        , errorImageSizeOfBuffer    :: Word32 }++        -- | Something went wrong in the library.+        | ErrorInternalErrorPleaseReport 	deriving (Eq, Show) 
Codec/BMP/FileHeader.hs view
@@ -70,10 +70,11 @@ 	| fileHeaderType header /= bmpMagic 	= Just	$ ErrorBadMagic (fileHeaderType header) -	| fileHeaderFileSize header -		< fromIntegral (sizeOfFileHeader + sizeOfBitmapInfoV3)-	= Just	$ ErrorDodgyFileHeaderFieldFileSize -		$ fromIntegral $ fileHeaderFileSize header+        | fileHeaderFileSize header < fromIntegral sizeOfFileHeader+        = Just  $ ErrorFileHeaderTruncated++        | fileHeaderFileSize header < fromIntegral (sizeOfFileHeader + sizeOfBitmapInfoV3)+        = Just  $ ErrorImageHeaderTruncated  	| fileHeaderReserved1 header /= 0 	= Just 	$ ErrorReservedFieldNotZero
Codec/BMP/Unpack.hs view
@@ -26,7 +26,7 @@    in	case bitCount of 	 24	-> packRGB24ToRGBA32 width height (bmpRawImageData bmp) 	 32	-> packRGB32ToRGBA32 width height (bmpRawImageData bmp)-	 _	-> error "Codec.BMP.unpackBMPToRGBA32: unhandled bitcount"+	 _	-> error "Codec.BMP.unpackBMPToRGBA32: unhandled bitcount."   -- | Unpack raw, uncompressed 24 bit BMP image data to a string of RGBA component values.@@ -41,13 +41,16 @@  = let	bytesPerLine	= BS.length str `div` height 	padPerLine	= bytesPerLine - width * 3 	sizeDest	= width * height * 4-   in	if height * (width * 3 + padPerLine) /= BS.length str-	 then error "Codec.BMP.unpackRGB24ToRGBA32: given image dimensions don't match input data."++        -- We allow padding bytes on the end of the image data.+   in	if BS.length str < height * (width * 3 + padPerLine)+	 then error "Codec.BMP.unpackRGB24ToRGBA32: image data is truncated."  	 else unsafePerformIO        	 	$ allocaBytes sizeDest      $ \bufDest ->     	   	  BS.unsafeUseAsCString str $ \bufSrc  ->             	   do	packRGB24ToRGBA32' width height padPerLine (castPtr bufSrc) (castPtr bufDest) 			packCStringLen (bufDest, sizeDest)+ 		 -- We're doing this via Ptrs because we don't want to take the -- overhead of doing the bounds checks in ByteString.index.@@ -89,8 +92,8 @@ 		 packRGB32ToRGBA32 width height str   = let sizeDest = height * width * 4-    in  if sizeDest /= BS.length str-	 then error "Codec.BMP.unpackRGB24ToRGBA32: given image dimensions don't match input data."+    in  if  BS.length str < sizeDest+	 then error "Codec.BMP.packRGB24ToRGBA32: image data is truncated."  	 else unsafePerformIO        	 	$ allocaBytes sizeDest      $ \bufDest ->     	   	  BS.unsafeUseAsCString str $ \bufSrc  ->
bmp.cabal view
@@ -1,5 +1,5 @@ Name:                bmp-Version:             1.1.2.1+Version:             1.2.0.1 License:             MIT License-file:        LICENSE Author:              Ben Lippmeier@@ -16,7 +16,7 @@ Synopsis:         Read and write uncompressed BMP image files. -Tested-with: GHC == 6.12.1+Tested-with: GHC == 7.2  Library   Build-Depends: @@ -25,13 +25,14 @@         binary               >= 0.5.0.2 && < 0.6.0.0    ghc-options:-        -Wall -fno-warn-missing-signatures -fno-warn-missing-fields+        -Wall -fno-warn-missing-signatures    Exposed-modules:         Codec.BMP    Other-modules:         Codec.BMP.Base+        Codec.BMP.Compression         Codec.BMP.BitmapInfo         Codec.BMP.BitmapInfoV3         Codec.BMP.BitmapInfoV4