summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Annex/URLClaim.hs29
-rw-r--r--Command/AddUrl.hs15
-rw-r--r--Command/ReKey.hs3
-rw-r--r--Command/RmUrl.hs3
-rw-r--r--Command/Whereis.hs3
-rw-r--r--Remote.hs11
-rw-r--r--Remote/External.hs10
-rw-r--r--Remote/External/Types.hs2
-rw-r--r--Types/Remote.hs3
-rw-r--r--Types/URLClaim.hs11
-rw-r--r--doc/design/external_special_remote_protocol.mdwn3
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
diff --git a/Remote.hs b/Remote.hs
index dd682493c..65e725338 100644
--- a/Remote.hs
+++ b/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
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`
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-27 06:04:56 +0000