card nonce generation (#14)

- created card nonce generation
- enabled card creation test

hs-square.cabal

@@ -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

src/Square.hs

@@ -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

src/Square/Internal/CardNonce.hs

@@ -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)

src/Square/Internal/UrlSchema.hs

@@ -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"

test/CustomerSpec.hs

@@ -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 "" )

test/TestImport.hs

@@ -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 )