better type for Retriever

Putting a callback in the Retriever type allows for the callback to
remove the retrieved file when it's done with it.

I did not really want to make Retriever be fixed to Annex Bool,
but when I tried to use Annex a, I got into some type of type mess.
This commit is contained in:
Joey Hess 2014-07-29 18:40:40 -04:00
parent 47e522979c
commit bc9e4697b9
4 changed files with 53 additions and 37 deletions

View file

@ -16,6 +16,7 @@ module Annex.Content (
getViaTmpChecked,
getViaTmpUnchecked,
prepGetViaTmpChecked,
prepTmp,
withTmp,
checkDiskSpace,
moveAnnex,

View file

@ -249,26 +249,28 @@ retrieveChunks retriever u chunkconfig encryptor basek dest basep sink
let p = maybe basep
(offsetMeterUpdate basep . toBytesProcessed)
offset
v <- tryNonAsyncAnnex $ retriever (encryptor k) p
case v of
Left e
| null ls -> giveup e
| otherwise -> firstavail currsize ls
Right content -> do
v <- tryNonAsyncAnnex $
retriever (encryptor k) p $ \content ->
bracketIO (maybe opennew openresume offset) hClose $ \h -> do
tosink h p content
let sz = toBytesProcessed $
fromMaybe 0 $ keyChunkSize k
getrest p h sz sz ks
`catchNonAsyncAnnex` giveup
case v of
Left e
| null ls -> giveup e
| otherwise -> firstavail currsize ls
Right r -> return r
getrest _ _ _ _ [] = return True
getrest p h sz bytesprocessed (k:ks) = do
let p' = offsetMeterUpdate p bytesprocessed
tosink h p' =<< retriever (encryptor k) p'
retriever (encryptor k) p' $ tosink h p'
getrest p h sz (addBytesProcessed bytesprocessed sz) ks
getunchunked = bracketIO opennew hClose $ \h -> do
tosink h basep =<< retriever (encryptor basek) basep
retriever (encryptor basek) basep $ tosink h basep
return True
opennew = openBinaryFile dest WriteMode
@ -288,10 +290,13 @@ retrieveChunks retriever u chunkconfig encryptor basek dest basep sink
- it is not responsible for updating progress (often it cannot).
- Instead, the sink is passed a meter to update as it consumes
- the ByteString. -}
tosink h p (ByteContent b) = liftIO $
tosink h p (ByteContent b) = liftIO $ do
sink h (Just p) b
tosink h _ (FileContent f) = liftIO $
return True
tosink h _ (FileContent f) = liftIO $ do
sink h Nothing =<< L.readFile f
nukeFile h
return True
{- Can resume when the chunk's offset is at or before the end of
- the dest file. -}

View file

@ -6,8 +6,6 @@
-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE FlexibleContexts #-}
module Remote.Helper.ChunkedEncryptable (
Preparer,
@ -39,17 +37,48 @@ import Annex.Exception
import qualified Data.ByteString.Lazy as L
-- Use when nothing needs to be done to prepare a helper.
simplyPrepare :: helper -> Preparer helper
simplyPrepare helper _ a = a $ Just helper
-- Use to run a check when preparing a helper.
checkPrepare :: (Key -> Annex Bool) -> helper -> Preparer helper
checkPrepare checker helper k a = ifM (checker k)
( a (Just helper)
, a Nothing
)
{- Modifies a base Remote to support both chunking and encryption.
-}
-- A Storer that expects to be provided with a file containing
-- the content of the key to store.
fileStorer :: (Key -> FilePath -> MeterUpdate -> Annex Bool) -> Storer
fileStorer a k (FileContent f) m = a k f m
fileStorer a k (ByteContent b) m = withTmp k $ \f -> do
liftIO $ L.writeFile f b
a k f m
-- A Storer that expects to be provided with a L.ByteString of
-- the content to store.
byteStorer :: (Key -> L.ByteString -> MeterUpdate -> Annex Bool) -> Storer
byteStorer a k c m = withBytes c $ \b -> a k b m
-- A Retriever that writes the content of a Key to a provided file.
-- It is responsible for updating the progress meter as it retrieves data.
fileRetriever :: (FilePath -> Key -> MeterUpdate -> Annex ()) -> Retriever
fileRetriever a k m callback = bracketAnnex (prepTmp k) (liftIO . nukeFile) go
where
go f = do
a f k m
callback (FileContent f)
-- A Retriever that generates a L.ByteString containing the Key's content.
byteRetriever :: (Key -> Annex L.ByteString) -> Retriever
byteRetriever a k _m callback = callback =<< (ByteContent <$> a k)
withBytes :: ContentSource -> (L.ByteString -> Annex a) -> Annex a
withBytes (ByteContent b) a = a b
withBytes (FileContent f) a = a =<< liftIO (L.readFile f)
-- Modifies a base Remote to support both chunking and encryption.
chunkedEncryptableRemote
:: RemoteConfig
-> Preparer Storer

View file

@ -1,4 +1,4 @@
{- Types for Storer and Retriever
{- Types for Storer and Retriever actions for remotes.
-
- Copyright 2014 Joey Hess <joey@kitenet.net>
-
@ -10,7 +10,6 @@
module Types.StoreRetrieve where
import Common.Annex
import Annex.Content
import Utility.Metered
import qualified Data.ByteString.Lazy as L
@ -28,25 +27,7 @@ data ContentSource
-- Can throw exceptions.
type Storer = Key -> ContentSource -> MeterUpdate -> Annex Bool
-- Action that retrieves a Key's content from a remote.
-- Action that retrieves a Key's content from a remote, passing it to a
-- callback.
-- Throws exception if key is not present, or remote is not accessible.
type Retriever = Key -> MeterUpdate -> Annex ContentSource
fileStorer :: (Key -> FilePath -> MeterUpdate -> Annex Bool) -> Storer
fileStorer a k (FileContent f) m = a k f m
fileStorer a k (ByteContent b) m = withTmp k $ \tmp -> do
liftIO $ L.writeFile tmp b
a k tmp m
byteStorer :: (Key -> L.ByteString -> MeterUpdate -> Annex Bool) -> Storer
byteStorer a k c m = withBytes c $ \b -> a k b m
fileRetriever :: (Key -> MeterUpdate -> Annex FilePath) -> Retriever
fileRetriever a k m = FileContent <$> a k m
byteRetriever :: (Key -> Annex L.ByteString) -> Retriever
byteRetriever a k _m = ByteContent <$> a k
withBytes :: ContentSource -> (L.ByteString -> Annex a) -> Annex a
withBytes (ByteContent b) a = a b
withBytes (FileContent f) a = a =<< liftIO (L.readFile f)
type Retriever = Key -> MeterUpdate -> (ContentSource -> Annex Bool) -> Annex Bool