get, move, copy, mirror: Added --failed switch which retries failed copies/moves

Note that get --from foo --failed will get things that a previous get --from bar
tried and failed to get, etc. I considered making --failed only retry
transfers from the same remote, but it was easier, and seems more useful,
to not have the same remote requirement.

Noisy due to some refactoring into Types/

Annex/Content.hs

@@ -54,6 +54,7 @@ import qualified Data.Set as S
 
 import Annex.Common
 import Logs.Location
+import Types.Transfer
 import Logs.Transfer
 import qualified Git
 import qualified Annex

Annex/Notification.hs

@@ -10,7 +10,7 @@
 module Annex.Notification (NotifyWitness, notifyTransfer, notifyDrop) where
 
 import Annex.Common
-import Logs.Transfer
+import Types.Transfer
 #ifdef WITH_DBUS_NOTIFICATIONS
 import qualified Annex
 import Types.DesktopNotify

Annex/Transfer.hs

@@ -20,6 +20,7 @@ module Annex.Transfer (
 
 import Annex.Common
 import Logs.Transfer as X
+import Types.Transfer as X
 import Annex.Notification as X
 import Annex.Perms
 import Utility.Metered

Assistant/Alert.hs

@@ -14,7 +14,7 @@ import Assistant.Types.Alert
 import Assistant.Alert.Utility
 import qualified Remote
 import Utility.Tense
-import Logs.Transfer
+import Types.Transfer
 import Types.Distribution
 import Git.Types (RemoteName)
 

Assistant/DaemonStatus.hs

@@ -14,6 +14,7 @@ import Assistant.Alert.Utility
 import Utility.Tmp
 import Assistant.Types.NetMessager
 import Utility.NotificationBroadcaster
+import Types.Transfer
 import Logs.Transfer
 import Logs.Trust
 import Logs.TimeStamp

Assistant/DeleteRemote.hs

@@ -12,7 +12,7 @@ module Assistant.DeleteRemote where
 import Assistant.Common
 import Assistant.Types.UrlRenderer
 import Assistant.TransferQueue
-import Logs.Transfer
+import Types.Transfer
 import Logs.Location
 import Assistant.DaemonStatus
 import qualified Remote

Assistant/Sync.hs

@@ -36,7 +36,7 @@ import Assistant.Threads.Watcher (watchThread, WatcherControl(..))
 import Assistant.TransferSlots
 import Assistant.TransferQueue
 import Assistant.RepoProblem
-import Logs.Transfer
+import Types.Transfer
 
 import Data.Time.Clock
 import qualified Data.Map as M

Assistant/Threads/Committer.hs

@@ -17,7 +17,7 @@ import Assistant.Alert
 import Assistant.DaemonStatus
 import Assistant.TransferQueue
 import Assistant.Drop
-import Logs.Transfer
+import Types.Transfer
 import Logs.Location
 import qualified Annex.Queue
 import qualified Git.LsFiles

Assistant/Threads/Cronner.hs

@@ -24,7 +24,7 @@ import Utility.HumanTime
 import Utility.Batch
 import Assistant.TransferQueue
 import Annex.Content
-import Logs.Transfer
+import Types.Transfer
 import Assistant.Types.UrlRenderer
 import Assistant.Alert
 import Remote

Assistant/Threads/Glacier.hs

@@ -14,6 +14,7 @@ import Assistant.Common
 import Utility.ThreadScheduler
 import qualified Types.Remote as Remote
 import qualified Remote.Glacier as Glacier
+import Types.Transfer
 import Logs.Transfer
 import Assistant.DaemonStatus
 import Assistant.TransferQueue

Assistant/Threads/SanityChecker.hs

@@ -38,7 +38,7 @@ import Git.Repair
 import Git.Index
 import Assistant.Unused
 import Logs.Unused
-import Logs.Transfer
+import Types.Transfer
 import Annex.Path
 import qualified Annex
 #ifdef WITH_WEBAPP

Assistant/Threads/TransferPoller.hs

@@ -9,6 +9,7 @@ module Assistant.Threads.TransferPoller where
 
 import Assistant.Common
 import Assistant.DaemonStatus
+import Types.Transfer
 import Logs.Transfer
 import Utility.NotificationBroadcaster
 import qualified Assistant.Threads.TransferWatcher as TransferWatcher

Assistant/Threads/TransferScanner.hs

@@ -16,6 +16,7 @@ import Assistant.Drop
 import Assistant.Sync
 import Assistant.DeleteRemote
 import Assistant.Types.UrlRenderer
+import Types.Transfer
 import Logs.Transfer
 import Logs.Location
 import Logs.Group

Assistant/Threads/TransferWatcher.hs

@@ -10,6 +10,7 @@ module Assistant.Threads.TransferWatcher where
 import Assistant.Common
 import Assistant.DaemonStatus
 import Assistant.TransferSlots
+import Types.Transfer
 import Logs.Transfer
 import Utility.DirWatcher
 import Utility.DirWatcher.Types

Assistant/Threads/Transferrer.hs

@@ -10,7 +10,7 @@ module Assistant.Threads.Transferrer where
 import Assistant.Common
 import Assistant.TransferQueue
 import Assistant.TransferSlots
-import Logs.Transfer
+import Types.Transfer
 import Annex.Path
 import Utility.Batch
 

Assistant/TransferQueue.hs

@@ -26,6 +26,7 @@ module Assistant.TransferQueue (
 import Assistant.Common
 import Assistant.DaemonStatus
 import Assistant.Types.TransferQueue
+import Types.Transfer
 import Logs.Transfer
 import Types.Remote
 import qualified Remote

Assistant/TransferSlots.hs

@@ -21,6 +21,7 @@ import Assistant.Alert
 import Assistant.Alert.Utility
 import Assistant.Commits
 import Assistant.Drop
+import Types.Transfer
 import Logs.Transfer
 import Logs.Location
 import qualified Git

Assistant/TransferrerPool.hs

@@ -9,7 +9,7 @@ module Assistant.TransferrerPool where
 
 import Assistant.Common
 import Assistant.Types.TransferrerPool
-import Logs.Transfer
+import Types.Transfer
 import Utility.Batch
 
 import qualified Command.TransferKeys as T

Assistant/Types/DaemonStatus.hs

@@ -10,7 +10,7 @@ module Assistant.Types.DaemonStatus where
 import Annex.Common
 import Assistant.Pairing
 import Utility.NotificationBroadcaster
-import Logs.Transfer
+import Types.Transfer
 import Assistant.Types.ThreadName
 import Assistant.Types.NetMessager
 import Assistant.Types.Alert

Assistant/Types/TransferQueue.hs

@@ -8,7 +8,7 @@
 module Assistant.Types.TransferQueue where
 
 import Annex.Common
-import Logs.Transfer
+import Types.Transfer
 
 import Control.Concurrent.STM
 import Utility.TList

Assistant/Upgrade.hs

@@ -16,7 +16,7 @@ import Assistant.Alert
 import Assistant.DaemonStatus
 import Utility.Env
 import Types.Distribution
-import Logs.Transfer
+import Types.Transfer
 import Logs.Web
 import Logs.Presence
 import Logs.Location

Assistant/WebApp/DashBoard.hs

@@ -16,6 +16,7 @@ import Assistant.TransferQueue
 import Assistant.TransferSlots
 import Assistant.DaemonStatus
 import Utility.NotificationBroadcaster
+import Types.Transfer
 import Logs.Transfer
 import Utility.Percentage
 import Utility.DataUnits

Assistant/WebApp/Types.hs

@@ -19,7 +19,7 @@ import Assistant.Types.Buddies
 import Utility.NotificationBroadcaster
 import Utility.WebApp
 import Utility.Yesod
-import Logs.Transfer
+import Types.Transfer
 import Utility.Gpg (KeyId)
 import Build.SysConfig (packageversion)
 import Types.ScheduledActivity

CHANGELOG

@@ -20,6 +20,8 @@ git-annex (6.20160726) UNRELEASED; urgency=medium
     not been added on uuid-1.3.12.)
   * info: When run on a file now includes an indication of whether
     the content is present locally.
+  * get, move, copy, mirror: Added --failed switch which retries
+    failed copies/moves.
 
  -- Joey Hess <id@joeyh.name>  Wed, 20 Jul 2016 12:03:15 -0400
 

CmdLine/GitAnnex/Options.hs

@@ -139,20 +139,13 @@ parseToOption = parseRemoteOption $ strOption
 data KeyOptions
 	= WantAllKeys
 	| WantUnusedKeys
+	| WantFailedTransfers
 	| WantSpecificKey Key
 	| WantIncompleteKeys
 	| WantBranchKeys [Branch]
 
-parseKeyOptions :: Bool -> Parser KeyOptions
-parseKeyOptions allowincomplete = if allowincomplete
-	then base
-		<|> flag' WantIncompleteKeys
-			( long "incomplete"
-			<> help "resume previous downloads"
-			)
-	else base
-  where
-	base = parseAllOption
+parseKeyOptions :: Parser KeyOptions
+parseKeyOptions = parseAllOption
 	<|> WantBranchKeys <$> some (option (str >>= pure . Ref)
 		( long "branch" <> metavar paramRef
 		<> help "operate on files in the specified branch or treeish"
@@ -166,6 +159,18 @@ parseKeyOptions allowincomplete = if allowincomplete
 		<> help "operate on specified key"
 		))
 
+parseFailedTransfersOption :: Parser KeyOptions
+parseFailedTransfersOption = flag' WantFailedTransfers
+	( long "failed"
+	<> help "operate on files that recently failed to be transferred"
+	)
+
+parseIncompleteOption :: Parser KeyOptions
+parseIncompleteOption = flag' WantIncompleteKeys
+	( long "incomplete"
+	<> help "resume previous downloads"
+	)
+
 parseAllOption :: Parser KeyOptions
 parseAllOption = flag' WantAllKeys
 	( long "all" <> short 'A'

CmdLine/Seek.hs

@@ -25,6 +25,10 @@ import CmdLine.GitAnnex.Options
 import CmdLine.Action
 import Logs.Location
 import Logs.Unused
+import Types.Transfer
+import Logs.Transfer
+import Remote.List
+import qualified Remote
 import Annex.CatFile
 import Annex.Content
 
@@ -154,8 +158,9 @@ withNothing :: CommandStart -> CmdParams -> CommandSeek
 withNothing a [] = seekActions $ return [a]
 withNothing _ _ = error "This command takes no parameters."
 
-{- Handles the --all, --branch, --unused, --key, and --incomplete options,
- - which specify particular keys to run an action on.
+{- Handles the --all, --branch, --unused, --failed, --key, and
+ - --incomplete options, which specify particular keys to run an
+ - action on.
  -
  - In a bare repo, --all is the default.
  -
@@ -180,8 +185,7 @@ withKeyOptions'
 	:: Maybe KeyOptions
 	-> Bool
 	-> Annex (Key -> ActionItem -> Annex ())
-	-> (CmdParams
-	-> CommandSeek)
+	-> (CmdParams -> CommandSeek)
 	-> CmdParams
 	-> CommandSeek
 withKeyOptions' ko auto mkkeyaction fallbackaction params = do
@@ -195,10 +199,11 @@ withKeyOptions' ko auto mkkeyaction fallbackaction params = do
 		(False, Nothing) -> fallbackaction params
 		(True, Just WantAllKeys) -> noauto $ runkeyaction loggedKeys
 		(True, Just WantUnusedKeys) -> noauto $ runkeyaction unusedKeys'
+		(True, Just WantFailedTransfers) -> noauto runfailedtransfers
 		(True, Just (WantSpecificKey k)) -> noauto $ runkeyaction (return [k])
 		(True, Just WantIncompleteKeys) -> noauto $ runkeyaction incompletekeys
 		(True, Just (WantBranchKeys bs)) -> noauto $ runbranchkeys bs
-		(False, Just _) -> error "Can only specify one of file names, --all, --branch, --unused, --key, or --incomplete"
+		(False, Just _) -> error "Can only specify one of file names, --all, --branch, --unused, --failed, --key, or --incomplete"
   where
 	noauto a
 		| auto = error "Cannot use --auto with --all or --branch or --unused or --key or --incomplete"
@@ -218,6 +223,12 @@ withKeyOptions' ko auto mkkeyaction fallbackaction params = do
 					=<< catKey (LsTree.sha i)
 			unlessM (liftIO cleanup) $
 				error ("git ls-tree " ++ Git.fromRef b ++ " failed")
+	runfailedtransfers = do
+		keyaction <- mkkeyaction
+		rs <- remoteList
+		ts <- concat <$> mapM (getFailedTransfers . Remote.uuid) rs
+		forM_ ts $ \(t, i) ->
+			keyaction (transferKey t) (mkActionItem (t, i))
 
 prepFiltered :: (FilePath -> CommandStart) -> Annex [FilePath] -> Annex [CommandStart]
 prepFiltered a fs = do

Command.hs

@@ -1,6 +1,6 @@
 {- git-annex command infrastructure
  -
- - Copyright 2010-2015 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2016 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -26,6 +26,8 @@ import qualified Git
 import Annex.Init
 import Config
 import Utility.Daemon
+import Types.Transfer
+import Types.ActionItem
 
 {- Generates a normal Command -}
 command :: String -> CommandSection -> String -> CmdParamsDesc -> (CmdParamsDesc -> CommandParser) -> Command
@@ -91,6 +93,15 @@ stop = return Nothing
 stopUnless :: Annex Bool -> Annex (Maybe a) -> Annex (Maybe a)
 stopUnless c a = ifM c ( a , stop )
 
+{- When acting on a failed transfer, stops unless it was in the specified
+ - direction. -}
+checkFailedTransferDirection :: ActionItem -> Direction -> Annex (Maybe a) -> Annex (Maybe a)
+checkFailedTransferDirection ai d = stopUnless (pure check)
+  where
+	check = case actionItemTransferDirection ai of
+		Nothing -> True
+		Just d' -> d' == d
+
 commonChecks :: [CommandCheck]
 commonChecks = [repoExists]
 

Command/Drop.hs

@@ -41,7 +41,7 @@ optParser desc = DropOptions
 	<$> cmdParams desc
 	<*> optional parseDropFromOption
 	<*> parseAutoOption
-	<*> optional (parseKeyOptions False)
+	<*> optional parseKeyOptions
 	<*> parseBatchOption
 
 parseDropFromOption :: Parser (DeferredParse Remote)

Command/Fsck.hs

@@ -66,7 +66,7 @@ optParser desc = FsckOptions
 		<> completeRemotes
 		))
 	<*> optional parseincremental
-	<*> optional (parseKeyOptions False)
+	<*> optional parseKeyOptions
   where
 	parseincremental =
 		flag' StartIncrementalO

Command/Get.hs

@@ -14,6 +14,7 @@ import Annex.Transfer
 import Annex.NumCopies
 import Annex.Wanted
 import qualified Command.Move
+import Types.ActionItem
 
 cmd :: Command
 cmd = withGlobalOptions (jobsOption : jsonOption : annexedMatchingOptions) $ 
@@ -34,7 +35,7 @@ optParser desc = GetOptions
 	<$> cmdParams desc
 	<*> optional parseFromOption
 	<*> parseAutoOption
-	<*> optional (parseKeyOptions True)
+	<*> optional (parseIncompleteOption <|> parseKeyOptions <|> parseFailedTransfersOption)
 	<*> parseBatchOption
 
 seek :: GetOptions -> CommandSeek
@@ -57,7 +58,8 @@ start o from file key = start' expensivecheck from key afile (mkActionItem afile
 		| otherwise = return True
 
 startKeys :: Maybe Remote -> Key -> ActionItem -> CommandStart
-startKeys from key = start' (return True) from key Nothing
+startKeys from key ai = checkFailedTransferDirection ai Download $
+	start' (return True) from key Nothing ai
 
 start' :: Annex Bool -> Maybe Remote -> Key -> AssociatedFile -> ActionItem -> CommandStart
 start' expensivecheck from key afile ai = stopUnless (not <$> inAnnex key) $

Command/Info.hs

@@ -32,6 +32,7 @@ import Remote
 import Config
 import Git.Config (boolConfig)
 import Utility.Percentage
+import Types.Transfer
 import Logs.Transfer
 import Types.TrustLevel
 import Types.FileMatcher

Command/MetaData.hs

@@ -40,7 +40,7 @@ optParser :: CmdParamsDesc -> Parser MetaDataOptions
 optParser desc = MetaDataOptions
 	<$> cmdParams desc
 	<*> ((Get <$> getopt) <|> (Set <$> some modopts) <|> pure GetAll)
-	<*> optional (parseKeyOptions False)
+	<*> optional parseKeyOptions
 	<*> parseBatchOption
   where
 	getopt = option (eitherReader mkMetaField)

Command/Mirror.hs

@@ -14,6 +14,7 @@ import qualified Command.Get
 import qualified Remote
 import Annex.Content
 import Annex.NumCopies
+import Types.Transfer
 
 cmd :: Command
 cmd = withGlobalOptions ([jobsOption] ++ annexedMatchingOptions) $
@@ -31,7 +32,7 @@ optParser :: CmdParamsDesc -> Parser MirrorOptions
 optParser desc = MirrorOptions
 	<$> cmdParams desc
 	<*> parseFromToOptions
-	<*> optional (parseKeyOptions False)
+	<*> optional (parseKeyOptions <|> parseFailedTransfersOption)
 
 instance DeferredParseClass MirrorOptions where
 	finishParse v = MirrorOptions
@@ -53,13 +54,13 @@ start o file k = startKey o afile k (mkActionItem afile)
 
 startKey :: MirrorOptions -> Maybe FilePath -> Key -> ActionItem -> CommandStart
 startKey o afile key ai = case fromToOptions o of
-	ToRemote r -> ifM (inAnnex key)
+	ToRemote r -> checkFailedTransferDirection ai Upload $ ifM (inAnnex key)
 		( Command.Move.toStart False afile key ai =<< getParsed r
 		, do
 			numcopies <- getnumcopies
 			Command.Drop.startRemote afile ai numcopies key =<< getParsed r
 		)
-	FromRemote r -> do
+	FromRemote r -> checkFailedTransferDirection ai Download $ do
 		haskey <- flip Remote.hasKey key =<< getParsed r
 		case haskey of
 			Left _ -> stop

Command/Move.hs

@@ -35,7 +35,7 @@ optParser :: CmdParamsDesc -> Parser MoveOptions
 optParser desc = MoveOptions
 	<$> cmdParams desc
 	<*> parseFromToOptions
-	<*> optional (parseKeyOptions False)
+	<*> optional (parseKeyOptions <|> parseFailedTransfersOption)
 
 instance DeferredParseClass MoveOptions where
 	finishParse v = MoveOptions
@@ -61,8 +61,10 @@ startKey o move = start' o move Nothing
 start' :: MoveOptions -> Bool -> AssociatedFile -> Key -> ActionItem -> CommandStart
 start' o move afile key ai = 
 	case fromToOptions o of
-		FromRemote src -> fromStart move afile key ai =<< getParsed src
-		ToRemote dest -> toStart move afile key ai =<< getParsed dest
+		FromRemote src -> checkFailedTransferDirection ai Download $
+			fromStart move afile key ai =<< getParsed src
+		ToRemote dest -> checkFailedTransferDirection ai Upload $
+			toStart move afile key ai =<< getParsed dest
 
 showMoveAction :: Bool -> Key -> ActionItem -> Annex ()
 showMoveAction move = showStart' (if move then "move" else "copy")

Command/RecvKey.hs

@@ -12,7 +12,7 @@ import Annex.Content
 import Annex.Action
 import Annex
 import Utility.Rsync
-import Logs.Transfer
+import Types.Transfer
 import Command.SendKey (fieldTransfer)
 import qualified CmdLine.GitAnnexShell.Fields as Fields
 

Command/TransferInfo.hs

@@ -9,6 +9,7 @@ module Command.TransferInfo where
 
 import Command
 import Annex.Content
+import Types.Transfer
 import Logs.Transfer
 import qualified CmdLine.GitAnnexShell.Fields as Fields
 import Utility.Metered

Command/Whereis.hs

@@ -31,7 +31,7 @@ data WhereisOptions = WhereisOptions
 optParser :: CmdParamsDesc -> Parser WhereisOptions
 optParser desc = WhereisOptions
 	<$> cmdParams desc
-	<*> optional (parseKeyOptions False)
+	<*> optional parseKeyOptions
 	<*> parseBatchOption
 
 seek :: WhereisOptions -> CommandSeek

Logs/Transfer.hs

@@ -9,6 +9,7 @@
 
 module Logs.Transfer where
 
+import Types.Transfer
 import Annex.Common
 import Annex.Perms
 import qualified Git
@@ -23,38 +24,6 @@ import Data.Time.Clock
 import Data.Time.Clock.POSIX
 import Control.Concurrent
 
-{- Enough information to uniquely identify a transfer, used as the filename
- - of the transfer information file. -}
-data Transfer = Transfer
-	{ transferDirection :: Direction
-	, transferUUID :: UUID
-	, transferKey :: Key
-	}
-	deriving (Eq, Ord, Read, Show)
-
-{- Information about a Transfer, stored in the transfer information file.
- -
- - Note that the associatedFile may not correspond to a file in the local
- - git repository. It's some file, possibly relative to some directory,
- - of some repository, that was acted on to initiate the transfer.
- -}
-data TransferInfo = TransferInfo
-	{ startedTime :: Maybe POSIXTime
-	, transferPid :: Maybe PID
-	, transferTid :: Maybe ThreadId
-	, transferRemote :: Maybe Remote
-	, bytesComplete :: Maybe Integer
-	, associatedFile :: Maybe FilePath
-	, transferPaused :: Bool
-	}
-	deriving (Show, Eq, Ord)
-
-stubTransferInfo :: TransferInfo
-stubTransferInfo = TransferInfo Nothing Nothing Nothing Nothing Nothing Nothing False
-
-data Direction = Upload | Download
-	deriving (Eq, Ord, Read, Show)
-
 showLcDirection :: Direction -> String
 showLcDirection Upload = "upload"
 showLcDirection Download = "download"

Messages.hs

@@ -5,8 +5,6 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
-
 module Messages (
 	showStart,
 	ActionItem,
@@ -53,11 +51,10 @@ import System.Log.Handler.Simple
 import Common
 import Types
 import Types.Messages
-import Git.FilePath
+import Types.ActionItem
 import Messages.Internal
 import qualified Messages.JSON as JSON
 import Utility.JSONStream (JSONChunk(..))
-import Types.Key
 import qualified Annex
 
 showStart :: String -> FilePath -> Annex ()
@@ -66,33 +63,6 @@ showStart command file = outputMessage json $
   where
 	json = JSON.start command (Just file) Nothing
 
-data ActionItem 
-	= ActionItemAssociatedFile AssociatedFile
-	| ActionItemKey
-	| ActionItemBranchFilePath BranchFilePath
-
-class MkActionItem t where
-	mkActionItem :: t -> ActionItem
-
-instance MkActionItem AssociatedFile where
-	mkActionItem = ActionItemAssociatedFile
-
-instance MkActionItem Key where
-	mkActionItem _ = ActionItemKey
-
-instance MkActionItem BranchFilePath where
-	mkActionItem = ActionItemBranchFilePath
-
-actionItemDesc :: ActionItem -> Key -> String
-actionItemDesc (ActionItemAssociatedFile (Just f)) _ = f
-actionItemDesc (ActionItemAssociatedFile Nothing) k = key2file k
-actionItemDesc ActionItemKey k = key2file k
-actionItemDesc (ActionItemBranchFilePath bfp) _ = descBranchFilePath bfp
-
-actionItemWorkTreeFile :: ActionItem -> Maybe FilePath
-actionItemWorkTreeFile (ActionItemAssociatedFile af) = af
-actionItemWorkTreeFile _ = Nothing
-
 showStart' :: String -> Key -> ActionItem -> Annex ()
 showStart' command key i = outputMessage json $
 	command ++ " " ++ actionItemDesc i key ++ " "

Remote/External.hs

@@ -22,7 +22,7 @@ import Remote.Helper.ReadOnly
 import Remote.Helper.Messages
 import Utility.Metered
 import Messages.Progress
-import Logs.Transfer
+import Types.Transfer
 import Logs.PreferredContent.Raw
 import Logs.RemoteState
 import Logs.Web

Remote/External/Types.hs

@@ -34,7 +34,7 @@ module Remote.External.Types (
 import Annex.Common
 import Types.StandardGroups (PreferredContentExpression)
 import Utility.Metered (BytesProcessed(..))
-import Logs.Transfer (Direction(..))
+import Types.Transfer (Direction(..))
 import Config.Cost (Cost)
 import Types.Remote (RemoteConfig)
 import Types.Availability (Availability(..))

Remote/GCrypt.hs

@@ -25,6 +25,7 @@ import Types.Remote
 import Types.GitConfig
 import Types.Crypto
 import Types.Creds
+import Types.Transfer
 import qualified Git
 import qualified Git.Command
 import qualified Git.Config
@@ -47,7 +48,6 @@ import qualified Remote.Directory
 import Utility.Rsync
 import Utility.Tmp
 import Logs.Remote
-import Logs.Transfer
 import Utility.Gpg
 
 remote :: RemoteType

Remote/Helper/Ssh.hs

@@ -20,7 +20,7 @@ import Messages.Progress
 import Utility.Metered
 import Utility.Rsync
 import Types.Remote
-import Logs.Transfer
+import Types.Transfer
 import Config
 
 {- Generates parameters to ssh to a repository's host and run a command.

Remote/Rsync.hs

@@ -34,7 +34,7 @@ import Utility.Rsync
 import Utility.CopyFile
 import Messages.Progress
 import Utility.Metered
-import Logs.Transfer
+import Types.Transfer
 import Types.Creds
 import Annex.DirHashes
 import Utility.Tmp

Types/ActionItem.hs

@@ -0,0 +1,54 @@
+{- items that a command can act on
+ -
+ - Copyright 2016 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
+
+module Types.ActionItem where
+
+import Types.Key
+import Types.Transfer
+import Git.FilePath
+
+import Data.Maybe
+
+data ActionItem 
+	= ActionItemAssociatedFile AssociatedFile
+	| ActionItemKey
+	| ActionItemBranchFilePath BranchFilePath
+	| ActionItemFailedTransfer Transfer TransferInfo
+
+class MkActionItem t where
+	mkActionItem :: t -> ActionItem
+
+instance MkActionItem AssociatedFile where
+	mkActionItem = ActionItemAssociatedFile
+
+instance MkActionItem Key where
+	mkActionItem _ = ActionItemKey
+
+instance MkActionItem BranchFilePath where
+	mkActionItem = ActionItemBranchFilePath
+
+instance MkActionItem (Transfer, TransferInfo) where
+	mkActionItem = uncurry ActionItemFailedTransfer
+
+actionItemDesc :: ActionItem -> Key -> String
+actionItemDesc (ActionItemAssociatedFile (Just f)) _ = f
+actionItemDesc (ActionItemAssociatedFile Nothing) k = key2file k
+actionItemDesc ActionItemKey k = key2file k
+actionItemDesc (ActionItemBranchFilePath bfp) _ = descBranchFilePath bfp
+actionItemDesc (ActionItemFailedTransfer _ i) k = 
+	fromMaybe (key2file k) (associatedFile i)
+
+actionItemWorkTreeFile :: ActionItem -> Maybe FilePath
+actionItemWorkTreeFile (ActionItemAssociatedFile af) = af
+actionItemWorkTreeFile _ = Nothing
+
+actionItemTransferDirection :: ActionItem -> Maybe Direction
+actionItemTransferDirection (ActionItemFailedTransfer t _) = Just $
+	transferDirection t
+actionItemTransferDirection _ = Nothing

Types/Transfer.hs

@@ -0,0 +1,47 @@
+{- git-annex transfer types
+ -
+ - Copyright 2012 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Types.Transfer where
+
+import Types
+import Utility.PID
+
+import Data.Time.Clock.POSIX
+import Control.Concurrent
+
+{- Enough information to uniquely identify a transfer, used as the filename
+ - of the transfer information file. -}
+data Transfer = Transfer
+	{ transferDirection :: Direction
+	, transferUUID :: UUID
+	, transferKey :: Key
+	}
+	deriving (Eq, Ord, Read, Show)
+
+{- Information about a Transfer, stored in the transfer information file.
+ -
+ - Note that the associatedFile may not correspond to a file in the local
+ - git repository. It's some file, possibly relative to some directory,
+ - of some repository, that was acted on to initiate the transfer.
+ -}
+data TransferInfo = TransferInfo
+	{ startedTime :: Maybe POSIXTime
+	, transferPid :: Maybe PID
+	, transferTid :: Maybe ThreadId
+	, transferRemote :: Maybe Remote
+	, bytesComplete :: Maybe Integer
+	, associatedFile :: Maybe FilePath
+	, transferPaused :: Bool
+	}
+	deriving (Show, Eq, Ord)
+
+stubTransferInfo :: TransferInfo
+stubTransferInfo = TransferInfo Nothing Nothing Nothing Nothing Nothing Nothing False
+
+data Direction = Upload | Download
+	deriving (Eq, Ord, Read, Show)
+

doc/git-annex-copy.mdwn

@@ -59,6 +59,10 @@ Copies the content of files from or to another remote.
 
   Operate on files found by last run of git-annex unused.
 
+* `--failed`
+
+  Operate on files that have recently failed to be transferred.
+
 * `--key=keyname`
 
   Use this option to move a specified key.

doc/git-annex-get.mdwn

@@ -32,6 +32,11 @@ or transferring them from some kind of key-value store.
   Enables parallel download with up to the specified number of jobs
   running at once. For example: `-J10`
 
+* file matching options
+ 
+  The [[git-annex-matching-options]](1)
+  can be used to specify files to get.
+
 * `--incomplete`
 
   Resume any incomplete downloads of files that were started and
@@ -45,11 +50,6 @@ or transferring them from some kind of key-value store.
   as git-annex does not know the associated file, and the associated file
   may not even be in the current git working directory.
 
-* file matching options
- 
-  The [[git-annex-matching-options]](1)
-  can be used to specify files to get.
-
 * `--all`
 
   Rather than specifying a filename or path to get, this option can be
@@ -65,6 +65,10 @@ or transferring them from some kind of key-value store.
 
   Operate on files found by last run of git-annex unused.
 
+* `--failed`
+
+  Operate on files that have recently failed to be transferred.
+
 * `--key=keyname`
 
   Use this option to get a specified key.

doc/git-annex-mirror.mdwn

@@ -53,6 +53,14 @@ contents. Use [[git-annex-sync]](1) for that.
   Like --all, this bypasses checking the .gitattributes annex.numcopies
   setting when dropping files.
 
+* `--unused`
+
+  Operate on files found by last run of git-annex unused.
+
+* `--failed`
+
+  Operate on files that have recently failed to be transferred.
+
 * file matching options
 
   The [[git-annex-matching-options]](1)

doc/git-annex-move.mdwn

@@ -42,6 +42,10 @@ Moves the content of files from or to another remote.
 
   Operate on files found by last run of git-annex unused.
 
+* `--failed`
+
+  Operate on files that have recently failed to be transferred.
+
 * `--key=keyname`
 
   Use this option to move a specified key.

doc/todo/__34__copy_--failed__34__.mdwn

@@ -3,3 +3,5 @@ I often "copy --to remote" many files at once, and inevitably the transfer fails
 Related: <https://git-annex.branchable.com/todo/make_copy_--fast__faster/>
 
 git-annex is awesome btw. Thanks!
+
+> [[done]] --[[Joey]]

doc/todo/__34__copy_--failed__34__/comment_1_ff81023df39f9faac5935f6417ad2b38._comment

@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2016-08-03T15:07:43Z"
+ content="""
+Nice idea, and there's already a log of recent failed transfers that
+could be used.
+"""]]

doc/todo/make_copy_--fast__faster/comment_4_3ac10a07c74e5debafc9ae574d26c955._comment

@@ -0,0 +1,11 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 4"""
+ date="2016-08-03T16:02:46Z"
+ content="""
+--failed can now be used to retry only failed transfers. So that will be a
+lot faster in that specific case. 
+
+Leaving this bug open for the general wishlist that copy --fast be somehow
+a lot faster than it is at finding things that need to be copied.
+"""]]