test(avs): AvsCardNo instances adjusted for 8-digit codes
This commit is contained in:
parent
a5010eb61d
commit
9bfcbfc568
@ -424,7 +424,7 @@ postPrintAckDirectR = do
|
|||||||
case enr of
|
case enr of
|
||||||
Left (e :: SomeException) -> do -- catch all to avoid ok220 in case of any error
|
Left (e :: SomeException) -> do -- catch all to avoid ok220 in case of any error
|
||||||
$logWarnS "APC" $ "Result upload failed parsing: " <> tshow e
|
$logWarnS "APC" $ "Result upload failed parsing: " <> tshow e
|
||||||
return (badRequest400, "Exception: " <> tshow e)
|
return (badRequest400, "Error: " <> tshow e)
|
||||||
Right lids -> do
|
Right lids -> do
|
||||||
now <- liftIO getCurrentTime
|
now <- liftIO getCurrentTime
|
||||||
nr <- updateWhereCount
|
nr <- updateWhereCount
|
||||||
@ -444,7 +444,7 @@ postPrintAckDirectR = do
|
|||||||
$logWarnS "APC" msg
|
$logWarnS "APC" msg
|
||||||
return (ok200, msg)
|
return (ok200, msg)
|
||||||
[] -> do
|
[] -> do
|
||||||
let msg = "Warning: No file received. A file of lms identifiers must be supplied for print job acknowledging."
|
let msg = "Error: No file received. A file of lms identifiers must be supplied for print job acknowledging."
|
||||||
$logWarnS "APC" msg
|
$logWarnS "APC" msg
|
||||||
return (badRequest400, msg)
|
return (badRequest400, msg)
|
||||||
_other -> do
|
_other -> do
|
||||||
|
|||||||
@ -83,7 +83,7 @@ instance FromJSON SloppyBool where
|
|||||||
type AvsInternalPersonalNo = Text -- type synonym for clarity/documentation within types
|
type AvsInternalPersonalNo = Text -- type synonym for clarity/documentation within types
|
||||||
|
|
||||||
-- CompleteCardNo = xxxxxxxx.y
|
-- CompleteCardNo = xxxxxxxx.y
|
||||||
-- where x is an 8 digit AvsCardNo prefixed by zeros
|
-- where x is an 8 digit AvsCardNo prefixed by zeros, see normalizeAvsCardNo
|
||||||
-- and y is the 1 digit AvsVersionNo
|
-- 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
|
newtype AvsCardNo = AvsCardNo { avsCardNo :: Text } -- always 8 digits
|
||||||
@ -92,9 +92,11 @@ newtype AvsCardNo = AvsCardNo { avsCardNo :: Text } -- always 8 digits
|
|||||||
instance E.SqlString AvsCardNo
|
instance E.SqlString AvsCardNo
|
||||||
-- AvsCardNo is an untagged Text with respect to FromJSON/ToJSON, as needed by AVS API
|
-- AvsCardNo is an untagged Text with respect to FromJSON/ToJSON, as needed by AVS API
|
||||||
instance FromJSON AvsCardNo where
|
instance FromJSON AvsCardNo where
|
||||||
parseJSON x = AvsCardNo . Text.justifyRight 8 '0' <$> parseJSON x
|
parseJSON x = AvsCardNo . normalizeAvsCardNo <$> parseJSON x
|
||||||
instance ToJSON AvsCardNo where
|
instance ToJSON AvsCardNo where
|
||||||
toJSON (AvsCardNo cno) = toJSON cno
|
toJSON (AvsCardNo cno) = toJSON $ normalizeAvsCardNo cno
|
||||||
|
normalizeAvsCardNo :: Text -> Text
|
||||||
|
normalizeAvsCardNo = Text.justifyRight 8 '0'
|
||||||
|
|
||||||
-- The AVS API requires PersonIds sometimes as as mere numbers `AvsPersonId` and sometimes as tagged objects `AvsObjPersonId`
|
-- The AVS API requires PersonIds sometimes as as mere numbers `AvsPersonId` and sometimes as tagged objects `AvsObjPersonId`
|
||||||
newtype AvsPersonId = AvsPersonId { avsPersonId :: Int } -- untagged Int
|
newtype AvsPersonId = AvsPersonId { avsPersonId :: Int } -- untagged Int
|
||||||
|
|||||||
@ -16,8 +16,8 @@ instance Arbitrary AvsPersonId where
|
|||||||
shrink (AvsPersonId x) = AvsPersonId <$> shrink x
|
shrink (AvsPersonId x) = AvsPersonId <$> shrink x
|
||||||
|
|
||||||
instance Arbitrary AvsCardNo where
|
instance Arbitrary AvsCardNo where
|
||||||
arbitrary = AvsCardNo <$> arbitrary
|
arbitrary = AvsCardNo . normalizeAvsCardNo <$> arbitrary
|
||||||
shrink (AvsCardNo x) = AvsCardNo <$> shrink x
|
shrink (AvsCardNo x) = AvsCardNo . normalizeAvsCardNo <$> shrink x
|
||||||
|
|
||||||
instance Arbitrary AvsLicence where
|
instance Arbitrary AvsLicence where
|
||||||
arbitrary = genericArbitrary
|
arbitrary = genericArbitrary
|
||||||
|
|||||||
Reference in New Issue
Block a user