From caf8e8b71e55c51c83601f50e0736e1b419d5e2f Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Wed, 14 Feb 2024 18:03:48 +0100 Subject: [PATCH] chore(avs): add remaining queries to new unifying class --- src/Model/Types/Avs.hs | 30 +++++++++++++++++++----------- src/Utils/Avs.hs | 36 +++++++++++++++++++++++++++++++----- 2 files changed, 50 insertions(+), 16 deletions(-) diff --git a/src/Model/Types/Avs.hs b/src/Model/Types/Avs.hs index 57976e002..82fc54f7d 100644 --- a/src/Model/Types/Avs.hs +++ b/src/Model/Types/Avs.hs @@ -247,7 +247,8 @@ avsPersonIdZero = AvsPersonId 0 -- this mus be zero acording to VSM specificatio newtype AvsObjPersonId = AvsObjPersonId -- tagged object { avsObjPersonID :: AvsPersonId } - deriving (Eq, Ord, Show, Generic) + deriving (Show, Generic) + deriving newtype (Eq, Ord, NFData, Binary) deriveJSON defaultOptions { fieldLabelModifier = dropCamel 2 , omitNothingFields = True @@ -421,7 +422,7 @@ data AvsStatusPerson = AvsStatusPerson { avsStatusPersonID :: AvsPersonId , avsStatusPersonCardStatus :: Set AvsDataPersonCard -- only delivers non-Maybe fields, all Maybe-fields are Nothing } - deriving (Eq, Ord, Show, Generic) + deriving (Eq, Ord, Show, Generic, NFData, Binary) deriveJSON defaultOptions { fieldLabelModifier = \case { "avsStatusPersonCardStatus" -> "personCardStatus"; others -> dropCamel 2 others } @@ -517,7 +518,7 @@ data AvsPersonInfo = AvsPersonInfo , avsInfoPersonEMail :: Maybe Text , avsInfoPersonMobilePhoneNo :: Maybe Text , avsInfoInternalPersonalNo :: Maybe AvsInternalPersonalNo -- Fraport Personalnummer - } deriving (Eq, Ord, Show, Generic, NFData) + } deriving (Eq, Ord, Show, Generic, NFData, Binary) makeLenses_ ''AvsPersonInfo @@ -563,7 +564,7 @@ data AvsFirmCommunication = AvsFirmCommunication , avsCommunicationCountry :: Maybe Text , avsCommunicationStreetANDHouseNo :: Maybe Text , avsCommunicationEMail :: Maybe Text - } deriving (Eq, Ord, Show, Generic, NFData) + } deriving (Eq, Ord, Show, Generic, NFData, Binary) instance {-# OVERLAPS #-} Canonical (Maybe AvsFirmCommunication) where canonical (Just AvsFirmCommunication{..}) @@ -610,7 +611,7 @@ data AvsFirmInfo = AvsFirmInfo , avsFirmEMail :: Maybe Text , avsFirmEMailSuperior :: Maybe Text , avsFirmCommunication :: Maybe AvsFirmCommunication - } deriving (Eq, Ord, Show, Generic, NFData) + } deriving (Eq, Ord, Show, Generic, NFData, Binary) makeLenses_ ''AvsFirmInfo @@ -668,7 +669,7 @@ data AvsDataContact = AvsDataContact { avsContactPersonID :: AvsPersonId , avsContactPersonInfo :: AvsPersonInfo , avsContactFirmInfo :: AvsFirmInfo - } deriving (Eq, Ord, Show, Generic) + } deriving (Eq, Ord, Show, Generic, NFData, Binary) makeLenses_ ''AvsDataContact @@ -691,7 +692,8 @@ deriveJSON defaultOptions type AvsResponseStatus :: Type newtype AvsResponseStatus = AvsResponseStatus (Set AvsStatusPerson) - deriving (Eq, Ord, Show, Generic) + deriving (Show, Generic) + deriving newtype (Eq, Ord, NFData, Binary) makeWrapped ''AvsResponseStatus deriveJSON defaultOptions { fieldLabelModifier = dropCamel 2 @@ -714,7 +716,8 @@ deriveJSON defaultOptions } ''AvsResponsePerson newtype AvsResponseContact = AvsResponseContact (Set AvsDataContact) - deriving (Eq, Ord, Show, Generic) + deriving (Show, Generic) + deriving newtype (Eq, Ord, NFData, Binary) makeWrapped ''AvsResponseContact deriveJSON defaultOptions { fieldLabelModifier = dropCamel 2 @@ -771,19 +774,24 @@ deriveJSON defaultOptions } ''AvsQueryPerson newtype AvsQueryStatus = AvsQueryStatus (Set AvsPersonId) - deriving (Eq, Ord, Show, Generic) + deriving (Show, Generic) + deriving newtype (Eq, Ord, NFData, Binary) 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) + deriving (Show, Generic) + deriving newtype (Eq, Ord, NFData, Binary) deriveJSON defaultOptions ''AvsQueryContact makeWrapped ''AvsQueryContact -newtype AvsQueryGetLicences = AvsQueryGetLicences AvsObjPersonId -- this should have been a set, but the specification was implemented differently +newtype AvsQueryGetLicences = AvsQueryGetLicences AvsObjPersonId -- this should have been a set, but the specification was implemented differently; also currently only allows to ask for all licences with ID 0 deriving (Eq, Ord, Show, Generic) deriveJSON defaultOptions ''AvsQueryGetLicences +data AvsQueryGetAllLicences = AvsQueryGetAllLicences -- for convenience, encoding AvsQueryGetLicences (AvsObjPersonId avsPersonIdZero) + deriving (Eq, Ord, Show, Generic) + newtype AvsQuerySetLicences = AvsQuerySetLicences (Set AvsPersonLicence) deriving (Eq, Ord, Show, Generic) deriveJSON defaultOptions ''AvsQuerySetLicences diff --git a/src/Utils/Avs.hs b/src/Utils/Avs.hs index c5f9a9839..7585169b6 100644 --- a/src/Utils/Avs.hs +++ b/src/Utils/Avs.hs @@ -64,10 +64,6 @@ data AvsQuery = AvsQuery makeLenses_ ''AvsQuery --- | To query all active licences, a special constant argument must be prepared -avsQueryAllLicences :: AvsQueryGetLicences -avsQueryAllLicences = AvsQueryGetLicences $ AvsObjPersonId avsPersonIdZero - -- | `SomeAvsQuery` is an umbrella to unify usage of all AVS queries, since Servant required separate types to fit the existing AVS-VSM API class (SomeAvsQuery (SomeAvsCachable q), Binary (SomeAvsCachable q), Binary (SomeAvsResponse (SomeAvsCachable q)), Typeable (SomeAvsResponse (SomeAvsCachable q)), NFData (SomeAvsResponse (SomeAvsCachable q))) @@ -79,9 +75,21 @@ class (SomeAvsQuery (SomeAvsCachable q), Binary (SomeAvsCachable q), Binary (Som instance SomeAvsQuery AvsQueryPerson where type SomeAvsResponse AvsQueryPerson = AvsResponsePerson - pickQuery = avsQueryPerson + pickQuery = avsQueryPerson type SomeAvsCachable AvsQueryPerson = AvsQueryPerson cacheable _ = Just (id, id) + +instance SomeAvsQuery AvsQueryStatus where + type SomeAvsResponse AvsQueryStatus = AvsResponseStatus + pickQuery = avsQueryStatus + type SomeAvsCachable AvsQueryStatus = AvsQueryStatus + cacheable _ = Just (id, id) + +instance SomeAvsQuery AvsQueryContact where + type SomeAvsResponse AvsQueryContact = AvsResponseContact + pickQuery = avsQueryContact + type SomeAvsCachable AvsQueryContact = AvsQueryContact + cacheable _ = Just (id, id) -- class (SomeAvsQuery q, Typeable q, Binary q, Binary (SomeAvsResponse q), Typeable (SomeAvsResponse q), NFData (SomeAvsResponse q)) => SomeAvsCachable q -- instance SomeAvsCachable AvsQueryPerson @@ -92,12 +100,30 @@ instance SomeAvsQuery () where type SomeAvsCachable () = () pickQuery _ () = return $ Right () cacheable _ = Just (id,id) + instance SomeAvsQuery AvsQuerySetLicences where type SomeAvsResponse AvsQuerySetLicences = AvsResponseSetLicences pickQuery = avsQuerySetLicences type SomeAvsCachable AvsQuerySetLicences = () -- not cachable cacheable _ = Nothing +instance SomeAvsQuery AvsQueryGetAllLicences where + type SomeAvsResponse AvsQueryGetAllLicences = AvsResponseGetLicences + pickQuery = const . avsQueryGetAllLicences + type SomeAvsCachable AvsQueryGetAllLicences = () -- not cachable + cacheable _ = Nothing + +-- AVS/VSM-Interface currently only allows to query ID 0, which means all licences +-- instance SomeAvsQuery AvsQueryGetLicences where +-- type SomeAvsResponse AvsQueryGetLicences = AvsResponseGetLicences +-- pickQuery = avsQuerySetLicences +-- type SomeAvsCachable AvsQueryGetLicences = () -- not cachable +-- cacheable _ = Nothing + +-- | To query all active licences, a special constant argument must be prepared +avsQueryAllLicences :: AvsQueryGetLicences +avsQueryAllLicences = AvsQueryGetLicences $ AvsObjPersonId avsPersonIdZero + mkAvsQuery :: BaseUrl -> BasicAuthData -> ClientEnv -> AvsQuery #ifdef DEVELOPMENT