@@ -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
@@ -374,7 +362,7 @@ guessCreditCardType n
374362 [ inRange (51, 55) (firstDigits 2) && (digitsLength == 16)
375363 , inRange (2221, 2720) (firstDigits 4) && (digitsLength == 16)]
376364 isAmEx = (firstDigits 2 `elem` [34, 37]) && (digitsLength == 15)
377− isUnionPay = (firstDigits 2 `elem` [62]) && (digitsLength `elem` [16,17,18,19])
365+ isUnionPay = (firstDigits 2 == 62) && (digitsLength `elem` [16,17,18,19])
378366 isDiscoverCard = or
379367 [ firstDigits 4 == 6011
380368 , inRange (644, 649) (firstDigits 3)
@@ -396,11 +384,11 @@ guessCreditCardType n
396384 $ n ^.. _CreditCardNumber . folded . to digitToNum
397385
398386creditCardType :: CreditCardNumber -> Either CreditCardError CreditCardType
399−creditCardType n = case checkLuhnDigit n of
400− True -> case guessCreditCardType n of
387+creditCardType n
388+ | checkLuhnDigit n = case guessCreditCardType n of
401389 Nothing -> Left UnknownCardNumber
402390 Just t -> Right t
403− False -> Left InvalidCardNumber
391+ | otherwise = Left InvalidCardNumber
404392
405393isValidCCNumber :: CreditCardNumber -> Bool
406394isValidCCNumber = isRight . creditCardType
@@ -408,7 +396,7 @@ isValidCCNumber = isRight . creditCardType
408396guessPANCardType :: CreditCardPAN -> Maybe CreditCardType
409397guessPANCardType = guessCreditCardType <=< panToBogusNumber
410398
411−#ifndef ghcjs_HOST_OS
399+#ifdef BACKEND
412400#ifdef USE_POSTGRES
413401deriving instance FromField CreditCardPAN
414402deriving instance ToField CreditCardPAN
@@ -436,3 +424,20 @@ instance FromField CreditCardType where
436424 _ -> returnError ConversionFailed f ("Invalid credit card type: " ++ T.unpack txt)
437425#endif
438426#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