2 files changed, 59 insertions, 21 deletions

diff --git a/Storage/Local.hs b/Storage/Local.hs
index a13fcae..bd49116 100644
--- a/Storage/Local.hs
+++ b/Storage/Local.hs
@@ -5,10 +5,11 @@
 
 {-# LANGUAGE OverloadedStrings #-}
 
-module Storage.Local (localStorage) where
+module Storage.Local (localStorage, uploadQueue) where
 
 import Types
 import Types.Storage
+import Storage.Network (Server(..))
 import Serialization ()
 import qualified Data.ByteString as B
 import qualified Data.ByteString.UTF8 as U8
@@ -22,6 +23,7 @@ import System.FilePath
 import Raaz.Core.Encode
 import Control.DeepSeq
 import Control.Exception
+import Control.Monad
 
 newtype Section = Section String
 
@@ -31,10 +33,14 @@ localStorage n = Storage
 	, retrieveShard = retrieve section
 	, obscureShards = obscure section
 	, countShards = count section
+	, moveShards = move section
 	}
   where
 	section = Section n
 
+uploadQueue :: Server -> Storage
+uploadQueue s = localStorage ("uploadqueue" </> serverName s)
+
 store :: Section -> StorableObjectIdent -> Shard -> IO StoreResult
 store section i s = onError (StoreFailure . show) $ do
 	dir <- shardDir section
@@ -84,6 +90,26 @@ count section = onError (CountFailure . show) $ do
 	CountResult . genericLength . filter isShardFile
 		<$> getDirectoryContents dir
 
+move :: Section -> Storage -> IO ()
+move section storage = do
+	dir <- shardDir section
+	fs <- getDirectoryContents dir
+	forM_ fs $ \f -> case fromShardFile f of
+		Nothing -> return ()
+		Just i -> do
+			-- Use a dummy shard number of 0; it doesn't
+			-- matter because we're not going to be
+			-- recombining the shard, just sending its contents
+			-- on the the server.
+			r <- retrieve section 0 i
+			case r of
+				RetrieveFailure _ -> return ()
+				RetrieveSuccess shard -> do
+					s <- storeShard storage i shard
+					case s of
+						StoreFailure _ -> return ()
+						_ -> removeFile f
+
 onError :: (IOException -> a) -> IO a -> IO a
 onError f a = do
 	v <- try a
@@ -96,14 +122,19 @@ shardDir (Section section) = do
 	u <- getUserEntryForID =<< getEffectiveUserID
 	return $ homeDirectory u </> dotdir </> section
 
-shardFile :: StorableObjectIdent -> String
+shardFile :: StorableObjectIdent -> FilePath
 shardFile i = U8.toString (toByteString i) <> ext
 
-ext :: String
-ext = ".keysafe"
+fromShardFile :: FilePath -> Maybe StorableObjectIdent
+fromShardFile f
+	| isShardFile f = fromByteString $ U8.fromString $ dropExtension f
+	| otherwise = Nothing
 
 isShardFile :: FilePath -> Bool
 isShardFile f = ext `isSuffixOf` f
 
+ext :: String
+ext = ".keysafe"
+
 dotdir :: FilePath
 dotdir = ".keysafe" </> "objects"
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 ()