module Data.Git.Storage.Loose
(
Zipped(..)
, looseUnmarshall
, looseUnmarshallRaw
, looseUnmarshallZipped
, looseUnmarshallZippedRaw
, looseMarshall
, looseRead
, looseReadHeader
, looseReadRaw
, looseExists
, looseWriteBlobFromFile
, looseWrite
, looseEnumeratePrefixes
, looseEnumerateWithPrefixFilter
, looseEnumerateWithPrefix
) where
import Codec.Compression.Zlib
import Data.Git.Ref
import Data.Git.Path
import Data.Git.Internal
import Data.Git.Storage.FileWriter
import Data.Git.Storage.Object
import Filesystem
import Filesystem.Path
import Filesystem.Path.Rules
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString as B
import Data.Attoparsec.Lazy
import qualified Data.Attoparsec.Char8 as PC
import Control.Applicative ((<$>), (<|>))
import Control.Monad
import Control.Exception (onException, SomeException)
import qualified Control.Exception as E
import Data.String
import Data.Char (isHexDigit)
import Prelude hiding (FilePath)
isObjectPrefix [a,b] = isHexDigit a && isHexDigit b
isObjectPrefix _ = False
decimal :: Parser Int
decimal = PC.decimal
parseHeader = do
h <- takeWhile1 ((/=) 0x20)
_ <- word8 0x20
sz <- decimal
return (objectTypeUnmarshall $ BC.unpack h, fromIntegral sz, Nothing)
parseTreeHeader = string "tree " >> decimal >> word8 0
parseTagHeader = string "tag " >> decimal >> word8 0
parseCommitHeader = string "commit " >> decimal >> word8 0
parseBlobHeader = string "blob " >> decimal >> word8 0
parseTree = parseTreeHeader >> objectParseTree
parseTag = parseTagHeader >> objectParseTag
parseCommit = parseCommitHeader >> objectParseCommit
parseBlob = parseBlobHeader >> objectParseBlob
parseObject :: L.ByteString -> Object
parseObject = parseSuccess (parseTree <|> parseBlob <|> parseCommit <|> parseTag)
where parseSuccess p = either error id . eitherResult . parse p
looseUnmarshall :: L.ByteString -> Object
looseUnmarshall = parseObject
looseUnmarshallZipped :: Zipped -> Object
looseUnmarshallZipped = parseObject . dezip
looseUnmarshallRaw :: L.ByteString -> (ObjectHeader, ObjectData)
looseUnmarshallRaw stream =
case L.findIndex ((==) 0) stream of
Nothing -> error "object not right format. missing 0"
Just idx ->
let (h, r) = L.splitAt (idx+1) stream in
case maybeResult $ parse parseHeader h of
Nothing -> error "cannot open object"
Just hdr -> (hdr, r)
looseUnmarshallZippedRaw :: Zipped -> (ObjectHeader, ObjectData)
looseUnmarshallZippedRaw = looseUnmarshallRaw . dezip
looseReadRaw repoPath ref = looseUnmarshallZippedRaw <$> readZippedFile (objectPathOfRef repoPath ref)
looseReadHeader repoPath ref = toHeader <$> readZippedFile (objectPathOfRef repoPath ref)
where toHeader = either error id . eitherResult . parse parseHeader . dezip
looseRead repoPath ref = looseUnmarshallZipped <$> readZippedFile (objectPathOfRef repoPath ref)
looseExists repoPath ref = isFile (objectPathOfRef repoPath ref)
looseEnumeratePrefixes repoPath = filter isObjectPrefix <$> getDirectoryContents (repoPath </> fromString "objects")
looseEnumerateWithPrefixFilter :: FilePath -> String -> (Ref -> Bool) -> IO [Ref]
looseEnumerateWithPrefixFilter repoPath prefix filterF =
filter filterF . map (fromHexString . (prefix ++)) . filter isRef <$> getDir (repoPath </> fromString "objects" </> fromString prefix)
where
getDir p = E.catch (getDirectoryContents p) (\(_::SomeException) -> return [])
isRef l = length l == 38
looseEnumerateWithPrefix :: FilePath -> String -> IO [Ref]
looseEnumerateWithPrefix repoPath prefix =
looseEnumerateWithPrefixFilter repoPath prefix (const True)
looseMarshall obj
| objectIsDelta obj = error "cannot write delta object loose"
| otherwise = L.concat [ L.fromChunks [hdrB], objData ]
where
objData = objectWrite obj
hdrB = objectWriteHeader (objectToType obj) (fromIntegral $ L.length objData)
looseWriteBlobFromFile repoPath file = do
fsz <- getSize file
let hdr = objectWriteHeader TypeBlob (fromIntegral fsz)
tmpPath <- objectTemporaryPath repoPath
flip onException (removeFile tmpPath) $ do
(ref, npath) <- withFileWriter tmpPath $ \fw -> do
fileWriterOutput fw hdr
withFile file ReadMode $ \h -> loop h fw
digest <- fileWriterGetDigest fw
return (digest, objectPathOfRef repoPath digest)
exists <- isFile npath
when exists $ error "destination already exists"
rename tmpPath npath
return ref
where loop h fw = do
r <- B.hGet h (32*1024)
if B.null r
then return ()
else fileWriterOutput fw r >> loop h fw
looseWrite repoPath obj = createDirectory True (directory path)
>> isFile path
>>= \exists -> unless exists (writeFileLazy path $ compress content)
>> return ref
where
path = objectPathOfRef repoPath ref
content = looseMarshall obj
ref = hashLBS content
writeFileLazy p bs = withFile p WriteMode (\h -> L.hPut h bs)
getDirectoryContents p = map (encodeString posix . filename) <$> listDirectory p