From 019c080687ce4a07031bdfe2263397f4f868c3c3 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Wed, 31 Aug 2016 14:30:35 -0400
Subject: added --store-directory

---
 HTTP/Server.hs | 24 +++++++++++++-----------
 1 file changed, 13 insertions(+), 11 deletions(-)

(limited to 'HTTP')

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)
-- 
cgit v1.2.3