break web log handling into a separate module
This commit is contained in:
parent
1a29b5b52e
commit
b4015064e1
2 changed files with 50 additions and 33 deletions
49
Logs/Web.hs
Normal file
49
Logs/Web.hs
Normal 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)
|
|
@ -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
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue