From 2e705b686840f0b1ff777c21d6faae77eb7fd706 Mon Sep 17 00:00:00 2001
From: fr33domlover <fr33domlover@riseup.net>
Date: Sun, 24 Feb 2019 01:35:07 +0000
Subject: [PATCH] Make key storage limits configurable instead of hardcoding to
 2

---
 config/settings-default.yaml |  3 +++
 src/Vervis/Foundation.hs     | 24 ++++++++++++++++--------
 src/Vervis/Settings.hs       |  8 ++++++++
 3 files changed, 27 insertions(+), 8 deletions(-)

diff --git a/config/settings-default.yaml b/config/settings-default.yaml
index bac70cc..7d1bd98 100644
--- a/config/settings-default.yaml
+++ b/config/settings-default.yaml
@@ -76,6 +76,9 @@ database:
   database: "_env:PGDATABASE:vervis_dev"
   poolsize: "_env:PGPOOLSIZE:10"
 
+max-instance-keys:  2
+max-actor-keys:     2
+
 ###############################################################################
 # Version control repositories
 ###############################################################################
diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs
index b45acf0..3c34255 100644
--- a/src/Vervis/Foundation.hs
+++ b/src/Vervis/Foundation.hs
@@ -598,10 +598,14 @@ instanceAndActor host luActor luInbox = do
     idAndNew (Right iid)           = (iid, True)
 
 actorRoom :: RemoteSharerId -> AppDB Bool
-actorRoom rsid =
-    sumUpTo 2
-        (count [VerifKeySharedUsageUser ==. rsid])
-        (count [VerifKeySharer ==. Just rsid])
+actorRoom rsid = do
+    mn <- getsYesod $ appMaxActorKeys . appSettings
+    case mn of
+        Nothing -> pure True
+        Just n ->
+            sumUpTo n
+                (count [VerifKeySharedUsageUser ==. rsid])
+                (count [VerifKeySharer ==. Just rsid])
 
 -- | Given a shared key we have in our DB, verify that the given actor lists
 -- this key, and update the DB accordingly.
@@ -805,10 +809,14 @@ instance YesodHttpSig App where
                         vkid <- insert $ VerifKey luKey iid mexpires key Nothing
                         insert_ $ VerifKeySharedUsage vkid rsid
                         return $ Right ()
-                    else return $ Left "We already store 2 keys"
+                    else return $ Left "We've reached key storage limit"
                 where
-                instanceRoom iid =
-                    (< 2) <$> count [VerifKeyInstance ==. iid, VerifKeySharer ==. Nothing]
+                instanceRoom iid = do
+                    mn <- getsYesod $ appMaxInstanceKeys . appSettings
+                    case mn of
+                        Nothing -> pure True
+                        Just n ->
+                            (< n) <$> count [VerifKeyInstance ==. iid, VerifKeySharer ==. Nothing]
             addPersonalKey host luInbox (VerifKeyDetail luKey key mexpires luActor _) = do
                 (iid, rsid, inew) <- instanceAndActor host luActor luInbox
                 room <-
@@ -819,7 +827,7 @@ instance YesodHttpSig App where
                     then do
                         insert_ $ VerifKey luKey iid mexpires key (Just rsid)
                         return $ Right ()
-                    else return $ Left "We already store 2 keys"
+                    else return $ Left "We've reached key storage limit"
         updateVerifKey vkid vkd =
             update vkid [VerifKeyExpires =. vkdExpires vkd, VerifKeyPublic =. vkdKey vkd]
 
diff --git a/src/Vervis/Settings.hs b/src/Vervis/Settings.hs
index f819f0b..508e289 100644
--- a/src/Vervis/Settings.hs
+++ b/src/Vervis/Settings.hs
@@ -50,6 +50,12 @@ data AppSettings = AppSettings
       appStaticDir              :: String
       -- | Configuration settings for accessing the database.
     , appDatabaseConf           :: PostgresConf
+      -- | Maximal number of remote instance-scope keys to cache in our local
+      -- database per instance.
+    , appMaxInstanceKeys        :: Maybe Int
+      -- | Maximal number of keys (personal keys or usage of shared keys) to
+      -- remember cached in our database per remote actor.
+    , appMaxActorKeys           :: Maybe Int
       -- | Base for all generated URLs. If @Nothing@, determined from the
       -- request headers.
     , appRoot                   :: Maybe Text
@@ -119,6 +125,8 @@ instance FromJSON AppSettings where
 #endif
         appStaticDir              <- o .: "static-dir"
         appDatabaseConf           <- o .: "database"
+        appMaxInstanceKeys        <- o .:? "max-instance-keys"
+        appMaxActorKeys           <- o .:? "max-actor-keys"
         appRoot                   <- o .:? "approot"
         appHost                   <- fromString <$> o .: "host"
         appPort                   <- o .: "http-port"