From 1286dc7e78b489de440252432f34b218edf42267 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Thu, 7 Sep 2023 16:20:55 +0000 Subject: [PATCH] chore(avs): add firm communication address field to json parser --- src/Model/Types/Avs.hs | 116 +++++++++++++++++++++++++++-------------- 1 file changed, 78 insertions(+), 38 deletions(-) diff --git a/src/Model/Types/Avs.hs b/src/Model/Types/Avs.hs index dc58f1087..997fa6588 100644 --- a/src/Model/Types/Avs.hs +++ b/src/Model/Types/Avs.hs @@ -44,7 +44,7 @@ o .:?~ key = o .: key <|> maybe empty parseJSON go -- Like (.:?) but maps Just null to Nothing, ie. Nothing instead of Just "" -(.:?!) :: (MonoFoldable a, FromJSON a) => Object -> Text -> Parser (Maybe a) +(.:?!) :: (Canonical (Maybe a), FromJSON a) => Object -> Text -> Parser (Maybe a) (.:?!) o k = canonical <$> (o .:? k) @@ -83,7 +83,7 @@ instance FromJSON SloppyBool where newtype AvsInternalPersonalNo = AvsInternalPersonalNo { avsInternalPersonalNo :: Text } -- ought to be all digits deriving (Eq, Ord, Show, Generic) - deriving newtype (NFData, PathPiece, PersistField, PersistFieldSql, Csv.ToField, Csv.FromField) + deriving newtype (NFData, PathPiece, PersistField, PersistFieldSql, Csv.ToField, Csv.FromField) instance E.SqlString AvsInternalPersonalNo -- AvsInternalPersonalNo is an untagged Text with respect to FromJSON/ToJSON, as needed by AVS API @@ -93,7 +93,7 @@ normalizeAvsInternalPersonalNo = Text.dropWhile (\c -> '0' == c || Char.isSpace mkAvsInternalPersonalNo :: Text -> AvsInternalPersonalNo mkAvsInternalPersonalNo = AvsInternalPersonalNo . normalizeAvsInternalPersonalNo -instance Canonical AvsInternalPersonalNo where +instance Canonical AvsInternalPersonalNo where canonical (AvsInternalPersonalNo ipn) = AvsInternalPersonalNo $ Text.dropWhile (\c -> '0' == c || Char.isSpace c) ipn instance FromJSON AvsInternalPersonalNo where parseJSON x = AvsInternalPersonalNo . normalizeAvsInternalPersonalNo <$> parseJSON x @@ -103,11 +103,11 @@ instance ToJSON AvsInternalPersonalNo where type instance Element AvsInternalPersonalNo = Char instance MonoFoldable AvsInternalPersonalNo where ofoldMap f = ofoldr (mappend . f) mempty . avsInternalPersonalNo - ofoldr x y = Text.foldr x y . avsInternalPersonalNo - ofoldl' x y = Text.foldl' x y . avsInternalPersonalNo + ofoldr x y = Text.foldr x y . avsInternalPersonalNo + ofoldl' x y = Text.foldl' x y . avsInternalPersonalNo otoList = Text.unpack . avsInternalPersonalNo - oall x = Text.all x . avsInternalPersonalNo - oany x = Text.any x . avsInternalPersonalNo + oall x = Text.all x . avsInternalPersonalNo + oany x = Text.any x . avsInternalPersonalNo onull = Text.null . avsInternalPersonalNo olength = Text.length . avsInternalPersonalNo ofoldr1Ex x = Text.foldr1 x . avsInternalPersonalNo @@ -128,19 +128,19 @@ instance MonoFoldable AvsInternalPersonalNo where {-# INLINE lastEx #-} {- -instance {-# OVERLAPS #-} Canonical (Maybe AvsInternalPersonalNo) where - canonical (Just aipn) | ipn@(AvsInternalPersonalNo pn) <- canonical aipn, not (null pn) = Just ipn +instance {-# OVERLAPS #-} Canonical (Maybe AvsInternalPersonalNo) where + canonical (Just aipn) | ipn@(AvsInternalPersonalNo pn) <- canonical aipn, not (null pn) = Just ipn canonical _ = Nothing -} --- CompleteCardNo = xxxxxxxx.y +-- CompleteCardNo = xxxxxxxx.y -- where x is an 8 digit AvsCardNo prefixed by zeros, see normalizeAvsCardNo -- and y is the 1 digit AvsVersionNo -type AvsVersionNo = Text -- always 1 digit +type AvsVersionNo = Text -- always 1 digit newtype AvsCardNo = AvsCardNo { avsCardNo :: Text } -- always 8 digits -- TODO: Create Smart Constructor deriving (Eq, Ord, Show, Generic) - deriving newtype (NFData, PathPiece, Csv.ToField, Csv.FromField) + deriving newtype (NFData, PathPiece, Csv.ToField, Csv.FromField) -- No longer needed: -- deriving newtype (PersistField, PersistFieldSql) -- instance E.SqlString AvsCardNo @@ -153,7 +153,7 @@ instance ToJSON AvsCardNo where normalizeAvsCardNo :: Text -> Text normalizeAvsCardNo = Text.justifyRight 8 '0' -instance Canonical AvsCardNo where +instance Canonical AvsCardNo where canonical AvsCardNo{..} = AvsCardNo $ normalizeAvsCardNo avsCardNo -- canonical = AvsCardNo . normalizeAvsCardNo . avsCardNo @@ -164,7 +164,7 @@ data AvsFullCardNo = AvsFullCardNo { avsFullCardNo :: AvsCardNo, avsFullCardVers tshowAvsFullCardNo :: AvsFullCardNo -> Text tshowAvsFullCardNo AvsFullCardNo{..} = avsCardNo (canonical avsFullCardNo) <> Text.cons '.' avsFullCardVersion -instance Show AvsFullCardNo where +instance Show AvsFullCardNo where show = Text.unpack . tshowAvsFullCardNo readAvsFullCardNo :: Text -> Maybe AvsFullCardNo @@ -175,9 +175,9 @@ readAvsFullCardNo _ = Nothing instance PersistField AvsFullCardNo where toPersistValue = PersistText . tshowAvsFullCardNo - fromPersistValue (PersistText t) - | Just afc <- readAvsFullCardNo t = Right afc - | otherwise = Left $ "Encoding of AvsFullCardNo is invalid: " <> t + fromPersistValue (PersistText t) + | Just afc <- readAvsFullCardNo t = Right afc + | otherwise = Left $ "Encoding of AvsFullCardNo is invalid: " <> t fromPersistValue other = Left $ "Encoding of AvsFullCardNo with invalid type: " <> tshow other instance PersistFieldSql AvsFullCardNo where @@ -185,7 +185,7 @@ instance PersistFieldSql AvsFullCardNo where discernAvsCardPersonalNo :: Text -> Maybe (Either AvsFullCardNo AvsInternalPersonalNo) -- Just implies it is a whole number or decimal with one digit after the point discernAvsCardPersonalNo (Text.span Char.isDigit -> (c, pv)) - | Text.null pv + | Text.null pv = Just $ Right $ mkAvsInternalPersonalNo c | not $ Text.null c , Just ('.', v) <- Text.uncons pv @@ -199,7 +199,7 @@ newtype AvsPersonId = AvsPersonId { avsPersonId :: Int } -- untagged Int 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; +-- As opposed to AvsObjPersonId, AvsPersonId is an untagged Int with respect to FromJSON/ToJSON, as needed by AVS API; instance FromJSON AvsPersonId where parseJSON x = AvsPersonId <$> parseJSON x instance ToJSON AvsPersonId where @@ -214,7 +214,7 @@ _AvsPersonId :: Iso AvsPersonId AvsPersonId Int Int _AvsPersonId = iso avsPersonId AvsPersonId -- | Non-existing default, also needed for query all ramp driving licences -avsPersonIdZero :: AvsPersonId +avsPersonIdZero :: AvsPersonId avsPersonIdZero = AvsPersonId 0 -- this mus be zero acording to VSM specification newtype AvsObjPersonId = AvsObjPersonId -- tagged object @@ -238,7 +238,7 @@ discernAvsIds someid = aux someid , let afcn = AvsFullCardNo (AvsCardNo $ Text.dropEnd 2 someid) (Text.singleton h2) = Just $ Left afcn | otherwise = Nothing - aux _ = Right . AvsPersonId <$> readMay someid -- must always succeed at that point + aux _ = Right . AvsPersonId <$> readMay someid -- must always succeed at that point data AvsLicence = AvsNoLicence | AvsLicenceVorfeld | AvsLicenceRollfeld @@ -265,10 +265,10 @@ instance FromJSON AvsLicence where -- we assume that the Ord-Instance is respected by the SQL Backend! instance PersistField AvsLicence where toPersistValue = PersistInt64 . fromIntegral . fromEnum - fromPersistValue (PersistInt64 v') + fromPersistValue (PersistInt64 v') | let v = fromIntegral v' , v >= fromEnum (minBound::AvsLicence) - , v <= fromEnum (maxBound::AvsLicence) + , v <= fromEnum (maxBound::AvsLicence) = Right $ toEnum v fromPersistValue other = Left $ "Encoding of AvsLicence " <> tshow other <> " is out of range" @@ -314,7 +314,7 @@ data AvsDataPersonCard = AvsDataPersonCard , avsDataPostalCode:: Maybe Text -- Nothing if returned with AvsResponseStatus , avsDataCity :: Maybe Text -- Nothing if returned with AvsResponseStatus , avsDataFirm :: Maybe Text -- Nothing if returned with AvsResponseStatus - , avsDataCardNo :: AvsCardNo -- always 8 digits number, prefixed with 0 + , avsDataCardNo :: AvsCardNo -- always 8 digits number, prefixed with 0 , avsDataVersionNo :: AvsVersionNo -- always 1 digit number } deriving (Eq, Ord, Show, Generic) @@ -478,17 +478,17 @@ deriveJSON defaultOptions { fieldLabelModifier = dropCamel 2 , omitNothingFields = True , tagSingleConstructors = False - , rejectUnknownFields = False + , rejectUnknownFields = False } ''AvsLicenceResponse -data AvsPersonInfo = AvsPersonInfo +data AvsPersonInfo = AvsPersonInfo { avsInfoPersonNo :: Text -- Int -- AVS Personennummer, zum Gebrauch in menschlicher Kommunikation , avsInfoFirstName :: Text -- WARNING: name stored as is, but AVS does contain weird whitespaces , avsInfoLastName :: Text -- WARNING: name stored as is, but AVS does contain weird whitespaces , avsInfoRampLicence :: Int -- AvsLicence -- unlike other queries, may return -1 for guest unable to hold a licence; currently not distinquished from no licence , avsInfoDateOfBirth :: Maybe Day , avsInfoPersonEMail :: Maybe Text - , avsInfoPersonMobilePhoneNo :: Maybe Text + , avsInfoPersonMobilePhoneNo :: Maybe Text , avsInfoInternalPersonalNo :: Maybe AvsInternalPersonalNo -- Fraport Personalnummer } deriving (Eq, Ord, Show, Generic) @@ -508,12 +508,12 @@ instance FromJSON AvsPersonInfo where instance ToJSON AvsPersonInfo where toJSON AvsPersonInfo{..} = object $ catMaybes - [ ("DateOfBirth" .=) <$> avsInfoDateOfBirth + [ ("DateOfBirth" .=) <$> avsInfoDateOfBirth , ("PersonEMail" .=) <$> avsInfoPersonEMail & canonical - , ("PersonMobilePhoneNo" .=) <$> avsInfoPersonMobilePhoneNo & canonical + , ("PersonMobilePhoneNo" .=) <$> avsInfoPersonMobilePhoneNo & canonical , ("InternalPersonalNo" .=) <$> avsInfoInternalPersonalNo & canonical ] <> - [ "PersonsNo" .= avsInfoPersonNo + [ "PersonsNo" .= avsInfoPersonNo , "FirstName" .= avsInfoFirstName , "LastName" .= avsInfoLastName , "RampLicence" .= avsInfoRampLicence @@ -521,7 +521,44 @@ instance ToJSON AvsPersonInfo where -- derivePersistFieldJSON ''AvsPersonInfo -data AvsFirmInfo = AvsFirmInfo +data AvsFirmCommunication = AvsFirmCommunication + { avsCommunicationZIPCode :: Maybe Text + , avsCommunicationCity :: Maybe Text + , avsCommunicationCountry :: Maybe Text + , avsCommunicationStreetANDHouseNo :: Maybe Text + , avsCommunicationEMail :: Maybe Text + } deriving (Eq, Ord, Show, Generic) + +instance {-# OVERLAPS #-} Canonical (Maybe AvsFirmCommunication) where + canonical (Just AvsFirmCommunication{..}) + | isNothing avsCommunicationZIPCode + , isNothing avsCommunicationCity + , isNothing avsCommunicationCountry + , isNothing avsCommunicationStreetANDHouseNo + , isNothing avsCommunicationEMail + = Nothing + canonical other = other + +makeLenses_ ''AvsFirmCommunication + +instance FromJSON AvsFirmCommunication where + parseJSON = withObject "AvsFirmCommunication" $ \o -> AvsFirmCommunication + <$> o .:?! "ZIPCode" + <*> o .:?! "City" + <*> o .:?! "Country" + <*> o .:?! "StreetANDHouseNo" + <*> o .:?! "EMail" + +instance ToJSON AvsFirmCommunication where + toJSON AvsFirmCommunication{..} = object $ catMaybes + [ ("ZIPCode" .=) <$> avsCommunicationZIPCode & canonical + , ("City" .=) <$> avsCommunicationCity & canonical + , ("Country" .=) <$> avsCommunicationCountry & canonical + , ("StreetANDHouseNo" .=) <$> avsCommunicationStreetANDHouseNo & canonical + , ("EMail" .=) <$> avsCommunicationEMail & canonical + ] + +data AvsFirmInfo = AvsFirmInfo { avsFirmFirm :: Text , avsFirmFirmNo :: Int , avsFirmAbbreviation :: Text -- enthält manchmal Leerzeichen! @@ -531,6 +568,7 @@ data AvsFirmInfo = AvsFirmInfo , avsFirmStreetANDHouseNo :: Maybe Text , avsFirmEMail :: Maybe Text , avsFirmEMailSuperior :: Maybe Text + , avsFirmCommunication :: Maybe AvsFirmCommunication } deriving (Eq, Ord, Show, Generic) makeLenses_ ''AvsFirmInfo @@ -546,15 +584,17 @@ instance FromJSON AvsFirmInfo where <*> o .:?! "StreetANDHouseNo" <*> o .:?! "EMail" <*> o .:?! "EMailSuperior" + <*> o .:?! "Communication" instance ToJSON AvsFirmInfo where toJSON AvsFirmInfo{..} = object $ catMaybes [ ("ZIPCode" .=) <$> avsFirmZIPCode & canonical - , ("City" .=) <$> avsFirmCity & canonical + , ("City" .=) <$> avsFirmCity & canonical , ("Country" .=) <$> avsFirmCountry & canonical , ("StreetANDHouseNo" .=) <$> avsFirmStreetANDHouseNo & canonical - , ("EMail" .=) <$> avsFirmEMail & canonical + , ("EMail" .=) <$> avsFirmEMail & canonical , ("EMailSuperior" .=) <$> avsFirmEMailSuperior & canonical + , ("Communication" .=) <$> avsFirmCommunication & canonical ] <> [ "Firm" .= avsFirmFirm , "FirmNo" .= avsFirmFirmNo @@ -566,7 +606,7 @@ instance ToJSON AvsFirmInfo where data AvsDataContact = AvsDataContact { avsContactPersonID :: AvsPersonId , avsContactPersonInfo :: AvsPersonInfo - , avsContactFirmInfo :: AvsFirmInfo + , avsContactFirmInfo :: AvsFirmInfo } deriving (Eq, Ord, Show, Generic) makeLenses_ ''AvsDataContact @@ -591,14 +631,14 @@ deriveJSON defaultOptions type AvsResponseStatus :: Type newtype AvsResponseStatus = AvsResponseStatus (Set AvsStatusPerson) deriving (Eq, Ord, Show, Generic) -makeWrapped ''AvsResponseStatus +makeWrapped ''AvsResponseStatus deriveJSON defaultOptions { fieldLabelModifier = dropCamel 2 , omitNothingFields = True , tagSingleConstructors = False , rejectUnknownFields = False } ''AvsResponseStatus -instance Semigroup AvsResponseStatus where +instance Semigroup AvsResponseStatus where (AvsResponseStatus a) <> (AvsResponseStatus b) = AvsResponseStatus (a <> b) newtype AvsResponsePerson = AvsResponsePerson (Set AvsDataPerson) @@ -668,11 +708,11 @@ deriveJSON defaultOptions } ''AvsQueryPerson newtype AvsQueryStatus = AvsQueryStatus (Set AvsPersonId) - deriving (Eq, Ord, Show, Generic) + 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 +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