diff options
| -rw-r--r-- | HTTP.hs | 4 | ||||
| -rw-r--r-- | HTTP/Client.hs | 2 | ||||
| -rw-r--r-- | HTTP/ProofOfWork.hs | 23 | ||||
| -rw-r--r-- | HTTP/RateLimit.hs | 7 | ||||
| -rw-r--r-- | HTTP/Server.hs | 5 | ||||
| -rw-r--r-- | Storage/Network.hs | 11 |
6 files changed, 32 insertions, 20 deletions
@@ -36,8 +36,8 @@ type HttpAPI = :<|> "keysafe" :> V1 :> "objects" :> ObjectIdent :> POWParam :> ReqBody '[OctetStream] StorableObject :> Put '[JSON] (POWGuarded StoreResult) - :<|> "keysafe" :> V1 :> "stats" :> "countobjects" - :> Get '[JSON] CountResult + :<|> "keysafe" :> V1 :> "stats" :> "countobjects" :> POWParam + :> Get '[JSON] (POWGuarded CountResult) type V1 = "v1" diff --git a/HTTP/Client.hs b/HTTP/Client.hs index 8f81db4..74381be 100644 --- a/HTTP/Client.hs +++ b/HTTP/Client.hs @@ -20,5 +20,5 @@ httpAPI = Proxy motd :: Manager -> BaseUrl -> ClientM Motd getObject :: StorableObjectIdent -> Maybe ProofOfWork -> Manager -> BaseUrl -> ClientM (POWGuarded StorableObject) putObject :: StorableObjectIdent -> Maybe ProofOfWork -> StorableObject -> Manager -> BaseUrl -> ClientM (POWGuarded StoreResult) -countObjects :: Manager -> BaseUrl -> ClientM CountResult +countObjects :: Maybe ProofOfWork -> Manager -> BaseUrl -> ClientM (POWGuarded CountResult) motd :<|> getObject :<|> putObject :<|> countObjects = client httpAPI diff --git a/HTTP/ProofOfWork.hs b/HTTP/ProofOfWork.hs index 04aec57..ef6ecfb 100644 --- a/HTTP/ProofOfWork.hs +++ b/HTTP/ProofOfWork.hs @@ -82,8 +82,19 @@ mkRandomSalt = do instance Raaz.Random Word8 -isValidProofOfWork :: ProofOfWork -> ProofOfWorkRequirement -> StorableObjectIdent -> Bool -isValidProofOfWork (ProofOfWork pow rsalt) req (StorableObjectIdent n) = +class POWIdent p where + getPOWIdent :: p -> B.ByteString + +instance POWIdent StorableObjectIdent where + getPOWIdent (StorableObjectIdent i) = i + +data NoPOWIdent = NoPOWIdent + +instance POWIdent NoPOWIdent where + getPOWIdent NoPOWIdent = B.empty + +isValidProofOfWork :: POWIdent p => ProofOfWork -> ProofOfWorkRequirement -> p -> Bool +isValidProofOfWork (ProofOfWork pow rsalt) req p = samesalts && enoughzeros where samesalts = rsalt == randomSalt req @@ -91,7 +102,7 @@ isValidProofOfWork (ProofOfWork pow rsalt) req (StorableObjectIdent n) = tunable = proofOfWorkHashTunable (addedArgon2Iterations req) salt = Salt $ POWSalt $ encodeUtf8 (fromRandomSalt (randomSalt req)) <> pow - ExpensiveHash _ hash = expensiveHash tunable salt n + 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 -- bytestring that is what's checked for the neccesary number @@ -109,12 +120,12 @@ instance Encodable POWSalt where toByteString (POWSalt n) = n fromByteString = Just . POWSalt -genProofOfWork :: ProofOfWorkRequirement -> StorableObjectIdent -> ProofOfWork -genProofOfWork req i = go allByteStrings +genProofOfWork :: POWIdent p => ProofOfWorkRequirement -> p -> ProofOfWork +genProofOfWork req p = go allByteStrings where go [] = error "failed to generate Proof Of Work. This should be impossible!" go (b:bs) - | isValidProofOfWork candidate req i = candidate + | isValidProofOfWork candidate req p = candidate | otherwise = go bs where candidate = ProofOfWork b (randomSalt req) diff --git a/HTTP/RateLimit.hs b/HTTP/RateLimit.hs index 9153664..737f7dc 100644 --- a/HTTP/RateLimit.hs +++ b/HTTP/RateLimit.hs @@ -5,7 +5,6 @@ module HTTP.RateLimit where -import Types import Types.Cost import HTTP import HTTP.ProofOfWork @@ -107,8 +106,8 @@ fillRate = 60000000 -- 1 token per minute -- If all buckets are tried and are empty, we must be very overloaded. -- In this case, the request is still processed, since the client has done -- quite a lot of work. -rateLimit :: RateLimiter -> Maybe ProofOfWork -> StorableObjectIdent -> Handler a -> Handler (POWGuarded a) -rateLimit ratelimiter mpow i a = do +rateLimit :: POWIdent p => RateLimiter -> Maybe ProofOfWork -> p -> Handler a -> Handler (POWGuarded a) +rateLimit ratelimiter mpow p a = do validsalt <- liftIO $ checkValidSalt ratelimiter mpow bs <- liftIO $ atomically $ readTMVar (buckets ratelimiter) if validsalt @@ -123,7 +122,7 @@ rateLimit ratelimiter mpow i a = do Just mkreq -> case mpow of Nothing -> assignWork ratelimiter (b:bs) Just pow@(ProofOfWork _ salt) -> - if isValidProofOfWork pow (mkreq salt) i + if isValidProofOfWork pow (mkreq salt) p then checkbucket b bs else assignWork ratelimiter (b:bs) checkbucket b bs = do diff --git a/HTTP/Server.hs b/HTTP/Server.hs index dd35d1c..65d3d32 100644 --- a/HTTP/Server.hs +++ b/HTTP/Server.hs @@ -85,8 +85,9 @@ validObjectsize o = any (sz ==) knownObjectSizes where sz = B.length (fromStorableObject o) -countObjects :: ServerState -> Handler CountResult -countObjects = liftIO . countShares . serverStorage +countObjects :: ServerState -> Maybe ProofOfWork -> Handler (POWGuarded CountResult) +countObjects st pow = rateLimit (rateLimiter st) pow NoPOWIdent $ + liftIO $ countShares $ serverStorage st -- | 1 is a dummy value; the server does not know the actual share numbers. dummyShareNum :: ShareNum diff --git a/Storage/Network.hs b/Storage/Network.hs index 6053ff3..9739f2f 100644 --- a/Storage/Network.hs +++ b/Storage/Network.hs @@ -74,20 +74,21 @@ obscure :: Server -> IO ObscureResult obscure _ = return ObscureSuccess count :: Server -> IO CountResult -count srv = either CountFailure id <$> serverRequest' srv countObjects +count srv = serverRequest srv CountFailure id NoPOWIdent countObjects -- | Not needed for servers. move :: Server -> Storage -> IO () move _ _ = error "move is not implemented for servers" serverRequest - :: Server + :: POWIdent p + => Server -> (String -> a) -> (r -> a) - -> StorableObjectIdent + -> p -> (Maybe ProofOfWork -> Manager -> BaseUrl -> ExceptT ServantError IO (POWGuarded r)) -> IO a -serverRequest srv onerr onsuccess i a = go Nothing maxProofOfWork +serverRequest srv onerr onsuccess p a = go Nothing maxProofOfWork where go pow (Seconds timeleft) | timeleft <= 0 = return $ onerr "server asked for too much proof of work; gave up" @@ -97,7 +98,7 @@ serverRequest srv onerr onsuccess i a = go Nothing maxProofOfWork Left err -> return $ onerr err Right (Result r) -> return $ onsuccess r Right (NeedProofOfWork req) -> go - (Just $ genProofOfWork req i) + (Just $ genProofOfWork req p) (Seconds timeleft - generationTime req) serverRequest' |