Make key storage limits configurable instead of hardcoding to 2
This commit is contained in:
parent
17524b6ee1
commit
2e705b6868
3 changed files with 27 additions and 8 deletions
|
@ -76,6 +76,9 @@ database:
|
||||||
database: "_env:PGDATABASE:vervis_dev"
|
database: "_env:PGDATABASE:vervis_dev"
|
||||||
poolsize: "_env:PGPOOLSIZE:10"
|
poolsize: "_env:PGPOOLSIZE:10"
|
||||||
|
|
||||||
|
max-instance-keys: 2
|
||||||
|
max-actor-keys: 2
|
||||||
|
|
||||||
###############################################################################
|
###############################################################################
|
||||||
# Version control repositories
|
# Version control repositories
|
||||||
###############################################################################
|
###############################################################################
|
||||||
|
|
|
@ -598,8 +598,12 @@ instanceAndActor host luActor luInbox = do
|
||||||
idAndNew (Right iid) = (iid, True)
|
idAndNew (Right iid) = (iid, True)
|
||||||
|
|
||||||
actorRoom :: RemoteSharerId -> AppDB Bool
|
actorRoom :: RemoteSharerId -> AppDB Bool
|
||||||
actorRoom rsid =
|
actorRoom rsid = do
|
||||||
sumUpTo 2
|
mn <- getsYesod $ appMaxActorKeys . appSettings
|
||||||
|
case mn of
|
||||||
|
Nothing -> pure True
|
||||||
|
Just n ->
|
||||||
|
sumUpTo n
|
||||||
(count [VerifKeySharedUsageUser ==. rsid])
|
(count [VerifKeySharedUsageUser ==. rsid])
|
||||||
(count [VerifKeySharer ==. Just rsid])
|
(count [VerifKeySharer ==. Just rsid])
|
||||||
|
|
||||||
|
@ -805,10 +809,14 @@ instance YesodHttpSig App where
|
||||||
vkid <- insert $ VerifKey luKey iid mexpires key Nothing
|
vkid <- insert $ VerifKey luKey iid mexpires key Nothing
|
||||||
insert_ $ VerifKeySharedUsage vkid rsid
|
insert_ $ VerifKeySharedUsage vkid rsid
|
||||||
return $ Right ()
|
return $ Right ()
|
||||||
else return $ Left "We already store 2 keys"
|
else return $ Left "We've reached key storage limit"
|
||||||
where
|
where
|
||||||
instanceRoom iid =
|
instanceRoom iid = do
|
||||||
(< 2) <$> count [VerifKeyInstance ==. iid, VerifKeySharer ==. Nothing]
|
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
|
addPersonalKey host luInbox (VerifKeyDetail luKey key mexpires luActor _) = do
|
||||||
(iid, rsid, inew) <- instanceAndActor host luActor luInbox
|
(iid, rsid, inew) <- instanceAndActor host luActor luInbox
|
||||||
room <-
|
room <-
|
||||||
|
@ -819,7 +827,7 @@ instance YesodHttpSig App where
|
||||||
then do
|
then do
|
||||||
insert_ $ VerifKey luKey iid mexpires key (Just rsid)
|
insert_ $ VerifKey luKey iid mexpires key (Just rsid)
|
||||||
return $ Right ()
|
return $ Right ()
|
||||||
else return $ Left "We already store 2 keys"
|
else return $ Left "We've reached key storage limit"
|
||||||
updateVerifKey vkid vkd =
|
updateVerifKey vkid vkd =
|
||||||
update vkid [VerifKeyExpires =. vkdExpires vkd, VerifKeyPublic =. vkdKey vkd]
|
update vkid [VerifKeyExpires =. vkdExpires vkd, VerifKeyPublic =. vkdKey vkd]
|
||||||
|
|
||||||
|
|
|
@ -50,6 +50,12 @@ data AppSettings = AppSettings
|
||||||
appStaticDir :: String
|
appStaticDir :: String
|
||||||
-- | Configuration settings for accessing the database.
|
-- | Configuration settings for accessing the database.
|
||||||
, appDatabaseConf :: PostgresConf
|
, 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
|
-- | Base for all generated URLs. If @Nothing@, determined from the
|
||||||
-- request headers.
|
-- request headers.
|
||||||
, appRoot :: Maybe Text
|
, appRoot :: Maybe Text
|
||||||
|
@ -119,6 +125,8 @@ instance FromJSON AppSettings where
|
||||||
#endif
|
#endif
|
||||||
appStaticDir <- o .: "static-dir"
|
appStaticDir <- o .: "static-dir"
|
||||||
appDatabaseConf <- o .: "database"
|
appDatabaseConf <- o .: "database"
|
||||||
|
appMaxInstanceKeys <- o .:? "max-instance-keys"
|
||||||
|
appMaxActorKeys <- o .:? "max-actor-keys"
|
||||||
appRoot <- o .:? "approot"
|
appRoot <- o .:? "approot"
|
||||||
appHost <- fromString <$> o .: "host"
|
appHost <- fromString <$> o .: "host"
|
||||||
appPort <- o .: "http-port"
|
appPort <- o .: "http-port"
|
||||||
|
|
Loading…
Reference in a new issue