From 986995f9beabfc4546c0a1a6b35dc7cdbc926efc Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Mon, 22 Aug 2016 14:24:46 -0400
Subject: avoid global

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

(limited to 'HTTP/Server.hs')

diff --git a/HTTP/Server.hs b/HTTP/Server.hs
index f98d062..a671a4b 100644
--- a/HTTP/Server.hs
+++ b/HTTP/Server.hs
@@ -18,36 +18,35 @@ import Network.Wai.Handler.Warp
 import Control.Monad.IO.Class
 import Control.Concurrent
 import Control.Concurrent.STM
-import System.IO.Unsafe (unsafePerformIO)
 
 data ServerState = ServerState
 	{ obscurerRequest :: TMVar ()
 	}
 
-{-# NOINLINE serverState #-}
-serverState :: ServerState
-serverState = unsafePerformIO $ ServerState
+newServerState :: IO ServerState
+newServerState = ServerState
 	<$> newEmptyTMVarIO
 
 runServer :: Port -> IO ()
 runServer port = do
-	_ <- forkIO obscurerThread
-	run port app
+	st <- newServerState
+	_ <- forkIO $ obscurerThread st
+	run port (app st)
 
 serverStorage :: Storage
 serverStorage = localStorage "server"
 
-app :: Application
-app = serve userAPI server
+app :: ServerState -> Application
+app st = serve userAPI (server st)
 
 userAPI :: Proxy HttpAPI
 userAPI = Proxy
 
-server :: Server HttpAPI
-server = apiVersion
+server :: ServerState -> Server HttpAPI
+server st = apiVersion
 	:<|> motd
-	:<|> getObject
-	:<|> putObject
+	:<|> getObject st
+	:<|> putObject st
 	:<|> countObjects
 
 apiVersion :: Handler APIVersion
@@ -56,18 +55,18 @@ apiVersion = return (APIVersion 1)
 motd :: Handler Motd
 motd = return $ Motd "Hello World!"
 
-getObject :: StorableObjectIdent -> Maybe ProofOfWork -> Handler (ProofOfWorkRequirement StorableObject)
-getObject i _pow = do
+getObject :: ServerState -> StorableObjectIdent -> Maybe ProofOfWork -> Handler (ProofOfWorkRequirement StorableObject)
+getObject st i _pow = do
 	r <- liftIO $ retrieveShare serverStorage dummyShareNum i
-	liftIO requestObscure
+	liftIO $ requestObscure st
 	case r of
 		RetrieveSuccess (Share _n o) -> return $ Result o
 		RetrieveFailure _ -> throwError err404
 
-putObject :: StorableObjectIdent -> Maybe ProofOfWork -> StorableObject -> Handler (ProofOfWorkRequirement StoreResult)
-putObject i _pow o = do
+putObject :: ServerState -> StorableObjectIdent -> Maybe ProofOfWork -> StorableObject -> Handler (ProofOfWorkRequirement StoreResult)
+putObject st i _pow o = do
 	r <- liftIO $ storeShare serverStorage i (Share dummyShareNum o)
-	liftIO requestObscure
+	liftIO $ requestObscure st
 	return (Result r)
 
 countObjects :: Maybe ProofOfWork -> Handler (ProofOfWorkRequirement CountResult)
@@ -80,15 +79,15 @@ dummyShareNum = 1
 -- | This thread handles obscuring the shares after put and get operations.
 -- Since obscuring can be an expensive process when there are many shares,
 -- the thread runs a maximum of once per half-hour.
-obscurerThread :: IO ()
-obscurerThread = do
+obscurerThread :: ServerState -> IO ()
+obscurerThread st = do
 	_ <- obscureShares serverStorage
 	putStrLn "obscured shares"
 	threadDelay (1000000*60*30)
-	_ <- atomically $ takeTMVar (obscurerRequest serverState)
-	obscurerThread
+	_ <- atomically $ takeTMVar (obscurerRequest st)
+	obscurerThread st
 
-requestObscure :: IO ()
-requestObscure = do
-	_ <- atomically $ tryPutTMVar (obscurerRequest serverState) ()
+requestObscure :: ServerState -> IO ()
+requestObscure st = do
+	_ <- atomically $ tryPutTMVar (obscurerRequest st) ()
 	return ()
-- 
cgit v1.2.3