purify exportActions
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 commit809cfbbd8a
and5d394023eb
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:
parent
5d394023eb
commit
9cebfd7002
11 changed files with 143 additions and 148 deletions
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue