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, 45 insertions, 12 deletions

diff --git a/HTTP/ProofOfWork.hs b/HTTP/ProofOfWork.hs
index ef6ecfb..476ba87 100644
--- a/HTTP/ProofOfWork.hs
+++ b/HTTP/ProofOfWork.hs
@@ -3,7 +3,7 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
-{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveGeneric, OverloadedStrings #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module HTTP.ProofOfWork where
@@ -27,24 +27,36 @@ import Data.Monoid
 import Prelude
 
 -- | A value that the client has to do some work to calculate.
-data ProofOfWork = ProofOfWork B.ByteString RandomSalt
+data ProofOfWork = ProofOfWork B.ByteString RequestID
 	deriving (Show)
 
 data ProofOfWorkRequirement = ProofOfWorkRequirement
 	{ leadingZeros :: Int
 	, addedArgon2Iterations :: Word32
-	, randomSalt :: RandomSalt
+	, requestID :: RequestID
 	}
 	deriving (Generic, Show)
 
+-- | A request ID has two parts, a RandomSalt and a HMAC.
+-- The server can verify if a request ID is one it generated.
+data RequestID = RequestID
+	{ randomSalt :: RandomSalt
+	, requestHMAC :: T.Text
+	}
+	deriving (Generic, Show, Eq)
+
 -- | Using Text and not ByteString so that ProofOfWorkRequirement can have a
 -- JSON instance.
 newtype RandomSalt = RandomSalt { fromRandomSalt :: T.Text }
 	deriving (Generic, Show, Eq)
 
-instance Hashable RandomSalt where
-	hashIO32 = hashIO32 . encodeUtf8 . fromRandomSalt
-	hashIO64 = hashIO64 . encodeUtf8 . fromRandomSalt
+instance Hashable RequestID where
+	hashIO32 = hashIO32 . hashRequestID
+	hashIO64 = hashIO64 . hashRequestID
+
+hashRequestID :: RequestID -> B.ByteString
+hashRequestID rid = encodeUtf8 (fromRandomSalt (randomSalt rid)) 
+	<> ":" <> encodeUtf8 (requestHMAC rid)
 
 -- | Servers should never demand a proof of work that takes longer than
 -- this to generate. Note that if a server changes its mind and doubles
@@ -65,7 +77,7 @@ generationTime req =
 	let UseArgon2 (CPUCost (Seconds s) _) _ = proofOfWorkHashTunable (addedArgon2Iterations req)
 	in Seconds ((2^(leadingZeros req)) * s)
 
-mkProofOfWorkRequirement :: Seconds -> Maybe (RandomSalt -> ProofOfWorkRequirement)
+mkProofOfWorkRequirement :: Seconds -> Maybe (RequestID -> ProofOfWorkRequirement)
 mkProofOfWorkRequirement (Seconds n)
 	| lz < 1 = Nothing
 	| otherwise = Just $ ProofOfWorkRequirement lz its
@@ -74,6 +86,26 @@ mkProofOfWorkRequirement (Seconds n)
 	UseArgon2 (CPUCost (Seconds s) _) _ = proofOfWorkHashTunable its
 	its = 0
 
+newtype RequestIDSecret = RequestIDSecret (Raaz.Key (Raaz.HMAC Raaz.SHA256))
+
+newRequestIDSecret :: IO RequestIDSecret
+newRequestIDSecret = do
+	prg <- Raaz.newPRG () :: IO Raaz.SystemPRG
+	RequestIDSecret <$> Raaz.random prg
+
+mkRequestID :: RequestIDSecret -> IO RequestID
+mkRequestID secret = mkRequeestID' secret <$> mkRandomSalt
+
+mkRequeestID' :: RequestIDSecret -> RandomSalt -> RequestID
+mkRequeestID' (RequestIDSecret key) salt =
+	let hmac = Raaz.hmacSha256 key (encodeUtf8 $ fromRandomSalt salt)
+	in RequestID salt (T.pack (showBase16 hmac))
+
+validRequestID :: RequestIDSecret -> RequestID -> Bool
+validRequestID secret rid =
+	let rid' = mkRequeestID' secret (randomSalt rid)
+	in requestHMAC rid == requestHMAC rid'
+
 mkRandomSalt :: IO RandomSalt
 mkRandomSalt = do
 	prg <- Raaz.newPRG () :: IO Raaz.SystemPRG
@@ -93,15 +125,16 @@ data NoPOWIdent = NoPOWIdent
 instance POWIdent NoPOWIdent where
 	getPOWIdent NoPOWIdent = B.empty
 
+-- Note that this does not check validRequestID.
 isValidProofOfWork :: POWIdent p => ProofOfWork -> ProofOfWorkRequirement -> p -> Bool
-isValidProofOfWork (ProofOfWork pow rsalt) req p =
-	samesalts && enoughzeros
+isValidProofOfWork (ProofOfWork pow rid) req p =
+	samerequestids && enoughzeros
   where
-	samesalts = rsalt == randomSalt req
+	samerequestids = rid == requestID req
 	enoughzeros = all (== False) (take (leadingZeros req) (setBits b))
 	tunable = proofOfWorkHashTunable (addedArgon2Iterations req)
 	salt = Salt $ POWSalt $
-		encodeUtf8 (fromRandomSalt (randomSalt req)) <> pow
+		encodeUtf8 (fromRandomSalt (randomSalt (requestID req))) <> pow
 	ExpensiveHash _ hash = expensiveHash tunable salt (getPOWIdent p)
 	-- Since expensiveHash generates an ascii encoded hash that
 	-- includes the parameters, take the sha256 of it to get the
@@ -128,4 +161,4 @@ genProofOfWork req p = go allByteStrings
 		| isValidProofOfWork candidate req p = candidate
 		| otherwise = go bs
 	  where
-		candidate = ProofOfWork b (randomSalt req)
+		candidate = ProofOfWork b (requestID req)