refactor(avs): avs queries are automatically chunked
This commit is contained in:
parent
ea82d75a09
commit
ebb81e0c54
@ -197,6 +197,7 @@ discernAvsCardPersonalNo _ = Nothing
|
||||
newtype AvsPersonId = AvsPersonId { avsPersonId :: Int } -- untagged Int
|
||||
deriving (Eq, Ord, Generic)
|
||||
deriving newtype (NFData, PathPiece, PersistField, PersistFieldSql, Csv.ToField, Csv.FromField, Hashable, Binary)
|
||||
-- TODO: consider using "makeWrapped ''AvsPersonId"
|
||||
instance E.SqlString AvsPersonId
|
||||
-- As opposed to AvsObjPersonId, AvsPersonId is an untagged Int with respect to FromJSON/ToJSON, as needed by AVS API;
|
||||
instance FromJSON AvsPersonId where
|
||||
@ -590,6 +591,7 @@ deriveJSON defaultOptions
|
||||
type AvsResponseStatus :: Type
|
||||
newtype AvsResponseStatus = AvsResponseStatus (Set AvsStatusPerson)
|
||||
deriving (Eq, Ord, Show, Generic)
|
||||
makeWrapped ''AvsResponseStatus
|
||||
deriveJSON defaultOptions
|
||||
{ fieldLabelModifier = dropCamel 2
|
||||
, omitNothingFields = True
|
||||
@ -601,6 +603,7 @@ instance Semigroup AvsResponseStatus where
|
||||
|
||||
newtype AvsResponsePerson = AvsResponsePerson (Set AvsDataPerson)
|
||||
deriving (Eq, Ord, Show, Generic)
|
||||
-- makeWrapped ''AvsResponsePerson
|
||||
deriveJSON defaultOptions
|
||||
{ fieldLabelModifier = dropCamel 2
|
||||
, omitNothingFields = True
|
||||
@ -610,6 +613,7 @@ deriveJSON defaultOptions
|
||||
|
||||
newtype AvsResponseContact = AvsResponseContact (Set AvsDataContact)
|
||||
deriving (Eq, Ord, Show, Generic)
|
||||
makeWrapped ''AvsResponseContact
|
||||
deriveJSON defaultOptions
|
||||
{ fieldLabelModifier = dropCamel 2
|
||||
, omitNothingFields = True
|
||||
@ -666,10 +670,12 @@ deriveJSON defaultOptions
|
||||
newtype AvsQueryStatus = AvsQueryStatus (Set AvsPersonId)
|
||||
deriving (Eq, Ord, Show, Generic)
|
||||
deriveJSON defaultOptions ''AvsQueryStatus
|
||||
makeWrapped ''AvsQueryStatus
|
||||
|
||||
newtype AvsQueryContact = AvsQueryContact (Set AvsObjPersonId) -- note the difference to AvsQueryStatus, which receives a list of id, whereas here we sent a list of single-field object
|
||||
deriving (Eq, Ord, Show, Generic)
|
||||
deriveJSON defaultOptions ''AvsQueryContact
|
||||
makeWrapped ''AvsQueryContact
|
||||
|
||||
newtype AvsQueryGetLicences = AvsQueryGetLicences AvsObjPersonId -- this should have been a set, but the specification was implemented differently
|
||||
deriving (Eq, Ord, Show, Generic)
|
||||
|
||||
@ -13,10 +13,10 @@ import qualified Data.Text as Text
|
||||
|
||||
import Servant
|
||||
import Servant.Client
|
||||
#ifdef DEVELOPMENT
|
||||
#else
|
||||
-- #ifdef DEVELOPMENT
|
||||
-- #else
|
||||
import Servant.Client.Core (requestPath)
|
||||
#endif
|
||||
-- #endif
|
||||
|
||||
import Model.Types.Avs
|
||||
|
||||
@ -34,8 +34,8 @@ type AVSSetRampLicences = "RampDrivingLicence" :> ReqBody '[JSON] AvsQueryS
|
||||
avsMaxSetLicenceAtOnce :: Int
|
||||
avsMaxSetLicenceAtOnce = 90 -- maximum input set size for avsQuerySetLicences as enforced by AVS
|
||||
|
||||
avsMaxGetStatusAtOnce :: Int
|
||||
avsMaxGetStatusAtOnce = 900 -- maximum input set size for avsQueryStatus as enforced by AVS
|
||||
avsMaxQueryAtOnce :: Int
|
||||
avsMaxQueryAtOnce = 900 -- maximum input set size for avsQueryStatus as enforced by AVS
|
||||
|
||||
|
||||
avsApi :: Proxy AVS
|
||||
@ -68,20 +68,20 @@ avsQueryAllLicences = AvsQueryGetLicences $ AvsObjPersonId avsPersonIdZero
|
||||
|
||||
|
||||
mkAvsQuery :: BaseUrl -> BasicAuthData -> ClientEnv -> AvsQuery
|
||||
#ifdef DEVELOPMENT
|
||||
mkAvsQuery _ _ _ = AvsQuery
|
||||
{ avsQueryPerson = \_ -> return . Right $ AvsResponsePerson mempty
|
||||
, avsQueryStatus = \_ -> return . Right $ AvsResponseStatus mempty
|
||||
, avsQueryContact = \_ -> return . Right $ AvsResponseContact $ Set.singleton $ AvsDataContact (AvsPersonId 1234567) (AvsPersonInfo "123123123" "Heribert" "Sumpfmeier" (-1) Nothing Nothing Nothing Nothing) (AvsFirmInfo "Lange Firma" 7 "Kurz" Nothing Nothing Nothing Nothing Nothing Nothing)
|
||||
, avsQuerySetLicences = \_ -> return . Right $ AvsResponseSetLicences mempty
|
||||
, avsQueryGetAllLicences = return . Right $ AvsResponseGetLicences mempty
|
||||
}
|
||||
#else
|
||||
-- #ifdef DEVELOPMENT
|
||||
-- mkAvsQuery _ _ _ = AvsQuery
|
||||
-- { avsQueryPerson = \_ -> return . Right $ AvsResponsePerson mempty
|
||||
-- , avsQueryStatus = \_ -> return . Right $ AvsResponseStatus mempty
|
||||
-- , avsQueryContact = \_ -> return . Right $ AvsResponseContact $ Set.singleton $ AvsDataContact (AvsPersonId 1234567) (AvsPersonInfo "123123123" "Heribert" "Sumpfmeier" (-1) Nothing Nothing Nothing Nothing) (AvsFirmInfo "Lange Firma" 7 "Kurz" Nothing Nothing Nothing Nothing Nothing Nothing)
|
||||
-- , avsQuerySetLicences = \_ -> return . Right $ AvsResponseSetLicences mempty
|
||||
-- , avsQueryGetAllLicences = return . Right $ AvsResponseGetLicences mempty
|
||||
-- }
|
||||
-- #else
|
||||
mkAvsQuery baseUrl basicAuth cliEnv = AvsQuery
|
||||
{ avsQueryPerson = \q -> liftIO $ catch404toEmpty <$> runClientM (rawQueryPerson q) cliEnv
|
||||
, avsQueryStatus = \q -> liftIO $ runClientM (splitQueryStatus q) cliEnv
|
||||
, avsQueryContact = \q -> liftIO $ runClientM (rawQueryContact q) cliEnv
|
||||
, avsQuerySetLicences = \q -> liftIO $ runClientM (rawQuerySetLicences q) cliEnv
|
||||
{ avsQueryPerson = \q -> liftIO $ catch404toEmpty <$> runClientM (rawQueryPerson q) cliEnv
|
||||
, avsQueryStatus = \q -> liftIO $ runClientM (splitQuery rawQueryStatus q) cliEnv
|
||||
, avsQueryContact = \q -> liftIO $ runClientM (splitQuery rawQueryContact q) cliEnv
|
||||
, avsQuerySetLicences = \q -> liftIO $ runClientM (rawQuerySetLicences q) cliEnv -- TODO: currently uses setLicencesAvs for splitting to ensure return of correctly set licences
|
||||
-- , avsQueryGetLicences = \q -> liftIO $ runClientM (rawQueryGetLicences q) cliEnv
|
||||
, avsQueryGetAllLicences = liftIO $ runClientM (rawQueryGetLicences avsQueryAllLicences) cliEnv
|
||||
}
|
||||
@ -96,26 +96,18 @@ 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
|
||||
|
||||
-- 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
|
||||
|
||||
-- splitQuery :: (a -> Set b) -> (Set b -> a) -> (a -> ClientM c) -> a -> ClientM c
|
||||
-- splitQuery toSet fromSet rawQuery q
|
||||
-- | Set.size (toSet q) <= avsMaxGetStatusAtOnce = rawQueryStatus q
|
||||
-- | otherwise = do
|
||||
-- let (fromSet -> avid_1,fromSet -> avid_2) = Set.splitAt avsMaxGetStatusAtOnce (toSet q)
|
||||
-- res1 <- rawQuery avid_1
|
||||
-- res2 <- splitQuery toSet fromSet rawQuery avid_2
|
||||
-- return $ fromSet (toSet res1 <> toSet res2)
|
||||
|
||||
#endif
|
||||
splitQuery :: (Wrapped a, Wrapped c, Unwrapped a ~ Set b, Semigroup (Unwrapped c))
|
||||
=> (a -> ClientM c) -> a -> ClientM c
|
||||
splitQuery rawQuery q
|
||||
| Set.size s <= avsMaxQueryAtOnce = rawQuery q
|
||||
| otherwise = do
|
||||
let (avsid1, avsid2) = Set.splitAt avsMaxQueryAtOnce s
|
||||
res1 <- rawQuery $ view _Unwrapped' avsid1
|
||||
res2 <- splitQuery rawQuery $ view _Unwrapped' avsid2
|
||||
return $ view _Unwrapped' (res1 ^. _Wrapped' <> res2 ^. _Wrapped')
|
||||
where
|
||||
s = view _Wrapped' q
|
||||
-- #endif
|
||||
|
||||
-----------------------
|
||||
-- Utility Functions --
|
||||
|
||||
Loading…
Reference in New Issue
Block a user