chore(avs): add firm communication address field to json parser

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 
+  ofoldr x y = Text.foldr x y . avsInternalPersonalNo
-  ofoldl' x y = Text.foldl' x y . avsInternalPersonalNo 
+  ofoldl' x y = Text.foldl' x y . avsInternalPersonalNo
   otoList = Text.unpack . avsInternalPersonalNo
-  oall x = Text.all x . avsInternalPersonalNo   
+  oall x = Text.all x . avsInternalPersonalNo
-  oany x = Text.any 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 
+instance {-# OVERLAPS #-} Canonical (Maybe AvsInternalPersonalNo) where
-  canonical (Just aipn) | ipn@(AvsInternalPersonalNo pn) <- canonical aipn, not (null pn) = Just ipn 
+  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) 
+  fromPersistValue (PersistText t)
-    | Just afc <- readAvsFullCardNo t = Right afc 
+    | Just afc <- readAvsFullCardNo t = Right afc
-    | otherwise           = Left $ "Encoding of AvsFullCardNo is invalid: " <> t 
+    | 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