diff --git a/src/Handler/Admin/Avs.hs b/src/Handler/Admin/Avs.hs index d117376e8..90e15c3f3 100644 --- a/src/Handler/Admin/Avs.hs +++ b/src/Handler/Admin/Avs.hs @@ -163,7 +163,7 @@ postAdminAvsR = do ((presult, pwidget), penctype) <- runFormPost $ makeAvsPersonForm Nothing let procFormPerson :: AvsQueryPerson -> Handler (Maybe (Maybe Widget, Maybe AvsPersonId)) - procFormPerson fr = do + procFormPerson (fixAvsQueryPerson -> fr) = do addMessage Info $ text2Html $ "Query: " <> tshow (toJSON fr) try (avsQuery fr) >>= \case Left err -> return $ Just (Just $ exceptionWgt err, Nothing) diff --git a/src/Model/Types/Avs.hs b/src/Model/Types/Avs.hs index 7ab00ebc0..9a7a032ed 100644 --- a/src/Model/Types/Avs.hs +++ b/src/Model/Types/Avs.hs @@ -176,12 +176,17 @@ instance FromJSON AvsCardNo where instance ToJSON AvsCardNo where toJSON (AvsCardNo cno) = toJSON $ normalizeAvsCardNo cno normalizeAvsCardNo :: Text -> Text -normalizeAvsCardNo = Text.justifyRight 8 '0' +normalizeAvsCardNo = Text.justifyRight 8 '0' . Text.strip instance Canonical AvsCardNo where canonical AvsCardNo{..} = 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 } deriving (Eq, Ord, Generic, NFData) @@ -816,6 +821,25 @@ deriveJSON defaultOptions , rejectUnknownFields = False } ''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) deriving (Show, Generic) deriving newtype (Eq, Ord, NFData, Binary)