Browse Source

card nonce generation (#14)

- created card nonce generation
- enabled card creation test
pull/15/head
piq9117 2 years ago
committed by Gitea
parent
commit
df7e076fb6
6 changed files with 146 additions and 8 deletions
  1. +1
    -0
      hs-square.cabal
  2. +1
    -0
      src/Square.hs
  3. +104
    -0
      src/Square/Internal/CardNonce.hs
  4. +4
    -0
      src/Square/Internal/UrlSchema.hs
  5. +21
    -8
      test/CustomerSpec.hs
  6. +15
    -0
      test/TestImport.hs

+ 1
- 0
hs-square.cabal View File

@@ -26,6 +26,7 @@ library
, Square.Lens.UrlSchema
, Square.Lens.Customer
, Square.Lens.Env
, Square.Internal.CardNonce
other-modules: Import
, Square.Internal.Request
, Square.Internal.UrlSchema


+ 1
- 0
src/Square.hs View File

@@ -45,6 +45,7 @@ runSquare req env = do
manager <- newManager
let request = ( toRequest ( env ^. squareEnvRootUrl ) ( env ^. squareEnvAccessToken ) req )
res <- httpLbs request manager `catch` onHttpException
print res
case eitherDecode $ responseBody res of
Left err -> throwError . ParserError . T.pack $ err
Right response -> pure response


+ 104
- 0
src/Square/Internal/CardNonce.hs View File

@@ -0,0 +1,104 @@
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
module Square.Internal.CardNonce where

import Import
-- lens
import Lens.Micro.TH
-- json
import Data.Aeson
import Data.Aeson.TH
-- text
import qualified Data.Char as C
import Text.Casing (snake)
-- http
import Network.HTTP.Types
-- square
import Square.Internal.Request
import Square.Internal.UrlSchema
import Square.Request

data CardNonceReq = CardNonceReq
{ _cardNonceReqClientId :: Text
, _cardNonceReqAnalyticsToken :: Text
, _cardNonceReqSessionId :: Text
, _cardNonceReqSquarejsVersion :: Text
, _cardNonceReqWebsiteUrl :: Text
, _cardNonceReqVersion :: Maybe Text
, _cardNonceReq_ :: Maybe Text
, _cardNonceReqCardData :: CardData
} deriving ( Eq, Show )

data CardNonceRes = CardNonceRes
{ _CardNonceResCardNonce :: Text
} deriving ( Eq, Show )

data CardData = CardData
{ _cardDataNumber :: Text
, _cardDataBillingPostalCode :: Text
, _cardDataCvv :: Text
, _cardDataExpMonth :: Int
, _cardDataExpYear :: Int
} deriving ( Eq, Show )

makeLenses ''CardNonceReq
makeLenses ''CardNonceRes

instance ToRequest CardNonceReq where
toRequest _ accessToken cnr = buildRequest
urlSchemaCardNonce
accessToken
POST
( Just $ buildQuery cnr )
( Just $ toJSON $ cleanRequest cnr )

where
buildQuery :: CardNonceReq -> Query
buildQuery CardNonceReq {..} =
withDefaultQuery ( mUnderscoreQuery _cardNonceReq_ )
<> withDefaultQuery ( mVersion _cardNonceReqVersion )

mUnderscoreQuery :: Maybe Text -> Maybe Query
mUnderscoreQuery = fmap ( mkQuery "card-nonce" )

mVersion :: Maybe Text -> Maybe Query
mVersion = fmap ( mkQuery "version" )

cleanRequest :: CardNonceReq -> CardNonceReq
cleanRequest cn = cn
{ _cardNonceReqVersion = Nothing
, _cardNonceReq_ = Nothing
}

defaultCardNonceReq :: CardNonceReq
defaultCardNonceReq = CardNonceReq
mempty
mempty
mempty
"337514c2e6"
"http://localhost:3000"
( Just "337514c2e6" )
( Just "1587530846033.7578" )
( CardData
"4111111111111111"
"111111"
"111"
12
2021
)

$(deriveJSON
defaultOptions
{ fieldLabelModifier = fmap C.toLower . snake . drop 13
, omitNothingFields = True
}
''CardNonceReq)

$(deriveJSON
defaultOptions
{ fieldLabelModifier = fmap C.toLower . snake . drop 13 }
''CardNonceRes)

$(deriveJSON
defaultOptions { fieldLabelModifier = fmap C.toLower . snake . drop 9 }
''CardData)

+ 4
- 0
src/Square/Internal/UrlSchema.hs View File

@@ -6,6 +6,7 @@ module Square.Internal.UrlSchema
, endpointToText
, addUrlParam
, addSegment
, urlSchemaCardNonce
) where

import Import
@@ -45,3 +46,6 @@ urlSchema rootUrl = UrlSchema
-- is added in the ToRequest instance
, _urlSchemaCreateCard = SquareEndpoint $ rootUrlToText rootUrl <> "/v2/customers/"
}

urlSchemaCardNonce :: SquareEndpoint
urlSchemaCardNonce = SquareEndpoint $ "https://pci-connect.squareupsandbox.com/v2/card-nonce"

+ 21
- 8
test/CustomerSpec.hs View File

@@ -5,9 +5,10 @@ import TestImport
-- json
import Data.Aeson
-- uuid
import Data.UUID as UUID
import Data.UUID.V4 as UUID
import Data.UUID as UUID
import Data.UUID.V4 as UUID
-- square
import Square.Internal.CardNonce
import Square.Lens.Customer
import Square.Request.Customer
import Square.Response.Customer
@@ -59,12 +60,16 @@ spec = do
squareEnv = defaultEnv & squareEnvAccessToken .~ token
request = defaultGetCustomerQuery
& getCustomerQuerySortOrder .~ Just SortOrderAsc

( res :: Either Error GetCustomerRes ) <- runExceptT $ runSquare request squareEnv
let result = concat $ join $ res ^? _Right . getCustomerResCustomers
assertEqual "" ( length result > 0 ) True
assertEqual "list will not be empty" ( length result > 0 ) True

it "will create a customer card" $ do
token <- accessToken
appId <- applicationId
analToken <- analyticsToken
sessId <- sessionId
let
squareEnv = defaultEnv & squareEnvAccessToken .~ token
request = defaultGetCustomerQuery
@@ -75,12 +80,20 @@ spec = do
$ concat
$ ( customerListResult ^? _Right ^? _Just . getCustomerResCustomers . _Just )
<&> ( <&> ( ^. getCustomerResBodyId ) )
createCardRequest = defaultCreateCustomerReq
& createCustomerCardReqCustomerId .~ ( fromMaybe "" mCustomerId )
& createCustomerCardReqCardNonce .~ ""
& createCustomerCardReqCardholderName .~ "customer1 customer1"
& createCustomerCardReqBillingAddress . customerAddressPostalCode .~ Just "111111"
cardNonceRequest = defaultCardNonceReq
& cardNonceReqClientId .~ appId
& cardNonceReqAnalyticsToken .~ analToken
& cardNonceReqSessionId .~ sessId

( cardNonceRes :: Either Error CardNonceRes ) <- runExceptT $ runSquare cardNonceRequest squareEnv
let cardNonceResult = cardNonceRes ^? _Right . cardNonceResCardNonce
assertNotEqual "card_nonce is not empty" cardNonceResult ( Just "" )
let createCardRequest = defaultCreateCustomerReq
& createCustomerCardReqCustomerId .~ ( fromMaybe "" mCustomerId )
& createCustomerCardReqCardNonce .~ ( fromMaybe "" cardNonceResult )
& createCustomerCardReqCardholderName .~ "customer1 customer1"
& createCustomerCardReqBillingAddress . customerAddressPostalCode .~ Just "111111"
( res :: Either Error CreateCardRes ) <- runExceptT $ runSquare createCardRequest squareEnv
let result = ( res ^? _Right . createCardResCard & join ) <&> ( ^. createCardResBodyId ) & join
assertNotEqual "" result ( Just "" )


+ 15
- 0
test/TestImport.hs View File

@@ -2,6 +2,9 @@ module TestImport
( module X
, accessToken
, assertNotEqual
, applicationId
, analyticsToken
, sessionId
) where

import qualified Data.Text as T
@@ -19,6 +22,18 @@ accessToken :: IO AccessToken
accessToken = do
mkAccessToken . T.pack <$> getEnv "SANDBOX_ACCESS_TOKEN"

applicationId :: IO Text
applicationId = do
T.pack <$> getEnv "APPLICATION_ID"

sessionId :: IO Text
sessionId = do
T.pack <$> getEnv "SESSION_ID"

analyticsToken :: IO Text
analyticsToken = do
T.pack <$> getEnv "ANALYTICS_TOKEN"

assertNotEqual :: ( Show a, Eq a ) => String -> a -> a -> IO ()
assertNotEqual preface expected actual =
unless ( actual /= expected ) ( assertFailure msg )


Loading…
Cancel
Save