diff options
author | Joey Hess <joeyh@joeyh.name> | 2016-09-13 17:13:19 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2016-09-13 17:13:19 -0400 |
commit | 48e49d83867a5335f5e45a42dbac202caa42cd5d (patch) | |
tree | 2fb75ecd3295a0bb23d6eb393d9f0cf3ed4d663d /HTTP/Server.hs | |
parent | 4d69e01dea8515d9cbccfbf2f793c98a1a752539 (diff) | |
download | keysafe-48e49d83867a5335f5e45a42dbac202caa42cd5d.tar.gz |
implemented dynamic rate limiting
Diffstat (limited to 'HTTP/Server.hs')
-rw-r--r-- | HTTP/Server.hs | 20 |
1 files changed, 11 insertions, 9 deletions
diff --git a/HTTP/Server.hs b/HTTP/Server.hs index 65d3d32..aab3dab 100644 --- a/HTTP/Server.hs +++ b/HTTP/Server.hs @@ -13,6 +13,7 @@ import HTTP.RateLimit import Types import Types.Storage import Tunables +import CmdLine (ServerConfig(..)) import Storage.Local import Serialization () import Servant @@ -20,6 +21,7 @@ import Network.Wai import Network.Wai.Handler.Warp import Control.Monad.IO.Class import Control.Concurrent +import Control.Concurrent.Thread.Delay import Control.Concurrent.STM import Data.String import qualified Data.ByteString as B @@ -30,20 +32,20 @@ data ServerState = ServerState , rateLimiter :: RateLimiter } -newServerState :: Maybe LocalStorageDirectory -> IO ServerState -newServerState d = ServerState +newServerState :: Maybe LocalStorageDirectory -> ServerConfig -> IO ServerState +newServerState d cfg = ServerState <$> newEmptyTMVarIO <*> pure d - <*> newRateLimiter + <*> newRateLimiter cfg d -runServer :: Maybe LocalStorageDirectory -> String -> Port -> IO () -runServer d bindaddress port = do - st <- newServerState d +runServer :: Maybe LocalStorageDirectory -> ServerConfig -> IO () +runServer d cfg = do + st <- newServerState d cfg _ <- forkIO $ obscurerThread st runSettings settings (app st) where - settings = setHost host $ setPort port $ defaultSettings - host = fromString bindaddress + settings = setHost host $ setPort (serverPort cfg) $ defaultSettings + host = fromString (serverAddress cfg) serverStorage :: ServerState -> Storage serverStorage st = localStorage (storageDir $ storageDirectory st) "server" @@ -100,7 +102,7 @@ obscurerThread :: ServerState -> IO () obscurerThread st = do _ <- obscureShares (serverStorage st) putStrLn "obscured shares" - threadDelay (1000000*60*30) + delay (1000000*60*30) _ <- atomically $ takeTMVar (obscurerRequest st) obscurerThread st |