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.

1 files changed, 28 insertions, 11 deletions

diff --git a/HTTP.hs b/HTTP.hs
index db9ef4d..702a806 100644
--- a/HTTP.hs
+++ b/HTTP.hs
@@ -20,40 +20,47 @@ import Servant.API
 import Data.Text
 import Data.Aeson.Types
 import GHC.Generics hiding (V1)
+import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as L
 import qualified Raaz.Core.Encode as Raaz
+import Data.Monoid
+import Prelude
 
 -- | Keysafe's http API
 type HttpAPI = 
 	"keysafe" :> V1 :> "motd" :> Get '[JSON] Motd
 	:<|> "keysafe" :> V1 :> "objects" :> ObjectIdent :> POWParam
-		:> Get '[JSON] (ProofOfWorkRequirement StorableObject)
+		:> Get '[JSON] (POWGuarded StorableObject)
 	:<|> "keysafe" :> V1 :> "objects" :> ObjectIdent :> POWParam
 		:> ReqBody '[OctetStream] StorableObject
-		:> Put '[JSON] (ProofOfWorkRequirement StoreResult)
-	:<|> "keysafe" :> V1 :> "stats" :> "countobjects" :> POWParam
-		:> Get '[JSON] (ProofOfWorkRequirement CountResult)
+		:> Put '[JSON] (POWGuarded StoreResult)
+	:<|> "keysafe" :> V1 :> "stats" :> "countobjects"
+		:> Get '[JSON] CountResult
 
 type V1 = "v1"
 
 newtype Motd = Motd Text
 	deriving (Generic)
 
+data POWGuarded t
+	= Result t
+	| NeedProofOfWork ProofOfWorkRequirement
+	deriving (Generic)
+
 type POWParam = QueryParam "proofofwork" ProofOfWork
 
 type ObjectIdent = Capture "ident" StorableObjectIdent
 
 instance ToJSON Motd
 instance FromJSON Motd
-instance ToJSON t => ToJSON (ProofOfWorkRequirement t)
-instance FromJSON t => FromJSON (ProofOfWorkRequirement t)
-
-instance FromHttpApiData ProofOfWork where
-	parseUrlPiece = Right . ProofOfWork
-instance ToHttpApiData ProofOfWork where
-	toUrlPiece (ProofOfWork t) = t
+instance ToJSON t => ToJSON (POWGuarded t)
+instance FromJSON t => FromJSON (POWGuarded t)
+instance ToJSON ProofOfWorkRequirement
+instance FromJSON ProofOfWorkRequirement
+instance ToJSON RandomSalt
+instance FromJSON RandomSalt
 
 -- StorableObjectIdent contains a hash, which is valid UTF-8.
 instance ToHttpApiData StorableObjectIdent where
@@ -75,6 +82,16 @@ instance FromJSON StorableObject where
 	parseJSON (Object v) = StorableObject <$> (unb64 =<< v .: "data")
 	parseJSON invalid = typeMismatch "StorableObject" invalid
 
+-- ProofOfWork contains an arbitrary bytestring and is base64 encoded in
+-- the query string.
+instance ToHttpApiData ProofOfWork where
+	toUrlPiece (ProofOfWork b (RandomSalt s)) = s <> ":" <> b64 b
+instance FromHttpApiData ProofOfWork where
+	parseUrlPiece t = do
+		let (s, rest) = T.break (/= ':') t
+		b <- unb64 (T.drop 1 rest)
+		return (ProofOfWork b (RandomSalt s))
+
 b64 :: B.ByteString -> Text
 b64 v = T.decodeUtf8 $ Raaz.toByteString (Raaz.encode v :: Raaz.Base64)