aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Annex/Export.hs35
-rw-r--r--Command/Export.hs72
-rw-r--r--Database/Export.hs127
-rw-r--r--Database/Types.hs21
-rw-r--r--Remote/Directory.hs6
-rw-r--r--Remote/External/Types.hs8
-rw-r--r--Remote/Helper/Export.hs12
-rw-r--r--Remote/S3.hs2
-rw-r--r--Remote/WebDAV.hs4
-rw-r--r--Remote/WebDAV/DavLocation.hs2
-rw-r--r--Types/Export.hs26
-rw-r--r--doc/todo/export.mdwn24
-rw-r--r--git-annex.cabal1
13 files changed, 247 insertions, 93 deletions
diff --git a/Annex/Export.hs b/Annex/Export.hs
new file mode 100644
index 000000000..0afe3cdcc
--- /dev/null
+++ b/Annex/Export.hs
@@ -0,0 +1,35 @@
+{- git-annex exports
+ -
+ - Copyright 2017 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Annex.Export where
+
+import Annex
+import Annex.CatFile
+import Types.Key
+import qualified Git
+
+-- An export includes both annexed files and files stored in git.
+-- For the latter, a SHA1 key is synthesized.
+data ExportKey = AnnexKey Key | GitKey Key
+ deriving (Show, Eq, Ord)
+
+asKey :: ExportKey -> Key
+asKey (AnnexKey k) = k
+asKey (GitKey k) = k
+
+exportKey :: Git.Sha -> Annex ExportKey
+exportKey sha = mk <$> catKey sha
+ where
+ mk (Just k) = AnnexKey k
+ mk Nothing = GitKey $ Key
+ { keyName = show sha
+ , keyVariety = SHA1Key (HasExt False)
+ , keySize = Nothing
+ , keyMtime = Nothing
+ , keyChunkSize = Nothing
+ , keyChunkNum = Nothing
+ }
diff --git a/Command/Export.hs b/Command/Export.hs
index a9f474a19..f898c9e0d 100644
--- a/Command/Export.hs
+++ b/Command/Export.hs
@@ -21,6 +21,7 @@ import Git.Sha
import Types.Key
import Types.Remote
import Types.Export
+import Annex.Export
import Annex.Content
import Annex.CatFile
import Annex.LockFile
@@ -53,28 +54,6 @@ optParser _ = ExportOptions
( metavar paramTreeish
)
--- An export includes both annexed files and files stored in git.
--- For the latter, a SHA1 key is synthesized.
-data ExportKey = AnnexKey Key | GitKey Key
- deriving (Show, Eq, Ord)
-
-asKey :: ExportKey -> Key
-asKey (AnnexKey k) = k
-asKey (GitKey k) = k
-
-exportKey :: Git.Sha -> Annex ExportKey
-exportKey sha = mk <$> catKey sha
- where
- mk (Just k) = AnnexKey k
- mk Nothing = GitKey $ Key
- { keyName = show sha
- , keyVariety = SHA1Key (HasExt False)
- , keySize = Nothing
- , keyMtime = Nothing
- , keyChunkSize = Nothing
- , keyChunkNum = Nothing
- }
-
-- To handle renames which swap files, the exported file is first renamed
-- to a stable temporary name based on the key.
exportTempName :: ExportKey -> ExportLocation
@@ -153,7 +132,8 @@ seek' o r = do
-- if this export is interrupted, there are no files left over
-- from a previous export, that are not part of this export.
c <- Annex.getState Annex.errcounter
- when (c == 0) $
+ when (c == 0) $ do
+ liftIO $ recordDataSource db new
recordExport (uuid r) $ ExportChange
{ oldTreeish = map exportedTreeish old
, newTreeish = new
@@ -184,24 +164,24 @@ mkDiffMap old new = do
where
combinedm (srca, dsta) (srcb, dstb) = (srca <|> srcb, dsta <|> dstb)
mkdm i = do
- srcek <- getk (Git.DiffTree.srcsha i)
- dstek <- getk (Git.DiffTree.dstsha i)
+ srcek <- getek (Git.DiffTree.srcsha i)
+ dstek <- getek (Git.DiffTree.dstsha i)
return $ catMaybes
[ (, (Just (Git.DiffTree.file i), Nothing)) <$> srcek
, (, (Nothing, Just (Git.DiffTree.file i))) <$> dstek
]
- getk sha
+ getek sha
| sha == nullSha = return Nothing
| otherwise = Just <$> exportKey sha
startExport :: Remote -> ExportActions Annex -> ExportHandle -> Git.LsTree.TreeItem -> CommandStart
startExport r ea db ti = do
ek <- exportKey (Git.LsTree.sha ti)
- stopUnless (liftIO $ notElem loc <$> getExportLocation db (asKey ek)) $ do
+ stopUnless (liftIO $ notElem loc <$> getExportedLocation db (asKey ek)) $ do
showStart "export" f
next $ performExport r ea db ek (Git.LsTree.sha ti) loc
where
- loc = ExportLocation $ toInternalGitPath f
+ loc = mkExportLocation f
f = getTopFilePath $ Git.LsTree.file ti
performExport :: Remote -> ExportActions Annex -> ExportHandle -> ExportKey -> Sha -> ExportLocation -> CommandPerform
@@ -231,7 +211,7 @@ performExport r ea db ek contentsha loc = do
cleanupExport :: Remote -> ExportHandle -> ExportKey -> ExportLocation -> CommandCleanup
cleanupExport r db ek loc = do
- liftIO $ addExportLocation db (asKey ek) loc
+ liftIO $ addExportedLocation db (asKey ek) loc
logChange (asKey ek) (uuid r) InfoPresent
return True
@@ -244,7 +224,7 @@ startUnexport r ea db f shas = do
showStart "unexport" f'
next $ performUnexport r ea db eks loc
where
- loc = ExportLocation $ toInternalGitPath f'
+ loc = mkExportLocation f'
f' = getTopFilePath f
startUnexport' :: Remote -> ExportActions Annex -> ExportHandle -> TopFilePath -> ExportKey -> CommandStart
@@ -252,7 +232,7 @@ startUnexport' r ea db f ek = do
showStart "unexport" f'
next $ performUnexport r ea db [ek] loc
where
- loc = ExportLocation $ toInternalGitPath f'
+ loc = mkExportLocation f'
f' = getTopFilePath f
performUnexport :: Remote -> ExportActions Annex -> ExportHandle -> [ExportKey] -> ExportLocation -> CommandPerform
@@ -266,11 +246,11 @@ cleanupUnexport :: Remote -> ExportActions Annex -> ExportHandle -> [ExportKey]
cleanupUnexport r ea db eks loc = do
liftIO $ do
forM_ eks $ \ek ->
- removeExportLocation db (asKey ek) loc
+ removeExportedLocation db (asKey ek) loc
flushDbQueue db
remaininglocs <- liftIO $
- concat <$> forM eks (\ek -> getExportLocation db (asKey ek))
+ concat <$> forM eks (\ek -> getExportedLocation db (asKey ek))
when (null remaininglocs) $
forM_ eks $ \ek ->
logChange (asKey ek) (uuid r) InfoMissing
@@ -282,31 +262,31 @@ startRecoverIncomplete r ea db sha oldf
| sha == nullSha = stop
| otherwise = do
ek <- exportKey sha
- let loc@(ExportLocation f) = exportTempName ek
- showStart "unexport" f
- liftIO $ removeExportLocation db (asKey ek) oldloc
+ let loc = exportTempName ek
+ showStart "unexport" (fromExportLocation f)
+ liftIO $ removeExportedLocation db (asKey ek) oldloc
next $ performUnexport r ea db [ek] loc
where
- oldloc = ExportLocation $ toInternalGitPath oldf'
+ oldloc = mkExportLocation oldf'
oldf' = getTopFilePath oldf
startMoveToTempName :: Remote -> ExportActions Annex -> ExportHandle -> TopFilePath -> ExportKey -> CommandStart
startMoveToTempName r ea db f ek = do
- let tmploc@(ExportLocation tmpf) = exportTempName ek
- showStart "rename" (f' ++ " -> " ++ tmpf)
+ showStart "rename" (f' ++ " -> " ++ fromExportLocation tmploc)
next $ performRename r ea db ek loc tmploc
where
- loc = ExportLocation $ toInternalGitPath f'
+ loc = mkExportLocation f'
f' = getTopFilePath f
+ tmploc = exportTempName ek
startMoveFromTempName :: Remote -> ExportActions Annex -> ExportHandle -> ExportKey -> TopFilePath -> CommandStart
startMoveFromTempName r ea db ek f = do
- let tmploc@(ExportLocation tmpf) = exportTempName ek
- stopUnless (liftIO $ elem tmploc <$> getExportLocation db (asKey ek)) $ do
- showStart "rename" (tmpf ++ " -> " ++ f')
+ let tmploc = exportTempName ek
+ stopUnless (liftIO $ elem tmploc <$> getExportedLocation db (asKey ek)) $ do
+ showStart "rename" (exportLocation tmploc ++ " -> " ++ f')
next $ performRename r ea db ek tmploc loc
where
- loc = ExportLocation $ toInternalGitPath f'
+ loc = mkExportLocation f'
f' = getTopFilePath f
performRename :: Remote -> ExportActions Annex -> ExportHandle -> ExportKey -> ExportLocation -> ExportLocation -> CommandPerform
@@ -323,8 +303,8 @@ performRename r ea db ek src dest = do
cleanupRename :: ExportActions Annex -> ExportHandle -> ExportKey -> ExportLocation -> ExportLocation -> CommandCleanup
cleanupRename ea db ek src dest = do
liftIO $ do
- removeExportLocation db (asKey ek) src
- addExportLocation db (asKey ek) dest
+ removeExportedLocation db (asKey ek) src
+ addExportedLocation db (asKey ek) dest
flushDbQueue db
if exportDirectories src /= exportDirectories dest
then removeEmptyDirectories ea db src [asKey ek]
diff --git a/Database/Export.hs b/Database/Export.hs
index df3d92300..7dae408fa 100644
--- a/Database/Export.hs
+++ b/Database/Export.hs
@@ -14,13 +14,19 @@ module Database.Export (
ExportHandle,
openDb,
closeDb,
- addExportLocation,
- removeExportLocation,
flushDbQueue,
- getExportLocation,
+ recordDataSource,
+ getDataSource,
+ addExportedLocation,
+ removeExportedLocation,
+ getExportedLocation,
isExportDirectoryEmpty,
+ getExportTree,
+ updateExportTree,
ExportedId,
+ ExportTreeId,
ExportedDirectoryId,
+ DataSourceId,
) where
import Database.Types
@@ -29,6 +35,11 @@ import Database.Init
import Annex.Locations
import Annex.Common hiding (delete)
import Types.Export
+import Annex.Export
+import Git.Types
+import Git.Sha
+import Git.FilePath
+import qualified Git.DiffTree
import Database.Persist.TH
import Database.Esqueleto hiding (Key)
@@ -36,14 +47,26 @@ import Database.Esqueleto hiding (Key)
newtype ExportHandle = ExportHandle H.DbQueue
share [mkPersist sqlSettings, mkMigrate "migrateExport"] [persistLowerCase|
+-- Files that have been exported to the remote.
Exported
key IKey
file SFilePath
- KeyFileIndex key file
+ ExportedIndex key file
+-- The tree that has been exported to the remote.
+-- Not all of these files are necessarily present on the remote yet.
+ExportTree
+ key IKey
+ file SFilePath
+ ExportTreeIndex key file
+-- Directories that exist on the remote, and the files that are in them.
ExportedDirectory
subdir SFilePath
file SFilePath
- SubdirFileIndex subdir file
+ ExportedDirectoryIndex subdir file
+-- Record of what tree the current database content comes from.
+DataSource
+ tree SRef
+ UniqueTree tree
|]
{- Opens the database, creating it if it doesn't exist yet. -}
@@ -68,48 +91,110 @@ queueDb (ExportHandle h) = H.queueDb h checkcommit
| sz > 1000 = return True
| otherwise = return False
-addExportLocation :: ExportHandle -> Key -> ExportLocation -> IO ()
-addExportLocation h k el@(ExportLocation f) = queueDb h $ do
+flushDbQueue :: ExportHandle -> IO ()
+flushDbQueue (ExportHandle h) = H.flushDbQueue h
+
+recordDataSource :: ExportHandle -> Sha -> IO ()
+recordDataSource h s = queueDb h $ do
+ delete $ from $ \r -> do
+ where_ (r ^. DataSourceTree ==. r ^. DataSourceTree)
+ void $ insertUnique $ DataSource (toSRef s)
+
+getDataSource :: ExportHandle -> IO (Maybe Sha)
+getDataSource (ExportHandle h) = H.queryDbQueue h $ do
+ l <- select $ from $ \r -> do
+ where_ (r ^. DataSourceTree ==. r ^. DataSourceTree)
+ return (r ^. DataSourceTree)
+ case l of
+ (s:[]) -> return (Just (fromSRef (unValue s)))
+ _ -> return Nothing
+
+addExportedLocation :: ExportHandle -> Key -> ExportLocation -> IO ()
+addExportedLocation h k el = queueDb h $ do
void $ insertUnique $ Exported ik ef
insertMany_ $ map
- (\(ExportDirectory d) -> ExportedDirectory (toSFilePath d) ef)
+ (\ed -> ExportedDirectory (toSFilePath (fromExportDirectory ed)) ef)
(exportDirectories el)
where
ik = toIKey k
- ef = toSFilePath f
+ ef = toSFilePath (fromExportLocation el)
-removeExportLocation :: ExportHandle -> Key -> ExportLocation -> IO ()
-removeExportLocation h k el@(ExportLocation f) = queueDb h $ do
+removeExportedLocation :: ExportHandle -> Key -> ExportLocation -> IO ()
+removeExportedLocation h k el = queueDb h $ do
delete $ from $ \r -> do
where_ (r ^. ExportedKey ==. val ik &&. r ^. ExportedFile ==. val ef)
- let subdirs = map (\(ExportDirectory d) -> toSFilePath d)
+ let subdirs = map (toSFilePath . fromExportDirectory)
(exportDirectories el)
delete $ from $ \r -> do
where_ (r ^. ExportedDirectoryFile ==. val ef
&&. r ^. ExportedDirectorySubdir `in_` valList subdirs)
where
ik = toIKey k
- ef = toSFilePath f
-
-flushDbQueue :: ExportHandle -> IO ()
-flushDbQueue (ExportHandle h) = H.flushDbQueue h
+ ef = toSFilePath (fromExportLocation el)
{- Note that this does not see recently queued changes. -}
-getExportLocation :: ExportHandle -> Key -> IO [ExportLocation]
-getExportLocation (ExportHandle h) k = H.queryDbQueue h $ do
+getExportedLocation :: ExportHandle -> Key -> IO [ExportLocation]
+getExportedLocation (ExportHandle h) k = H.queryDbQueue h $ do
l <- select $ from $ \r -> do
where_ (r ^. ExportedKey ==. val ik)
return (r ^. ExportedFile)
- return $ map (ExportLocation . fromSFilePath . unValue) l
+ return $ map (mkExportLocation . fromSFilePath . unValue) l
where
ik = toIKey k
{- Note that this does not see recently queued changes. -}
isExportDirectoryEmpty :: ExportHandle -> ExportDirectory -> IO Bool
-isExportDirectoryEmpty (ExportHandle h) (ExportDirectory d) = H.queryDbQueue h $ do
+isExportDirectoryEmpty (ExportHandle h) d = H.queryDbQueue h $ do
l <- select $ from $ \r -> do
where_ (r ^. ExportedDirectorySubdir ==. val ed)
return (r ^. ExportedDirectoryFile)
return $ null l
where
- ed = toSFilePath d
+ ed = toSFilePath $ fromExportDirectory d
+
+{- Get locations in the export that might contain a key. -}
+getExportTree :: ExportHandle -> Key -> IO [ExportLocation]
+getExportTree (ExportHandle h) k = H.queryDbQueue h $ do
+ l <- select $ from $ \r -> do
+ where_ (r ^. ExportTreeKey ==. val ik)
+ return (r ^. ExportTreeFile)
+ return $ map (mkExportLocation . fromSFilePath . unValue) l
+ where
+ ik = toIKey k
+
+addExportTree :: ExportHandle -> Key -> ExportLocation -> IO ()
+addExportTree h k loc = queueDb h $
+ void $ insertUnique $ Exported ik ef
+ where
+ ik = toIKey k
+ ef = toSFilePath (fromExportLocation loc)
+
+removeExportTree :: ExportHandle -> Key -> ExportLocation -> IO ()
+removeExportTree h k loc = queueDb h $
+ delete $ from $ \r ->
+ where_ (r ^. ExportTreeKey ==. val ik &&. r ^. ExportTreeFile ==. val ef)
+ where
+ ik = toIKey k
+ ef = toSFilePath (fromExportLocation loc)
+
+{- Diff from the old to the new tree and update the ExportTree table. -}
+updateExportTree :: ExportHandle -> Sha -> Sha -> Annex ()
+updateExportTree h old new = do
+ (diff, cleanup) <- inRepo $
+ Git.DiffTree.diffTreeRecursive old new
+ forM_ diff $ \i -> do
+ let loc = mkExportLocation $ getTopFilePath $
+ Git.DiffTree.file i
+ srcek <- getek (Git.DiffTree.srcsha i)
+ case srcek of
+ Nothing -> return ()
+ Just k -> liftIO $ removeExportTree h (asKey k) loc
+ dstek <- getek (Git.DiffTree.dstsha i)
+ case dstek of
+ Nothing -> return ()
+ Just k -> liftIO $ addExportTree h (asKey k) loc
+ void $ liftIO cleanup
+ where
+ getek sha
+ | sha == nullSha = return Nothing
+ | otherwise = Just <$> exportKey sha
diff --git a/Database/Types.hs b/Database/Types.hs
index a4b5fbcb1..49a63f067 100644
--- a/Database/Types.hs
+++ b/Database/Types.hs
@@ -1,6 +1,6 @@
{- types for SQL databases
-
- - Copyright 2015-2016 Joey Hess <id@joeyh.name>
+ - Copyright 2015-2017 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@@ -16,6 +16,7 @@ import Data.Char
import Utility.PartialPrelude
import Key
import Utility.InodeCache
+import Git.Types (Ref(..))
-- A serialized Key
newtype SKey = SKey String
@@ -93,3 +94,21 @@ fromSFilePath (SFilePath s) = s
derivePersistField "SFilePath"
+-- A serialized Ref
+newtype SRef = SRef Ref
+
+-- Note that Read instance does not work when used in any kind of complex
+-- data structure.
+instance Read SRef where
+ readsPrec _ s = [(SRef (Ref s), "")]
+
+instance Show SRef where
+ show (SRef (Ref s)) = s
+
+derivePersistField "SRef"
+
+toSRef :: Ref -> SRef
+toSRef = SRef
+
+fromSRef :: SRef -> Ref
+fromSRef (SRef r) = r
diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index 2d2daff39..406af0fdc 100644
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -274,14 +274,14 @@ renameExportM d _k oldloc newloc = liftIO $ catchBoolIO $ do
dest = exportPath d newloc
exportPath :: FilePath -> ExportLocation -> FilePath
-exportPath d (ExportLocation loc) = d </> loc
+exportPath d loc = d </> fromExportLocation loc
{- Removes the ExportLocation directory and its parents, so long as
- they're empty, up to but not including the topdir. -}
removeExportLocation :: FilePath -> ExportLocation -> IO ()
-removeExportLocation topdir (ExportLocation loc) = go (Just loc) (Right ())
+removeExportLocation topdir loc = go (Just $ fromExportLocation loc) (Right ())
where
go _ (Left _e) = return ()
go Nothing _ = return ()
go (Just loc') _ = go (upFrom loc')
- =<< tryIO (removeDirectory $ exportPath topdir (ExportLocation loc'))
+ =<< tryIO (removeDirectory $ exportPath topdir (mkExportLocation loc'))
diff --git a/Remote/External/Types.hs b/Remote/External/Types.hs
index 0ddbbaf0a..77f3e837e 100644
--- a/Remote/External/Types.hs
+++ b/Remote/External/Types.hs
@@ -358,9 +358,9 @@ instance Proto.Serializable URI where
deserialize = parseURI
instance Proto.Serializable ExportLocation where
- serialize (ExportLocation loc) = loc
- deserialize = Just . ExportLocation
+ serialize = fromExportLocation
+ deserialize = Just . mkExportLocation
instance Proto.Serializable ExportDirectory where
- serialize (ExportDirectory loc) = loc
- deserialize = Just . ExportDirectory
+ serialize = fromExportDirectory
+ deserialize = Just . mkExportDirectory
diff --git a/Remote/Helper/Export.hs b/Remote/Helper/Export.hs
index df75dacd0..6f4811285 100644
--- a/Remote/Helper/Export.hs
+++ b/Remote/Helper/Export.hs
@@ -93,7 +93,7 @@ adjustExportable r = case M.lookup "exporttree" (config r) of
-- Storing a key on an export would need a way to
-- look up the file(s) that the currently exported
-- tree uses for a key; there's not currently an
- -- inexpensive way to do that (getExportLocation
+ -- inexpensive way to do that (getExportedLocation
-- only finds files that have been stored on the
-- export already).
{ storeKey = \_ _ _ -> do
@@ -105,7 +105,7 @@ adjustExportable r = case M.lookup "exporttree" (config r) of
, retrieveKeyFile = \k _af dest p -> unVerified $
if maybe False (isJust . verifyKeyContent) (maybeLookupBackendVariety (keyVariety k))
then do
- locs <- liftIO $ getExportLocation db k
+ locs <- liftIO $ getExportedLocation db k
case locs of
[] -> do
warning "unknown export location"
@@ -136,7 +136,7 @@ adjustExportable r = case M.lookup "exporttree" (config r) of
, checkPresent = \k -> do
ea <- exportActions r
anyM (checkPresentExport ea k)
- =<< liftIO (getExportLocation db k)
+ =<< liftIO (getExportedLocation db k)
, mkUnavailable = return Nothing
, getInfo = do
is <- getInfo r
@@ -155,10 +155,10 @@ removeEmptyDirectories ea db loc ks
ok <- allM (go removeexportdirectory)
(reverse (exportDirectories loc))
unless ok $ liftIO $ do
- -- Add back to export database, so this is
- -- tried again next time.
+ -- Add location back to export database,
+ -- so this is tried again next time.
forM_ ks $ \k ->
- addExportLocation db k loc
+ addExportedLocation db k loc
flushDbQueue db
return ok
where
diff --git a/Remote/S3.hs b/Remote/S3.hs
index 398ca13b1..52d03ba94 100644
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@@ -615,7 +615,7 @@ getBucketObject c = munge . key2file
_ -> getFilePrefix c ++ s
getBucketExportLocation :: RemoteConfig -> ExportLocation -> FilePath
-getBucketExportLocation c (ExportLocation loc) = getFilePrefix c ++ loc
+getBucketExportLocation c loc = getFilePrefix c ++ fromExportLocation loc
{- Internet Archive documentation limits filenames to a subset of ascii.
- While other characters seem to work now, this entity encodes everything
diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs
index 921146ebd..495b3f8fc 100644
--- a/Remote/WebDAV.hs
+++ b/Remote/WebDAV.hs
@@ -204,8 +204,8 @@ removeExportDav mh _k loc = runExport mh $ \_dav ->
removeHelper (exportLocation loc)
removeExportDirectoryDav :: Maybe DavHandle -> ExportDirectory -> Annex Bool
-removeExportDirectoryDav mh (ExportDirectory dir) = runExport mh $ \_dav ->
- safely (inLocation dir delContentM)
+removeExportDirectoryDav mh dir = runExport mh $ \_dav ->
+ safely (inLocation (fromExportDirectory dir) delContentM)
>>= maybe (return False) (const $ return True)
renameExportDav :: Maybe DavHandle -> Key -> ExportLocation -> ExportLocation -> Annex Bool
diff --git a/Remote/WebDAV/DavLocation.hs b/Remote/WebDAV/DavLocation.hs
index 09f2b1b47..cbe87e6a7 100644
--- a/Remote/WebDAV/DavLocation.hs
+++ b/Remote/WebDAV/DavLocation.hs
@@ -47,7 +47,7 @@ keyLocation :: Key -> DavLocation
keyLocation k = keyDir k ++ keyFile k
exportLocation :: ExportLocation -> DavLocation
-exportLocation (ExportLocation f) = f
+exportLocation = fromExportLocation
{- Where we store temporary data for a key as it's being uploaded. -}
keyTmpLocation :: Key -> DavLocation
diff --git a/Types/Export.hs b/Types/Export.hs
index cc1b8debf..0e86f9684 100644
--- a/Types/Export.hs
+++ b/Types/Export.hs
@@ -5,19 +5,41 @@
- Licensed under the GNU GPL version 3 or higher.
-}
-module Types.Export where
+module Types.Export (
+ ExportLocation,
+ mkExportLocation,
+ fromExportLocation,
+ ExportDirectory,
+ mkExportDirectory,
+ fromExportDirectory,
+ exportDirectories,
+) where
+
+import Git.FilePath
import qualified System.FilePath.Posix as Posix
-- A location on a remote that a key can be exported to.
-- The FilePath will be relative to the top of the export,
--- and may contain unix-style path separators.
+-- and uses unix-style path separators.
newtype ExportLocation = ExportLocation FilePath
deriving (Show, Eq)
+mkExportLocation :: FilePath -> ExportLocation
+mkExportLocation = ExportLocation . toInternalGitPath
+
+fromExportLocation :: ExportLocation -> FilePath
+fromExportLocation (ExportLocation f) = f
+
newtype ExportDirectory = ExportDirectory FilePath
deriving (Show, Eq)
+mkExportDirectory :: FilePath -> ExportDirectory
+mkExportDirectory = ExportDirectory . toInternalGitPath
+
+fromExportDirectory :: ExportDirectory -> FilePath
+fromExportDirectory (ExportDirectory f) = f
+
-- | All subdirectories down to the ExportLocation, with the deepest ones
-- last. Does not include the top of the export.
exportDirectories :: ExportLocation -> [ExportDirectory]
diff --git a/doc/todo/export.mdwn b/doc/todo/export.mdwn
index f23ed6866..3ddca0cf8 100644
--- a/doc/todo/export.mdwn
+++ b/doc/todo/export.mdwn
@@ -26,18 +26,30 @@ Work is in progress. Todo list:
export database is not populated. So, seems that the export database needs
to get populated based on the export log in these cases.
- This needs a (local) record of what tree the (local) export db
- was last updated for, which is updated at the same time as the export log.
- One way to record that would be as a git ref.
+ This needs the db to contain a record of the data source,
+ the tree that most recently populated it.
- When the export log contains a different tree than the local
- record, the export was updated in another repository, and so the
+ When the export log contains a different tree than the data source,
+ the export was updated in another repository, and so the
export db needs to be updated.
- Updating the export db could diff the last exported treeish with the
+ Updating the export db could diff the data source with the
logged treeish. Add/delete exported files from the database to get
it to the same state as the remote database.
+ When an export is incomplete, the database is in some
+ state in between the data source tree and the incompletely
+ exported tree. Diffing won't resolve this.
+
+ When to record the data source? If it's done at the same time the export
+ is recorded (as no longer incomplete) in the export log, all the files
+ have not yet been uploaded to the export, and the the database is not
+ fully updated to match the data source.
+
+ Seems that we need a separate table, to be able to look up filenames
+ from the export tree by key. That table can be fully populated,
+ before the Exported table is.
+
* tracking exports
* Support configuring export in the assistant
diff --git a/git-annex.cabal b/git-annex.cabal
index 1d74b358a..e8c3d2373 100644
--- a/git-annex.cabal
+++ b/git-annex.cabal
@@ -506,6 +506,7 @@ Executable git-annex
Annex.Direct
Annex.Drop
Annex.Environment
+ Annex.Export
Annex.FileMatcher
Annex.Fixup
Annex.GitOverlay
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-02 18:44:39 +0000