summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2014-07-24 15:08:07 -0400
committerGravatar Joey Hess <joey@kitenet.net>2014-07-24 15:08:07 -0400
commit35b31b00e4efbf84bcfb814acc477bbb89b50107 (patch)
tree73ff2a919db27556617739b132889acc702f6d43
parent28961c83eb80cbc874b0d5bcd232912ef0b455ff (diff)
improve chunk data types
-rw-r--r--Remote/Directory.hs18
-rw-r--r--Remote/Helper/Chunked.hs10
-rw-r--r--Remote/Helper/Chunked/Legacy.hs4
-rw-r--r--Remote/WebDAV.hs8
4 files changed, 20 insertions, 20 deletions
diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index 3158154e3..82d38c884 100644
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -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
diff --git a/Remote/Helper/Chunked.hs b/Remote/Helper/Chunked.hs
index aafa6b700..a71c39fbc 100644
--- a/Remote/Helper/Chunked.hs
+++ b/Remote/Helper/Chunked.hs
@@ -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
diff --git a/Remote/Helper/Chunked/Legacy.hs b/Remote/Helper/Chunked/Legacy.hs
index b35bc92a0..3b6b0d47f 100644
--- a/Remote/Helper/Chunked/Legacy.hs
+++ b/Remote/Helper/Chunked/Legacy.hs
@@ -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
diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs
index 3d618f79c..36df60945 100644
--- a/Remote/WebDAV.hs
+++ b/Remote/WebDAV.hs
@@ -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