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:
parent
30685751ea
commit
7ae16bb6f7
11 changed files with 26 additions and 67 deletions
|
@ -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)
|
|
@ -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
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
11
Remote.hs
11
Remote.hs
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
2
Remote/External/Types.hs
vendored
2
Remote/External/Types.hs
vendored
|
@ -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
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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)
|
|
@ -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`
|
||||
|
|
Loading…
Reference in a new issue