AssociatedFile newtype

To prevent any further mistakes like 301aff34c4

This commit was sponsored by Francois Marier on Patreon.

Annex/Drop.hs

@@ -55,8 +55,8 @@ handleDropsFrom locs rs reason fromhere key afile preverified runner = do
 			map (`fromTopFilePath` g) <$> Database.Keys.getAssociatedFiles key
 		)
 	let fs = case afile of
-		Just f -> nub (f : l)
-		Nothing -> l
+		AssociatedFile (Just f) -> nub (f : l)
+		AssociatedFile Nothing -> l
 	n <- getcopies fs
 	void $ if fromhere && checkcopies n Nothing
 		then go fs rs n >>= dropl fs
@@ -93,9 +93,9 @@ handleDropsFrom locs rs reason fromhere key afile preverified runner = do
 
 	checkdrop fs n u a
 		| null fs = check $ -- no associated files; unused content
-			wantDrop True u (Just key) Nothing
+			wantDrop True u (Just key) (AssociatedFile Nothing)
 		| otherwise = check $
-			allM (wantDrop True u (Just key) . Just) fs
+			allM (wantDrop True u (Just key) . AssociatedFile . Just) fs
 		where
 			check c = ifM c
 				( dodrop n u a
@@ -107,7 +107,9 @@ handleDropsFrom locs rs reason fromhere key afile preverified runner = do
 			( do
 				liftIO $ debugM "drop" $ unwords
 					[ "dropped"
-					, fromMaybe (key2file key) afile
+					, case afile of
+						AssociatedFile Nothing -> key2file key
+						AssociatedFile (Just af) -> af
 					, "(from " ++ maybe "here" show u ++ ")"
 					, "(copies now " ++ show (fromNumCopies have - 1) ++ ")"
 					, ": " ++ reason

Annex/FileMatcher.hs

@@ -44,13 +44,13 @@ type GetFileMatcher = FilePath -> Annex (FileMatcher Annex)
 checkFileMatcher :: GetFileMatcher -> FilePath -> Annex Bool
 checkFileMatcher getmatcher file = do
 	matcher <- getmatcher file
-	checkMatcher matcher Nothing (Just file) S.empty True
+	checkMatcher matcher Nothing (AssociatedFile (Just file)) S.empty True
 
 checkMatcher :: FileMatcher Annex -> Maybe Key -> AssociatedFile -> AssumeNotPresent -> Bool -> Annex Bool
 checkMatcher matcher mkey afile notpresent d
 	| isEmpty matcher = return d
 	| otherwise = case (mkey, afile) of
-		(_, Just file) -> go =<< fileMatchInfo file
+		(_, AssociatedFile (Just file)) -> go =<< fileMatchInfo file
 		(Just key, _) -> go (MatchingKey key)
 		_ -> return d
   where

Annex/Notification.hs

@@ -28,10 +28,10 @@ noNotification = NotifyWitness
 {- Wrap around an action that performs a transfer, which may run multiple
  - attempts. Displays notification when supported and when the user asked
  - for it. -}
-notifyTransfer :: Direction -> Maybe FilePath -> (NotifyWitness -> Annex Bool) -> Annex Bool
-notifyTransfer _ Nothing a = a NotifyWitness
+notifyTransfer :: Direction -> AssociatedFile -> (NotifyWitness -> Annex Bool) -> Annex Bool
+notifyTransfer _ (AssociatedFile Nothing) a = a NotifyWitness
 #ifdef WITH_DBUS_NOTIFICATIONS
-notifyTransfer direction (Just f) a = do
+notifyTransfer direction (AssociatedFile (Just f)) a = do
 	wanted <- Annex.getState Annex.desktopnotify
 	if (notifyStart wanted || notifyFinish wanted)
 		then do
@@ -47,19 +47,19 @@ notifyTransfer direction (Just f) a = do
 			return ok
 		else a NotifyWitness
 #else
-notifyTransfer _ (Just _) a = a NotifyWitness
+notifyTransfer _ (AssociatedFile (Just _)) a = a NotifyWitness
 #endif
 
-notifyDrop :: Maybe FilePath -> Bool -> Annex ()
-notifyDrop Nothing _ = noop
+notifyDrop :: AssociatedFile -> Bool -> Annex ()
+notifyDrop (AssociatedFile Nothing) _ = noop
 #ifdef WITH_DBUS_NOTIFICATIONS
-notifyDrop (Just f) ok = do
+notifyDrop (AssociatedFile (Just f)) ok = do
 	wanted <- Annex.getState Annex.desktopnotify
 	when (notifyFinish wanted) $ liftIO $ do
 		client <- DBus.Client.connectSession
 		void $ Notify.notify client (droppedNote ok f)
 #else
-notifyDrop (Just _) _ = noop
+notifyDrop (AssociatedFile (Just _)) _ = noop
 #endif
 
 #ifdef WITH_DBUS_NOTIFICATIONS

Annex/Transfer.hs

@@ -77,7 +77,7 @@ guardHaveUUID u a
  - An upload can be run from a read-only filesystem, and in this case
  - no transfer information or lock file is used.
  -}
-runTransfer :: Observable v => Transfer -> Maybe FilePath -> RetryDecider -> (MeterUpdate -> Annex v) -> Annex v
+runTransfer :: Observable v => Transfer -> AssociatedFile -> RetryDecider -> (MeterUpdate -> Annex v) -> Annex v
 runTransfer = runTransfer' False
 
 {- Like runTransfer, but ignores any existing transfer lock file for the
@@ -85,12 +85,12 @@ runTransfer = runTransfer' False
  -
  - Note that this may result in confusing progress meter display in the
  - webapp, if multiple processes are writing to the transfer info file. -}
-alwaysRunTransfer :: Observable v => Transfer -> Maybe FilePath -> RetryDecider -> (MeterUpdate -> Annex v) -> Annex v
+alwaysRunTransfer :: Observable v => Transfer -> AssociatedFile -> RetryDecider -> (MeterUpdate -> Annex v) -> Annex v
 alwaysRunTransfer = runTransfer' True
 
-runTransfer' :: Observable v => Bool -> Transfer -> Maybe FilePath -> RetryDecider -> (MeterUpdate -> Annex v) -> Annex v
-runTransfer' ignorelock t file shouldretry transferaction = checkSecureHashes t $ do
-	info <- liftIO $ startTransferInfo file
+runTransfer' :: Observable v => Bool -> Transfer -> AssociatedFile -> RetryDecider -> (MeterUpdate -> Annex v) -> Annex v
+runTransfer' ignorelock t afile shouldretry transferaction = checkSecureHashes t $ do
+	info <- liftIO $ startTransferInfo afile
 	(meter, tfile, metervar) <- mkProgressUpdater t info
 	mode <- annexFileMode
 	(lck, inprogress) <- prep tfile mode info

Assistant/DeleteRemote.hs

@@ -64,7 +64,7 @@ removableRemote urlrenderer uuid = do
   where
 	queueremaining r k = 
 		queueTransferWhenSmall "remaining object in unwanted remote"
-			Nothing (Transfer Download uuid k) r
+			(AssociatedFile Nothing) (Transfer Download uuid k) r
 	{- Scanning for keys can take a long time; do not tie up
 	 - the Annex monad while doing it, so other threads continue to
 	 - run. -}

Assistant/Threads/Committer.hs

@@ -503,9 +503,10 @@ checkChangeContent change@(Change { changeInfo = i }) =
 		Just k -> whenM (scanComplete <$> getDaemonStatus) $ do
 			present <- liftAnnex $ inAnnex k
 			void $ if present
-				then queueTransfers "new file created" Next k (Just f) Upload
-				else queueTransfers "new or renamed file wanted" Next k (Just f) Download
-			handleDrops "file renamed" present k (Just f) []
+				then queueTransfers "new file created" Next k af Upload
+				else queueTransfers "new or renamed file wanted" Next k af Download
+			handleDrops "file renamed" present k af []
   where
 	f = changeFile change
+	af = AssociatedFile (Just f)
 checkChangeContent _ = noop

Assistant/Threads/Cronner.hs

@@ -190,7 +190,7 @@ runActivity' urlrenderer (ScheduledSelfFsck _ d) = do
 	void $ repairWhenNecessary urlrenderer u Nothing fsckresults
 	mapM_ reget =<< liftAnnex (dirKeys gitAnnexBadDir)
   where
-	reget k = queueTransfers "fsck found bad file; redownloading" Next k Nothing Download
+	reget k = queueTransfers "fsck found bad file; redownloading" Next k (AssociatedFile Nothing) Download
 runActivity' urlrenderer (ScheduledRemoteFsck u s d) = dispatch =<< liftAnnex (remoteFromUUID u)
   where
 	dispatch Nothing = debug ["skipping remote fsck of uuid without a configured remote", fromUUID u, fromSchedule s]

Assistant/Threads/SanityChecker.hs

@@ -190,8 +190,8 @@ dailyCheck urlrenderer = do
 	unused <- liftAnnex unusedKeys'
 	void $ liftAnnex $ setUnusedKeys unused
 	forM_ unused $ \k -> do
-		unlessM (queueTransfers "unused" Later k Nothing Upload) $
-			handleDrops "unused" True k Nothing []
+		unlessM (queueTransfers "unused" Later k (AssociatedFile Nothing) Upload) $
+			handleDrops "unused" True k (AssociatedFile Nothing) []
 
 	return True
   where

Assistant/Threads/TransferScanner.hs

@@ -154,8 +154,9 @@ expensiveScan urlrenderer rs = batch <~> do
 
 	enqueue f (r, t) =
 		queueTransferWhenSmall "expensive scan found missing object"
-			(Just f) t r
+			(AssociatedFile (Just f)) t r
 	findtransfers f unwanted key = do
+		let af = AssociatedFile (Just f)
 		{- The syncable remotes may have changed since this
 		 - scan began. -}
 		syncrs <- syncDataRemotes <$> getDaemonStatus
@@ -163,14 +164,14 @@ expensiveScan urlrenderer rs = batch <~> do
 		present <- liftAnnex $ inAnnex key
 		liftAnnex $ handleDropsFrom locs syncrs
 			"expensive scan found too many copies of object"
-			present key (Just f) [] callCommandAction
+			present key af [] callCommandAction
 		liftAnnex $ do
 			let slocs = S.fromList locs
 			let use a = return $ mapMaybe (a key slocs) syncrs
 			ts <- if present
-				then filterM (wantSend True (Just key) (Just f) . Remote.uuid . fst)
+				then filterM (wantSend True (Just key) af . Remote.uuid . fst)
 					=<< use (genTransfer Upload False)
-				else ifM (wantGet True (Just key) (Just f))
+				else ifM (wantGet True (Just key) af)
 					( use (genTransfer Download True) , return [] )
 			let unwanted' = S.difference unwanted slocs
 			return (unwanted', ts)

Assistant/TransferSlots.hs

@@ -153,10 +153,11 @@ genTransfer t info = case transferRemote info of
 	 -}
 	go remote transferrer = ifM (liftIO $ performTransfer transferrer t info)
 		( do
-			maybe noop
-				(void . addAlert . makeAlertFiller True 
-					. transferFileAlert direction True)
-				(associatedFile info)
+			case associatedFile info of
+				AssociatedFile Nothing -> noop
+				AssociatedFile (Just af) -> void $ 
+					addAlert $ makeAlertFiller True $
+						transferFileAlert direction True af
 			unless isdownload $
 				handleDrops
 					("object uploaded to " ++ show remote)

Assistant/Upgrade.hs

@@ -85,7 +85,7 @@ startDistributionDownload d = go =<< liftIO . newVersionLocation d =<< liftIO ol
 		hook <- asIO1 $ distributionDownloadComplete d dest cleanup
 		modifyDaemonStatus_ $ \s -> s
 			{ transferHook = M.insert k hook (transferHook s) }
-		maybe noop (queueTransfer "upgrade" Next (Just f) t)
+		maybe noop (queueTransfer "upgrade" Next (AssociatedFile (Just f)) t)
 			=<< liftAnnex (remoteFromUUID webUUID)
 		startTransfer t
 	k = distributionKey d

Assistant/WebApp/DashBoard.hs

@@ -43,6 +43,9 @@ transfersDisplay = do
 	ident = "transfers"
 	isrunning info = not $
 		transferPaused info || isNothing (startedTime info)
+	desc transfer info = case associatedFile info of
+		AssociatedFile Nothing -> key2file $ transferKey transfer
+		AssociatedFile (Just af) -> af
 
 {- Simplifies a list of transfers, avoiding display of redundant
  - equivilant transfers. -}

Backend/Hash.hs

@@ -148,8 +148,8 @@ trivialMigrate oldkey newbackend afile
 		}
 	{- Fast migration from hash to hashE backend. -}
 	| migratable && hasExt oldvariety = case afile of
-		Nothing -> Nothing
-		Just file -> Just $ oldkey
+		AssociatedFile Nothing -> Nothing
+		AssociatedFile (Just file) -> Just $ oldkey
 			{ keyName = keyHash oldkey ++ selectExtension file
 			, keyVariety = newvariety
 			}

Command/AddUrl.hs

@@ -171,7 +171,9 @@ downloadRemoteFile r relaxed uri file sz = checkCanAdd file $ do
 			-- so that the remote knows what url it
 			-- should use to download it.
 			setTempUrl urlkey loguri
-			let downloader = \dest p -> fst <$> Remote.retrieveKeyFile r urlkey (Just file) dest p
+			let downloader = \dest p -> fst 
+				<$> Remote.retrieveKeyFile r urlkey
+					(AssociatedFile (Just file)) dest p
 			ret <- downloadWith downloader urlkey (Remote.uuid r) loguri file
 			removeTempUrl urlkey
 			return ret
@@ -255,8 +257,8 @@ addUrlFileQuvi relaxed quviurl videourl file = checkCanAdd file $ do
 			checkDiskSpaceToGet sizedkey Nothing $ do
 				tmp <- fromRepo $ gitAnnexTmpObjectLocation key
 				showOutput
-				ok <- Transfer.notifyTransfer Transfer.Download (Just file) $
-					Transfer.download webUUID key (Just file) Transfer.forwardRetry $ \p -> do
+				ok <- Transfer.notifyTransfer Transfer.Download afile $
+					Transfer.download webUUID key afile Transfer.forwardRetry $ \p -> do
 						liftIO $ createDirectoryIfMissing True (parentDir tmp)
 						downloadUrl key p [videourl] tmp
 				if ok
@@ -265,6 +267,8 @@ addUrlFileQuvi relaxed quviurl videourl file = checkCanAdd file $ do
 						return (Just key)
 					else return Nothing
 		)
+  where
+	afile = AssociatedFile (Just file)
 
 addUrlChecked :: Bool -> URLString -> UUID -> (Key -> Annex (Bool, Bool)) -> Key -> CommandPerform
 addUrlChecked relaxed url u checkexistssize key
@@ -328,10 +332,11 @@ downloadWith downloader dummykey u url file =
 			, return Nothing
 			)
   where
-	runtransfer tmp =  Transfer.notifyTransfer Transfer.Download (Just file) $
-		Transfer.download u dummykey (Just file) Transfer.forwardRetry $ \p -> do
+	runtransfer tmp =  Transfer.notifyTransfer Transfer.Download afile $
+		Transfer.download u dummykey afile Transfer.forwardRetry $ \p -> do
 			liftIO $ createDirectoryIfMissing True (parentDir tmp)
 			downloader tmp p
+	afile = AssociatedFile (Just file)
 
 {- Adds the url size to the Key. -}
 addSizeUrlKey :: Url.UrlInfo -> Key -> Key

Command/Copy.hs

@@ -53,6 +53,6 @@ start o file key = stopUnless shouldCopy $
 		| otherwise = return True
 	want = case Command.Move.fromToOptions (moveOptions o) of
 		ToRemote dest -> (Remote.uuid <$> getParsed dest) >>=
-			wantSend False (Just key) (Just file)
+			wantSend False (Just key) (AssociatedFile (Just file))
 		FromRemote _ ->
-			wantGet False (Just key) (Just file)
+			wantGet False (Just key) (AssociatedFile (Just file))

Command/Drop.hs

@@ -65,7 +65,7 @@ seek o = allowConcurrentOutput $
 start :: DropOptions -> FilePath -> Key -> CommandStart
 start o file key = start' o key afile (mkActionItem afile)
   where
-	afile = Just file
+	afile = AssociatedFile (Just file)
 
 start' :: DropOptions -> Key -> AssociatedFile -> ActionItem -> CommandStart
 start' o key afile ai = do
@@ -85,7 +85,7 @@ start' o key afile ai = do
 			| otherwise = return True
 
 startKeys :: DropOptions -> Key -> ActionItem -> CommandStart
-startKeys o key = start' o key Nothing
+startKeys o key = start' o key (AssociatedFile Nothing)
 
 startLocal :: AssociatedFile -> ActionItem -> NumCopies -> Key -> [VerifiedCopy] -> CommandStart
 startLocal afile ai numcopies key preverified = stopUnless (inAnnex key) $ do
@@ -202,7 +202,8 @@ requiredContent = do
 {- In auto mode, only runs the action if there are enough
  - copies on other semitrusted repositories. -}
 checkDropAuto :: Bool -> Maybe Remote -> AssociatedFile -> Key -> (NumCopies -> CommandStart) -> CommandStart
-checkDropAuto automode mremote afile key a = go =<< maybe getNumCopies getFileNumCopies afile
+checkDropAuto automode mremote (AssociatedFile afile) key a =
+	go =<< maybe getNumCopies getFileNumCopies afile
   where
 	go numcopies
 		| automode = do

Command/DropUnused.hs

@@ -46,9 +46,9 @@ perform :: Maybe Remote -> NumCopies -> Key -> CommandPerform
 perform from numcopies key = case from of
 	Just r -> do
 		showAction $ "from " ++ Remote.name r
-		Command.Drop.performRemote key Nothing numcopies r
+		Command.Drop.performRemote key (AssociatedFile Nothing) numcopies r
 	Nothing -> ifM (inAnnex key)
-		( Command.Drop.performLocal key Nothing numcopies []
+		( Command.Drop.performLocal key (AssociatedFile Nothing) numcopies []
 		, next (return True)
 		)
 

Command/Fsck.hs

@@ -110,9 +110,10 @@ start from inc file key = do
 			numcopies <- getFileNumCopies file
 			case from of
 				Nothing -> go $ perform key file backend numcopies
-				Just r -> go $ performRemote key (Just file) backend numcopies r
+				Just r -> go $ performRemote key afile backend numcopies r
   where
-	go = runFsck inc (mkActionItem (Just file)) key
+	go = runFsck inc (mkActionItem afile) key
+	afile = AssociatedFile (Just file)
 
 perform :: Key -> FilePath -> Backend -> NumCopies -> Annex Bool
 perform key file backend numcopies = do
@@ -123,10 +124,12 @@ perform key file backend numcopies = do
 		, verifyLocationLog key keystatus file
 		, verifyAssociatedFiles key keystatus file
 		, verifyWorkTree key file
-		, checkKeySize key keystatus (Just file)
-		, checkBackend backend key keystatus (Just file)
-		, checkKeyNumCopies key (Just file) numcopies
+		, checkKeySize key keystatus afile
+		, checkBackend backend key keystatus afile
+		, checkKeyNumCopies key afile numcopies
 		]
+  where
+	afile = AssociatedFile (Just file)
 
 {- To fsck a remote, the content is retrieved to a tmp file,
  - and checked locally. -}
@@ -148,7 +151,7 @@ performRemote key afile backend numcopies remote =
 				return False
 	dispatch (Right False) = go False Nothing
 	go present localcopy = check
-		[ verifyLocationLogRemote key (maybe (key2file key) id afile) remote present
+		[ verifyLocationLogRemote key afile remote present
 		, withLocalCopy localcopy $ checkKeySizeRemote key remote afile
 		, withLocalCopy localcopy $ checkBackendRemote backend key remote afile
 		, checkKeyNumCopies key afile numcopies
@@ -167,7 +170,7 @@ performRemote key afile backend numcopies remote =
 			, ifM (Annex.getState Annex.fast)
 				( return Nothing
 				, Just . fst <$>
-					Remote.retrieveKeyFile remote key Nothing tmp dummymeter
+					Remote.retrieveKeyFile remote key (AssociatedFile Nothing) tmp dummymeter
 				)
 			)
 		, return (Just False)
@@ -181,16 +184,16 @@ startKey from inc key ai numcopies =
 		Just backend -> runFsck inc ai key $
 			case from of
 				Nothing -> performKey key backend numcopies
-				Just r -> performRemote key Nothing backend numcopies r
+				Just r -> performRemote key (AssociatedFile Nothing) backend numcopies r
 
 performKey :: Key -> Backend -> NumCopies -> Annex Bool
 performKey key backend numcopies = do
 	keystatus <- getKeyStatus key
 	check
 		[ verifyLocationLog key keystatus (key2file key)
-		, checkKeySize key keystatus Nothing
-		, checkBackend backend key keystatus Nothing
-		, checkKeyNumCopies key Nothing numcopies
+		, checkKeySize key keystatus (AssociatedFile Nothing)
+		, checkBackend backend key keystatus (AssociatedFile Nothing)
+		, checkKeyNumCopies key (AssociatedFile Nothing) numcopies
 		]
 
 check :: [Annex Bool] -> Annex Bool
@@ -249,10 +252,12 @@ verifyLocationLog key keystatus desc = do
 		then return True
 		else verifyLocationLog' key desc present u (logChange key u)
 
-verifyLocationLogRemote :: Key -> String -> Remote -> Bool -> Annex Bool
-verifyLocationLogRemote key desc remote present =
+verifyLocationLogRemote :: Key -> AssociatedFile -> Remote -> Bool -> Annex Bool
+verifyLocationLogRemote key (AssociatedFile afile) remote present =
 	verifyLocationLog' key desc present (Remote.uuid remote)
 		(Remote.logStatus remote key)
+  where
+	desc = fromMaybe (key2file key) afile
 
 verifyLocationLog' :: Key -> String -> Bool -> UUID -> (LogStatus -> Annex ()) -> Annex Bool
 verifyLocationLog' key desc present u updatestatus = do
@@ -356,7 +361,7 @@ checkKeySizeRemote key remote afile localcopy =
 	checkKeySizeOr (badContentRemote remote localcopy) key localcopy afile
 
 checkKeySizeOr :: (Key -> Annex String) -> Key -> FilePath -> AssociatedFile -> Annex Bool
-checkKeySizeOr bad key file afile = case keySize key of
+checkKeySizeOr bad key file (AssociatedFile afile) = case keySize key of
 	Nothing -> return True
 	Just size -> do
 		size' <- liftIO $ getFileSize file
@@ -396,7 +401,9 @@ checkBackend backend key keystatus afile = go =<< isDirect
 			( nocheck
 			, checkBackendOr badContent backend key content afile
 			)
-	go True = maybe nocheck checkdirect afile
+	go True = case afile of
+		AssociatedFile Nothing -> nocheck
+		AssociatedFile (Just f) -> checkdirect f
 	checkdirect file = ifM (Direct.goodContent key file)
 		( checkBackendOr' (badContentDirect file) backend key file afile
 			(Direct.goodContent key file)
@@ -416,7 +423,7 @@ checkBackendOr bad backend key file afile =
 -- in order to detect situations where the file is changed while being
 -- verified (particularly in direct mode).
 checkBackendOr' :: (Key -> Annex String) -> Backend -> Key -> FilePath -> AssociatedFile -> Annex Bool -> Annex Bool
-checkBackendOr' bad backend key file afile postcheck =
+checkBackendOr' bad backend key file (AssociatedFile afile) postcheck =
 	case Types.Backend.verifyKeyContent backend of
 		Nothing -> return True
 		Just verifier -> do
@@ -436,21 +443,23 @@ checkBackendOr' bad backend key file afile postcheck =
 
 checkKeyNumCopies :: Key -> AssociatedFile -> NumCopies -> Annex Bool
 checkKeyNumCopies key afile numcopies = do
-	let file = fromMaybe (key2file key) afile
+	let (desc, hasafile) = case afile of
+		AssociatedFile Nothing -> (key2file key, False)
+		AssociatedFile (Just af) -> (af, True)
 	locs <- loggedLocations key
 	(untrustedlocations, otherlocations) <- trustPartition UnTrusted locs
 	(deadlocations, safelocations) <- trustPartition DeadTrusted otherlocations
 	let present = NumCopies (length safelocations)
 	if present < numcopies
-		then ifM (pure (isNothing afile) <&&> checkDead key)
+		then ifM (pure (not hasafile) <&&> checkDead key)
 			( do
 				showLongNote $ "This key is dead, skipping."
 				return True
 			, do
 				untrusted <- Remote.prettyPrintUUIDs "untrusted" untrustedlocations
 				dead <- Remote.prettyPrintUUIDs "dead" deadlocations
-				warning $ missingNote file present numcopies untrusted dead
-				when (fromNumCopies present == 0 && isNothing afile) $
+				warning $ missingNote desc present numcopies untrusted dead
+				when (fromNumCopies present == 0 && not hasafile) $
 					showLongNote "(Avoid this check by running: git annex dead --key )"
 				return False
 			)

Command/Get.hs

@@ -51,14 +51,15 @@ seek o = allowConcurrentOutput $ do
 start :: GetOptions -> Maybe Remote -> FilePath -> Key -> CommandStart
 start o from file key = start' expensivecheck from key afile (mkActionItem afile)
   where
-	afile = Just file
+	afile = AssociatedFile (Just file)
 	expensivecheck
-		| autoMode o = numCopiesCheck file key (<) <||> wantGet False (Just key) (Just file)
+		| autoMode o = numCopiesCheck file key (<)
+			<||> wantGet False (Just key) afile
 		| otherwise = return True
 
 startKeys :: Maybe Remote -> Key -> ActionItem -> CommandStart
 startKeys from key ai = checkFailedTransferDirection ai Download $
-	start' (return True) from key Nothing ai
+	start' (return True) from key (AssociatedFile Nothing) ai
 
 start' :: Annex Bool -> Maybe Remote -> Key -> AssociatedFile -> ActionItem -> CommandStart
 start' expensivecheck from key afile ai = stopUnless (not <$> inAnnex key) $

Command/Info.hs

@@ -39,6 +39,7 @@ import Logs.Transfer
 import Types.Key
 import Types.TrustLevel
 import Types.FileMatcher
+import Types.ActionItem
 import qualified Limit
 import Messages.JSON (DualDisp(..), ObjectMap(..))
 import Annex.BloomFilter
@@ -420,7 +421,9 @@ transfer_list = stat desc $ nojson $ lift $ do
 	desc = "transfers in progress"
 	line uuidmap t i = unwords
 		[ formatDirection (transferDirection t) ++ "ing"
-		, fromMaybe (key2file $ transferKey t) (associatedFile i)
+		, actionItemDesc
+			(ActionItemAssociatedFile (associatedFile i))
+			(transferKey t)
 		, if transferDirection t == Upload then "to" else "from"
 		, maybe (fromUUID $ transferUUID t) Remote.name $
 			M.lookup (transferUUID t) uuidmap
@@ -428,9 +431,11 @@ transfer_list = stat desc $ nojson $ lift $ do
 	jsonify t i = object $ map (\(k, v) -> (T.pack k, v)) $
 		[ ("transfer", toJSON (formatDirection (transferDirection t)))
 		, ("key", toJSON (key2file (transferKey t)))
-		, ("file", toJSON (associatedFile i))
+		, ("file", toJSON afile)
 		, ("remote", toJSON (fromUUID (transferUUID t)))
 		]
+	  where
+		AssociatedFile afile = associatedFile i
 
 disk_size :: Stat
 disk_size = simpleStat "available local disk space" $

Command/MetaData.hs

@@ -86,7 +86,7 @@ seek o = case batchOption o of
 start :: POSIXTime -> MetaDataOptions -> FilePath -> Key -> CommandStart
 start now o file k = startKeys now o k (mkActionItem afile)
   where
-	afile = Just file
+	afile = AssociatedFile (Just file)
 
 startKeys :: POSIXTime -> MetaDataOptions -> Key -> ActionItem -> CommandStart
 startKeys now o k ai = case getSet o of
@@ -155,7 +155,7 @@ startBatch (i, (MetaData m)) = case i of
 	Left f -> do
 		mk <- lookupFile f
 		case mk of
-			Just k -> go k (mkActionItem (Just f))
+			Just k -> go k (mkActionItem (AssociatedFile (Just f)))
 			Nothing -> giveup $ "not an annexed file: " ++ f
 	Right k -> go k (mkActionItem k)
   where

Command/Migrate.hs

@@ -73,7 +73,7 @@ perform file oldkey oldbackend newbackend = go =<< genkey
 	go (Just (newkey, knowngoodcontent))
 		| knowngoodcontent = finish newkey
 		| otherwise = stopUnless checkcontent $ finish newkey
-	checkcontent = Command.Fsck.checkBackend oldbackend oldkey Command.Fsck.KeyLocked $ Just file
+	checkcontent = Command.Fsck.checkBackend oldbackend oldkey Command.Fsck.KeyLocked afile
 	finish newkey = ifM (Command.ReKey.linkKey file oldkey newkey)
 		( do
 			copyMetaData oldkey newkey
@@ -86,7 +86,7 @@ perform file oldkey oldbackend newbackend = go =<< genkey
 			next $ Command.ReKey.cleanup file oldkey newkey
 		, error "failed"
 		)
-	genkey = case maybe Nothing (\fm -> fm oldkey newbackend (Just file)) (fastMigrate oldbackend) of
+	genkey = case maybe Nothing (\fm -> fm oldkey newbackend afile) (fastMigrate oldbackend) of
 		Just newkey -> return $ Just (newkey, True)
 		Nothing -> do
 			content <- calcRepo $ gitAnnexLocation oldkey
@@ -99,3 +99,4 @@ perform file oldkey oldbackend newbackend = go =<< genkey
 			return $ case v of
 				Just (newkey, _) -> Just (newkey, False)
 				_ -> Nothing
+	afile = AssociatedFile (Just file)

Command/Mirror.hs

@@ -43,16 +43,16 @@ instance DeferredParseClass MirrorOptions where
 seek :: MirrorOptions -> CommandSeek
 seek o = allowConcurrentOutput $ 
 	withKeyOptions (keyOptions o) False
-		(startKey o Nothing)
+		(startKey o (AssociatedFile Nothing))
 		(withFilesInGit $ whenAnnexed $ start o)
 		(mirrorFiles o)
 
 start :: MirrorOptions -> FilePath -> Key -> CommandStart
 start o file k = startKey o afile k (mkActionItem afile)
   where
-	afile = Just file
+	afile = AssociatedFile (Just file)
 
-startKey :: MirrorOptions -> Maybe FilePath -> Key -> ActionItem -> CommandStart
+startKey :: MirrorOptions -> AssociatedFile -> Key -> ActionItem -> CommandStart
 startKey o afile key ai = case fromToOptions o of
 	ToRemote r -> checkFailedTransferDirection ai Upload $ ifM (inAnnex key)
 		( Command.Move.toStart False afile key ai =<< getParsed r
@@ -72,4 +72,6 @@ startKey o afile key ai = case fromToOptions o of
 				, stop
 				)
   where
-	getnumcopies = maybe getNumCopies getFileNumCopies afile
+	getnumcopies = case afile of
+		AssociatedFile Nothing -> getNumCopies
+		AssociatedFile (Just af) -> getFileNumCopies af

Command/Move.hs

@@ -53,10 +53,10 @@ seek o = allowConcurrentOutput $
 start :: MoveOptions -> Bool -> FilePath -> Key -> CommandStart
 start o move f k = start' o move afile k (mkActionItem afile)
   where
-	afile = Just f
+	afile = AssociatedFile (Just f)
 
 startKey :: MoveOptions -> Bool -> Key -> ActionItem -> CommandStart
-startKey o move = start' o move Nothing
+startKey o move = start' o move (AssociatedFile Nothing)
 
 start' :: MoveOptions -> Bool -> AssociatedFile -> Key -> ActionItem -> CommandStart
 start' o move afile key ai = 

Command/SendKey.hs

@@ -46,7 +46,7 @@ start key = do
 fieldTransfer :: Direction -> Key -> (MeterUpdate -> Annex Bool) -> CommandStart
 fieldTransfer direction key a = do
 	liftIO $ debugM "fieldTransfer" "transfer start"
-	afile <- Fields.getField Fields.associatedFile
+	afile <- AssociatedFile <$> Fields.getField Fields.associatedFile
 	ok <- maybe (a $ const noop)
 		-- Using noRetry here because we're the sender.
 		(\u -> runner (Transfer direction (toUUID u) key) afile noRetry a)

Command/Sync.hs

@@ -519,8 +519,8 @@ seekSyncContent o rs = do
 	liftIO $ not <$> isEmptyMVar mvar
   where
 	seekworktree mvar l bloomfeeder = seekHelper LsFiles.inRepo l >>=
-		mapM_ (\f -> ifAnnexed f (go (Right bloomfeeder) mvar (Just f)) noop)
-	seekkeys mvar bloom k _ = go (Left bloom) mvar Nothing k
+		mapM_ (\f -> ifAnnexed f (go (Right bloomfeeder) mvar (AssociatedFile (Just f))) noop)
+	seekkeys mvar bloom k _ = go (Left bloom) mvar (AssociatedFile Nothing) k
 	go ebloom mvar af k = commandAction $ do
 		whenM (syncFile ebloom rs af k) $
 			void $ liftIO $ tryPutMVar mvar ()

Command/TestRemote.hs

@@ -155,8 +155,9 @@ test st r k =
 			Nothing -> return True
 			Just verifier -> verifier k (key2file k)
 	get = getViaTmp (RemoteVerify r) k $ \dest ->
-		Remote.retrieveKeyFile r k Nothing dest nullMeterUpdate
-	store = Remote.storeKey r k Nothing nullMeterUpdate
+		Remote.retrieveKeyFile r k (AssociatedFile Nothing)
+			dest nullMeterUpdate
+	store = Remote.storeKey r k (AssociatedFile Nothing) nullMeterUpdate
 	remove = Remote.removeKey r k
 
 testUnavailable :: Annex.AnnexState -> Remote -> Key -> [TestTree]
@@ -164,15 +165,15 @@ testUnavailable st r k =
 	[ check (== Right False) "removeKey" $
 		Remote.removeKey r k
 	, check (== Right False) "storeKey" $
-		Remote.storeKey r k Nothing nullMeterUpdate
+		Remote.storeKey r k (AssociatedFile Nothing) nullMeterUpdate
 	, check (`notElem` [Right True, Right False]) "checkPresent" $
 		Remote.checkPresent r k
 	, check (== Right False) "retrieveKeyFile" $
 		getViaTmp (RemoteVerify r) k $ \dest ->
-			Remote.retrieveKeyFile r k Nothing dest nullMeterUpdate
+			Remote.retrieveKeyFile r k (AssociatedFile Nothing) dest nullMeterUpdate
 	, check (== Right False) "retrieveKeyFileCheap" $
 		getViaTmp (RemoteVerify r) k $ \dest -> unVerified $
-			Remote.retrieveKeyFileCheap r k Nothing dest
+			Remote.retrieveKeyFileCheap r k (AssociatedFile Nothing) dest
 	]
   where
 	check checkval desc a = testCase desc $ do

Command/TransferInfo.hs

@@ -41,7 +41,7 @@ start (k:[]) = do
 	case file2key k of
 		Nothing -> error "bad key"
 		(Just key) -> whenM (inAnnex key) $ do
-			file <- Fields.getField Fields.associatedFile
+			afile <- AssociatedFile <$> Fields.getField Fields.associatedFile
 			u <- maybe (error "missing remoteuuid") toUUID
 				<$> Fields.getField Fields.remoteUUID
 			let t = Transfer
@@ -49,7 +49,7 @@ start (k:[]) = do
 				, transferUUID = u
 				, transferKey = key
 				}
-			tinfo <- liftIO $ startTransferInfo file
+			tinfo <- liftIO $ startTransferInfo afile
 			(update, tfile, _) <- mkProgressUpdater t tinfo
 			liftIO $ mapM_ void
 				[ tryIO $ forever $ do

Command/TransferKey.hs

@@ -30,10 +30,10 @@ optParser :: CmdParamsDesc -> Parser TransferKeyOptions
 optParser desc  = TransferKeyOptions
 	<$> cmdParams desc
 	<*> parseFromToOptions
-	<*> optional (strOption
+	<*> (AssociatedFile <$> optional (strOption
 		( long "file" <> metavar paramFile
 		<> help "the associated file"
-		))
+		)))
 
 instance DeferredParseClass TransferKeyOptions where
 	finishParse v = TransferKeyOptions

Command/TransferKeys.hs

@@ -116,10 +116,10 @@ instance TCSerialized Direction where
 	deserialize _ = Nothing
 
 instance TCSerialized AssociatedFile where
-	serialize (Just f) = f
-	serialize Nothing = ""
-	deserialize "" = Just Nothing
-	deserialize f = Just $ Just f
+	serialize (AssociatedFile (Just f)) = f
+	serialize (AssociatedFile Nothing) = ""
+	deserialize "" = Just (AssociatedFile Nothing)
+	deserialize f = Just (AssociatedFile (Just f))
 
 instance TCSerialized RemoteName where
 	serialize n = n

Command/Whereis.hs

@@ -49,7 +49,7 @@ seek o = do
 start :: M.Map UUID Remote -> FilePath -> Key -> CommandStart
 start remotemap file key = startKeys remotemap key (mkActionItem afile)
   where
-	afile = Just file
+	afile = AssociatedFile (Just file)
 
 startKeys :: M.Map UUID Remote -> Key -> ActionItem -> CommandStart
 startKeys remotemap key ai = do

Key.hs

@@ -9,7 +9,7 @@
 
 module Key (
 	Key(..),
-	AssociatedFile,
+	AssociatedFile(..),
 	stubKey,
 	key2file,
 	file2key,

Limit/Wanted.hs

@@ -13,12 +13,14 @@ import Limit
 import Types.FileMatcher
 
 addWantGet :: Annex ()
-addWantGet = addLimit $ Right $ const $ checkWant $ wantGet False Nothing
+addWantGet = addLimit $ Right $ const $ checkWant $
+	wantGet False Nothing
 
 addWantDrop :: Annex ()
-addWantDrop = addLimit $ Right $ const $ checkWant $ wantDrop False Nothing Nothing
+addWantDrop = addLimit $ Right $ const $ checkWant $
+	wantDrop False Nothing Nothing
 
-checkWant :: (Maybe FilePath -> Annex Bool) -> MatchInfo -> Annex Bool
-checkWant a (MatchingFile fi) = a (Just $ matchFile fi)
+checkWant :: (AssociatedFile -> Annex Bool) -> MatchInfo -> Annex Bool
+checkWant a (MatchingFile fi) = a (AssociatedFile (Just $ matchFile fi))
 checkWant _ (MatchingKey _) = return False
 checkWant _ (MatchingInfo {}) = return False

Logs/Transfer.hs

@@ -10,6 +10,7 @@
 module Logs.Transfer where
 
 import Types.Transfer
+import Types.ActionItem
 import Annex.Common
 import Annex.Perms
 import qualified Git
@@ -27,7 +28,9 @@ describeTransfer :: Transfer -> TransferInfo -> String
 describeTransfer t info = unwords
 	[ show $ transferDirection t
 	, show $ transferUUID t
-	, fromMaybe (key2file $ transferKey t) (associatedFile info)
+	, actionItemDesc
+		(ActionItemAssociatedFile (associatedFile info))
+		(transferKey t)
 	, show $ bytesComplete info
 	]
 
@@ -67,8 +70,8 @@ mkProgressUpdater t info = do
 		Just sz -> sz `div` 100
 		Nothing -> 100 * 1024 -- arbitrarily, 100 kb
 
-startTransferInfo :: Maybe FilePath -> IO TransferInfo
-startTransferInfo file = TransferInfo
+startTransferInfo :: AssociatedFile -> IO TransferInfo
+startTransferInfo afile = TransferInfo
 	<$> (Just . utcTimeToPOSIXSeconds <$> getCurrentTime)
 #ifndef mingw32_HOST_OS
 	<*> pure Nothing -- pid not stored in file, so omitted for speed
@@ -78,7 +81,7 @@ startTransferInfo file = TransferInfo
 	<*> pure Nothing -- tid ditto
 	<*> pure Nothing -- not 0; transfer may be resuming
 	<*> pure Nothing
-	<*> pure file
+	<*> pure afile
 	<*> pure False
 
 {- If a transfer is still running, returns its TransferInfo.
@@ -228,7 +231,9 @@ writeTransferInfo info = unlines
 #ifdef mingw32_HOST_OS
 	, maybe "" show (transferPid info)
 #endif
-	, fromMaybe "" $ associatedFile info -- comes last; arbitrary content
+	-- comes last; arbitrary content
+	, let AssociatedFile afile = associatedFile info
+	  in fromMaybe "" afile
 	]
 
 readTransferInfoFile :: Maybe PID -> FilePath -> IO (Maybe TransferInfo)
@@ -246,7 +251,7 @@ readTransferInfo mpid s = TransferInfo
 	<*> pure Nothing
 	<*> pure Nothing
 	<*> bytes
-	<*> pure (if null filename then Nothing else Just filename)
+	<*> pure (AssociatedFile (if null filename then Nothing else Just filename))
 	<*> pure False
   where
 #ifdef mingw32_HOST_OS

P2P/Protocol.hs

@@ -136,8 +136,9 @@ instance Proto.Serializable Service where
 -- These mungings are ok, because an AssociatedFile is only ever displayed
 -- to the user and does not need to match a file on disk.
 instance Proto.Serializable AssociatedFile where
-	serialize Nothing = ""
-	serialize (Just af) = toInternalGitPath $ concatMap esc af
+	serialize (AssociatedFile Nothing) = ""
+	serialize (AssociatedFile (Just af)) = 
+		toInternalGitPath $ concatMap esc af
 	  where
 		esc '%' = "%%"
 		esc c 
@@ -145,9 +146,9 @@ instance Proto.Serializable AssociatedFile where
 			| otherwise = [c]
 	
 	deserialize s = case fromInternalGitPath $ deesc [] s of
-		[] -> Just Nothing
+		[] -> Just (AssociatedFile Nothing)
 		f
-			| isRelative f -> Just (Just f)
+			| isRelative f -> Just (AssociatedFile (Just f))
 			| otherwise -> Nothing
 	  where
 	  	deesc b [] = reverse b

Remote/GCrypt.hs

@@ -326,7 +326,8 @@ store r rsyncopts
 			return True
 	| Git.repoIsSsh (repo r) = if accessShell r
 		then fileStorer $ \k f p -> Ssh.rsyncHelper (Just p)
-			=<< Ssh.rsyncParamsRemote False r Upload k f Nothing
+			=<< Ssh.rsyncParamsRemote False r Upload k f
+				(AssociatedFile Nothing)
 		else fileStorer $ Remote.Rsync.store rsyncopts
 	| otherwise = unsupportedUrl
 
@@ -336,8 +337,10 @@ retrieve r rsyncopts
 		guardUsable (repo r) (return False) $
 			sink =<< liftIO (L.readFile $ gCryptLocation r k)
 	| Git.repoIsSsh (repo r) = if accessShell r
-		then fileRetriever $ \f k p ->
-			unlessM (Ssh.rsyncHelper (Just p) =<< Ssh.rsyncParamsRemote False r Download k f Nothing) $
+		then fileRetriever $ \f k p -> do
+			ps <- Ssh.rsyncParamsRemote False r Download k f
+				(AssociatedFile Nothing)
+			unlessM (Ssh.rsyncHelper (Just p) ps) $
 				giveup "rsync failed"
 		else fileRetriever $ Remote.Rsync.retrieve rsyncopts
 	| otherwise = unsupportedUrl

Remote/Git.hs

@@ -479,8 +479,9 @@ copyFromRemote' r key file dest meterupdate
 		)
 	feedprogressback' a = do
 		u <- getUUID
+		let AssociatedFile afile = file
 		let fields = (Fields.remoteUUID, fromUUID u)
-			: maybe [] (\f -> [(Fields.associatedFile, f)]) file
+			: maybe [] (\f -> [(Fields.associatedFile, f)]) afile
 		Just (cmd, params) <- Ssh.git_annex_shell ConsumeStdin
 			(repo r) "transferinfo" 
 			[Param $ key2file key] fields

Remote/Helper/Ssh.hs

@@ -126,7 +126,7 @@ rsyncHelper m params = do
 {- Generates rsync parameters that ssh to the remote and asks it
  - to either receive or send the key's content. -}
 rsyncParamsRemote :: Bool -> Remote -> Direction -> Key -> FilePath -> AssociatedFile -> Annex [CommandParam]
-rsyncParamsRemote unlocked r direction key file afile = do
+rsyncParamsRemote unlocked r direction key file (AssociatedFile afile) = do
 	u <- getUUID
 	let fields = (Fields.remoteUUID, fromUUID u)
 		: (Fields.unlocked, if unlocked then "1" else "")

Types.hs

@@ -9,7 +9,7 @@ module Types (
 	Annex,
 	Backend,
 	Key,
-	AssociatedFile,
+	AssociatedFile(..),
 	UUID(..),
 	GitConfig(..),
 	RemoteGitConfig(..),

Types/ActionItem.hs

@@ -13,8 +13,6 @@ import Key
 import Types.Transfer
 import Git.FilePath
 
-import Data.Maybe
-
 data ActionItem 
 	= ActionItemAssociatedFile AssociatedFile
 	| ActionItemKey
@@ -37,15 +35,15 @@ instance MkActionItem (Transfer, TransferInfo) where
 	mkActionItem = uncurry ActionItemFailedTransfer
 
 actionItemDesc :: ActionItem -> Key -> String
-actionItemDesc (ActionItemAssociatedFile (Just f)) _ = f
-actionItemDesc (ActionItemAssociatedFile Nothing) k = key2file k
+actionItemDesc (ActionItemAssociatedFile (AssociatedFile (Just f))) _ = f
+actionItemDesc (ActionItemAssociatedFile (AssociatedFile Nothing)) k = key2file k
 actionItemDesc ActionItemKey k = key2file k
 actionItemDesc (ActionItemBranchFilePath bfp) _ = descBranchFilePath bfp
-actionItemDesc (ActionItemFailedTransfer _ i) k = 
-	fromMaybe (key2file k) (associatedFile i)
+actionItemDesc (ActionItemFailedTransfer _ i) k =
+	actionItemDesc (ActionItemAssociatedFile (associatedFile i)) k
 
 actionItemWorkTreeFile :: ActionItem -> Maybe FilePath
-actionItemWorkTreeFile (ActionItemAssociatedFile af) = af
+actionItemWorkTreeFile (ActionItemAssociatedFile (AssociatedFile af)) = af
 actionItemWorkTreeFile _ = Nothing
 
 actionItemTransferDirection :: ActionItem -> Maybe Direction

Types/Key.hs

@@ -23,7 +23,8 @@ data Key = Key
 	} deriving (Eq, Ord, Read, Show)
 
 {- A filename may be associated with a Key. -}
-type AssociatedFile = Maybe FilePath
+newtype AssociatedFile = AssociatedFile (Maybe FilePath)
+	deriving (Show, Eq, Ord)
 
 {- There are several different varieties of keys. -}
 data KeyVariety

Types/Transfer.hs

@@ -36,13 +36,13 @@ data TransferInfo = TransferInfo
 	, transferTid :: Maybe ThreadId
 	, transferRemote :: Maybe Remote
 	, bytesComplete :: Maybe Integer
-	, associatedFile :: Maybe FilePath
+	, associatedFile :: AssociatedFile
 	, transferPaused :: Bool
 	}
 	deriving (Show, Eq, Ord)
 
 stubTransferInfo :: TransferInfo
-stubTransferInfo = TransferInfo Nothing Nothing Nothing Nothing Nothing Nothing False
+stubTransferInfo = TransferInfo Nothing Nothing Nothing Nothing Nothing (AssociatedFile Nothing) False
 
 data Direction = Upload | Download
 	deriving (Eq, Ord, Show, Read)
@@ -64,5 +64,5 @@ instance Arbitrary TransferInfo where
 		<*> pure Nothing -- remote not needed
 		<*> arbitrary
 		-- associated file cannot be empty (but can be Nothing)
-		<*> arbitrary `suchThat` (/= Just "")
+		<*> (AssociatedFile <$> arbitrary `suchThat` (/= Just ""))
 		<*> arbitrary

templates/dashboard/transfers.hamlet

@@ -6,10 +6,7 @@
         <div .row>
           <div .col-sm-10>
             <h3 .forcewrap .small-margin-top .tiny-margin-bottom>
-              $maybe file <- associatedFile info
-                #{file}
-              $nothing
-                #{key2file $ transferKey transfer}
+              #{desc transfer info}
               $case transferDirection transfer
                 $of Upload
                   &rarr;