implement client-server Proof Of Work

Mashed up a argon2-based PoW with token buckets and bloom filters.
This is intended to prevent a few abuses including:

* Using a keysafe server for general file storage, by storing a whole
  lot of chunks.
* An attacker guessing names that people will use, and uploading junk
  to keysafe servers under those names, to make it harder for others to use
  keysafe later.
* An attacker trying to guess the names used for objects on keysafe
  servers in order to download them and start password cracking.
  (As a second level of defense, since the name generation hash
  is expensive already.)

Completely untested, but it builds!

This commit was sponsored by Andreas on Patreon.

1 files changed, 12 insertions, 9 deletions

diff --git a/HTTP/Server.hs b/HTTP/Server.hs
index ab27aaa..dd35d1c 100644
--- a/HTTP/Server.hs
+++ b/HTTP/Server.hs
@@ -9,6 +9,7 @@ module HTTP.Server (runServer) where
 
 import HTTP
 import HTTP.ProofOfWork
+import HTTP.RateLimit
 import Types
 import Types.Storage
 import Tunables
@@ -26,12 +27,14 @@ import qualified Data.ByteString as B
 data ServerState = ServerState
 	{ obscurerRequest :: TMVar ()
 	, storageDirectory :: Maybe LocalStorageDirectory
+	, rateLimiter :: RateLimiter
 	}
 
 newServerState :: Maybe LocalStorageDirectory -> IO ServerState
 newServerState d = ServerState
 	<$> newEmptyTMVarIO
 	<*> pure d
+	<*> newRateLimiter
 
 runServer :: Maybe LocalStorageDirectory -> String -> Port -> IO ()
 runServer d bindaddress port = do
@@ -60,30 +63,30 @@ server st = motd
 motd :: Handler Motd
 motd = return $ Motd "Hello World!"
 
-getObject :: ServerState -> StorableObjectIdent -> Maybe ProofOfWork -> Handler (ProofOfWorkRequirement StorableObject)
-getObject st i _pow = do
+getObject :: ServerState -> StorableObjectIdent -> Maybe ProofOfWork -> Handler (POWGuarded StorableObject)
+getObject st i pow = rateLimit (rateLimiter st) pow i $ do
 	r <- liftIO $ retrieveShare (serverStorage st) dummyShareNum i
 	liftIO $ requestObscure st
 	case r of
-		RetrieveSuccess (Share _n o) -> return $ Result o
+		RetrieveSuccess (Share _n o) -> return o
 		RetrieveFailure _ -> throwError err404
 
-putObject :: ServerState -> StorableObjectIdent -> Maybe ProofOfWork -> StorableObject -> Handler (ProofOfWorkRequirement StoreResult)
-putObject st i _pow o = do
+putObject :: ServerState -> StorableObjectIdent -> Maybe ProofOfWork -> StorableObject -> Handler (POWGuarded StoreResult)
+putObject st i pow o = rateLimit (rateLimiter st) pow i $ do
 	if validObjectsize o
 		then do
 			r <- liftIO $ storeShare (serverStorage st) i (Share dummyShareNum o)
 			liftIO $ requestObscure st
-			return $ Result r
-		else return $ Result $ StoreFailure "invalid object size"
+			return r
+		else return $ StoreFailure "invalid object size"
 
 validObjectsize :: StorableObject -> Bool
 validObjectsize o = any (sz ==) knownObjectSizes
   where
 	sz = B.length (fromStorableObject o)
 
-countObjects :: ServerState -> Maybe ProofOfWork -> Handler (ProofOfWorkRequirement CountResult)
-countObjects st _pow = liftIO $ Result <$> countShares (serverStorage st)
+countObjects :: ServerState -> Handler CountResult
+countObjects = liftIO . countShares . serverStorage
 
 -- | 1 is a dummy value; the server does not know the actual share numbers.
 dummyShareNum :: ShareNum