From 79e163ec1182e4b247f3a9b86f9096a96cdd299a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 1 Oct 2015 14:07:06 -0400 Subject: refactor --- Annex/Content.hs | 38 +++++++++++++++----------------------- Remote/Git.hs | 4 ++-- 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) -- cgit v1.2.3