diff options
Diffstat (limited to 'Storage')
-rw-r--r-- | Storage/Local.hs | 39 | ||||
-rw-r--r-- | Storage/Network.hs | 41 |
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 () |