added obscurer thread to server

1 files changed, 37 insertions, 5 deletions

diff --git a/HTTP/Server.hs b/HTTP/Server.hs
index 03fd712..1d5e145 100644
--- a/HTTP/Server.hs
+++ b/HTTP/Server.hs
@@ -16,9 +16,23 @@ import Servant
 import Network.Wai
 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
+	<$> newEmptyTMVarIO
 
 runServer :: Port -> IO ()
-runServer port = run port app
+runServer port = do
+	forkIO obscurerThread
+	run port app
 
 serverStorage :: Storage
 serverStorage = localStorage "server"
@@ -45,18 +59,36 @@ motd = return $ Motd "Hello World!"
 getObject :: StorableObjectIdent -> Maybe ProofOfWork -> Handler (ProofOfWorkRequirement StorableObject)
 getObject i _pow = do
 	r <- liftIO $ retrieveShare serverStorage dummyShareNum i
+	liftIO requestObscure
 	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 = liftIO $ Result 
-	<$> storeShare serverStorage i (Share dummyShareNum o)
+putObject i _pow o = do
+	r <- liftIO $ storeShare serverStorage i (Share dummyShareNum o)
+	liftIO requestObscure
+	return (Result r)
 
 countObjects :: Maybe ProofOfWork -> Handler (ProofOfWorkRequirement CountResult)
-countObjects _pow = liftIO $ Result
-	<$> countShares serverStorage
+countObjects _pow = liftIO $ Result <$> countShares serverStorage
 
 -- | 1 is a dummy value; the server does not know the actual share numbers.
 dummyShareNum :: ShareNum
 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
+	_ <- atomically $ takeTMVar (obscurerRequest serverState)
+	obscureShares serverStorage
+	putStrLn "obscured shares"
+	threadDelay (1000000*60*30)
+	obscurerThread
+
+requestObscure :: IO ()
+requestObscure = do
+	_ <- atomically $ tryPutTMVar (obscurerRequest serverState) ()
+	return ()