add support for multiple storage locattions

also, server upload queues in ~/.keysafe

2 files changed, 31 insertions, 24 deletions

diff --git a/Storage/Local.hs b/Storage/Local.hs
index 82a7fd0..a13fcae 100644
--- a/Storage/Local.hs
+++ b/Storage/Local.hs
@@ -8,7 +8,7 @@
 module Storage.Local (localStorage) where
 
 import Types
-import Storage
+import Types.Storage
 import Serialization ()
 import qualified Data.ByteString as B
 import qualified Data.ByteString.UTF8 as U8
@@ -23,17 +23,21 @@ import Raaz.Core.Encode
 import Control.DeepSeq
 import Control.Exception
 
-localStorage :: Storage
-localStorage = Storage
-	{ storeShard = store
-	, retrieveShard = retrieve
-	, obscureShards = obscure
-	, countShards = count
+newtype Section = Section String
+
+localStorage :: String -> Storage
+localStorage n = Storage
+	{ storeShard = store section
+	, retrieveShard = retrieve section
+	, obscureShards = obscure section
+	, countShards = count section
 	}
+  where
+	section = Section n
 
-store :: StorableObjectIdent -> Shard -> IO StoreResult
-store i s = onError (StoreFailure . show) $ do
-	dir <- shardDir
+store :: Section -> StorableObjectIdent -> Shard -> IO StoreResult
+store section i s = onError (StoreFailure . show) $ do
+	dir <- shardDir section
 	createDirectoryIfMissing True dir
 	let dest = dir </> shardFile i
 	exists <- doesFileExist dest
@@ -49,9 +53,9 @@ store i s = onError (StoreFailure . show) $ do
 			renameFile tmp dest
 			return StoreSuccess
 
-retrieve :: ShardNum -> StorableObjectIdent -> IO RetrieveResult
-retrieve n i = onError (RetrieveFailure . show) $ do
-	dir <- shardDir
+retrieve :: Section -> ShardNum -> StorableObjectIdent -> IO RetrieveResult
+retrieve section n i = onError (RetrieveFailure . show) $ do
+	dir <- shardDir section
 	fd <- openFd (dir </> shardFile i) ReadOnly Nothing defaultFileFlags
 	h <- fdToHandle fd
 	b <- B.hGetContents h
@@ -67,16 +71,16 @@ retrieve n i = onError (RetrieveFailure . show) $ do
 --
 -- Note that the contents of shards is never changed, so it's ok to set the
 -- mtime to the epoch; backup programs won't be confused.
-obscure :: IO ObscureResult
-obscure = onError (ObscureFailure . show) $ do
-	dir <- shardDir
+obscure :: Section -> IO ObscureResult
+obscure section = onError (ObscureFailure . show) $ do
+	dir <- shardDir section
 	fs <- filter isShardFile <$> getDirectoryContents dir
 	mapM_ (\f -> setFileTimes (dir </> f) 0 0) fs
 	return ObscureSuccess
 
-count :: IO CountResult
-count = onError (CountFailure . show) $ do
-	dir <- shardDir
+count :: Section -> IO CountResult
+count section = onError (CountFailure . show) $ do
+	dir <- shardDir section
 	CountResult . genericLength . filter isShardFile
 		<$> getDirectoryContents dir
 
@@ -87,10 +91,10 @@ onError f a = do
 		Left e -> f e
 		Right r -> r
 
-shardDir :: IO FilePath
-shardDir = do
+shardDir :: Section -> IO FilePath
+shardDir (Section section) = do
 	u <- getUserEntryForID =<< getEffectiveUserID
-	return $ homeDirectory u </> dotdir
+	return $ homeDirectory u </> dotdir </> section
 
 shardFile :: StorableObjectIdent -> String
 shardFile i = U8.toString (toByteString i) <> ext
diff --git a/Storage/Network.hs b/Storage/Network.hs
index 06b7545..7a461c7 100644
--- a/Storage/Network.hs
+++ b/Storage/Network.hs
@@ -5,10 +5,13 @@
 
 {-# LANGUAGE OverloadedStrings #-}
 
-module Storage.Network (networkStorage) where
+module Storage.Network (networkServers, networkStorage) where
 
 import Types
-import Storage
+import Types.Storage
+
+networkServers :: IO StorageLocations
+networkServers = return $ StorageLocations [] -- none yet
 
 networkStorage :: Storage
 networkStorage = Storage