mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

purify exportActions

Browse source 
Purifying exportActions will allow introspecting and modifying it,
which is needed to add progress bar display to it.

Only S3 and WebDAV ran an Annex action while constructing ExportActions.
There was a small performance gain from them doing that, since a
resource was able to be prepared and reused for multiple actions by
Command.Export.

As seen in commit 809cfbbd8a and
5d394023eb S3 and WebDAV actually create a
new handle for each access in normal, non-export use. It doesn't seem
worth making export use of them marginally more efficient than normal
use. It would be better to do that work upfront when constructing the
remote. Or perhaps use a MVar to cache a handle.

This commit was sponsored by Nick Piper on Patreon.
This commit is contained in:
Joey Hess 2019-01-30 14:55:28 -04:00
parent 5d394023eb
commit 9cebfd7002
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
11 changed files with 143 additions and 148 deletions
Download patch file Download diff file Expand all files Collapse all files

55
Remote/WebDAV.hs
View file

@ -79,14 +79,14 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
, lockContent = Nothing
, checkPresent = checkPresentDummy
, checkPresentCheap = False
, exportActions = withDAVHandle this $ \mh -> return $ ExportActions
{ storeExport = storeExportDav mh
, retrieveExport = retrieveExportDav mh
, checkPresentExport = checkPresentExportDav this mh
, removeExport = removeExportDav mh
, exportActions = ExportActions
{ storeExport = storeExportDav this
, retrieveExport = retrieveExportDav this
, checkPresentExport = checkPresentExportDav this
, removeExport = removeExportDav this
, removeExportDirectory = Just $
removeExportDirectoryDav mh
, renameExport = renameExportDav mh
removeExportDirectoryDav this
, renameExport = renameExportDav this
}
, whereisKey = Nothing
, remoteFsck = Nothing
@ -193,45 +193,46 @@ checkKey r chunkconfig (Just dav) k = do
existsDAV (keyLocation k)
either giveup return v
storeExportDav :: Maybe DavHandle -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex Bool
storeExportDav mh f k loc p = runExport mh $ \dav -> do
storeExportDav :: Remote -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex Bool
storeExportDav r f k loc p = withDAVHandle r $ \mh -> runExport mh $ \dav -> do
reqbody <- liftIO $ httpBodyStorer f p
storeHelper dav (keyTmpLocation k) (exportLocation loc) reqbody
return True
retrieveExportDav :: Maybe DavHandle -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Bool
retrieveExportDav mh _k loc d p = runExport mh $ \_dav -> do
retrieveExportDav :: Remote -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Bool
retrieveExportDav r _k loc d p = withDAVHandle r $ \mh -> runExport mh $ \_dav -> do
retrieveHelper (exportLocation loc) d p
return True
checkPresentExportDav :: Remote -> Maybe DavHandle -> Key -> ExportLocation -> Annex Bool
checkPresentExportDav r mh _k loc = case mh of
checkPresentExportDav :: Remote -> Key -> ExportLocation -> Annex Bool
checkPresentExportDav r _k loc = withDAVHandle r $ \case
Nothing -> giveup $ name r ++ " not configured"
Just h -> liftIO $ do
v <- goDAV h $ existsDAV (exportLocation loc)
either giveup return v
removeExportDav :: Maybe DavHandle -> Key -> ExportLocation -> Annex Bool
removeExportDav mh _k loc = runExport mh $ \_dav ->
removeExportDav :: Remote -> Key -> ExportLocation -> Annex Bool
removeExportDav r _k loc = withDAVHandle r $ \mh -> runExport mh $ \_dav ->
removeHelper (exportLocation loc)
removeExportDirectoryDav :: Maybe DavHandle -> ExportDirectory -> Annex Bool
removeExportDirectoryDav mh dir = runExport mh $ \_dav -> do
removeExportDirectoryDav :: Remote -> ExportDirectory -> Annex Bool
removeExportDirectoryDav r dir = withDAVHandle r $ \mh -> runExport mh $ \_dav -> do
let d = fromExportDirectory dir
debugDav $ "delContent " ++ d
safely (inLocation d delContentM)
>>= maybe (return False) (const $ return True)
renameExportDav :: Maybe DavHandle -> Key -> ExportLocation -> ExportLocation -> Annex Bool
renameExportDav Nothing _ _ _ = return False
renameExportDav (Just h) _k src dest
-- box.com's DAV endpoint has buggy handling of renames,
-- so avoid renaming when using it.
| boxComUrl `isPrefixOf` baseURL h = return False
| otherwise = runExport (Just h) $ \dav -> do
maybe noop (void . mkColRecursive) (locationParent (exportLocation dest))
moveDAV (baseURL dav) (exportLocation src) (exportLocation dest)
return True
renameExportDav :: Remote -> Key -> ExportLocation -> ExportLocation -> Annex Bool
renameExportDav r _k src dest = withDAVHandle r $ \case
Just h
-- box.com's DAV endpoint has buggy handling of renames,
-- so avoid renaming when using it.
| boxComUrl `isPrefixOf` baseURL h -> return False
| otherwise -> runExport (Just h) $ \dav -> do
maybe noop (void . mkColRecursive) (locationParent (exportLocation dest))
moveDAV (baseURL dav) (exportLocation src) (exportLocation dest)
return True
Nothing -> return False
runExport :: Maybe DavHandle -> (DavHandle -> DAVT IO Bool) -> Annex Bool
runExport Nothing _ = return False