-- SPDX-FileCopyrightText: 2022 Steffen Jost <jost@tcs.ifi.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

{-|
Module: Model.Types.Avs
Description: Types for interface to AusweisVerwaltungsSystem (AVS)
-}

module Model.Types.Avs
  ( module Model.Types.Avs
  ) where

import Import.NoModel hiding ((.=))
import Database.Persist.Sql
import qualified Database.Esqueleto.Experimental as E
import qualified Data.Csv as Csv
import Utils.Lens.TH

import Text.Read (Read(..))
import qualified Data.Char          as Char
import qualified Data.Text          as Text
import qualified Data.Set           as Set

-- import qualified Data.HashMap.Lazy  as HM

import Data.Aeson
import Data.Aeson.Types


{-
-- | Like (.:) but attempts parsing with case-insensitve keys as fallback.
--   Note that the type also works for an optional field
--   Taken from Data.Aeson.Filthy, which could somehow not be added as a dependency.
(.:~) :: FromJSON a => Object -> Text -> Parser a
o .:~ key = o .: key <|> maybe empty parseJSON go
    where go = lookup (Text.toLower key) [(Text.toLower k, v) | (k,v) <- HM.toList o]

- Like (.:?) but attempts parsing with case-insensitve keys as fallback.
(.:?~) :: FromJSON a => Object -> Text -> Parser (Maybe a)
o .:?~ key = o .: key <|> maybe empty parseJSON go
    where go = lookup (Text.toLower key) [(Text.toLower k, v) | (k,v) <- HM.toList o]
-}


-- Like (.:?) but maps Just null to Nothing, ie. Nothing instead of Just ""
(.:?!) :: (Canonical (Maybe a), FromJSON a) => Object -> Text -> Parser (Maybe a)
(.:?!) o k = canonical <$> (o .:? k)


-- | `SloppyBool` successfully parses different variations of true/false
newtype SloppyBool = SloppyBool { sloppyBool :: Bool }
  deriving (Bounded, Enum, Eq, Ord, Generic)

-- Cannot tell difference between SloppyBool and Bool through Show and Read. A good or a bad idea?
instance Show SloppyBool where
  show = show . sloppyBool

instance Read SloppyBool where
  readPrec = fmap SloppyBool readPrec
  -- readsPrec n s = first SloppyBool <$> readsPrec n s

instance ToJSON SloppyBool where
    toJSON (SloppyBool True) = "true"
    toJSON _                 = "false"

instance FromJSON SloppyBool where
    parseJSON (Bool b)  = pure $ SloppyBool b
    parseJSON (String t)
        | lowb == "true"  = true
        | lowb == "t"     = true
        | lowb == "f"     = false
        | lowb == "false" = false
      where lowb    = Text.toLower $ Text.strip t
            true  = pure $ SloppyBool True
            false = pure $ SloppyBool False
    parseJSON invalid   = prependFailure "parsing SloppyBool failed, " $ fail $ "expected Bool or String encoding boolean. Found " ++ show invalid


-------------------
-- AVS Datatypes --
-------------------

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)
instance E.SqlString AvsInternalPersonalNo
-- AvsInternalPersonalNo is an untagged Text with respect to FromJSON/ToJSON, as needed by AVS API

normalizeAvsInternalPersonalNo :: Text -> Text
normalizeAvsInternalPersonalNo = Text.dropWhile (\c -> '0' == c || Char.isSpace c)

mkAvsInternalPersonalNo :: Text -> AvsInternalPersonalNo
mkAvsInternalPersonalNo = AvsInternalPersonalNo . normalizeAvsInternalPersonalNo

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
instance ToJSON AvsInternalPersonalNo where
  toJSON (AvsInternalPersonalNo ipn) = toJSON $ normalizeAvsInternalPersonalNo ipn

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
  otoList = Text.unpack . 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
  ofoldl1Ex' x = Text.foldl1' x . avsInternalPersonalNo
  headEx = Text.head . avsInternalPersonalNo
  lastEx = Text.last . avsInternalPersonalNo
  {-# INLINE ofoldMap #-}
  {-# INLINE ofoldr #-}
  {-# INLINE ofoldl' #-}
  {-# INLINE otoList #-}
  {-# INLINE oall #-}
  {-# INLINE oany #-}
  {-# INLINE onull #-}
  {-# INLINE olength #-}
  {-# INLINE ofoldr1Ex #-}
  {-# INLINE ofoldl1Ex' #-}
  {-# INLINE headEx #-}
  {-# INLINE lastEx #-}

{-
instance {-# OVERLAPS #-} Canonical (Maybe AvsInternalPersonalNo) where
  canonical (Just aipn) | ipn@(AvsInternalPersonalNo pn) <- canonical aipn, not (null pn) = Just ipn
  canonical _ = Nothing
-}


-- 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
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)
-- No longer needed:
-- deriving newtype (PersistField, PersistFieldSql)
-- instance E.SqlString AvsCardNo

-- AvsCardNo is an untagged Text with respect to FromJSON/ToJSON, as needed by AVS API
instance FromJSON AvsCardNo where
  parseJSON x = AvsCardNo . normalizeAvsCardNo <$> parseJSON x
instance ToJSON AvsCardNo where
  toJSON (AvsCardNo cno) = toJSON $ normalizeAvsCardNo cno
normalizeAvsCardNo :: Text -> Text
normalizeAvsCardNo = Text.justifyRight 8 '0'

instance Canonical AvsCardNo where
  canonical AvsCardNo{..} = AvsCardNo $ normalizeAvsCardNo avsCardNo
  -- canonical = AvsCardNo . normalizeAvsCardNo . avsCardNo


data AvsFullCardNo = AvsFullCardNo { avsFullCardNo :: AvsCardNo, avsFullCardVersion :: AvsVersionNo }
  deriving (Eq, Ord, Generic, NFData)

tshowAvsFullCardNo :: AvsFullCardNo -> Text
tshowAvsFullCardNo AvsFullCardNo{..} = avsCardNo (canonical avsFullCardNo) <> Text.cons '.' avsFullCardVersion

instance Show AvsFullCardNo where
  show = Text.unpack . tshowAvsFullCardNo

readAvsFullCardNo :: Text -> Maybe AvsFullCardNo
readAvsFullCardNo (Text.span Char.isDigit -> (c, Text.uncons -> Just ('.',v)))
  | not $ Text.null c, Just (Char.isDigit -> True, "") <- Text.uncons v
    = Just $ AvsFullCardNo (AvsCardNo $ normalizeAvsCardNo c) v
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 other  = Left $ "Encoding of AvsFullCardNo with invalid type: " <> tshow other

instance PersistFieldSql AvsFullCardNo where
  sqlType _ = SqlString

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
    = Just $ Right $ mkAvsInternalPersonalNo c
  | not $ Text.null c
  , Just ('.', v) <- Text.uncons pv
  , Just (Char.isDigit -> True, "") <- Text.uncons v
    = Just $ Left $ AvsFullCardNo (AvsCardNo c) v
discernAvsCardPersonalNo _ = Nothing

-- The AVS API requires PersonIds sometimes as as mere numbers `AvsPersonId` and sometimes as tagged objects `AvsObjPersonId`
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
  parseJSON x = AvsPersonId <$> parseJSON x
instance ToJSON AvsPersonId where
  toJSON (AvsPersonId pid) = toJSON pid
-- Cannot tell difference between AvsPersonId and Int through Show and Read. A good or a bad idea?
instance Show AvsPersonId where
  show = show . avsPersonId
instance Read AvsPersonId where
  readPrec = fmap AvsPersonId readPrec

_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 0 -- this mus be zero acording to VSM specification

newtype AvsObjPersonId = AvsObjPersonId -- tagged object
      { avsObjPersonID :: AvsPersonId
      }
  deriving (Eq, Ord, Show, Generic)
deriveJSON defaultOptions
  { fieldLabelModifier = dropCamel 2
  , omitNothingFields = True
  , tagSingleConstructors = False
  , rejectUnknownFields = False
  } ''AvsObjPersonId


discernAvsIds :: Text -> Maybe (Either AvsFullCardNo AvsPersonId)
discernAvsIds someid = aux someid
  where
    aux (Text.uncons -> Just (h,t))
      | Char.isDigit h = aux t
      | h == '.', Just (h2, t2) <- Text.uncons t, Text.null t2, Char.isDigit h2
      , 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


data AvsLicence = AvsNoLicence | AvsLicenceVorfeld | AvsLicenceRollfeld
  deriving (Bounded, Enum, Eq, Ord, Read, Show, Generic, Finite, Universe, NFData)

instance ToJSON AvsLicence where
    -- toJSON al = Number $ fromEnum AvsLicence -- would do, but...
    toJSON AvsNoLicence       = Number 0
    toJSON AvsLicenceVorfeld  = Number 1
    toJSON AvsLicenceRollfeld = Number 2

instance FromJSON AvsLicence where
  parseJSON (Number n)  | n == 1 = pure AvsLicenceVorfeld   -- ordered by occurrence, n==1 is most common case
                        | n == 2 = pure AvsLicenceRollfeld
                        | n == 0 = pure AvsNoLicence
                    {-  | n ==(-1) = pure AvsNoLicenceGuest -- InfoContact may send -1 for Guest unable to obtain a licence -}
#ifdef DEVELOPMENT
  parseJSON invalid = prependFailure "parsing AvsLicence failed, " $ fail $ "expected Int value being 0, 1 or 2. Found " ++ show invalid
#else
  parseJSON _ = pure AvsNoLicence     -- we simply ignore all other values
#endif


-- we assume that the Ord-Instance is respected by the SQL Backend!
instance PersistField AvsLicence where
  toPersistValue = PersistInt64 . fromIntegral . fromEnum
  fromPersistValue (PersistInt64 v')
    | let v = fromIntegral v'
    , v >= fromEnum (minBound::AvsLicence)
    , v <= fromEnum (maxBound::AvsLicence)
      = Right $ toEnum v
  fromPersistValue other = Left $ "Encoding of AvsLicence " <> tshow other <> " is out of range"

instance PersistFieldSql AvsLicence where
  sqlType _ = SqlInt64

-- | Ought to be identical to QualificationShortname!
licence2char :: AvsLicence -> Char
licence2char AvsNoLicence       = '0'
licence2char AvsLicenceVorfeld  = 'F'
licence2char AvsLicenceRollfeld = 'R'


data AvsDataCardColor = AvsCardColorMisc Text | AvsCardColorGrün | AvsCardColorBlau | AvsCardColorRot | AvsCardColorGelb
  deriving (Eq, Ord, Read, Show, Generic)
  deriving anyclass (NFData)
  -- instance RenderMessage declared in Foundation.I18n

instance ToJSON AvsDataCardColor where
  toJSON  AvsCardColorGrün    = "Grün"
  toJSON  AvsCardColorBlau    = "Blau"
  toJSON  AvsCardColorRot     = "Rot"
  toJSON  AvsCardColorGelb    = "Gelb"
  toJSON (AvsCardColorMisc t) = String t

instance FromJSON AvsDataCardColor where
  parseJSON (String t) = case Text.toLower t of
    "grün" -> pure AvsCardColorGrün
    "blau" -> pure AvsCardColorBlau
    "rot"  -> pure AvsCardColorRot
    "gelb" -> pure AvsCardColorGelb
    _      -> pure $ AvsCardColorMisc t
  parseJSON invalid = prependFailure "parsing AvsDataCardColor failed, " (typeMismatch "String" invalid)


data AvsDataPersonCard = AvsDataPersonCard
      { avsDataValid     :: Bool          -- card currently valid? Note that AVS encodes booleans as JSON String "true" and "false" and not as JSON booleans
      , avsDataValidTo   :: Maybe Day     -- Nothing if returned with AvsResponseStatus
      , avsDataIssueDate :: Maybe Day     -- Nothing if returned with AvsResponseStatus
      , avsDataCardColor :: AvsDataCardColor
      , avsDataCardAreas :: Set Char      -- logically a set of upper-case letters
      , avsDataStreet    :: Maybe Text    -- Nothing if returned with AvsResponseStatus
      , 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
      , avsDataVersionNo :: AvsVersionNo  -- always 1 digit number
      }
  deriving (Eq, Ord, Show, Generic)
  deriving anyclass (NFData)

{- Automatically derived Ord instance should prioritize avsDataValid and avsDataValidTo. Checked in test/Model.TypesSpec
instance Ord AvsDataPersonCard where
  compare a b =
          compareBy avsDataValid
      <>  compareBy avsDataValidTo
      <>  compareBy avsDataIssueDate
      <>  compareBy avsDataCardAreas
      ...
    where
      compareBy f = compare `on` f a b
 -}

makeLenses_ ''AvsDataPersonCard
{-
instance Canonical AvsDataPersonCard where
  canonical proto = proto { avsDataStreet     = canonical $ avsDataStreet      proto
                          , avsDataPostalCode = canonical $ avsDataPostalCode  proto
                          , avsDataCity       = canonical $ avsDataCity        proto
                          , avsDataFirm       = canonical $ avsDataFirm        proto
                          }
-}
instance Canonical AvsDataPersonCard where
  canonical proto =
    proto & _avsDataStreet      %~ canonical
          & _avsDataPostalCode  %~ canonical
          & _avsDataCity        %~ canonical
          & _avsDataFirm        %~ canonical
          & _avsDataCardNo      %~ canonical

-- TODO: use canonical in FromJSON/ToJSON instances for consistency
instance FromJSON AvsDataPersonCard where
  parseJSON = withObject "AvsDataPersonCard" $ \v -> AvsDataPersonCard    -- NOTE: String "AvsDataPersonCard" is only used in error messages when parsing fails
    <$> ((v .: "Valid") <&> sloppyBool)
    <*> v .:? "ValidTo"
    <*> v .:? "IssueDate"
    <*> v .: "CardColor"
    <*> ((v .: "CardAreas") <&> charSet)
    <*> v .:?! "Street"
    <*> v .:?! "PostalCode"
    <*> v .:?! "City"
    <*> v .:?! "Firm"
    <*> ((v .: "CardNo") <&> canonical)
    <*> v .: "VersionNo"

instance ToJSON AvsDataPersonCard where
  toJSON AvsDataPersonCard{..} = object $
    catMaybes
    [ ("ValidTo"     .=) <$> avsDataValidTo
    , ("IssueDate"   .=) <$> avsDataIssueDate
    , ("Street"      .=) <$> (avsDataStreet     & canonical)
    , ("PostalCode"  .=) <$> (avsDataPostalCode & canonical)
    , ("City"        .=) <$> (avsDataCity       & canonical)
    , ("Firm"        .=) <$> (avsDataFirm       & canonical)
    ]
    <>
    [ "Valid"       .= show avsDataValid
    , "CardColor"   .= avsDataCardColor
    , "CardAreas"   .= Set.foldl Text.snoc Text.empty avsDataCardAreas
    , "CardNo"      .= (avsDataCardNo & canonical)
    , "VersionNo"   .= avsDataVersionNo
    ]
derivePersistFieldJSON ''AvsDataPersonCard

getFullCardNo :: AvsDataPersonCard -> AvsFullCardNo
getFullCardNo AvsDataPersonCard{avsDataCardNo, avsDataVersionNo} = AvsFullCardNo avsDataCardNo avsDataVersionNo

-- | like `tshowAvsFullCardNo` but without leading zeroes for use as pdf pin
personCard2pin :: AvsDataPersonCard -> Text
personCard2pin = Text.dropWhile ('0'==) . tshowAvsFullCardNo . getFullCardNo

data AvsStatusPerson = AvsStatusPerson
      { avsStatusPersonID         :: AvsPersonId
      , avsStatusPersonCardStatus :: Set AvsDataPersonCard -- only delivers non-Maybe fields, all Maybe-fields are Nothing
      }
  deriving (Eq, Ord, Show, Generic)

deriveJSON defaultOptions
  { fieldLabelModifier = \case { "avsStatusPersonCardStatus" -> "personCardStatus"; others -> dropCamel 2 others }
  , omitNothingFields = True
  , tagSingleConstructors = False
  , rejectUnknownFields = False
  } ''AvsStatusPerson

data AvsDataPerson = AvsDataPerson
      { avsPersonFirstName          :: Text                         -- WARNING: name stored as is, but AVS does contain weird whitespaces
      , avsPersonLastName           :: Text                         -- WARNING: name stored as is, but AVS does contain weird whitespaces
      , avsPersonInternalPersonalNo :: Maybe AvsInternalPersonalNo  -- Fraport Personalnummer
      , avsPersonPersonNo           :: Int                          -- AVS Personennummer, in menschlicher Kommunikation verwendet
      , avsPersonPersonID           :: AvsPersonId                  -- Eindeutige PersonenID, wichtig für die Schnittstelle!
      , avsPersonPersonCards        :: Set AvsDataPersonCard
      }
    deriving (Eq, Ord, Show, Generic)

makeLenses_ ''AvsDataPerson

instance Canonical AvsDataPerson where
  canonical = over _avsPersonInternalPersonalNo canonical
            . over _avsPersonPersonCards        canonical


instance FromJSON AvsDataPerson where
  parseJSON = withObject "AvsDataPerson" $ \v -> AvsDataPerson
    <$> v .:    "FirstName"
    <*> v .:    "LastName"
    <*> v .:?!  "InternalPersonalNo"
    <*> v .:    "PersonNo"
    <*> v .:    "PersonID"
    <*> v .:    "personCards"                        -- starts with lower case letter!

instance ToJSON AvsDataPerson where
  toJSON AvsDataPerson{..} = object $
    catMaybes [ ("InternalPersonalNo"  .=) <$> (avsPersonInternalPersonalNo & canonical) ]
    <>
    [ "FirstName"           .= avsPersonFirstName
    , "LastName"            .= avsPersonLastName
    , "PersonNo"            .= avsPersonPersonNo
    , "PersonID"            .= avsPersonPersonID
    , "personCards"         .= avsPersonPersonCards   -- starts with lower case letter!
    ]

{- Derived instance decodes empty Texts to Just "", which is annoying
deriveJSON defaultOptions
  { fieldLabelModifier = \case { "avsPersonPersonCards" -> "personCards"; others -> dropCamel 2 others }
  , omitNothingFields = True
  , tagSingleConstructors = False
  , rejectUnknownFields = False
  } ''AvsDataPerson
-}

data AvsPersonLicence = AvsPersonLicence
      { avsLicenceRampLicence  :: AvsLicence
      , avsLicencePersonID     :: AvsPersonId
      }
  deriving (Eq, Ord, Show, Generic)
deriveJSON defaultOptions
  { fieldLabelModifier = dropCamel 2
  , omitNothingFields = True
  , tagSingleConstructors = False
  , rejectUnknownFields = False
  } ''AvsPersonLicence

avsPersonLicenceIs :: AvsPersonLicence -> AvsLicence -> Bool
avsPersonLicenceIs = (==) . avsLicenceRampLicence

avsPersonLicenceIsLEQ :: AvsPersonLicence -> AvsLicence -> Bool
avsPersonLicenceIsLEQ = (<=) . avsLicenceRampLicence


data AvsLicenceResponse = AvsLicenceResponse
        { avsResponsePersonID :: AvsPersonId
        , avsResponseSuccess  :: SloppyBool
        , avsResponseMessage  :: Text
        }
    deriving (Eq, Ord, Show, Generic)
deriveJSON defaultOptions
  { fieldLabelModifier = dropCamel 2
  , omitNothingFields = True
  , tagSingleConstructors = False
  , rejectUnknownFields = False
  } ''AvsLicenceResponse

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
  , avsInfoInternalPersonalNo   :: Maybe AvsInternalPersonalNo  -- Fraport Personalnummer
  } deriving (Eq, Ord, Show, Generic)

makeLenses_ ''AvsPersonInfo

instance FromJSON AvsPersonInfo where
  parseJSON = withObject "AvsPersonInfo" $ \o -> AvsPersonInfo
    <$> o .:   "PersonsNo"                                      -- NOTE: PersonsNo, not PersonNo as elsewhere
    <*> o .:   "FirstName"
    <*> o .:   "LastName"
    <*> o .:   "RampLicence"
    <*> o .:?  "DateOfBirth"
    <*> o .:?! "PersonEMail"
    <*> o .:?! "PersonMobilePhoneNo"
    <*> o .:?! "InternalPersonalNo"


instance ToJSON AvsPersonInfo where
  toJSON AvsPersonInfo{..} = object $ catMaybes
    [ ("DateOfBirth"         .=) <$> avsInfoDateOfBirth
    , ("PersonEMail"         .=) <$> avsInfoPersonEMail         & canonical
    , ("PersonMobilePhoneNo" .=) <$> avsInfoPersonMobilePhoneNo & canonical
    , ("InternalPersonalNo"  .=) <$> avsInfoInternalPersonalNo  & canonical
    ] <>
    [ "PersonsNo"   .= avsInfoPersonNo
    , "FirstName"   .= avsInfoFirstName
    , "LastName"    .= avsInfoLastName
    , "RampLicence" .= avsInfoRampLicence
    ]
-- derivePersistFieldJSON ''AvsPersonInfo


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!
  , avsFirmZIPCode          :: Maybe Text
  , avsFirmCity             :: Maybe Text
  , avsFirmCountry          :: Maybe Text
  , avsFirmStreetANDHouseNo :: Maybe Text
  , avsFirmEMail            :: Maybe Text
  , avsFirmEMailSuperior    :: Maybe Text
  , avsFirmCommunication    :: Maybe AvsFirmCommunication
  } deriving (Eq, Ord, Show, Generic)

makeLenses_ ''AvsFirmInfo

instance FromJSON AvsFirmInfo where
  parseJSON = withObject "AvsFirmInfo" $ \o -> AvsFirmInfo
    <$> o .:   "Firm"
    <*> o .:   "FirmNo"
    <*> o .:   "Abbreviation"
    <*> o .:?! "ZIPCode"
    <*> o .:?! "City"
    <*> o .:?! "Country"
    <*> o .:?! "StreetANDHouseNo"
    <*> o .:?! "EMail"
    <*> o .:?! "EMailSuperior"
    <*> o .:?! "Communication"

instance ToJSON AvsFirmInfo where
  toJSON AvsFirmInfo{..} = object $ catMaybes
    [ ("ZIPCode"          .=) <$> avsFirmZIPCode          & canonical
    , ("City"             .=) <$> avsFirmCity             & canonical
    , ("Country"          .=) <$> avsFirmCountry          & canonical
    , ("StreetANDHouseNo" .=) <$> avsFirmStreetANDHouseNo & canonical
    , ("EMail"            .=) <$> avsFirmEMail            & canonical
    , ("EMailSuperior"    .=) <$> avsFirmEMailSuperior    & canonical
    , ("Communication"    .=) <$> avsFirmCommunication    & canonical
    ] <>
    [ "Firm"          .= avsFirmFirm
    , "FirmNo"        .= avsFirmFirmNo
    , "Abbreviation"  .= avsFirmAbbreviation
    ]
-- derivePersistFieldJSON ''AvsFirmInfo


data AvsDataContact = AvsDataContact
  { avsContactPersonID    :: AvsPersonId
  , avsContactPersonInfo  :: AvsPersonInfo
  , avsContactFirmInfo    :: AvsFirmInfo
  } deriving (Eq, Ord, Show, Generic)

makeLenses_ ''AvsDataContact

-- instance Canonical AvsDataContact where
--   canonical = over _avsContactPersonInfo canonical
--             . over _avsContactFirmInfo   canonical

deriveJSON defaultOptions
  { fieldLabelModifier = dropCamel 2
  , tagSingleConstructors = False
  , rejectUnknownFields = False
  } ''AvsDataContact




--------------
-- Responses --
---------------

type AvsResponseStatus :: Type
newtype AvsResponseStatus = AvsResponseStatus (Set AvsStatusPerson)
  deriving (Eq, Ord, Show, Generic)
makeWrapped ''AvsResponseStatus
deriveJSON defaultOptions
  { fieldLabelModifier = dropCamel 2
  , omitNothingFields = True
  , tagSingleConstructors = False
  , rejectUnknownFields = False
  } ''AvsResponseStatus
instance Semigroup AvsResponseStatus where
  (AvsResponseStatus a) <> (AvsResponseStatus b) = AvsResponseStatus (a <> b)

newtype AvsResponsePerson = AvsResponsePerson (Set AvsDataPerson)
  deriving (Eq, Ord, Show, Generic)
-- makeWrapped ''AvsResponsePerson
deriveJSON defaultOptions
  { fieldLabelModifier = dropCamel 2
  , omitNothingFields = True
  , tagSingleConstructors = False
  , rejectUnknownFields = False
  } ''AvsResponsePerson

newtype AvsResponseContact = AvsResponseContact (Set AvsDataContact)
  deriving (Eq, Ord, Show, Generic)
makeWrapped ''AvsResponseContact
deriveJSON defaultOptions
  { fieldLabelModifier = dropCamel 2
  , omitNothingFields = True
  , tagSingleConstructors = False
  , rejectUnknownFields = False
  } ''AvsResponseContact

newtype AvsResponseGetLicences = AvsResponseGetLicences (Set AvsPersonLicence)
  deriving (Eq, Ord, Show, Generic)
deriveJSON defaultOptions
  { fieldLabelModifier = dropCamel 2
  , omitNothingFields = True
  , tagSingleConstructors = False
  , rejectUnknownFields = False
  } ''AvsResponseGetLicences

data AvsResponseSetLicences = AvsResponseSetLicences (Set AvsLicenceResponse)
                            | AvsResponseSetLicencesError
                                { avsResponseSetLicencesStatus   :: Text
                                , avsResponseSetLicencesMessage  :: Text
                                }
  deriving (Eq, Ord, Show, Generic)
deriveJSON defaultOptions
  { fieldLabelModifier = dropCamel 4
  , omitNothingFields = True
  , tagSingleConstructors = False
  , rejectUnknownFields = False
  , sumEncoding = UntaggedValue
  } ''AvsResponseSetLicences


-------------
-- Queries --
-------------
data AvsQueryPerson = AvsQueryPerson
        { avsPersonQueryCardNo             :: Maybe AvsCardNo
        , avsPersonQueryVersionNo          :: Maybe AvsVersionNo
        , avsPersonQueryFirstName          :: Maybe Text
        , avsPersonQueryLastName           :: Maybe Text
        , avsPersonQueryInternalPersonalNo :: Maybe AvsInternalPersonalNo
        }
  deriving (Eq, Ord, Show, Generic)

instance Default AvsQueryPerson where
  def = AvsQueryPerson Nothing Nothing Nothing Nothing Nothing

deriveJSON defaultOptions
  { fieldLabelModifier    = dropCamel 3
  , omitNothingFields     = True
  , tagSingleConstructors = False
  , rejectUnknownFields   = False
  } ''AvsQueryPerson

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)
deriveJSON defaultOptions ''AvsQueryGetLicences

newtype AvsQuerySetLicences = AvsQuerySetLicences (Set AvsPersonLicence)
  deriving (Eq, Ord, Show, Generic)
deriveJSON defaultOptions ''AvsQuerySetLicences
