module Data.Git.Storage.PackIndex
( PackIndexHeader(..)
, PackIndex(..)
, packIndexOpen
, packIndexClose
, withPackIndex
, packIndexEnumerate
, packIndexHeaderGetNbWithPrefix
, packIndexGetReferenceLocation
, packIndexGetReferencesWithPrefix
, packIndexReadHeader
, packIndexRead
, packIndexGetHeader
) where
import Data.List
import Data.Bits
import Data.Word
import Data.ByteString (ByteString)
import Data.Vector (Vector, (!))
import qualified Data.Vector as V
import Data.Git.Internal
import Data.Git.Imports
import Data.Git.OS
import Data.Git.Storage.FileReader
import Data.Git.Path
import Data.Git.Ref
import qualified Data.Git.Parser as P
data PackIndexHeader = PackIndexHeader !Word32 !(Vector Word32)
deriving (Show,Eq)
data PackIndex = PackIndex
{ packIndexSha1s :: Vector Ref
, packIndexCRCs :: Vector Word32
, packIndexPackoffs :: Vector Word32
, packIndexPackChecksum :: Ref
, packIndexChecksum :: Ref
}
packIndexEnumerate :: LocalPath -> IO [Ref]
packIndexEnumerate repoPath = map onlyHash . filter isPackFile <$> listDirectoryFilename (repoPath </> "objects" </> "pack")
where
isPackFile :: String -> Bool
isPackFile x = ".idx" `isSuffixOf` x && "pack-" `isPrefixOf` x
onlyHash = fromHexString . takebut 4 . drop 5
takebut n l = take (length l n) l
packIndexOpen :: LocalPath -> Ref -> IO FileReader
packIndexOpen repoPath indexRef = openFile (indexPath repoPath indexRef) ReadMode >>= fileReaderNew False
packIndexClose :: FileReader -> IO ()
packIndexClose = fileReaderClose
withPackIndex :: LocalPath -> Ref -> (FileReader -> IO a) -> IO a
withPackIndex repoPath indexRef = withFileReader (indexPath repoPath indexRef)
packIndexHeaderGetSize :: PackIndexHeader -> Word32
packIndexHeaderGetSize (PackIndexHeader _ indexes) = indexes ! 255
packIndexHeaderByteSize :: Int
packIndexHeaderByteSize = 2*4 + 256*4
packIndexHeaderGetNbWithPrefix :: PackIndexHeader -> Int -> Word32
packIndexHeaderGetNbWithPrefix (PackIndexHeader _ indexes) n
| n < 0 || n > 255 = 0
| n == 0 = indexes ! 0
| otherwise = (indexes ! n) (indexes ! (n1))
packIndexHeaderFoldRef :: PackIndexHeader -> FileReader -> Int -> (a -> Word32 -> Ref -> (a, Bool)) -> a -> IO a
packIndexHeaderFoldRef idxHdr@(PackIndexHeader _ indexes) fr refprefix f initAcc
| nb == 0 = return initAcc
| otherwise = do
let spos = (indexes ! refprefix) nb
fileReaderSeek fr (fromIntegral (sha1Offset + spos * 20))
loop nb initAcc
where
loop 0 acc = return acc
loop n acc = do
b <- fromBinary <$> fileReaderGetBS 20 fr
let (!nacc, terminate) = f acc (nbn) b
if terminate
then return nacc
else loop (n1) nacc
nb = packIndexHeaderGetNbWithPrefix idxHdr refprefix
(sha1Offset,_,_) = packIndexOffsets idxHdr
packIndexGetReferenceLocation :: PackIndexHeader -> FileReader -> Ref -> IO (Maybe Word64)
packIndexGetReferenceLocation idxHdr@(PackIndexHeader _ indexes) fr ref = do
mrpos <- packIndexHeaderFoldRef idxHdr fr refprefix f Nothing
case mrpos of
Nothing -> return Nothing
Just rpos -> do
let spos = (indexes ! refprefix) nb
fileReaderSeek fr (fromIntegral (packOffset + 4 * (spos+rpos)))
Just . fromIntegral . be32 <$> fileReaderGetBS 4 fr
where
f acc rpos rref = if ref == rref then (Just rpos,True) else (acc,False)
refprefix = refPrefix ref
nb = packIndexHeaderGetNbWithPrefix idxHdr refprefix
(_,_,packOffset) = packIndexOffsets idxHdr
packIndexGetReferencesWithPrefix :: PackIndexHeader -> FileReader -> String -> IO [Ref]
packIndexGetReferencesWithPrefix idxHdr fr prefix =
packIndexHeaderFoldRef idxHdr fr refprefix f []
where
f acc _ ref = case cmpPrefix prefix ref of
GT -> (acc ,False)
EQ -> (ref:acc,False)
LT -> (acc ,True)
refprefix = read ("0x" ++ take 2 prefix)
packIndexOffsets :: PackIndexHeader -> (Word32, Word32, Word32)
packIndexOffsets idx = (packIndexSha1sOffset, packIndexCRCsOffset, packIndexPackOffOffset)
where
packIndexPackOffOffset = packIndexCRCsOffset + crcsTableSz
packIndexCRCsOffset = packIndexSha1sOffset + sha1TableSz
packIndexSha1sOffset = fromIntegral packIndexHeaderByteSize
crcsTableSz = 4 * sz
sha1TableSz = 20 * sz
sz = packIndexHeaderGetSize idx
parsePackIndexHeader :: P.Parser PackIndexHeader
parsePackIndexHeader = do
magic <- P.word32
when (magic /= 0xff744f63) $ error "wrong magic number for packIndex"
ver <- P.word32
when (ver /= 2) $ error "unsupported packIndex version"
fanouts <- V.replicateM 256 P.word32
return $ PackIndexHeader ver fanouts
packIndexReadHeader :: FileReader -> IO PackIndexHeader
packIndexReadHeader fr = fileReaderSeek fr 0 >> fileReaderParse fr parsePackIndexHeader
packIndexGetHeader :: LocalPath -> Ref -> IO PackIndexHeader
packIndexGetHeader repoPath indexRef = withPackIndex repoPath indexRef $ packIndexReadHeader
packIndexRead :: LocalPath -> Ref -> IO (PackIndexHeader, (Vector Ref, Vector Word32, Vector Word32, [ByteString], Ref, Ref))
packIndexRead repoPath indexRef = do
withPackIndex repoPath indexRef $ \fr -> do
idx <- fileReaderParse fr parsePackIndexHeader
liftM2 (,) (return idx) (fileReaderParse fr (parsePackIndex $ packIndexHeaderGetSize idx))
where parsePackIndex sz = do
sha1s <- V.replicateM (fromIntegral sz) P.referenceBin
crcs <- V.replicateM (fromIntegral sz) P.word32
packoffs <- V.replicateM (fromIntegral sz) P.word32
let nbLarge = length $ filter (== True) $ map (\packoff -> packoff `testBit` 31) $ V.toList packoffs
largeoffs <- replicateM nbLarge (P.take 4)
packfileChecksum <- P.referenceBin
idxfileChecksum <- P.referenceBin
return (sha1s, crcs, packoffs, largeoffs, packfileChecksum, idxfileChecksum)