refactoring

diff --git a/Remote/Git.hs b/Remote/Git.hs
index 43255ec32d76bcdb711d8260d6592c8fe1ebf01f..f05b9c92a1c62cf54597ab53fa4339119a117811 100644 (file)
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -545,7 +545,7 @@ copyFromRemote'' repo forcersync r st@(State connpool _ _ _ _) key file dest met
                                (ok, v) <- runTransfer (Transfer Download u (fromKey id key))
                                        file Nothing stdRetry $ \p ->
                                                metered (Just (combineMeterUpdate p meterupdate)) key $ \_ p' -> 
-                                                       copier object dest p' checksuccess
+                                                       copier object dest key p' checksuccess
                                if ok
                                        then return v
                                        else giveup "failed to retrieve content from remote"
@@ -690,7 +690,7 @@ copyToRemote' repo r st@(State connpool duc _ _ _) key file meterupdate
                                let rsp = RetrievalAllKeysSecure
                                res <- logStatusAfter key $ Annex.Content.getViaTmp rsp verify key file $ \dest ->
                                        metered (Just (combineMeterUpdate meterupdate p)) key $ \_ p' -> 
-                                               copier object (fromRawFilePath dest) p' (liftIO checksuccessio)
+                                               copier object (fromRawFilePath dest) key p' (liftIO checksuccessio)
                                Annex.Content.saveState True
                                return res
                        )
@@ -783,50 +783,6 @@ onLocal' (LocalRemoteAnnex repo v) a = liftIO (takeMVar v) >>= \case
 onLocalFast :: State -> Annex a -> Annex a
 onLocalFast st a = onLocal st $ Annex.BranchState.disableUpdate >> a
 
--- To avoid the overhead of trying copy-on-write every time, it's tried
--- once and if it fails, is not tried again.
-newtype CopyCoWTried = CopyCoWTried (MVar Bool)
-
-newCopyCoWTried :: IO CopyCoWTried
-newCopyCoWTried = CopyCoWTried <$> newEmptyMVar
-
-{- Copys a file. Uses copy-on-write if it is supported. Otherwise,
- - uses rsync, so that interrupted copies can be resumed. -}
-rsyncOrCopyFile :: State -> [CommandParam] -> FilePath -> FilePath -> MeterUpdate -> Annex Bool
-#ifdef mingw32_HOST_OS
-rsyncOrCopyFile _st _rsyncparams src dest p =
-       -- rsync is only available on Windows in some installation methods,
-       -- and is not strictly needed here, so don't use it.
-       docopywith copyFileExternal
-  where
-#else
-rsyncOrCopyFile st rsyncparams src dest p =
-       -- If multiple threads reach this at the same time, they
-       -- will both try CoW, which is acceptable.
-       ifM (liftIO $ isEmptyMVar copycowtried)
-               ( do
-                       ok <- docopycow
-                       void $ liftIO $ tryPutMVar copycowtried ok
-                       pure ok <||> dorsync
-               , ifM (liftIO $ readMVar copycowtried)
-                       ( docopycow <||> dorsync
-                       , dorsync
-                       )
-               )
-  where
-       copycowtried = case st of
-               State _ _ (CopyCoWTried v) _ _ -> v
-       dorsync = do
-               -- dest may already exist, so make sure rsync can write to it
-               void $ liftIO $ tryIO $ allowWrite (toRawFilePath dest)
-               oh <- mkOutputHandlerQuiet
-               Ssh.rsyncHelper oh (Just p) $
-                       rsyncparams ++ [File src, File dest]
-       docopycow = docopywith copyCoW
-#endif
-       docopywith a = liftIO $ watchFileSize dest p $
-               a CopyTimeStamps src dest
-
 commitOnCleanup :: Git.Repo -> Remote -> State -> Annex a -> Annex a
 commitOnCleanup repo r st a = go `after` a
   where
@@ -867,23 +823,23 @@ wantHardLink = (annexHardLink <$> Annex.getGitConfig)
 --
 -- When a hard link is created, returns Verified; the repo being linked
 -- from is implicitly trusted, so no expensive verification needs to be
--- done.
-type Copier = FilePath -> FilePath -> MeterUpdate -> Annex Bool -> Annex (Bool, Verification)
+-- done. Also returns Verified if the key's content is verified while
+-- copying it.
+type Copier = FilePath -> FilePath -> Key -> MeterUpdate -> Annex Bool -> Annex (Bool, Verification)
 
 mkCopier :: Bool -> State -> [CommandParam] -> Annex Copier
 mkCopier remotewanthardlink st rsyncparams = do
-       let copier = \src dest p check -> unVerified $
-               rsyncOrCopyFile st rsyncparams src dest p <&&> check
+       let copier = fileCopier st rsyncparams
        localwanthardlink <- wantHardLink
        let linker = \src dest -> createLink src dest >> return True
        if remotewanthardlink || localwanthardlink
-               then return $ \src dest p check ->
+               then return $ \src dest k p check ->
                        ifM (liftIO (catchBoolIO (linker src dest)))
                                ( ifM check
                                        ( return (True, Verified)
                                        , return (False, UnVerified)
                                        )
-                               , copier src dest p check
+                               , copier src dest k p check
                                )
                else return copier
 
@@ -941,3 +897,53 @@ mkState r u gc = do
                                )
 
                        return (duc, getrepo)
+
+-- To avoid the overhead of trying copy-on-write every time, it's tried
+-- once and if it fails, is not tried again.
+newtype CopyCoWTried = CopyCoWTried (MVar Bool)
+
+newCopyCoWTried :: IO CopyCoWTried
+newCopyCoWTried = CopyCoWTried <$> newEmptyMVar
+
+{- Copys a file. Uses copy-on-write if it is supported. Otherwise,
+ - uses rsync, so that interrupted copies can be resumed. -}
+fileCopier :: State -> [CommandParam] -> Copier
+#ifdef mingw32_HOST_OS
+rsyncOrCopyFile _st _rsyncparams src dest k p check =
+       -- rsync is only available on Windows in some installation methods,
+       -- and is not strictly needed here, so don't use it.
+       unVerified $ docopywith copyFileExternal <&&> check
+  where
+#else
+fileCopier st rsyncparams src dest _k p check =
+       -- If multiple threads reach this at the same time, they
+       -- will both try CoW, which is acceptable.
+       ifM (liftIO $ isEmptyMVar copycowtried)
+               ( do
+                       ok <- docopycow
+                       void $ liftIO $ tryPutMVar copycowtried ok
+                       if ok
+                               then unVerified check
+                               else unVerified $ dorsync <&&> check
+               , ifM (liftIO $ readMVar copycowtried)
+                       ( do
+                               ok <- docopycow
+                               if ok
+                                       then unVerified check
+                                       else unVerified $ dorsync <&&> check
+                       , unVerified dorsync
+                       )
+               )
+  where
+       copycowtried = case st of
+               State _ _ (CopyCoWTried v) _ _ -> v
+       dorsync = do
+               -- dest may already exist, so make sure rsync can write to it
+               void $ liftIO $ tryIO $ allowWrite (toRawFilePath dest)
+               oh <- mkOutputHandlerQuiet
+               Ssh.rsyncHelper oh (Just p) $
+                       rsyncparams ++ [File src, File dest]
+       docopycow = docopywith copyCoW
+#endif
+       docopywith a = liftIO $ watchFileSize dest p $
+               a CopyTimeStamps src dest