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, 32 insertions, 14 deletions

diff --git a/Storage/Network.hs b/Storage/Network.hs
index 24f1c7d..6053ff3 100644
--- a/Storage/Network.hs
+++ b/Storage/Network.hs
@@ -14,8 +14,10 @@ module Storage.Network (
 
 import Types
 import Types.Storage
+import Types.Cost
 import Data.List
 import Data.Char
+import HTTP
 import HTTP.Client
 import HTTP.ProofOfWork
 import Servant.Client
@@ -58,12 +60,12 @@ networkStorage server = Storage
 
 store :: Server -> StorableObjectIdent -> Share -> IO StoreResult
 store srv i (Share _n o) = 
-	serverRequest srv StoreFailure id $ \pow ->
+	serverRequest srv StoreFailure id i $ \pow ->
 		putObject i pow o
 
 retrieve :: Server -> ShareNum -> StorableObjectIdent -> IO RetrieveResult
 retrieve srv n i = 
-	serverRequest srv RetrieveFailure (RetrieveSuccess . Share n) $
+	serverRequest srv RetrieveFailure (RetrieveSuccess . Share n) i $
 		getObject i
 
 -- | Servers should automatically obscure, so do nothing.
@@ -72,7 +74,7 @@ obscure :: Server -> IO ObscureResult
 obscure _ = return ObscureSuccess
 
 count :: Server -> IO CountResult
-count srv = serverRequest srv CountFailure id countObjects
+count srv = either CountFailure id <$> serverRequest' srv countObjects
 
 -- | Not needed for servers.
 move :: Server -> Storage -> IO ()
@@ -82,23 +84,39 @@ serverRequest
 	:: Server
 	-> (String -> a)
 	-> (r -> a)
-	-> (Maybe ProofOfWork -> Manager -> BaseUrl -> ExceptT ServantError IO (ProofOfWorkRequirement r))
+	-> StorableObjectIdent
+	-> (Maybe ProofOfWork -> Manager -> BaseUrl -> ExceptT ServantError IO (POWGuarded r))
 	-> IO a
-serverRequest srv onerr onsuccess a = 
+serverRequest srv onerr onsuccess i a = go Nothing maxProofOfWork
+  where
+	go pow (Seconds timeleft)
+		| timeleft <= 0 = return $ onerr "server asked for too much proof of work; gave up"
+		| otherwise = do
+			res <- serverRequest' srv (a pow)
+			case res of
+				Left err -> return $ onerr err
+				Right (Result r) -> return $ onsuccess r
+				Right (NeedProofOfWork req) -> go
+					(Just $ genProofOfWork req i)
+					(Seconds timeleft - generationTime req)
+
+serverRequest'
+	:: Server
+	-> (Manager -> BaseUrl -> ExceptT ServantError IO r)
+	-> IO (Either String r)
+serverRequest' srv a = do
 	-- A new Manager is allocated for each request, rather than reusing
 	-- any connection. This is a feature; it makes correlation attacks
 	-- harder because the server can't tell if two connections
-	-- (over tor) came from the same user.
-	go Nothing =<< torableManager
+	-- accessing different objects came from the same user, except by
+	-- comparing IP addresses (which are masked somewhat by using tor).
+	manager <- torableManager
+	res <- runExceptT $ a manager url
+	return $ case res of
+		Left err -> Left $ "server failure: " ++ show err
+		Right r -> Right r
   where
 	url = serverUrl srv
-	go pow manager = do
-		res <- runExceptT $ a pow manager url
-		case res of
-			Left err -> return $ onerr $ 
-				"server failure: " ++ show err
-			Right (Result r) -> return $ onsuccess r
-			Right needpow -> error "NEEDPOW" -- loop with pow
 
 -- | HTTP Manager supporting tor .onion and regular hosts
 torableManager :: IO Manager