improve chunk data types
This commit is contained in:
parent
9e2d49d441
commit
bbdb2c04d5
4 changed files with 20 additions and 20 deletions
|
@ -99,7 +99,7 @@ tmpDir d k = addTrailingPathSeparator $ d </> "tmp" </> keyFile k
|
|||
|
||||
withCheckedFiles :: (FilePath -> IO Bool) -> ChunkConfig -> FilePath -> Key -> ([FilePath] -> IO Bool) -> IO Bool
|
||||
withCheckedFiles _ _ [] _ _ = return False
|
||||
withCheckedFiles check (LegacyChunkSize _) d k a = go $ locations d k
|
||||
withCheckedFiles check (LegacyChunks _) d k a = go $ locations d k
|
||||
where
|
||||
go [] = return False
|
||||
go (f:fs) = do
|
||||
|
@ -128,7 +128,7 @@ store d chunkconfig k _f p = sendAnnex k (void $ remove d k) $ \src ->
|
|||
metered (Just p) k $ \meterupdate ->
|
||||
storeHelper d chunkconfig k k $ \dests ->
|
||||
case chunkconfig of
|
||||
LegacyChunkSize chunksize ->
|
||||
LegacyChunks chunksize ->
|
||||
storeLegacyChunked meterupdate chunksize dests
|
||||
=<< L.readFile src
|
||||
_ -> do
|
||||
|
@ -143,7 +143,7 @@ storeEncrypted d gpgOpts chunkconfig (cipher, enck) k p = sendAnnex k (void $ re
|
|||
storeHelper d chunkconfig enck k $ \dests ->
|
||||
encrypt gpgOpts cipher (feedFile src) $ readBytes $ \b ->
|
||||
case chunkconfig of
|
||||
LegacyChunkSize chunksize ->
|
||||
LegacyChunks chunksize ->
|
||||
storeLegacyChunked meterupdate chunksize dests b
|
||||
_ -> do
|
||||
let dest = Prelude.head dests
|
||||
|
@ -153,7 +153,7 @@ storeEncrypted d gpgOpts chunkconfig (cipher, enck) k p = sendAnnex k (void $ re
|
|||
{- Splits a ByteString into chunks and writes to dests, obeying configured
|
||||
- chunk size (not to be confused with the L.ByteString chunk size).
|
||||
- Note: Must always write at least one file, even for empty ByteString. -}
|
||||
storeLegacyChunked :: MeterUpdate -> Legacy.ChunkSize -> [FilePath] -> L.ByteString -> IO [FilePath]
|
||||
storeLegacyChunked :: MeterUpdate -> ChunkSize -> [FilePath] -> L.ByteString -> IO [FilePath]
|
||||
storeLegacyChunked _ _ [] _ = error "bad storeLegacyChunked call"
|
||||
storeLegacyChunked meterupdate chunksize alldests@(firstdest:_) b
|
||||
| L.null b = do
|
||||
|
@ -161,7 +161,7 @@ storeLegacyChunked meterupdate chunksize alldests@(firstdest:_) b
|
|||
L.writeFile firstdest b
|
||||
return [firstdest]
|
||||
| otherwise = storeLegacyChunked' meterupdate chunksize alldests (L.toChunks b) []
|
||||
storeLegacyChunked' :: MeterUpdate -> Legacy.ChunkSize -> [FilePath] -> [S.ByteString] -> [FilePath] -> IO [FilePath]
|
||||
storeLegacyChunked' :: MeterUpdate -> ChunkSize -> [FilePath] -> [S.ByteString] -> [FilePath] -> IO [FilePath]
|
||||
storeLegacyChunked' _ _ [] _ _ = error "ran out of dests"
|
||||
storeLegacyChunked' _ _ _ [] c = return $ reverse c
|
||||
storeLegacyChunked' meterupdate chunksize (d:dests) bs c = do
|
||||
|
@ -200,8 +200,8 @@ storeHelper d chunkconfig key origkey storer = check <&&> liftIO go
|
|||
void $ storer [tmpf]
|
||||
finalizer tmpdir destdir
|
||||
return True
|
||||
ChunkSize _ -> error "TODO: storeHelper with ChunkSize"
|
||||
LegacyChunkSize _ -> Legacy.storeChunks key tmpdir destdir storer recorder finalizer
|
||||
UnpaddedChunks _ -> error "TODO: storeHelper with UnpaddedChunks"
|
||||
LegacyChunks _ -> Legacy.storeChunks key tmpdir destdir storer recorder finalizer
|
||||
|
||||
finalizer tmp dest = do
|
||||
void $ tryIO $ allowWrite dest -- may already exist
|
||||
|
@ -237,8 +237,8 @@ retrieveEncrypted d chunkconfig (cipher, enck) k f p = metered (Just p) k $ \met
|
|||
|
||||
retrieveCheap :: FilePath -> ChunkConfig -> Key -> FilePath -> Annex Bool
|
||||
-- no cheap retrieval for chunks
|
||||
retrieveCheap _ (ChunkSize _) _ _ = return False
|
||||
retrieveCheap _ (LegacyChunkSize _) _ _ = return False
|
||||
retrieveCheap _ (UnpaddedChunks _) _ _ = return False
|
||||
retrieveCheap _ (LegacyChunks _) _ _ = return False
|
||||
#ifndef mingw32_HOST_OS
|
||||
retrieveCheap d ck k f = liftIO $ withStoredFiles ck d k go
|
||||
where
|
||||
|
|
|
@ -13,18 +13,20 @@ import Types.Remote
|
|||
import qualified Data.Map as M
|
||||
import Data.Int
|
||||
|
||||
type ChunkSize = Int64
|
||||
|
||||
data ChunkConfig
|
||||
= NoChunks
|
||||
| ChunkSize Int64
|
||||
| LegacyChunkSize Int64
|
||||
| UnpaddedChunks ChunkSize
|
||||
| LegacyChunks ChunkSize
|
||||
|
||||
chunkConfig :: RemoteConfig -> ChunkConfig
|
||||
chunkConfig m =
|
||||
case M.lookup "chunksize" m of
|
||||
Nothing -> case M.lookup "chunk" m of
|
||||
Nothing -> NoChunks
|
||||
Just v -> ChunkSize $ readsz v "chunk"
|
||||
Just v -> LegacyChunkSize $ readsz v "chunksize"
|
||||
Just v -> UnpaddedChunks $ readsz v "chunk"
|
||||
Just v -> LegacyChunks $ readsz v "chunksize"
|
||||
where
|
||||
readsz v f = case readSize dataUnits v of
|
||||
Just size | size > 0 -> fromInteger size
|
||||
|
|
|
@ -9,13 +9,11 @@ module Remote.Helper.Chunked.Legacy where
|
|||
|
||||
import Common.Annex
|
||||
import Utility.Metered
|
||||
import Remote.Helper.Chunked (ChunkSize)
|
||||
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
import Data.Int
|
||||
import qualified Control.Exception as E
|
||||
|
||||
type ChunkSize = Int64
|
||||
|
||||
{- This is an extension that's added to the usual file (or whatever)
|
||||
- where the remote stores a key. -}
|
||||
type ChunkExt = String
|
||||
|
|
|
@ -117,8 +117,8 @@ storeHelper r k baseurl user pass b = catchBoolIO $ do
|
|||
storehttp tmpurl b
|
||||
finalizer tmpurl keyurl
|
||||
return True
|
||||
ChunkSize _ -> error "TODO: storeHelper with ChunkSize"
|
||||
LegacyChunkSize chunksize -> do
|
||||
UnpaddedChunks _ -> error "TODO: storeHelper with UnpaddedChunks"
|
||||
LegacyChunks chunksize -> do
|
||||
let storer urls = Legacy.storeChunked chunksize urls storehttp b
|
||||
let recorder url s = storehttp url (L8.fromString s)
|
||||
Legacy.storeChunks k tmpurl keyurl storer recorder finalizer
|
||||
|
@ -211,8 +211,8 @@ withStoredFiles
|
|||
-> IO a
|
||||
withStoredFiles r k baseurl user pass onerr a = case chunkconfig of
|
||||
NoChunks -> a [keyurl]
|
||||
ChunkSize _ -> error "TODO: withStoredFiles with ChunkSize"
|
||||
LegacyChunkSize _ -> do
|
||||
UnpaddedChunks _ -> error "TODO: withStoredFiles with UnpaddedChunks"
|
||||
LegacyChunks _ -> do
|
||||
let chunkcount = keyurl ++ Legacy.chunkCount
|
||||
v <- getDAV chunkcount user pass
|
||||
case v of
|
||||
|
|
Loading…
Reference in a new issue