diff --git a/Graphics/ExifTags.hs b/Graphics/ExifTags.hs --- a/Graphics/ExifTags.hs +++ b/Graphics/ExifTags.hs @@ -35,7 +35,7 @@ showT :: Show a => a -> Text showT = T.pack . show -exposureTime = exifSubIfdTag "exposureTime" 0x829a $ ppExposureTime +exposureTime = exifSubIfdTag "exposureTime" 0x829a ppExposureTime fnumber = exifSubIfdTag "fnumber" 0x829d ppAperture exposureProgram = exifSubIfdTag "exposureProgram" 0x8822 ppExposureProgram spectralSensitivity = exifSubIfdTag "spectralSensitivity" 0x8824 showT @@ -46,7 +46,7 @@ dateTimeDigitized = exifSubIfdTag "dateTimeDigitized" 0x9004 showT componentConfiguration = exifSubIfdTag "componentConfiguration" 0x9101 ppComponentConfiguration compressedBitsPerPixel = exifSubIfdTag "compressedBitsPerPixel" 0x9102 (T.pack . formatAsFloatingPoint 2) -shutterSpeedValue = exifSubIfdTag "shutterSpeedValue" 0x9201 $ ppExposureTime +shutterSpeedValue = exifSubIfdTag "shutterSpeedValue" 0x9201 ppExposureTime apertureValue = exifSubIfdTag "apertureValue" 0x9202 ppApexAperture brightnessValue = exifSubIfdTag "brightnessValue" 0x9203 $ asFpWithFormat "%s EV" exposureBiasValue = exifSubIfdTag "exposureBiasValue" 0x9204 $ asFpWithFormat "%s EV" @@ -92,6 +92,15 @@ subjectDistanceRange = exifSubIfdTag "subjectDistanceRange" 0xa40c ppSubjectDistanceRange imageUniqueId = exifSubIfdTag "imageUniqueId" 0xa420 showT exifInteroperabilityOffset=exifSubIfdTag "exifInteroperabilityOffset" 0xa005 showT +offsetTime = exifSubIfdTag "offsetTime" 0x9010 showT +offsetTimeDigitized = exifSubIfdTag "Offset Time Digitized" 0x9012 showT +offsetTimeOriginal = exifSubIfdTag "Offset Time Original" 0x9011 showT +lensSpecification = exifSubIfdTag "lensSpecification" 0xa432 showT -- also called lensInfo +lensMake = exifSubIfdTag "lensMake" 0xa433 showT +lensModel = exifSubIfdTag "lensModel" 0xa434 showT +compositeImage = exifSubIfdTag "compositeImage" 0xa460 showT +compositeImageCount = exifSubIfdTag "compositeImageCount" 0xa461 showT +compositeImageExposureTimes = exifSubIfdTag "compositeImageExposureTimes" 0xa462 showT imageDescription = exifIfd0Tag "imageDescription" 0x010e showT make = exifIfd0Tag "make" 0x010f showT @@ -110,6 +119,7 @@ referenceBlackWhite = exifIfd0Tag "referenceBlackWhite" 0x0214 showT copyright = exifIfd0Tag "copyright" 0x8298 showT printImageMatching = exifIfd0Tag "printImageMatching" 0xc4a5 ppUndef +hostComputer = exifIfd0Tag "hostComputer" 0x13c showT gpsVersionID = exifGpsTag "gpsVersionID" 0x0000 showT gpsLatitudeRef = exifGpsTag "gpsLatitudeRef" 0x0001 ppGpsLatitudeRef @@ -168,7 +178,10 @@ gpsImgDirectionRef, gpsImgDirection, gpsMapDatum, gpsDestLatitudeRef, gpsDestLatitude, gpsDestLongitudeRef, gpsDestLongitude, gpsDestBearingRef, gpsDestBearing, gpsDestDistanceRef, gpsDestDistance, gpsProcessingMethod, - gpsAreaInformation, gpsDateStamp, gpsDifferential] + gpsAreaInformation, gpsDateStamp, gpsDifferential, + offsetTime, offsetTimeDigitized, offsetTimeOriginal, lensSpecification, + lensMake, lensModel, compositeImage, compositeImageCount, compositeImageExposureTimes, + hostComputer] -- | Extract the GPS latitude and longitude where the picture was taken -- (if it is present in the EXIF) @@ -238,9 +251,9 @@ ppGpsLatitudeRef :: ExifValue -> Text ppGpsLatitudeRef (ExifText "N") = "North" ppGpsLatitudeRef (ExifText "S") = "South" -ppGpsLatitudeRef v@_ = T.pack $ "Invalid latitude: " ++ show v +ppGpsLatitudeRef v = T.pack $ "Invalid latitude: " ++ show v ppGpsLongitudeRef :: ExifValue -> Text ppGpsLongitudeRef (ExifText "E") = "East" ppGpsLongitudeRef (ExifText "W") = "West" -ppGpsLongitudeRef v@_ = T.pack $ "Invalid longitude: " ++ show v +ppGpsLongitudeRef v = T.pack $ "Invalid longitude: " ++ show v diff --git a/Graphics/Helpers.hs b/Graphics/Helpers.hs --- a/Graphics/Helpers.hs +++ b/Graphics/Helpers.hs @@ -3,7 +3,6 @@ import Data.Binary.Get import qualified Data.ByteString.Lazy as B import Control.Monad (replicateM) -import Control.Applicative ( (<$>) ) import Data.Char (chr, isDigit, ord) -- | Suppress the 'Left' value of an 'Either' diff --git a/Graphics/HsExif.hs b/Graphics/HsExif.hs --- a/Graphics/HsExif.hs +++ b/Graphics/HsExif.hs @@ -147,7 +147,6 @@ import qualified Data.ByteString.Lazy as B import qualified Data.ByteString as BS import Control.Monad -import Control.Applicative ( (<$>) ) import qualified Data.ByteString.Char8 as Char8 import Data.ByteString.Internal (w2c) import Data.Word @@ -177,7 +176,7 @@ -- The reading is strict to avoid file handle exhaustion on a recursive -- reading of a directory tree. parseFileExif :: FilePath -> IO (Either String (Map ExifTag ExifValue)) -parseFileExif filename = withFile filename ReadMode ((evaluate =<<) . fmap parseExif . B.hGetContents) +parseFileExif filename = withFile filename ReadMode ((evaluate . parseExif) <=< B.hGetContents) -- | Read EXIF data from a lazy bytestring. parseExif :: B.ByteString -> Either String (Map ExifTag ExifValue) @@ -186,6 +185,15 @@ getExif :: Get (Map ExifTag ExifValue) getExif = do firstBytes <- lookAhead $ (,) <$> getWord16be <*> getWord16be + + ftypheic <- lookAhead $ do + skip 4 + ftyp <- getByteString 4 + skip 8 + mif <- getByteString 4 + -- https://github.com/kamadak/exif-rs/blob/b279fa00a80a1136c10e2c6b3980a040adc92f05/src/isobmff.rs#L33-L37 + return $ ftyp == "ftyp" && mif `elem` ["mif1", "msf1"] + case firstBytes of (0xffd8,_ ) -> getWord16be >> findAndParseExifBlockJPEG (0x4d4d,0x002A) -> findAndParseExifBlockTiff -- TIFF big-endian: DNG, Nikon @@ -196,7 +204,9 @@ (0x4949,0x5500) -> findAndParseExifBlockTiff -- Panasonic RW2 -- Fuji RAF files use a custom format with an embedded JPEG preview containing the EXIF data (0x4655,0x4A49) -> findAndParseExifBlockFuji -- Fuji RAF - _ -> fail "Not a JPEG, TIFF, RAF, or TIFF-based raw file" + _ -> if ftypheic + then findAndParseExifBlockHEIC + else fail "Not a JPEG, TIFF, RAF, or TIFF-based raw file" findAndParseExifBlockJPEG :: Get (Map ExifTag ExifValue) findAndParseExifBlockJPEG = do @@ -231,6 +241,14 @@ + 2 -- findAndParseExifBlockJPEG expects 2 bytes skipped findAndParseExifBlockJPEG +findAndParseExifBlockHEIC :: Get (Map ExifTag ExifValue) +findAndParseExifBlockHEIC = do + (e, nul, aligned) <- lookAhead $ (,,) <$> getByteString 4 <*> (toInteger <$> getWord16be) <*> getByteString 2 + + if e == "Exif" && nul == 0 && aligned `elem` ["MM", "II"] + then skip 6 >> parseTiff + else skip 1 >> findAndParseExifBlockHEIC + data ByteAlign = Intel | Motorola deriving (Eq) getWord16 :: ByteAlign -> Get Word16 @@ -280,7 +298,7 @@ skip offset dirEntriesCount <- fromIntegral <$> getWord16 byteAlign replicateM dirEntriesCount (parseIfEntry byteAlign ifdId) - + concat <$> mapM (entryTags byteAlign) entries -- | Convert IFD entries to tags, reading sub-IFDs @@ -347,7 +365,7 @@ { dataTypeId = 3, dataLength = 2, - readSingle = liftM (ExifNumber . fromIntegral) . getWord16, + readSingle = fmap (ExifNumber . fromIntegral) . getWord16, readMany = readNumberList getWord16 } @@ -355,7 +373,7 @@ { dataTypeId = 4, dataLength = 4, - readSingle = liftM (ExifNumber . fromIntegral) . getWord32, + readSingle = fmap (ExifNumber . fromIntegral) . getWord32, readMany = readNumberList getWord32 } @@ -378,7 +396,7 @@ dataTypeId = 6, dataLength = 1, readSingle = \_ -> ExifNumber . signedInt8ToInt <$> getWord8, - readMany = readNumberList (liftM signedInt8ToInt . const getWord8) + readMany = readNumberList (fmap signedInt8ToInt . const getWord8) } undefinedValueHandler = ValueHandler @@ -393,16 +411,16 @@ { dataTypeId = 8, dataLength = 2, - readSingle = liftM (ExifNumber . signedInt16ToInt) . getWord16, - readMany = readNumberList (liftM signedInt16ToInt . getWord16) + readSingle = fmap (ExifNumber . signedInt16ToInt) . getWord16, + readMany = readNumberList (fmap signedInt16ToInt . getWord16) } signedLongValueHandler = ValueHandler { dataTypeId = 9, dataLength = 4, - readSingle = liftM (ExifNumber . signedInt32ToInt) . getWord32, - readMany = readNumberList (liftM signedInt32ToInt . getWord32) + readSingle = fmap (ExifNumber . signedInt32ToInt) . getWord32, + readMany = readNumberList (fmap signedInt32ToInt . getWord32) } readSignedRationalContents :: (Int -> Int -> a) -> ByteAlign -> Get a diff --git a/Graphics/PrettyPrinters.hs b/Graphics/PrettyPrinters.hs --- a/Graphics/PrettyPrinters.hs +++ b/Graphics/PrettyPrinters.hs @@ -52,7 +52,7 @@ ppExposureTime :: ExifValue -> Text ppExposureTime v@(ExifRational num den) = let seconds = fromIntegral num / (fromIntegral den :: Double) - value | seconds <= 0.25 && seconds > 0 = "1/" ++ show ((round (1 / seconds)) :: Int) + value | seconds <= 0.25 && seconds > 0 = "1/" ++ show (round (1 / seconds) :: Int) | otherwise = formatAsNumber 1 v in T.append (T.pack value) " sec." ppExposureTime v = T.pack (show v) @@ -206,7 +206,7 @@ where numbers = fromIntegral <$> BS.unpack bs formatComponent = fromMaybe "?" . flip Map.lookup componentMap -ppComponentConfiguration v@_ = unknown v +ppComponentConfiguration v = unknown v ppFlashPixVersion :: ExifValue -> Text ppFlashPixVersion = formatVersion "FlashPix version %.1f" @@ -219,26 +219,26 @@ where num :: Float = read asStr / 100.0 asStr = T.unpack $ decodeUtf8 s -formatVersion _ v@_ = unknown v +formatVersion _ v = unknown v #if ICONV getIconvEncodingName :: Text -> EncodingName getIconvEncodingName "JIS" = "SJIS" -getIconvEncodingName x@_ = T.unpack x -- ASCII and UNICODE work out of the box. +getIconvEncodingName x = T.unpack x -- ASCII and UNICODE work out of the box. ppUserComment :: ExifValue -> Text ppUserComment (ExifUndefined v) = decodeUtf8 $ BL.toStrict $ convertFuzzy Transliterate encoding "UTF8" rawText where encoding = getIconvEncodingName $ decodeUtf8 $ BS.take 8 v rawText = BL.fromStrict $ BS.drop 8 v -ppUserComment v@_ = unknown v +ppUserComment v = unknown v #else ppUserComment :: ExifValue -> Text ppUserComment (ExifUndefined v) = decodeUtf8 $ BS.drop 8 v -ppUserComment v@_ = unknown v +ppUserComment v = unknown v #endif diff --git a/hsexif.cabal b/hsexif.cabal --- a/hsexif.cabal +++ b/hsexif.cabal @@ -1,5 +1,5 @@ name: hsexif -version: 0.6.1.9 +version: 0.6.1.10 synopsis: EXIF handling library in pure Haskell description: The hsexif library provides functions for working with EXIF data contained in JPEG files. Currently it only supports reading the data. diff --git a/tests/Tests.hs b/tests/Tests.hs --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -11,14 +11,13 @@ import Data.Time.LocalTime import Data.Time.Calendar import Data.Char (chr) -import Control.Monad (join) -import Control.Applicative ( (<$>) ) import Data.List import Graphics.Types (formatAsRational) import Graphics.PrettyPrinters (ppExposureTime) import Graphics.HsExif import Graphics.Helpers +import Graphics.ExifTags main :: IO () main = do @@ -30,6 +29,7 @@ gps3 <- B.readFile "tests/gps3.jpg" partial <- B.readFile "tests/partial_exif.jpg" tiff <- B.readFile "tests/RAW_NIKON_D1.NEF" + appleHEIC <- B.readFile "tests/Apple_iPhone14.HEIC" let parseExifM = hush . parseExif let exifData = parseExifM imageContents let gpsExifData = parseExifM gps @@ -54,6 +54,7 @@ describe "flash fired" $ testFlashFired exifData describe "partial exif data" $ testPartialExif partial describe "tiff file" $ testNef tiffExifData + describe "Apple HEIC file" $ testHEIC appleHEIC describe "unusual data layouts" $ do it "parses EXIF below IDF0" $ do @@ -61,14 +62,13 @@ case result of Left err -> assertBool ("Cannot parse: " ++ err) False Right tags -> do - (Map.lookup dateTimeOriginal tags) `assertEqual'` (Just $ ExifText "2013:10:02 20:33:33") + Map.lookup dateTimeOriginal tags `assertEqual'` Just (ExifText "2013:10:02 20:33:33") it "xmp block before the exif" $ do result <- parseFileExif "tests/xmp-before-exif-truncated.jpg" -- the file is truncated. original is at: https://github.com/emmanueltouzery/hsexif/issues/17 case result of Left err -> assertBool ("Cannot parse: " ++ err) False Right tags -> do - (Map.lookup dateTimeOriginal tags) `assertEqual'` (Just $ ExifText "2020:03:04 17:14:20") - + Map.lookup dateTimeOriginal tags `assertEqual'` Just (ExifText "2020:03:04 17:14:20") testNotAJpeg :: B.ByteString -> Spec testNotAJpeg imageContents = it "returns empty list if not a JPEG" $ @@ -131,7 +131,7 @@ ]) (sort cleanedParsed) -- the sony maker note is 35k!! Just test its size and that it starts with "SONY DSC". assertEqual' (Just 35692) (BS.length <$> makerNoteV) - assertEqual' (Just "SONY DSC") (take 8 <$> fmap (chr . fromIntegral) <$> BS.unpack <$> makerNoteV) + assertEqual' (Just "SONY DSC") (take 8 . fmap (chr . fromIntegral) . BS.unpack <$> makerNoteV) where -- the makerNote is HUGE. so test it separately. parsed = hush $ parseExif imageContents @@ -166,7 +166,7 @@ testReadGpsLatLongNoData :: Maybe (Map ExifTag ExifValue) -> Spec testReadGpsLatLongNoData exifData = it "reads gps latitude longitude" $ - assertEqual' Nothing $ join $ getGpsLatitudeLongitude <$> exifData + assertEqual' Nothing $ getGpsLatitudeLongitude =<< exifData testFormatAsFloatingPoint :: Spec testFormatAsFloatingPoint = it "properly formats as floating point" $ do @@ -308,3 +308,70 @@ assertEqual' :: (Show a, Eq a) => a -> a -> Assertion assertEqual' = assertEqual "doesn't match" + +testHEIC :: B.ByteString -> Spec +testHEIC imageContents = it "parses an Apple HEIC" $ do + case cleanedParsedM of + Nothing -> assertBool "Parsing fails" False + Just cleanedParsed -> do + assertEqualListDebug (sort expected) (sort cleanedParsed) + + assertEqual' + (Just "\NUL\NUL\NUL\NUL\NUL\NUL\NUL\SOH") + (take 8 . fmap (chr . fromIntegral) . BS.unpack <$> compositeImageExposureTimesV) + + assertEqual' (Just 1514) (BS.length <$> makerNoteV) + + where + parsed = hush $ parseExif imageContents + tricky = [compositeImageExposureTimes, makerNote] + cleanedParsedM = filter ((`notElem` tricky) . fst) <$> (Map.toList <$> parsed) + + makerNoteV = parsed >>= Map.lookup makerNote >>= getUndefMaybe + compositeImageExposureTimesV = parsed >>= Map.lookup compositeImageExposureTimes >>= getUndefMaybe + + expected = + [ (hostComputer, ExifText "iPhone 14 Pro Max") + , (exposureTime, ExifRational 1 4) + , (fnumber, ExifRational 11 5) + , (exposureProgram, ExifNumber 2) + , (isoSpeedRatings, ExifNumber 2500) + , (exifVersion, ExifUndefined "0232") + , (dateTimeOriginal, ExifText "2023:05:07 19:21:26") + , (dateTimeDigitized, ExifText "2023:05:07 19:21:26") + , (offsetTime, ExifText "+08:00") + , (offsetTimeDigitized, ExifText "+08:00") + , (offsetTimeOriginal, ExifText "+08:00") + , (shutterSpeedValue, ExifRational 17962 9509) + , (apertureValue, ExifRational 193685 85136) + , (brightnessValue, ExifRational (-77686) 13317) + , (exposureBiasValue, ExifRational 5 128) + , (meteringMode, ExifNumber 5) + , (flash, ExifNumber 16) + , (focalLength, ExifRational 111 50) + , (subjectArea, ExifNumberList [2010,1508,2211,1324]) + , (subSecTimeOriginal, ExifText "458") + , (subSecTimeDigitized, ExifText "458") + , (colorSpace, ExifNumber 65535) + , (exifImageWidth, ExifNumber 4032) + , (exifImageHeight, ExifNumber 3024) + , (sensingMethod, ExifNumber 2) + , (sceneType, ExifUndefined "\SOH") + , (exposureMode, ExifNumber 0) + , (whiteBalance, ExifNumber 0) + , (digitalZoomRatio, ExifRational 126 71) + , (focalLengthIn35mmFilm, ExifNumber 24) + , (lensSpecification, ExifRationalList [(111,50),(9,1),(1244236,699009),(14,5)]) + , (lensMake, ExifText "Apple") + , (lensModel, ExifText "iPhone 14 Pro Max back triple camera 2.22mm f/2.2") + , (compositeImage, ExifNumber 3) + , (compositeImageCount, ExifNumberList [13, 0]) + , (make, ExifText "Apple") + , (model, ExifText "iPhone 14 Pro Max") + , (orientation, ExifNumber 6) + , (xResolution, ExifRational 72 1) + , (yResolution, ExifRational 72 1) + , (resolutionUnit, ExifNumber 2) + , (software, ExifText "16.4.1") + , (dateTime, ExifText "2023:05:07 19:21:26") + ]