break web log handling into a separate module

This commit is contained in:
Joey Hess 2011-10-15 16:25:51 -04:00
parent 1a29b5b52e
commit b4015064e1
2 changed files with 50 additions and 33 deletions

49
Logs/Web.hs Normal file
View file

@ -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)

View file

@ -14,13 +14,10 @@ import Common.Annex
import Types.Remote import Types.Remote
import qualified Git import qualified Git
import Config import Config
import Logs.Presence
import Logs.Location
import Logs.UUID import Logs.UUID
import Logs.Web
import qualified Utility.Url as Url import qualified Utility.Url as Url
type URLString = String
remote :: RemoteType Annex remote :: RemoteType Annex
remote = RemoteType { remote = RemoteType {
typename = "web", typename = "web",
@ -35,10 +32,6 @@ remote = RemoteType {
list :: Annex [Git.Repo] list :: Annex [Git.Repo]
list = return [Git.repoRemoteNameSet Git.repoFromUnknown "web"] 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 :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex (Remote Annex)
gen r _ _ = gen r _ _ =
return Remote { return Remote {
@ -54,31 +47,6 @@ gen r _ _ =
repo = 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 -> FilePath -> Annex Bool
downloadKey key file = get =<< getUrls key downloadKey key file = get =<< getUrls key
where where