chore(avs): add firm communication address field to json parser
This commit is contained in:
parent
b68eff63ca
commit
1286dc7e78
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user