diff options
| -rw-r--r-- | Logs/Web.hs | 49 | ||||
| -rw-r--r-- | Remote/Web.hs | 34 |
2 files changed, 50 insertions, 33 deletions
diff --git a/Logs/Web.hs b/Logs/Web.hs new file mode 100644 index 000000000..ff8fbdb6b --- /dev/null +++ b/Logs/Web.hs @@ -0,0 +1,49 @@ +{- Web url logs. + - + - Copyright 2011 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Logs.Web ( + URLString, + webUUID, + setUrl, + getUrls +) where + +import Common.Annex +import Logs.Presence +import Logs.Location +import Logs.UUID + +type URLString = String + +-- Dummy uuid for the whole web. Do not alter. +webUUID :: UUID +webUUID = "00000000-0000-0000-0000-000000000001" + +{- The urls for a key are stored in remote/web/hash/key.log + - in the git-annex branch. -} +urlLog :: Key -> FilePath +urlLog key = "remote/web" </> hashDirLower key </> keyFile key ++ ".log" +oldurlLog :: Key -> FilePath +{- A bug used to store the urls elsewhere. -} +oldurlLog key = "remote/web" </> hashDirLower key </> show key ++ ".log" + +getUrls :: Key -> Annex [URLString] +getUrls key = do + us <- currentLog (urlLog key) + if null us + then currentLog (oldurlLog key) + else return us + +{- Records a change in an url for a key. -} +setUrl :: Key -> URLString -> LogStatus -> Annex () +setUrl key url status = do + g <- gitRepo + addLog (urlLog key) =<< logNow status url + + -- update location log to indicate that the web has the key, or not + us <- getUrls key + logChange g key webUUID (if null us then InfoMissing else InfoPresent) diff --git a/Remote/Web.hs b/Remote/Web.hs index 51373a49c..e46937ba5 100644 --- a/Remote/Web.hs +++ b/Remote/Web.hs @@ -14,13 +14,10 @@ import Common.Annex import Types.Remote import qualified Git import Config -import Logs.Presence -import Logs.Location import Logs.UUID +import Logs.Web import qualified Utility.Url as Url -type URLString = String - remote :: RemoteType Annex remote = RemoteType { typename = "web", @@ -35,10 +32,6 @@ remote = RemoteType { list :: Annex [Git.Repo] list = return [Git.repoRemoteNameSet Git.repoFromUnknown "web"] --- Dummy uuid for the whole web. Do not alter. -webUUID :: UUID -webUUID = "00000000-0000-0000-0000-000000000001" - gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex (Remote Annex) gen r _ _ = return Remote { @@ -54,31 +47,6 @@ gen r _ _ = repo = r } -{- The urls for a key are stored in remote/web/hash/key.log - - in the git-annex branch. -} -urlLog :: Key -> FilePath -urlLog key = "remote/web" </> hashDirLower key </> keyFile key ++ ".log" -oldurlLog :: Key -> FilePath -{- A bug used to store the urls elsewhere. -} -oldurlLog key = "remote/web" </> hashDirLower key </> show key ++ ".log" - -getUrls :: Key -> Annex [URLString] -getUrls key = do - us <- currentLog (urlLog key) - if null us - then currentLog (oldurlLog key) - else return us - -{- Records a change in an url for a key. -} -setUrl :: Key -> URLString -> LogStatus -> Annex () -setUrl key url status = do - g <- gitRepo - addLog (urlLog key) =<< logNow status url - - -- update location log to indicate that the web has the key, or not - us <- getUrls key - logChange g key webUUID (if null us then InfoMissing else InfoPresent) - downloadKey :: Key -> FilePath -> Annex Bool downloadKey key file = get =<< getUrls key where |