untested moving of upload queues on to servers

There needs to be a 1:1 mapping between upload queues and servers,
otherwise using the upload queue risks two shards for the same object
being uploaded to the same server.

Also, fixed storeShards to give up on StoreAlreadyExists, rather than
trying another storage location. Otherwise, on a name collision,
the shards would be rejected by the servers, and be stored to their upload
queues.

1 files changed, 24 insertions, 17 deletions

diff --git a/Storage/Network.hs b/Storage/Network.hs
index 7a461c7..2b837dc 100644
--- a/Storage/Network.hs
+++ b/Storage/Network.hs
@@ -5,32 +5,39 @@
 
 {-# LANGUAGE OverloadedStrings #-}
 
-module Storage.Network (networkServers, networkStorage) where
+module Storage.Network (Server(..), networkServers, networkStorage) where
 
 import Types
 import Types.Storage
 
-networkServers :: IO StorageLocations
-networkServers = return $ StorageLocations [] -- none yet
+newtype Server = Server { serverName :: String }
 
-networkStorage :: Storage
-networkStorage = Storage
-	{ storeShard = store
-	, retrieveShard = retrieve
-	, obscureShards = obscure
-	, countShards = count
+networkServers :: IO [Server]
+networkServers = return [] -- none yet
+
+networkStorage :: Server -> Storage
+networkStorage server = Storage
+	{ storeShard = store server
+	, retrieveShard = retrieve server
+	, obscureShards = obscure server
+	, countShards = count server
+	, moveShards = move server
 	}
 
-store :: StorableObjectIdent -> Shard -> IO StoreResult
-store _i _s = return $ StoreFailure "network storage not implemented yet"
+store :: Server -> StorableObjectIdent -> Shard -> IO StoreResult
+store _server _i _s = return $ StoreFailure "network storage not implemented yet"
 
-retrieve :: ShardNum -> StorableObjectIdent -> IO RetrieveResult
-retrieve _n _i = return $ RetrieveFailure "network storage not implemented yet"
+retrieve :: Server -> ShardNum -> StorableObjectIdent -> IO RetrieveResult
+retrieve _server _n _i = return $ RetrieveFailure "network storage not implemented yet"
 
 -- | Servers should automatically obscure, so do nothing.
 -- (Could upload chaff.)
-obscure :: IO ObscureResult
-obscure = return ObscureSuccess
+obscure :: Server -> IO ObscureResult
+obscure _ = return ObscureSuccess
+
+count :: Server -> IO CountResult
+count _server = return $ CountFailure "network storage not implemented yet"
 
-count :: IO CountResult
-count = return $ CountFailure "network storage not implemented yet"
+-- | Not needed for servers.
+move :: Server -> Storage -> IO ()
+move _ _ = return ()