diff options
Diffstat (limited to 'Storage.hs')
| -rw-r--r-- | Storage.hs | 25 |
1 files changed, 13 insertions, 12 deletions
@@ -10,23 +10,16 @@ import Types.Storage import Shard import Storage.Local import Storage.Network -import System.FilePath import Data.Monoid import Data.Maybe +import System.FilePath +import Control.Monad allStorageLocations :: IO StorageLocations allStorageLocations = do servers <- networkServers - return $ servers <> uploadQueueLocations servers - --- | Objects queued for upload to servers. There are a number of queues, --- but no 1:1 mapping from queues to a particular server. --- It's important that when flushing the upload queue, the objects in each --- separate queue are sent to a separate server. -uploadQueueLocations :: StorageLocations -> StorageLocations -uploadQueueLocations (StorageLocations servers) = StorageLocations $ - map (localStorage . ("uploadqueue" </>) . show) - [1..length servers] + return $ StorageLocations $ + map networkStorage servers <> map uploadQueue servers localStorageLocations :: StorageLocations localStorageLocations = StorageLocations $ @@ -52,7 +45,10 @@ storeShards (StorageLocations locs) sis shards = do StoreSuccess -> do _ <- showprogress go otherlocs (loc:usedlocs) Nothing rest - _ -> go otherlocs usedlocs (Just r) tostore + StoreFailure _ -> go otherlocs usedlocs (Just r) tostore + -- Give up if any location complains a shard + -- already exists, because we have a name conflict. + StoreAlreadyExists -> return (StoreAlreadyExists, usedlocs) -- | Retrieves shards from among the storage locations, and returns all -- the shards it can find, which may not be all that were requested. @@ -84,3 +80,8 @@ retrieveShards (StorageLocations locs) l = do -- all shards and so learn the idents of -- all of them. go (unusedlocs++[loc]) usedlocs' rest shards' + +uploadQueued :: IO () +uploadQueued = do + servers <- networkServers + forM_ servers $ \s -> moveShards (uploadQueue s) (networkStorage s) |