Revert "let url claims optionally include a suggested filename"

This reverts commit 85df9c30e9.

Putting filename in the claim was a bad idea.
This commit is contained in:
Joey Hess 2014-12-11 14:09:57 -04:00
parent 30685751ea
commit 7ae16bb6f7
11 changed files with 26 additions and 67 deletions

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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