Warn when --uploadqueued fails to upload to servers.

1 files changed, 13 insertions, 3 deletions

diff --git a/Storage.hs b/Storage.hs
index b8aace7..2e35972 100644
--- a/Storage.hs
+++ b/Storage.hs
@@ -12,6 +12,7 @@ import Storage.Local
 import Storage.Network
 import Servers
 import Data.Maybe
+import Data.List
 import System.FilePath
 import Control.Monad
 import qualified Data.Set as S
@@ -109,9 +110,18 @@ retrieveShares (StorageLocations locs) sis updateprogress = do
 				-- all of them.
 				go (unusedlocs++[loc]) usedlocs' rest shares'
 
-uploadQueued :: Maybe LocalStorageDirectory -> IO ()
+-- | Returns descriptions of any failures.
+uploadQueued :: Maybe LocalStorageDirectory -> IO [String]
 uploadQueued d = do
 	StorageLocations locs <- allStorageLocations d
-	forM_ locs $ \loc -> case uploadQueue loc of
-		Nothing -> return ()
+	results <- forM locs $ \loc -> case uploadQueue loc of
+		Nothing -> return []
 		Just q -> moveShares q loc
+	return $ processresults (concat results) []
+  where
+	processresults [] c = nub c
+	processresults (StoreSuccess:rs) c = processresults rs c
+	processresults (StoreFailure e:rs) c = processresults rs (e:c)
+	processresults (StoreAlreadyExists:rs) c =
+		processresults rs ("Unable to upload a share to a server due to a name conflict.":c)
+