summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Command/Export.hs61
-rw-r--r--Remote/BitTorrent.hs7
-rw-r--r--Remote/Bup.hs7
-rw-r--r--Remote/Ddar.hs7
-rw-r--r--Remote/Directory.hs14
-rw-r--r--Remote/External.hs7
-rw-r--r--Remote/GCrypt.hs7
-rw-r--r--Remote/Git.hs7
-rw-r--r--Remote/Glacier.hs7
-rw-r--r--Remote/Helper/Export.hs21
-rw-r--r--Remote/Hook.hs7
-rw-r--r--Remote/P2P.hs7
-rw-r--r--Remote/Rsync.hs7
-rw-r--r--Remote/S3.hs7
-rw-r--r--Remote/Tahoe.hs7
-rw-r--r--Remote/Web.hs7
-rw-r--r--Remote/WebDAV.hs7
-rw-r--r--Types/Remote.hs93
-rw-r--r--doc/design/exporting_trees_to_special_remotes.mdwn4
-rw-r--r--git-annex.cabal1
20 files changed, 143 insertions, 149 deletions
diff --git a/Command/Export.hs b/Command/Export.hs
index 0df13e489..03d549cbf 100644
--- a/Command/Export.hs
+++ b/Command/Export.hs
@@ -69,6 +69,9 @@ exportKey sha = mk <$> catKey sha
seek :: ExportOptions -> CommandSeek
seek o = do
r <- getParsed (exportRemote o)
+ unlessM (exportSupported (exportActions r)) $
+ error "That remote does not support exports."
+
new <- fromMaybe (error "unknown tree") <$>
-- Dereference the tree pointed to by the branch, commit,
-- or tag.
@@ -113,29 +116,28 @@ startExport r ti = do
f = getTopFilePath $ Git.LsTree.file ti
performExport :: Remote -> ExportKey -> Sha -> ExportLocation -> CommandPerform
-performExport r ek contentsha loc = case storeExport r of
- Nothing -> error "remote does not support exporting files"
- Just storer -> do
- sent <- case ek of
- AnnexKey k -> ifM (inAnnex k)
- ( metered Nothing k $ \m -> do
- let rollback = void $ performUnexport r ek loc
- sendAnnex k rollback
- (\f -> storer f k loc m)
- , do
- showNote "not available"
- return False
- )
- -- Sending a non-annexed file.
- GitKey sha1k -> metered Nothing sha1k $ \m ->
- withTmpFile "export" $ \tmp h -> do
- b <- catObject contentsha
- liftIO $ L.hPut h b
- liftIO $ hClose h
- storer tmp sha1k loc m
- if sent
- then next $ cleanupExport r ek
- else stop
+performExport r ek contentsha loc = do
+ let storer = storeExport $ exportActions r
+ sent <- case ek of
+ AnnexKey k -> ifM (inAnnex k)
+ ( metered Nothing k $ \m -> do
+ let rollback = void $ performUnexport r ek loc
+ sendAnnex k rollback
+ (\f -> storer f k loc m)
+ , do
+ showNote "not available"
+ return False
+ )
+ -- Sending a non-annexed file.
+ GitKey sha1k -> metered Nothing sha1k $ \m ->
+ withTmpFile "export" $ \tmp h -> do
+ b <- catObject contentsha
+ liftIO $ L.hPut h b
+ liftIO $ hClose h
+ storer tmp sha1k loc m
+ if sent
+ then next $ cleanupExport r ek
+ else stop
cleanupExport :: Remote -> ExportKey -> CommandCleanup
cleanupExport r ek = do
@@ -154,13 +156,12 @@ startUnexport r diff
f = getTopFilePath $ Git.DiffTree.file diff
performUnexport :: Remote -> ExportKey -> ExportLocation -> CommandPerform
-performUnexport r ek loc = case removeExport r of
- Nothing -> error "remote does not support removing exported files"
- Just remover -> do
- ok <- remover (asKey ek) loc
- if ok
- then next $ cleanupUnexport r ek
- else stop
+performUnexport r ek loc = do
+ let remover = removeExport $ exportActions r
+ ok <- remover (asKey ek) loc
+ if ok
+ then next $ cleanupUnexport r ek
+ else stop
cleanupUnexport :: Remote -> ExportKey -> CommandCleanup
cleanupUnexport r ek = do
diff --git a/Remote/BitTorrent.hs b/Remote/BitTorrent.hs
index 887a0898e..9a1be1c0e 100644
--- a/Remote/BitTorrent.hs
+++ b/Remote/BitTorrent.hs
@@ -26,6 +26,7 @@ import Backend.URL
import Annex.Perms
import Annex.UUID
import qualified Annex.Url as Url
+import Remote.Helper.Export
import Network.URI
@@ -61,11 +62,7 @@ gen r _ c gc =
, lockContent = Nothing
, checkPresent = checkKey
, checkPresentCheap = False
- , storeExport = Nothing
- , retrieveExport = Nothing
- , removeExport = Nothing
- , checkPresentExport = Nothing
- , renameExport = Nothing
+ , exportActions = exportUnsupported
, whereisKey = Nothing
, remoteFsck = Nothing
, repairRepo = Nothing
diff --git a/Remote/Bup.hs b/Remote/Bup.hs
index aad8e6bba..6ff2aa885 100644
--- a/Remote/Bup.hs
+++ b/Remote/Bup.hs
@@ -25,6 +25,7 @@ import Config.Cost
import qualified Remote.Helper.Ssh as Ssh
import Remote.Helper.Special
import Remote.Helper.Messages
+import Remote.Helper.Export
import Utility.Hash
import Utility.UserInfo
import Annex.UUID
@@ -61,11 +62,7 @@ gen r u c gc = do
, lockContent = Nothing
, checkPresent = checkPresentDummy
, checkPresentCheap = bupLocal buprepo
- , storeExport = Nothing
- , retrieveExport = Nothing
- , removeExport = Nothing
- , checkPresentExport = Nothing
- , renameExport = Nothing
+ , exportActions = exportUnsupported
, whereisKey = Nothing
, remoteFsck = Nothing
, repairRepo = Nothing
diff --git a/Remote/Ddar.hs b/Remote/Ddar.hs
index 1da3ff412..c5d02a4e6 100644
--- a/Remote/Ddar.hs
+++ b/Remote/Ddar.hs
@@ -19,6 +19,7 @@ import qualified Git
import Config
import Config.Cost
import Remote.Helper.Special
+import Remote.Helper.Export
import Annex.Ssh
import Annex.UUID
import Utility.SshHost
@@ -60,11 +61,7 @@ gen r u c gc = do
, lockContent = Nothing
, checkPresent = checkPresentDummy
, checkPresentCheap = ddarLocal ddarrepo
- , storeExport = Nothing
- , retrieveExport = Nothing
- , removeExport = Nothing
- , checkPresentExport = Nothing
- , renameExport = Nothing
+ , exportActions = exportUnsupported
, whereisKey = Nothing
, remoteFsck = Nothing
, repairRepo = Nothing
diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index f5d7f7e49..e2e517b84 100644
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -25,6 +25,7 @@ import Config.Cost
import Config
import Utility.FileMode
import Remote.Helper.Special
+import Remote.Helper.Export
import qualified Remote.Directory.LegacyChunked as Legacy
import Annex.Content
import Annex.UUID
@@ -59,11 +60,14 @@ gen r u c gc = do
, lockContent = Nothing
, checkPresent = checkPresentDummy
, checkPresentCheap = True
- , storeExport = Just $ storeExportDirectory dir
- , retrieveExport = Just $ retrieveExportDirectory dir
- , removeExport = Just $ removeExportDirectory dir
- , checkPresentExport = Just $ checkPresentExportDirectory dir
- , renameExport = Just $ renameExportDirectory dir
+ , exportActions = ExportActions
+ { exportSupported = return True
+ , storeExport = storeExportDirectory dir
+ , retrieveExport = retrieveExportDirectory dir
+ , removeExport = removeExportDirectory dir
+ , checkPresentExport = checkPresentExportDirectory dir
+ , renameExport = renameExportDirectory dir
+ }
, whereisKey = Nothing
, remoteFsck = Nothing
, repairRepo = Nothing
diff --git a/Remote/External.hs b/Remote/External.hs
index dd62c1539..fca60a995 100644
--- a/Remote/External.hs
+++ b/Remote/External.hs
@@ -18,6 +18,7 @@ import Config
import Git.Config (isTrue, boolConfig)
import Git.Env
import Remote.Helper.Special
+import Remote.Helper.Export
import Remote.Helper.ReadOnly
import Remote.Helper.Messages
import Utility.Metered
@@ -85,11 +86,7 @@ gen r u c gc
, lockContent = Nothing
, checkPresent = checkPresentDummy
, checkPresentCheap = False
- , storeExport = Nothing
- , retrieveExport = Nothing
- , removeExport = Nothing
- , checkPresentExport = Nothing
- , renameExport = Nothing
+ , exportActions = exportUnsupported
, whereisKey = towhereis
, remoteFsck = Nothing
, repairRepo = Nothing
diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs
index 95b7ae287..dd681a75c 100644
--- a/Remote/GCrypt.hs
+++ b/Remote/GCrypt.hs
@@ -38,6 +38,7 @@ import Remote.Helper.Git
import Remote.Helper.Encryptable
import Remote.Helper.Special
import Remote.Helper.Messages
+import Remote.Helper.Export
import qualified Remote.Helper.Ssh as Ssh
import Utility.Metered
import Annex.UUID
@@ -114,11 +115,7 @@ gen' r u c gc = do
, lockContent = Nothing
, checkPresent = checkPresentDummy
, checkPresentCheap = repoCheap r
- , storeExport = Nothing
- , retrieveExport = Nothing
- , removeExport = Nothing
- , checkPresentExport = Nothing
- , renameExport = Nothing
+ , exportActions = exportUnsupported
, whereisKey = Nothing
, remoteFsck = Nothing
, repairRepo = Nothing
diff --git a/Remote/Git.hs b/Remote/Git.hs
index 020cd1c61..129d5e171 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -50,6 +50,7 @@ import Utility.Batch
import Utility.SimpleProtocol
import Remote.Helper.Git
import Remote.Helper.Messages
+import Remote.Helper.Export
import qualified Remote.Helper.Ssh as Ssh
import qualified Remote.GCrypt
import qualified Remote.P2P
@@ -157,11 +158,7 @@ gen r u c gc
, lockContent = Just (lockKey new)
, checkPresent = inAnnex new
, checkPresentCheap = repoCheap r
- , storeExport = Nothing
- , retrieveExport = Nothing
- , removeExport = Nothing
- , checkPresentExport = Nothing
- , renameExport = Nothing
+ , exportActions = exportUnsupported
, whereisKey = Nothing
, remoteFsck = if Git.repoIsUrl r
then Nothing
diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs
index be65cecb7..b21167aaf 100644
--- a/Remote/Glacier.hs
+++ b/Remote/Glacier.hs
@@ -18,6 +18,7 @@ import Config
import Config.Cost
import Remote.Helper.Special
import Remote.Helper.Messages
+import Remote.Helper.Export
import qualified Remote.Helper.AWS as AWS
import Creds
import Utility.Metered
@@ -57,11 +58,7 @@ gen r u c gc = new <$> remoteCost gc veryExpensiveRemoteCost
, lockContent = Nothing
, checkPresent = checkPresentDummy
, checkPresentCheap = False
- , storeExport = Nothing
- , retrieveExport = Nothing
- , removeExport = Nothing
- , checkPresentExport = Nothing
- , renameExport = Nothing
+ , exportActions = exportUnsupported
, whereisKey = Nothing
, remoteFsck = Nothing
, repairRepo = Nothing
diff --git a/Remote/Helper/Export.hs b/Remote/Helper/Export.hs
new file mode 100644
index 000000000..d623818e7
--- /dev/null
+++ b/Remote/Helper/Export.hs
@@ -0,0 +1,21 @@
+{- exports to remotes
+ -
+ - Copyright 2017 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Remote.Helper.Export where
+
+import Annex.Common
+import Types.Remote
+
+exportUnsupported :: ExportActions Annex
+exportUnsupported = ExportActions
+ { exportSupported = return False
+ , storeExport = \_ _ _ _ -> return False
+ , retrieveExport = \_ _ _ _ -> return (False, UnVerified)
+ , removeExport = \_ _ -> return False
+ , checkPresentExport = \_ _ -> return False
+ , renameExport = \_ _ _ -> return False
+ }
diff --git a/Remote/Hook.hs b/Remote/Hook.hs
index 2a9874242..5be4339e3 100644
--- a/Remote/Hook.hs
+++ b/Remote/Hook.hs
@@ -16,6 +16,7 @@ import Config.Cost
import Annex.UUID
import Remote.Helper.Special
import Remote.Helper.Messages
+import Remote.Helper.Export
import Utility.Env
import Messages.Progress
@@ -51,11 +52,7 @@ gen r u c gc = do
, lockContent = Nothing
, checkPresent = checkPresentDummy
, checkPresentCheap = False
- , storeExport = Nothing
- , retrieveExport = Nothing
- , removeExport = Nothing
- , checkPresentExport = Nothing
- , renameExport = Nothing
+ , exportActions = exportUnsupported
, whereisKey = Nothing
, remoteFsck = Nothing
, repairRepo = Nothing
diff --git a/Remote/P2P.hs b/Remote/P2P.hs
index d77ac89d8..f51b73b33 100644
--- a/Remote/P2P.hs
+++ b/Remote/P2P.hs
@@ -24,6 +24,7 @@ import Annex.UUID
import Config
import Config.Cost
import Remote.Helper.Git
+import Remote.Helper.Export
import Messages.Progress
import Utility.Metered
import Utility.AuthToken
@@ -57,11 +58,7 @@ chainGen addr r u c gc = do
, lockContent = Just (lock u addr connpool)
, checkPresent = checkpresent u addr connpool
, checkPresentCheap = False
- , storeExport = Nothing
- , retrieveExport = Nothing
- , removeExport = Nothing
- , checkPresentExport = Nothing
- , renameExport = Nothing
+ , exportActions = exportUnsupported
, whereisKey = Nothing
, remoteFsck = Nothing
, repairRepo = Nothing
diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs
index d40d23bae..33485c78b 100644
--- a/Remote/Rsync.hs
+++ b/Remote/Rsync.hs
@@ -28,6 +28,7 @@ import Annex.UUID
import Annex.Ssh
import Remote.Helper.Special
import Remote.Helper.Messages
+import Remote.Helper.Export
import Remote.Rsync.RsyncUrl
import Crypto
import Utility.Rsync
@@ -73,11 +74,7 @@ gen r u c gc = do
, lockContent = Nothing
, checkPresent = checkPresentDummy
, checkPresentCheap = False
- , storeExport = Nothing
- , retrieveExport = Nothing
- , removeExport = Nothing
- , checkPresentExport = Nothing
- , renameExport = Nothing
+ , exportActions = exportUnsupported
, whereisKey = Nothing
, remoteFsck = Nothing
, repairRepo = Nothing
diff --git a/Remote/S3.hs b/Remote/S3.hs
index ce6776595..341d14b4e 100644
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@@ -39,6 +39,7 @@ import Config.Cost
import Remote.Helper.Special
import Remote.Helper.Http
import Remote.Helper.Messages
+import Remote.Helper.Export
import qualified Remote.Helper.AWS as AWS
import Creds
import Annex.UUID
@@ -84,11 +85,7 @@ gen r u c gc = do
, lockContent = Nothing
, checkPresent = checkPresentDummy
, checkPresentCheap = False
- , storeExport = Nothing
- , retrieveExport = Nothing
- , removeExport = Nothing
- , checkPresentExport = Nothing
- , renameExport = Nothing
+ , exportActions = exportUnsupported
, whereisKey = Just (getWebUrls info)
, remoteFsck = Nothing
, repairRepo = Nothing
diff --git a/Remote/Tahoe.hs b/Remote/Tahoe.hs
index cf65634b0..b197edca2 100644
--- a/Remote/Tahoe.hs
+++ b/Remote/Tahoe.hs
@@ -34,6 +34,7 @@ import qualified Git
import Config
import Config.Cost
import Remote.Helper.Special
+import Remote.Helper.Export
import Annex.UUID
import Annex.Content
import Logs.RemoteState
@@ -75,11 +76,7 @@ gen r u c gc = do
, lockContent = Nothing
, checkPresent = checkKey u hdl
, checkPresentCheap = False
- , storeExport = Nothing
- , retrieveExport = Nothing
- , removeExport = Nothing
- , checkPresentExport = Nothing
- , renameExport = Nothing
+ , exportActions = exportUnsupported
, whereisKey = Just (getWhereisKey u)
, remoteFsck = Nothing
, repairRepo = Nothing
diff --git a/Remote/Web.hs b/Remote/Web.hs
index 4d55389ec..45e8d1c22 100644
--- a/Remote/Web.hs
+++ b/Remote/Web.hs
@@ -10,6 +10,7 @@ module Remote.Web (remote, getWebUrls) where
import Annex.Common
import Types.Remote
import Remote.Helper.Messages
+import Remote.Helper.Export
import qualified Git
import qualified Git.Construct
import Annex.Content
@@ -50,11 +51,7 @@ gen r _ c gc =
, lockContent = Nothing
, checkPresent = checkKey
, checkPresentCheap = False
- , storeExport = Nothing
- , retrieveExport = Nothing
- , removeExport = Nothing
- , checkPresentExport = Nothing
- , renameExport = Nothing
+ , exportActions = exportUnsupported
, whereisKey = Nothing
, remoteFsck = Nothing
, repairRepo = Nothing
diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs
index 9230a027d..4c9552a6f 100644
--- a/Remote/WebDAV.hs
+++ b/Remote/WebDAV.hs
@@ -28,6 +28,7 @@ import Config.Cost
import Remote.Helper.Special
import Remote.Helper.Messages
import Remote.Helper.Http
+import Remote.Helper.Export
import qualified Remote.Helper.Chunked.Legacy as Legacy
import Creds
import Utility.Metered
@@ -68,11 +69,7 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
, lockContent = Nothing
, checkPresent = checkPresentDummy
, checkPresentCheap = False
- , storeExport = Nothing
- , retrieveExport = Nothing
- , removeExport = Nothing
- , checkPresentExport = Nothing
- , renameExport = Nothing
+ , exportActions = exportUnsupported
, whereisKey = Nothing
, remoteFsck = Nothing
, repairRepo = Nothing
diff --git a/Types/Remote.hs b/Types/Remote.hs
index 6e78bf238..169701ecc 100644
--- a/Types/Remote.hs
+++ b/Types/Remote.hs
@@ -19,6 +19,7 @@ module Types.Remote
, Verification(..)
, unVerified
, ExportLocation(..)
+ , ExportActions(..)
)
where
@@ -63,91 +64,75 @@ instance Eq (RemoteTypeA a) where
x == y = typename x == typename y
{- An individual remote. -}
-data RemoteA a = Remote {
+data RemoteA a = Remote
-- each Remote has a unique uuid
- uuid :: UUID,
+ { uuid :: UUID
-- each Remote has a human visible name
- name :: RemoteName,
+ , name :: RemoteName
-- Remotes have a use cost; higher is more expensive
- cost :: Cost,
+ , cost :: Cost
-- Transfers a key's contents from disk to the remote.
-- The key should not appear to be present on the remote until
-- all of its contents have been transferred.
- storeKey :: Key -> AssociatedFile -> MeterUpdate -> a Bool,
+ , storeKey :: Key -> AssociatedFile -> MeterUpdate -> a Bool
-- Retrieves a key's contents to a file.
-- (The MeterUpdate does not need to be used if it writes
-- sequentially to the file.)
- retrieveKeyFile :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> a (Bool, Verification),
+ , retrieveKeyFile :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> a (Bool, Verification)
-- Retrieves a key's contents to a tmp file, if it can be done cheaply.
-- It's ok to create a symlink or hardlink.
- retrieveKeyFileCheap :: Key -> AssociatedFile -> FilePath -> a Bool,
+ , retrieveKeyFileCheap :: Key -> AssociatedFile -> FilePath -> a Bool
-- Removes a key's contents (succeeds if the contents are not present)
- removeKey :: Key -> a Bool,
+ , removeKey :: Key -> a Bool
-- Uses locking to prevent removal of a key's contents,
-- thus producing a VerifiedCopy, which is passed to the callback.
-- If unable to lock, does not run the callback, and throws an
-- error.
-- This is optional; remotes do not have to support locking.
- lockContent :: forall r. Maybe (Key -> (VerifiedCopy -> a r) -> a r),
+ , lockContent :: forall r. Maybe (Key -> (VerifiedCopy -> a r) -> a r)
-- Checks if a key is present in the remote.
-- Throws an exception if the remote cannot be accessed.
- checkPresent :: Key -> a Bool,
+ , checkPresent :: Key -> a Bool
-- Some remotes can checkPresent without an expensive network
-- operation.
- checkPresentCheap :: Bool,
-
- -- Exports content to an ExportLocation.
- -- The exported file should not appear to be present on the remote
- -- until all of its contents have been transferred.
- storeExport :: Maybe (FilePath -> Key -> ExportLocation -> MeterUpdate -> a Bool),
- -- Retrieves exported content to a file.
- -- (The MeterUpdate does not need to be used if it writes
- -- sequentially to the file.)
- retrieveExport :: Maybe (Key -> ExportLocation -> FilePath -> MeterUpdate -> a (Bool, Verification)),
- -- Removes an exported file (succeeds if the contents are not present)
- removeExport :: Maybe (Key -> ExportLocation -> a Bool),
- -- Checks if anything is exported to the remote at the specified
- -- ExportLocation.
- -- Throws an exception if the remote cannot be accessed.
- checkPresentExport :: Maybe (Key -> ExportLocation -> a Bool),
- -- Renames an already exported file.
- renameExport :: Maybe (Key -> ExportLocation -> ExportLocation -> a Bool),
-
+ , checkPresentCheap :: Bool
+ -- Some remotes support exports of trees.
+ , exportActions :: ExportActions a
-- Some remotes can provide additional details for whereis.
- whereisKey :: Maybe (Key -> a [String]),
+ , whereisKey :: Maybe (Key -> a [String])
-- Some remotes can run a fsck operation on the remote,
-- without transferring all the data to the local repo
-- The parameters are passed to the fsck command on the remote.
- remoteFsck :: Maybe ([CommandParam] -> a (IO Bool)),
+ , remoteFsck :: Maybe ([CommandParam] -> a (IO Bool))
-- Runs an action to repair the remote's git repository.
- repairRepo :: Maybe (a Bool -> a (IO Bool)),
+ , repairRepo :: Maybe (a Bool -> a (IO Bool))
-- a Remote has a persistent configuration store
- config :: RemoteConfig,
+ , config :: RemoteConfig
-- git repo for the Remote
- repo :: Git.Repo,
+ , repo :: Git.Repo
-- a Remote's configuration from git
- gitconfig :: RemoteGitConfig,
+ , gitconfig :: RemoteGitConfig
-- a Remote can be assocated with a specific local filesystem path
- localpath :: Maybe FilePath,
+ , localpath :: Maybe FilePath
-- a Remote can be known to be readonly
- readonly :: Bool,
+ , readonly :: Bool
-- a Remote can be globally available. (Ie, "in the cloud".)
- availability :: Availability,
+ , availability :: Availability
-- the type of the remote
- remotetype :: RemoteTypeA a,
+ , remotetype :: RemoteTypeA a
-- For testing, makes a version of this remote that is not
-- available for use. All its actions should fail.
- mkUnavailable :: a (Maybe (RemoteA a)),
+ , 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 -> a Bool),
+ , claimUrl :: Maybe (URLString -> a Bool)
-- Checks that the url is accessible, and gets information about
-- its contents, without downloading the full content.
-- Throws an exception if the url is inaccessible.
- checkUrl :: Maybe (URLString -> a UrlContents)
-}
+ , checkUrl :: Maybe (URLString -> a UrlContents)
+ }
instance Show (RemoteA a) where
show remote = "Remote { name =\"" ++ name remote ++ "\" }"
@@ -175,3 +160,23 @@ unVerified a = do
-- The FilePath will be relative, and may contain unix-style path
-- separators.
newtype ExportLocation = ExportLocation FilePath
+
+data ExportActions a = ExportActions
+ { exportSupported :: a Bool
+ -- Exports content to an ExportLocation.
+ -- The exported file should not appear to be present on the remote
+ -- until all of its contents have been transferred.
+ , storeExport :: FilePath -> Key -> ExportLocation -> MeterUpdate -> a Bool
+ -- Retrieves exported content to a file.
+ -- (The MeterUpdate does not need to be used if it writes
+ -- sequentially to the file.)
+ , retrieveExport :: Key -> ExportLocation -> FilePath -> MeterUpdate -> a (Bool, Verification)
+ -- Removes an exported file (succeeds if the contents are not present)
+ , removeExport :: Key -> ExportLocation -> a Bool
+ -- Checks if anything is exported to the remote at the specified
+ -- ExportLocation.
+ -- Throws an exception if the remote cannot be accessed.
+ , checkPresentExport :: Key -> ExportLocation -> a Bool
+ -- Renames an already exported file.
+ , renameExport :: Key -> ExportLocation -> ExportLocation -> a Bool
+ }
diff --git a/doc/design/exporting_trees_to_special_remotes.mdwn b/doc/design/exporting_trees_to_special_remotes.mdwn
index 7e5700fae..52a68c6b4 100644
--- a/doc/design/exporting_trees_to_special_remotes.mdwn
+++ b/doc/design/exporting_trees_to_special_remotes.mdwn
@@ -83,6 +83,10 @@ the [[external_special_remote_protocol]].
Here's the changes to the latter:
+* `EXPORTSUPPORTED`
+ Used to check if a special remote supports exports. The remote
+ responds with either `EXPORTSUPPORTED-SUCCESS` or
+ `EXPORTSUPPORTED-FAILURE`
* `EXPORT Name`
Comes immediately before each of the following requests,
specifying the name of the exported file. It will be in the form
diff --git a/git-annex.cabal b/git-annex.cabal
index a7d062857..178531de0 100644
--- a/git-annex.cabal
+++ b/git-annex.cabal
@@ -902,6 +902,7 @@ Executable git-annex
Remote.Helper.Chunked
Remote.Helper.Chunked.Legacy
Remote.Helper.Encryptable
+ Remote.Helper.Export
Remote.Helper.Git
Remote.Helper.Hooks
Remote.Helper.Http
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-16 06:31:22 +0000