From f8231ade9124faa3e7b517d2a7e76085ac84b562 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Wed, 14 Sep 2016 14:29:58 -0400
Subject: Warn when --uploadqueued fails to upload to servers.

---
 Storage/Local.hs   | 51 +++++++++++++++++++++++++++++++++++----------------
 Storage/Network.hs |  2 +-
 2 files changed, 36 insertions(+), 17 deletions(-)

(limited to 'Storage')

diff --git a/Storage/Local.hs b/Storage/Local.hs
index 20d0922..efda2bc 100644
--- a/Storage/Local.hs
+++ b/Storage/Local.hs
@@ -17,6 +17,7 @@ import qualified Data.ByteString as B
 import qualified Data.ByteString.UTF8 as U8
 import Data.Monoid
 import Data.List
+import Data.Maybe
 import System.Posix.User
 import System.IO
 import System.Directory
@@ -93,25 +94,43 @@ count section getsharedir = onError (CountFailure . show) $ do
 	CountResult . genericLength . filter isShareFile
 		<$> getDirectoryContents dir
 
-move :: Section -> GetShareDir -> Storage -> IO ()
+move :: Section -> GetShareDir -> Storage -> IO [StoreResult]
 move section getsharedir storage = do
 	dir <- getsharedir section
 	fs <- getDirectoryContents dir
-	forM_ fs $ \f -> case fromShareFile f of
-		Nothing -> return ()
-		Just i -> do
-			-- Use a dummy share number of 0; it doesn't
-			-- matter because we're not going to be
-			-- recombining the share, just sending its contents
-			-- on the the server.
-			r <- retrieve section getsharedir 0 i
-			case r of
-				RetrieveFailure _ -> return ()
-				RetrieveSuccess share -> do
-					s <- storeShare storage i share
-					case s of
-						StoreFailure _ -> return ()
-						_ -> removeFile f
+	rs <- forM fs $ \f -> case fromShareFile f of
+		Nothing -> return Nothing
+		Just i -> Just <$> go f i
+	return (catMaybes rs)
+  where
+	-- Use a dummy share number of 0; it doesn't
+	-- matter because we're not going to be
+	-- recombining the share here.
+	sharenum = 0
+
+	go f i = do
+		r <- retrieve section getsharedir sharenum i
+		case r of
+			RetrieveFailure e -> return (StoreFailure e)
+			RetrieveSuccess share -> do
+				s <- storeShare storage i share
+				case s of
+					StoreSuccess -> movesuccess f
+					StoreAlreadyExists -> alreadyexists share i f
+					StoreFailure e -> return (StoreFailure e)
+
+	movesuccess f = do
+		removeFile f
+		return StoreSuccess
+
+	-- Detect case where the same data is already
+	-- stored on the other storage.
+	alreadyexists share i f = do
+		check <- retrieveShare storage sharenum i
+		case check of
+			RetrieveSuccess share'
+				| share' == share -> movesuccess f
+			_ -> return StoreAlreadyExists
 
 onError :: (IOException -> a) -> IO a -> IO a
 onError f a = do
diff --git a/Storage/Network.hs b/Storage/Network.hs
index 9b586b3..ff33e3f 100644
--- a/Storage/Network.hs
+++ b/Storage/Network.hs
@@ -47,5 +47,5 @@ count :: Server -> IO CountResult
 count srv = serverRequest srv CountFailure id NoPOWIdent countObjects
 
 -- | Not needed for servers.
-move :: Server -> Storage -> IO ()
+move :: Server -> Storage -> IO [StoreResult]
 move _ _ = error "move is not implemented for servers"
-- 
cgit v1.2.3