make storeExport throw exceptions

Command/Export.hs

@@ -20,6 +20,7 @@ import qualified Git.Ref
 import Git.Types
 import Git.FilePath
 import Git.Sha
+import qualified Remote
 import Types.Remote
 import Types.Export
 import Annex.Export
@@ -280,7 +281,8 @@ performExport r db ek af contentsha loc allfilledvar = do
 					let rollback = void $
 						performUnexport r db [ek] loc
 					sendAnnex k rollback $ \f ->
-						storer f k loc pm
+						Remote.action $
+							storer f k loc pm
 			, do
 				showNote "not available"
 				return False
@@ -291,7 +293,8 @@ performExport r db ek af contentsha loc allfilledvar = do
 				b <- catObject contentsha
 				liftIO $ L.hPut h b
 				liftIO $ hClose h
-				storer tmp sha1k loc nullMeterUpdate
+				Remote.action $
+					storer tmp sha1k loc nullMeterUpdate
 	let failedsend = liftIO $ modifyMVar_ allfilledvar (pure . const (AllFilled False))
 	case sent of
 		Right True -> next $ cleanupExport r db ek loc True

Command/TestRemote.hs

@@ -287,15 +287,15 @@ testExportTree runannex mkr mkk1 mkk2 =
 	, check "remove export when not present" $ \ea k1 _k2 -> 
 		removeexport ea k1
 	, check "store export" $ \ea k1 _k2 ->
-		storeexport ea k1
+		isRight <$> tryNonAsync (storeexport ea k1)
 	, check "check present export after store" $ \ea k1 _k2 ->
 		checkpresentexport ea k1
 	, check "store export when already present" $ \ea k1 _k2 ->
-		storeexport ea k1
+		isRight <$> tryNonAsync (storeexport ea k1)
 	, check "retrieve export" $ \ea k1 _k2 -> 
 		retrieveexport ea k1
 	, check "store new content to export" $ \ea _k1 k2 ->
-		storeexport ea k2
+		isRight <$> tryNonAsync (storeexport ea k2)
 	, check "check present export after store of new content" $ \ea _k1 k2 ->
 		checkpresentexport ea k2
 	, check "retrieve export new content" $ \ea _k1 k2 ->

Remote/Adb.hs

@@ -234,8 +234,10 @@ androidHashDir adir k = AndroidPath $
   where
 	hdir = replace [pathSeparator] "/" (fromRawFilePath (hashDirLower def k))
 
-storeExportM :: AndroidSerial -> AndroidPath -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex Bool 
+storeExportM :: AndroidSerial -> AndroidPath -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex ()
-storeExportM serial adir src _k loc _p = store' serial dest src
+storeExportM serial adir src _k loc _p = 
+	unlessM (store' serial dest src) $
+		giveup "adb failed"
   where
 	dest = androidExportLocation adir loc
 
@@ -317,19 +319,19 @@ retrieveExportWithContentIdentifierM serial adir loc cid dest mkkey _p = catchDe
   where
 	src = androidExportLocation adir loc
 
-storeExportWithContentIdentifierM :: AndroidSerial -> AndroidPath -> FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex (Either String ContentIdentifier)
+storeExportWithContentIdentifierM :: AndroidSerial -> AndroidPath -> FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex ContentIdentifier
 storeExportWithContentIdentifierM serial adir src _k loc overwritablecids _p =
 	-- Check if overwrite is safe before sending, because sending the
 	-- file is expensive and don't want to do it unncessarily.
 	ifM checkcanoverwrite
 		( ifM (store'' serial dest src checkcanoverwrite)
-			( getExportContentIdentifier serial adir loc >>= return . \case
+			( getExportContentIdentifier serial adir loc >>= \case
-				Right (Just cid) -> Right cid
+				Right (Just cid) -> return cid
-				Right Nothing -> Left "adb failed to store file"
+				Right Nothing -> giveup "adb failed to store file"
-				Left _ -> Left "unable to get content identifier for file stored on adtb"
+				Left _ -> giveup "unable to get content identifier for file stored by adb"
-			, return $ Left "adb failed to store file"
+			, giveup "adb failed to store file"
 			)
-		, return $ Left "unsafe to overwrite file"
+		, giveup "unsafe to overwrite file"
 		)
   where
 	dest = androidExportLocation adir loc

Remote/Directory.hs

@@ -264,13 +264,12 @@ checkPresentGeneric' d check = ifM check
 		)
 	)
 
-storeExportM :: FilePath -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex Bool
+storeExportM :: FilePath -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex ()
-storeExportM d src _k loc p = liftIO $ catchBoolIO $ do
+storeExportM d src _k loc p = liftIO $ do
 	createDirectoryUnder d (takeDirectory dest)
 	-- Write via temp file so that checkPresentGeneric will not
 	-- see it until it's fully stored.
 	viaTmp (\tmp () -> withMeteredFile src p (L.writeFile tmp)) dest ()
-	return True
   where
 	dest = exportPath d loc
 
@@ -407,37 +406,36 @@ retrieveExportWithContentIdentifierM dir loc cid dest mkkey p =
 		| currcid == Just cid = cont
 		| otherwise = return Nothing
 
-storeExportWithContentIdentifierM :: FilePath -> FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex (Either String ContentIdentifier)
+storeExportWithContentIdentifierM :: FilePath -> FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex ContentIdentifier
-storeExportWithContentIdentifierM dir src _k loc overwritablecids p =
+storeExportWithContentIdentifierM dir src _k loc overwritablecids p = do
-	catchNonAsync go (return . Left . show)
+	liftIO $ createDirectoryUnder dir destdir
+	withTmpFileIn destdir template $ \tmpf tmph -> do
+		liftIO $ withMeteredFile src p (L.hPut tmph)
+		liftIO $ hFlush tmph
+		liftIO $ hClose tmph
+		liftIO (getFileStatus tmpf) >>= liftIO . mkContentIdentifier tmpf >>= \case
+			Nothing -> giveup "unable to generate content identifier"
+			Just newcid -> do
+				checkExportContent dir loc
+					(newcid:overwritablecids)
+					(giveup "unsafe to overwrite file")
+					(const $ liftIO $ rename tmpf dest)
+				return newcid
   where
-	go = do
-		liftIO $ createDirectoryUnder dir destdir
-		withTmpFileIn destdir template $ \tmpf tmph -> do
-			liftIO $ withMeteredFile src p (L.hPut tmph)
-			liftIO $ hFlush tmph
-			liftIO $ hClose tmph
-			liftIO (getFileStatus tmpf) >>= liftIO . mkContentIdentifier tmpf >>= \case
-				Nothing -> 
-					return $ Left "unable to generate content identifier"
-				Just newcid ->
-					checkExportContent dir loc (newcid:overwritablecids) (Left "unsafe to overwrite file") $ const $ do
-						liftIO $ rename tmpf dest
-						return (Right newcid)
 	dest = exportPath dir loc
 	(destdir, base) = splitFileName dest
 	template = relatedTemplate (base ++ ".tmp")
 
 removeExportWithContentIdentifierM :: FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> Annex Bool
 removeExportWithContentIdentifierM dir k loc removeablecids =
-	checkExportContent dir loc removeablecids False $ \case
+	checkExportContent dir loc removeablecids (return False) $ \case
 		DoesNotExist -> return True
 		KnownContentIdentifier -> removeExportM dir k loc
 
 checkPresentExportWithContentIdentifierM :: FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> Annex Bool
 checkPresentExportWithContentIdentifierM dir _k loc knowncids =
 	checkPresentGeneric' dir $
-		checkExportContent dir loc knowncids False $ \case
+		checkExportContent dir loc knowncids (return False) $ \case
 			DoesNotExist -> return False
 			KnownContentIdentifier -> return True
 
@@ -458,18 +456,18 @@ data CheckResult = DoesNotExist | KnownContentIdentifier
 --
 -- So, it suffices to check if the destination file's current
 -- content is known, and immediately run the callback.
-checkExportContent :: FilePath -> ExportLocation -> [ContentIdentifier] -> a -> (CheckResult -> Annex a) -> Annex a
+checkExportContent :: FilePath -> ExportLocation -> [ContentIdentifier] -> Annex a -> (CheckResult -> Annex a) -> Annex a
 checkExportContent dir loc knowncids unsafe callback = 
 	tryWhenExists (liftIO $ getFileStatus dest) >>= \case
 		Just destst
-			| not (isRegularFile destst) -> return unsafe
+			| not (isRegularFile destst) -> unsafe
 			| otherwise -> catchDefaultIO Nothing (liftIO $ mkContentIdentifier dest destst) >>= \case
 				Just destcid
 					| destcid `elem` knowncids -> callback KnownContentIdentifier
 					-- dest exists with other content
-					| otherwise -> return unsafe
+					| otherwise -> unsafe
 				-- should never happen
-				Nothing -> return unsafe
+				Nothing -> unsafe
 		-- dest does not exist
 		Nothing -> callback DoesNotExist
   where

Remote/External.hs

@@ -279,19 +279,16 @@ whereisKeyM external k = handleRequestKey external WHEREIS k Nothing $ \resp ->
 	UNSUPPORTED_REQUEST -> result []
 	_ -> Nothing
 
-storeExportM :: External -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex Bool
+storeExportM :: External -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex ()
-storeExportM external f k loc p = safely $
+storeExportM external f k loc p = either giveup return =<< go
-	handleRequestExport external loc req k (Just p) $ \resp -> case resp of
-		TRANSFER_SUCCESS Upload k' | k == k' -> result True
-		TRANSFER_FAILURE Upload k' errmsg | k == k' ->
-			Just $ do
-				warning $ respErrorMessage "TRANSFER" errmsg
-				return (Result False)
-		UNSUPPORTED_REQUEST -> Just $ do
-			warning "TRANSFEREXPORT not implemented by external special remote"
-			return (Result False)
-		_ -> Nothing
   where
+	go = handleRequestExport external loc req k (Just p) $ \resp -> case resp of
+		TRANSFER_SUCCESS Upload k' | k == k' -> result $ Right ()
+		TRANSFER_FAILURE Upload k' errmsg | k == k' ->
+			result $ Left $ respErrorMessage "TRANSFER" errmsg
+		UNSUPPORTED_REQUEST -> 
+			result $ Left "TRANSFEREXPORT not implemented by external special remote"
+		_ -> Nothing
 	req sk = TRANSFEREXPORT Upload sk f
 
 retrieveExportM :: External -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Bool

Remote/Helper/ExportImport.hs

@@ -36,15 +36,15 @@ instance HasExportUnsupported (ParsedRemoteConfig -> RemoteGitConfig -> Annex Bo
 
 instance HasExportUnsupported (ExportActions Annex) where
 	exportUnsupported = ExportActions
-		{ storeExport = \_ _ _ _ -> do
+		{ storeExport = nope
-			warning "store export is unsupported"
-			return False
 		, 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
+					newcid <- storeExportWithContentIdentifier (importActions r') f k loc oldcids p
-						Left err -> do
+					withExclusiveLock gitAnnexContentIdentifierLock $ do
-							warning err
+						liftIO $ ContentIdentifier.recordContentIdentifier db rs newcid k
-							return False
+						liftIO $ ContentIdentifier.flushDbQueue db
-						Right newcid -> do
+					recordContentIdentifier rs newcid k
-							withExclusiveLock gitAnnexContentIdentifierLock $ do
-								liftIO $ ContentIdentifier.recordContentIdentifier db rs newcid k
-								liftIO $ ContentIdentifier.flushDbQueue db
-							recordContentIdentifier rs newcid k
-							return True
 				, removeExport = \k loc ->
 					removeExportWithContentIdentifier (importActions r') k loc
 						=<< keycids k

Remote/Helper/ReadOnly.hs

@@ -53,8 +53,8 @@ readonlyRemoveKey _ = readonlyFail
 readonlyStorer :: Storer
 readonlyStorer _ _ _ = readonlyFail
 
-readonlyStoreExport :: FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex Bool
+readonlyStoreExport :: FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex ()
-readonlyStoreExport _ _ _ _ = readonlyFail'
+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 :: FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex ContentIdentifier
-readonlyStoreExportWithContentIdentifier _ _ _ _ _ =
+readonlyStoreExportWithContentIdentifier _ _ _ _ _ = readonlyFail
-	return $ Left readonlyWarning
 
 readonlyRemoveExportWithContentIdentifier :: Key -> ExportLocation -> [ContentIdentifier] -> Annex Bool
 readonlyRemoveExportWithContentIdentifier _ _ _ = readonlyFail'
 
-readonlyFail :: Annex ()
+readonlyFail :: Annex a
 readonlyFail = giveup readonlyWarning
 
 readonlyFail' :: Annex Bool

Remote/Rsync.hs

@@ -308,9 +308,9 @@ checkPresentGeneric o rsyncurls = do
 				proc "rsync" $ toCommand $ opts ++ [Param u]
 			return True
 
-storeExportM :: RsyncOpts -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex Bool
+storeExportM :: RsyncOpts -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex ()
 storeExportM o src _k loc meterupdate =
-	storeGeneric' o meterupdate basedest populatedest
+	storeGeneric o meterupdate basedest populatedest
   where
 	basedest = fromRawFilePath (fromExportLocation loc)
 	populatedest = liftIO . createLinkOrCopy src

Remote/S3.hs

@@ -460,22 +460,19 @@ checkKeyHelper' info h o limit = liftIO $ runResourceT $ do
   where
 	req = limit $ S3.headObject (bucket info) o
 
-storeExportS3 :: S3HandleVar -> Remote -> RemoteStateHandle -> S3Info -> Maybe Magic -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex Bool
+storeExportS3 :: S3HandleVar -> Remote -> RemoteStateHandle -> S3Info -> Maybe Magic -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex ()
-storeExportS3 hv r rs info magic f k loc p = fst
+storeExportS3 hv r rs info magic f k loc p = void $ storeExportS3' hv r rs info magic f k loc p
-	<$> storeExportS3' hv r rs info magic f k loc p
 
-storeExportS3' :: S3HandleVar -> Remote -> RemoteStateHandle -> S3Info -> Maybe Magic -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex (Bool, (Maybe S3Etag, Maybe S3VersionID))
+storeExportS3' :: S3HandleVar -> Remote -> RemoteStateHandle -> S3Info -> Maybe Magic -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex (Maybe S3Etag, Maybe S3VersionID)
 storeExportS3' hv r rs info magic f k loc p = withS3Handle hv $ \case
-	Just h -> catchNonAsync (go h) (\e -> warning (show e) >> return (False, (Nothing, Nothing)))
+	Just h -> go h
-	Nothing -> do
+	Nothing -> giveup $ needS3Creds (uuid r)
-		warning $ needS3Creds (uuid r)
-		return (False, (Nothing, Nothing))
   where
 	go h = do
 		let o = T.pack $ bucketExportLocation info loc
 		(metag, mvid) <- storeHelper info h magic f o p
 		setS3VersionID info rs k mvid
-		return (True, (metag, mvid))
+		return (metag, mvid)
 
 retrieveExportS3 :: S3HandleVar -> Remote -> S3Info -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Bool
 retrieveExportS3 hv r info _k loc f p =
@@ -671,7 +668,7 @@ rewritePreconditionException a = catchJust (Url.matchStatusCodeException want) a
 --
 -- When the bucket is not versioned, data loss can result.
 -- This is why that configuration requires --force to enable.
-storeExportWithContentIdentifierS3 :: S3HandleVar -> Remote -> RemoteStateHandle -> S3Info -> Maybe Magic -> FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex (Either String ContentIdentifier)
+storeExportWithContentIdentifierS3 :: S3HandleVar -> Remote -> RemoteStateHandle -> S3Info -> Maybe Magic -> FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex ContentIdentifier
 storeExportWithContentIdentifierS3 hv r rs info magic src k loc _overwritablecids p
 	| versioning info = go
 	-- FIXME Actual aws version that supports getting Etag for a store
@@ -680,18 +677,16 @@ storeExportWithContentIdentifierS3 hv r rs info magic src k loc _overwritablecid
 #if MIN_VERSION_aws(0,99,0)
 	| otherwise = go
 #else
-	| otherwise = return $
+	| otherwise = giveup "git-annex is built with too old a version of the aws library to support this operation"
-		Left "git-annex is built with too old a version of the aws library to support this operation"
 #endif
   where
 	go = storeExportS3' hv r rs info magic src k loc p >>= \case
-		(False, _) -> return $ Left "failed to store content in S3 bucket"
+		(_, Just vid) -> return $
-		(True, (_, Just vid)) -> return $ Right $
 			mkS3VersionedContentIdentifier vid
-		(True, (Just etag, Nothing)) -> return $ Right $
+		(Just etag, Nothing) -> return $
 			mkS3UnversionedContentIdentifier etag
-		(True, (Nothing, Nothing)) -> 
+		(Nothing, Nothing) -> 
-			return $ Left "did not get ETag for store to S3 bucket"
+			giveup "did not get ETag for store to S3 bucket"
 
 -- Does not guarantee that the removed object has the content identifier,
 -- but when the bucket is versioned, the removed object content can still

Remote/WebDAV.hs

@@ -206,19 +206,16 @@ checkKey hv r chunkconfig k = withDavHandle hv $ \dav -> do
 				existsDAV (keyLocation k)
 			either giveup return v
 
-storeExportDav :: DavHandleVar -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex Bool
+storeExportDav :: DavHandleVar -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex ()
 storeExportDav hdl f k loc p = case exportLocation loc of
-	Right dest -> withDavHandle' hdl $ \mh -> runExport mh $ \dav -> do
+	Right dest -> withDavHandle hdl $ \h -> runExport h $ \dav -> do
 		reqbody <- liftIO $ httpBodyStorer f p
 		storeHelper dav (keyTmpLocation k) dest reqbody
-		return True
+	Left err -> giveup err
-	Left err -> do
-		warning err
-		return False
 
 retrieveExportDav :: DavHandleVar -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Bool
 retrieveExportDav hdl  _k loc d p = case exportLocation loc of
-	Right src -> withDavHandle' hdl $ \mh -> runExport mh $ \_dav -> do
+	Right src -> withDavHandle' hdl $ \mh -> runExport' mh $ \_dav -> do
 		retrieveHelper src d p
 		return True
 	Left _err -> return False
@@ -234,7 +231,7 @@ checkPresentExportDav hdl _ _k loc = case exportLocation loc of
 
 removeExportDav :: DavHandleVar-> Key -> ExportLocation -> Annex Bool
 removeExportDav hdl _k loc = case exportLocation loc of
-	Right p -> withDavHandle' hdl $ \mh -> runExport mh $ \_dav ->
+	Right p -> withDavHandle' hdl $ \mh -> runExport' mh $ \_dav ->
 		removeHelper p
 	-- When the exportLocation is not legal for webdav,
 	-- the content is certianly not stored there, so it's ok for
@@ -244,7 +241,7 @@ removeExportDav hdl _k loc = case exportLocation loc of
 	Left _err -> return True
 
 removeExportDirectoryDav :: DavHandleVar -> ExportDirectory -> Annex Bool
-removeExportDirectoryDav hdl dir = withDavHandle' hdl $ \mh -> runExport mh $ \_dav -> do
+removeExportDirectoryDav hdl dir = withDavHandle' hdl $ \mh -> runExport' mh $ \_dav -> do
 	let d = fromRawFilePath $ fromExportDirectory dir
 	debugDav $ "delContent " ++ d
 	safely (inLocation d delContentM)
@@ -258,7 +255,7 @@ renameExportDav hdl _k src dest = case (exportLocation src, exportLocation dest)
 			-- so avoid renaming when using it.
 			| boxComUrl `isPrefixOf` baseURL h -> return Nothing
 			| otherwise -> do
-				v <- runExport (Right h) $ \dav -> do
+				v <- runExport' (Right h) $ \dav -> do
 					maybe noop (void . mkColRecursive) (locationParent destl)
 					moveDAV (baseURL dav) srcl destl
 					return True
@@ -266,9 +263,12 @@ renameExportDav hdl _k src dest = case (exportLocation src, exportLocation dest)
 		Left _e -> return (Just False)
 	_ -> return (Just False)
 
-runExport :: Either String DavHandle -> (DavHandle -> DAVT IO Bool) -> Annex Bool
+runExport' :: Either String DavHandle -> (DavHandle -> DAVT IO Bool) -> Annex Bool
-runExport (Left _e) _ = return False
+runExport' (Left _e) _ = return False
-runExport (Right h) a = fromMaybe False <$> liftIO (goDAV h $ safely (a h))
+runExport' (Right h) a = fromMaybe False <$> liftIO (goDAV h $ safely (a h))
+
+runExport :: DavHandle -> (DavHandle -> DAVT IO a) -> Annex a
+runExport h a = liftIO (goDAV h (a h))
 
 configUrl :: ParsedRemoteConfig -> Maybe URLString
 configUrl c = fixup <$> getRemoteConfigValue urlField c

Types/Remote.hs

@@ -231,7 +231,8 @@ data ExportActions a = ExportActions
 	-- Exports content to an ExportLocation.
 	-- The exported file should not appear to be present on the remote
 	-- until all of its contents have been transferred.
-	{ storeExport :: FilePath -> Key -> ExportLocation -> MeterUpdate -> a Bool
+	-- Throws exception on failure.
+	{ storeExport :: FilePath -> Key -> ExportLocation -> MeterUpdate -> a ()
 	-- Retrieves exported content to a file.
 	-- (The MeterUpdate does not need to be used if it writes
 	-- sequentially to the file.)
@@ -293,6 +294,8 @@ data ImportActions a = ImportActions
 	-- needs to make sure that the ContentIdentifier it returns
 	-- corresponds to what it wrote, not to what some other writer
 	-- wrote.
+	--
+	-- Throws exception on failure.
 	, storeExportWithContentIdentifier
 		:: FilePath
 		-> Key
@@ -300,7 +303,7 @@ data ImportActions a = ImportActions
 		-- old content that it's safe to overwrite
 		-> [ContentIdentifier]
 		-> MeterUpdate
-		-> a (Either String ContentIdentifier)
+		-> a ContentIdentifier
 	-- This is used rather than removeExport when a special remote
 	-- supports imports.
 	--