move meteredWriteFileChunks out of legacy
This commit is contained in:
parent
e2c44bf656
commit
ceea04e77f
4 changed files with 20 additions and 14 deletions
|
@ -222,7 +222,7 @@ retrieve :: FilePath -> ChunkConfig -> Key -> AssociatedFile -> FilePath -> Mete
|
||||||
retrieve d chunkconfig k _ f p = metered (Just p) k $ \meterupdate ->
|
retrieve d chunkconfig k _ f p = metered (Just p) k $ \meterupdate ->
|
||||||
liftIO $ withStoredFiles chunkconfig d k $ \files ->
|
liftIO $ withStoredFiles chunkconfig d k $ \files ->
|
||||||
catchBoolIO $ do
|
catchBoolIO $ do
|
||||||
Legacy.meteredWriteFileChunks meterupdate f files L.readFile
|
meteredWriteFileChunks meterupdate f files L.readFile
|
||||||
return True
|
return True
|
||||||
|
|
||||||
retrieveEncrypted :: FilePath -> ChunkConfig -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool
|
retrieveEncrypted :: FilePath -> ChunkConfig -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool
|
||||||
|
|
|
@ -5,14 +5,21 @@
|
||||||
- Licensed under the GNU GPL version 3 or higher.
|
- Licensed under the GNU GPL version 3 or higher.
|
||||||
-}
|
-}
|
||||||
|
|
||||||
module Remote.Helper.Chunked where
|
module Remote.Helper.Chunked
|
||||||
|
( ChunkSize
|
||||||
|
, ChunkConfig(..)
|
||||||
|
, chunkConfig
|
||||||
|
, meteredWriteFileChunks
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Common.Annex
|
||||||
import Utility.DataUnits
|
import Utility.DataUnits
|
||||||
import Types.Remote
|
import Types.Remote
|
||||||
import Logs.Chunk.Pure (ChunkSize)
|
import Logs.Chunk.Pure (ChunkSize)
|
||||||
|
import Utility.Metered
|
||||||
|
|
||||||
|
import qualified Data.ByteString.Lazy as L
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Data.Int
|
|
||||||
|
|
||||||
data ChunkConfig
|
data ChunkConfig
|
||||||
= NoChunks
|
= NoChunks
|
||||||
|
@ -30,3 +37,11 @@ chunkConfig m =
|
||||||
readsz v f = case readSize dataUnits v of
|
readsz v f = case readSize dataUnits v of
|
||||||
Just size | size > 0 -> fromInteger size
|
Just size | size > 0 -> fromInteger size
|
||||||
_ -> error ("bad " ++ f)
|
_ -> error ("bad " ++ f)
|
||||||
|
|
||||||
|
{- 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
|
||||||
|
|
|
@ -8,8 +8,7 @@
|
||||||
module Remote.Helper.Chunked.Legacy where
|
module Remote.Helper.Chunked.Legacy where
|
||||||
|
|
||||||
import Common.Annex
|
import Common.Annex
|
||||||
import Utility.Metered
|
import Remote.Helper.Chunked
|
||||||
import Remote.Helper.Chunked (ChunkSize)
|
|
||||||
|
|
||||||
import qualified Data.ByteString.Lazy as L
|
import qualified Data.ByteString.Lazy as L
|
||||||
import qualified Control.Exception as E
|
import qualified Control.Exception as E
|
||||||
|
@ -115,11 +114,3 @@ storeChunked chunksize dests storer content = either onerr return
|
||||||
let (chunk, b') = L.splitAt sz b
|
let (chunk, b') = L.splitAt sz b
|
||||||
storer d chunk
|
storer d chunk
|
||||||
storechunks sz (d:useddests) ds b'
|
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
|
|
||||||
|
|
|
@ -140,7 +140,7 @@ retrieve :: Remote -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex
|
||||||
retrieve r k _f d p = metered (Just p) k $ \meterupdate ->
|
retrieve r k _f d p = metered (Just p) k $ \meterupdate ->
|
||||||
davAction r False $ \(baseurl, user, pass) -> liftIO $ catchBoolIO $
|
davAction r False $ \(baseurl, user, pass) -> liftIO $ catchBoolIO $
|
||||||
withStoredFiles r k baseurl user pass onerr $ \urls -> do
|
withStoredFiles r k baseurl user pass onerr $ \urls -> do
|
||||||
Legacy.meteredWriteFileChunks meterupdate d urls $ \url -> do
|
meteredWriteFileChunks meterupdate d urls $ \url -> do
|
||||||
mb <- getDAV url user pass
|
mb <- getDAV url user pass
|
||||||
case mb of
|
case mb of
|
||||||
Nothing -> throwIO "download failed"
|
Nothing -> throwIO "download failed"
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue