diff options
author | Joey Hess <joey@kitenet.net> | 2014-08-03 01:12:24 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2014-08-03 01:12:24 -0400 |
commit | 237cceb715438809f9ddf7b45695f000f65f82b8 (patch) | |
tree | c6db0a6b1b79258fe0b85572640a69f6da837245 /Remote/Glacier.hs | |
parent | a4a09a104747501f80ef93c4814e8dcf8bf51cb9 (diff) |
better byteRetriever
Make the byteRetriever be passed the callback that consumes the bytestring.
This way, there's no worries about the lazy bytestring not all being read
when the resource that's creating it is closed.
Which in turn lets bup, ddar, and S3 each switch from using an unncessary
fileRetriver to a byteRetriever. So, more efficient on chunks and encrypted
files.
The only remaining fileRetrievers are hook and external, which really do
retrieve to files.
Diffstat (limited to 'Remote/Glacier.hs')
-rw-r--r-- | Remote/Glacier.hs | 33 |
1 files changed, 16 insertions, 17 deletions
diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs index 9b428bd80..592a7db1f 100644 --- a/Remote/Glacier.hs +++ b/Remote/Glacier.hs @@ -20,7 +20,6 @@ import Config.Cost import Remote.Helper.Special import Remote.Helper.ChunkedEncryptable import qualified Remote.Helper.AWS as AWS -import Crypto import Creds import Utility.Metered import qualified Annex @@ -120,11 +119,10 @@ store r k b p = go =<< glacierEnv c u return True prepareRetrieve :: Remote -> Preparer Retriever -prepareRetrieve r = simplyPrepare $ fileRetriever $ \d k p -> - retrieve r k (readBytes (meteredWriteFile p d)) +prepareRetrieve = simplyPrepare . byteRetriever . retrieve -retrieve :: Remote -> Key -> (Handle -> IO ()) -> Annex () -retrieve r k reader = go =<< glacierEnv c u +retrieve :: Remote -> Key -> (L.ByteString -> Annex Bool) -> Annex Bool +retrieve r k sink = go =<< glacierEnv c u where c = config r u = uuid r @@ -138,17 +136,21 @@ retrieve r k reader = go =<< glacierEnv c u go Nothing = error "cannot retrieve from glacier" go (Just e) = do let cmd = (proc "glacier" (toCommand params)) { env = Just e } - ok <- liftIO $ catchBoolIO $ - withHandle StdoutHandle createProcessSuccess cmd $ \h -> - ifM (hIsEOF h) - ( return False - , do - reader h - return True - ) + (_, Just h, _, pid) <- liftIO $ createProcess cmd + -- Glacier cannot store empty files, so if the output is + -- empty, the content is not available yet. + ok <- ifM (liftIO $ hIsEOF h) + ( return False + , sink =<< liftIO (L.hGetContents h) + ) + liftIO $ hClose h + liftIO $ forceSuccessProcess cmd pid unless ok $ do showLongNote "Recommend you wait up to 4 hours, and then run this command again." - error "not yet available" + return ok + +retrieveCheap :: Remote -> Key -> FilePath -> Annex Bool +retrieveCheap _ _ _ = return False remove :: Remote -> Key -> Annex Bool remove r k = glacierAction r @@ -159,9 +161,6 @@ remove r k = glacierAction r , Param $ archive r k ] -retrieveCheap :: Remote -> Key -> FilePath -> Annex Bool -retrieveCheap _ _ _ = return False - checkPresent :: Remote -> Key -> Annex (Either String Bool) checkPresent r k = do showAction $ "checking " ++ name r |