use less expensive hash for proof of work

The server has to run the hash once to verify a request, so a hash that
took 4 seconds could make the server do too much work if it's being flooded
with requests.

So, made the hash much less expensive.

This required keeping track of fractional seconds. Actually, I used
Rational for them, to avoid most rounding problems. That turned out nice.

I've only tuned the proofOfWorkHashTunable on my fanless overheating
laptop so far. It seems to be fairly reasonablly tuned though.

2 files changed, 18 insertions, 9 deletions

diff --git a/HTTP/ProofOfWork.hs b/HTTP/ProofOfWork.hs
index 476ba87..35b5ffd 100644
--- a/HTTP/ProofOfWork.hs
+++ b/HTTP/ProofOfWork.hs
@@ -21,6 +21,7 @@ import Raaz.Core.Encode
 import qualified Raaz
 import Data.BloomFilter.Hash
 import Control.Monad
+import Control.DeepSeq
 import Data.Word
 import Data.Bits
 import Data.Monoid
@@ -28,7 +29,9 @@ import Prelude
 
 -- | A value that the client has to do some work to calculate.
 data ProofOfWork = ProofOfWork B.ByteString RequestID
-	deriving (Show)
+	deriving (Show, Generic)
+
+instance NFData ProofOfWork
 
 data ProofOfWorkRequirement = ProofOfWorkRequirement
 	{ leadingZeros :: Int
@@ -45,10 +48,7 @@ data RequestID = RequestID
 	}
 	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 NFData RequestID
 
 instance Hashable RequestID where
 	hashIO32 = hashIO32 . hashRequestID
@@ -58,6 +58,13 @@ hashRequestID :: RequestID -> B.ByteString
 hashRequestID rid = encodeUtf8 (fromRandomSalt (randomSalt rid)) 
 	<> ":" <> encodeUtf8 (requestHMAC rid)
 
+-- | Using Text and not ByteString so that ProofOfWorkRequirement can have a
+-- JSON instance.
+newtype RandomSalt = RandomSalt { fromRandomSalt :: T.Text }
+	deriving (Generic, Show, Eq)
+
+instance NFData RandomSalt
+
 -- | 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
 -- the proof of work, a client counts that cumulatively. So, a server
@@ -82,7 +89,7 @@ mkProofOfWorkRequirement (Seconds n)
 	| lz < 1 = Nothing
 	| otherwise = Just $ ProofOfWorkRequirement lz its
   where
-	lz = floor (logBase 2 (max 1 (fromIntegral n / fromIntegral s)) :: Double)
+	lz = floor (logBase 2 (fromRational (max 1 (n / s))) :: Double)
 	UseArgon2 (CPUCost (Seconds s) _) _ = proofOfWorkHashTunable its
 	its = 0
 
@@ -125,10 +132,12 @@ data NoPOWIdent = NoPOWIdent
 instance POWIdent NoPOWIdent where
 	getPOWIdent NoPOWIdent = B.empty
 
+instance POWIdent Int where
+	getPOWIdent = encodeUtf8 . T.pack . show
+
 -- Note that this does not check validRequestID.
 isValidProofOfWork :: POWIdent p => ProofOfWork -> ProofOfWorkRequirement -> p -> Bool
-isValidProofOfWork (ProofOfWork pow rid) req p =
-	samerequestids && enoughzeros
+isValidProofOfWork (ProofOfWork pow rid) req p = samerequestids && enoughzeros
   where
 	samerequestids = rid == requestID req
 	enoughzeros = all (== False) (take (leadingZeros req) (setBits b))
diff --git a/HTTP/RateLimit.hs b/HTTP/RateLimit.hs
index 45c6b9a..39d7dbc 100644
--- a/HTTP/RateLimit.hs
+++ b/HTTP/RateLimit.hs
@@ -104,7 +104,7 @@ newRateLimiter cfg storedir logger = do
 			<*> pure minFillInterval
 		return (b:bs)
 
-	sdiv (Seconds n) d = Seconds (n `div` d)
+	sdiv (Seconds n) d = Seconds (n / d)
 
 mkBloomFilter :: IO BloomFilter
 mkBloomFilter = do