addurl, importfeed: Fix failure when annex.securehashesonly is set

The temporary URL key used for the download, before the real key is
generated, was blocked by annex.securehashesonly.

Fixed by passing the Backend that will be used for the final key into
runTransfer. When a Backend is provided, have preCheckSecureHashes
check that, rather than the key being transferred.

Sponsored-by: unqueued on Patreon

Command/AddUrl.hs

@@ -323,28 +323,28 @@ addUrlFile addunlockedmatcher o url urlinfo file =
 
 downloadWeb :: AddUnlockedMatcher -> DownloadOptions -> URLString -> Url.UrlInfo -> RawFilePath -> Annex (Maybe Key)
 downloadWeb addunlockedmatcher o url urlinfo file =
-	go =<< downloadWith' downloader urlkey webUUID url (AssociatedFile (Just file))
+	go =<< downloadWith' downloader urlkey webUUID url file
   where
 	urlkey = addSizeUrlKey urlinfo $ Backend.URL.fromUrl url Nothing
 	downloader f p = Url.withUrlOptions $ downloadUrl False urlkey p Nothing [url] f
 	go Nothing = return Nothing
-	go (Just tmp) = ifM (pure (not (rawOption o)) <&&> liftIO (isHtmlFile (fromRawFilePath tmp)))
-		( tryyoutubedl tmp
-		, normalfinish tmp
+	go (Just (tmp, backend)) = ifM (pure (not (rawOption o)) <&&> liftIO (isHtmlFile (fromRawFilePath tmp)))
+		( tryyoutubedl tmp backend
+		, normalfinish tmp backend
 		)
-	normalfinish tmp = checkCanAdd o file $ \canadd -> do
+	normalfinish tmp backend = checkCanAdd o file $ \canadd -> do
 		showDestinationFile (fromRawFilePath file)
 		createWorkTreeDirectory (parentDir file)
-		Just <$> finishDownloadWith canadd addunlockedmatcher tmp webUUID url file
+		Just <$> finishDownloadWith canadd addunlockedmatcher tmp backend webUUID url file
 	-- Ask youtube-dl what filename it will download first, 
 	-- so it's only used when the file contains embedded media.
-	tryyoutubedl tmp = youtubeDlFileNameHtmlOnly url >>= \case
+	tryyoutubedl tmp backend = youtubeDlFileNameHtmlOnly url >>= \case
 		Right mediafile -> 
 			let f = youtubeDlDestFile o file (toRawFilePath mediafile)
 			in lookupKey f >>= \case
 				Just k -> alreadyannexed (fromRawFilePath f) k
 				Nothing -> dl f
-		Left err -> checkRaw (Just err) o Nothing (normalfinish tmp)
+		Left err -> checkRaw (Just err) o Nothing (normalfinish tmp backend)
 	  where
 		dl dest = withTmpWorkDir mediakey $ \workdir -> do
 			let cleanuptmp = pruneTmpWorkDirBefore tmp (liftIO . removeWhenExistsWith R.removeLink)
@@ -358,7 +358,7 @@ downloadWeb addunlockedmatcher o url urlinfo file =
 								showDestinationFile (fromRawFilePath dest)
 								addWorkTree canadd addunlockedmatcher webUUID mediaurl dest mediakey (Just (toRawFilePath mediafile))
 								return $ Just mediakey
-						Right Nothing -> checkRaw Nothing o Nothing (normalfinish tmp)
+						Right Nothing -> checkRaw Nothing o Nothing (normalfinish tmp backend)
 						Left msg -> do
 							cleanuptmp
 							warning msg
@@ -421,29 +421,31 @@ showDestinationFile file = do
  -}
 downloadWith :: CanAddFile -> AddUnlockedMatcher -> (FilePath -> MeterUpdate -> Annex Bool) -> Key -> UUID -> URLString -> RawFilePath -> Annex (Maybe Key)
 downloadWith canadd addunlockedmatcher downloader dummykey u url file =
-	go =<< downloadWith' downloader dummykey u url afile
+	go =<< downloadWith' downloader dummykey u url file
   where
-	afile = AssociatedFile (Just file)
 	go Nothing = return Nothing
-	go (Just tmp) = Just <$> finishDownloadWith canadd addunlockedmatcher tmp u url file
+	go (Just (tmp, backend)) = Just <$> finishDownloadWith canadd addunlockedmatcher tmp backend u url file
 
 {- Like downloadWith, but leaves the dummy key content in
  - the returned location. -}
-downloadWith' :: (FilePath -> MeterUpdate -> Annex Bool) -> Key -> UUID -> URLString -> AssociatedFile -> Annex (Maybe RawFilePath)
-downloadWith' downloader dummykey u url afile =
+downloadWith' :: (FilePath -> MeterUpdate -> Annex Bool) -> Key -> UUID -> URLString -> RawFilePath -> Annex (Maybe (RawFilePath, Backend))
+downloadWith' downloader dummykey u url file =
 	checkDiskSpaceToGet dummykey Nothing $ do
+		backend <- chooseBackend file
 		tmp <- fromRepo $ gitAnnexTmpObjectLocation dummykey
-		ok <- Transfer.notifyTransfer Transfer.Download url $
-			Transfer.download' u dummykey afile Nothing Transfer.stdRetry $ \p -> do
+		let t = (Transfer.Transfer Transfer.Download u (fromKey id dummykey))
+		ok <- Transfer.notifyTransfer Transfer.Download url $ \_w ->
+			Transfer.runTransfer t (Just backend) afile Nothing Transfer.stdRetry $ \p -> do
 				createAnnexDirectory (parentDir tmp)
 				downloader (fromRawFilePath tmp) p
 		if ok
-			then return (Just tmp)
+			then return (Just (tmp, backend))
 			else return Nothing
+  where
+	afile = AssociatedFile (Just file)
 
-finishDownloadWith :: CanAddFile -> AddUnlockedMatcher -> RawFilePath -> UUID -> URLString -> RawFilePath -> Annex Key
-finishDownloadWith canadd addunlockedmatcher tmp u url file = do
-	backend <- chooseBackend file
+finishDownloadWith :: CanAddFile -> AddUnlockedMatcher -> RawFilePath -> Backend -> UUID -> URLString -> RawFilePath -> Annex Key
+finishDownloadWith canadd addunlockedmatcher tmp backend u url file = do
 	let source = KeySource
 		{ keyFilename = file
 		, contentLocation = tmp

Command/CalcKey.hs

@@ -8,7 +8,7 @@
 module Command.CalcKey where
 
 import Command
-import Backend (genKey)
+import Backend (genKey, defaultBackend)
 import Types.KeySource
 import Utility.Metered
 
@@ -21,7 +21,7 @@ cmd = noCommit $ noMessages $ dontCheck repoExists $
 			(batchable run (pure ()))
 
 run :: () -> SeekInput -> String -> Annex Bool
-run _ _ file = tryNonAsync (genKey ks nullMeterUpdate Nothing) >>= \case
+run _ _ file = tryNonAsync (genKey ks nullMeterUpdate =<< defaultBackend) >>= \case
 	Right (k, _) -> do
 		liftIO $ putStrLn $ serializeKey k
 		return True

Command/Migrate.hs

@@ -56,8 +56,7 @@ start o si file key = do
 		Nothing -> stop
 		Just oldbackend -> do
 			exists <- inAnnex key
-			newbackend <- maybe defaultBackend return 
-				=<< chooseBackend file
+			newbackend <- chooseBackend file
 			if (newbackend /= oldbackend || upgradableKey oldbackend key || forced) && exists
 				then go False oldbackend newbackend
 				else if removeSize o && exists
@@ -116,7 +115,7 @@ perform onlyremovesize o file oldkey oldbackend newbackend = go =<< genkey (fast
 			, contentLocation = content
 			, inodeCache = Nothing
 			}
-		newkey <- fst <$> genKey source nullMeterUpdate (Just newbackend)
+		newkey <- fst <$> genKey source nullMeterUpdate newbackend
 		return $ Just (newkey, False)
 	genkey (Just fm) = fm oldkey newbackend afile >>= \case
 		Just newkey -> return (Just (newkey, True))

Command/Reinject.hs

@@ -63,7 +63,7 @@ startSrcDest _ = giveup "specify a src file and a dest file"
 startKnown :: FilePath -> CommandStart
 startKnown src = notAnnexed src' $
 	starting "reinject" ai si $ do
-		(key, _) <- genKey ks nullMeterUpdate Nothing
+		(key, _) <- genKey ks nullMeterUpdate =<< defaultBackend
 		ifM (isKnownKey key)
 			( perform src' key
 			, do

Command/SendKey.hs

@@ -49,7 +49,7 @@ fieldTransfer direction key a = do
 	let afile = AssociatedFile Nothing
 	ok <- maybe (a $ const noop)
 		-- Using noRetry here because we're the sender.
-		(\u -> runner (Transfer direction (toUUID u) (fromKey id key)) afile Nothing noRetry a)
+		(\u -> runner (Transfer direction (toUUID u) (fromKey id key)) Nothing afile Nothing noRetry a)
 		=<< Fields.getField Fields.remoteUUID
 	fastDebug "Command.SendKey" "transfer done"
 	liftIO $ exitBool ok