added --store-directory

1 files changed, 13 insertions, 11 deletions

diff --git a/HTTP/Server.hs b/HTTP/Server.hs
index 3e0b9aa..5d5c87f 100644
--- a/HTTP/Server.hs
+++ b/HTTP/Server.hs
@@ -24,23 +24,25 @@ import qualified Data.ByteString as B
 
 data ServerState = ServerState
 	{ obscurerRequest :: TMVar ()
+	, storageDirectory :: Maybe LocalStorageDirectory
 	}
 
-newServerState :: IO ServerState
-newServerState = ServerState
+newServerState :: Maybe LocalStorageDirectory -> IO ServerState
+newServerState d = ServerState
 	<$> newEmptyTMVarIO
+	<*> pure d
 
-runServer :: String -> Port -> IO ()
-runServer bindaddress port = do
-	st <- newServerState
+runServer :: Maybe LocalStorageDirectory -> String -> Port -> IO ()
+runServer d bindaddress port = do
+	st <- newServerState d
 	_ <- forkIO $ obscurerThread st
 	runSettings settings (app st)
   where
 	settings = setHost host $ setPort port $ defaultSettings 
 	host = fromString bindaddress
 
-serverStorage :: Storage
-serverStorage = localStorage userStorageDir "server"
+serverStorage :: ServerState -> Storage
+serverStorage st = localStorage (storageDir $ storageDirectory st) "server"
 
 app :: ServerState -> Application
 app st = serve userAPI (server st)
@@ -59,7 +61,7 @@ motd = return $ Motd "Hello World!"
 
 getObject :: ServerState -> StorableObjectIdent -> Maybe ProofOfWork -> Handler (ProofOfWorkRequirement StorableObject)
 getObject st i _pow = do
-	r <- liftIO $ retrieveShare serverStorage dummyShareNum i
+	r <- liftIO $ retrieveShare (serverStorage st) dummyShareNum i
 	liftIO $ requestObscure st
 	case r of
 		RetrieveSuccess (Share _n o) -> return $ Result o
@@ -69,7 +71,7 @@ putObject :: ServerState -> StorableObjectIdent -> Maybe ProofOfWork -> Storable
 putObject st i _pow o = do
 	if validObjectsize o
 		then do
-			r <- liftIO $ storeShare serverStorage i (Share dummyShareNum o)
+			r <- liftIO $ storeShare (serverStorage st) i (Share dummyShareNum o)
 			liftIO $ requestObscure st
 			return $ Result r
 		else return $ Result $ StoreFailure "invalid object size"
@@ -80,7 +82,7 @@ validObjectsize o = any (sz ==) knownObjectSizes
 	sz = B.length (fromStorableObject o)
 
 countObjects :: ServerState -> Maybe ProofOfWork -> Handler (ProofOfWorkRequirement CountResult)
-countObjects _st _pow = liftIO $ Result <$> countShares serverStorage
+countObjects st _pow = liftIO $ Result <$> countShares (serverStorage st)
 
 -- | 1 is a dummy value; the server does not know the actual share numbers.
 dummyShareNum :: ShareNum
@@ -91,7 +93,7 @@ dummyShareNum = 1
 -- the thread runs a maximum of once per half-hour.
 obscurerThread :: ServerState -> IO ()
 obscurerThread st = do
-	_ <- obscureShares serverStorage
+	_ <- obscureShares (serverStorage st)
 	putStrLn "obscured shares"
 	threadDelay (1000000*60*30)
 	_ <- atomically $ takeTMVar (obscurerRequest st)