1 files changed, 26 insertions, 34 deletions

diff --git a/Logs/Web.hs b/Logs/Web.hs
index cbce7a36e..ede600ec2 100644
--- a/Logs/Web.hs
+++ b/Logs/Web.hs
@@ -11,17 +11,19 @@ module Logs.Web (
 	getUrls,
 	setUrlPresent,
 	setUrlMissing,
-	urlLog,
-	urlLogKey,
-	knownUrls
+	knownUrls,
+	Downloader(..),
+	getDownloader,
+	setDownloader,
 ) where
 
 import qualified Data.ByteString.Lazy.Char8 as L
+import Data.Tuple.Utils
 
 import Common.Annex
+import Logs
 import Logs.Presence
 import Logs.Location
-import Types.Key
 import qualified Annex.Branch
 import Annex.CatFile
 import qualified Git
@@ -33,35 +35,9 @@ type URLString = String
 webUUID :: UUID
 webUUID = UUID "00000000-0000-0000-0000-000000000001"
 
-urlLogExt :: String
-urlLogExt = ".log.web"
-
-urlLog :: Key -> FilePath
-urlLog key = hashDirLower key </> keyFile key ++ urlLogExt
-
-{- Converts a url log file into a key.
- - (Does not work on oldurlLogs.) -}
-urlLogKey :: FilePath -> Maybe Key
-urlLogKey file
-	| ext == urlLogExt = fileKey base
-	| otherwise = Nothing
-  where
-  	(base, ext) = splitAt (length file - extlen) file
-	extlen = length urlLogExt
-
-isUrlLog :: FilePath -> Bool
-isUrlLog file = urlLogExt `isSuffixOf` file
-
-{- Used to store the urls elsewhere. -}
-oldurlLogs :: Key -> [FilePath]
-oldurlLogs key = 
-	[ "remote/web" </> hashDirLower key </> key2file key ++ ".log"
-	, "remote/web" </> hashDirLower key </> keyFile key ++ ".log"
-	]
-
 {- Gets all urls that a key might be available from. -}
 getUrls :: Key -> Annex [URLString]
-getUrls key = go $ urlLog key : oldurlLogs key
+getUrls key = go $ urlLogFile key : oldurlLogs key
   where
 	go [] = return []
 	go (l:ls) = do
@@ -74,13 +50,13 @@ setUrlPresent :: Key -> URLString -> Annex ()
 setUrlPresent key url = do
 	us <- getUrls key
 	unless (url `elem` us) $ do
-		addLog (urlLog key) =<< logNow InfoPresent url
+		addLog (urlLogFile key) =<< logNow InfoPresent url
 		-- update location log to indicate that the web has the key
 		logChange key webUUID InfoPresent
 
 setUrlMissing :: Key -> URLString -> Annex ()
 setUrlMissing key url = do
-	addLog (urlLog key) =<< logNow InfoMissing url
+	addLog (urlLogFile key) =<< logNow InfoMissing url
 	whenM (null <$> getUrls key) $
 		logChange key webUUID InfoMissing
 
@@ -95,9 +71,25 @@ knownUrls = do
 	Annex.Branch.withIndex $ do
 		top <- fromRepo Git.repoPath
 		(l, cleanup) <- inRepo $ Git.LsFiles.stagedDetails [top]
-		r <- mapM (geturls . snd) $ filter (isUrlLog . fst) l
+		r <- mapM (geturls . snd3) $ filter (isUrlLog . fst3) l
 		void $ liftIO cleanup
 		return $ concat r
   where
 	geturls Nothing = return []
   	geturls (Just logsha) = getLog . L.unpack <$> catObject logsha
+
+data Downloader = DefaultDownloader | QuviDownloader
+
+{- Determines the downloader for an URL.
+ -
+ - Some URLs are not downloaded by normal means, and this is indicated
+ - by prefixing them with downloader: when they are recorded in the url
+ - logs. -}
+getDownloader :: URLString -> (URLString, Downloader)
+getDownloader u = case separate (== ':') u of
+	("quvi", u') -> (u', QuviDownloader)
+	_ -> (u, DefaultDownloader)
+
+setDownloader :: URLString -> Downloader -> URLString
+setDownloader u DefaultDownloader = u
+setDownloader u QuviDownloader = "quvi:" ++ u