fix(avs): prevent empty contact and status queries

This commit is contained in:
Steffen Jost 2025-01-31 13:53:29 +01:00
parent 3f40dd890e
commit 7d9be73844

View File

@ -1,4 +1,4 @@
-- SPDX-FileCopyrightText: 2022-24 Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Steffen Jost <s.jost@frapor.de>
-- SPDX-FileCopyrightText: 2022-25 Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Steffen Jost <s.jost@frapor.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later
@ -34,13 +34,13 @@ type AVSGetRampLicences = "RampDrivingLicenceInfo" :> ReqBody '[JSON] AvsQueryG
type AVSSetRampLicences = "RampDrivingLicence" :> ReqBody '[JSON] AvsQuerySetLicences :> Post '[JSON] AvsResponseSetLicences
avsMaxSetLicenceAtOnce :: Int
avsMaxSetLicenceAtOnce = 80 -- maximum input set size for avsQuerySetLicences as enforced by AVS
avsMaxSetLicenceAtOnce = 80 -- maximum input set size for avsQuerySetLicences as enforced by AVS (<80)
avsMaxQueryAtOnce :: Int
avsMaxQueryAtOnce = 500 -- maximum input set size for avsQueryStatus and avsQueryContact as enforced by AVS
avsMaxQueryAtOnce = 250 -- maximum input set size for avsQueryStatus and avsQueryContact as enforced by AVS (<500)
avsMaxQueryDelay :: Int
avsMaxQueryDelay = 300000 -- microsecond to wait before sending another AVS query
avsMaxQueryDelay = 200000 -- microsecond to wait before sending another AVS query
avsApi :: Proxy AVS
@ -151,9 +151,10 @@ mkAvsQuery baseUrl basicAuth cliEnv = AvsQuery
| baseUrl == base = Right $ AvsResponsePerson mempty -- WORKAROUND: AVS server erroneously returns 404 if no matching person could be found in its database!
catch404toEmpty other = other
splitQuery :: (Wrapped a, Wrapped c, Unwrapped a ~ Set b, Semigroup (Unwrapped c))
splitQuery :: (Wrapped a, Wrapped c, Unwrapped a ~ Set b, Monoid (Unwrapped c))
=> (a -> ClientM c) -> a -> ClientM c
splitQuery rawQuery q
| Set.size s <= 0 = return $ view _Unwrapped' mempty -- empty query, retun empty answer
| avsMaxQueryAtOnce >= Set.size s = rawQuery q
| otherwise = do
-- logInfoS "AVS" $ "Splitting large query for input Set " <> tshow (Set.size s) -- would require MonadLogger ClientM