memory DOS prevention

Prevent DOS of user side by limiting the size of the BackLog that
is maintained. This should not cause problems in even high latency
environments, and should prevent memory use > 16 mb.

The developer side does not keep much data, other than a list of the
Hashes of things it has recently sent, so is not susceptable to memory
DOS.

This commit was sponsored by Brock Spratlen on Patreon.

7 files changed, 65 insertions, 21 deletions

diff --git a/Log.hs b/Log.hs
index 90f1b53..8690f27 100644
--- a/Log.hs
+++ b/Log.hs
@@ -4,6 +4,7 @@ module Log where
 
 import Types
 import Hash
+import Memory
 
 import GHC.Generics (Generic)
 import Data.Aeson
@@ -28,6 +29,9 @@ data ActivityLog = ActivityLog
 	}
 	deriving (Show, Generic)
 
+instance DataSize ActivityLog where
+	dataSize l = dataSize (loggedActivity l) + dataSize (loggedHash l) + 2
+
 instance ToJSON (ActivityLog)
 instance FromJSON (ActivityLog)
 
@@ -36,6 +40,10 @@ data SomeActivity
 	| ActivityEntered (Activity Entered)
 	deriving (Show, Generic)
 
+instance DataSize SomeActivity where
+	dataSize (ActivitySeen a) = dataSize a
+	dataSize (ActivityEntered a) = dataSize a
+
 instance ToJSON SomeActivity where
 	toJSON = genericToJSON sumOptions
 	toEncoding = genericToEncoding sumOptions
diff --git a/Memory.hs b/Memory.hs
new file mode 100644
index 0000000..963acf7
--- /dev/null
+++ b/Memory.hs
@@ -0,0 +1,9 @@
+module Memory where
+
+-- | Class of things whose size in memory is known.
+--
+-- (This can be an approximate size, but should be no larger than the
+-- memory used to reprecent the thing.)
+class DataSize t where
+	-- ^ Size in bytes
+	dataSize :: t -> Integer
diff --git a/TODO b/TODO
index bfe4e07..bc4b5ca 100644
--- a/TODO
+++ b/TODO
@@ -1,21 +1,5 @@
 * loadLog should verify the hashes (and signatures) in the log, and
   refuse to use logs that are not valid proofs of a session.
-* potential DOS where developer sends Activity Entered that all
-  refer back to the first Activity Seen. This requires the user
-  side to keep a Backlog containing all later Activity Seen, so uses
-  up a lot of memory.
-
-  For this to work, the developer would need to include
-  in their Activity Entered echoData anticipating all the Activity Seen
-  that they have generated. This is doable; for example the developer
-  can send a stream of A's, and then needs to only include the right
-  amount in the echoData.
-
-  Should probably cap the BackLog to some maximum size to prevent
-  this kind of DOS. Dropping old items from the BackLog after some
-  amount of time would also work; after eg 10 seconds it's very
-  unlikely that a Activity Entered will legitimately refer to an
-  old backlog item.
 * Encryption!
 * Add random nonce to start message, to avoid replay issues.
   (Or perhaps the encryption derives a RSA key in a way that avoids
diff --git a/Types.hs b/Types.hs
index c3b5340..ec21254 100644
--- a/Types.hs
+++ b/Types.hs
@@ -12,6 +12,7 @@ module Types (
 ) where
 
 import Val
+import Memory
 
 import GHC.Generics (Generic)
 import Data.Aeson
@@ -23,6 +24,9 @@ data Seen = Seen
 	}
 	deriving (Show, Generic)
 
+instance DataSize Seen where
+	dataSize = dataSize . seenData
+
 -- | Things that the developer enters.
 data Entered = Entered
 	{ enteredData :: Val
@@ -32,6 +36,9 @@ data Entered = Entered
 	}
 	deriving (Show, Generic)
 
+instance DataSize Entered where
+	dataSize e = dataSize (enteredData e) + dataSize (echoData e)
+
 -- | High level protocol.
 data Proto a
 	= Proto a
@@ -40,6 +47,10 @@ data Proto a
 	-- ^ sent by user to indicate when an Entered value was rejected.
 	deriving (Show, Generic)
 
+instance DataSize a => DataSize (Proto a) where
+	dataSize (Proto a) = dataSize a
+	dataSize (Rejected a) = dataSize a
+
 -- | A Proto activity (either Entered or Seen) with a pointer
 -- to the Activity before this one.
 --
@@ -51,15 +62,27 @@ data Activity a = Activity
 	}
 	deriving (Show, Generic)
 
+instance DataSize a => DataSize (Activity a) where
+	dataSize a = dataSize (activity a) 
+		+ maybe 0 dataSize (prevActivity a) 
+		+ dataSize (signature a)
+
 newtype Signature = Signature Val
 	deriving (Show, Generic)
 
+instance DataSize Signature where
+	dataSize _ = 42 -- FIXME real size here
+
 data Hash = Hash
 	{ hashMethod :: HashMethod
 	, hashValue :: Val
 	}
 	deriving (Show, Generic, Eq)
 
+instance DataSize Hash where
+	dataSize (Hash { hashMethod = SHA256 }) = 64
+	dataSize (Hash { hashMethod = SHA3 }) = 56
+
 -- | We use SHA256. (SHA3 is included to future proof, and because it
 -- improves the generated JSON.)
 data HashMethod = SHA256 | SHA3
diff --git a/Val.hs b/Val.hs
index 86a35c9..40e718b 100644
--- a/Val.hs
+++ b/Val.hs
@@ -2,18 +2,23 @@
 
 module Val where
 
-import Data.ByteString
+import Memory
+
 import GHC.Generics (Generic)
 import Data.Aeson
 import Data.Aeson.Types
 import qualified Codec.Binary.Base64 as B64
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
+import qualified Data.ByteString as B
 
 -- | Newtype of ByteString so we can have JSON instances without orphans.
-newtype Val = Val { val :: ByteString }
+newtype Val = Val { val :: B.ByteString }
 	deriving (Show, Generic, Eq, Monoid)
 
+instance DataSize Val where
+	dataSize (Val b) = fromIntegral (B.length b)
+
 -- | JSON instances for Val, using base64 encoding when the value
 -- is not utf-8 encoded, and otherwise using a more efficient encoding.
 instance ToJSON Val where
@@ -28,10 +33,10 @@ instance FromJSON Val where
 			Nothing -> Val <$> (unb64 =<< o .: "b64")
 	parseJSON invalid = typeMismatch "ByteString" invalid
 
-b64 :: ByteString -> T.Text
+b64 :: B.ByteString -> T.Text
 b64 = T.decodeUtf8 . B64.encode
 
-unb64 :: Monad m => T.Text -> m ByteString
+unb64 :: Monad m => T.Text -> m B.ByteString
 unb64 t = either
 	(\_ -> fail "bad base64 data")
 	return
diff --git a/debug-me.cabal b/debug-me.cabal
index cc34c0c..62cfa4c 100644
--- a/debug-me.cabal
+++ b/debug-me.cabal
@@ -43,6 +43,7 @@ Executable debug-me
     Graphviz
     Hash
     Log
+    Memory
     Pty
     Replay
     Session
diff --git a/debug-me.hs b/debug-me.hs
index 3cc1f09..8ff38ed 100644
--- a/debug-me.hs
+++ b/debug-me.hs
@@ -5,6 +5,7 @@ module Main where
 import Types
 import Hash
 import Pty
+import Memory
 import CmdLine
 import Log
 import Graphviz
@@ -251,7 +252,8 @@ sendPtyInput ichan ochan p backlog logger = go
 			bl <- readTVar backlog
 			-- Don't need to retain backlog before the Activity
 			-- that entered references.
-			let bl'@(Backlog bll) = truncateBacklog bl entered
+			let bl'@(Backlog bll) = reduceBacklog $
+				truncateBacklog bl entered
 			if isLegalEntered entered bl'
 				then do
 					let l = mkActivityLog (ActivityEntered entered) now
@@ -293,6 +295,18 @@ truncateBacklog (Backlog (b :| l)) (Activity _ hp _)
 	truncationpoint x@(ActivityLog { loggedActivity = ActivitySeen {}}) = Just (loggedHash x) == hp
 	truncationpoint _ = False
 
+-- | To avoid DOS attacks that try to fill up the backlog and so use all
+-- memory, don't let the backlog contain more than 1000 items, or
+-- more than 16 megabytes of total data. (Excluding the most recent
+-- item).
+reduceBacklog :: Backlog -> Backlog
+reduceBacklog (Backlog (b :| l)) = Backlog (b :| go 0 (take 1000 l))
+  where
+	go _ [] = []
+	go n (x:xs)
+		| n > 16777216 = []
+		| otherwise = x : go (n + dataSize x) xs
+
 -- | Entered activity is legal when it points to the last Seen activvity,
 -- because this guarantees that the person who entered it saw
 -- the current state of the system before manipulating it.