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

make storeExport throw exceptions

Browse source
This commit is contained in:
Joey Hess 2020-05-15 12:17:15 -04:00
parent dc7dc1e179
commit 4814b444dd
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
11 changed files with 99 additions and 105 deletions
Download patch file Download diff file Expand all files Collapse all files

25
Remote/Helper/ExportImport.hs
View file

@ -36,15 +36,15 @@ instance HasExportUnsupported (ParsedRemoteConfig -> RemoteGitConfig -> Annex Bo
instance HasExportUnsupported (ExportActions Annex) where
exportUnsupported = ExportActions
{ storeExport = \_ _ _ _ -> do
warning "store export is unsupported"
return False
{ storeExport = nope
, retrieveExport = \_ _ _ _ -> return False
, checkPresentExport = \_ _ -> return False
, removeExport = \_ _ -> return False
, removeExportDirectory = Just $ \_ -> return False
, renameExport = \_ _ _ -> return Nothing
}
where
nope = giveup "export not supported"
-- | Use for remotes that do not support imports.
class HasImportUnsupported a where
@ -57,11 +57,13 @@ instance HasImportUnsupported (ImportActions Annex) where
importUnsupported = ImportActions
{ listImportableContents = return Nothing
, retrieveExportWithContentIdentifier = \_ _ _ _ _ -> return Nothing
, storeExportWithContentIdentifier = \_ _ _ _ _ -> return (Left "import not supported")
, storeExportWithContentIdentifier = nope
, removeExportWithContentIdentifier = \_ _ _ -> return False
, removeExportDirectoryWhenEmpty = Just $ \_ -> return False
, checkPresentExportWithContentIdentifier = \_ _ _ -> return False
}
where
nope = giveup "import not supported"
exportIsSupported :: ParsedRemoteConfig -> RemoteGitConfig -> Annex Bool
exportIsSupported = \_ _ -> return True
@ -151,16 +153,11 @@ adjustExportImport r rs = case getRemoteConfigValue exportTreeField (config r) o
oldks <- liftIO $ Export.getExportTreeKey exportdb loc
oldcids <- liftIO $ concat
<$> mapM (ContentIdentifier.getContentIdentifiers db rs) oldks
storeExportWithContentIdentifier (importActions r') f k loc oldcids p >>= \case
Left err -> do
warning err
return False
Right newcid -> do
withExclusiveLock gitAnnexContentIdentifierLock $ do
liftIO $ ContentIdentifier.recordContentIdentifier db rs newcid k
liftIO $ ContentIdentifier.flushDbQueue db
recordContentIdentifier rs newcid k
return True
newcid <- storeExportWithContentIdentifier (importActions r') f k loc oldcids p
withExclusiveLock gitAnnexContentIdentifierLock $ do
liftIO $ ContentIdentifier.recordContentIdentifier db rs newcid k
liftIO $ ContentIdentifier.flushDbQueue db
recordContentIdentifier rs newcid k
, removeExport = \k loc ->
removeExportWithContentIdentifier (importActions r') k loc
=<< keycids k

11
Remote/Helper/ReadOnly.hs
View file

@ -53,8 +53,8 @@ readonlyRemoveKey _ = readonlyFail
readonlyStorer :: Storer
readonlyStorer _ _ _ = readonlyFail
readonlyStoreExport :: FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex Bool
readonlyStoreExport _ _ _ _ = readonlyFail'
readonlyStoreExport :: FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex ()
readonlyStoreExport _ _ _ _ = readonlyFail
readonlyRemoveExport :: Key -> ExportLocation -> Annex Bool
readonlyRemoveExport _ _ = readonlyFail'
@ -65,14 +65,13 @@ readonlyRemoveExportDirectory _ = readonlyFail'
readonlyRenameExport :: Key -> ExportLocation -> ExportLocation -> Annex (Maybe Bool)
readonlyRenameExport _ _ _ = return Nothing
readonlyStoreExportWithContentIdentifier :: FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex (Either String ContentIdentifier)
readonlyStoreExportWithContentIdentifier _ _ _ _ _ =
return $ Left readonlyWarning
readonlyStoreExportWithContentIdentifier :: FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex ContentIdentifier
readonlyStoreExportWithContentIdentifier _ _ _ _ _ = readonlyFail
readonlyRemoveExportWithContentIdentifier :: Key -> ExportLocation -> [ContentIdentifier] -> Annex Bool
readonlyRemoveExportWithContentIdentifier _ _ _ = readonlyFail'
readonlyFail :: Annex ()
readonlyFail :: Annex a
readonlyFail = giveup readonlyWarning
readonlyFail' :: Annex Bool