@@ -1,9 +1,10 @@
11{-# LANGUAGE CPP #-}
2−{-# LANGUAGE DerivingStrategies #-}
32{-# LANGUAGE OverloadedStrings #-}
43{-# LANGUAGE StandaloneDeriving #-}
54{-# LANGUAGE DerivingVia #-}
65{-# LANGUAGE TemplateHaskell #-}
6+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
7+{-# HLINT ignore "Use ||" #-}
78
89module Data.CreditCard
910 ( -- * Types
@@ -53,7 +54,7 @@ module Data.CreditCard
5354
5455import Control.Lens hiding (elements)
5556
56−import Control.Monad (guard, (<=<))
57+import Control.Monad (guard, (<=<), replicateM)
5758import Data.Aeson as Aeson
5859import Data.Aeson.Inflections (defaultFieldLabelModifier)
5960import Data.Binary (Binary)
@@ -65,21 +66,20 @@ import Data.Ix
6566import Data.List as L
6667import Data.List.NonEmpty (NonEmpty)
6768import qualified Data.List.NonEmpty as NE
68−import Data.OpenApi as OpenApi
69− ( ToSchema(..), SchemaOptions(..), defaultSchemaOptions
70− , genericDeclareNamedSchema)
71−import Data.Proxy
7269import Data.Semigroup
7370import Data.Text (Text)
7471import qualified Data.Text as T
7572import Data.Time
76−#ifndef ghcjs_HOST_OS
73+#ifdef BACKEND
74+import Data.Proxy
75+import Data.OpenApi as OpenApi
76+ ( ToSchema(..), SchemaOptions(..), defaultSchemaOptions
77+ , genericDeclareNamedSchema)
7778#ifdef USE_POSTGRES
7879import Database.PostgreSQL.Simple.FromField
7980import Database.PostgreSQL.Simple.ToField
8081#endif
8182#endif
82−import Formatting as F
8383import GHC.Generics (Generic)
8484import Numeric.Natural
8585import Test.QuickCheck.Arbitrary
@@ -93,7 +93,11 @@ import qualified Data.Store.Internal
9393newtype ZipCode = ZipCode
9494 { unZipCode :: Text }
9595 deriving stock (Show, Eq, Generic)
96+#ifdef BACKEND
9697 deriving newtype (ToJSON, FromJSON, ToSchema)
98+#else
99+ deriving newtype (ToJSON, FromJSON)
100+#endif
97101#ifdef USE_STORE
98102 deriving anyclass Data.Store.Store
99103#endif
@@ -110,17 +114,12 @@ data CreditCardDate = CreditCardDate
110114 deriving anyclass Data.Store.Store
111115#endif
112116
113−instance ToSchema CreditCardDate where
114− declareNamedSchema _ = declareNamedSchema (Proxy @Text)
115−
116117makeLenses ''CreditCardDate
117118
118119formatExpiryDate :: CreditCardDate -> Text
119−formatExpiryDate ccd =
120− F.sformat
121− (F.left 2 '0' F.% F.left 2 '0')
122− (F.sformat F.int $ ccd ^. ccdMonth)
123− (F.sformat F.int $ ccd ^. ccdYear - 2000)
120+formatExpiryDate ccd = s2 (ccd ^. ccdMonth) <> s2 (ccd ^. ccdYear - 2000)
121+ where
122+ s2 = T.justifyRight 2 '0' . T.pack . show
124123
125124-- NOTE: This function is supposed to be called 'parseExpiryDate',
126125-- but we already have a function with the same name in b2b/api
@@ -168,10 +167,6 @@ newtype CreditCardNumber = CreditCardNumber
168167 { unCreditCardNumber :: NonEmpty Digit }
169168 deriving (Eq, Generic)
170169
171−
172−instance ToSchema CreditCardNumber where
173− declareNamedSchema _ = declareNamedSchema (Proxy @Text)
174−
175170makePrisms ''CreditCardNumber
176171
177172renderCardNumber :: CreditCardNumber -> Text
@@ -242,14 +237,18 @@ mkCreditCardPan n = CreditCardPAN $ firstDigits <> stars <> lastDigits
242237newtype CreditCardSecurity = CreditCardSecurity
243238 { unCCSecurity :: Text }
244239 deriving (Eq, Ord, Generic)
240+#ifdef BACKEND
245241 deriving newtype (ToJSON, FromJSON, ToSchema)
242+#else
243+ deriving newtype (ToJSON, FromJSON)
244+#endif
246245#ifdef USE_STORE
247246 deriving anyclass Data.Store.Store
248247#endif
249248
250249instance Arbitrary CreditCardSecurity where
251250 arbitrary = CreditCardSecurity . T.pack . concatMap (show :: Int -> String)
252− <$> sequence (replicate 3 (choose (0, 9)))
251+ <$> replicateM 3 (choose (0, 9))
253252
254253-- | Show instance for 'CreditCardSecurity' doesn't actually show
255254-- anything. It replaces all characters with '*'.
@@ -265,27 +264,19 @@ parseCreditCardSecurity txt
265264 | isValid = pure $ CreditCardSecurity txt
266265 | otherwise = Nothing
267266 where
268− isValid = and
269− [ (3, 4) `inRange` T.length txt
270− , T.all isDigit txt ]
267+ isValid = (3, 4) `inRange` T.length txt && T.all isDigit txt
271268
272269data CreditCard = CreditCard
273− { _ccNumber :: !(CreditCardNumber)
274− , _ccHolderName :: !(Text)
270+ { _ccNumber :: !CreditCardNumber
271+ , _ccHolderName :: !Text
275272 , _ccSecurity :: !(Maybe CreditCardSecurity)
276− , _ccExpirationDate :: !(CreditCardDate)
273+ , _ccExpirationDate :: !CreditCardDate
277274 , _ccZipCode :: !(Maybe ZipCode)
278275 } deriving (Eq, Generic, Show)
279276#ifdef USE_STORE
280277 deriving anyclass Data.Store.Store
281278#endif
282279
283−instance ToSchema CreditCard where
284− declareNamedSchema p = genericDeclareNamedSchema opts p
285− where
286− opts = defaultSchemaOptions
287− { OpenApi.fieldLabelModifier = defaultFieldLabelModifier }
288−
289280instance FromJSON CreditCard where
290281 parseJSON =
291282 genericParseJSON defaultOptions
@@ -322,9 +313,6 @@ makePrisms ''CreditCardType
322313instance Arbitrary CreditCardType where
323314 arbitrary = elements [minBound..maxBound]
324315
325−instance ToSchema CreditCardType where
326− declareNamedSchema p = genericDeclareNamedSchema defaultSchemaOptions p
327−
328316instance FromJSON CreditCardType where
329317 parseJSON =
330318 genericParseJSON defaultOptions
@@ -347,8 +335,8 @@ getDigits = F.toList . fmap digitToNum . unDigits . natToDigits
347335getLuhnDigit :: [Digit] -> Digit
348336getLuhnDigit n = digitFromNumMod10 (total * 9)
349337 where
350− total = sum $ L.map multEven $ L.zip [0..] $ L.reverse n
351− multEven (i :: Int, digitToNum -> a)
338+ total = sum $ L.zipWith multEven [0..] $ L.reverse n
339+ multEven (i :: Int) (digitToNum -> a)
352340 | even i = sum $ getDigits (a * 2)
353341 | otherwise = a
354342
@@ -370,32 +358,37 @@ guessCreditCardType n
370358 | otherwise = Nothing
371359 where
372360 isVisa = (4 == firstDigits 1) && (digitsLength `elem` [13,16,19])
373− isMasterCard = (inRange (51, 55) (firstDigits 2)) && (digitsLength == 16)
361+ isMasterCard = or
362+ [ inRange (51, 55) (firstDigits 2) && (digitsLength == 16)
363+ , inRange (2221, 2720) (firstDigits 4) && (digitsLength == 16)]
374364 isAmEx = (firstDigits 2 `elem` [34, 37]) && (digitsLength == 15)
375− isUnionPay = (firstDigits 2 `elem` [62]) && (digitsLength `elem` [16,17,18,19])
376− isDiscoverCard =
377− (firstDigits 4 == 6011 || inRange (644, 649) (firstDigits 3)
378− || inRange (622126, 622925) (firstDigits 6) || firstDigits 2 == 65)
365+ isUnionPay = (firstDigits 2 == 62) && (digitsLength `elem` [16,17,18,19])
366+ isDiscoverCard = or
367+ [ firstDigits 4 == 6011
368+ , inRange (644, 649) (firstDigits 3)
369+ , inRange (622126, 622925) (firstDigits 6)
370+ , firstDigits 2 == 65]
379371 && (digitsLength `elem` [16, 19])
380− isDinersClub =
381− ((inRange (300, 305) (firstDigits 3) || firstDigits 3 == 309
382− || firstDigits 2 == 36 || inRange (38, 39) (firstDigits 2))
383− && digitsLength == 14)
384− || (firstDigits 2 `elem` [54, 55] && digitsLength == 16)
385− isJCB =
386− (inRange (3528, 3589) (firstDigits 4) && digitsLength `elem` [15, 16])
387− || (firstDigits 4 `elem` [1800, 2131] && digitsLength == 15)
388− || (firstDigits 6 == 357266 && digitsLength == 19)
372+ isDinersClub = or
373+ [ inRange (300, 305) (firstDigits 3) && digitsLength == 14
374+ , firstDigits 3 == 309 && digitsLength == 14
375+ , firstDigits 2 == 36 && digitsLength == 14
376+ , inRange (38, 39) (firstDigits 2) && digitsLength == 14
377+ , firstDigits 2 `elem` [54, 55] && digitsLength == 16]
378+ isJCB = or
379+ [ inRange (3528, 3589) (firstDigits 4) && digitsLength `elem` [15, 16]
380+ , firstDigits 4 `elem` [1800, 2131] && digitsLength == 15
381+ , firstDigits 6 == 357266 && digitsLength == 19]
389382 digitsLength = L.length $ n ^. _CreditCardNumber
390383 firstDigits x = poly10 @Integer $ L.take x
391384 $ n ^.. _CreditCardNumber . folded . to digitToNum
392385
393386creditCardType :: CreditCardNumber -> Either CreditCardError CreditCardType
394−creditCardType n = case checkLuhnDigit n of
395− True -> case guessCreditCardType n of
387+creditCardType n
388+ | checkLuhnDigit n = case guessCreditCardType n of
396389 Nothing -> Left UnknownCardNumber
397390 Just t -> Right t
398− False -> Left InvalidCardNumber
391+ | otherwise = Left InvalidCardNumber
399392
400393isValidCCNumber :: CreditCardNumber -> Bool
401394isValidCCNumber = isRight . creditCardType
@@ -403,7 +396,7 @@ isValidCCNumber = isRight . creditCardType
403396guessPANCardType :: CreditCardPAN -> Maybe CreditCardType
404397guessPANCardType = guessCreditCardType <=< panToBogusNumber
405398
406−#ifndef ghcjs_HOST_OS
399+#ifdef BACKEND
407400#ifdef USE_POSTGRES
408401deriving instance FromField CreditCardPAN
409402deriving instance ToField CreditCardPAN
@@ -431,3 +424,20 @@ instance FromField CreditCardType where
431424 _ -> returnError ConversionFailed f ("Invalid credit card type: " ++ T.unpack txt)
432425#endif
433426#endif
427+
428+#ifdef BACKEND
429+instance ToSchema CreditCardDate where
430+ declareNamedSchema _ = declareNamedSchema (Proxy @Text)
431+
432+instance ToSchema CreditCardNumber where
433+ declareNamedSchema _ = declareNamedSchema (Proxy @Text)
434+
435+instance ToSchema CreditCard where
436+ declareNamedSchema = genericDeclareNamedSchema opts
437+ where
438+ opts = defaultSchemaOptions
439+ { OpenApi.fieldLabelModifier = defaultFieldLabelModifier }
440+
441+instance ToSchema CreditCardType where
442+ declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
443+#endif