git-annex/Remote/Helper/Chunked/Legacy.hs

{- legacy git-annex chunked remotes
 -
 - Copyright 2012 Joey Hess <id@joeyh.name>
 -
 - Licensed under the GNU AGPL version 3 or higher.
 -}

module Remote.Helper.Chunked.Legacy where

import Annex.Common
import Remote.Helper.Chunked
import Utility.Metered

import qualified Data.ByteString.Lazy as L

{- This is an extension that's added to the usual file (or whatever)
 - where the remote stores a key. -}
type ChunkExt = String

{- A record of the number of chunks used.
 -
 - While this can be guessed at based on the size of the key, encryption
 - makes that larger. Also, using this helps deal with changes to chunksize
 - over the life of a remote.
 -}
chunkCount :: ChunkExt
chunkCount = ".chunkcount"

{- An infinite stream of extensions to use for chunks. -}
chunkStream :: [ChunkExt]
chunkStream = map (\n -> ".chunk" ++ show n) [1 :: Integer ..]

{- Parses the String from the chunkCount file, and returns the files that
 - are used to store the chunks. -}
listChunks :: FilePath -> String -> [FilePath]
listChunks basedest chunkcount = take count $ map (basedest ++) chunkStream
  where
	count = fromMaybe 0 $ readish chunkcount

{- For use when there is no chunkCount file; uses the action to find
 - chunks, and returns them, or Nothing if none found. Relies on
 - storeChunks's finalizer atomically moving the chunks into place once all
 - are written.
 -
 - This is only needed to work around a bug that caused the chunkCount file
 - not to be written.
 -}
probeChunks :: FilePath -> (FilePath -> IO Bool) -> IO [FilePath]
probeChunks basedest check = go [] $ map (basedest ++) chunkStream
  where
	go l [] = return (reverse l)
	go l (c:cs) = ifM (check c)
		( go (c:l) cs
		, go l []
		)

{- Given the base destination to use to store a value,
 - generates a stream of temporary destinations,
 - and passes it to an action, which should chunk and store the data,
 - and return the destinations it stored to, or [] on error. Then
 - calls the recorder to write the chunk count. Finally, the
 - finalizer is called to rename the tmp into the dest 
 - (and do any other cleanup).
 -}
storeChunks :: Key -> FilePath -> FilePath -> ([FilePath] -> IO [FilePath]) -> (FilePath -> String -> IO ()) -> (FilePath -> FilePath -> IO ()) -> IO ()
storeChunks key tmp dest storer recorder finalizer = do
	stored <- storer tmpdests
	let chunkcount = basef ++ chunkCount
	recorder chunkcount (show $ length stored)
	finalizer tmp dest
	when (null stored) $
		giveup "no chunks were stored"
  where
	basef = tmp ++ fromRawFilePath (keyFile key)
	tmpdests = map (basef ++ ) chunkStream

{- Given a list of destinations to use, chunks the data according to the
 - ChunkSize, and runs the storer action to store each chunk. Returns
 - the destinations where data was stored, or [] on error.
 -
 - This buffers each chunk in memory.
 - More optimal versions of this can be written, that rely
 - on L.toChunks to split the lazy bytestring into chunks (typically
 - smaller than the ChunkSize), and eg, write those chunks to a Handle.
 - But this is the best that can be done with the storer interface that
 - writes a whole L.ByteString at a time.
 -}
storeChunked :: ChunkSize -> [FilePath] -> (FilePath -> L.ByteString -> IO ()) -> L.ByteString -> IO [FilePath]
storeChunked chunksize dests storer content = 
	either onerr return =<< tryNonAsync (go (Just chunksize) dests)
  where
	go _ [] = return [] -- no dests!?
	go Nothing (d:_) = do
		storer d content
		return [d]
	go (Just sz) _
		-- always write a chunk, even if the data is 0 bytes
		| L.null content = go Nothing dests
		| otherwise = storechunks sz [] dests content
		
	onerr e = do
		warningIO (show e)
		return []
	
	storechunks _ _ [] _ = return [] -- ran out of dests
	storechunks sz useddests (d:ds) b
		| L.null b = return $ reverse useddests
		| otherwise = do
			let (chunk, b') = L.splitAt sz b
			storer d chunk
			storechunks sz (d:useddests) ds b'

{- Writes a series of chunks to a file. The feeder is called to get
 - each chunk.
 -}
meteredWriteFileChunks :: MeterUpdate -> FilePath -> [v] -> (v -> IO L.ByteString) -> IO ()
meteredWriteFileChunks meterupdate dest chunks feeder =
	withBinaryFile dest WriteMode $ \h ->
		forM_ chunks $
			meteredWrite meterupdate h <=< feeder