lift types from IO to Annex

Some remotes like External need to run store and retrieve actions in Annex,
not IO. In order to do that lift, I had to dive pretty deep into the
utilities, making Utility.Gpg and Utility.Tmp be partly converted to using
MonadIO, and Control.Monad.Catch for exception handling.

There should be no behavior changes in this commit.

This commit was sponsored by Michael Barabanov.

3 files changed, 17 insertions, 19 deletions

diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index 5d8a040d4..9f2775965 100644
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -112,8 +112,8 @@ prepareStore d chunkconfig = checkPrepare
 	(\k -> checkDiskSpace (Just d) k 0)
 	(byteStorer $ store d chunkconfig)
 
-store :: FilePath -> ChunkConfig -> Key -> L.ByteString -> MeterUpdate -> IO Bool
-store d chunkconfig k b p = do
+store :: FilePath -> ChunkConfig -> Key -> L.ByteString -> MeterUpdate -> Annex Bool
+store d chunkconfig k b p = liftIO $ do
 	void $ tryIO $ createDirectoryIfMissing True tmpdir
 	case chunkconfig of
 		LegacyChunks chunksize -> Legacy.store chunksize finalizer k b p tmpdir destdir
@@ -138,7 +138,7 @@ store d chunkconfig k b p = do
 retrieve :: FilePath -> ChunkConfig -> Preparer Retriever
 retrieve d (LegacyChunks _) = Legacy.retrieve locations d
 retrieve d _ = simplyPrepare $ byteRetriever $ 
-	\k -> L.readFile =<< getLocation d k
+	\k -> liftIO $ L.readFile =<< getLocation d k
 
 retrieveCheap :: FilePath -> ChunkConfig -> Key -> FilePath -> Annex Bool
 -- no cheap retrieval possible for chunks
diff --git a/Remote/Directory/LegacyChunked.hs b/Remote/Directory/LegacyChunked.hs
index af846a2e6..312119f4e 100644
--- a/Remote/Directory/LegacyChunked.hs
+++ b/Remote/Directory/LegacyChunked.hs
@@ -96,7 +96,7 @@ retrieve locations d basek a = do
 	tmpdir <- fromRepo $ gitAnnexTmpMiscDir
 	createAnnexDirectory tmpdir
 	let tmp = tmpdir </> keyFile basek ++ ".directorylegacy.tmp"
-	a $ Just $ byteRetriever $ \k -> do
+	a $ Just $ byteRetriever $ \k -> liftIO $ do
 		void $ withStoredFiles d locations k $ \fs -> do
 			forM_ fs $
 				S.appendFile tmp <=< S.readFile
diff --git a/Remote/Helper/Chunked.hs b/Remote/Helper/Chunked.hs
index 70e541cce..ccdd35271 100644
--- a/Remote/Helper/Chunked.hs
+++ b/Remote/Helper/Chunked.hs
@@ -27,7 +27,6 @@ import Annex.Exception
 
 import qualified Data.ByteString.Lazy as L
 import qualified Data.Map as M
-import Control.Exception
 
 data ChunkConfig
 	= NoChunks
@@ -91,15 +90,14 @@ storeChunks
 	-> Key
 	-> FilePath
 	-> MeterUpdate
-	-> (Key -> ContentSource -> MeterUpdate -> IO Bool)
+	-> (Key -> ContentSource -> MeterUpdate -> Annex Bool)
 	-> (Key -> Annex (Either String Bool))
 	-> Annex Bool
 storeChunks u chunkconfig k f p storer checker = 
 	case chunkconfig of
 		(UnpaddedChunks chunksize) -> 
 			bracketIO open close (go chunksize)
-		_ -> showprogress $
-			liftIO . storer k (FileContent f)
+		_ -> showprogress $ storer k (FileContent f)
   where
 	showprogress = metered (Just p) k
 
@@ -130,7 +128,7 @@ storeChunks u chunkconfig k f p storer checker =
 				return True
 			| otherwise = do
 				let (chunkkey, chunkkeys') = nextChunkKeyStream chunkkeys
-				ifM (liftIO $ storer chunkkey (ByteContent chunk) meterupdate')
+				ifM (storer chunkkey (ByteContent chunk) meterupdate')
 					( do
 						let bytesprocessed' = addBytesProcessed bytesprocessed (L.length chunk)
 						loop bytesprocessed' (splitchunk bs) chunkkeys'
@@ -234,20 +232,20 @@ retrieveChunks retriever u chunkconfig encryptor basek dest basep sink
 			const (go =<< chunkKeysOnly u basek)
 	| otherwise = go =<< chunkKeys u chunkconfig basek
   where
-	go ls = liftIO $ do
-		currsize <- catchMaybeIO $
+	go ls = do
+		currsize <- liftIO $ catchMaybeIO $
 			toInteger . fileSize <$> getFileStatus dest
 		let ls' = maybe ls (setupResume ls) currsize
-		firstavail currsize ls' `catchNonAsync` giveup
+		firstavail currsize ls' `catchNonAsyncAnnex` giveup
 
 	giveup e = do
-		warningIO (show e)
+		warning (show e)
 		return False
 
 	firstavail _ [] = return False
 	firstavail currsize ([]:ls) = firstavail currsize ls
 	firstavail currsize ((k:ks):ls) = do
-		v <- tryNonAsync $ retriever (encryptor k)
+		v <- tryNonAsyncAnnex $ retriever (encryptor k)
 		case v of
 			Left e
 				| null ls -> giveup e
@@ -257,8 +255,8 @@ retrieveChunks retriever u chunkconfig encryptor basek dest basep sink
 				let p = maybe basep
 					(offsetMeterUpdate basep . toBytesProcessed)
 					offset
-				bracket (maybe opennew openresume offset) hClose $ \h -> do
-					withBytes content $ sink h p
+				bracketIO (maybe opennew openresume offset) hClose $ \h -> do
+					withBytes content $ liftIO . sink h p
 					let sz = toBytesProcessed $
 						fromMaybe 0 $ keyChunkSize k
 					getrest p h sz sz ks
@@ -267,12 +265,12 @@ retrieveChunks retriever u chunkconfig encryptor basek dest basep sink
 	getrest p h sz bytesprocessed (k:ks) = do
 		let p' = offsetMeterUpdate p bytesprocessed
 		content <- retriever (encryptor k)
-		withBytes content $ sink h p'
+		withBytes content $ liftIO . sink h p'
 		getrest p h sz (addBytesProcessed bytesprocessed sz) ks
 
-	getunchunked = liftIO $ bracket opennew hClose $ \h -> do
+	getunchunked = bracketIO opennew hClose $ \h -> do
 		content <- retriever (encryptor basek)
-		withBytes content $ sink h basep
+		withBytes content $ liftIO . sink h basep
 		return True
 
 	opennew = openBinaryFile dest WriteMode