diff options
Diffstat (limited to 'HTTP/ProofOfWork.hs')
| -rw-r--r-- | HTTP/ProofOfWork.hs | 57 |
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) |