diff options
author | Joey Hess <joeyh@joeyh.name> | 2014-12-11 14:09:57 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2014-12-11 14:09:57 -0400 |
commit | 4e88f7e9af6a776347649047f2473e470a729ed9 (patch) | |
tree | baa24cac409b25155aed0bcb7e006028ab743dc4 | |
parent | 9949e46e150be17320c22a096ead5ffd0fb5a8a6 (diff) |
Revert "let url claims optionally include a suggested filename"
This reverts commit bc0bf97b20c48e1d1a35d25e2e76a311c102438c.
Putting filename in the claim was a bad idea.
-rw-r--r-- | Annex/URLClaim.hs | 29 | ||||
-rw-r--r-- | Command/AddUrl.hs | 15 | ||||
-rw-r--r-- | Command/ReKey.hs | 3 | ||||
-rw-r--r-- | Command/RmUrl.hs | 3 | ||||
-rw-r--r-- | Command/Whereis.hs | 3 | ||||
-rw-r--r-- | Remote.hs | 11 | ||||
-rw-r--r-- | Remote/External.hs | 10 | ||||
-rw-r--r-- | Remote/External/Types.hs | 2 | ||||
-rw-r--r-- | Types/Remote.hs | 3 | ||||
-rw-r--r-- | Types/URLClaim.hs | 11 | ||||
-rw-r--r-- | doc/design/external_special_remote_protocol.mdwn | 3 |
11 files changed, 26 insertions, 67 deletions
diff --git a/Annex/URLClaim.hs b/Annex/URLClaim.hs deleted file mode 100644 index 3acb28e29..000000000 --- a/Annex/URLClaim.hs +++ /dev/null @@ -1,29 +0,0 @@ -{- Url claim checking. - - - - Copyright 2013-2014 Joey Hess <joey@kitenet.net> - - - - Licensed under the GNU GPL version 3 or higher. - -} - -module Annex.URLClaim ( - URLClaim(..), - urlClaim -) where - -import Common.Annex -import Types.URLClaim -import Logs.Web -import Remote -import qualified Types.Remote as Remote - -urlClaim :: URLString -> Annex (Remote, URLClaim) -urlClaim url = do - rs <- remoteList - -- The web special remote claims urls by default. - let web = Prelude.head $ filter (\r -> uuid r == webUUID) rs - fromMaybe (web, URLClaimed) <$> getM (\r -> ret r <$> checkclaim r) rs - where - checkclaim = maybe (pure Nothing) (flip id url) . Remote.claimUrl - - ret _ Nothing = Nothing - ret r (Just c) = Just (r, c) diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index 27c8359b0..76095d6e4 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -21,7 +21,6 @@ import qualified Annex.Url as Url import qualified Backend.URL import qualified Remote import qualified Types.Remote as Remote -import Annex.URLClaim import Annex.Content import Logs.Web import Types.Key @@ -59,23 +58,23 @@ seek ps = do start :: Bool -> Maybe FilePath -> Maybe Int -> String -> CommandStart start relaxed optfile pathdepth s = do - (r, claim) <- urlClaim s + r <- Remote.claimingUrl s if Remote.uuid r == webUUID then startWeb relaxed optfile pathdepth s - else startRemote r claim relaxed optfile pathdepth s + else startRemote r relaxed optfile pathdepth s -startRemote :: Remote -> URLClaim -> Bool -> Maybe FilePath -> Maybe Int -> String -> CommandStart -startRemote r claim relaxed optfile pathdepth s = do +startRemote :: Remote -> Bool -> Maybe FilePath -> Maybe Int -> String -> CommandStart +startRemote r relaxed optfile pathdepth s = do url <- case Url.parseURIRelaxed s of Nothing -> error $ "bad uri " ++ s Just u -> pure u pathmax <- liftIO $ fileNameLengthLimit "." - let file = flip fromMaybe optfile $ case claim of - URLClaimedAs f -> f - URLClaimed -> url2file url pathdepth pathmax + let file = choosefile $ url2file url pathdepth pathmax showStart "addurl" file showNote $ "using " ++ Remote.name r next $ performRemote r relaxed s file + where + choosefile = flip fromMaybe optfile performRemote :: Remote -> Bool -> URLString -> FilePath -> CommandPerform performRemote r relaxed uri file = ifAnnexed file adduri geturi diff --git a/Command/ReKey.hs b/Command/ReKey.hs index a0348d858..5dadf4e60 100644 --- a/Command/ReKey.hs +++ b/Command/ReKey.hs @@ -16,7 +16,6 @@ import qualified Command.Add import Logs.Web import Logs.Location import Utility.CopyFile -import Annex.URLClaim import qualified Remote cmd :: [Command] @@ -64,7 +63,7 @@ cleanup file oldkey newkey = do -- the new key as well. urls <- getUrls oldkey forM_ urls $ \url -> do - r <- fst <$> urlClaim url + r <- Remote.claimingUrl url setUrlPresent (Remote.uuid r) newkey url -- Update symlink to use the new key. diff --git a/Command/RmUrl.hs b/Command/RmUrl.hs index 737c935c5..570004266 100644 --- a/Command/RmUrl.hs +++ b/Command/RmUrl.hs @@ -10,7 +10,6 @@ module Command.RmUrl where import Common.Annex import Command import Logs.Web -import Annex.URLClaim import qualified Remote cmd :: [Command] @@ -28,7 +27,7 @@ start (file, url) = flip whenAnnexed file $ \_ key -> do cleanup :: String -> Key -> CommandCleanup cleanup url key = do - r <- fst <$> urlClaim url + r <- Remote.claimingUrl url let url' = if Remote.uuid r == webUUID then url else setDownloader url OtherDownloader diff --git a/Command/Whereis.hs b/Command/Whereis.hs index 5f75badde..314c204be 100644 --- a/Command/Whereis.hs +++ b/Command/Whereis.hs @@ -14,7 +14,6 @@ import Command import Remote import Logs.Trust import Logs.Web -import Annex.URLClaim cmd :: [Command] cmd = [noCommit $ withOptions (jsonOption : keyOptions) $ @@ -72,4 +71,4 @@ performRemote key remote = do . filter (\(_, d) -> d == OtherDownloader) . map getDownloader <$> getUrls key - filterM (\u -> (==) <$> pure remote <*> (fst <$> urlClaim u)) us + filterM (\u -> (==) <$> pure remote <*> claimingUrl u) us @@ -46,6 +46,7 @@ module Remote ( logStatus, checkAvailable, isXMPPRemote, + claimingUrl, ) where import qualified Data.Map as M @@ -60,6 +61,7 @@ import Annex.UUID import Logs.UUID import Logs.Trust import Logs.Location hiding (logStatus) +import Logs.Web import Remote.List import Config import Git.Types (RemoteName) @@ -318,3 +320,12 @@ hasKey r k = either (Left . show) Right <$> tryNonAsync (checkPresent r k) hasKeyCheap :: Remote -> Bool hasKeyCheap = checkPresentCheap + +{- The web special remote claims urls by default. -} +claimingUrl :: URLString -> Annex Remote +claimingUrl url = do + rs <- remoteList + let web = Prelude.head $ filter (\r -> uuid r == webUUID) rs + fromMaybe web <$> firstM checkclaim rs + where + checkclaim = maybe (pure False) (flip id url) . claimUrl diff --git a/Remote/External.hs b/Remote/External.hs index baae1ab9d..62671755c 100644 --- a/Remote/External.hs +++ b/Remote/External.hs @@ -12,7 +12,6 @@ import qualified Annex import Common.Annex import Types.Remote import Types.CleanupActions -import Types.URLClaim import qualified Git import Config import Remote.Helper.Special @@ -422,13 +421,12 @@ getAvailability external r gc = maybe query return (remoteAnnexAvailability gc) setRemoteAvailability r avail return avail -claimurl :: External -> URLString -> Annex (Maybe URLClaim) +claimurl :: External -> URLString -> Annex Bool claimurl external url = handleRequest external (CLAIMURL url) Nothing $ \req -> case req of - CLAIMURL_SUCCESS -> Just $ return $ Just URLClaimed - (CLAIMURL_AS f) -> Just $ return $ Just $ URLClaimedAs f - CLAIMURL_FAILURE -> Just $ return Nothing - UNSUPPORTED_REQUEST -> Just $ return Nothing + CLAIMURL_SUCCESS -> Just $ return True + CLAIMURL_FAILURE -> Just $ return False + UNSUPPORTED_REQUEST -> Just $ return False _ -> Nothing checkurl :: External -> URLString -> Annex (Maybe Integer) diff --git a/Remote/External/Types.hs b/Remote/External/Types.hs index a230ef3d2..b00352702 100644 --- a/Remote/External/Types.hs +++ b/Remote/External/Types.hs @@ -136,7 +136,6 @@ data Response | INITREMOTE_SUCCESS | INITREMOTE_FAILURE ErrorMsg | CLAIMURL_SUCCESS - | CLAIMURL_AS FilePath | CLAIMURL_FAILURE | CHECKURL_SIZE Size | CHECKURL_SIZEUNKNOWN @@ -159,7 +158,6 @@ instance Proto.Receivable Response where parseCommand "INITREMOTE-SUCCESS" = Proto.parse0 INITREMOTE_SUCCESS parseCommand "INITREMOTE-FAILURE" = Proto.parse1 INITREMOTE_FAILURE parseCommand "CLAIMURL-SUCCESS" = Proto.parse0 CLAIMURL_SUCCESS - parseCommand "CLAIMURL-AS" = Proto.parse1 CLAIMURL_AS parseCommand "CLAIMURL-FAILURE" = Proto.parse0 CLAIMURL_FAILURE parseCommand "CHECKURL-SIZE" = Proto.parse1 CHECKURL_SIZE parseCommand "CHECKURL-SIZEUNKNOWN" = Proto.parse0 CHECKURL_SIZEUNKNOWN diff --git a/Types/Remote.hs b/Types/Remote.hs index bb56bb01d..baa857906 100644 --- a/Types/Remote.hs +++ b/Types/Remote.hs @@ -25,7 +25,6 @@ import Types.UUID import Types.GitConfig import Types.Availability import Types.Creds -import Types.URLClaim import Config.Cost import Utility.Metered import Git.Types @@ -104,7 +103,7 @@ data RemoteA a = Remote { -- Information about the remote, for git annex info to display. getInfo :: a [(String, String)], -- Some remotes can download from an url (or uri). - claimUrl :: Maybe (URLString -> a (Maybe URLClaim)), + claimUrl :: Maybe (URLString -> a Bool), -- Checks that the url is accessible, and gets the size of its -- content. Returns Nothing if the url is accessible, but -- its size cannot be determined inexpensively. diff --git a/Types/URLClaim.hs b/Types/URLClaim.hs deleted file mode 100644 index f14333111..000000000 --- a/Types/URLClaim.hs +++ /dev/null @@ -1,11 +0,0 @@ -{- git-annex url claiming - - - - Copyright 2014 Joey Hess <joey@kitenet.net> - - - - Licensed under the GNU GPL version 3 or higher. - -} - -module Types.URLClaim where - -data URLClaim = URLClaimed | URLClaimedAs FilePath - deriving (Eq) diff --git a/doc/design/external_special_remote_protocol.mdwn b/doc/design/external_special_remote_protocol.mdwn index c62949b6d..072c5a1a2 100644 --- a/doc/design/external_special_remote_protocol.mdwn +++ b/doc/design/external_special_remote_protocol.mdwn @@ -179,9 +179,6 @@ while it's handling a request. Indicates that INITREMOTE failed. * `CLAIMURL-SUCCESS` Indicates that the CLAIMURL url will be handled by this remote. -* `CLAIMURL-AS Filename` - Indicates that the CLAIMURL url will be handled by this remote, - and suggests a filename to use for it. * `CLAIMURL-FAILURE` Indicates that the CLAIMURL url wil not be handled by this remote. * `CHECKURL-SIZE Size` |