1{- Web url logs.
2 -
3 - Copyright 2011-2021 Joey Hess <id@joeyh.name>
4 -
5 - Licensed under the GNU AGPL version 3 or higher.
6 -}
7
8{-# LANGUAGE BangPatterns #-}
9
10module Logs.Web (
11	URLString,
12	getUrls,
13	getUrlsWithPrefix,
14	setUrlPresent,
15	setUrlMissing,
16	Downloader(..),
17	getDownloader,
18	setDownloader,
19	setDownloader',
20	setTempUrl,
21	removeTempUrl,
22	parseUrlLog,
23) where
24
25import qualified Data.Map as M
26import qualified Data.ByteString.Lazy as L
27
28import Annex.Common
29import qualified Annex
30import Logs
31import Logs.Presence
32import Logs.Location
33import Utility.Url
34import Annex.UUID
35import qualified Annex.Branch
36import qualified Types.Remote as Remote
37
38{- Gets all urls that a key might be available from. -}
39getUrls :: Key -> Annex [URLString]
40getUrls key = do
41	config <- Annex.getGitConfig
42	l <- go $ urlLogFile config key : oldurlLogs config key
43	tmpl <- Annex.getState (maybeToList . M.lookup key . Annex.tempurls)
44	return (tmpl ++ l)
45  where
46	go [] = return []
47	go (l:ls) = do
48		us <- currentLogInfo l
49		if null us
50			then go ls
51			else return $ map decodeUrlLogInfo us
52
53getUrlsWithPrefix :: Key -> String -> Annex [URLString]
54getUrlsWithPrefix key prefix = filter (prefix `isPrefixOf`)
55	. map (fst . getDownloader)
56	<$> getUrls key
57
58setUrlPresent :: Key -> URLString -> Annex ()
59setUrlPresent key url = do
60	us <- getUrls key
61	unless (url `elem` us) $ do
62		config <- Annex.getGitConfig
63		addLog (Annex.Branch.RegardingUUID []) (urlLogFile config key)
64			InfoPresent (LogInfo (encodeBS url))
65	-- If the url does not have an OtherDownloader, it must be present
66	-- in the web.
67	case snd (getDownloader url) of
68		OtherDownloader -> return ()
69		_ -> logChange key webUUID InfoPresent
70
71setUrlMissing :: Key -> URLString -> Annex ()
72setUrlMissing key url = do
73	-- Avoid making any changes if the url was not registered.
74	us <- getUrls key
75	when (url `elem` us) $ do
76		config <- Annex.getGitConfig
77		addLog (Annex.Branch.RegardingUUID []) (urlLogFile config key)
78			InfoMissing (LogInfo (encodeBS url))
79		-- If the url was a web url and none of the remaining urls
80		-- for the key are web urls, the key must not be present
81		-- in the web.
82		when (isweb url && null (filter isweb $ filter (/= url) us)) $
83			logChange key webUUID InfoMissing
84  where
85	isweb u = case snd (getDownloader u) of
86		OtherDownloader -> False
87		_ -> True
88
89setTempUrl :: Key -> URLString -> Annex ()
90setTempUrl key url = Annex.changeState $ \s ->
91	s { Annex.tempurls = M.insert key url (Annex.tempurls s) }
92
93removeTempUrl :: Key -> Annex ()
94removeTempUrl key = Annex.changeState $ \s ->
95	s { Annex.tempurls = M.delete key (Annex.tempurls s) }
96
97data Downloader = WebDownloader | YoutubeDownloader | QuviDownloader | OtherDownloader
98	deriving (Eq, Show, Enum, Bounded)
99
100{- To keep track of how an url is downloaded, it's mangled slightly in
101 - the log, with a prefix indicating when a Downloader is used. -}
102setDownloader :: URLString -> Downloader -> String
103setDownloader u WebDownloader = u
104setDownloader u QuviDownloader = "quvi:" ++ u
105setDownloader u YoutubeDownloader = "yt:" ++ u
106setDownloader u OtherDownloader = ":" ++ u
107
108setDownloader' :: URLString -> Remote -> String
109setDownloader' u r
110	| Remote.uuid r == webUUID = setDownloader u WebDownloader
111	| otherwise = setDownloader u OtherDownloader
112
113getDownloader :: URLString -> (URLString, Downloader)
114getDownloader u = case separate (== ':') u of
115	("yt", u') -> (u', YoutubeDownloader)
116	-- quvi is not used any longer; youtube-dl should be able to handle
117	-- all urls it did.
118	("quvi", u') -> (u', YoutubeDownloader)
119	("", u') -> (u', OtherDownloader)
120	_ -> (u, WebDownloader)
121
122decodeUrlLogInfo :: LogInfo -> URLString
123decodeUrlLogInfo = decodeBS . fromLogInfo
124
125{- Parses the content of an url log file, returning the urls that are
126 - currently recorded. -}
127parseUrlLog :: L.ByteString -> [URLString]
128parseUrlLog = map decodeUrlLogInfo . getLog
129