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