summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Logs/Web.hs49
-rw-r--r--Remote/Web.hs34
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