diff options
author | Joey Hess <joeyh@joeyh.name> | 2016-08-18 15:48:45 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2016-08-18 15:49:26 -0400 |
commit | 07afb8fc1eb3a850b13f7aa09cc0ca3b0b495a2c (patch) | |
tree | 6781d8f5bf2a1e7b507407acf96852a39fcddac3 /Storage.hs | |
parent | 9ac67ddbc263497283a8b03c74bc73527b3088cc (diff) | |
download | keysafe-07afb8fc1eb3a850b13f7aa09cc0ca3b0b495a2c.tar.gz |
fix behavior on retrieve failure
Diffstat (limited to 'Storage.hs')
-rw-r--r-- | Storage.hs | 18 |
1 files changed, 10 insertions, 8 deletions
@@ -17,19 +17,21 @@ import Data.Maybe allStorageLocations :: IO StorageLocations allStorageLocations = do servers <- networkServers - return $ servers <> uploadQueueLocations + 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 -uploadQueueLocations = StorageLocations $ - map (localStorage . ("uploadqueue" </>) . show) ([1..] :: [Integer]) +uploadQueueLocations :: StorageLocations -> StorageLocations +uploadQueueLocations (StorageLocations servers) = StorageLocations $ + map (localStorage . ("uploadqueue" </>) . show) + [1..length servers] localStorageLocations :: StorageLocations localStorageLocations = StorageLocations $ - map (localStorage . ("local" </>) . show) ([1..] :: [Integer]) + map (localStorage . ("local" </>) . show) + [1..100 :: Int] type UpdateProgress = IO () @@ -66,7 +68,7 @@ retrieveShards (StorageLocations locs) l = do where go unusedlocs usedlocs [] shards = return (shards, usedlocs, unusedlocs) go [] usedlocs _ shards = return (shards, usedlocs, []) - go (loc:otherlocs) usedlocs toretrieve@((updateprogress, (n, i)):rest) shards = do + go (loc:otherlocs) usedlocs (toretrieve@(updateprogress, (n, i)):rest) shards = do r <- retrieveShard loc n i case r of RetrieveSuccess s -> do @@ -74,11 +76,11 @@ retrieveShards (StorageLocations locs) l = do go otherlocs (loc:usedlocs) rest (s:shards) RetrieveFailure _ -> do (shards', usedlocs', unusedlocs) <- - go otherlocs usedlocs toretrieve shards + go otherlocs usedlocs [toretrieve] shards -- May need to ask the location that didn't -- have the shard for a later shard, but -- ask it last. This way, the first -- location on the list can't deny having -- all shards and so learn the idents of -- all of them. - go (unusedlocs++[loc]) usedlocs' toretrieve shards' + go (unusedlocs++[loc]) usedlocs' rest shards' |