fix(avs): chunk avs status query automatically

src/Handler/Admin/Avs.hs

@@ -95,7 +95,7 @@ makeAvsStatusForm tmpl = identifyForm FIDAvsQueryStatus . validateForm validateA
     parseAvsIds txt = AvsQueryStatus $ Set.fromList ids
       where
         nonemptys = filter (not . Text.null) $ Text.strip <$> Text.split (==',') txt
-        ids = catMaybes $ readMay <$> nonemptys
+        ids = mapMaybe readMay nonemptys
     unparseAvsIds :: AvsQueryStatus -> Text
     unparseAvsIds (AvsQueryStatus ids) = Text.intercalate ", " $ tshow <$> Set.toAscList ids
 
@@ -113,7 +113,7 @@ makeAvsContactForm tmpl = identifyForm FIDAvsQueryContact . validateForm validat
     parseAvsIds txt = AvsQueryContact $ Set.fromList ids
       where        
         nonemptys = filter (not . Text.null) $ Text.strip <$> Text.split (==',') txt
-        ids = catMaybes $ fmap AvsObjPersonId . readMay <$> nonemptys
+        ids = mapMaybe (fmap AvsObjPersonId . readMay) nonemptys
     unparseAvsIds :: AvsQueryContact -> Text
     unparseAvsIds (AvsQueryContact ids) = Text.intercalate ", " $ tshow <$> Set.toAscList ids
 

src/Model/Types/Avs.hs

@@ -587,6 +587,7 @@ deriveJSON defaultOptions
 -- Responses --
 ---------------
 
+type AvsResponseStatus :: Type
 newtype AvsResponseStatus = AvsResponseStatus (Set AvsStatusPerson)
   deriving (Eq, Ord, Show, Generic)
 deriveJSON defaultOptions
@@ -595,6 +596,8 @@ deriveJSON defaultOptions
   , tagSingleConstructors = False
   , rejectUnknownFields = False
   } ''AvsResponseStatus
+instance Semigroup AvsResponseStatus where 
+  (AvsResponseStatus a) <> (AvsResponseStatus b) = AvsResponseStatus (a <> b)
 
 newtype AvsResponsePerson = AvsResponsePerson (Set AvsDataPerson)
   deriving (Eq, Ord, Show, Generic)

src/Utils/Avs.hs

@@ -34,6 +34,10 @@ type AVSSetRampLicences = "RampDrivingLicence"      :> ReqBody '[JSON] AvsQueryS
 avsMaxSetLicenceAtOnce :: Int
 avsMaxSetLicenceAtOnce = 99   -- maximum input set size for avsQuerySetLicences as enforced by AVS
 
+avsMaxGetStatusAtOnce :: Int
+avsMaxGetStatusAtOnce = 990   -- maximum input set size for avsQueryStatus as enforced by AVS
+
+
 avsApi :: Proxy AVS
 avsApi = Proxy
 
@@ -75,7 +79,7 @@ mkAvsQuery _ _ _ = AvsQuery
 #else
 mkAvsQuery baseUrl basicAuth cliEnv = AvsQuery
     { avsQueryPerson      = \q -> liftIO $ catch404toEmpty <$> runClientM (rawQueryPerson      q)  cliEnv
-    , avsQueryStatus      = \q -> liftIO $                     runClientM (rawQueryStatus      q)  cliEnv
+    , avsQueryStatus      = \q -> liftIO $                     runClientM (splitQueryStatus    q)  cliEnv
     , avsQueryContact     = \q -> liftIO $                     runClientM (rawQueryContact     q)  cliEnv
     , avsQuerySetLicences = \q -> liftIO $                     runClientM (rawQuerySetLicences q)  cliEnv
     -- , avsQueryGetLicences = \q -> liftIO $                     runClientM (rawQueryGetLicences q)  cliEnv
@@ -91,6 +95,16 @@ mkAvsQuery baseUrl basicAuth cliEnv = AvsQuery
     catch404toEmpty (Left (FailureResponse (requestPath -> (base, _path)) (statusCode . responseStatusCode -> 404)))
       | baseUrl == base = Right $ AvsResponsePerson mempty -- WORKAROUND: AVS server erroneously returns 404 if no matching person could be found in its database!
     catch404toEmpty other = other
+
+    -- TODO: make a generic implementation for this
+    splitQueryStatus :: AvsQueryStatus -> ClientM AvsResponseStatus
+    splitQueryStatus q@(AvsQueryStatus avids)
+      | Set.size avids <= avsMaxGetStatusAtOnce = rawQueryStatus q
+      | otherwise = do 
+          let (avid_1,avid_2) = Set.splitAt avsMaxGetStatusAtOnce avids
+          res1 <- rawQueryStatus   (AvsQueryStatus avid_1)
+          res2 <- splitQueryStatus (AvsQueryStatus avid_2)
+          return $ res1 <> res2
 #endif
 
 -----------------------