diff options
author | Joey Hess <joeyh@joeyh.name> | 2016-08-22 13:21:18 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2016-08-22 13:21:18 -0400 |
commit | f20df55a550cdd5ce88ef59e7bd92d3ca464ab55 (patch) | |
tree | a7d69f61155ea017e750a33259b2f2f99d09e7c3 /HTTP/Server.hs | |
parent | d2ebdb398ad8bcfa16f8b8d62a833da09d436e72 (diff) | |
download | keysafe-f20df55a550cdd5ce88ef59e7bd92d3ca464ab55.tar.gz |
added obscurer thread to server
Diffstat (limited to 'HTTP/Server.hs')
-rw-r--r-- | HTTP/Server.hs | 42 |
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 () |