fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

chore(avs): add covenience clean up to avs admin person search

Browse Source
This commit is contained in:
Steffen Jost 2024-06-24 11:30:17 +02:00
parent d161c296ad
commit f425bd9afe
2 changed files with 26 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/Handler/Admin/Avs.hs
View File

@ -163,7 +163,7 @@ postAdminAvsR = do
((presult, pwidget), penctype) <- runFormPost $ makeAvsPersonForm Nothing ((presult, pwidget), penctype) <- runFormPost $ makeAvsPersonForm Nothing
let procFormPerson :: AvsQueryPerson -> Handler (Maybe (Maybe Widget, Maybe AvsPersonId)) let procFormPerson :: AvsQueryPerson -> Handler (Maybe (Maybe Widget, Maybe AvsPersonId))
procFormPerson fr = do procFormPerson (fixAvsQueryPerson -> fr) = do
addMessage Info $ text2Html $ "Query: " <> tshow (toJSON fr) addMessage Info $ text2Html $ "Query: " <> tshow (toJSON fr)
try (avsQuery fr) >>= \case try (avsQuery fr) >>= \case
Left err -> return $ Just (Just $ exceptionWgt err, Nothing) Left err -> return $ Just (Just $ exceptionWgt err, Nothing)

26
src/Model/Types/Avs.hs
View File

@ -176,12 +176,17 @@ instance FromJSON AvsCardNo where
instance ToJSON AvsCardNo where instance ToJSON AvsCardNo where
toJSON (AvsCardNo cno) = toJSON $ normalizeAvsCardNo cno toJSON (AvsCardNo cno) = toJSON $ normalizeAvsCardNo cno
normalizeAvsCardNo :: Text -> Text normalizeAvsCardNo :: Text -> Text
normalizeAvsCardNo = Text.justifyRight 8 '0' normalizeAvsCardNo = Text.justifyRight 8 '0' . Text.strip
instance Canonical AvsCardNo where instance Canonical AvsCardNo where
canonical AvsCardNo{..} = AvsCardNo $ normalizeAvsCardNo avsCardNo canonical AvsCardNo{..} = AvsCardNo $ normalizeAvsCardNo avsCardNo
-- canonical = AvsCardNo . normalizeAvsCardNo . avsCardNo -- canonical = AvsCardNo . normalizeAvsCardNo . avsCardNo
instance Canonical (Maybe AvsCardNo) where
canonical (Just AvsCardNo{avsCardNo=(Text.strip -> acn)})
| not (Text.null acn) = Just $ AvsCardNo $ normalizeAvsCardNo acn
canonical _ = Nothing
data AvsFullCardNo = AvsFullCardNo { avsFullCardNo :: AvsCardNo, avsFullCardVersion :: AvsVersionNo } data AvsFullCardNo = AvsFullCardNo { avsFullCardNo :: AvsCardNo, avsFullCardVersion :: AvsVersionNo }
deriving (Eq, Ord, Generic, NFData) deriving (Eq, Ord, Generic, NFData)
@ -816,6 +821,25 @@ deriveJSON defaultOptions
, rejectUnknownFields = False , rejectUnknownFields = False
} ''AvsQueryPerson } ''AvsQueryPerson
-- | fix common problem of card no being given in a single field with a dot or containing whitespace
fixAvsQueryPerson :: AvsQueryPerson -> AvsQueryPerson
fixAvsQueryPerson AvsQueryPerson{avsPersonQueryVersionNo=Nothing, avsPersonQueryCardNo=Just (AvsCardNo (Text.strip -> acn0)),..}
| Just (Right AvsFullCardNo{avsFullCardNo=acn1, avsFullCardVersion=avc1}) <- parseAvsCardNo acn0
= AvsQueryPerson
{ avsPersonQueryCardNo = Just acn1
, avsPersonQueryVersionNo = Just avc1
, avsPersonQueryFirstName = canonical avsPersonQueryFirstName
, avsPersonQueryLastName = canonical avsPersonQueryLastName
, avsPersonQueryInternalPersonalNo = canonical avsPersonQueryInternalPersonalNo
}
fixAvsQueryPerson AvsQueryPerson{..} = AvsQueryPerson
{ avsPersonQueryCardNo = canonical avsPersonQueryCardNo
, avsPersonQueryVersionNo = canonical avsPersonQueryVersionNo
, avsPersonQueryFirstName = canonical avsPersonQueryFirstName
, avsPersonQueryLastName = canonical avsPersonQueryLastName
, avsPersonQueryInternalPersonalNo = canonical avsPersonQueryInternalPersonalNo
}
newtype AvsQueryStatus = AvsQueryStatus (Set AvsPersonId) newtype AvsQueryStatus = AvsQueryStatus (Set AvsPersonId)
deriving (Show, Generic) deriving (Show, Generic)
deriving newtype (Eq, Ord, NFData, Binary) deriving newtype (Eq, Ord, NFData, Binary)