add stub claimUrl

This commit is contained in:
Joey Hess 2014-12-08 13:40:15 -04:00
parent 8093008ef4
commit cb6e16947d
16 changed files with 28 additions and 13 deletions

View file

@ -29,8 +29,7 @@ import qualified Annex.Branch
import Annex.CatFile
import qualified Git
import qualified Git.LsFiles
type URLString = String
import Utility.Url
-- Dummy uuid for the whole web. Do not alter.
webUUID :: UUID

View file

@ -74,6 +74,7 @@ gen r u c gc = do
, readonly = False
, mkUnavailable = return Nothing
, getInfo = return [("repo", buprepo)]
, claimUrl = Nothing
}
return $ Just $ specialRemote' specialcfg c
(simplyPrepare $ store this buprepo)

View file

@ -71,6 +71,7 @@ gen r u c gc = do
, readonly = False
, mkUnavailable = return Nothing
, getInfo = return [("repo", ddarrepo)]
, claimUrl = Nothing
}
ddarrepo = fromMaybe (error "missing ddarrepo") $ remoteAnnexDdarRepo gc
specialcfg = (specialRemoteCfg c)

View file

@ -68,7 +68,8 @@ gen r u c gc = do
remotetype = remote,
mkUnavailable = gen r u c $
gc { remoteAnnexDirectory = Just "/dev/null" },
getInfo = return [("directory", dir)]
getInfo = return [("directory", dir)],
claimUrl = Nothing
}
where
dir = fromMaybe (error "missing directory") $ remoteAnnexDirectory gc

View file

@ -68,8 +68,9 @@ gen r u c gc = do
availability = avail,
remotetype = remote,
mkUnavailable = gen r u c $
gc { remoteAnnexExternalType = Just "!dne!" }
, getInfo = return [("externaltype", externaltype)]
gc { remoteAnnexExternalType = Just "!dne!" },
getInfo = return [("externaltype", externaltype)],
claimUrl = Nothing
}
where
externaltype = fromMaybe (error "missing externaltype") (remoteAnnexExternalType gc)

View file

@ -122,6 +122,7 @@ gen' r u c gc = do
, remotetype = remote
, mkUnavailable = return Nothing
, getInfo = return $ gitRepoInfo r
, claimUrl = Nothing
}
return $ Just $ specialRemote' specialcfg c
(simplyPrepare $ store this rsyncopts)

View file

@ -160,6 +160,7 @@ gen r u c gc
, remotetype = remote
, mkUnavailable = unavailable r u c gc
, getInfo = return $ gitRepoInfo r
, claimUrl = Nothing
}
unavailable :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)

View file

@ -68,7 +68,8 @@ gen r u c gc = new <$> remoteCost gc veryExpensiveRemoteCost
remotetype = remote,
mkUnavailable = return Nothing,
getInfo = includeCredsInfo c (AWS.creds u) $
[ ("glacier vault", getVault c) ]
[ ("glacier vault", getVault c) ],
claimUrl = Nothing
}
specialcfg = (specialRemoteCfg c)
-- Disabled until jobList gets support for chunks.

View file

@ -61,7 +61,8 @@ gen r u c gc = do
remotetype = remote,
mkUnavailable = gen r u c $
gc { remoteAnnexHookType = Just "!dne!" },
getInfo = return [("hooktype", hooktype)]
getInfo = return [("hooktype", hooktype)],
claimUrl = Nothing
}
where
hooktype = fromMaybe (error "missing hooktype") $ remoteAnnexHookType gc

View file

@ -84,6 +84,7 @@ gen r u c gc = do
, remotetype = remote
, mkUnavailable = return Nothing
, getInfo = return [("url", url)]
, claimUrl = Nothing
}
where
specialcfg = (specialRemoteCfg c)

View file

@ -92,7 +92,8 @@ gen r u c gc = do
then Just ("internet archive item", iaItemUrl $ fromMaybe "unknown" $ getBucketName c)
else Nothing
, Just ("partsize", maybe "unlimited" (roughSize storageUnits False) (getPartSize c))
]
],
claimUrl = Nothing
}
s3Setup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)

View file

@ -85,7 +85,8 @@ gen r u c gc = do
availability = GloballyAvailable,
remotetype = remote,
mkUnavailable = return Nothing,
getInfo = return []
getInfo = return [],
claimUrl = Nothing
}
tahoeSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)

View file

@ -63,7 +63,8 @@ gen r _ c gc =
availability = GloballyAvailable,
remotetype = remote,
mkUnavailable = return Nothing,
getInfo = return []
getInfo = return [],
claimUrl = Nothing -- implicitly claims all urls
}
downloadKey :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool

View file

@ -73,7 +73,8 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
remotetype = remote,
mkUnavailable = gen r u (M.insert "url" "http://!dne!/" c) gc,
getInfo = includeCredsInfo c (davCreds u) $
[("url", fromMaybe "unknown" (M.lookup "url" c))]
[("url", fromMaybe "unknown" (M.lookup "url" c))],
claimUrl = Nothing
}
chunkconfig = getChunkConfig c

View file

@ -29,6 +29,7 @@ import Config.Cost
import Utility.Metered
import Git.Types
import Utility.SafeCommand
import Utility.Url
type RemoteConfigKey = String
type RemoteConfig = M.Map RemoteConfigKey String
@ -100,7 +101,9 @@ data RemoteA a = Remote {
-- available for use. All its actions should fail.
mkUnavailable :: a (Maybe (RemoteA a)),
-- Information about the remote, for git annex info to display.
getInfo :: a [(String, String)]
getInfo :: a [(String, String)],
-- Some remotes can download from an url (or uri).
claimUrl :: Maybe (URLString -> IO Bool)
}
instance Show (RemoteA a) where

View file

@ -22,7 +22,7 @@ both available from CERN and from a torrent, for example.
Solution: Add a new method to remotes:
claimUri :: Maybe (Uri -> Bool)
claimUrl :: Maybe (URLString -> IO Bool)
Remotes that implement this method (including special remotes) will
be queried when such an uri is added, to see which claims it. Once the