diff options
author | Joey Hess <joeyh@joeyh.name> | 2016-09-14 14:29:58 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2016-09-14 14:30:48 -0400 |
commit | f8231ade9124faa3e7b517d2a7e76085ac84b562 (patch) | |
tree | 6745e0fc8fe2fc8866ab4837b8d2bc3c88f09c3f /Storage | |
parent | 0a3eb9be07a7514f5544384bc914f22ea88c24a8 (diff) | |
download | keysafe-f8231ade9124faa3e7b517d2a7e76085ac84b562.tar.gz |
Warn when --uploadqueued fails to upload to servers.
Diffstat (limited to 'Storage')
-rw-r--r-- | Storage/Local.hs | 51 | ||||
-rw-r--r-- | Storage/Network.hs | 2 |
2 files changed, 36 insertions, 17 deletions
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" |