diff options
author | Joey Hess <joeyh@joeyh.name> | 2016-09-12 22:35:47 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2016-09-12 22:39:21 -0400 |
commit | 13c408d2295597540f0b2dfb6f7b86e739876c90 (patch) | |
tree | cac72a6d5a75fb15d71d5e86395543829fe2f2df /HTTP/ProofOfWork.hs | |
parent | 483cc9e1fe40899c7f045d71d75aaa5ca99db3fb (diff) | |
download | keysafe-13c408d2295597540f0b2dfb6f7b86e739876c90.tar.gz |
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.
Diffstat (limited to 'HTTP/ProofOfWork.hs')
-rw-r--r-- | HTTP/ProofOfWork.hs | 116 |
1 files changed, 107 insertions, 9 deletions
diff --git a/HTTP/ProofOfWork.hs b/HTTP/ProofOfWork.hs index 45cc96d..04aec57 100644 --- a/HTTP/ProofOfWork.hs +++ b/HTTP/ProofOfWork.hs @@ -4,19 +4,117 @@ -} {-# LANGUAGE DeriveGeneric #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} module HTTP.ProofOfWork where import Types -import qualified Data.Text as T +import Types.Cost +import ExpensiveHash +import Tunables +import ByteStrings import GHC.Generics +import qualified Data.Text as T +import qualified Data.ByteString as B +import Data.Text.Encoding (encodeUtf8) +import Raaz.Core.Encode +import qualified Raaz +import Data.BloomFilter.Hash +import Control.Monad +import Data.Word +import Data.Bits +import Data.Monoid +import Prelude + +-- | A value that the client has to do some work to calculate. +data ProofOfWork = ProofOfWork B.ByteString RandomSalt + deriving (Show) + +data ProofOfWorkRequirement = ProofOfWorkRequirement + { leadingZeros :: Int + , addedArgon2Iterations :: Word32 + , randomSalt :: RandomSalt + } + deriving (Generic, Show) + +-- | 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 + +-- | 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 +-- should avoid any single proof of work requirement taking more than half +-- this long. +maxProofOfWork :: Seconds +maxProofOfWork = Seconds (16*60) + +-- | How long it will take to generate a proof of work meeting the +-- requirement, maximum. +-- +-- Of course, a client can get lucky and find a value that works +-- on the very first try. On average, the client will need to work for half +-- as long as the returned number of Seconds. +generationTime :: ProofOfWorkRequirement -> Seconds +generationTime req = + let UseArgon2 (CPUCost (Seconds s) _) _ = proofOfWorkHashTunable (addedArgon2Iterations req) + in Seconds ((2^(leadingZeros req)) * s) + +mkProofOfWorkRequirement :: Seconds -> Maybe (RandomSalt -> ProofOfWorkRequirement) +mkProofOfWorkRequirement (Seconds n) + | lz < 1 = Nothing + | otherwise = Just $ ProofOfWorkRequirement lz its + where + lz = floor (logBase 2 (max 1 (fromIntegral n / fromIntegral s)) :: Double) + UseArgon2 (CPUCost (Seconds s) _) _ = proofOfWorkHashTunable its + its = 0 + +mkRandomSalt :: IO RandomSalt +mkRandomSalt = do + prg <- Raaz.newPRG () :: IO Raaz.SystemPRG + rs <- replicateM 16 (Raaz.random prg :: IO Word8) + return $ RandomSalt $ T.pack $ concatMap show rs + +instance Raaz.Random Word8 + +isValidProofOfWork :: ProofOfWork -> ProofOfWorkRequirement -> StorableObjectIdent -> Bool +isValidProofOfWork (ProofOfWork pow rsalt) req (StorableObjectIdent n) = + samesalts && enoughzeros + where + samesalts = rsalt == randomSalt req + enoughzeros = all (== False) (take (leadingZeros req) (setBits b)) + tunable = proofOfWorkHashTunable (addedArgon2Iterations req) + salt = Salt $ POWSalt $ + encodeUtf8 (fromRandomSalt (randomSalt req)) <> pow + ExpensiveHash _ hash = expensiveHash tunable salt n + -- Since expensiveHash generates an ascii encoded hash that + -- includes the parameters, take the sha256 of it to get the + -- bytestring that is what's checked for the neccesary number + -- of leading 0 bits. + b = Raaz.toByteString $ Raaz.sha256 $ encodeUtf8 hash + +setBits :: B.ByteString -> [Bool] +setBits = concatMap go . B.unpack + where + go byte = map (uncurry testBit) (zip (repeat byte) [0..7]) + +newtype POWSalt = POWSalt B.ByteString -data ProofOfWorkRequirement t - = Result t - | ProofOfWorkRequirement - { leadingZeros :: Int - , argon2Iterations :: Int - } - deriving (Generic) +instance Encodable POWSalt where + toByteString (POWSalt n) = n + fromByteString = Just . POWSalt -newtype ProofOfWork = ProofOfWork T.Text +genProofOfWork :: ProofOfWorkRequirement -> StorableObjectIdent -> ProofOfWork +genProofOfWork req i = go allByteStrings + where + go [] = error "failed to generate Proof Of Work. This should be impossible!" + go (b:bs) + | isValidProofOfWork candidate req i = candidate + | otherwise = go bs + where + candidate = ProofOfWork b (randomSalt req) |