diff --git a/Annex/Import.hs b/Annex/Import.hs index 7c59f9a5ec..c5a16f3d86 100644 --- a/Annex/Import.hs +++ b/Annex/Import.hs @@ -12,6 +12,7 @@ module Annex.Import ( ImportCommitConfig(..), buildImportCommit, buildImportTrees, + recordImportTree, canImportKeys, importKeys, makeImportMatcher, @@ -104,6 +105,28 @@ buildImportCommit remote importtreeconfig importcommitconfig importable = Just trackingcommit -> inRepo (Git.Ref.tree trackingcommit) >>= \case Nothing -> go Nothing Just _ -> go (Just trackingcommit) + where + go trackingcommit = do + (imported, updatestate) <- recordImportTree remote importtreeconfig importable + buildImportCommit' remote importcommitconfig trackingcommit imported >>= \case + Just finalcommit -> do + updatestate + return (Just finalcommit) + Nothing -> return Nothing + +{- Builds a tree for an import from a special remote. + - + - Also returns an action that can be used to update + - all the other state to record the import. + -} +recordImportTree + :: Remote + -> ImportTreeConfig + -> ImportableContents (Either Sha Key) + -> Annex (History Sha, Annex ()) +recordImportTree remote importtreeconfig importable = do + imported@(History finaltree _) <- buildImportTrees basetree subdir importable + return (imported, updatestate finaltree) where basetree = case importtreeconfig of ImportTree -> emptyTree @@ -112,21 +135,12 @@ buildImportCommit remote importtreeconfig importcommitconfig importable = ImportTree -> Nothing ImportSubTree dir _ -> Just dir - go trackingcommit = do - imported@(History finaltree _) <- - buildImportTrees basetree subdir importable - buildImportCommit' remote importcommitconfig trackingcommit imported >>= \case - Just finalcommit -> do - updatestate finaltree - return (Just finalcommit) - Nothing -> return Nothing - - updatestate committedtree = do + updatestate finaltree = do importedtree <- case subdir of - Nothing -> pure committedtree + Nothing -> pure finaltree Just dir -> let subtreeref = Ref $ - fromRef' committedtree + fromRef' finaltree <> ":" <> getTopFilePath dir in fromMaybe emptyTree @@ -308,9 +322,10 @@ importKeys :: Remote -> ImportTreeConfig -> Bool + -> Bool -> ImportableContents (ContentIdentifier, ByteSize) -> Annex (Maybe (ImportableContents (Either Sha Key))) -importKeys remote importtreeconfig importcontent importablecontents = do +importKeys remote importtreeconfig importcontent ignorelargefilesconfig importablecontents = do unless (canImportKeys remote importcontent) $ giveup "This remote does not support importing without downloading content." -- This map is used to remember content identifiers that @@ -400,7 +415,7 @@ importKeys remote importtreeconfig importcontent importablecontents = do let act = if importcontent then case Remote.importKey ia of Nothing -> dodownload - Just _ -> if Utility.Matcher.introspect matchNeedsFileContent matcher + Just _ -> if not ignorelargefilesconfig && Utility.Matcher.introspect matchNeedsFileContent matcher then dodownload else doimport else doimport @@ -410,7 +425,7 @@ importKeys remote importtreeconfig importcontent importablecontents = do case Remote.importKey ia of Nothing -> error "internal" -- checked earlier Just importkey -> do - when (Utility.Matcher.introspect matchNeedsFileContent matcher) $ + when (not ignorelargefilesconfig && Utility.Matcher.introspect matchNeedsFileContent matcher) $ giveup "annex.largefiles configuration examines file contents, so cannot import without content." let mi = MatchingInfo ProvidedInfo { providedFilePath = f @@ -419,7 +434,9 @@ importKeys remote importtreeconfig importcontent importablecontents = do , providedMimeType = Nothing , providedMimeEncoding = Nothing } - islargefile <- checkMatcher' matcher mi mempty + islargefile <- if ignorelargefilesconfig + then pure True + else checkMatcher' matcher mi mempty metered Nothing sz $ const $ if islargefile then doimportlarge importkey cidmap db loc cid sz f else doimportsmall cidmap db loc cid sz @@ -433,24 +450,26 @@ importKeys remote importtreeconfig importcontent importablecontents = do return Nothing where importer = do - unsizedk <- importkey loc cid - -- Don't display progress when generating - -- key, if the content will later be - -- downloaded, which is a more expensive - -- operation generally. - (if importcontent then nullMeterUpdate else p) - -- This avoids every remote needing - -- to add the size. - let k = alterKey unsizedk $ \kd -> kd - { keySize = keySize kd <|> Just sz } - checkSecureHashes k >>= \case - Nothing -> do - recordcidkey cidmap db cid k - logChange k (Remote.uuid remote) InfoPresent - if importcontent - then getcontent k - else return (Just (k, True)) - Just msg -> giveup (msg ++ " to import") + -- Don't display progress when generating + -- key, if the content will later be + -- downloaded, which is a more expensive + -- operation generally. + let p' = if importcontent then nullMeterUpdate else p + importkey loc cid p' >>= \case + Nothing -> return Nothing + Just unsizedk -> do + -- This avoids every remote needing + -- to add the size. + let k = alterKey unsizedk $ \kd -> kd + { keySize = keySize kd <|> Just sz } + checkSecureHashes k >>= \case + Nothing -> do + recordcidkey cidmap db cid k + logChange k (Remote.uuid remote) InfoPresent + if importcontent + then getcontent k + else return (Just (k, True)) + Just msg -> giveup (msg ++ " to import") getcontent :: Key -> Annex (Maybe (Key, Bool)) getcontent k = do @@ -533,7 +552,9 @@ importKeys remote importtreeconfig importcontent importablecontents = do , contentFile = Just tmpfile , matchKey = Nothing } - islargefile <- checkMatcher' matcher mi mempty + islargefile <- if ignorelargefilesconfig + then pure True + else checkMatcher' matcher mi mempty if islargefile then do backend <- chooseBackend f diff --git a/Command/Import.hs b/Command/Import.hs index fd788438f4..f383fd843f 100644 --- a/Command/Import.hs +++ b/Command/Import.hs @@ -306,7 +306,7 @@ seekRemote remote branch msubdir importcontent ci = do void $ includeCommandAction (listContents remote importtreeconfig ci importabletvar) liftIO (atomically (readTVar importabletvar)) >>= \case Nothing -> return () - Just importable -> importKeys remote importtreeconfig importcontent importable >>= \case + Just importable -> importKeys remote importtreeconfig importcontent False importable >>= \case Nothing -> warning $ concat [ "Failed to import some files from " , Remote.name remote diff --git a/Command/Sync.hs b/Command/Sync.hs index 1f1afc9c13..bb938fe42a 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -67,7 +67,7 @@ import Annex.UpdateInstead import Annex.Export import Annex.TaggedPush import Annex.CurrentBranch -import Annex.Import (canImportKeys) +import Annex.Import import Annex.CheckIgnore import Types.FileMatcher import qualified Database.Export as Export @@ -77,6 +77,7 @@ import Utility.Process.Transcript import Utility.Tuple import Control.Concurrent.MVar +import Control.Concurrent.STM import qualified Data.Map as M import qualified Data.ByteString as S import Data.Char @@ -463,6 +464,9 @@ pullRemote o mergeconfig remote branch = stopUnless (pure $ pullOption o && want importRemote :: Bool -> SyncOptions -> [Git.Merge.MergeConfig] -> Remote -> CurrBranch -> CommandSeek importRemote importcontent o mergeconfig remote currbranch | not (pullOption o) || not wantpull = noop + | Remote.thirdPartyPopulated (Remote.remotetype remote) = + when (canImportKeys remote importcontent) $ + importThirdPartyPopulated remote | otherwise = case remoteAnnexTrackingBranch (Remote.gitconfig remote) of Nothing -> noop Just tb -> do @@ -479,6 +483,34 @@ importRemote importcontent o mergeconfig remote currbranch where wantpull = remoteAnnexPull (Remote.gitconfig remote) +{- Import from a remote that is populated by a third party, by listing + - the contents of the remote, and then adding only the files on it that + - importKey identifies to a tree. The tree is only used to keep track + - of where keys are located on the remote, no remote tracking branch is + - updated, because the filenames are the names of annex object files, + - not suitable for a tracking branch. Does not transfer any content. -} +importThirdPartyPopulated :: Remote -> CommandSeek +importThirdPartyPopulated remote = do + importabletvar <- liftIO $ newTVarIO Nothing + void $ includeCommandAction (Command.Import.listContents remote ImportTree (CheckGitIgnore False) importabletvar) + liftIO (atomically (readTVar importabletvar)) >>= \case + Nothing -> return () + Just importable -> + importKeys remote ImportTree False False importable >>= \case + Just importablekeys -> go importablekeys + Nothing -> warning $ concat + [ "Failed to import from" + , Remote.name remote + ] + where + go importablekeys = void $ includeCommandAction $ starting "pull" ai si $ do + (_imported, updatestate) <- recordImportTree remote ImportTree importablekeys + next $ do + updatestate + return True + ai = ActionItemOther (Just (Remote.name remote)) + si = SeekInput [] + {- The remote probably has both a master and a synced/master branch. - Which to merge from? Well, the master has whatever latest changes - were committed (or pushed changes, if this is a bare remote), diff --git a/Remote/Adb.hs b/Remote/Adb.hs index de5b62d030..82459c8599 100644 --- a/Remote/Adb.hs +++ b/Remote/Adb.hs @@ -46,6 +46,7 @@ remote = specialRemoteType $ RemoteType , setup = adbSetup , exportSupported = exportIsSupported , importSupported = importIsSupported + , thirdPartyPopulated = False } androiddirectoryField :: RemoteConfigField diff --git a/Remote/BitTorrent.hs b/Remote/BitTorrent.hs index a60b58506c..61e660270a 100644 --- a/Remote/BitTorrent.hs +++ b/Remote/BitTorrent.hs @@ -49,6 +49,7 @@ remote = RemoteType , setup = error "not supported" , exportSupported = exportUnsupported , importSupported = importUnsupported + , thirdPartyPopulated = False } -- There is only one bittorrent remote, and it always exists. diff --git a/Remote/Bup.hs b/Remote/Bup.hs index f87888b688..8950ac4670 100644 --- a/Remote/Bup.hs +++ b/Remote/Bup.hs @@ -50,6 +50,7 @@ remote = specialRemoteType $ RemoteType , setup = bupSetup , exportSupported = exportUnsupported , importSupported = importUnsupported + , thirdPartyPopulated = False } buprepoField :: RemoteConfigField diff --git a/Remote/Ddar.hs b/Remote/Ddar.hs index 514b978474..4c544d28cd 100644 --- a/Remote/Ddar.hs +++ b/Remote/Ddar.hs @@ -45,6 +45,7 @@ remote = specialRemoteType $ RemoteType , setup = ddarSetup , exportSupported = exportUnsupported , importSupported = importUnsupported + , thirdPartyPopulated = False } ddarrepoField :: RemoteConfigField diff --git a/Remote/Directory.hs b/Remote/Directory.hs index 4be5850bb5..fd3072c14f 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -56,6 +56,7 @@ remote = specialRemoteType $ RemoteType , setup = directorySetup , exportSupported = exportIsSupported , importSupported = importIsSupported + , thirdPartyPopulated = False } directoryField :: RemoteConfigField @@ -369,13 +370,13 @@ guardSameContentIdentifiers cont old new | new == Just old = cont | otherwise = giveup "file content has changed" -importKeyM :: RawFilePath -> ExportLocation -> ContentIdentifier -> MeterUpdate -> Annex Key +importKeyM :: RawFilePath -> ExportLocation -> ContentIdentifier -> MeterUpdate -> Annex (Maybe Key) importKeyM dir loc cid p = do backend <- chooseBackend f k <- fst <$> genKey ks p backend currcid <- liftIO $ mkContentIdentifier absf =<< R.getFileStatus absf - guardSameContentIdentifiers (return k) cid currcid + guardSameContentIdentifiers (return (Just k)) cid currcid where f = fromExportLocation loc absf = dir P. f diff --git a/Remote/External.hs b/Remote/External.hs index 255c5e2456..4921bb5027 100644 --- a/Remote/External.hs +++ b/Remote/External.hs @@ -53,6 +53,7 @@ remote = specialRemoteType $ RemoteType , setup = externalSetup , exportSupported = checkExportSupported , importSupported = importUnsupported + , thirdPartyPopulated = False } externaltypeField :: RemoteConfigField diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs index 73c5b7b50c..af1ddc712f 100644 --- a/Remote/GCrypt.hs +++ b/Remote/GCrypt.hs @@ -78,6 +78,7 @@ remote = specialRemoteType $ RemoteType , setup = gCryptSetup , exportSupported = exportUnsupported , importSupported = importUnsupported + , thirdPartyPopulated = False } gitRepoField :: RemoteConfigField diff --git a/Remote/Git.hs b/Remote/Git.hs index f9e0711401..62751a5607 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -87,6 +87,7 @@ remote = RemoteType , setup = gitSetup , exportSupported = exportUnsupported , importSupported = importUnsupported + , thirdPartyPopulated = False } locationField :: RemoteConfigField diff --git a/Remote/GitLFS.hs b/Remote/GitLFS.hs index d2c749359f..f9cf7f7512 100644 --- a/Remote/GitLFS.hs +++ b/Remote/GitLFS.hs @@ -74,6 +74,7 @@ remote = specialRemoteType $ RemoteType , setup = mySetup , exportSupported = exportUnsupported , importSupported = importUnsupported + , thirdPartyPopulated = False } urlField :: RemoteConfigField diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs index a5420d9987..d4b2365226 100644 --- a/Remote/Glacier.hs +++ b/Remote/Glacier.hs @@ -48,6 +48,7 @@ remote = specialRemoteType $ RemoteType , setup = glacierSetup , exportSupported = exportUnsupported , importSupported = importUnsupported + , thirdPartyPopulated = False } datacenterField :: RemoteConfigField diff --git a/Remote/Helper/ExportImport.hs b/Remote/Helper/ExportImport.hs index b8d6390e4a..985cca4084 100644 --- a/Remote/Helper/ExportImport.hs +++ b/Remote/Helper/ExportImport.hs @@ -72,7 +72,7 @@ importIsSupported :: ParsedRemoteConfig -> RemoteGitConfig -> Annex Bool importIsSupported = \_ _ -> return True -- | Prevent or allow exporttree=yes and importtree=yes when --- setting up a new remote, depending on exportSupported and importSupported. +-- setting up a new remote, depending on the remote's capabilities. adjustExportImportRemoteType :: RemoteType -> RemoteType adjustExportImportRemoteType rt = rt { setup = setup' } where @@ -80,7 +80,7 @@ adjustExportImportRemoteType rt = rt { setup = setup' } pc <- either giveup return . parseRemoteConfig c =<< configParser rt c let checkconfig supported configured configfield cont = - ifM (supported rt pc gc) + ifM (supported rt pc gc <&&> pure (not (thirdPartyPopulated rt))) ( case st of Init | configured pc && encryptionIsEnabled pc -> @@ -102,35 +102,40 @@ adjustExportImportRemoteType rt = rt { setup = setup' } -- | Adjust a remote to support exporttree=yes and/or importree=yes. adjustExportImport :: Remote -> RemoteStateHandle -> Annex Remote adjustExportImport r rs = do - isexporttree <- pure (exportTree (config r)) <&&> isexporttreeSupported r - isimporttree <- pure (importTree (config r)) <&&> isimporttreeSupported r + isexport <- pure (exportTree (config r)) + <&&> isExportSupported r + -- When thirdPartyPopulated is True, the remote + -- does not need to be configured with importTree to support + -- imports. + isimport <- pure (importTree (config r) || not (thirdPartyPopulated (remotetype r))) + <&&> isImportSupported r let r' = r { remotetype = (remotetype r) - { exportSupported = if isexporttree + { exportSupported = if isexport then exportSupported (remotetype r) else exportUnsupported - , importSupported = if isimporttree + , importSupported = if isimport then importSupported (remotetype r) else importUnsupported } } - if not isexporttree && not isimporttree + if not isexport && not isimport then return r' - else adjustExportImport' isexporttree isimporttree r' rs + else adjustExportImport' isexport isimport r' rs adjustExportImport' :: Bool -> Bool -> Remote -> RemoteStateHandle -> Annex Remote -adjustExportImport' isexporttree isimporttree r rs = do +adjustExportImport' isexport isimport r rs = do dbv <- prepdbv ciddbv <- prepciddb - let normal = not isexporttree && not isimporttree + let normal = not isexport && not isimport let iskeyvaluestore = normal || appendonly r return $ r - { exportActions = if isexporttree - then if isimporttree + { exportActions = if isexport + then if isimport then exportActionsForImport dbv ciddbv (exportActions r) else exportActions r else exportUnsupported - , importActions = if isimporttree + , importActions = if isimport then importActions r else importUnsupported , storeKey = \k af p -> @@ -139,11 +144,13 @@ adjustExportImport' isexporttree isimporttree r rs = do -- when another repository has already stored the -- key, and the local repository does not know -- about it. To avoid unnecessary costs, don't do it. - if isexporttree - then giveup "remote is configured with exporttree=yes; use `git-annex export` to store content on it" - else if isimporttree - then giveup "remote is configured with importtree=yes and without exporttree=yes; cannot modify content stored on it" - else storeKey r k af p + if mergeable + then if isexport + then giveup "remote is configured with exporttree=yes; use `git-annex export` to store content on it" + else if isimport + then giveup "remote is configured with importtree=yes and without exporttree=yes; cannot modify content stored on it" + else storeKey r k af p + else storeKey r k af p , removeKey = \k -> -- Removing a key from an export would need to -- change the tree in the export log to not include @@ -151,19 +158,21 @@ adjustExportImport' isexporttree isimporttree r rs = do -- files would not be dealt with correctly. -- There does not seem to be a good use case for -- removing a key from an export in any case. - if isexporttree - then giveup "dropping content from an export is not supported; use `git annex export` to export a tree that lacks the files you want to remove" - else if isimporttree - then giveup "dropping content from this remote is not supported because it is configured with importtree=yes" - else removeKey r k - , lockContent = if iskeyvaluestore + if mergeable + then if isexport + then giveup "dropping content from an export is not supported; use `git annex export` to export a tree that lacks the files you want to remove" + else if isimport + then giveup "dropping content from this remote is not supported because it is configured with importtree=yes" + else removeKey r k + else removeKey r k + , lockContent = if iskeyvaluestore || not mergeable then lockContent r else Nothing , retrieveKeyFile = \k af dest p -> - if isimporttree + if isimport then supportappendonlyretrieve k af dest p $ retrieveKeyFileFromImport dbv ciddbv k af dest p - else if isexporttree + else if isexport then supportappendonlyretrieve k af dest p $ retrieveKeyFileFromExport dbv k af dest p else retrieveKeyFile r k af dest p @@ -172,16 +181,19 @@ adjustExportImport' isexporttree isimporttree r rs = do else Nothing , checkPresent = \k -> if appendonly r then checkPresent r k - else if isimporttree + else if isimport then anyM (checkPresentImport ciddbv k) =<< getexportlocs dbv k - else if isexporttree + else if isexport -- Check if any of the files a key -- was exported to are present. This -- doesn't guarantee the export -- contains the right content, - -- which is why export remotes - -- are untrusted. + -- if the remote is an export, + -- or if something else can write + -- to it. Remotes that have such + -- problems are made untrusted, + -- so it's not worried about here. then anyM (checkPresentExport (exportActions r) k) =<< getexportlocs dbv k else checkPresent r k @@ -201,17 +213,23 @@ adjustExportImport' isexporttree isimporttree r rs = do else return Nothing , getInfo = do is <- getInfo r - is' <- if isexporttree + is' <- if isexport && not mergeable then do ts <- map fromRef . exportedTreeishes <$> getExport (uuid r) return (is++[("exporttree", "yes"), ("exportedtree", unwords ts)]) else return is - return $ if isimporttree + return $ if isimport && not mergeable then (is'++[("importtree", "yes")]) else is' } where + -- When a remote is populated by a third party, a tree can be + -- imported from it, but that tree is not mergeable into the + -- user's own git branch. But annex objects found in the tree + -- (identified by importKey) can still be retrieved from the remote. + mergeable = thirdPartyPopulated (remotetype r) + -- exportActions adjusted to use the equivilant import actions, -- which take ContentIdentifiers into account. exportActionsForImport dbv ciddbv ea = ea diff --git a/Remote/Hook.hs b/Remote/Hook.hs index cc0ead39e7..89611113b7 100644 --- a/Remote/Hook.hs +++ b/Remote/Hook.hs @@ -40,6 +40,7 @@ remote = specialRemoteType $ RemoteType , setup = hookSetup , exportSupported = exportUnsupported , importSupported = importUnsupported + , thirdPartyPopulated = False } hooktypeField :: RemoteConfigField diff --git a/Remote/HttpAlso.hs b/Remote/HttpAlso.hs index 9411f3a842..7beb52426a 100644 --- a/Remote/HttpAlso.hs +++ b/Remote/HttpAlso.hs @@ -41,6 +41,7 @@ remote = RemoteType , setup = httpAlsoSetup , exportSupported = exportIsSupported , importSupported = importUnsupported + , thirdPartyPopulated = False } urlField :: RemoteConfigField diff --git a/Remote/P2P.hs b/Remote/P2P.hs index 5016c9f059..859205bfcc 100644 --- a/Remote/P2P.hs +++ b/Remote/P2P.hs @@ -41,6 +41,7 @@ remote = RemoteType , setup = error "P2P remotes are set up using git-annex p2p" , exportSupported = exportUnsupported , importSupported = importUnsupported + , thirdPartyPopulated = False } chainGen :: P2PAddress -> Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote) diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs index 813c0f1bbd..7627fbd2c6 100644 --- a/Remote/Rsync.hs +++ b/Remote/Rsync.hs @@ -60,6 +60,7 @@ remote = specialRemoteType $ RemoteType , setup = rsyncSetup , exportSupported = exportIsSupported , importSupported = importUnsupported + , thirdPartyPopulated = False } shellEscapeField :: RemoteConfigField diff --git a/Remote/S3.hs b/Remote/S3.hs index b35a62186e..661e0ab7fa 100644 --- a/Remote/S3.hs +++ b/Remote/S3.hs @@ -118,6 +118,7 @@ remote = specialRemoteType $ RemoteType , setup = s3Setup , exportSupported = exportIsSupported , importSupported = importIsSupported + , thirdPartyPopulated = False } bucketField :: RemoteConfigField diff --git a/Remote/Tahoe.hs b/Remote/Tahoe.hs index 72df4c70e8..3fbae0df9b 100644 --- a/Remote/Tahoe.hs +++ b/Remote/Tahoe.hs @@ -67,6 +67,7 @@ remote = specialRemoteType $ RemoteType , setup = tahoeSetup , exportSupported = exportUnsupported , importSupported = importUnsupported + , thirdPartyPopulated = False } scsField :: RemoteConfigField diff --git a/Remote/Web.hs b/Remote/Web.hs index bbe24b38fc..f5de143c27 100644 --- a/Remote/Web.hs +++ b/Remote/Web.hs @@ -32,6 +32,7 @@ remote = RemoteType , setup = error "not supported" , exportSupported = exportUnsupported , importSupported = importUnsupported + , thirdPartyPopulated = False } -- There is only one web remote, and it always exists. diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs index b649ae0444..5163942b47 100644 --- a/Remote/WebDAV.hs +++ b/Remote/WebDAV.hs @@ -57,6 +57,7 @@ remote = specialRemoteType $ RemoteType , setup = webdavSetup , exportSupported = exportIsSupported , importSupported = importUnsupported + , thirdPartyPopulated = False } urlField :: RemoteConfigField diff --git a/Types/Remote.hs b/Types/Remote.hs index 7b5f1ac0e5..e04ff8d938 100644 --- a/Types/Remote.hs +++ b/Types/Remote.hs @@ -63,10 +63,15 @@ data RemoteTypeA a = RemoteType , configParser :: RemoteConfig -> a RemoteConfigParser -- initializes or enables a remote , setup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> a (RemoteConfig, UUID) - -- check if a remote of this type is able to support export of trees + -- check if a remote of this type is able to support export , exportSupported :: ParsedRemoteConfig -> RemoteGitConfig -> a Bool - -- check if a remote of this type is able to support import of trees + -- check if a remote of this type is able to support import , importSupported :: ParsedRemoteConfig -> RemoteGitConfig -> a Bool + -- is a remote of this type not a usual key/value store, + -- or export/import of a tree of files, but instead a collection + -- of files, populated by something outside git-annex, some of + -- which may be annex objects? + , thirdPartyPopulated :: Bool } instance Eq (RemoteTypeA a) where @@ -113,9 +118,9 @@ data RemoteA a = Remote -- Some remotes can checkPresent without an expensive network -- operation. , checkPresentCheap :: Bool - -- Some remotes support export of trees of files. + -- Some remotes support export. , exportActions :: ExportActions a - -- Some remotes support import of trees of files. + -- Some remotes support import. , importActions :: ImportActions a -- Some remotes can provide additional details for whereis. , whereisKey :: Maybe (Key -> a [String]) @@ -288,8 +293,13 @@ data ImportActions a = ImportActions -- bearing in mind that the file on the remote may have changed -- since the ContentIdentifier was generated. -- - -- Throws exception on failure. - , importKey :: Maybe (ImportLocation -> ContentIdentifier -> MeterUpdate -> a Key) + -- When the remote is thirdPartyPopulated, this should check if the + -- file stored on the remote is the content of an annex object, + -- and return its Key, or Nothing if it is not. Should not + -- otherwise return Nothing. + -- + -- Throws exception on failure to access the remote. + , importKey :: Maybe (ImportLocation -> ContentIdentifier -> MeterUpdate -> a (Maybe Key)) -- Retrieves a file from the remote. Ensures that the file -- it retrieves has the requested ContentIdentifier. --