eliminate half the bloom filters, using HMAC to verify RequestIDs

Simplifies code, uses less memory, and don't need to protect
against flooding generation of RequestIDs, since the server does not store
them at all.

Note that the RequestIDSecret is only stored in ram, so restarting the
server will invalidate any RequestIds given out before. It would be
possible now to store that on disk to avoid that problem, but probably not
worth it.

1 files changed, 51 insertions, 70 deletions

diff --git a/HTTP/RateLimit.hs b/HTTP/RateLimit.hs
index 194e798..45c6b9a 100644
--- a/HTTP/RateLimit.hs
+++ b/HTTP/RateLimit.hs
@@ -34,22 +34,19 @@ import Control.Monad.IO.Class
 -- successively more difficult proof of work access requirement.
 -- 
 -- To guard against DOS attacks that reuse the same proof of work,
--- RandomSalt values are used, and bloom filters keep track of
--- the ones that have been assigned and used.
+-- bloom filters keep track of RequestIDs that have been used before.
 data RateLimiter = RateLimiter
 	{ buckets :: TMVar [Bucket]
 	, unusedBuckets :: TMVar [Bucket]
 	, fallbackQueue :: FallbackQueue
-	, assignedRandomSalts :: BloomFilter
-	, assignedRandomSaltsOld :: BloomFilter
-	, usedRandomSalts :: BloomFilter
-	, usedRandomSaltsOld :: BloomFilter
-	, numRandomSalts :: TMVar Int
-	, randomSaltGenerationLimiter :: TokenBucket
+	, usedRequestIDs :: BloomFilter
+	, usedRequestIDsOld :: BloomFilter
+	, numUsedRequestIDs :: TMVar Int
+	, requestIDSecret :: RequestIDSecret
 	, requestCounter :: TMVar Integer
 	}
 
-type BloomFilter = TMVar (BloomFilter.MBloom RealWorld RandomSalt)
+type BloomFilter = TMVar (BloomFilter.MBloom RealWorld RequestID)
 
 -- | Buckets fill up at a fixed rate, and accessing a bucket
 -- removes one unit from it.
@@ -78,10 +75,8 @@ newRateLimiter cfg storedir logger = do
 		<*> newFallbackQueue
 		<*> mkBloomFilter
 		<*> mkBloomFilter
-		<*> mkBloomFilter
-		<*> mkBloomFilter
 		<*> newTMVarIO 0
-		<*> newTokenBucket
+		<*> newRequestIDSecret
 		<*> newTMVarIO 0
 	_ <- forkIO (adjusterThread cfg storedir rl logger)
 	return rl
@@ -121,7 +116,7 @@ mkBloomFilter = do
 	-- of memory.
 	(bloomhashes, bloomsize) = suggestSizing bloomMaxSize (1/100000)
 
--- | Maximum number of RandomSalts that can be stored in a bloom filter
+-- | Maximum number of RequestIDs that can be stored in a bloom filter
 -- without the false positive rate getting bad.
 bloomMaxSize :: Int
 bloomMaxSize = 1000000
@@ -130,21 +125,21 @@ bloomMaxSize = 1000000
 -- access to, until one is found that accepts it.
 rateLimit :: POWIdent p => RateLimiter -> Logger -> Maybe ProofOfWork -> p -> Handler a -> Handler (POWGuarded a)
 rateLimit ratelimiter logger mpow p a = do
-	validsalt <- liftIO $ checkValidSalt ratelimiter mpow
 	bs <- getBuckets ratelimiter
-	if validsalt
+	validrequest <- liftIO $ checkValidRequestID ratelimiter logger mpow
+	if validrequest
 		then go bs
-		else assignWork ratelimiter logger bs
+		else assignWork ratelimiter bs
   where
 	go [] = fallback ratelimiter logger a
 	go (b:bs) = case mkProofOfWorkRequirement (proofOfWorkRequired b) of
 		Nothing -> checkbucket b bs
 		Just mkreq -> case mpow of
-			Nothing -> assignWork ratelimiter logger (b:bs)
-			Just pow@(ProofOfWork _ salt) -> 
-				if isValidProofOfWork pow (mkreq salt) p
+			Nothing -> assignWork ratelimiter (b:bs)
+			Just pow@(ProofOfWork _ rid) -> 
+				if isValidProofOfWork pow (mkreq rid) p
 					then checkbucket b bs
-					else assignWork ratelimiter logger (b:bs)
+					else assignWork ratelimiter (b:bs)
 	checkbucket b bs = do
 		allowed <- liftIO $ tokenBucketTryAlloc (tokenBucket b) 
 			burstSize (fillInterval b) 1
@@ -152,69 +147,55 @@ rateLimit ratelimiter logger mpow p a = do
 			then allowRequest ratelimiter a
 			else go bs
 
-checkValidSalt :: RateLimiter -> Maybe ProofOfWork -> IO Bool
-checkValidSalt _ Nothing = return True
-checkValidSalt rl (Just (ProofOfWork _ salt)) = do
-	assigned <- iselem assignedRandomSalts
-	oldassigned <- iselem assignedRandomSaltsOld
-	used <- iselem usedRandomSalts
-	oldused <- iselem usedRandomSaltsOld
-	if assigned && not oldassigned && not used && not oldused
-		then do
-			withBloomFilter rl usedRandomSalts
-				(`BloomFilter.insert` salt)
-			return True
-		else return False
+checkValidRequestID :: RateLimiter -> Logger -> Maybe ProofOfWork -> IO Bool
+checkValidRequestID _ _ Nothing = return True
+checkValidRequestID rl logger (Just (ProofOfWork _ rid))
+	| validRequestID (requestIDSecret rl) rid = do
+		used <- iselem usedRequestIDs
+		oldused <- iselem usedRequestIDsOld
+		if not used && not oldused
+			then do
+				withBloomFilter rl usedRequestIDs
+					(`BloomFilter.insert` rid)
+				checkbloomsize
+				return True
+			else return False
+	| otherwise = return False
   where
-	iselem f = withBloomFilter rl f (BloomFilter.elem salt)
-
-assignWork :: RateLimiter -> Logger -> [Bucket] -> Handler (POWGuarded a)
-assignWork ratelimiter logger bs = case mapMaybe (mkProofOfWorkRequirement . proofOfWorkRequired) bs of
-	[] -> throwError err404
-	(mkreq:_) -> liftIO $ do
-		-- This prevents an attacker flooding requests that 
-		-- cause new random salts to be assigned, in order 
-		-- to fill up the bloom table and cause salts assigned 
-		-- to other clients to be rejected.
-		-- Since the bloom filters hold 1 million salts,
-		-- the attacker would need to send requests for over 10
-		-- hours to force a bloom filter rotation, so would not
-		-- impact many users.
-		tokenBucketWait (randomSaltGenerationLimiter ratelimiter)
-			100 -- burst
-			1000000 -- refill 1 token per second
-
-		salt <- liftIO mkRandomSalt
-		withBloomFilter ratelimiter assignedRandomSalts
-			(`BloomFilter.insert` salt)
+	iselem f = withBloomFilter rl f (BloomFilter.elem rid)
+
+	checkbloomsize = do
 		needrot <- atomically $ do
-			n <- takeTMVar (numRandomSalts ratelimiter)
+			n <- takeTMVar (numUsedRequestIDs rl)
 			if n > bloomMaxSize `div` 2
-				then return Nothing
+				then return (Just n)
 				else do
-					putTMVar (numRandomSalts ratelimiter) (n+1)
-					return (Just n)
+					putTMVar (numUsedRequestIDs rl) (n+1)
+					return Nothing
 		handlerotation needrot
-		return $ NeedProofOfWork $ mkreq salt
-  where
+
 	handlerotation Nothing = return ()
 	handlerotation (Just n) = do
 		logStderr logger $ "rotating bloom filters after processing " ++ show n ++ " requests"
-		newassigned <- mkBloomFilter
 		newused <- mkBloomFilter
 		atomically $ do
-			oldassigned <- takeTMVar (assignedRandomSalts ratelimiter)
-			oldused <- takeTMVar (usedRandomSalts ratelimiter)
-			putTMVar (assignedRandomSaltsOld ratelimiter) oldassigned
-			putTMVar (usedRandomSaltsOld ratelimiter) oldused
-			putTMVar (assignedRandomSalts ratelimiter) =<< takeTMVar newassigned
-			putTMVar (usedRandomSalts ratelimiter) =<< takeTMVar newused
-			putTMVar (numRandomSalts ratelimiter) 0
+			oldused <- takeTMVar (usedRequestIDs rl)
+			putTMVar (usedRequestIDsOld rl) oldused
+			putTMVar (usedRequestIDs rl) =<< takeTMVar newused
+			putTMVar (numUsedRequestIDs rl) 0
+
+assignWork :: RateLimiter -> [Bucket] -> Handler (POWGuarded a)
+assignWork ratelimiter bs = 
+	case mapMaybe (mkProofOfWorkRequirement . proofOfWorkRequired) bs of
+		[] -> throwError err404
+		(mkreq:_) -> do
+			rid <- liftIO $ mkRequestID $ requestIDSecret ratelimiter
+			return $ NeedProofOfWork $ mkreq rid
 
 withBloomFilter
 	:: RateLimiter
 	-> (RateLimiter -> BloomFilter)
-	-> (BloomFilter.MBloom RealWorld RandomSalt -> ST RealWorld a)
+	-> (BloomFilter.MBloom RealWorld RequestID -> ST RealWorld a)
 	-> IO a
 withBloomFilter rl field a = do
 	b <- atomically $ readTMVar (field rl)
@@ -294,7 +275,7 @@ fallback ratelimiter logger a =
 	
 	giveup = do
 		liftIO $ logStderr logger "** warning: All token buckets are empty and request queue is large; possible DOS attack? Rejected request.."
-		assignWork ratelimiter logger =<< getBuckets ratelimiter
+		assignWork ratelimiter =<< getBuckets ratelimiter
 
 -- | How much data could be stored, in bytes per second, assuming all
 -- buckets in the rate limiter being constantly drained by requests,