Browse Source

Search Customer (#9)

- implemented urlschema
- implemented request record
- implenented search customer api
- test implemented for search customer
pull/10/head
piq9117 1 year ago
committed by Gitea
parent
commit
fa1ecfa888
6 changed files with 130 additions and 18 deletions
  1. +2
    -0
      hs-square.cabal
  2. +4
    -3
      shell.nix
  3. +9
    -4
      src/Square.hs
  4. +70
    -1
      src/Square/Request/Customer.hs
  5. +6
    -4
      src/Square/UrlSchema.hs
  6. +39
    -6
      test/CustomerSpec.hs

+ 2
- 0
hs-square.cabal View File

@@ -42,6 +42,7 @@ library
, aeson
, casing
, exceptions
, time
hs-source-dirs: src
default-language: Haskell2010
default-extensions: NoImplicitPrelude
@@ -65,6 +66,7 @@ test-suite unit
, microlens
, uuid
, aeson
, time
default-language: Haskell2010
default-extensions: NoImplicitPrelude
, OverloadedStrings


+ 4
- 3
shell.nix View File

@@ -6,7 +6,7 @@ let

f = { mkDerivation, aeson, base, bytestring, casing, exceptions
, hspec, hspec-discover, http-conduit, http-types, HUnit, microlens
, microlens-th, mtl, relude, stdenv, text, transformers, uuid
, microlens-th, mtl, relude, stdenv, text, time, transformers, uuid
}:
mkDerivation {
pname = "hs-square";
@@ -14,10 +14,11 @@ let
src = ./.;
libraryHaskellDepends = [
aeson base bytestring casing exceptions http-conduit http-types
microlens microlens-th mtl relude text transformers
microlens microlens-th mtl relude text time transformers
];
testHaskellDepends = [
aeson base hspec hspec-discover HUnit microlens relude text uuid
aeson base hspec hspec-discover HUnit microlens relude text time
uuid
];
testToolDepends = [ hspec-discover ];
license = stdenv.lib.licenses.asl20;


+ 9
- 4
src/Square.hs View File

@@ -13,6 +13,7 @@ module Square

import Import
-- control
import Control.Monad.Catch
import Control.Monad.Except
-- text
import qualified Data.Text as T
@@ -30,20 +31,24 @@ import Square.Request

data Error
= ParserError Text
| HTTPError HttpException
deriving ( Show )

instance Exception Error

runSquare
:: ( MonadIO m, MonadError Error m, FromJSON a, ToRequest req )
:: ( MonadCatch m, MonadIO m, MonadError Error m, FromJSON a, ToRequest req )
=> req
-> SquareEnv
-> m a
runSquare req env = do
manager <- newManager
res <- httpLbs
( toRequest ( env ^. squareEnvRootUrl ) ( env ^. squareEnvAccessToken ) req )
manager
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

onHttpException :: MonadError Error m => HttpException -> m a
onHttpException = throwError . HTTPError

+ 70
- 1
src/Square/Request/Customer.hs View File

@@ -19,6 +19,8 @@ import Square.Internal.Request
import Square.Lens.UrlSchema
import Square.Request
import Square.UrlSchema
-- time
import Data.Time.Clock

data CreateCustomerReq = CreateCustomerReq
{ _createCustomerReqIdempotencyKey :: Maybe Text
@@ -119,12 +121,79 @@ data DeleteCustomer = DeleteCustomer
instance ToRequest DeleteCustomer where
toRequest rootUrl accessToken DeleteCustomer{..} =
buildRequest
( addParam ( urlSchema rootUrl ^. urlSchemaDeleteCustomer ) _deleteCustomerId )
( addUrlParam ( urlSchema rootUrl ^. urlSchemaDeleteCustomer ) _deleteCustomerId )
accessToken
DELETE
Nothing
Nothing

data SearchCustomerReq = SearchCustomerReq
{ _searchCustomerReqQuery :: SearchCustomerQueryBody
} deriving ( Eq, Show )

data SearchCustomerQueryBody = SearchCustomerQueryBody
{ _searchCustomerQueryBodyFilter :: SearchCustomerFilter
, _searchCustomerQueryBodySort :: SearchCustomerSort
, _searchCustomerQueryBodyLimit :: Int
} deriving ( Eq, Show )

data SearchCustomerFilter = SearchCustomerFilter
{ _searchCustomerFilterCreatedAt :: TimeRange
, _searchCustomerFilterUpdatedAt :: Maybe TimeRange
, _searchCustomerFilterCreationSource :: CustomerCreationSourceFilter
} deriving ( Eq, Show )

data TimeRange = TimeRange
{ _timeRangeEndAt :: UTCTime
, _timeRangeStartAt :: UTCTime
} deriving ( Eq, Show )

data SearchCustomerSort = SearchCustomerSort
{ _searchCustomerSortField :: Text
, _searchCustomerSortOrder :: Text
} deriving ( Eq, Show )

data CustomerCreationSourceFilter = CustomerCreationSourceFilter
{ _customerCreationSourceFilterRule :: Text
, _customerCreationSourceFilterValues :: [ Text ]
} deriving ( Eq, Show )

instance ToRequest SearchCustomerReq where
toRequest rootUrl accessToken scr = buildRequest
( urlSchema rootUrl ^. urlSchemaSearchCustomer )
accessToken
POST
Nothing
( Just $ toJSON scr )

---
-- json derivation
---

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

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

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

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

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

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

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


+ 6
- 4
src/Square/UrlSchema.hs View File

@@ -4,7 +4,7 @@ module Square.UrlSchema
, UrlSchema
, urlSchema
, endpointToText
, addParam
, addUrlParam
) where

import Import
@@ -14,13 +14,14 @@ data UrlSchema = UrlSchema
{ _urlSchemaCreateCustomer :: SquareEndpoint
, _urlSchemaGetCustomers :: SquareEndpoint
, _urlSchemaDeleteCustomer :: SquareEndpoint
, _urlSchemaSearchCustomer :: SquareEndpoint
} deriving ( Eq, Show )

newtype SquareEndpoint = SquareEndpoint Text
deriving ( Eq, Show, Generic )
deriving ( Eq, Show )

addParam :: SquareEndpoint -> Text -> SquareEndpoint
addParam ( SquareEndpoint ep ) param = SquareEndpoint $ ep <> param
addUrlParam :: SquareEndpoint -> Text -> SquareEndpoint
addUrlParam ( SquareEndpoint ep ) param = SquareEndpoint $ ep <> param

endpointToText :: SquareEndpoint -> Text
endpointToText = coerce
@@ -30,4 +31,5 @@ urlSchema rootUrl = UrlSchema
{ _urlSchemaCreateCustomer = SquareEndpoint $ rootUrlToText rootUrl <> "/v2/customers"
, _urlSchemaGetCustomers = SquareEndpoint $ rootUrlToText rootUrl <> "/v2/customers"
, _urlSchemaDeleteCustomer = SquareEndpoint $ rootUrlToText rootUrl <> "/v2/customers/"
, _urlSchemaSearchCustomer = SquareEndpoint $ rootUrlToText rootUrl <> "/v2/customers/search"
}

+ 39
- 6
test/CustomerSpec.hs View File

@@ -11,6 +11,8 @@ import Data.UUID.V4 as UUID
import Square.Lens.Customer
import Square.Request.Customer
import Square.Response.Customer
-- time
import Data.Time.Clock

spec :: Spec
spec = do
@@ -21,12 +23,12 @@ spec = do
let
request = defaultCustomerReq
& createCustomerReqBirthday .~ Just "1998-09-01T00:00:00-00:00"
& createCustomerReqCompanyName .~ Just "asdf"
& createCustomerReqEmailAddress .~ Just "test@email.com"
& createCustomerReqFamilyName .~ Just "asdf"
& createCustomerReqGivenName .~ Just "asdf"
& createCustomerReqCompanyName .~ Just "company1"
& createCustomerReqEmailAddress .~ Just "customer1@email.com"
& createCustomerReqFamilyName .~ Just "customer1"
& createCustomerReqGivenName .~ Just "customer1"
& createCustomerReqIdempotencyKey .~ Just uuid
& createCustomerReqNickName .~ Just "asdf"
& createCustomerReqNickName .~ Just "customer1"
& createCustomerReqNote .~ Just "asdf"
& createCustomerReqPhoneNumber .~ Just "123-123-1234"

@@ -44,7 +46,38 @@ spec = do
& getCustomerQuerySortOrder .~ Just SortOrderAsc
( res :: Either Error GetCustomerRes ) <- runExceptT $ runSquare request squareEnv
let result = concat $ join $ res ^? _Right . getCustomerResCustomers
assertEqual "" ( length result ) 1
assertEqual "" ( length result > 0 ) True

it "will search for customers" $ do
token <- accessToken
now <- getCurrentTime
let
tmr = addUTCTime nominalDay now
yesterday = addUTCTime ( -nominalDay ) now
request = SearchCustomerReq
{ _searchCustomerReqQuery = SearchCustomerQueryBody
{ _searchCustomerQueryBodyFilter = SearchCustomerFilter
{ _searchCustomerFilterCreatedAt = TimeRange
{ _timeRangeStartAt = yesterday
, _timeRangeEndAt = tmr
}
, _searchCustomerFilterUpdatedAt = Nothing
, _searchCustomerFilterCreationSource = CustomerCreationSourceFilter
{ _customerCreationSourceFilterRule = "INCLUDE"
, _customerCreationSourceFilterValues = [ "THIRD_PARTY" ]
}
}
, _searchCustomerQueryBodySort = SearchCustomerSort
{ _searchCustomerSortField = "CREATED_AT"
, _searchCustomerSortOrder = "ASC"
}
, _searchCustomerQueryBodyLimit = 1
}
}
squareEnv = defaultEnv & squareEnvAccessToken .~ token
( res :: Either Error GetCustomerRes ) <- runExceptT $ runSquare request squareEnv
let result = res ^? _Right . getCustomerResCustomers
assertEqual "" ( length result > 0 ) True

it "delete a customer by id" $ do
token <- accessToken


Loading…
Cancel
Save