summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2015-10-01 14:07:06 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2015-10-01 14:07:06 -0400
commit79e163ec1182e4b247f3a9b86f9096a96cdd299a (patch)
treed6fde3045a65d664ca7e14628e38774cdba55ba5
parent5c4125e55b40ff4be98a827298f4173f4e54b41e (diff)
refactor
-rw-r--r--Annex/Content.hs38
-rw-r--r--Remote/Git.hs4
2 files changed, 17 insertions, 25 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs
index 077407071..a5683c6df 100644
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -14,7 +14,6 @@ module Annex.Content (
inAnnexCheck,
lockContent,
getViaTmp,
- getViaTmpChecked,
getViaTmpUnchecked,
prepGetViaTmpChecked,
prepTmp,
@@ -213,21 +212,27 @@ lockContent key a = do
#endif
{- Runs an action, passing it a temporary filename to get,
- - and if the action succeeds, moves the temp file into
- - the annex as a key's content. -}
+ - and if the action succeeds, verifies the file matches the key and
+ - moves the file into the annex as a key's content. -}
getViaTmp :: Key -> (FilePath -> Annex Bool) -> Annex Bool
-getViaTmp = getViaTmpChecked (return True)
+getViaTmp key action = prepGetViaTmpChecked key False $
+ getViaTmpUnchecked key action
{- Like getViaTmp, but does not check that there is enough disk space
- for the incoming key. For use when the key content is already on disk
- and not being copied into place. -}
getViaTmpUnchecked :: Key -> (FilePath -> Annex Bool) -> Annex Bool
-getViaTmpUnchecked = finishGetViaTmp (return True)
-
-getViaTmpChecked :: Annex Bool -> Key -> (FilePath -> Annex Bool) -> Annex Bool
-getViaTmpChecked check key action =
- prepGetViaTmpChecked key False $
- finishGetViaTmp check key action
+getViaTmpUnchecked key action = do
+ tmpfile <- prepTmp key
+ ifM (action tmpfile)
+ ( do
+ moveAnnex key tmpfile
+ logStatus key InfoPresent
+ return True
+ -- the tmp file is left behind, in case caller wants
+ -- to resume its transfer
+ , return False
+ )
{- Prepares to download a key via a tmp file, and checks that there is
- enough free disk space.
@@ -253,19 +258,6 @@ prepGetViaTmpChecked key unabletoget getkey = do
, return unabletoget
)
-finishGetViaTmp :: Annex Bool -> Key -> (FilePath -> Annex Bool) -> Annex Bool
-finishGetViaTmp check key action = do
- tmpfile <- prepTmp key
- ifM (action tmpfile <&&> check)
- ( do
- moveAnnex key tmpfile
- logStatus key InfoPresent
- return True
- -- the tmp file is left behind, in case caller wants
- -- to resume its transfer
- , return False
- )
-
prepTmp :: Key -> Annex FilePath
prepTmp key = do
tmp <- fromRepo $ gitAnnexTmpObjectLocation key
diff --git a/Remote/Git.hs b/Remote/Git.hs
index 4187a5178..1b5b2ab42 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -502,8 +502,8 @@ copyToRemote' r key file p
ensureInitialized
runTransfer (Transfer Download u key) file noRetry noObserver $ const $
Annex.Content.saveState True `after`
- Annex.Content.getViaTmpChecked (liftIO checksuccessio) key
- (\dest -> mkCopier hardlink params object dest >>= \a -> a p)
+ Annex.Content.getViaTmp key
+ (\dest -> mkCopier hardlink params object dest >>= \a -> a p <&&> liftIO checksuccessio)
)
fsckOnRemote :: Git.Repo -> [CommandParam] -> Annex (IO Bool)