diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,22 @@ + +The MIT License (MIT) + +Copyright (c) 2022 Dylan Martin + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +THE SOFTWARE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ +import Distribution.Simple + +main = defaultMain diff --git a/circle.cabal b/circle.cabal new file mode 100644 --- /dev/null +++ b/circle.cabal @@ -0,0 +1,67 @@ +name: circle +version: 0.1.0.0 +synopsis: Circle API client for Haskell +description: For usage information please consult README.md +homepage: https://github.com/dmarticus/circle#readme +license: MIT +license-file: LICENSE +author: Dylan Martin +maintainer: dmarticus@gmail.com +copyright: 2022 Dylan Martin +category: Web +build-type: Simple +cabal-version: >=1.10 + +library + hs-source-dirs: src + exposed-modules: + Circle + Circle.Client + Circle.Types + + build-depends: + aeson >=0.11.1 && <1.6 + , autodocodec >=0.2.0 && <0.3 + , base >=4.7 && <5 + , bytestring >=0.10.0 && <0.11 + , case-insensitive >=1.2.1 && <1.3 + , containers >=0.6.5 && <0.7 + , country >=0.2.1 && <0.3 + , http-client >=0.7.6 && <0.7.9 + , http-client-tls >=0.3 && <0.3.6 + , http-types >=0.8 && <0.13 + , pcre-heavy >=1.0.0 && <1.1 + , refined >=0.6 && <0.9 + , template-haskell >=2.16.0 && <2.17 + , text >=0.11 && <1.3 + , time >=1.4 && <1.11 + , unordered-containers >=0.2.5 && <0.3 + , uuid >=1.3.15 && <1.4 + , vector >=0.10.9 && <0.13 + + default-language: Haskell2010 + ghc-options: -Wall -fwarn-unused-binds -fwarn-unused-imports + +test-suite test + ghc-options: -Wall -fwarn-unused-binds -fwarn-unused-imports + type: exitcode-stdio-1.0 + main-is: Tests.hs + hs-source-dirs: test + build-depends: + base >=4.7 && <5 + , circle + , hspec >=1.8 && <2.8 + , hspec-expectations >=0.8.2 && <0.9 + , http-client >=0.7.6 && <0.7.9 + , http-client-tls >=0.3 && <0.3.6 + , random >=1.2.0 && <1.3 + , safe >=0.3 && <0.4 + , text >=0.11 && <1.3 + , time >=1.9.3 && <1.10 + , uuid >=1.3.15 && <1.4 + + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/dmarticus/circle diff --git a/src/Circle.hs b/src/Circle.hs new file mode 100644 --- /dev/null +++ b/src/Circle.hs @@ -0,0 +1,34 @@ +------------------------------------------- + +-- | +-- Module : Circle +-- Copyright : (c) Dylan Martin, 2022 +-- Maintainer : dmarticus@gmail.com +-- Stability : experimental +-- Portability : POSIX +-- +-- < https:/\/\developers.circle.com/developer/v1/docs > +-- +-- @ +-- import Circle.Client +-- import Circle.Types +-- import Network.HTTP.Client (newManager) +-- import Network.HTTP.Client.TLS (tlsManagerSettings) +-- +-- main :: IO () +-- main = do +-- manager <- newManager tlsManagerSettings +-- config <- sandboxEnvConfig \"CIRCLE_API_KEY\" +-- result <- circle config manager getConfigurationInfo +-- case result of +-- Right CircleResponseBody b -> print bs +-- Left CircleError e -> print e +-- @ +module Circle + ( module Circle.Client, + module Circle.Types, + ) +where + +import Circle.Client +import Circle.Types diff --git a/src/Circle/Client.hs b/src/Circle/Client.hs new file mode 100644 --- /dev/null +++ b/src/Circle/Client.hs @@ -0,0 +1,1000 @@ +------------------------------------------- +------------------------------------------- +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +-- | +-- Module : Circle.Client +-- Copyright : (c) Dylan Martin, 2022 +-- Maintainer : dmarticus@gmail.com +-- Stability : experimental +-- Portability : POSIX +-- +-- < https:/\/\developers.circle.com/developer/v1/docs > +module Circle.Client where + +import Circle.Types +import Data.Aeson (eitherDecode, encode) +import Data.Aeson.Types (FromJSON) +import qualified Data.ByteString.Char8 as BS8 +import qualified Data.ByteString.Lazy.Char8 as BSL +import Data.Maybe (fromJust, isNothing) +import qualified Data.Text as T +import Data.UUID +import qualified Data.UUID as UUID +import Network.HTTP.Client + ( Manager, + Request (method, queryString, requestBody), + RequestBody (RequestBodyLBS), + Response (responseBody), + applyBearerAuth, + httpLbs, + newManager, + parseRequest, + requestHeaders, + ) +import Network.HTTP.Client.TLS (tlsManagerSettings) +import Network.HTTP.Types.Header (hAccept, hContentType) +import qualified Network.HTTP.Types.Method as NHTM + +--------------------------------------------------------------- +-- /businessAccount/banks/wires endpoint +--------------------------------------------------------------- + +-- | Create a business bank account for a wire +-- https://developers.circle.com/reference/createbusinesswireaccount +createBusinessWireAccount :: WireAccountRequestBody -> CircleAPIRequest WireAccountRequest TupleBS8 BSL.ByteString +createBusinessWireAccount wireAccountBody = do + mkCircleAPIRequest NHTM.methodPost url params + where + url = "businessAccount/banks/wires" + params = case wireAccountBody of + USBankAccount usBankAccountBody -> Params (Just $ Body (encode usBankAccountBody)) [] + IBANBankAccount ibanBankAccountBody -> Params (Just $ Body (encode ibanBankAccountBody)) [] + NonIBANBankAccount nonIBANBankAccountBody -> Params (Just $ Body (encode nonIBANBankAccountBody)) [] + +-- | Get a list of business account wire accounts +-- https://developers.circle.com/reference/listbusinesswireaccounts +listBusinessWireAccounts :: CircleAPIRequest WireAccountsRequest TupleBS8 BSL.ByteString +listBusinessWireAccounts = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "businessAccount/banks/wires" + params = Params Nothing [] + +-- | Get a single business account wire account, accepts the wire account Id as a parameter +-- https://developers.circle.com/reference/getbusinesswireaccount +getBusinessWireAccount :: UUID -> CircleAPIRequest WireAccountRequest TupleBS8 BSL.ByteString +getBusinessWireAccount wireAccountId = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "businessAccount/banks/wires/" <> UUID.toText wireAccountId + params = Params Nothing [] + +-- | Get the wire transfer instructions into the Circle business bank account given your bank account id. +-- https://developers.circle.com/reference/getbusinesswireaccountinstructions +getBusinessWireAccountInstructions :: UUID -> CircleAPIRequest WireInstructionsRequest TupleBS8 BSL.ByteString +getBusinessWireAccountInstructions wireAccountId = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "businessAccount/banks/wires/" <> UUID.toText wireAccountId <> "/instructions" + params = Params Nothing [] + +--------------------------------------------------------------- +-- /businessAccount/balances endpoint +--------------------------------------------------------------- + +-- | List all business balances +-- https://developers.circle.com/reference/listbusinesspayouts +listAllBusinessBalances :: CircleAPIRequest BalanceRequest TupleBS8 BSL.ByteString +listAllBusinessBalances = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "businessAccount/balances" + params = Params Nothing [] + +--------------------------------------------------------------- +-- /configuration endpoint +--------------------------------------------------------------- + +-- | Get configuration info +-- https://developers.circle.com/reference/getaccountconfig +getConfigurationInfo :: CircleAPIRequest ConfigurationRequest TupleBS8 BSL.ByteString +getConfigurationInfo = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "configuration" + params = Params Nothing [] + +--------------------------------------------------------------- +-- /encryption/public endpoint +--------------------------------------------------------------- + +-- | Get encryption info +-- https://developers.circle.com/reference/getpublickey +getPublicKey :: CircleAPIRequest EncryptionRequest TupleBS8 BSL.ByteString +getPublicKey = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "encryption/public" + params = Params Nothing [] + +--------------------------------------------------------------- +-- /channels endpoint +--------------------------------------------------------------- + +-- | List all channels +-- https://developers.circle.com/reference/listchannels +listAllChannels :: CircleAPIRequest ChannelsRequest TupleBS8 BSL.ByteString +listAllChannels = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "channels" + params = Params Nothing [] + +--------------------------------------------------------------- +-- /stablecoins endpoint +--------------------------------------------------------------- + +-- | List all stablecoins +-- https://developers.circle.com/reference/listchannels +listAllStablecoins :: CircleAPIRequest StablecoinsRequest TupleBS8 BSL.ByteString +listAllStablecoins = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "stablecoins" + params = Params Nothing [] + +--------------------------------------------------------------- +-- /notifications/subscriptions endpoint +--------------------------------------------------------------- + +-- | List all subscriptions +-- https://developers.circle.com/reference/listsubscriptions +listAllNotificationSubscriptions :: CircleAPIRequest SubscriptionsRequest TupleBS8 BSL.ByteString +listAllNotificationSubscriptions = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "notifications/subscriptions" + params = Params Nothing [] + +-- | Create new subscription +-- https://developers.circle.com/reference/createsubscribtion +createSubscription :: SubscriptionRequestBody -> CircleAPIRequest SubscriptionRequest TupleBS8 BSL.ByteString +createSubscription subscriptionBody = do + mkCircleAPIRequest NHTM.methodPost url params + where + url = "notifications/subscriptions" + params = Params (Just $ Body (encode subscriptionBody)) [] + +-- | Delete subscription +-- https://developers.circle.com/reference/deletesubscribtion +deleteSubscription :: UUID -> CircleAPIRequest SubscriptionsRequest TupleBS8 BSL.ByteString +deleteSubscription resourceId = do + mkCircleAPIRequest NHTM.methodDelete url params + where + url = "notifications/subscriptions" <> UUID.toText resourceId + params = Params Nothing [] + +--------------------------------------------------------------- +-- /businessAccount/payouts endpoint +--------------------------------------------------------------- + +-- | Lists all payouts made from a given business account +-- https://developers.circle.com/reference/listbusinesspayouts +listAllBusinessAccountPayouts :: CircleAPIRequest PayoutsRequest TupleBS8 BSL.ByteString +listAllBusinessAccountPayouts = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "businessAccount/payouts" + params = Params Nothing [] + +-- | Gets a specific payout associated with a business account +-- https://developers.circle.com/reference/getbusinesspayout +getBusinessAccountPayout :: UUID -> CircleAPIRequest PayoutRequest TupleBS8 BSL.ByteString +getBusinessAccountPayout payoutId = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "businessAccount/payouts" <> UUID.toText payoutId + params = Params Nothing [] + +-- | Creates a business account payout +-- https://developers.circle.com/reference/createbusinesspayout +createBusinessAccountPayout :: BusinessPayoutRequestBody -> CircleAPIRequest PayoutRequest TupleBS8 BSL.ByteString +createBusinessAccountPayout payoutBody = do + mkCircleAPIRequest NHTM.methodPost url params + where + url = "businessAccount/payouts" + params = Params (Just $ Body (encode payoutBody)) [] + +--------------------------------------------------------------- +-- /businessAccount/transfers endpoint +--------------------------------------------------------------- + +-- | Searches for transfers from your business account. +-- If the date parameters are omitted, returns the most recent transfers. +-- This endpoint returns up to 50 transfers in descending chronological order or pageSize, if provided. +-- https://developers.circle.com/reference/listbusinesstransfers +listAllBusinessAccountTransfers :: CircleAPIRequest TransfersRequest TupleBS8 BSL.ByteString +listAllBusinessAccountTransfers = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "businessAccount/transfers" + params = Params Nothing [] + +-- | Get a business account transfer based on a transfer ID +-- https://developers.circle.com/reference/getbusinesstransfer +getBusinessAccountTransfer :: UUID -> CircleAPIRequest TransferRequest TupleBS8 BSL.ByteString +getBusinessAccountTransfer transferId = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "businessAccount/transfers/" <> T.pack (show transferId) + params = Params Nothing [] + +-- | Create a new transfer +-- https://developers.circle.com/reference/createbusinesstransfer +createBusinessAccountTransfer :: BusinessTransferRequestBody -> CircleAPIRequest TransferRequest TupleBS8 BSL.ByteString +createBusinessAccountTransfer transferBody = do + mkCircleAPIRequest NHTM.methodPost url params + where + url = "businessAccount/transfers" + params = Params (Just $ Body (encode transferBody)) [] + +--------------------------------------------------------------- +-- /businessAccount/wallets/addresses endpoint +--------------------------------------------------------------- + +-- | List all deposit addresses +-- https://developers.circle.com/developer/v1/reference/getbusinessdepositaddress +listAllBusinessAccountDepositAddresses :: CircleAPIRequest DepositAddressesRequest TupleBS8 BSL.ByteString +listAllBusinessAccountDepositAddresses = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "businessAccount/wallets/addresses/deposit" + params = Params Nothing [] + +-- | Create new business account deposit address +-- Generates a new blockchain address for a wallet for a given currency/chain pair. +-- Circle may reuse addresses on blockchains that support reuse. +-- For example, if you're requesting two addresses for depositing USD and ETH, both on Ethereum, +-- you may see the same Ethereum address returned. +-- Depositing cryptocurrency to a generated address will credit the associated wallet with the value of the deposit. +-- https://developers.circle.com/developer/v1/reference/createbusinessdepositaddress +createBusinessAccountDepositAddress :: DepositAddressRequestBody -> CircleAPIRequest DepositAddressRequest TupleBS8 BSL.ByteString +createBusinessAccountDepositAddress depositAddressBody = do + mkCircleAPIRequest NHTM.methodPost url params + where + url = "businessAccount/wallets/addresses/deposit" + params = Params (Just $ Body (encode depositAddressBody)) [] + +-- | List all recipient addresses +-- Returns a list of recipient addresses that have each been verified and are eligible for transfers. +-- Any recipient addresses pending verification are not included in the response. +-- https://developers.circle.com/developer/v1/reference/listbusinessrecipientaddresses +listAllBusinessAccountRecipientAddresses :: CircleAPIRequest RecipientAddressesRequest TupleBS8 BSL.ByteString +listAllBusinessAccountRecipientAddresses = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "businessAccount/wallets/addresses/recipient" + params = Params Nothing [] + +-- | Create a new recipient address +-- Stores an external blockchain address. Once added, the recipient address must be verified to ensure that you know and trust each new address. +-- https://developers.circle.com/developer/v1/reference/createbusinessrecipientaddress +createBusinessAccountRecipientAddress :: RecipientAddressRequestBody -> CircleAPIRequest RecipientAddressRequest TupleBS8 BSL.ByteString +createBusinessAccountRecipientAddress recipientAddressBody = do + mkCircleAPIRequest NHTM.methodPost url params + where + url = "businessAccount/wallets/addresses/recipient" + params = Params (Just $ Body (encode recipientAddressBody)) [] + +--------------------------------------------------------------- +-- /businessAccount/deposits Endpoint +--------------------------------------------------------------- + +-- | List all deposits +-- Searches for deposits sent to your business account. If the date parameters are omitted, returns the most recent deposits. +-- This endpoint returns up to 50 deposits in descending chronological order or pageSize, if provided. +-- https://developers.circle.com/developer/v1/reference/listbusinessdeposits +listAllBusinessAccountDeposits :: CircleAPIRequest DepositsRequest TupleBS8 BSL.ByteString +listAllBusinessAccountDeposits = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "businessAccount/deposits" + params = Params Nothing [] + +--------------------------------------------------------------- +-- /businessAccount/banks/signet endpoint (Production-Only) +--------------------------------------------------------------- + +-- TODO how to test these if no sandbox instance? + +-- | Create a signet bank account +-- https://developers.circle.com/developer/v1/reference/createbusinesssignetaccount +createSignetBankAccount :: SignetBankAccountRequestBody -> CircleAPIRequest SignetBankAccountRequest TupleBS8 BSL.ByteString +createSignetBankAccount signetBankAccountBody = do + mkCircleAPIRequest NHTM.methodPost url params + where + url = "businessAccount/banks/signet" + params = Params (Just $ Body (encode signetBankAccountBody)) [] + +-- | Get a list of Signet accounts +-- https://developers.circle.com/developer/v1/reference/listbusinesssignetaccounts +listSignetAccounts :: CircleAPIRequest SignetBankAccountsRequest TupleBS8 BSL.ByteString +listSignetAccounts = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "businessAccount/banks/signet" + params = Params Nothing [] + +-- | Get a single Signet bank account, accepts the Signet bank account Id as a parameter +-- https://developers.circle.com/developer/v1/reference/getbusinesssignetaccount +getSignetAccount :: UUID -> CircleAPIRequest SignetBankAccountRequestBody TupleBS8 BSL.ByteString +getSignetAccount signetBankAccountId = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "businessAccount/banks/signet/" <> UUID.toText signetBankAccountId + params = Params Nothing [] + +-- | Get the Signet transfer instructions into the Circle bank account given your bank account id (only available on Production now). +-- https://developers.circle.com/developer/v1/reference/getbusinesssignetaccountinstructions +getSignetAccountInstructions :: UUID -> CircleAPIRequest SignetBankInstructionsResponseData TupleBS8 BSL.ByteString +getSignetAccountInstructions signetBankAccountId = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "businessAccount/banks/signet/" <> UUID.toText signetBankAccountId <> "/instructions" + params = Params Nothing [] + +--------------------------------------------------------------- +-- /businessAccount/banks/sen endpoint (Silvergate SEN operations) +--------------------------------------------------------------- + +-- | Create a bank account for a SEN +-- https://developers.circle.com/developer/v1/reference/createbusinesssenaccount +createSENAccount :: SENAccountRequestBody -> CircleAPIRequest SENAccountRequest TupleBS8 BSL.ByteString +createSENAccount senAccountBody = do + mkCircleAPIRequest NHTM.methodPost url params + where + url = "businessAccount/banks/sen" + params = Params (Just $ Body (encode senAccountBody)) [] + +-- | Get a list of SEN accounts +-- https://developers.circle.com/developer/v1/reference/listbusinesssenaccounts +listSENAccounts :: CircleAPIRequest SENAccountsRequest TupleBS8 BSL.ByteString +listSENAccounts = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "businessAccount/banks/sen" + params = Params Nothing [] + +-- | Get a single SEN account, accepts the SEN account Id as a parameter +-- https://developers.circle.com/developer/v1/reference/getbusinesssenaccount +getSENAccount :: UUID -> CircleAPIRequest SENAccountRequest TupleBS8 BSL.ByteString +getSENAccount senAccountId = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "businessAccount/banks/sen/" <> UUID.toText senAccountId + params = Params Nothing [] + +-- | Get the SEN transfer instructions into the Circle bank account given your bank account id. +-- https://developers.circle.com/developer/v1/reference/getbusinesssenaccountinstructions +getSENAccountInstructions :: UUID -> CircleAPIRequest SENInstructionsRequest TupleBS8 BSL.ByteString +getSENAccountInstructions senAccountId = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "businessAccount/banks/sen/" <> UUID.toText senAccountId <> "/instructions" + params = Params Nothing [] + +--------------------------------------------------------------- +-- /payments endpoint +--------------------------------------------------------------- + +-- | List all payments +-- https://developers.circle.com/developer/v1/reference/listpayments +listAllPayments :: CircleAPIRequest PaymentsRequest TupleBS8 BSL.ByteString +listAllPayments = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "payments" + params = Params Nothing [] + +-- | Create a payment (fiat or Crypto) +-- https://developers.circle.com/developer/v1/reference/payments-payments-create +createPayment :: CreatePaymentRequestBody -> CircleAPIRequest PaymentRequest TupleBS8 BSL.ByteString +createPayment createPaymentBody = do + mkCircleAPIRequest NHTM.methodPost url params + where + url = "payments" + params = Params (Just $ Body (encode createPaymentBody)) [] + +-- | Get a payment (fiat or Crypto) +-- https://developers.circle.com/developer/v1/reference/payments-payments-get-id +getPayment :: UUID -> CircleAPIRequest PaymentRequest TupleBS8 BSL.ByteString +getPayment paymentId = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "payments/" <> UUID.toText paymentId + params = Params Nothing [] + +-- | Cancel a fiat payment +-- https://developers.circle.com/developer/v1/reference/payments-payments-cancel-id +cancelPayment :: UUID -> CancelPaymentRequestBody -> CircleAPIRequest PaymentRequest TupleBS8 BSL.ByteString +cancelPayment paymentId cancelPaymentBody = do + mkCircleAPIRequest NHTM.methodPost url params + where + url = "payments/" <> UUID.toText paymentId <> "/cancel" + params = Params (Just $ Body (encode cancelPaymentBody)) [] + +-- | Refund a fiat payment +-- https://developers.circle.com/developer/v1/reference/payments-payments-refund-id +refundPayment :: UUID -> RefundPaymentRequestBody -> CircleAPIRequest PaymentRequest TupleBS8 BSL.ByteString +refundPayment paymentId refundPaymentBody = do + mkCircleAPIRequest NHTM.methodPost url params + where + url = "payments/" <> UUID.toText paymentId <> "/refund" + params = Params (Just $ Body (encode refundPaymentBody)) [] + +-- TODO add capture payment method? + +--------------------------------------------------------------- +-- /mock/payments endpoints +--------------------------------------------------------------- + +-- TODO constrain these method to run in the sandbox only. Would be cool to do the same thing with the Production only methods + +-- | Create mock wire payment SANDBOX ONLY +-- In the sandbox environment, initiate a mock wire payment that mimics the behavior of funds sent through the bank (wire) account linked to master wallet. +-- https://developers.circle.com/developer/v1/reference/createmockwirepayment +createMockWirePayment :: MockSenOrWirePaymentRequestBody -> CircleAPIRequest MockPaymentRequest TupleBS8 BSL.ByteString +createMockWirePayment wireBody = do + mkCircleAPIRequest NHTM.methodPost url params + where + url = "mocks/payments/wire" + params = Params (Just $ Body (encode wireBody)) [] + +-- | Create mock SEPA payment SANDBOX ONLY (in Beta) +-- In the sandbox environment, initiate a mock SEPA payment that mimics the behavior of funds sent through the bank (SEPA) account linked to master wallet. +-- https://developers.circle.com/developer/v1/reference/createmocksepapayment +createMockSEPAPayment :: MockSEPAPaymentRequestBody -> CircleAPIRequest MockPaymentRequest TupleBS8 BSL.ByteString +createMockSEPAPayment sepaBody = do + mkCircleAPIRequest NHTM.methodPost url params + where + url = "mocks/payments/sepa" + params = Params (Just $ Body (encode sepaBody)) [] + +-- | Create mock Silvergate payment SANDBOX ONLY +-- In the sandbox environment, initiate a mock SEN transfer that mimics the behavior of funds sent through the Silvergate SEN account linked to master wallet. +-- https://developers.circle.com/developer/v1/reference/createmocksenpayment +createMockSilvergatePayment :: MockSenOrWirePaymentRequestBody -> CircleAPIRequest MockPaymentRequest TupleBS8 BSL.ByteString +createMockSilvergatePayment senBody = do + mkCircleAPIRequest NHTM.methodPost url params + where + url = "mocks/payments/sen" + params = Params (Just $ Body (encode senBody)) [] + +--------------------------------------------------------------- +-- /mock/ach endpoint +--------------------------------------------------------------- + +-- | Create mock ACH account SANDBOX ONLY +-- In the sandbox environment, create a mock ACH account and retrieve a processor token that can be used to link an ACH account. +-- https://developers.circle.com/developer/v1/reference/createmockachaccount-1 +createMockACHBankAccount :: CreateMockACHBankAccountRequestBody -> CircleAPIRequest MockAccountRequest TupleBS8 BSL.ByteString +createMockACHBankAccount achPaymentBody = do + mkCircleAPIRequest NHTM.methodPost url params + where + url = "mocks/ach/account" + params = Params (Just $ Body (encode achPaymentBody)) [] + +--------------------------------------------------------------- +-- /mock/cards/chargebacks endpoint +--------------------------------------------------------------- + +-- | Create mock chargeback SANDBOX ONLY +-- In the sandbox environment, initiate a mock chargeback of a specified payment. +-- The entire payment will be charged back for its full value. The payment must be in the paid state +-- (otherwise the endpoint will return a 404), and each payment can only be charged back once +-- (otherwise the endpoint will return a 409). This endpoint is only available in the sandbox environment. +-- https://developers.circle.com/developer/v1/reference/payments-chargebacks-mock-create +createMockChargeback :: UUID -> CircleAPIRequest MockChargebackRequest TupleBS8 BSL.ByteString +createMockChargeback paymentId = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "mocks/cards/chargebacks" + params = Params (Just $ Body (encode paymentId)) [] + +--------------------------------------------------------------- +-- /transfers endpoint (On-chain transfers) +--------------------------------------------------------------- + +-- | Searches for transfers. +-- Searches for transfers involving the provided wallets. If no wallet ids +-- are provided, searches all wallets associated with your Circle API +-- account. If the date parameters are omitted, returns the most recent +-- transfers. This endpoint returns up to 50 transfers in descending +-- chronological order or pageSize, if provided. +-- https://developers.circle.com/developer/v1/reference/listtransfers-1 +listAllOnChainTransfers :: CircleAPIRequest OnChainTransfersRequest TupleBS8 BSL.ByteString +listAllOnChainTransfers = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "transfers" + params = Params Nothing [] + +-- | Get a business account transfer based on a transfer ID +-- https://developers.circle.com/developer/v1/reference/gettransfer +getOnChainTransfer :: UUID -> CircleAPIRequest TransferRequest TupleBS8 BSL.ByteString +getOnChainTransfer transferId = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "transfers/" <> UUID.toText transferId + params = Params Nothing [] + +-- | Create an on-chain transfer (i.e. a crypto payment) +-- https://developers.circle.com/developer/v1/reference/accounts-transfers-create +createOnChainTransfer :: OnChainTransferRequestBody -> CircleAPIRequest TransferRequest TupleBS8 BSL.ByteString +createOnChainTransfer onChainTransferBody = do + mkCircleAPIRequest NHTM.methodPost url params + where + url = "transfers" + params = Params (Just $ Body (encode onChainTransferBody)) [] + +--------------------------------------------------------------- +-- /cards endpoint +--------------------------------------------------------------- + +-- | List all cards +-- https://developers.circle.com/developer/v1/reference/listcards +listAllCards :: CircleAPIRequest CardsRequest TupleBS8 BSL.ByteString +listAllCards = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "cards" + params = Params Nothing [] + +-- | Get a card +-- https://developers.circle.com/developer/v1/reference/payments-cards-get-id +getCard :: UUID -> CircleAPIRequest CardRequest TupleBS8 BSL.ByteString +getCard cardId = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "cards/" <> UUID.toText cardId + params = Params Nothing [] + +-- | Create a card +-- https://developers.circle.com/developer/v1/reference/payments-cards-create +createCard :: CreateCardRequestBody -> CircleAPIRequest CardRequest TupleBS8 BSL.ByteString +createCard createCardBody = do + mkCircleAPIRequest NHTM.methodPost url params + where + url = "cards" + params = Params (Just $ Body (encode createCardBody)) [] + +-- | Update a card +-- https://developers.circle.com/developer/v1/reference/updatecard +updateCard :: UUID -> UpdateCardRequestBody -> CircleAPIRequest CardRequest TupleBS8 BSL.ByteString +updateCard cardId updateCardBody = do + mkCircleAPIRequest NHTM.methodPut url params + where + url = "cards/" <> UUID.toText cardId + params = Params (Just $ Body (encode updateCardBody)) [] + +--------------------------------------------------------------- +-- banks/wires endpoint +--------------------------------------------------------------- + +-- | Create a bank account for a wire +-- https://developers.circle.com/developer/v1/reference/createwireaccount +createWireAccount :: WireAccountRequestBody -> CircleAPIRequest WireAccountRequest TupleBS8 BSL.ByteString +createWireAccount wireAccountBody = do + mkCircleAPIRequest NHTM.methodPost url params + where + url = "banks/wires" + params = case wireAccountBody of + USBankAccount usBankAccountBody -> Params (Just $ Body (encode usBankAccountBody)) [] + IBANBankAccount ibanBankAccountBody -> Params (Just $ Body (encode ibanBankAccountBody)) [] + NonIBANBankAccount nonIBANBankAccountBody -> Params (Just $ Body (encode nonIBANBankAccountBody)) [] + +-- | Get a single wire account, accepts the wire account Id as a parameter +-- https://developers.circle.com/developer/v1/reference/getwireaccount-1 +getWireAccount :: UUID -> CircleAPIRequest WireAccountRequest TupleBS8 BSL.ByteString +getWireAccount wireAccountId = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "banks/wires/" <> UUID.toText wireAccountId + params = Params Nothing [] + +-- | Get the wire transfer instructions into the Circle bank account given your bank account id. +-- https://developers.circle.com/developer/v1/reference/getwireaccountinstructions +getWireAccountInstructions :: UUID -> CircleAPIRequest WireInstructionsRequest TupleBS8 BSL.ByteString +getWireAccountInstructions wireAccountId = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "banks/wires/" <> UUID.toText wireAccountId <> "/instructions" + params = Params Nothing [] + +--------------------------------------------------------------- +-- /banks/ach endpoint +--------------------------------------------------------------- + +-- NB: Use createMockACHBankAccount in the sandbox environment create a mock ACH account and retrieve a processor token that can be used to link an ACH account. + +-- | Create an ACH account +-- https://developers.circle.com/developer/v1/reference/payments-bank-accounts-ach-mock +createACHAccount :: CreateACHBankAccountRequestBody -> CircleAPIRequest ACHBankAccountRequest TupleBS8 BSL.ByteString +createACHAccount achAccountBody = do + mkCircleAPIRequest NHTM.methodPost url params + where + url = "banks/ach" + params = Params (Just $ Body (encode achAccountBody)) [] + +-- | Get an ACH account +-- https://developers.circle.com/developer/v1/reference/getachaccount-1 +getACHAccount :: UUID -> CircleAPIRequest ACHBankAccountRequest TupleBS8 BSL.ByteString +getACHAccount achAccountId = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "banks/ach/" <> UUID.toText achAccountId + params = Params Nothing [] + +--------------------------------------------------------------- +-- /banks/sepa endpoint +--------------------------------------------------------------- + +-- TODO some way to mark this stuff as being in beta? Is it even worth it? + +-- | Create a SEPA account (in beta) +-- https://developers.circle.com/developer/v1/reference/createsepaaccount-1 +createSEPAAccount :: SEPAAccountRequestBody -> CircleAPIRequest SEPAAccountRequest TupleBS8 BSL.ByteString +createSEPAAccount sepaAccountBody = do + mkCircleAPIRequest NHTM.methodPost url params + where + url = "banks/sepa" + params = Params (Just $ Body (encode sepaAccountBody)) [] + +-- | Get a SEPA account (in beta) +-- https://developers.circle.com/developer/v1/reference/getsepaaccount-1 +getSEPAAccount :: UUID -> CircleAPIRequest SEPAAccountRequest TupleBS8 BSL.ByteString +getSEPAAccount sepaAccountId = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "banks/sepa/" <> UUID.toText sepaAccountId + params = Params Nothing [] + +-- | Get instructions for a SEPA transfer (in beta) +-- https://developers.circle.com/developer/v1/reference/getsepaaccountinstructions +getSEPAAccountInstructions :: UUID -> CircleAPIRequest SEPAInstructionsRequest TupleBS8 BSL.ByteString +getSEPAAccountInstructions sepaAccountId = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "banks/sepa/" <> UUID.toText sepaAccountId <> "/instructions" + params = Params Nothing [] + +--------------------------------------------------------------- +-- /settlements endpoint +--------------------------------------------------------------- + +-- | List all settlements +-- https://developers.circle.com/developer/v1/reference/listsettlements +listAllSettlements :: CircleAPIRequest SettlementsRequest TupleBS8 BSL.ByteString +listAllSettlements = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "settlements" + params = Params Nothing [] + +-- | Get a settlement +-- https://developers.circle.com/developer/v1/reference/payments-settlements-get-id +getSettlement :: UUID -> CircleAPIRequest SettlementRequest TupleBS8 BSL.ByteString +getSettlement settlementId = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "settlements/" <> UUID.toText settlementId + params = Params Nothing [] + +--------------------------------------------------------------- +-- /chargebacks endpoint +--------------------------------------------------------------- + +-- | List all chargebacks +-- https://developers.circle.com/developer/v1/reference/listchargebacks +listAllChargebacks :: CircleAPIRequest ChargebacksRequest TupleBS8 BSL.ByteString +listAllChargebacks = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "chargebacks" + params = Params Nothing [] + +-- | Get a chargeback +-- https://developers.circle.com/developer/v1/reference/payments-chargebacks-get-id +getChargeback :: UUID -> CircleAPIRequest ChargebackRequest TupleBS8 BSL.ByteString +getChargeback chargebackId = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "chargebacks/" <> UUID.toText chargebackId + params = Params Nothing [] + +--------------------------------------------------------------- +-- /reversals endpoint +--------------------------------------------------------------- + +-- | Retrieve a list of ACH payment reversals. Results will be sorted by create date descending; more recent reversals will be at the beginning of the list +-- https://developers.circle.com/developer/v1/reference/listreversals +listAllACHReversals :: CircleAPIRequest ReversalsRequest TupleBS8 BSL.ByteString +listAllACHReversals = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "reversals" + params = Params Nothing [] + +--------------------------------------------------------------- +-- /balances endpoint +--------------------------------------------------------------- + +-- | Retrieves the balance of merchant funds that have settled and also of funds that have been sent for processing but have not yet settled. +-- https://developers.circle.com/developer/v1/reference/listbalances +listAllBalances :: CircleAPIRequest BalanceRequest TupleBS8 BSL.ByteString +listAllBalances = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "balances" + params = Params Nothing [] + +--------------------------------------------------------------- +-- /paymentIntents endpoint +--------------------------------------------------------------- + +-- | List all payment intents +-- https://developers.circle.com/developer/v1/reference/listpaymentintents +listAllPaymentIntents :: CircleAPIRequest PaymentIntentsRequest TupleBS8 BSL.ByteString +listAllPaymentIntents = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "paymentIntents" + params = Params Nothing [] + +-- | Create a payment intent +-- https://developers.circle.com/developer/v1/reference/createpaymentintent +createPaymentIntent :: CreatePaymentIntentRequestBody -> CircleAPIRequest PaymentIntentRequest TupleBS8 BSL.ByteString +createPaymentIntent createPaymentBody = do + mkCircleAPIRequest NHTM.methodPost url params + where + url = "paymentIntents" + params = Params (Just $ Body (encode createPaymentBody)) [] + +-- | Get a payment intent +-- https://developers.circle.com/developer/v1/reference/getpaymentintent +getPaymentIntent :: UUID -> CircleAPIRequest PaymentIntentRequest TupleBS8 BSL.ByteString +getPaymentIntent paymentIntentId = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "paymentIntents/" <> UUID.toText paymentIntentId + params = Params Nothing [] + +-- | Expire a payment intent +-- https://developers.circle.com/developer/v1/reference/expirepaymentintent +expirePaymentIntent :: UUID -> CircleAPIRequest PaymentIntentRequest TupleBS8 BSL.ByteString +expirePaymentIntent paymentIntentId = do + mkCircleAPIRequest NHTM.methodPost url params + where + url = "paymentIntents/" <> UUID.toText paymentIntentId <> "/expire" + params = Params Nothing [] + +--------------------------------------------------------------- +-- /payouts endpoint +--------------------------------------------------------------- + +-- | Lists all payouts made from a given account +-- https://developers.circle.com/developer/v1/reference/listpayouts +listAllPayouts :: CircleAPIRequest PayoutsRequest TupleBS8 BSL.ByteString +listAllPayouts = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "payouts" + params = Params Nothing [] + +-- | Gets a specific payout based on an ID +-- https://developers.circle.com/developer/v1/reference/payouts-payouts-get-id +getPayout :: UUID -> CircleAPIRequest PayoutRequest TupleBS8 BSL.ByteString +getPayout payoutId = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "payouts" <> UUID.toText payoutId + params = Params Nothing [] + +-- | Creates a payout +-- https://developers.circle.com/developer/v1/reference/payouts-payouts-create +createPayout :: PayoutRequestBody -> CircleAPIRequest PayoutRequest TupleBS8 BSL.ByteString +createPayout payoutBody = do + mkCircleAPIRequest NHTM.methodPost url params + where + url = "payouts" + params = Params (Just $ Body (encode payoutBody)) [] + +--------------------------------------------------------------- +-- /transfers endpoint (On-chain transfers) +--------------------------------------------------------------- + +-- | Searches for transfers from your account. +-- If the date parameters are omitted, returns the most recent transfers. +-- This endpoint returns up to 50 transfers in descending chronological order or pageSize, if provided. +-- https://developers.circle.com/developer/v1/reference/listtransfers +listAllTransfers :: CircleAPIRequest TransfersRequest TupleBS8 BSL.ByteString +listAllTransfers = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "transfers" + params = Params Nothing [] + +-- | Get a transfer based on a transfer ID +-- https://developers.circle.com/reference/getbusinesstransfer +getTransfer :: UUID -> CircleAPIRequest TransferRequest TupleBS8 BSL.ByteString +getTransfer transferId = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "transfers/" <> UUID.toText transferId + params = Params Nothing [] + +-- | Create a new transfer +-- https://developers.circle.com/developer/v1/reference/payouts-transfers-create +createTransfer :: TransferRequestBody -> CircleAPIRequest TransferRequest TupleBS8 BSL.ByteString +createTransfer transferBody = do + mkCircleAPIRequest NHTM.methodPost url params + where + url = "transfers" + params = Params (Just $ Body (encode transferBody)) [] + +--------------------------------------------------------------- +-- /returns endpoint +--------------------------------------------------------------- + +-- | Retrieve a list of Wire and ACH payout returns. Results will be sorted by create date descending; +-- more recent returns will be at the beginning of the list. +-- https://developers.circle.com/developer/v1/reference/listreturns +listAllReturns :: CircleAPIRequest ReturnsRequest TupleBS8 BSL.ByteString +listAllReturns = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "returns" + params = Params Nothing [] + +--------------------------------------------------------------- +-- /wallets endpoint +--------------------------------------------------------------- + +-- | Retrieves a list of a user's wallets. +-- https://developers.circle.com/developer/v1/reference/listwallets +listAllWallets :: CircleAPIRequest WalletsRequest TupleBS8 BSL.ByteString +listAllWallets = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "wallets" + params = Params Nothing [] + +-- | Get a wallet +-- https://developers.circle.com/developer/v1/reference/accounts-wallets-get-id +getWallet :: UUID -> CircleAPIRequest WalletRequest TupleBS8 BSL.ByteString +getWallet walletId = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "wallets/" <> UUID.toText walletId + params = Params Nothing [] + +-- | Creates an end user wallet. +-- https://developers.circle.com/developer/v1/reference/accounts-wallets-create +createWallet :: CreateWalletRequestBody -> CircleAPIRequest WalletRequest TupleBS8 BSL.ByteString +createWallet walletBody = do + mkCircleAPIRequest NHTM.methodPost url params + where + url = "wallets" + params = Params (Just $ Body (encode walletBody)) [] + +-- | Create new blockchain deposit address +-- Generates a new blockchain address for a wallet for a given currency/chain pair. +-- Circle may reuse addresses on blockchains that support reuse. +-- For example, if you're requesting two addresses for depositing USD and ETH, both on Ethereum, +-- you may see the same Ethereum address returned. +-- Depositing cryptocurrency to a generated address will credit the associated wallet with the value of the deposit. +-- https://developers.circle.com/developer/v1/reference/payments-on-chain-addresses-create +createDepositAddress :: UUID -> DepositAddressRequestBody -> CircleAPIRequest DepositAddressRequest TupleBS8 BSL.ByteString +createDepositAddress walletId depositAddressBody = do + mkCircleAPIRequest NHTM.methodPost url params + where + url = "wallets/" <> UUID.toText walletId <> "/addresses" + params = Params (Just $ Body (encode depositAddressBody)) [] + +-- | List all recipient addresses associated with a wallet Id +-- Retrieves a list of addresses associated with a wallet. +-- https://developers.circle.com/developer/v1/reference/listaddresses +listAllAddresses :: UUID -> CircleAPIRequest RecipientAddressesRequest TupleBS8 BSL.ByteString +listAllAddresses walletId = do + mkCircleAPIRequest NHTM.methodGet url params + where + url = "wallets/" <> UUID.toText walletId <> "/addresses" + params = Params Nothing [] + +--------------------------------------------------------------- +-- Utility methods for calling Circle's API +--------------------------------------------------------------- + +-- | Create a request to `circle`'s API +circle :: + (FromJSON (CircleRequest a)) => + CircleConfig -> + CircleAPIRequest a TupleBS8 BSL.ByteString -> + IO (Either CircleError (CircleRequest a)) +circle config request = do + response <- circle' config request + let result = eitherDecode $ responseBody response + case result of + Left s -> return (Left (CircleError (T.pack s) response)) + Right r -> return (Right r) + where + circle' :: + CircleConfig -> + CircleAPIRequest a TupleBS8 BSL.ByteString -> + IO Reply + circle' CircleConfig {..} CircleAPIRequest {..} = do + manager <- newManager tlsManagerSettings + initReq <- parseRequest $ T.unpack $ T.append (hostUri host) endpoint + let reqBody + | rMethod == NHTM.methodGet = mempty + | isNothing (paramsBody params) = mempty + | otherwise = unBody $ fromJust $ paramsBody params + req = + initReq + { method = rMethod, + requestBody = RequestBodyLBS reqBody, + requestHeaders = [(hContentType, "application/json"), (hAccept, "application/json")], + queryString = paramsToByteString $ paramsQuery params + } + circleToken = unApiToken token + authorizedRequest = applyBearerAuth circleToken req + httpLbs authorizedRequest manager + +-- | This function is only used internally to speed up the test suite. +-- Instead of creating a new Manager we reuse the same one. +circleTest :: + (FromJSON (CircleRequest a)) => + CircleConfig -> + Manager -> + CircleAPIRequest a TupleBS8 BSL.ByteString -> + IO (Either CircleError (CircleRequest a)) +circleTest config tlsManager request = do + response <- circleTest' config request tlsManager + let result = eitherDecode $ responseBody response + case result of + Left s -> return (Left (CircleError (T.pack s) response)) + Right r -> return (Right r) + where + circleTest' :: + CircleConfig -> + CircleAPIRequest a TupleBS8 BSL.ByteString -> + Manager -> + IO Reply + circleTest' CircleConfig {..} CircleAPIRequest {..} manager = do + initReq <- parseRequest $ T.unpack $ T.append (hostUri host) endpoint + let reqBody + | rMethod == NHTM.methodGet = mempty + | isNothing (paramsBody params) = mempty + | otherwise = unBody $ fromJust $ paramsBody params + req = + initReq + { method = rMethod, + requestBody = RequestBodyLBS reqBody, + requestHeaders = [(hContentType, "application/json"), (hAccept, "application/json")], + queryString = paramsToByteString $ paramsQuery params + } + circleToken = unApiToken token + authorizedRequest = applyBearerAuth circleToken req + httpLbs authorizedRequest manager + +-- | Conversion of a key value pair to a query parameterized string +paramsToByteString :: + [Query] -> + BS8.ByteString +paramsToByteString [] = mempty +paramsToByteString [x] = fst (unQuery x) <> "=" <> snd (unQuery x) +paramsToByteString (x : xs) = + mconcat [fst $ unQuery x, "=", snd $ unQuery x, "&"] <> paramsToByteString xs diff --git a/src/Circle/Types.hs b/src/Circle/Types.hs new file mode 100644 --- /dev/null +++ b/src/Circle/Types.hs @@ -0,0 +1,4360 @@ +------------------------------------------- +------------------------------------------- +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveLift #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +-- | +-- Module : Circle.Types +-- Copyright : (c) Dylan Martin, 2022 +-- Maintainer : dmarticus@gmail.com +-- Stability : experimental +-- Portability : POSIX +-- +-- < https:\/\/developers.circle.com\/developer\/v1\/docs\/circle-api-resources > +module Circle.Types where + +import Autodocodec + ( Autodocodec (Autodocodec), + HasCodec (codec), + bimapCodec, + dimapCodec, + object, + optionalField', + requiredField, + requiredField', + shownBoundedEnumCodec, + stringConstCodec, + (.=), + ) +import Control.Monad (guard) +import Country + ( Country, + alphaTwoUpper, + ) +import Data.Aeson + ( FromJSON (parseJSON), + Result (Error, Success), + ToJSON (toEncoding, toJSON), + withObject, + withText, + (.:), + (.:?), + ) +import Data.Aeson qualified as Aeson +import Data.Aeson.Types (fromJSON) +import Data.Bifunctor +import Data.ByteString.Char8 qualified as BS8 +import Data.ByteString.Lazy.Char8 qualified as BSL +import Data.Coerce (coerce) +import Data.Foldable +import Data.List.NonEmpty qualified as NE +import Data.Set qualified as Set +import Data.Text (Text) +import Data.Text qualified as T +import Data.Text.Encoding qualified as TE +import Data.Time +import Data.UUID +import Data.UUID qualified as UUID +import GHC.Generics (Generic) +import Language.Haskell.TH (Exp, Q) +import Language.Haskell.TH.Quote (QuasiQuoter (..)) +import Language.Haskell.TH.Syntax (Lift) +import Network.HTTP.Client (Response) +import Network.HTTP.Types.Method qualified as NHTM +import Refined +import Refined.Unsafe (reallyUnsafeRefine) +import System.Environment (getEnv) +import Text.Regex.PCRE.Heavy + +--------------------------------------------------------------- +-- Circle API wrapper +--------------------------------------------------------------- + +-- | Token type used for HTTP Bearer authentication. +newtype ApiToken = ApiToken + { unApiToken :: BS8.ByteString + } + deriving (Read, Show, Eq) + +-- | Type to represent the 3 main components (method, endpoint, and params) +-- needed to call Circle's API. +data CircleAPIRequest a b c = CircleAPIRequest + { -- | Method of CircleAPIRequest + rMethod :: !Method, + -- | Endpoint of CircleAPIRequest + endpoint :: !Text, + -- | Request params of CircleAPIRequest + params :: !(Params TupleBS8 BSL.ByteString) + } + deriving (Show) + +-- | Create a @CircleAPIRequest@ +mkCircleAPIRequest :: + Method -> + Text -> + Params TupleBS8 BSL.ByteString -> + CircleAPIRequest a b c +mkCircleAPIRequest = CircleAPIRequest + +type family CircleRequest a :: * + +-- | CircleErrors have contain both the error reason (`parseError`) and the +-- full error response body as a ByteString. +data CircleError = CircleError + { parseError :: !Text, + errorResponseBody :: !Reply + } + deriving (Show) + +-- | The CircleResponseBody will have `Nothing` for the `circleResponseCode` and +-- `circleResponseMessage` if the request succeeds, and `Nothing` for the `circleResponseData` +-- if the request fails. +data CircleResponseBody a = CircleResponseBody + { circleResponseCode :: !(Maybe ResponseStatus), + circleResponseMessage :: !(Maybe ResponseMessage), + circleResponseData :: !(Maybe a) + } + deriving (Eq, Show) + +-- NB: This FromJSON instance parses every response from the Circle API, so I can't use Autodocodec to derive FromJSON here +-- because I'm using ThisOrThat (see below) as a smart parser for certain types, and that type doesn't have Autodocodec instances +instance FromJSON a => FromJSON (CircleResponseBody a) where + parseJSON = withObject "CircleResponseBody" parse + where + parse o = + CircleResponseBody + <$> o .:? "status" + <*> o .:? "message" + <*> o .:? "data" + +-- Utility types have for interacting with the data returned from Circle's actual API +newtype ResponseStatus = ResponseStatus + { unResponseStatus :: Int + } + deriving (Eq, Show, FromJSON) + +instance HasCodec ResponseStatus where + codec = dimapCodec ResponseStatus unResponseStatus codec + +newtype ResponseMessage = ResponseMessage + { unResponseMessage :: Text + } + deriving (Eq, Show, FromJSON) + +instance HasCodec ResponseMessage where + codec = dimapCodec ResponseMessage unResponseMessage codec + +type Reply = Response BSL.ByteString + +type Method = NHTM.Method + +-- | Either production or sandbox API host +type Host = Text + +data CircleHost + = CircleProduction + | CircleSandbox + deriving (Eq, Show) + +hostUri :: CircleHost -> Text +hostUri CircleProduction = "https://api.circle.com/v1/" +hostUri CircleSandbox = "https://api-sandbox.circle.com/v1/" + +data CircleConfig = CircleConfig + { host :: !CircleHost, + token :: !ApiToken + } + deriving (Eq, Show) + +-- | Creates an API token using a secrete stored at \$CIRCLE_API_KEY (the default key for storing the Circle secret) +credentialsEnv :: Maybe String -> IO ApiToken +credentialsEnv mKey = do + key <- case mKey of + Just k -> pure k + Nothing -> pure "CIRCLE_API_KEY" + token <- getEnv key + return (ApiToken $ BS8.pack token) + +-- | Helper method for instantiating a Circle config that calls the production endpoint: https:\/\/api.circle.com\/v1\/ +-- Example usage: +-- @ +-- import Circle.Client +-- import Circle.Types +-- import Network.HTTP.Client (newManager) +-- import Network.HTTP.Client.TLS (tlsManagerSettings) +-- +-- main :: IO () +-- main = do +-- manager <- newManager tlsManagerSettings +-- config <- prodEnvConfig \"CIRCLE_API_KEY\" +-- result <- circle config manager getConfigurationInfo +-- case result of +-- Right CircleResponseBody b -> print bs +-- Left CircleError e -> print e +-- @ +prodEnvConfig :: Maybe String -> IO CircleConfig +prodEnvConfig key = do + CircleConfig CircleProduction <$> credentialsEnv key + +-- | Helper method for instantiating a Circle config that calls the production endpoint: https:\/\/api-sandbox.circle.com\/v1\/ +-- Example usage: +-- @ +-- import Circle.Client +-- import Circle.Types +-- import Network.HTTP.Client (newManager) +-- import Network.HTTP.Client.TLS (tlsManagerSettings) +-- +-- main :: IO () +-- main = do +-- manager <- newManager tlsManagerSettings +-- config <- sandboxEnvConfig \"CIRCLE_API_KEY\" +-- result <- circle config manager getConfigurationInfo +-- case result of +-- Right CircleResponseBody b -> print bs +-- Left CircleError e -> print e +-- @ +sandboxEnvConfig :: Maybe String -> IO CircleConfig +sandboxEnvConfig key = do + CircleConfig CircleSandbox <$> credentialsEnv key + +newtype Query = Query + { unQuery :: TupleBS8 + } + deriving (Eq, Show) + +newtype Body = Body + { unBody :: BSL.ByteString + } + deriving (Eq, Show) + +-- | Parameters for each request which include both the query and the body of a request +data Params b c = Params + { paramsBody :: Maybe Body, + paramsQuery :: ![Query] + } + deriving (Show) + +joinQueryParams :: Params b c -> Params b c -> Params b c +joinQueryParams (Params _ xs) (Params b ys) = Params b (xs ++ ys) + +-- | Type alias for query parameters +type TupleBS8 = (BS8.ByteString, BS8.ByteString) + +-- | Convert a parameter to a key\/value +class ToCircleParam param where + toCircleParam :: param -> Params TupleBS8 c -> Params TupleBS8 c + +class (ToCircleParam param) => CircleHasParam request param + +-- | Supports adding an optional query parameter. +-- Example usage: +-- @ +-- import Circle.Client +-- import Circle.Types +-- import Network.HTTP.Client (newManager) +-- import Network.HTTP.Client.TLS (tlsManagerSettings) +-- +-- main :: IO () +-- main = do +-- manager <- newManager tlsManagerSettings +-- config <- sandboxEnvConfig \"CIRCLE_API_KEY\" +-- result <- circle config manager listAllBalances -&- PaginationQueryParams (PageBefore "a8899b8e-782a-4526-b674-0efe1e04526d") +-- case result of +-- Right CircleResponseBody b -> print bs +-- Left CircleError e -> print e +-- @ +(-&-) :: + CircleHasParam r param => + CircleAPIRequest r b c -> + param -> + CircleAPIRequest r b c +circleAPIRequest -&- param = + circleAPIRequest + { params = toCircleParam param (params circleAPIRequest) + } + +--------------------------------------------------------------- +-- Query parameters +--------------------------------------------------------------- + +newtype PaginationQueryParams = PaginationQueryParams + { paginationQueryParams :: PaginationQueryParam + } + deriving (Eq, Show) + +-- | Depending on which endpoint is being called, the IDs after the `PageBefore` and `PageAfter` params could either be UUIDs or non-UUIDs. Let's just keep them as text for now. +-- TODO maybe improve this one day. +data PaginationQueryParam = PageBefore !Text | PageAfter !Text deriving (Show, Eq) + +-- | Circle has some BS pagination where they let users supply some canonical +-- collection ID, and then this pagination rule will return `n` entries before OR after that page, +-- where `n` is controlled by the pageSize param. This type exists to prevent callers from providing both params, which would error out +instance ToCircleParam PaginationQueryParams where + toCircleParam (PaginationQueryParams p) = + case p of + PageBefore a -> + joinQueryParams $ Params Nothing [Query ("pageBefore", TE.encodeUtf8 a)] + PageAfter a -> + joinQueryParams $ Params Nothing [Query ("pageAfter", TE.encodeUtf8 a)] + +newtype FromQueryParam = FromQueryParam + { fromQueryParam :: UTCTime + } + deriving (Eq, Show) + +instance ToCircleParam FromQueryParam where + toCircleParam (FromQueryParam i) = + joinQueryParams $ Params Nothing [Query ("from", TE.encodeUtf8 $ utcToCircle i)] + +newtype ToQueryParam = ToQueryParam + { toQueryParam :: UTCTime + } + deriving (Eq, Show) + +instance ToCircleParam ToQueryParam where + toCircleParam (ToQueryParam i) = + joinQueryParams $ Params Nothing [Query ("to", TE.encodeUtf8 $ utcToCircle i)] + +newtype PageSizeQueryParam = PageSizeQueryParam + { pageSizeQueryParam :: Integer + } + deriving (Eq, Show) + +instance ToCircleParam PageSizeQueryParam where + toCircleParam (PageSizeQueryParam i) = + joinQueryParams $ Params Nothing [Query ("pageSize", TE.encodeUtf8 $ (T.pack . show) i)] + +newtype StatusQueryParams = StatusQueryParams + { statusQueryParams :: [Status] + } + deriving (Eq, Show) + +statusToBS8 :: Status -> BS8.ByteString +statusToBS8 Pending = "pending" +statusToBS8 Complete = "complete" +statusToBS8 Failed = "failed" + +instance ToCircleParam StatusQueryParams where + toCircleParam (StatusQueryParams xs) = + joinQueryParams $ Params Nothing [Query ("status", BS8.intercalate "," (map statusToBS8 xs))] + +newtype DestinationQueryParam = DestinationQueryParam + { destinationQueryParam :: UUID + } + deriving (Eq, Show) + +instance ToCircleParam DestinationQueryParam where + toCircleParam (DestinationQueryParam i) = + joinQueryParams $ Params Nothing [Query ("destination", TE.encodeUtf8 (tshow i))] + +newtype TypeQueryParam = TypeQueryParam + { typeQueryParam :: BankAccountType + } + deriving (Eq, Show) + +bankAccountTypeToBS8 :: BankAccountType -> BS8.ByteString +bankAccountTypeToBS8 Wire = "wire" +bankAccountTypeToBS8 Sen = "sen" + +instance ToCircleParam TypeQueryParam where + toCircleParam (TypeQueryParam i) = + joinQueryParams $ Params Nothing [Query ("type", bankAccountTypeToBS8 i)] + +newtype CurrencyQueryParam = CurrencyQueryParam + { currencyQueryParam :: SupportedCurrencies + } + deriving (Eq, Show) + +currencyToBS8 :: SupportedCurrencies -> BS8.ByteString +currencyToBS8 USD = "USD" +currencyToBS8 EUR = "EUR" +currencyToBS8 BTC = "BTC" +currencyToBS8 ETH = "ETH" + +instance ToCircleParam CurrencyQueryParam where + toCircleParam (CurrencyQueryParam i) = + joinQueryParams $ Params Nothing [Query ("currency", currencyToBS8 i)] + +newtype SourceQueryParam = SourceQueryParam + { sourceQueryParam :: UUID + } + deriving (Eq, Show) + +instance ToCircleParam SourceQueryParam where + toCircleParam (SourceQueryParam i) = + joinQueryParams $ Params Nothing [Query ("source", TE.encodeUtf8 (tshow i))] + +newtype SettlementIdQueryParam = SettlementIdQueryParam + { settlementIdQueryParam :: UUID + } + deriving (Eq, Show) + +instance ToCircleParam SettlementIdQueryParam where + toCircleParam (SettlementIdQueryParam i) = + joinQueryParams $ Params Nothing [Query ("settlementId", TE.encodeUtf8 (tshow i))] + +newtype PaymentIntentIdQueryParam = PaymentIntentIdQueryParam + { paymentIntentIdQueryParam :: UUID + } + deriving (Eq, Show) + +instance ToCircleParam PaymentIntentIdQueryParam where + toCircleParam (PaymentIntentIdQueryParam i) = + joinQueryParams $ Params Nothing [Query ("paymentIntentId", TE.encodeUtf8 (tshow i))] + +newtype PaymentIdQueryParam = PaymentIdQueryParam + { paymentIdQueryParam :: UUID + } + deriving (Eq, Show) + +instance ToCircleParam PaymentIdQueryParam where + toCircleParam (PaymentIdQueryParam i) = + joinQueryParams $ Params Nothing [Query ("paymentId", TE.encodeUtf8 (tshow i))] + +newtype PaymentStatusQueryParams = PaymentStatusQueryParams + { paymentStatusQueryParams :: [PaymentStatus] + } + deriving (Eq, Show) + +paymentStatusToBS8 :: PaymentStatus -> BS8.ByteString +paymentStatusToBS8 PaymentPending = "pending" +paymentStatusToBS8 Confirmed = "confirmed" +paymentStatusToBS8 PaymentFailed = "failed" +paymentStatusToBS8 Paid = "paid" +paymentStatusToBS8 ActionRequired = "action_required" + +instance ToCircleParam PaymentStatusQueryParams where + toCircleParam (PaymentStatusQueryParams xs) = + joinQueryParams $ Params Nothing [Query ("status", BS8.intercalate "," (map paymentStatusToBS8 xs))] + +newtype PaymentIntentContextQueryParams = PaymentIntentContextQueryParams + { paymentIntentContextQueryParams :: [PaymentIntentContext] + } + deriving (Eq, Show) + +paymentIntentContextToBS8 :: PaymentIntentContext -> BS8.ByteString +paymentIntentContextToBS8 ContextUnderpaid = "underpaid" +paymentIntentContextToBS8 ContextPaid = "paid" +paymentIntentContextToBS8 ContextOverpaid = "overpaid" + +instance ToCircleParam PaymentIntentContextQueryParams where + toCircleParam (PaymentIntentContextQueryParams xs) = + joinQueryParams $ Params Nothing [Query ("context", BS8.intercalate "," (map paymentIntentContextToBS8 xs))] + +newtype WalletIdQueryParam = WalletIdQueryParam + { walletIdQueryParam :: WalletId + } + deriving (Eq, Show) + +instance ToCircleParam WalletIdQueryParam where + toCircleParam (WalletIdQueryParam i) = + joinQueryParams $ Params Nothing [Query ("walletId", TE.encodeUtf8 (unWalletId i))] + +newtype SourceWalletIdQueryParam = SourceWalletIdQueryParam + { sourceWalletIdQueryParam :: WalletId + } + deriving (Eq, Show) + +instance ToCircleParam SourceWalletIdQueryParam where + toCircleParam (SourceWalletIdQueryParam i) = + joinQueryParams $ Params Nothing [Query ("sourceWalletId", TE.encodeUtf8 (unWalletId i))] + +newtype DestinationWalletIdQueryParam = DestinationWalletIdQueryParam + { destinationWalletIdQueryParam :: WalletId + } + deriving (Eq, Show) + +instance ToCircleParam DestinationWalletIdQueryParam where + toCircleParam (DestinationWalletIdQueryParam i) = + joinQueryParams $ Params Nothing [Query ("destinationWalletId", TE.encodeUtf8 (unWalletId i))] + +newtype ReturnIdentitiesQueryParam = ReturnIdentitiesQueryParam + { returnIdentitiesQueryParam :: Bool + } + deriving (Eq, Show) + +instance ToCircleParam ReturnIdentitiesQueryParam where + toCircleParam (ReturnIdentitiesQueryParam i) = + joinQueryParams $ Params Nothing [Query ("returnIdentities", TE.encodeUtf8 (T.pack (show i)))] + +--------------------------------------------------------------- +-- Balance Types +--------------------------------------------------------------- + +data BalanceRequest + +type instance CircleRequest BalanceRequest = CircleResponseBody BalanceResponseBody + +-- | Response body for the "businessAccount\/balances" and "\/balances" endpoints +data BalanceResponseBody = BalanceResponseBody + { balanceResponseBodyAvailable :: ![MoneyAmount], + balanceResponseBodyUnsettled :: ![MoneyAmount] + } + deriving (Eq, Show, Generic) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec BalanceResponseBody) + +instance HasCodec BalanceResponseBody where + codec = + object "BalanceResponseBody" $ + BalanceResponseBody + <$> requiredField' "available" .= balanceResponseBodyAvailable + <*> requiredField' "unsettled" .= balanceResponseBodyAvailable + +--------------------------------------------------------------- +-- Payout Types +--------------------------------------------------------------- +data PayoutRequest + +type instance CircleRequest PayoutRequest = CircleResponseBody PayoutResponseBody + +data PayoutsRequest + +type instance CircleRequest PayoutsRequest = CircleResponseBody [PayoutResponseBody] + +instance CircleHasParam PayoutsRequest PaginationQueryParams + +instance CircleHasParam PayoutsRequest FromQueryParam + +instance CircleHasParam PayoutsRequest ToQueryParam + +instance CircleHasParam PayoutsRequest PageSizeQueryParam + +instance CircleHasParam PayoutsRequest StatusQueryParams + +instance CircleHasParam PayoutsRequest TypeQueryParam + +instance CircleHasParam PayoutsRequest DestinationQueryParam + +-- | Response body for methods that call "businessAccount\/payouts" or "payouts" endpoints +data PayoutResponseBody = PayoutResponseBody + { payoutResponseBodyId :: !UUID, + payoutResponseBodySourceWalletId :: !WalletId, + payoutResponseBodyDestinationBankAccount :: !DestinationBankAccount, + payoutResponseBodyAmount :: !MoneyAmount, + payoutResponseBodyFees :: !MoneyAmount, + payoutResponseBodyStatus :: !Status, + payoutResponseBodyTrackingRef :: !TrackingReference, + payoutResponseBodyPayoutErrorCode :: !PayoutErrorCode, + payoutResponseBodyRiskEvaluation :: !RiskEvaluation, + payoutResponseBodyAdjustments :: !Adjustments, + payoutResponseBodyPayoutReturn :: !PayoutReturnResponseBody, + payoutResponseBodyCreateDate :: !UTCTime, + payoutResponseBodyUpdateDate :: !UTCTime + } + deriving (Eq, Show) + deriving + ( ToJSON, + FromJSON + ) + via (Autodocodec PayoutResponseBody) + +instance HasCodec PayoutResponseBody where + codec = + object "PayoutResponseBody" $ + PayoutResponseBody + <$> requiredField' "id" .= payoutResponseBodyId + <*> requiredField' "sourceWalletId" .= payoutResponseBodySourceWalletId + <*> requiredField' "destination" .= payoutResponseBodyDestinationBankAccount + <*> requiredField' "amount" .= payoutResponseBodyAmount + <*> requiredField' "fees" .= payoutResponseBodyFees + <*> requiredField' "status" .= payoutResponseBodyStatus + <*> requiredField' "trackingRef" .= payoutResponseBodyTrackingRef + <*> requiredField' "errorCode" .= payoutResponseBodyPayoutErrorCode + <*> requiredField' "riskEvaluation" .= payoutResponseBodyRiskEvaluation + <*> requiredField' "adjustments" .= payoutResponseBodyAdjustments + <*> requiredField' "payoutReturn" .= payoutResponseBodyPayoutReturn + <*> requiredField' "createDate" .= payoutResponseBodyCreateDate + <*> requiredField' "updateDate" .= payoutResponseBodyUpdateDate + +-- | Request body for creating a new business account payout +data BusinessPayoutRequestBody = BusinessPayoutRequestBody + { businessPayoutIdempotencyKey :: !UUID, + businessPayoutDestination :: !DestinationBankAccount, + businessPayoutAmount :: !MoneyAmount + } + deriving (Eq, Show) + deriving + ( ToJSON, + FromJSON + ) + via (Autodocodec BusinessPayoutRequestBody) + +instance HasCodec BusinessPayoutRequestBody where + codec = + object "BusinessPayoutRequestBody" $ + BusinessPayoutRequestBody + <$> requiredField' "idempotencyKey" .= businessPayoutIdempotencyKey + <*> requiredField' "destination" .= businessPayoutDestination + <*> requiredField' "amount" .= businessPayoutAmount + +newtype PayoutMetadata = PayoutMetadata {payoutMetadataBeneficiaryEmail :: Email} + deriving (Eq, Show) + deriving (ToJSON, FromJSON) via (Autodocodec PayoutMetadata) + +instance HasCodec PayoutMetadata where + codec = + object "PayoutMetadata" $ + PayoutMetadata + <$> requiredField' "beneficiaryEmail" .= payoutMetadataBeneficiaryEmail + +-- | Request body to create a payout. +data PayoutRequestBody = PayoutRequestBody + { payoutIdempotencyKey :: !UUID, + payoutSource :: !(Maybe PaymentSource), + payoutDestination :: !DestinationBankAccount, + payoutAmount :: !MoneyAmount, + payoutMetadata :: !PayoutMetadata + } + deriving (Eq, Show) + deriving + ( ToJSON, + FromJSON + ) + via (Autodocodec PayoutRequestBody) + +instance HasCodec PayoutRequestBody where + codec = + object "PayoutRequestBody" $ + PayoutRequestBody + <$> requiredField' "idempotencyKey" .= payoutIdempotencyKey + <*> optionalField' "source" .= payoutSource + <*> requiredField' "destination" .= payoutDestination + <*> requiredField' "amount" .= payoutAmount + <*> requiredField' "metadata" .= payoutMetadata + +-- | Response body for methods that call the "returns" endpoint +data PayoutReturnResponseBody = PayoutReturnResponseBody + { payoutReturnResponseBodyId :: !UUID, + payoutReturnResponseBodyOriginalPayoutId :: !UUID, + payoutReturnResponseBodyAmount :: !MoneyAmount, + payoutReturnResponseBodyFees :: !MoneyAmount, + payoutReturnResponseBodyReason :: !Text, + payoutReturnResponseBodyStatus :: !Status, + payoutReturnResponseBodyCreateDate :: !UTCTime, + payoutReturnResponseBodyUpdateDate :: !UTCTime + } + deriving (Eq, Show) + deriving + ( ToJSON, + FromJSON + ) + via (Autodocodec PayoutReturnResponseBody) + +instance HasCodec PayoutReturnResponseBody where + codec = + object "PayoutReturnResponseBody" $ + PayoutReturnResponseBody + <$> requiredField' "id" .= payoutReturnResponseBodyId + <*> requiredField' "payoutId" .= payoutReturnResponseBodyOriginalPayoutId + <*> requiredField' "amount" .= payoutReturnResponseBodyAmount + <*> requiredField' "fees" .= payoutReturnResponseBodyFees + <*> requiredField' "reason" .= payoutReturnResponseBodyReason + <*> requiredField' "status" .= payoutReturnResponseBodyStatus + <*> requiredField' "createDate" .= payoutReturnResponseBodyCreateDate + <*> requiredField' "updateDate" .= payoutReturnResponseBodyUpdateDate + +data PayoutErrorCode + = InsufficientFunds + | TransactionDenied + | TransactionFailed + | TransactionReturned + | BankTransactionError + | FiatAccountLimitExceeded + | InvalidBankAccountNumber + | InvalidACHRoutingTransitNumber + | InvalidWireRoutingTransitNumber + | VendorInactive + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec PayoutErrorCode) + +instance HasCodec PayoutErrorCode where + codec = + stringConstCodec $ + NE.fromList + [ (InsufficientFunds, "insufficient_funds"), + (TransactionDenied, "transaction_denied"), + (TransactionFailed, "transaction_failed"), + (TransactionReturned, "transaction_returned"), + (BankTransactionError, "bank_transaction_error"), + (FiatAccountLimitExceeded, "fiat_account_limit_exceeded"), + (InvalidBankAccountNumber, "invalid_bank_account_number"), + (InvalidACHRoutingTransitNumber, "invalid_ach_rtn"), + (InvalidWireRoutingTransitNumber, "invalid_wire_rtn"), + (VendorInactive, "vendor_inactive") + ] + +--------------------------------------------------------------- +-- Configuration Types +--------------------------------------------------------------- + +data ConfigurationRequest + +type instance CircleRequest ConfigurationRequest = CircleResponseBody ConfigurationResponseBody + +-- | Response body for the "\/configuration" endpoint +newtype ConfigurationResponseBody = ConfigurationResponseBody {configurationResponseBodyPayments :: WalletConfig} + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec ConfigurationResponseBody) + +instance HasCodec ConfigurationResponseBody where + codec = + object "ConfigurationResponseBody" $ + ConfigurationResponseBody + <$> requiredField' "payments" .= configurationResponseBodyPayments + +newtype WalletConfig = WalletConfig {masterWalletId :: WalletId} + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec WalletConfig) + +instance HasCodec WalletConfig where + codec = + object "WalletConfig" $ + WalletConfig + <$> requiredField' "masterWalletId" .= masterWalletId + +--------------------------------------------------------------- +-- Encryption Types +--------------------------------------------------------------- + +data EncryptionRequest + +type instance CircleRequest EncryptionRequest = CircleResponseBody EncryptionResponseBody + +-- | Response body for the "\/encryption\/public" endpoint +data EncryptionResponseBody = EncryptionResponseBody + { encryptionResponseBodyKeyId :: !Text, -- TODO this should actually be a UUID, but for the tests to work it needs to be relaxed a bit + encryptionResponseBodyPublicKey :: !PGPKey + } + deriving (Eq, Show) + deriving (ToJSON, FromJSON) via (Autodocodec EncryptionResponseBody) + +newtype PGPKey = PGPKey + { unPGPKey :: Text + } + deriving (Eq, Show, ToJSON, FromJSON) + +instance HasCodec PGPKey where + codec = dimapCodec PGPKey unPGPKey codec + +instance HasCodec EncryptionResponseBody where + codec = + object "EncryptionResponseBody" $ + EncryptionResponseBody + <$> requiredField' "keyId" .= encryptionResponseBodyKeyId + <*> requiredField' "publicKey" .= encryptionResponseBodyPublicKey + +--------------------------------------------------------------- +-- Channels Types +--------------------------------------------------------------- + +data ChannelsRequest + +type instance CircleRequest ChannelsRequest = CircleResponseBody ChannelResponseBody + +-- | Response body for the "\/channels" endpoint +newtype ChannelResponseBody = ChannelResponseBody {channels :: [Channel]} + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec ChannelResponseBody) + +instance HasCodec ChannelResponseBody where + codec = + object "ChannelResponseBody" $ + ChannelResponseBody + <$> requiredField' "channels" .= channels + +data Channel = Channel + { channelId :: !UUID, + channelDefault :: !Bool, + channelCardDescriptor :: !Text, + channelAchDescriptor :: !Text + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec Channel) + +instance HasCodec Channel where + codec = + object "Channel" $ + Channel + <$> requiredField' "id" .= channelId + <*> requiredField' "default" .= channelDefault + <*> requiredField' "cardDescriptor" .= channelCardDescriptor + <*> requiredField' "achDescriptor" .= channelAchDescriptor + +--------------------------------------------------------------- +-- Stablecoin Types +--------------------------------------------------------------- + +data StablecoinsRequest + +type instance CircleRequest StablecoinsRequest = CircleResponseBody [StablecoinResponseBody] + +-- | Response body for the "\/stablecoins" endpoint +data StablecoinResponseBody = StablecoinResponseBody + { stablecoinResponseBodyName :: !Text, + stablecoinResponseBodySymbol :: !Stablecoin, + stablecoinResponseBodyTotalAmount :: !Text, --TODO need an amount field that supports crypto depth. Many of these coins go past a fixed integer depth. + stablecoinResponseBodyChains :: ![ChainAmount] + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec StablecoinResponseBody) + +instance HasCodec StablecoinResponseBody where + codec = + object "StablecoinResponseBody" $ + StablecoinResponseBody + <$> requiredField' "name" .= stablecoinResponseBodyName + <*> requiredField' "symbol" .= stablecoinResponseBodySymbol + <*> requiredField' "totalAmount" .= stablecoinResponseBodyTotalAmount + <*> requiredField' "chains" .= stablecoinResponseBodyChains + +data ChainAmount = ChainAmount + { chainAmountAmount :: !Text, + chainAmountChain :: !Chain, + chainAmountUpdateDate :: !UTCTime + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec ChainAmount) + +instance HasCodec ChainAmount where + codec = + object "ChainAmount" $ + ChainAmount + <$> requiredField' "amount" .= chainAmountAmount + <*> requiredField' "chain" .= chainAmountChain + <*> requiredField' "updateDate" .= chainAmountUpdateDate + +data Chain = ALGO | ARB | AVAX | ChainBTC | ChainETH | FLOW | HBAR | MATIC | NEAR | OP | SOL | TRX | XLM + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec Chain) + +instance HasCodec Chain where + codec = + stringConstCodec $ + NE.fromList + [ (ALGO, "ALGO"), + (ARB, "ARB"), + (AVAX, "AVAX"), + (ChainBTC, "BTC"), + (ChainETH, "ETH"), + (FLOW, "FLOW"), + (HBAR, "HBAR"), + (MATIC, "MATIC"), + (NEAR, "NEAR"), + (OP, "OP"), + (SOL, "SOL"), + (TRX, "TRX"), + (XLM, "XLM") + ] + +data Stablecoin = USDC | EUROC | USDT + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec Stablecoin) + +instance HasCodec Stablecoin where + codec = + stringConstCodec $ + NE.fromList + [ (USDC, "USDC"), + (EUROC, "EUROC"), + (USDT, "USDT") + ] + +--------------------------------------------------------------- +-- Subscription Types +--------------------------------------------------------------- + +data SubscriptionsRequest + +type instance CircleRequest SubscriptionsRequest = CircleResponseBody [SubscriptionResponseBody] + +data SubscriptionRequest + +type instance CircleRequest SubscriptionRequest = CircleResponseBody SubscriptionResponseBody + +-- | Response body for methods that call "notifications\/subscriptions" +data SubscriptionResponseBody = SubscriptionResponseBody + { subscriptionResponseBodyId :: !UUID, + subscriptionResponseBodyEndpoint :: !URL, + subscriptionResponseBodySubscriptionDetails :: ![SubscriptionDetails] + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec SubscriptionResponseBody) + +instance HasCodec SubscriptionResponseBody where + codec = + object "SubscriptionResponseBody" $ + SubscriptionResponseBody + <$> requiredField' "id" .= subscriptionResponseBodyId + <*> requiredField' "endpoint" .= subscriptionResponseBodyEndpoint + <*> requiredField' "subscriptionDetails" .= subscriptionResponseBodySubscriptionDetails + +data SubscriptionDetails = SubscriptionDetails + { subscriptionDetailsUrl :: !URL, + subscriptionDetailsStatus :: !Status + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec SubscriptionDetails) + +instance HasCodec SubscriptionDetails where + codec = + object "SubscriptionDetails" $ + SubscriptionDetails + <$> requiredField' "url" .= subscriptionDetailsUrl + <*> requiredField' "status" .= subscriptionDetailsStatus + +-- | Request body for creating a new subscription +newtype SubscriptionRequestBody = SubscriptionRequestBody + { subscriptionRequestBodyEndpoint :: Text + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec SubscriptionRequestBody) + +instance HasCodec SubscriptionRequestBody where + codec = + object "SubscriptionRequestBody" $ + SubscriptionRequestBody + <$> requiredField' "endpoint" .= subscriptionRequestBodyEndpoint + +--------------------------------------------------------------- +-- Transfer Types +--------------------------------------------------------------- + +data TransfersRequest + +type instance CircleRequest TransfersRequest = CircleResponseBody [TransferResponseBody] + +instance CircleHasParam TransfersRequest PaginationQueryParams + +instance CircleHasParam TransfersRequest FromQueryParam + +instance CircleHasParam TransfersRequest ToQueryParam + +instance CircleHasParam TransfersRequest PageSizeQueryParam + +instance CircleHasParam TransfersRequest WalletIdQueryParam + +instance CircleHasParam TransfersRequest SourceWalletIdQueryParam + +instance CircleHasParam TransfersRequest DestinationWalletIdQueryParam + +instance CircleHasParam TransfersRequest ReturnIdentitiesQueryParam + +data TransferRequest + +type instance CircleRequest TransferRequest = CircleResponseBody TransferResponseBody + +instance CircleHasParam TransferRequest ReturnIdentitiesQueryParam + +-- | Request body for creating a new business account transfer +data BusinessTransferRequestBody = BusinessTransferRequestBody + { businessTransferRequestBodyIdempotencyKey :: !UUID, + businessTransferRequestBodyDestination :: !TransferDestination, + businessTransferRequestBodyAmount :: !MoneyAmount + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec BusinessTransferRequestBody) + +instance HasCodec BusinessTransferRequestBody where + codec = + object "BusinessTransferRequestBody" $ + BusinessTransferRequestBody + <$> requiredField' "idempotencyKey" .= businessTransferRequestBodyIdempotencyKey + <*> requiredField' "destination" .= businessTransferRequestBodyDestination + <*> requiredField' "amount" .= businessTransferRequestBodyAmount + +-- | Request body for creating a new transfer +data TransferRequestBody = TransferRequestBody + { transferRequestBodyIdempotencyKey :: !UUID, + transferRequestBodySource :: !PaymentSource, + transferRequestBodyDestination :: !TransferDestination, + transferRequestBodyAmount :: !MoneyAmount + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec TransferRequestBody) + +instance HasCodec TransferRequestBody where + codec = + object "TransferRequestBody" $ + TransferRequestBody + <$> requiredField' "idempotencyKey" .= transferRequestBodyIdempotencyKey + <*> requiredField' "source" .= transferRequestBodySource + <*> requiredField' "destination" .= transferRequestBodyDestination + <*> requiredField' "amount" .= transferRequestBodyAmount + +data TransferDestination = TransferDestination + { transferDestinationType :: !DestinationType, + transferDestinationAddressId :: !UUID + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec TransferDestination) + +instance HasCodec TransferDestination where + codec = + object "TransferDestination" $ + TransferDestination + <$> requiredField' "type" .= transferDestinationType + <*> requiredField' "addressId" .= transferDestinationAddressId + +data DestinationType = VerifiedBlockchain + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec DestinationType) + +instance HasCodec DestinationType where + codec = + stringConstCodec $ + NE.fromList + [ (VerifiedBlockchain, "verified_blockchain") + ] + +-- | Response body for methods that call the "businessAccount\/transfers" and "transfers" endpoints +data TransferResponseBody = TransferResponseBody + { transferResponseBodyId :: !UUID, + transferResponseBodySource :: !(ThisOrThat SourceWallet SourceBlockchain), + transferResponseBodyDestination :: !(ThisOrThat DestinationWallet DestinationBlockchain), + transferResponseBodyAmount :: !MoneyAmount, + transferResponseBodyFees :: !TransferFeeAmount, + transferResponseBodyTransactionHash :: !(Maybe HexString), + transferResponseBodyStatus :: !Status, + transferResponseBodyTransferErrorCode :: !(Maybe TransferErrorCode), + transferResponseBodyRiskEvaluation :: !(Maybe RiskEvaluation), + transferResponseBodyCreateDate :: !(Maybe UTCTime) + } + deriving (Eq, Show) + +-- NB: this doesn't use autodocodec for deriving ToJSON and FromJSON since I'm using the hand-rolled +-- ThisOrThat helper for smartly parsing types. +instance FromJSON TransferResponseBody where + parseJSON = withObject "TransferResponseBody" parse + where + parse o = + TransferResponseBody + <$> o .: "id" + <*> o .: "source" + <*> o .: "destination" + <*> o .: "amount" + <*> o .: "fees" + <*> o .:? "transactionHash" + <*> o .: "status" + <*> o .:? "errorCode" + <*> o .:? "riskEvaluation" + <*> o .:? "createDate" + +data SourceWallet = SourceWallet + { sourceWalletType :: !TransferType, + sourceWalletId :: !WalletId, + sourceWalletIdentities :: ![Identity] + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec SourceWallet) + +instance HasCodec SourceWallet where + codec = + object "SourceWallet" $ + SourceWallet + <$> requiredField' "type" .= sourceWalletType + <*> requiredField' "id" .= sourceWalletId + <*> requiredField' "identities" .= sourceWalletIdentities + +data SourceBlockchain = SourceBlockchain + { sourceBlockchainType :: !TransferType, + sourceBlockchainChain :: !Chain, + sourceBlockChainIdentities :: ![Identity] + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec SourceBlockchain) + +instance HasCodec SourceBlockchain where + codec = + object "SourceBlockchain" $ + SourceBlockchain + <$> requiredField' "type" .= sourceBlockchainType + <*> requiredField' "chain" .= sourceBlockchainChain + <*> requiredField' "identities" .= sourceBlockChainIdentities + +data DestinationWallet = DestinationWallet + { destinationWalletType :: !TransferType, + destinationWalletId :: !WalletId, + destinationWalletAddress :: !(Maybe Text), + destinationWalletAddressTag :: !(Maybe Text) + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec DestinationWallet) + +instance HasCodec DestinationWallet where + codec = + object "DestinationWallet" $ + DestinationWallet + <$> requiredField' "type" .= destinationWalletType + <*> requiredField' "id" .= destinationWalletId + <*> optionalField' "address" .= destinationWalletAddress + <*> optionalField' "addressTag" .= destinationWalletAddressTag + +data DestinationBlockchain = DestinationBlockchain + { destinationBlockchainType :: !TransferType, + destinationBlockchainAddress :: !HexString, + destinationBlockchainAddressTag :: !(Maybe Text), + destinationBlockchainAddressChain :: !Chain + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec DestinationBlockchain) + +instance HasCodec DestinationBlockchain where + codec = + object "DestinationBlockchain" $ + DestinationBlockchain + <$> requiredField' "type" .= destinationBlockchainType + <*> requiredField' "address" .= destinationBlockchainAddress + <*> optionalField' "addressTag" .= destinationBlockchainAddressTag + <*> requiredField' "chain" .= destinationBlockchainAddressChain + +data Identity = Identity + { identityType :: !IdentityType, + identityName :: !Text, + identityAddresses :: ![Address] + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec Identity) + +instance HasCodec Identity where + codec = + object "Identity" $ + Identity + <$> requiredField' "type" .= identityType + <*> requiredField' "name" .= identityName + <*> requiredField' "addresses" .= identityAddresses + +data IdentityType = Individual | Business + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec IdentityType) + +instance HasCodec IdentityType where + codec = stringConstCodec $ NE.fromList [(Individual, "individual"), (Business, "business")] + +data TransferType = Wallet | Blockchain + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec TransferType) + +instance HasCodec TransferType where + codec = stringConstCodec $ NE.fromList [(Wallet, "wallet"), (Blockchain, "blockchain")] + +data TransferErrorCode + = TransferInsufficientFunds + | BlockchainError + | TransferDenied + | TransferFailed + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec TransferErrorCode) + +instance HasCodec TransferErrorCode where + codec = + stringConstCodec $ + NE.fromList + [ (TransferInsufficientFunds, "insufficient_funds"), + (BlockchainError, "blockchain_error"), + (TransferDenied, "transfer_denied"), + (TransferFailed, "transfer_failed") + ] + +--------------------------------------------------------------- +-- Address Types +--------------------------------------------------------------- + +data DepositAddressesRequest + +type instance CircleRequest DepositAddressesRequest = CircleResponseBody [DepositAddressResponseBody] + +data DepositAddressRequest + +type instance CircleRequest DepositAddressRequest = CircleResponseBody DepositAddressResponseBody + +-- | Response body for methods that call the "businessAccount\/wallets\/addresses\/deposit" endpoint +data DepositAddressResponseBody = DepositAddressResponseBody + { depositAddressResponseBodyAddress :: !HexString, + depositAddressResponseBodyAddressTag :: !(Maybe Text), -- The docs say it's on the response, but the sandbox API doesn't return in. Make it a `Maybe` for now. + depositAddressResponseBodyCurrency :: !SupportedCurrencies, + depositAddressResponseBodyChain :: !Chain + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec DepositAddressResponseBody) + +instance HasCodec DepositAddressResponseBody where + codec = + object "DepositAddressResponseBody" $ + DepositAddressResponseBody + <$> requiredField' "address" .= depositAddressResponseBodyAddress + <*> optionalField' "addressTag" .= depositAddressResponseBodyAddressTag + <*> requiredField' "currency" .= depositAddressResponseBodyCurrency + <*> requiredField' "chain" .= depositAddressResponseBodyChain + +-- | Request body for creating a new deposit address +data DepositAddressRequestBody = DepositAddressRequestBody + { depositAddressRequestBodyIdempotencyKey :: !UUID, + depositAddressRequestBodyCurrency :: !SupportedCurrencies, + depositAddressRequestBodyChain :: !Chain + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec DepositAddressRequestBody) + +instance HasCodec DepositAddressRequestBody where + codec = + object "DepositAddressRequestBody" $ + DepositAddressRequestBody + <$> requiredField' "idempotencyKey" .= depositAddressRequestBodyIdempotencyKey + <*> requiredField' "currency" .= depositAddressRequestBodyCurrency + <*> requiredField' "chain" .= depositAddressRequestBodyChain + +data RecipientAddressesRequest + +type instance CircleRequest RecipientAddressesRequest = CircleResponseBody [RecipientAddressResponseBody] + +instance CircleHasParam RecipientAddressesRequest PaginationQueryParams + +instance CircleHasParam RecipientAddressesRequest FromQueryParam + +instance CircleHasParam RecipientAddressesRequest ToQueryParam + +instance CircleHasParam RecipientAddressesRequest PageSizeQueryParam + +data RecipientAddressRequest + +type instance CircleRequest RecipientAddressRequest = CircleResponseBody RecipientAddressResponseBody + +-- | Response body for methods that call the "businessAccount\/wallets\/addresses\/recipient" endpoint +data RecipientAddressResponseBody = RecipientAddressResponseBody + { recipientAddressResponseBodyId :: !UUID, + recipientAddressResponseBodyAddress :: !HexString, + recipientAddressResponseBodyAddressTag :: !(Maybe Text), + recipientAddressResponseBodyChain :: !Chain, + recipientAddressResponseBodyCurrency :: !SupportedCurrencies, + recipientAddressResponseBodyDescription :: !Text + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec RecipientAddressResponseBody) + +instance HasCodec RecipientAddressResponseBody where + codec = + object "RecipientAddressResponseBody" $ + RecipientAddressResponseBody + <$> requiredField' "id" .= recipientAddressResponseBodyId + <*> requiredField' "address" .= recipientAddressResponseBodyAddress + <*> optionalField' "addressTag" .= recipientAddressResponseBodyAddressTag + <*> requiredField' "chain" .= recipientAddressResponseBodyChain + <*> requiredField' "currency" .= recipientAddressResponseBodyCurrency + <*> requiredField' "description" .= recipientAddressResponseBodyDescription + +-- | Request body for creating a new recipient address +data RecipientAddressRequestBody = RecipientAddressRequestBody + { recipientAddressRequestBodyIdempotencyKey :: !UUID, + recipientAddressRequestBodyAddress :: !HexString, + recipientAddressRequestBodyAddressTag :: !(Maybe Text), + recipientAddressRequestBodyChain :: !Chain, + recipientAddressRequestBodyCurrency :: !SupportedCurrencies, + recipientAddressRequestBodyDescription :: !Text + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec RecipientAddressRequestBody) + +instance HasCodec RecipientAddressRequestBody where + codec = + object "RecipientAddressRequestBody" $ + RecipientAddressRequestBody + <$> requiredField' "idempotencyKey" .= recipientAddressRequestBodyIdempotencyKey + <*> requiredField' "address" .= recipientAddressRequestBodyAddress + <*> optionalField' "addressTag" .= recipientAddressRequestBodyAddressTag + <*> requiredField' "chain" .= recipientAddressRequestBodyChain + <*> requiredField' "currency" .= recipientAddressRequestBodyCurrency + <*> requiredField' "description" .= recipientAddressRequestBodyDescription + +--------------------------------------------------------------- +-- Deposit Types +--------------------------------------------------------------- + +data DepositsRequest + +type instance CircleRequest DepositsRequest = CircleResponseBody [DepositResponseBody] + +instance CircleHasParam DepositsRequest TypeQueryParam + +instance CircleHasParam DepositsRequest PaginationQueryParams + +instance CircleHasParam DepositsRequest FromQueryParam + +instance CircleHasParam DepositsRequest ToQueryParam + +instance CircleHasParam DepositsRequest PageSizeQueryParam + +-- | Response body for methods that call the "businessAccount\/deposits" endpoint +data DepositResponseBody = DepositResponseBody + { depositResponseBodyId :: !UUID, + depositResponseBodySourceWalletId :: !(Maybe WalletId), + depositResponseBodyDestination :: !DestinationWallet, + depositResponseBodyAmount :: !MoneyAmount, + depositResponseBodyFee :: !MoneyAmount, + depositResponseBodyStatus :: !Status, + depositResponseBodyRiskEvaluation :: !(Maybe RiskEvaluation), + depositResponseBodyCreateDate :: !UTCTime, + depositResponseBodyUpdateDate :: !(Maybe UTCTime) + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec DepositResponseBody) + +instance HasCodec DepositResponseBody where + codec = + object "DepositResponseBody" $ + DepositResponseBody + <$> requiredField' "id" .= depositResponseBodyId + <*> optionalField' "sourceWalletId" .= depositResponseBodySourceWalletId + <*> requiredField' "destination" .= depositResponseBodyDestination + <*> requiredField' "amount" .= depositResponseBodyAmount + <*> requiredField' "fee" .= depositResponseBodyFee + <*> requiredField' "status" .= depositResponseBodyStatus + <*> requiredField' "riskEvaluation" .= depositResponseBodyRiskEvaluation + <*> requiredField' "createDate" .= depositResponseBodyCreateDate + <*> requiredField' "updateDate" .= depositResponseBodyUpdateDate + +--------------------------------------------------------------- +-- Mock Payment Types +--------------------------------------------------------------- + +data MockPaymentRequest + +type instance CircleRequest MockPaymentRequest = CircleResponseBody MockPaymentResponseBody + +-- | Response body for methods that call the "mock\/payments\/*" endpoint +data MockPaymentResponseBody = MockPaymentResponseBody + { mockPaymentResponseBodyTrackingRef :: !(Maybe TrackingReference), + mockPaymentResponseBodyAmount :: !(Maybe MoneyAmount), + mockPaymentResponseBodyBeneficiaryBank :: !(Maybe BeneficiaryBankDetails), + mockPaymentResponseBodyStatus :: !(Maybe Status) + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec MockPaymentResponseBody) + +instance HasCodec MockPaymentResponseBody where + codec = + object "MockPaymentResponseBody" $ + MockPaymentResponseBody + <$> optionalField' "trackingRef" .= mockPaymentResponseBodyTrackingRef + <*> optionalField' "amount" .= mockPaymentResponseBodyAmount + <*> optionalField' "beneficiaryBank" .= mockPaymentResponseBodyBeneficiaryBank + <*> optionalField' "status" .= mockPaymentResponseBodyStatus + +-- | Request body to create a mock SEN or Wire payment (in the sandbox only). +data MockSenOrWirePaymentRequestBody = MockSenOrWirePaymentRequestBody + { mockSenOrWirePaymentRequestBodyTrackingRef :: !TrackingReference, + mockSenOrWirePaymentRequestBodyAmount :: !MoneyAmount, + mockSenOrWirePaymentRequestBodyBeneficiaryBank :: !MockBeneficiaryBankDetails + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec MockSenOrWirePaymentRequestBody) + +instance HasCodec MockSenOrWirePaymentRequestBody where + codec = + object "MockSenOrWirePaymentRequestBody" $ + MockSenOrWirePaymentRequestBody + <$> requiredField' "trackingRef" .= mockSenOrWirePaymentRequestBodyTrackingRef + <*> requiredField' "amount" .= mockSenOrWirePaymentRequestBodyAmount + <*> requiredField' "beneficiaryBank" .= mockSenOrWirePaymentRequestBodyBeneficiaryBank + +-- | Request body to create a mock SEPA payment (in the sandbox only). +data MockSEPAPaymentRequestBody = MockSEPAPaymentRequestBody + { mockSEPAPaymentRequestBodyTrackingRef :: !TrackingReference, + mockSEPAPaymentRequestBodyAmount :: !MoneyAmount + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec MockSEPAPaymentRequestBody) + +instance HasCodec MockSEPAPaymentRequestBody where + codec = + object "MockSEPAPaymentRequestBody" $ + MockSEPAPaymentRequestBody + <$> requiredField' "trackingRef" .= mockSEPAPaymentRequestBodyTrackingRef + <*> requiredField' "amount" .= mockSEPAPaymentRequestBodyAmount + +newtype MockBeneficiaryBankDetails = MockBeneficiaryBankDetails {mockBeneficiaryBankDetailsAccountNumber :: AccountNumber} + deriving (Eq, Show, ToJSON, FromJSON) + +instance HasCodec MockBeneficiaryBankDetails where + codec = dimapCodec MockBeneficiaryBankDetails mockBeneficiaryBankDetailsAccountNumber codec + +--------------------------------------------------------------- +-- Silvergate SEN Types +--------------------------------------------------------------- + +data SENAccountRequest + +type instance CircleRequest SENAccountRequest = CircleResponseBody SENAccountResponseBody + +data SENAccountsRequest + +type instance CircleRequest SENAccountsRequest = CircleResponseBody [SENAccountResponseBody] + +data SENInstructionsRequest + +type instance CircleRequest SENInstructionsRequest = CircleResponseBody SENInstructionsResponseData + +-- | Request body to create a Silvergate SEN account. +data SENAccountRequestBody = SENAccountRequestBody + { senAccountRequestBodyIdempotencyKey :: !UUID, + senAccountRequestBodyAccountNumber :: !AccountNumber, + senAccountRequestBodyCurrency :: !(Maybe SupportedCurrencies) + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec SENAccountRequestBody) + +instance HasCodec SENAccountRequestBody where + codec = + object "SENAccountRequestBody" $ + SENAccountRequestBody + <$> requiredField' "idempotencyKey" .= senAccountRequestBodyIdempotencyKey + <*> requiredField' "accountNumber" .= senAccountRequestBodyAccountNumber + <*> optionalField' "currency" .= senAccountRequestBodyCurrency + +-- | Response body for methods that call the "businessAccount\/banks\/sen" endpoint +data SENAccountResponseBody = SENAccountResponseBody + { senAccountResponseBodyId :: !UUID, + senAccountResponseBodyStatus :: !Status, + senAccountResponseBodyDescription :: !Text, -- TODO better type: Bank name plus last four digits of the bank account number or IBAN. Make a custom type for this + senAccountResponseBodyTrackingRef :: !TrackingReference, + senAccountResponseBodyCreateDate :: !UTCTime, + senAccountResponseBodyUpdateDate :: !UTCTime, + senAccountResponseBodyCurrency :: !(Maybe SupportedCurrencies) + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec SENAccountResponseBody) + +instance HasCodec SENAccountResponseBody where + codec = + object "SENAccountResponseBody" $ + SENAccountResponseBody + <$> requiredField' "id" .= senAccountResponseBodyId + <*> requiredField' "status" .= senAccountResponseBodyStatus + <*> requiredField' "description" .= senAccountResponseBodyDescription + <*> requiredField' "trackingRef" .= senAccountResponseBodyTrackingRef + <*> requiredField' "createDate" .= senAccountResponseBodyCreateDate + <*> requiredField' "updateDate" .= senAccountResponseBodyUpdateDate + <*> optionalField' "currency" .= senAccountResponseBodyCurrency + +data SENInstructionsResponseData = SENInstructionsResponseData + { senInstructionsResponseDataTrackingRef :: !TrackingReference, + senInstructionsResponseDataAccountNumber :: !AccountNumber, + senInstructionsResponseDataCurrency :: !SupportedCurrencies + } + deriving stock (Eq, Show, Generic) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec SENInstructionsResponseData) + +instance HasCodec SENInstructionsResponseData where + codec = + object "SENInstructionsResponseData" $ + SENInstructionsResponseData + <$> requiredField' "trackingRef" .= senInstructionsResponseDataTrackingRef + <*> requiredField' "accountNumber" .= senInstructionsResponseDataAccountNumber + <*> requiredField' "currency" .= senInstructionsResponseDataCurrency + +--------------------------------------------------------------- +-- Signet Bank Account Types +--------------------------------------------------------------- + +data SignetBankAccountRequest + +type instance CircleRequest SignetBankAccountRequest = CircleResponseBody SignetBankAccountResponseData + +data SignetBankAccountsRequest + +type instance CircleRequest SignetBankAccountsRequest = CircleResponseBody [SignetBankAccountResponseData] + +data SignetBankInstructionsRequest + +type instance CircleRequest SignetBankInstructionsRequest = CircleResponseBody SignetBankInstructionsResponseData + +-- | Request body to create Signet Bank bank account. +data SignetBankAccountRequestBody = SignetBankAccountRequestBody + { signetBankAccountRequestBodyIdempotencyKey :: !UUID, + signetBankAccountRequestBodyWalletAddress :: !HexString + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec SignetBankAccountRequestBody) + +instance HasCodec SignetBankAccountRequestBody where + codec = + object "SignetBankAccountRequestBody" $ + SignetBankAccountRequestBody + <$> requiredField' "idempotencyKey" .= signetBankAccountRequestBodyIdempotencyKey + <*> requiredField' "walletAddress" .= signetBankAccountRequestBodyWalletAddress + +-- | Response body for methods that call the "businessAccount\/banks\/signet" endpoint +data SignetBankAccountResponseData = SignetBankAccountResponseData + { signetBankAccountId :: !UUID, + signetBankAccountStatus :: !Status, + signetBankAccountTrackingRef :: !TrackingReference, + signetBankAccountWalletAddress :: !HexString, + signetBankAccountCreateDate :: !UTCTime, + signetBankAccountUpdateDate :: !UTCTime + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec SignetBankAccountResponseData) + +instance HasCodec SignetBankAccountResponseData where + codec = + object "SignetBankAccountResponseData" $ + SignetBankAccountResponseData + <$> requiredField' "id" .= signetBankAccountId + <*> requiredField' "status" .= signetBankAccountStatus + <*> requiredField' "trackingRef" .= signetBankAccountTrackingRef + <*> requiredField' "walletAddress" .= signetBankAccountWalletAddress + <*> requiredField' "createDate" .= signetBankAccountCreateDate + <*> requiredField' "updateDate" .= signetBankAccountUpdateDate + +data SignetBankInstructionsResponseData = SignetBankInstructionsResponseData + { signetBankInstructionsTrackingRef :: !(Maybe TrackingReference), + signetBankInstructionsWalletAddress :: !(Maybe HexString) + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec SignetBankInstructionsResponseData) + +instance HasCodec SignetBankInstructionsResponseData where + codec = + object "SignetBankInstructionsResponseData" $ + SignetBankInstructionsResponseData + <$> optionalField' "trackingRef" .= signetBankInstructionsTrackingRef + <*> optionalField' "walletAddress" .= signetBankInstructionsWalletAddress + +--------------------------------------------------------------- +-- Wire Account Types +--------------------------------------------------------------- + +data WireAccountRequest + +type instance CircleRequest WireAccountRequest = CircleResponseBody WireAccountResponseBody + +data WireAccountsRequest + +type instance CircleRequest WireAccountsRequest = CircleResponseBody [WireAccountResponseBody] + +data WireInstructionsRequest + +type instance CircleRequest WireInstructionsRequest = CircleResponseBody WireInstructionsResponseData + +instance CircleHasParam WireInstructionsRequest PaginationQueryParams + +-- | Request body to create a wire account. Sum type because this endpoint supports several +-- different types of wire accounts. +data WireAccountRequestBody + = USBankAccount !USBankAccountRequestBody + | IBANBankAccount !IBANBankAccountRequestBody + | NonIBANBankAccount !NonIBANBankAccountRequestBody + deriving (Eq, Show) + +data USBankAccountRequestBody = USBankAccountRequestBody + { usBankAccountIdempotencyKey :: !UUID, + usBankAccountAccountNumber :: !AccountNumber, + usBankAccountRoutingNumber :: !RoutingNumber, + usBankAccountBillingDetails :: !BillingDetails, + usBankAccountBankAddress :: !BankAddress + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec USBankAccountRequestBody) + +instance HasCodec USBankAccountRequestBody where + codec = + object "USBankAccountRequestBody" $ + USBankAccountRequestBody + <$> requiredField' "idempotencyKey" .= usBankAccountIdempotencyKey + <*> requiredField' "accountNumber" .= usBankAccountAccountNumber + <*> requiredField' "routingNumber" .= usBankAccountRoutingNumber + <*> requiredField' "billingDetails" .= usBankAccountBillingDetails + <*> requiredField' "bankAddress" .= usBankAccountBankAddress + +data IBANBankAccountRequestBody = IBANBankAccountRequestBody + { ibanBankAccountIdempotencyKey :: !UUID, + ibanBankAccountIBAN :: !Iban, + ibanBankAccountBillingDetails :: !BillingDetails, + ibanBankAccountBankAddress :: !BankAddress + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec IBANBankAccountRequestBody) + +instance HasCodec IBANBankAccountRequestBody where + codec = + object "IBANBankAccountRequestBody" $ + IBANBankAccountRequestBody + <$> requiredField' "idempotencyKey" .= ibanBankAccountIdempotencyKey + <*> requiredField' "iban" .= ibanBankAccountIBAN + <*> requiredField' "billingDetails" .= ibanBankAccountBillingDetails + <*> requiredField' "bankAddress" .= ibanBankAccountBankAddress + +data NonIBANBankAccountRequestBody = NonIBANBankAccountRequestBody + { nonIBANBankAccountIdempotencyKey :: !UUID, + nonIBANBankAccountAccountNumber :: !AccountNumber, + nonIBANBankAccountRoutingNumber :: !RoutingNumber, + nonIBANBankAccountBillingDetails :: !BillingDetails, + nonIBANBankAccountBankAddress :: !BankAddress + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec NonIBANBankAccountRequestBody) + +instance HasCodec NonIBANBankAccountRequestBody where + codec = + object "NonIBANBankAccountRequestBody" $ + NonIBANBankAccountRequestBody + <$> requiredField' "idempotencyKey" .= nonIBANBankAccountIdempotencyKey + <*> requiredField' "accountNumber" .= nonIBANBankAccountAccountNumber + <*> requiredField' "routingNumber" .= nonIBANBankAccountRoutingNumber + <*> requiredField' "billingDetails" .= nonIBANBankAccountBillingDetails + <*> requiredField' "bankAddress" .= nonIBANBankAccountBankAddress + +-- | Response body for `getWireAccountInstructions` +data WireInstructionsResponseData = WireInstructionsResponseData + { wireInstructionsResponseDataTrackingRef :: !TrackingReference, + wireInstructionsResponseDataBeneficiaryDetails :: !BeneficiaryDetails, + wireInstructionsResponseDataBeneficiaryBankDetails :: !BeneficiaryBankDetails + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec WireInstructionsResponseData) + +instance HasCodec WireInstructionsResponseData where + codec = + object "WireInstructionsResponseData" $ + WireInstructionsResponseData + <$> requiredField' "trackingRef" .= wireInstructionsResponseDataTrackingRef + <*> requiredField' "beneficiary" .= wireInstructionsResponseDataBeneficiaryDetails + <*> requiredField' "beneficiaryBank" .= wireInstructionsResponseDataBeneficiaryBankDetails + +-- | Response body for methods that call the "\/wires" or "businessAccount\/wires" endpoints +data WireAccountResponseBody = WireAccountResponseBody + { wireAccountResponseBodyId :: !UUID, + wireAccountResponseBodyStatus :: !Status, + wireAccountResponseBodyDescription :: !Text, -- TODO better type: Bank name plus last four digits of the bank account number or IBAN. Make a custom type for this + wireAccountResponseBodyTrackingRef :: !TrackingReference, + wireAccountResponseBodyFingerprint :: !UUID, + wireAccountResponseBodyBillingDetails :: !BillingDetails, + wireAccountResponseBodyBankAddress :: !BankAddress, + wireAccountResponseBodyCreateDate :: !UTCTime, + wireAccountResponseBodyUpdateDate :: !UTCTime + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec WireAccountResponseBody) + +instance HasCodec WireAccountResponseBody where + codec = + object "WireAccountResponseBody" $ + WireAccountResponseBody + <$> requiredField' "id" .= wireAccountResponseBodyId + <*> requiredField' "status" .= wireAccountResponseBodyStatus + <*> requiredField' "description" .= wireAccountResponseBodyDescription + <*> requiredField' "trackingRef" .= wireAccountResponseBodyTrackingRef + <*> requiredField' "fingerprint" .= wireAccountResponseBodyFingerprint + <*> requiredField' "billingDetails" .= wireAccountResponseBodyBillingDetails + <*> requiredField' "bankAddress" .= wireAccountResponseBodyBankAddress + <*> requiredField' "createDate" .= wireAccountResponseBodyCreateDate + <*> requiredField' "updateDate" .= wireAccountResponseBodyUpdateDate + +--------------------------------------------------------------- +-- Payment Types +--------------------------------------------------------------- + +data PaymentRequest + +type instance CircleRequest PaymentRequest = CircleResponseBody (ThisOrThat FiatOrCryptoPaymentResponseBody FiatCancelOrRefundResponseBody) + +data PaymentsRequest + +type instance CircleRequest PaymentsRequest = CircleResponseBody [ThisOrThat FiatOrCryptoPaymentResponseBody FiatCancelOrRefundResponseBody] + +instance CircleHasParam PaymentsRequest PaginationQueryParams + +instance CircleHasParam PaymentsRequest FromQueryParam + +instance CircleHasParam PaymentsRequest ToQueryParam + +instance CircleHasParam PaymentsRequest PageSizeQueryParam + +instance CircleHasParam PaymentsRequest PaymentStatusQueryParams + +instance CircleHasParam PaymentsRequest TypeQueryParam + +instance CircleHasParam PaymentsRequest DestinationQueryParam + +instance CircleHasParam PaymentsRequest SourceQueryParam + +instance CircleHasParam PaymentsRequest SettlementIdQueryParam + +instance CircleHasParam PaymentsRequest PaymentIntentIdQueryParam + +-- | Request body to create any kind of payment. +data CreatePaymentRequestBody = CreatePaymentRequestBody + { createPaymentIdempotencyKey :: !UUID, + createPaymentKeyId :: !Text, -- TODO this is actually a UUID, but in Sandbox it has to be `key1`. Figure out how to reconcile this later. + requestMetadata :: !RequestMetadata, + createPaymentAmount :: !MoneyAmount, + createPaymentAutoCapture :: !(Maybe Bool), + createPaymentVerification :: !VerificationType, + -- | The following two fields are only present if VerificationType = ThreeDSecure + createPaymentVerificationSuccessUrl :: !(Maybe URL), + createPaymentVerificationFailureUrl :: !(Maybe URL), + createPaymentSource :: !PaymentSource, + createPaymentDescription :: !(Maybe Text), + -- | This encrypted data needs to encrypt the card CVV + createPaymentEncryptedData :: !(Maybe Text), + createPaymentChannel :: !(Maybe UUID) + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec CreatePaymentRequestBody) + +instance HasCodec CreatePaymentRequestBody where + codec = + object "CreatePaymentRequestBody" $ + CreatePaymentRequestBody + <$> requiredField' "idempotencyKey" .= createPaymentIdempotencyKey + <*> requiredField' "keyId" .= createPaymentKeyId + <*> requiredField' "metadata" .= requestMetadata + <*> requiredField' "amount" .= createPaymentAmount + <*> optionalField' "autoCapture" .= createPaymentAutoCapture + <*> requiredField' "verification" .= createPaymentVerification + <*> optionalField' "verificationSuccessfulUrl" .= createPaymentVerificationSuccessUrl + <*> optionalField' "verificationFailureUrl" .= createPaymentVerificationFailureUrl + <*> requiredField' "source" .= createPaymentSource + <*> optionalField' "description" .= createPaymentDescription + <*> optionalField' "encryptedData" .= createPaymentEncryptedData + <*> optionalField' "channel" .= createPaymentChannel + +data RequestMetadata = RequestMetadata + { requestMetadataEmail :: !Email, + requestMetadataPhoneNumber :: !(Maybe PhoneNumber), + requestMetadataSessionId :: !SessionId, + requestMetadataIpAddress :: !IPAddress + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec RequestMetadata) + +newtype SessionId = SessionId + { unSessionId :: Text -- TODO consider validating if necessary + } + deriving (Eq, Show, ToJSON, FromJSON) + +instance HasCodec SessionId where + codec = dimapCodec SessionId unSessionId codec + +newtype IPAddress = IPAddress + { unIPAddress :: Text -- TODO consider validating if necessary + } + deriving (Eq, Show, ToJSON, FromJSON) + +instance HasCodec IPAddress where + codec = dimapCodec IPAddress unIPAddress codec + +newtype PhoneNumber = PhoneNumber + { unPhoneNumber :: Text -- TODO consider validating if necessary + } + deriving (Eq, Show, ToJSON, FromJSON) + +instance HasCodec PhoneNumber where + codec = dimapCodec PhoneNumber unPhoneNumber codec + +instance HasCodec RequestMetadata where + codec = + object "RequestMetadata" $ + RequestMetadata + <$> requiredField' "email" .= requestMetadataEmail + <*> optionalField' "phoneNumber" .= requestMetadataPhoneNumber + <*> requiredField' "sessionId" .= requestMetadataSessionId + <*> requiredField' "ipAddress" .= requestMetadataIpAddress + +data PaymentErrorCode + = PaymentFailedErrorCode + | PaymentFraudDetected + | PaymentDenied + | PaymentNotSupportedByIssuer + | PaymentNotFunded + | PaymentUnprocessable + | PaymentStoppedByIssuer + | PaymentCanceled + | PaymentReturned + | PaymentFailedBalanceCheck + | CardFailed + | CardInvalid + | CardAddressMismatch + | CardZipMismatch + | CardCvvInvalid + | CardExpired + | CardLimitViolated + | CardNotHonored + | CardCvvRequired + | CardRestricted + | CardAccountIneligible + | CardNetworkUnsupported + | ChannelInvalid + | UnauthorizedTransaction + | BankAccountIneligible + | PaymentBankTransactionError + | InvalidAccountNumber + | InvalidWireRtn + | InvalidAchRtn + | RefIdInvalid + | AccountNameMismatch + | AccountNumberMismatch + | AccountIneligible + | WalletAddressMismatch + | CustomerNameMismatch + | InstitutionNameMismatch + | PaymentVendorInactive + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec PaymentErrorCode) + +instance HasCodec PaymentErrorCode where + codec = + stringConstCodec $ + NE.fromList + [ (PaymentFailedErrorCode, "payment_failed"), + (PaymentFraudDetected, "payment_fraud_detected"), + (PaymentDenied, "payment_denied"), + (PaymentNotSupportedByIssuer, "payment_not_supported_by_issuer"), + (PaymentNotFunded, "payment_not_funded"), + (PaymentUnprocessable, "payment_unprocessable"), + (PaymentStoppedByIssuer, "payment_stopped_by_issuer"), + (PaymentCanceled, "payment_canceled"), + (PaymentReturned, "payment_returned"), + (PaymentFailedBalanceCheck, "payment_failed_balance_check"), + (CardFailed, "card_failed"), + (CardInvalid, "card_invalid"), + (CardAddressMismatch, "card_address_mismatch"), + (CardZipMismatch, "card_zip_mismatch"), + (CardCvvInvalid, "card_cvv_invalid"), + (CardExpired, "card_expired"), + (CardLimitViolated, "card_limit_violated"), + (CardNotHonored, "card_not_honored"), + (CardCvvRequired, "card_cvv_required"), + (CardRestricted, "card_restricted"), + (CardAccountIneligible, "card_account_ineligible"), + (CardNetworkUnsupported, "card_network_unsupported"), + (ChannelInvalid, "channel_invalid"), + (UnauthorizedTransaction, "unauthorized_transaction"), + (BankAccountIneligible, "bank_account_ineligible"), + (PaymentBankTransactionError, "bank_transaction_error"), + (InvalidAccountNumber, "invalid_account_number"), + (InvalidWireRtn, "invalid_wire_rtn"), + (InvalidAchRtn, "invalid_ach_rtn"), + (RefIdInvalid, "ref_id_invalid"), + (AccountNameMismatch, "account_name_mismatch"), + (AccountNumberMismatch, "account_number_mismatch"), + (AccountIneligible, "account_ineligible"), + (WalletAddressMismatch, "wallet_address_mismatch"), + (CustomerNameMismatch, "customer_name_mismatch"), + (InstitutionNameMismatch, "institution_name_mismatch"), + (PaymentVendorInactive, "vendor_inactive") + ] + +-- TODO could likely make a better abstraction here. + +-- | A FiatOrCryptoPaymentResponseBody object represents a fiat or crypto payment. These payments look identical +-- except for the "Description" field, and the fact that a FiatPayment could have response verification data, whereas +-- a crypto payment could have info about the deposit address, transaction hash etc. +-- I'd love to differentiate these fields based on what I can parse from JSON, but there's enough overlap between +-- the two response bodies that I can cheat for now. +data FiatOrCryptoPaymentResponseBody = FiatOrCryptoPaymentResponseBody + { -- the following fields will be present on every response + fiatOrCryptoPaymentId :: !UUID, + fiatOrCryptoPaymentType :: !PaymentType, + fiatOrCryptoPaymentMerchantId :: !UUID, + fiatOrCryptoPaymentMerchantWalletId :: !WalletId, + fiatOrCryptoPaymentAmount :: !MoneyAmount, + fiatOrCryptoPaymentSource :: !PaymentSource, + fiatOrCryptoPaymentDescription :: !Text, + fiatOrCryptoPaymentStatus :: !PaymentStatus, + -- the following fields will only be present on Crypto payments + fiatOrCryptoPaymentPaymentIntentId :: !(Maybe UUID), + fiatOrCryptoPaymentSettlementAmount :: !(Maybe MoneyAmount), + fiatOrCryptoPaymentDepositAddress :: !(Maybe PaymentDepositAddress), + fiatOrCryptoPaymentTransactionHash :: !(Maybe HexString), + -- the following fields will only be present on fiat payments + fiatOrCryptoPaymentVerification :: !(Maybe VerificationData), + fiatOrCryptoPaymentCaptured :: !(Maybe Bool), + fiatOrCryptoPaymentCaptureAmount :: !(Maybe MoneyAmount), + fiatOrCryptoPaymentCaptureDate :: !(Maybe UTCTime), + fiatOrCryptoPaymentRequiredAction :: !(Maybe PaymentActionRequired), + fiatOrCryptoPaymentCancel :: !(Maybe FiatCancelOrRefundResponseBody), + fiatOrCryptoPaymentRefunds :: !(Maybe [FiatCancelOrRefundResponseBody]), + fiatOrCryptoPaymentFees :: !(Maybe MoneyAmount), + fiatOrCryptoPaymentChannel :: !(Maybe UUID), + fiatOrCryptoPaymentCreateDate :: !(Maybe UTCTime), + fiatOrCryptoPaymentUpdateDate :: !(Maybe UTCTime), + fiatOrCryptoPaymentTrackingRef :: !(Maybe TrackingReference), + fiatOrCryptoPaymentErrorCode :: !(Maybe PaymentErrorCode), + fiatOrCryptoMetadata :: !(Maybe ResponseMetadata), + fiatOrCryptoPaymentRiskEvaluation :: !(Maybe RiskEvaluation) + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec FiatOrCryptoPaymentResponseBody) + +instance HasCodec FiatOrCryptoPaymentResponseBody where + codec = + object "FiatOrCryptoPaymentResponseBody" $ + FiatOrCryptoPaymentResponseBody + <$> requiredField' "id" .= fiatOrCryptoPaymentId + <*> requiredField' "type" .= fiatOrCryptoPaymentType + <*> requiredField' "merchantId" .= fiatOrCryptoPaymentMerchantId + <*> requiredField' "merchantWalletId" .= fiatOrCryptoPaymentMerchantWalletId + <*> requiredField' "amount" .= fiatOrCryptoPaymentAmount + <*> requiredField' "source" .= fiatOrCryptoPaymentSource + <*> requiredField' "description" .= fiatOrCryptoPaymentDescription + <*> requiredField' "status" .= fiatOrCryptoPaymentStatus + <*> optionalField' "paymentIntentId" .= fiatOrCryptoPaymentPaymentIntentId + <*> optionalField' "settlementAmount" .= fiatOrCryptoPaymentSettlementAmount + <*> optionalField' "depositAddress" .= fiatOrCryptoPaymentDepositAddress + <*> optionalField' "transactionHash" .= fiatOrCryptoPaymentTransactionHash + <*> optionalField' "verification" .= fiatOrCryptoPaymentVerification + <*> optionalField' "captured" .= fiatOrCryptoPaymentCaptured + <*> optionalField' "captureAmount" .= fiatOrCryptoPaymentCaptureAmount + <*> optionalField' "captureDate" .= fiatOrCryptoPaymentCaptureDate + <*> optionalField' "requiredAction" .= fiatOrCryptoPaymentRequiredAction + <*> optionalField' "cancel" .= fiatOrCryptoPaymentCancel + <*> optionalField' "refunds" .= fiatOrCryptoPaymentRefunds + <*> optionalField' "fees" .= fiatOrCryptoPaymentFees + <*> optionalField' "channel" .= fiatOrCryptoPaymentChannel + <*> optionalField' "createDate" .= fiatOrCryptoPaymentCreateDate + <*> optionalField' "updateDate" .= fiatOrCryptoPaymentUpdateDate + <*> optionalField' "trackingRef" .= fiatOrCryptoPaymentTrackingRef + <*> optionalField' "errorCode" .= fiatOrCryptoPaymentErrorCode + <*> optionalField' "metadata" .= fiatOrCryptoMetadata + <*> optionalField' "channel" .= fiatOrCryptoPaymentRiskEvaluation + +data ResponseMetadata = ResponseMetadata + { responseMetadataEmail :: !Email, + responseMetadataPhoneNumber :: !(Maybe PhoneNumber) + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec ResponseMetadata) + +instance HasCodec ResponseMetadata where + codec = + object "ResponseMetadata" $ + ResponseMetadata + <$> requiredField' "email" .= responseMetadataEmail + <*> optionalField' "phoneNumber" .= responseMetadataPhoneNumber + +data VerificationData = VerificationData + { verificationAVS :: !AVS, + verificationCVV :: !CVV + } + deriving (Eq, Show, Generic) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec VerificationData) + +instance HasCodec VerificationData where + codec = + object "VerificationData" $ + VerificationData + <$> requiredField "avs" "Represents the raw AVS response, expressed as an upper-case letter." .= verificationAVS + <*> requiredField "cvv" "Represents the CVV response" .= verificationCVV + +data AVS = AVSNotRequested | AVSPending | Y | N + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec AVS) + +instance HasCodec AVS where + codec = stringConstCodec $ NE.fromList [(AVSNotRequested, "not_requested"), (AVSPending, "pending"), (Y, "Y"), (N, "N")] + +data CVV = CVVNotRequested | CVVPass | CVVFail | CVVUnavailable | CVVPending + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec CVV) + +instance HasCodec CVV where + codec = stringConstCodec $ NE.fromList [(CVVNotRequested, "not_requested"), (CVVPending, "pending"), (CVVPass, "pass"), (CVVFail, "fail"), (CVVUnavailable, "unavailable")] + +data PaymentDepositAddress = PaymentDepositAddress + { paymentDepositAddressChain :: !Chain, + paymentDepositAddressAddress :: !HexString + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec PaymentDepositAddress) + +instance HasCodec PaymentDepositAddress where + codec = + object "PaymentDepositAddress" $ + PaymentDepositAddress + <$> requiredField' "chain" .= paymentDepositAddressChain + <*> requiredField' "address" .= paymentDepositAddressAddress + +-- | A FiatCancelOrRefundResponseBody object represents an attempt at canceling or refunding a payment. +-- Cancellations apply only to card payments, and its presence doesn't necessarily mean that the cancellation was successful. +-- A successful cancellation has a status of paid, a successful refund has a status of confirmed. +data FiatCancelOrRefundResponseBody = FiatCancelOrRefundResponseBody + { -- TODO I could likely do some better data modeling here, there's a ton of shared fields between these + -- types so I kinda cheated and just made one mega type with maybes, but it'll be more ergonomic for devs + -- to have a specific type that's generated from the parsing. The tricky part is the differentiator is the + -- field `type`, so I think I'll need to be clever about this. + fiatCancelOrRefundResponseBodyId :: !UUID, + fiatCancelOrRefundResponseBodyType :: !PaymentType, + fiatCancelOrRefundResponseBodyMerchantId :: !UUID, + fiatCancelOrRefundResponseBodyMerchantWalletId :: !WalletId, + fiatCancelOrRefundResponseBodyAmount :: !MoneyAmount, + fiatCancelOrRefundResponseBodySource :: !PaymentSource, + fiatCancelOrRefundResponseBodyDescription :: !Text, + fiatCancelOrRefundResponseBodyStatus :: !PaymentStatus, + fiatCancelOrRefundResponseBodyOriginalPayment :: !OriginalFiatPayment, + fiatCancelOrRefundResponseBodyFees :: !(Maybe MoneyAmount), + fiatCancelOrRefundResponseBodyChannel :: !(Maybe Text), + fiatCancelOrRefundResponseBodyReason :: !(Maybe CancelPaymentReason), + fiatCancelOrRefundResponseBodyCreateDate :: !UTCTime, + fiatCancelOrRefundResponseBodyUpdateDate :: !UTCTime + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec FiatCancelOrRefundResponseBody) + +instance HasCodec FiatCancelOrRefundResponseBody where + codec = + object "FiatCancelOrRefundResponseBody" $ + FiatCancelOrRefundResponseBody + <$> requiredField' "id" .= fiatCancelOrRefundResponseBodyId + <*> requiredField' "type" .= fiatCancelOrRefundResponseBodyType + <*> requiredField' "merchantId" .= fiatCancelOrRefundResponseBodyMerchantId + <*> requiredField' "merchantWalletId" .= fiatCancelOrRefundResponseBodyMerchantWalletId + <*> requiredField' "amount" .= fiatCancelOrRefundResponseBodyAmount + <*> requiredField' "source" .= fiatCancelOrRefundResponseBodySource + <*> requiredField' "description" .= fiatCancelOrRefundResponseBodyDescription + <*> requiredField' "status" .= fiatCancelOrRefundResponseBodyStatus + <*> requiredField' "originalPayment" .= fiatCancelOrRefundResponseBodyOriginalPayment + <*> optionalField' "fees" .= fiatCancelOrRefundResponseBodyFees + <*> optionalField' "channel" .= fiatCancelOrRefundResponseBodyChannel + <*> optionalField' "reason" .= fiatCancelOrRefundResponseBodyReason + <*> requiredField' "createDate" .= fiatCancelOrRefundResponseBodyCreateDate + <*> requiredField' "updateDate" .= fiatCancelOrRefundResponseBodyUpdateDate + +data OriginalFiatPayment = OriginalFiatPayment + { originalFiatPaymentId :: !UUID, + originalFiatPaymentType :: !PaymentType, + originalFiatPaymentStatus :: !PaymentStatus, + originalFiatPaymentCreateDate :: !UTCTime, + originalFiatPaymentUpdateDate :: !UTCTime, + originalFiatPaymentDescription :: !(Maybe Text), + originalFiatPaymentAmount :: !(Maybe MoneyAmount), + originalFiatPaymentFees :: !(Maybe MoneyAmount), + originalFiatPaymentMerchantId :: !(Maybe UUID), + originalFiatPaymentMerchantWalletId :: !(Maybe WalletId), + originalFiatPaymentSource :: !(Maybe PaymentSource), + originalFiatPaymentTrackingRef :: !(Maybe TrackingReference) + } + deriving (Eq, Show, Generic) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec OriginalFiatPayment) + +instance HasCodec OriginalFiatPayment where + codec = + object "OriginalFiatPayment" $ + OriginalFiatPayment + <$> requiredField' "id" .= originalFiatPaymentId + <*> requiredField' "type" .= originalFiatPaymentType + <*> requiredField' "status" .= originalFiatPaymentStatus + <*> requiredField' "createDate" .= originalFiatPaymentCreateDate + <*> requiredField' "updateDate" .= originalFiatPaymentUpdateDate + <*> optionalField' "description" .= originalFiatPaymentDescription + <*> optionalField' "amount" .= originalFiatPaymentAmount + <*> optionalField' "fees" .= originalFiatPaymentFees + <*> optionalField' "merchantId" .= originalFiatPaymentMerchantId + <*> optionalField' "merchantWalletId" .= originalFiatPaymentMerchantWalletId + <*> optionalField' "source" .= originalFiatPaymentSource + <*> optionalField' "trackingRef" .= originalFiatPaymentTrackingRef + +data PaymentSource = PaymentSource + { paymentSourceId :: !UUID, + paymentSourceType :: !PaymentSourceType + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec PaymentSource) + +instance HasCodec PaymentSource where + codec = + object "PaymentSource" $ + PaymentSource + <$> requiredField' "id" .= paymentSourceId + <*> requiredField' "type" .= paymentSourceType + +data PaymentActionRequired = PaymentActionRequired + { paymentActionRequiredType :: !ActionRequiredType, + paymentActionRequiredRedirectUrl :: !URL + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec PaymentActionRequired) + +instance HasCodec PaymentActionRequired where + codec = + object "PaymentActionRequired" $ + PaymentActionRequired + <$> requiredField' "type" .= paymentActionRequiredType + <*> requiredField' "redirectUrl" .= paymentActionRequiredRedirectUrl + +data ActionRequiredType = ThreeDSecureRequired + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec ActionRequiredType) + +instance HasCodec ActionRequiredType where + codec = stringConstCodec $ NE.fromList [(ThreeDSecureRequired, "three_d_secure_required")] + +data VerificationType = VerificationThreeDSecure | VerificationCVV + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec VerificationType) + +instance HasCodec VerificationType where + codec = stringConstCodec $ NE.fromList [(VerificationThreeDSecure, "three_d_secure"), (VerificationCVV, "cvv")] + +data PaymentType = Payment | Cancel | Refund + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec PaymentType) + +instance HasCodec PaymentType where + codec = stringConstCodec $ NE.fromList [(Payment, "payment"), (Cancel, "cancel"), (Refund, "refund")] + +data PaymentSourceType = Card | ACH | WireSource | SEPA + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec PaymentSourceType) + +instance HasCodec PaymentSourceType where + codec = stringConstCodec $ NE.fromList [(Card, "card"), (ACH, "ach"), (WireSource, "wire"), (SEPA, "sepa")] + +-- | Request body to cancel a fiat payment. +data CancelPaymentRequestBody = CancelPaymentRequestBody + { cancelPaymentIdempotencyKey :: !UUID, + cancelPaymentReason :: !(Maybe CancelPaymentReason) + } + deriving (Eq, Show) + deriving + ( ToJSON, + FromJSON + ) + via (Autodocodec CancelPaymentRequestBody) + +instance HasCodec CancelPaymentRequestBody where + codec = + object "CancelPaymentRequestBody" $ + CancelPaymentRequestBody + <$> requiredField' "idempotencyKey" .= cancelPaymentIdempotencyKey + <*> optionalField' "reason" .= cancelPaymentReason + +data CancelPaymentReason + = CancelPaymentReasonDuplicate + | CancelPaymentReasonFraudulent + | CancelPaymentReasonRequestedByCustomer + | CancelPaymentReasonBankTransactionError + | CancelPaymentReasonInvalidAccountNumber + | CancelPaymentReasonInsufficientFunds + | CancelPaymentReasonPaymentStoppedByIssuer + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec CancelPaymentReason) + +instance HasCodec CancelPaymentReason where + codec = + stringConstCodec $ + NE.fromList + [ (CancelPaymentReasonDuplicate, "duplicate"), + (CancelPaymentReasonFraudulent, "fraudulent"), + (CancelPaymentReasonRequestedByCustomer, "requested_by_customer"), + (CancelPaymentReasonBankTransactionError, "bank_transaction_error"), + (CancelPaymentReasonInvalidAccountNumber, "invalid_account_number"), + (CancelPaymentReasonInsufficientFunds, "insufficient_funds"), + (CancelPaymentReasonPaymentStoppedByIssuer, "payment_stopped_by_issuer") + ] + +-- | Request body to refund a fiat payment. +data RefundPaymentRequestBody = RefundPaymentRequestBody + { refundPaymentIdempotencyKey :: !UUID, + refundPaymentAmount :: !MoneyAmount, + refundPaymentReason :: !(Maybe CancelPaymentReason) + } + deriving (Eq, Show) + deriving + ( ToJSON, + FromJSON + ) + via (Autodocodec RefundPaymentRequestBody) + +instance HasCodec RefundPaymentRequestBody where + codec = + object "RefundPaymentRequestBody" $ + RefundPaymentRequestBody + <$> requiredField' "idempotencyKey" .= refundPaymentIdempotencyKey + <*> requiredField' "amount" .= refundPaymentAmount + <*> optionalField' "reason" .= refundPaymentReason + +--------------------------------------------------------------- +-- On-chain Payment Types +--------------------------------------------------------------- + +data OnChainTransferRequest + +type instance CircleRequest OnChainTransferRequest = CircleResponseBody TransferResponseBody + +instance CircleHasParam OnChainTransferRequest ReturnIdentitiesQueryParam + +data OnChainTransfersRequest + +type instance CircleRequest OnChainTransfersRequest = CircleResponseBody [TransferResponseBody] + +instance CircleHasParam OnChainTransfersRequest PaginationQueryParams + +instance CircleHasParam OnChainTransfersRequest FromQueryParam + +instance CircleHasParam OnChainTransfersRequest ToQueryParam + +instance CircleHasParam OnChainTransfersRequest PageSizeQueryParam + +instance CircleHasParam OnChainTransfersRequest WalletIdQueryParam + +instance CircleHasParam OnChainTransfersRequest SourceWalletIdQueryParam + +instance CircleHasParam OnChainTransfersRequest DestinationWalletIdQueryParam + +instance CircleHasParam OnChainTransfersRequest ReturnIdentitiesQueryParam + +data OnChainAddressRequest + +type instance CircleRequest OnChainAddressRequest = CircleResponseBody DepositAddressResponseBody + +-- | Request body to create an on-chain transfer +data OnChainTransferRequestBody = OnChainTransferRequestBody + { onChainTransferRequestBodyIdempotencyKey :: !UUID, + onChainTransferRequestBodySource :: !SourceWallet, + onChainTransferRequestBodyDestination :: !(ThisOrThat DestinationWallet DestinationBlockchain), + onChainTransferRequestBodyAmount :: !MoneyAmount + } + deriving (Eq, Show) + +instance ToJSON OnChainTransferRequestBody where + toJSON :: OnChainTransferRequestBody -> Aeson.Value + toJSON OnChainTransferRequestBody {..} = + Aeson.object + [ "idempotencyKey" Aeson..= onChainTransferRequestBodyIdempotencyKey, + "source" Aeson..= onChainTransferRequestBodySource, + "destination" Aeson..= onChainTransferRequestBodyDestination, + "amount" Aeson..= onChainTransferRequestBodyAmount + ] + +--------------------------------------------------------------- +-- Card Types +--------------------------------------------------------------- + +data CardsRequest + +type instance CircleRequest CardsRequest = CircleResponseBody [ListCardResponseBody] + +instance CircleHasParam CardsRequest PaginationQueryParams + +instance CircleHasParam CardsRequest PageSizeQueryParam + +data CardRequest + +type instance CircleRequest CardRequest = CircleResponseBody CardResponseBody + +-- | Response body for `listAllCards` +data ListCardResponseBody = ListCardResponseBody + { listCardId :: !UUID, + listCardStatus :: !Status, + listCardBillingDetails :: !ListCardBillingDetails, + listCardExpiryMonth :: !Int, + listCardExpiryYear :: !Int, + listCardNetwork :: !CardNetwork, + listCardBin :: !(Maybe Text), -- first 6 digits of the Card, should be a custom newtype + listCardIssuerCountry :: !(Maybe ISO3166Alpha2), + listCardFingerprint :: !UUID, + listCardVerification :: !VerificationData, + listCardRiskEvaluation :: !(Maybe RiskEvaluation), + listCardCreateDate :: !UTCTime, + listCardUpdateDate :: !UTCTime + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec ListCardResponseBody) + +instance HasCodec ListCardResponseBody where + codec = + object "ListCardResponseBody" $ + ListCardResponseBody + <$> requiredField' "id" .= listCardId + <*> requiredField' "status" .= listCardStatus + <*> requiredField' "billingDetails" .= listCardBillingDetails + <*> requiredField' "expMonth" .= listCardExpiryMonth + <*> requiredField' "expYear" .= listCardExpiryYear + <*> requiredField' "network" .= listCardNetwork + <*> optionalField' "bin" .= listCardBin + <*> optionalField' "issuerCountry" .= listCardIssuerCountry + <*> requiredField' "fingerprint" .= listCardFingerprint + <*> requiredField' "verification" .= listCardVerification + <*> optionalField' "riskEvaluation" .= listCardRiskEvaluation + <*> requiredField' "createDate" .= listCardCreateDate + <*> requiredField' "updateDate" .= listCardUpdateDate + +-- | Response body for methods that interface with an individual card: `createCard`, `getCard`, and `updateCard` +data CardResponseBody = CardResponseBody + { cardId :: !UUID, + cardStatus :: !Status, + cardBillingDetails :: !BillingDetails, + cardExpiryMonth :: !Int, + cardExpiryYear :: !Int, + cardNetwork :: !CardNetwork, + cardLast4 :: !Text, -- last 4 digits of card, should be a custom type + cardBin :: !(Maybe Text), -- first 6 digits of the card, should be a custom newtype + cardIssuerCountry :: !(Maybe ISO3166Alpha2), + cardFundingType :: !(Maybe CardFundingType), + cardFingerprint :: !UUID, + cardErrorCode :: !(Maybe VerificationErrorCode), + cardVerification :: !VerificationData, + cardRiskEvaluation :: !(Maybe RiskEvaluation), + cardMetadata :: !ResponseMetadata, + cardCreateDate :: !UTCTime, + cardUpdateDate :: !UTCTime + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec CardResponseBody) + +instance HasCodec CardResponseBody where + codec = + object "CardResponseBody" $ + CardResponseBody + <$> requiredField' "id" .= cardId + <*> requiredField' "status" .= cardStatus + <*> requiredField' "billingDetails" .= cardBillingDetails + <*> requiredField' "expMonth" .= cardExpiryMonth + <*> requiredField' "expYear" .= cardExpiryYear + <*> requiredField' "network" .= cardNetwork + <*> requiredField' "last4" .= cardLast4 + <*> optionalField' "bin" .= cardBin + <*> optionalField' "issuerCountry" .= cardIssuerCountry + <*> optionalField' "fundingType" .= cardFundingType + <*> requiredField' "fingerprint" .= cardFingerprint + <*> optionalField' "errorCode" .= cardErrorCode + <*> requiredField' "verification" .= cardVerification + <*> optionalField' "riskEvaluation" .= cardRiskEvaluation + <*> requiredField' "metadata" .= cardMetadata + <*> requiredField' "createDate" .= cardCreateDate + <*> requiredField' "updateDate" .= cardUpdateDate + +-- | Request body to create a debit card. +data CreateCardRequestBody = CreateCardRequestBody + { createCardIdempotencyKey :: !UUID, + createCardKeyId :: !(Maybe Text), -- key1 in sandbox + createCardEncryptedData :: !(Maybe Text), -- NB: this encrypted data contains the CVV AND the card number somehow + createCardBillingDetails :: !BillingDetails, + createCardExpiryMonth :: !Int, + createCardExpiryYear :: !Int, + createCardMetadata :: !RequestMetadata + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec CreateCardRequestBody) + +instance HasCodec CreateCardRequestBody where + codec = + object "CreateCardRequestBody" $ + CreateCardRequestBody + <$> requiredField' "idempotencyKey" .= createCardIdempotencyKey + <*> optionalField' "keyId" .= createCardKeyId + <*> requiredField' "encryptedData" .= createCardEncryptedData + <*> requiredField' "billingDetails" .= createCardBillingDetails + <*> requiredField' "expMonth" .= createCardExpiryMonth + <*> requiredField' "expYear" .= createCardExpiryYear + <*> requiredField' "metadata" .= createCardMetadata + +-- | Request body to update a debit card. +data UpdateCardRequestBody = UpdateCardRequestBody + { updateCardKeyId :: !(Maybe Text), -- key1 in sandbox + updateCardEncryptedData :: !(Maybe Text), -- NB: this encrypted data contains the CVV AND the card number somehow + updateCardExpiryMonth :: !Int, + updateCardExpiryYear :: !Int + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec UpdateCardRequestBody) + +instance HasCodec UpdateCardRequestBody where + codec = + object "UpdateCardRequestBody" $ + UpdateCardRequestBody + <$> requiredField' "keyId" .= updateCardKeyId + <*> requiredField' "encryptedData" .= updateCardEncryptedData + <*> requiredField' "expMonth" .= updateCardExpiryMonth + <*> requiredField' "expYear" .= updateCardExpiryYear + +data ListCardBillingDetails = ListCardBillingDetails + { listCardBillingDetailsCountry :: !ISO3166Alpha2, + listCardBillingDetailsDistrict :: !District + } + deriving (Eq, Show, Generic) + deriving + ( ToJSON, + FromJSON + ) + via (Autodocodec ListCardBillingDetails) + +instance HasCodec ListCardBillingDetails where + codec = + object "ListCardBillingDetails" $ + ListCardBillingDetails + <$> requiredField' "country" .= listCardBillingDetailsCountry + <*> requiredField' "district" .= listCardBillingDetailsDistrict + +data CardNetwork + = VISA + | MASTERCARD + | AMEX + | UNKNOWN + deriving (Eq, Show, Enum, Bounded) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec CardNetwork) + +instance HasCodec CardNetwork where + codec = shownBoundedEnumCodec + +data CardFundingType + = Credit + | Debit + | Prepaid + | Unknown + deriving (Eq, Show, Enum, Bounded) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec CardFundingType) + +instance HasCodec CardFundingType where + codec = + stringConstCodec $ + NE.fromList + [ (Credit, "credit"), + (Debit, "debit"), + (Prepaid, "prepaid"), + (Unknown, "unknown") + ] + +data VerificationErrorCode + = VerificationFailed + | VerificationFraudDetected + | VerificationDenied + | VerificationNotSupportedByIssuer + | VerificationStoppedByIssuer + | VerificationCardFailed + | VerificationCardInvalid + | VerificationCardAddressMismatch + | VerificationCardZipMismatch + | VerificationCardCvvInvalid + | VerificationCardExpired + | VerificationCardLimitViolated + | VerificationCardNotHonored + | VerificationCardCvvRequired + | VerificationCreditCardNotAllowed + | VerificationCardAccountIneligible + | VerificationCardNetworkUnsupported + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec VerificationErrorCode) + +instance HasCodec VerificationErrorCode where + codec = + stringConstCodec $ + NE.fromList + [ (VerificationFailed, "verification_failed"), + (VerificationFraudDetected, "verification_fraud_detected"), + (VerificationDenied, "verification_denied"), + (VerificationNotSupportedByIssuer, "verification_not_supported_by_issuer"), + (VerificationStoppedByIssuer, "verification_stopped_by_issuer"), + (VerificationCardFailed, "card_failed"), + (VerificationCardInvalid, "card_invalid"), + (VerificationCardAddressMismatch, "card_address_mismatch"), + (VerificationCardZipMismatch, "card_zip_mismatch"), + (VerificationCardCvvInvalid, "card_cvv_invalid"), + (VerificationCardExpired, "card_expired"), + (VerificationCardLimitViolated, "card_limit_violated"), + (VerificationCardNotHonored, "card_not_honored"), + (VerificationCardCvvRequired, "card_cvv_required"), + (VerificationCreditCardNotAllowed, "credit_card_not_allowed"), + (VerificationCardAccountIneligible, "card_account_ineligible"), + (VerificationCardNetworkUnsupported, "card_network_unsupported") + ] + +--------------------------------------------------------------- +-- ACH Types +--------------------------------------------------------------- + +data ACHBankAccountRequest + +type instance CircleRequest ACHBankAccountRequest = CircleResponseBody ACHBankAccountResponseBody + +-- | Response body for `createACHAccount` and `getACHAccount` +data ACHBankAccountResponseBody = ACHBankAccountResponseBody + { achBankAccountId :: !UUID, + achBankAccountStatus :: !Status, + achBankAccountAccountNumber :: !AccountNumber, + achBankAccountRoutingNumber :: !RoutingNumber, + achBankAccountBillingDetails :: !BillingDetails, + achBankAccountType :: !(Maybe ACHBankAccountType), + achBankAccountBankAddress :: !BankAddress, + achBankAccountFingerprint :: !UUID, + achBankAccountErrorCode :: !(Maybe ACHBankAccountErrorCode), + achBankAccountRiskEvaluation :: !(Maybe RiskEvaluation), + achBankAccountMetadata :: !ResponseMetadata, + achBankAccountCreateDate :: !UTCTime, + achBankAccountUpdateDate :: !UTCTime + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec ACHBankAccountResponseBody) + +instance HasCodec ACHBankAccountResponseBody where + codec = + object "ACHBankAccountResponseBody" $ + ACHBankAccountResponseBody + <$> requiredField' "id" .= achBankAccountId + <*> requiredField' "status" .= achBankAccountStatus + <*> requiredField' "accountNumber" .= achBankAccountAccountNumber + <*> requiredField' "routingNumber" .= achBankAccountRoutingNumber + <*> requiredField' "billingDetails" .= achBankAccountBillingDetails + <*> optionalField' "bankAccountType" .= achBankAccountType + <*> requiredField' "bankAddress" .= achBankAccountBankAddress + <*> requiredField' "fingerprint" .= achBankAccountFingerprint + <*> optionalField' "errorCode" .= achBankAccountErrorCode + <*> optionalField' "riskEvaluation" .= achBankAccountRiskEvaluation + <*> requiredField' "metadata" .= achBankAccountMetadata + <*> requiredField' "createDate" .= achBankAccountCreateDate + <*> requiredField' "updateDate" .= achBankAccountUpdateDate + +data ACHBankAccountErrorCode + = ACHBankAccountAuthorizationExpired + | ACHBankAccountError + | ACHBankAccountIneligible + | ACHBankAccountNotFound + | ACHBankAccountUnauthorized + | ACHBankAccountUnsupportedRoutingNumber + | ACHBankAccountVerificationFailed + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec ACHBankAccountErrorCode) + +instance HasCodec ACHBankAccountErrorCode where + codec = + stringConstCodec $ + NE.fromList + [ (ACHBankAccountAuthorizationExpired, "bank_account_authorization_expired"), + (ACHBankAccountError, "bank_account_error"), + (ACHBankAccountIneligible, "bank_account_ineligible"), + (ACHBankAccountNotFound, "bank_account_not_found"), + (ACHBankAccountUnauthorized, "bank_account_unauthorized"), + (ACHBankAccountUnsupportedRoutingNumber, "unsupported_routing_number"), + (ACHBankAccountVerificationFailed, "verification_failed") + ] + +-- | Request body to an ACH bank account. +data CreateACHBankAccountRequestBody = CreateACHBankAccountRequestBody + { achBankAccountBodyIdempotencyKey :: !UUID, + achBankAccountBodyPlaidProcessorToken :: !ProcessorToken, + achBankAccountBodyBillingDetails :: !BillingDetails, + achBankAccountBodyBankAccountType :: !(Maybe ACHBankAccountType), + achBankAccountBodyMetadata :: !RequestMetadata + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec CreateACHBankAccountRequestBody) + +instance HasCodec CreateACHBankAccountRequestBody where + codec = + object "CreateACHBankAccountRequestBody" $ + CreateACHBankAccountRequestBody + <$> requiredField' "idempotencyKey" .= achBankAccountBodyIdempotencyKey + <*> requiredField' "plaidProcessorToken" .= achBankAccountBodyPlaidProcessorToken + <*> requiredField' "billingDetails" .= achBankAccountBodyBillingDetails + <*> optionalField' "bankAccountType" .= achBankAccountBodyBankAccountType + <*> requiredField' "metadata" .= achBankAccountBodyMetadata + +--------------------------------------------------------------- +-- Mock Account Types +--------------------------------------------------------------- + +data MockAccountRequest + +type instance CircleRequest MockAccountRequest = CircleResponseBody MockACHBankAccountResponseBody + +-- | Request body to create a mock ACH bank account (in the sandbox only). +data CreateMockACHBankAccountRequestBody = CreateMockACHBankAccountRequestBody + { mockACHBankAccountBodyAccount :: !MockACHBankAccount, + mockACHBankAccountBodyBalance :: !MoneyAmount + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec CreateMockACHBankAccountRequestBody) + +instance HasCodec CreateMockACHBankAccountRequestBody where + codec = + object "CreateMockACHBankAccountRequestBody" $ + CreateMockACHBankAccountRequestBody + <$> requiredField' "account" .= mockACHBankAccountBodyAccount + <*> requiredField' "balance" .= mockACHBankAccountBodyBalance + +-- | Response body for methods that call the "mocks\/ach\/account" endpoint +data MockACHBankAccountResponseBody = MockACHBankAccountResponseBody + { mockACHBankAccountResponseBodyAccount :: !MockACHBankAccount, + mockACHBankAccountResponseBodyBalance :: !MoneyAmount, + -- in sandbox, the value of this token is processor-sandbox-circle-82cf95bb-43f8-4191-8d30-2c9f42853621 + mockACHBankAccountResponseBodyProcessorToken :: !ProcessorToken + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec MockACHBankAccountResponseBody) + +instance HasCodec MockACHBankAccountResponseBody where + codec = + object "MockACHBankAccountResponseBody" $ + MockACHBankAccountResponseBody + <$> requiredField' "account" .= mockACHBankAccountResponseBodyAccount + <*> requiredField' "balance" .= mockACHBankAccountResponseBodyBalance + <*> requiredField' "processorToken" .= mockACHBankAccountResponseBodyProcessorToken + +data MockACHBankAccount = MockACHBankAccount + { mockACHBankAccountAccountNumber :: !AccountNumber, + mockACHBankAccountRoutingNumber :: !MockRoutingNumber, + mockACHBankAccountDescription :: !Text + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec MockACHBankAccount) + +instance HasCodec MockACHBankAccount where + codec = + object "MockACHBankAccount" $ + MockACHBankAccount + <$> requiredField' "accountNumber" .= mockACHBankAccountAccountNumber + <*> requiredField' "routingNumber" .= mockACHBankAccountRoutingNumber + <*> requiredField' "description" .= mockACHBankAccountDescription + +data MockRoutingNumber + = MockRoutingNumber1 + | MockRoutingNumber2 + | MockRoutingNumber3 + | MockRoutingNumber4 + | MockRoutingNumber5 + | MockRoutingNumber6 + | MockRoutingNumber7 + | MockRoutingNumber8 + | MockRoutingNumber9 + deriving (Eq, Show, Enum, Bounded) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec MockRoutingNumber) + +instance HasCodec MockRoutingNumber where + codec = + stringConstCodec $ + NE.fromList + [ (MockRoutingNumber1, "011000028"), + (MockRoutingNumber2, "011201762"), + (MockRoutingNumber3, "011500120"), + (MockRoutingNumber4, "021214862"), + (MockRoutingNumber5, "121000248"), + (MockRoutingNumber6, "121140399"), + (MockRoutingNumber7, "211073473"), + (MockRoutingNumber8, "221172610"), + (MockRoutingNumber9, "011000138") + ] + +--------------------------------------------------------------- +-- SEPA Types +--------------------------------------------------------------- + +data SEPAAccountRequest + +type instance CircleRequest SEPAAccountRequest = CircleResponseBody SEPAAccountResponseBody + +data SEPAInstructionsRequest + +type instance CircleRequest SEPAInstructionsRequest = CircleResponseBody WireInstructionsResponseData + +-- | Request body to create a SEPA account. +data SEPAAccountRequestBody = SEPAAccountRequestBody + { sepaAccountRequestBodyIdempotencyKey :: !UUID, + sepaAccountRequestBodyIBAN :: !Iban, + sepaAccountRequestBodyBillingDetails :: !BillingDetails + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec SEPAAccountRequestBody) + +instance HasCodec SEPAAccountRequestBody where + codec = + object "SEPAAccountRequestBody" $ + SEPAAccountRequestBody + <$> requiredField' "idempotencyKey" .= sepaAccountRequestBodyIdempotencyKey + <*> requiredField' "iban" .= sepaAccountRequestBodyIBAN + <*> requiredField' "billingDetails" .= sepaAccountRequestBodyBillingDetails + +-- | Response body for methods that call the "banks\/sepa" endpoint +data SEPAAccountResponseBody = SEPAAccountResponseBody + { sepaAccountResponseBodyId :: !UUID, + sepaAccountResponseBodyStatus :: !Status, + sepaAccountResponseBodyDescription :: !Text, -- TODO better type: Bank name plus last four digits of the bank account number or IBAN. Make a custom type for this + sepaAccountResponseBodyTrackingRef :: !TrackingReference, + sepaAccountResponseBodyFingerprint :: !UUID, + sepaAccountResponseBodyRiskEvaluation :: !(Maybe RiskEvaluation), + sepaAccountResponseBodyBillingDetails :: !BillingDetails, + sepaAccountResponseBodyCreateDate :: !UTCTime, + sepaAccountResponseBodyUpdateDate :: !UTCTime + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec SEPAAccountResponseBody) + +instance HasCodec SEPAAccountResponseBody where + codec = + object "SEPAAccountResponseBody" $ + SEPAAccountResponseBody + <$> requiredField' "id" .= sepaAccountResponseBodyId + <*> requiredField' "status" .= sepaAccountResponseBodyStatus + <*> requiredField' "description" .= sepaAccountResponseBodyDescription + <*> requiredField' "trackingRef" .= sepaAccountResponseBodyTrackingRef + <*> requiredField' "fingerprint" .= sepaAccountResponseBodyFingerprint + <*> optionalField' "riskEvaluation" .= sepaAccountResponseBodyRiskEvaluation + <*> requiredField' "billingDetails" .= sepaAccountResponseBodyBillingDetails + <*> requiredField' "createDate" .= sepaAccountResponseBodyCreateDate + <*> requiredField' "updateDate" .= sepaAccountResponseBodyUpdateDate + +--------------------------------------------------------------- +-- Settlements Types +--------------------------------------------------------------- + +data SettlementRequest + +type instance CircleRequest SettlementRequest = CircleResponseBody SettlementResponseBody + +data SettlementsRequest + +type instance CircleRequest SettlementsRequest = CircleResponseBody [SettlementResponseBody] + +instance CircleHasParam SettlementsRequest PaginationQueryParams + +instance CircleHasParam SettlementsRequest FromQueryParam + +instance CircleHasParam SettlementsRequest ToQueryParam + +instance CircleHasParam SettlementsRequest PageSizeQueryParam + +-- | Response body for methods that call the "settlements" endpoint +data SettlementResponseBody = SettlementResponseBody + { settlementResponseBodyId :: !UUID, + settlementResponseBodyMerchantWalletId :: !UUID, + settlementResponseBodyWalletId :: !UUID, + settlementResponseBodyTotalDebits :: !MoneyAmount, + settlementResponseBodyTotalCredits :: !MoneyAmount, + settlementResponseBodyPaymentFees :: !MoneyAmount, + settlementResponseBodyChargebackFees :: !MoneyAmount, + settlementResponseBodyCreateDate :: !UTCTime, + settlementResponseBodyUpdateDate :: !UTCTime + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec SettlementResponseBody) + +instance HasCodec SettlementResponseBody where + codec = + object "SettlementResponseBody" $ + SettlementResponseBody + <$> requiredField' "id" .= settlementResponseBodyId + <*> requiredField' "merchantWalletId" .= settlementResponseBodyMerchantWalletId + <*> requiredField' "walletId" .= settlementResponseBodyWalletId + <*> requiredField' "totalDebits" .= settlementResponseBodyTotalDebits + <*> requiredField' "totalCredits" .= settlementResponseBodyTotalCredits + <*> requiredField' "paymentFees" .= settlementResponseBodyPaymentFees + <*> requiredField' "chargebackFees" .= settlementResponseBodyChargebackFees + <*> requiredField' "createDate" .= settlementResponseBodyCreateDate + <*> requiredField' "updateDate" .= settlementResponseBodyUpdateDate + +--------------------------------------------------------------- +-- Chargeback Types +--------------------------------------------------------------- + +data ChargebacksRequest + +type instance CircleRequest ChargebacksRequest = CircleResponseBody [ChargebackResponseBody] + +instance CircleHasParam ChargebacksRequest PaginationQueryParams + +instance CircleHasParam ChargebacksRequest FromQueryParam + +instance CircleHasParam ChargebacksRequest ToQueryParam + +instance CircleHasParam ChargebacksRequest PageSizeQueryParam + +instance CircleHasParam ChargebacksRequest PaymentIdQueryParam + +data ChargebackRequest + +type instance CircleRequest ChargebackRequest = CircleResponseBody ChargebackResponseBody + +data MockChargebackRequest + +type instance CircleRequest MockChargebackRequest = CircleResponseBody ChargebackResponseBody + +-- | Response body for methods that call the "cards\/chargebacks" and "mocks\/cards\/chargebacks" endpoints +data ChargebackResponseBody = ChargebackResponseBody + { chargebackResponseBodyId :: !UUID, + chargebackResponseBodyPaymentId :: !UUID, + chargebackResponseBodyMerchantId :: !UUID, + chargebackResponseBodyReasonCode :: !Text, -- it's open-ended, no type will save this + chargebackResponseBodyCategory :: !(Maybe ChargebackCategory), + chargebackResponseBodyHistory :: [ChargebackHistory] + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec ChargebackResponseBody) + +instance HasCodec ChargebackResponseBody where + codec = + object "ChargebackResponseBody" $ + ChargebackResponseBody + <$> requiredField' "id" .= chargebackResponseBodyId + <*> requiredField' "paymentId" .= chargebackResponseBodyPaymentId + <*> requiredField' "merchantId" .= chargebackResponseBodyMerchantId + <*> requiredField' "reasonCode" .= chargebackResponseBodyReasonCode + <*> optionalField' "category" .= chargebackResponseBodyCategory + <*> requiredField' "history" .= chargebackResponseBodyHistory + +data ChargebackCategory + = CanceledRecurringPayment + | CustomerDispute + | Fraudulent + | General + | ProcessingError + | NotDefined + deriving (Eq, Show, Enum, Bounded) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec ChargebackCategory) + +instance HasCodec ChargebackCategory where + codec = + stringConstCodec $ + NE.fromList + [ (CanceledRecurringPayment, "Canceled Recurring Payment"), + (CustomerDispute, "Customer Dispute"), + (Fraudulent, "Fraudulent"), + (General, "General"), + (ProcessingError, "Processing Error"), + (NotDefined, "Not Defined") + ] + +data ChargebackHistory = ChargebackHistory + { chargebackHistoryType :: !ChargebackHistoryType, + chargebackHistoryAmount :: !MoneyAmount, + chargebackHistoryFee :: !(Maybe MoneyAmount), + chargebackHistoryDescription :: !Text, + chargebackHistorySettlementId :: !(Maybe UUID), + chargebackHistoryCreateDate :: !UTCTime + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec ChargebackHistory) + +instance HasCodec ChargebackHistory where + codec = + object "ChargebackHistory" $ + ChargebackHistory + <$> requiredField' "type" .= chargebackHistoryType + <*> requiredField' "amount" .= chargebackHistoryAmount + <*> requiredField' "fee" .= chargebackHistoryFee + <*> requiredField' "description" .= chargebackHistoryDescription + <*> optionalField' "settlementId" .= chargebackHistorySettlementId + <*> requiredField' "createDate" .= chargebackHistoryCreateDate + +data ChargebackHistoryType + = FirstChargeback + | SecondChargeback + | ChargebackReversal + | Representment + | ChargebackSettlement + deriving (Eq, Show, Enum, Bounded) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec ChargebackHistoryType) + +instance HasCodec ChargebackHistoryType where + codec = + stringConstCodec $ + NE.fromList + [ (FirstChargeback, "First Chargeback"), + (SecondChargeback, "Second Chargeback"), + (ChargebackReversal, "Chargeback Reversal"), + (Representment, "Representment"), + (ChargebackSettlement, "Chargeback Settlement") + ] + +--------------------------------------------------------------- +-- Reversal Types +--------------------------------------------------------------- + +data ReversalsRequest + +type instance CircleRequest ReversalsRequest = CircleResponseBody [ReversalResponseBody] + +instance CircleHasParam ReversalsRequest PaginationQueryParams + +instance CircleHasParam ReversalsRequest FromQueryParam + +instance CircleHasParam ReversalsRequest ToQueryParam + +instance CircleHasParam ReversalsRequest PageSizeQueryParam + +instance CircleHasParam ReversalsRequest PaymentStatusQueryParams + +-- | Response body for methods that call the "reversals" endpoint +data ReversalResponseBody = ReversalResponseBody + { reversalResponseBodyId :: !UUID, + reversalResponseBodyPaymentId :: !UUID, + reversalResponseBodyAmount :: !MoneyAmount, + reversalResponseBodyDescription :: !Text, + reversalResponseBodyStatus :: !Status, + reversalResponseBodyReason :: !ReversalReason, + reversalResponseBodyFees :: !MoneyAmount, + reversalResponseBodyCreateDate :: !UTCTime, + reversalResponseBodyUpdateDate :: !UTCTime + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec ReversalResponseBody) + +instance HasCodec ReversalResponseBody where + codec = + object "ReversalResponseBody" $ + ReversalResponseBody + <$> requiredField' "id" .= reversalResponseBodyId + <*> requiredField' "paymentId" .= reversalResponseBodyPaymentId + <*> requiredField' "amount" .= reversalResponseBodyAmount + <*> requiredField' "description" .= reversalResponseBodyDescription + <*> requiredField' "status" .= reversalResponseBodyStatus + <*> requiredField' "reason" .= reversalResponseBodyReason + <*> requiredField' "fees" .= reversalResponseBodyFees + <*> requiredField' "createDate" .= reversalResponseBodyCreateDate + <*> requiredField' "updateDate" .= reversalResponseBodyUpdateDate + +data ReversalReason + = ReversalDuplicate + | ReversalFraudulent + | ReversalRequestedByCustomer + | ReversalBankTransactionError + | ReversalInvalidAccountNumber + | ReversalInsufficientFunds + | ReversalPaymentStoppedByIssuer + | ReversalPaymentReturned + | ReversalBankAccountIneligible + | ReversalInvalidACHRTN + | ReversalUnauthorizedTransaction + | ReversalPaymentFailed + deriving (Eq, Show, Enum, Bounded) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec ReversalReason) + +instance HasCodec ReversalReason where + codec = + stringConstCodec $ + NE.fromList + [ (ReversalDuplicate, "duplicate"), + (ReversalFraudulent, "fraudulent"), + (ReversalRequestedByCustomer, "requested_by_customer"), + (ReversalBankTransactionError, "bank_transaction_error"), + (ReversalInvalidAccountNumber, "invalid_account_number"), + (ReversalInsufficientFunds, "insufficient_funds"), + (ReversalPaymentStoppedByIssuer, "payment_stopped_by_issuer"), + (ReversalPaymentReturned, "payment_returned"), + (ReversalBankAccountIneligible, "bank_account_ineligible"), + (ReversalInvalidACHRTN, "invalid_ach_rtn"), + (ReversalUnauthorizedTransaction, "unauthorized_transaction"), + (ReversalPaymentFailed, "payment_failed") + ] + +--------------------------------------------------------------- +-- Payment Intent Types +--------------------------------------------------------------- + +data PaymentIntentRequest + +type instance CircleRequest PaymentIntentRequest = CircleResponseBody PaymentIntentResponseBody + +data PaymentIntentsRequest + +type instance CircleRequest PaymentIntentsRequest = CircleResponseBody [PaymentIntentResponseBody] + +instance CircleHasParam PaymentIntentsRequest PaginationQueryParams + +instance CircleHasParam PaymentIntentsRequest FromQueryParam + +instance CircleHasParam PaymentIntentsRequest ToQueryParam + +instance CircleHasParam PaymentIntentsRequest PageSizeQueryParam + +instance CircleHasParam PaymentIntentsRequest PaymentStatusQueryParams + +instance CircleHasParam PaymentIntentsRequest PaymentIntentContextQueryParams + +-- | Request body to create a payment intent for a blockchain payment +data CreatePaymentIntentRequestBody = CreatePaymentIntentRequestBody + { createPaymentIntentIdempotencyKey :: !UUID, + createPaymentIntentAmount :: !MoneyAmount, + createPaymentIntentSettlementCurrency :: !SupportedCurrencies, + createPaymentIntentPaymentMethods :: [PaymentMethodData] + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec CreatePaymentIntentRequestBody) + +instance HasCodec CreatePaymentIntentRequestBody where + codec = + object "CreatePaymentIntentRequestBody" $ + CreatePaymentIntentRequestBody + <$> requiredField' "idempotencyKey" .= createPaymentIntentIdempotencyKey + <*> requiredField' "amount" .= createPaymentIntentAmount + <*> requiredField' "settlementCurrency" .= createPaymentIntentSettlementCurrency + <*> requiredField' "paymentMethods" .= createPaymentIntentPaymentMethods + +-- | Response body for methods that call the "paymentIntents" endpoint +data PaymentIntentResponseBody = PaymentIntentResponseBody + { paymentIntentResponseBodyIdempotencyKey :: !UUID, + paymentIntentResponseBodyId :: !UUID, + paymentIntentResponseBodyAmount :: !MoneyAmount, + paymentIntentResponseBodyAmountPaid :: !MoneyAmount, + paymentIntentResponseBodySettlementCurrency :: !SupportedCurrencies, + paymentIntentResponseBodyPaymentMethods :: ![PaymentMethodData], + paymentIntentResponseBodyFees :: ![BlockchainFeeMoneyAmount], + paymentIntentResponseBodyPaymentIds :: ![UUID], + paymentIntentResponseBodyTimeline :: ![TimelineData], + paymentIntentResponseBodyExpiresOn :: !UTCTime, + paymentIntentResponseBodyUpdateDate :: !UTCTime, + paymentIntentResponseBodyCreateDate :: !UTCTime + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec PaymentIntentResponseBody) + +instance HasCodec PaymentIntentResponseBody where + codec = + object "PaymentIntentResponseBody" $ + PaymentIntentResponseBody + <$> requiredField' "idempotencyKey" .= paymentIntentResponseBodyIdempotencyKey + <*> requiredField' "id" .= paymentIntentResponseBodyId + <*> requiredField' "amount" .= paymentIntentResponseBodyAmount + <*> requiredField' "amountPaid" .= paymentIntentResponseBodyAmountPaid + <*> requiredField' "settlementCurrency" .= paymentIntentResponseBodySettlementCurrency + <*> requiredField' "paymentMethods" .= paymentIntentResponseBodyPaymentMethods + <*> requiredField' "fees" .= paymentIntentResponseBodyFees + <*> requiredField' "paymentIds" .= paymentIntentResponseBodyPaymentIds + <*> requiredField' "timeline" .= paymentIntentResponseBodyTimeline + <*> requiredField' "expiresOn" .= paymentIntentResponseBodyExpiresOn + <*> requiredField' "updateDate" .= paymentIntentResponseBodyUpdateDate + <*> requiredField' "createDate" .= paymentIntentResponseBodyCreateDate + +data PaymentMethodData = PaymentMethodData + { paymentMethodType :: !Text, -- just "blockchain" + paymentMethodDataChain :: !Chain, + paymentMethodDataAddress :: !(Maybe HexString) + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec PaymentMethodData) + +instance HasCodec PaymentMethodData where + codec = + object "PaymentMethodData" $ + PaymentMethodData + <$> requiredField' "type" .= paymentMethodType + <*> requiredField' "chain" .= paymentMethodDataChain + <*> optionalField' "address" .= paymentMethodDataAddress + +data TimelineData = TimelineData + { timelineDataStatus :: !PaymentIntentStatus, + timelineDataContext :: !PaymentIntentContext, + timelineDataTime :: !UTCTime + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec TimelineData) + +instance HasCodec TimelineData where + codec = + object "TimelineData" $ + TimelineData + <$> requiredField' "status" .= timelineDataStatus + <*> requiredField' "context" .= timelineDataContext + <*> requiredField' "time" .= timelineDataTime + +--------------------------------------------------------------- +-- Payout Return Types +--------------------------------------------------------------- + +data ReturnsRequest + +type instance CircleRequest ReturnsRequest = CircleResponseBody [PayoutReturnResponseBody] + +instance CircleHasParam ReturnsRequest PaginationQueryParams + +instance CircleHasParam ReturnsRequest FromQueryParam + +instance CircleHasParam ReturnsRequest ToQueryParam + +instance CircleHasParam ReturnsRequest PageSizeQueryParam + +--------------------------------------------------------------- +-- Wallet Types +--------------------------------------------------------------- + +data WalletRequest + +type instance CircleRequest WalletRequest = CircleResponseBody WalletResponseBody + +data WalletsRequest + +type instance CircleRequest WalletsRequest = CircleResponseBody [WalletResponseBody] + +instance CircleHasParam WalletsRequest PaginationQueryParams + +instance CircleHasParam WalletsRequest FromQueryParam + +instance CircleHasParam WalletsRequest ToQueryParam + +instance CircleHasParam WalletsRequest PageSizeQueryParam + +-- | Response body for methods that call the "wallets" endpoint +data WalletResponseBody = WalletResponseBody + { walletResponseBodyWalletId :: !WalletId, + walletResponseBodyEntityId :: !UUID, + walletResponseBodyType :: !Text, -- This value will always be "end_user_wallet" + walletResponseBodyDescription :: !(Maybe Text), + walletResponseBodyBalances :: [MoneyAmount] + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec WalletResponseBody) + +instance HasCodec WalletResponseBody where + codec = + object "WalletResponseBody" $ + WalletResponseBody + <$> requiredField' "walletId" .= walletResponseBodyWalletId + <*> requiredField' "entityId" .= walletResponseBodyEntityId + <*> requiredField' "type" .= walletResponseBodyType + <*> optionalField' "description" .= walletResponseBodyDescription + <*> requiredField' "balances" .= walletResponseBodyBalances + +-- | Request body to create a Circle wallet. +data CreateWalletRequestBody = CreateWalletRequestBody + { createWalletRequestBodyIdempotencyKey :: !UUID, + createWalletRequestBodyDescription :: !(Maybe Text) + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec CreateWalletRequestBody) + +instance HasCodec CreateWalletRequestBody where + codec = + object "CreateWalletRequestBody" $ + CreateWalletRequestBody + <$> requiredField' "idempotencyKey" .= createWalletRequestBodyIdempotencyKey + <*> optionalField' "description" .= createWalletRequestBodyDescription + +--------------------------------------------------------------- +-- Utils +--------------------------------------------------------------- + +utcToCircle :: UTCTime -> Text +utcToCircle ut = + tshow day <> "T" <> clockTime <> "-00:00" + where + day = utctDay ut + time = utctDayTime ut + tod = snd $ utcToLocalTimeOfDay utc (timeToTimeOfDay time) + atLeastTwo :: Text -> Int -> Text + atLeastTwo t i + | i < 10 = t <> tshow i + | otherwise = tshow i + clockTime = + atLeastTwo "0" (todHour tod) + <> ":" + <> atLeastTwo "0" (todMin tod) + <> ":" + <> atLeastTwo "0" (floor $ todSec tod) + +tshow :: Show a => a -> Text +tshow = T.pack . show + +-- | Similar to 'Either' but with different 'ToJSON' and 'FromJSON' instances. +-- 'ToJSON' will serialize the payload without adding any kind of tag. +-- 'FromJSON' will first attempt to parse JSON as the first type parameter, +-- and if that fails will then attempt to parse as the second type parameter. +-- +-- NB: The order of type parameters make a huge difference! +-- In @'ThisOrThat' A B@, if @A@ is structurally a subtype of @B@, then the +-- parser can never produce a 'That' result! For example, with types +-- +-- @ +-- data A = A {foo :: String, bar :: Scientific} +-- data B = B {foo :: String, bar :: Scientific, baz :: Bool} +-- @ +-- +-- @'FromJSON' ('ThisOrThat' A B)@ can never parse a @B@. Any JSON object +-- that includes properties @foo: @ and @bar: @ will parse +-- as an @A@, whether or not the property @baz: @ is present. You +-- can fix this by instead using @'ThisOrThat' B A@. +data ThisOrThat a b = This a | That b + deriving stock (Eq, Generic) + +catThises :: [ThisOrThat a b] -> [a] +catThises lst = lst >>= toThis + where + toThis = \case + This a -> [a] + _ -> [] + +catThats :: [ThisOrThat a b] -> [b] +catThats lst = lst >>= toThat + where + toThat = \case + That b -> [b] + _ -> [] + +instance (Show a, Show b) => Show (ThisOrThat a b) where + show = \case + This a -> show a + That b -> show b + +instance (ToJSON a, ToJSON b) => ToJSON (ThisOrThat a b) where + toJSON (This a) = toJSON a + toJSON (That b) = toJSON b + toEncoding (This a) = toEncoding a + toEncoding (That b) = toEncoding b + +instance (FromJSON a, FromJSON b) => FromJSON (ThisOrThat a b) where + parseJSON val = do + let parsedA = fromJSON val + parsedB = fromJSON val + case (parsedA, parsedB) of + (Success a, _) -> pure $ This a + (_, Success b) -> pure $ That b + (Error thisError, Error thatError) -> + fail $ + fold + [ "Failed when parsing a ThisOrThat from JSON.\n", + "Error on the This: " <> thisError <> "\n", + "Error on the That: " <> thatError + ] + +instance Bifunctor ThisOrThat where + bimap f _ (This a) = This (f a) + bimap _ g (That b) = That (g b) + +thisOrThatToEither :: ThisOrThat a b -> Either a b +thisOrThatToEither = \case + This a -> Left a + That b -> Right b + +thisOrThat :: (a -> c) -> (b -> c) -> ThisOrThat a b -> c +thisOrThat f g tot = either f g $ thisOrThatToEither tot + +--------------------------------------------------------------- +-- General, shared types +--------------------------------------------------------------- +data Status = Pending | Complete | Failed + deriving (Show, Eq) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec Status) + +instance HasCodec Status where + codec = stringConstCodec $ NE.fromList [(Pending, "pending"), (Complete, "complete"), (Failed, "failed")] + +data PaymentStatus + = PaymentPending + | Confirmed + | Paid + | PaymentFailed + | ActionRequired + deriving (Show, Eq) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec PaymentStatus) + +instance HasCodec PaymentStatus where + codec = + stringConstCodec $ + NE.fromList + [ (Confirmed, "confirmed"), + (PaymentPending, "pending"), + (Paid, "paid"), + (PaymentFailed, "failed"), + (ActionRequired, "action_required") + ] + +data PaymentIntentStatus + = PaymentIntentCreated + | PaymentIntentPending + | PaymentIntentComplete + | PaymentIntentExpired + | PaymentIntentFailed + deriving (Show, Eq) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec PaymentIntentStatus) + +instance HasCodec PaymentIntentStatus where + codec = + stringConstCodec $ + NE.fromList + [ (PaymentIntentCreated, "created"), + (PaymentIntentPending, "pending"), + (PaymentIntentComplete, "complete"), + (PaymentIntentExpired, "expired"), + (PaymentIntentFailed, "failed") + ] + +data PaymentIntentContext + = ContextUnderpaid + | ContextPaid + | ContextOverpaid + deriving (Show, Eq) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec PaymentIntentContext) + +instance HasCodec PaymentIntentContext where + codec = + stringConstCodec $ + NE.fromList + [ (ContextUnderpaid, "underpaid"), + (ContextPaid, "paid"), + (ContextOverpaid, "overpaid") + ] + +data Address = Address + { addressCity :: !(Maybe City), + addressCountry :: !(Maybe ISO3166Alpha2), + addressLine1 :: !(Maybe AddressLine), + addressLine2 :: !(Maybe AddressLine), + addressDistrict :: !(Maybe District) + } + deriving (Eq, Show) + deriving + ( ToJSON, + FromJSON + ) + via (Autodocodec Address) + +instance HasCodec Address where + codec = + object "Address" $ + Address + <$> optionalField' "city" .= addressCity + <*> optionalField' "country" .= addressCountry + <*> optionalField' "line1" .= addressLine1 + <*> optionalField' "line2" .= addressLine2 + <*> optionalField' "district" .= addressDistrict + +data BankAccountType = Wire | Sen + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec BankAccountType) + +instance HasCodec BankAccountType where + codec = stringConstCodec $ NE.fromList [(Wire, "wire"), (Sen, "sen")] + +data ACHBankAccountType = RetailType | BusinessType + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec ACHBankAccountType) + +instance HasCodec ACHBankAccountType where + codec = stringConstCodec $ NE.fromList [(RetailType, "retail"), (BusinessType, "business")] + +data DestinationBankAccount = DestinationBankAccount + { destinationBankAccountType :: !BankAccountType, + destinationBankAccountId :: !UUID, + destinationBankAccountName :: !(Maybe Text) + } + deriving (Eq, Show) + deriving + ( ToJSON, + FromJSON + ) + via (Autodocodec DestinationBankAccount) + +instance HasCodec DestinationBankAccount where + codec = + object "DestinationBankAccount" $ + DestinationBankAccount + <$> requiredField' "type" .= destinationBankAccountType + <*> requiredField' "id" .= destinationBankAccountId + <*> optionalField' "name" .= destinationBankAccountName + +-- TODO can we do type narrowing to have other types that represent subsets of +-- this one without have to write custom constructors? +data SupportedCurrencies = USD | EUR | BTC | ETH + deriving (Eq, Show, Enum, Bounded) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec SupportedCurrencies) + +instance HasCodec SupportedCurrencies where + codec = shownBoundedEnumCodec + +newtype Amount = Amount + -- TODO consider making this a numeric type, maybe? + { unAmount :: Text + } + deriving (Eq, Show, ToJSON, FromJSON) + +instance HasCodec Amount where + codec = dimapCodec Amount unAmount codec + +data BlockchainFeeType = BlockchainLeaseFee | TotalPaymentFees + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec BlockchainFeeType) + +instance HasCodec BlockchainFeeType where + codec = stringConstCodec $ NE.fromList [(BlockchainLeaseFee, "blockChainLeaseFee"), (TotalPaymentFees, "totalPaymentFees")] + +data BlockchainFeeMoneyAmount = BlockchainFeeMoneyAmount + { blockchainFeeMoneyAmountType :: !BlockchainFeeType, + blockchainFeeMoneyAmountAmount :: !Amount, + blockchainFeeMoneyAmountCurrency :: !SupportedCurrencies + } + deriving (Eq, Show, Generic) + deriving + ( ToJSON, + FromJSON + ) + via (Autodocodec BlockchainFeeMoneyAmount) + +instance HasCodec BlockchainFeeMoneyAmount where + codec = + object "BlockchainFeeMoneyAmount" $ + BlockchainFeeMoneyAmount + <$> requiredField' "type" .= blockchainFeeMoneyAmountType + <*> requiredField' "amount" .= blockchainFeeMoneyAmountAmount + <*> requiredField' "currency" .= blockchainFeeMoneyAmountCurrency + +data MoneyAmount = MoneyAmount + { moneyAmountAmount :: !Amount, + moneyAmountCurrency :: !SupportedCurrencies + } + deriving (Eq, Show, Generic) + deriving + ( ToJSON, + FromJSON + ) + via (Autodocodec MoneyAmount) + +instance HasCodec MoneyAmount where + codec = + object "MoneyAmount" $ + MoneyAmount + <$> requiredField' "amount" .= moneyAmountAmount + <*> requiredField' "currency" .= moneyAmountCurrency + +data TransferFeeAmount = TransferFeeAmount + { transferFeeAmountAmount :: !Amount, + transferFeeAmountCurrency :: !SupportedCurrencies, + transferFeeAmountType :: !Text + } + deriving (Eq, Show, Generic) + deriving + ( ToJSON, + FromJSON + ) + via (Autodocodec TransferFeeAmount) + +instance HasCodec TransferFeeAmount where + codec = + object "TransferFeeAmount" $ + TransferFeeAmount + <$> requiredField' "amount" .= transferFeeAmountAmount + <*> requiredField' "currency" .= transferFeeAmountCurrency + <*> requiredField' "type" .= transferFeeAmountType + +data Decision = Approved | Denied | Review + deriving (Eq, Show, Generic) + deriving + ( ToJSON, + FromJSON + ) + via (Autodocodec Decision) + +instance HasCodec Decision where + codec = stringConstCodec $ NE.fromList [(Approved, "approved"), (Denied, "denied"), (Review, "review")] + +data RiskEvaluation = RiskEvaluation + { riskEvaluationDecision :: !Decision, + -- Parsing riskEvaluationReason as a text because it's pretty open-ended: https:\/\/developers.circle.com\/developer\/docs\/cards-banks-and-payments-risk-evaluation + -- TODO maybe eventually add type constraints around these potential fields (unlikely though, there are a lot) + riskEvaluationReason :: !Text + } + deriving (Eq, Show, Generic) + deriving + ( ToJSON, + FromJSON + ) + via (Autodocodec RiskEvaluation) + +instance HasCodec RiskEvaluation where + codec = + object "RiskEvaluation" $ + RiskEvaluation + <$> requiredField' "decision" .= riskEvaluationDecision + <*> requiredField' "reason" .= riskEvaluationReason + +data Adjustments = Adjustments + { adjustmentsFXCredit :: !MoneyAmount, + adjustmentsFXDebit :: !MoneyAmount + } + deriving (Eq, Show, Generic) + deriving + ( ToJSON, + FromJSON + ) + via (Autodocodec Adjustments) + +instance HasCodec Adjustments where + codec = + object "Adjustments" $ + Adjustments + <$> requiredField' "fxCredit" .= adjustmentsFXCredit + <*> requiredField' "fxDebit" .= adjustmentsFXDebit + +data BillingDetails = BillingDetails + { billingDetailsName :: !Text, + billingDetailsCity :: !City, + billingDetailsCountry :: !ISO3166Alpha2, + billingDetailsLine1 :: !AddressLine, -- address type + billingDetailsLine2 :: !(Maybe AddressLine), -- secondary address type + billingDetailsDistrict :: !(Maybe District), -- could be a state type + billingDetailsPostalCode :: !PostalCode -- postal code type + } + deriving (Eq, Show, Generic) + deriving + ( ToJSON, + FromJSON + ) + via (Autodocodec BillingDetails) + +instance HasCodec BillingDetails where + codec = + object "BillingDetails" $ + BillingDetails + <$> requiredField' "name" .= billingDetailsName + <*> requiredField' "city" .= billingDetailsCity + <*> requiredField' "country" .= billingDetailsCountry + <*> requiredField' "line1" .= billingDetailsLine1 + <*> optionalField' "line2" .= billingDetailsLine2 + <*> optionalField' "district" .= billingDetailsDistrict + <*> requiredField' "postalCode" .= billingDetailsPostalCode + +-- TODO refactor this type to use address WithName. Look into the same stuff that we used at Mercury for WithName +data BankAddress = BankAddress + { bankAddressName :: !(Maybe Text), + bankAddressCity :: !(Maybe City), + bankAddressCountry :: !(Maybe ISO3166Alpha2), + bankAddressLine1 :: !(Maybe AddressLine), + bankAddressLine2 :: !(Maybe AddressLine), + bankAddressDistrict :: !(Maybe District) + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec BankAddress) + +instance HasCodec BankAddress where + codec = + object "BankAddress" $ + BankAddress + <$> optionalField' "name" .= bankAddressName + <*> optionalField' "city" .= bankAddressCity + <*> optionalField' "country" .= bankAddressCountry + <*> optionalField' "line1" .= bankAddressLine1 + <*> optionalField' "line2" .= bankAddressLine2 + <*> optionalField' "district" .= bankAddressDistrict + +data BeneficiaryDetails = BeneficiaryDetails + { beneficiaryDetailsName :: !Text, + beneficiaryDetailsAddress1 :: !(Maybe AddressLine), + beneficiaryDetailsAddress2 :: !(Maybe AddressLine) + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec BeneficiaryDetails) + +instance HasCodec BeneficiaryDetails where + codec = + object "BeneficiaryDetails" $ + BeneficiaryDetails + <$> requiredField' "name" .= beneficiaryDetailsName + <*> optionalField' "address1" .= beneficiaryDetailsAddress1 + <*> optionalField' "address2" .= beneficiaryDetailsAddress2 + +data BeneficiaryBankDetails = BeneficiaryBankDetails + { beneficiaryBankDetailsName :: !Text, + beneficiaryBankDetailsSwiftCode :: !SwiftCode, + beneficiaryBankDetailsRoutingNumber :: !RoutingNumber, + beneficiaryBankDetailsAccountNumber :: !AccountNumber, + beneficiaryBankDetailsCurrency :: !SupportedCurrencies, + beneficiaryBankDetailsAddress :: !AddressLine, + beneficiaryBankDetailsCity :: !City, + beneficiaryBankDetailsPostalCode :: !PostalCode, + beneficiaryBankDetailsCountry :: !ISO3166Alpha2 + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec BeneficiaryBankDetails) + +instance HasCodec BeneficiaryBankDetails where + codec = + object "BeneficiaryBankDetails" $ + BeneficiaryBankDetails + <$> requiredField' "name" .= beneficiaryBankDetailsName + <*> requiredField' "swiftCode" .= beneficiaryBankDetailsSwiftCode + <*> requiredField' "routingNumber" .= beneficiaryBankDetailsRoutingNumber + <*> requiredField' "accountNumber" .= beneficiaryBankDetailsAccountNumber + <*> requiredField' "currency" .= beneficiaryBankDetailsCurrency + <*> requiredField' "address" .= beneficiaryBankDetailsAddress + <*> requiredField' "city" .= beneficiaryBankDetailsCity + <*> requiredField' "postalCode" .= beneficiaryBankDetailsPostalCode + <*> requiredField' "country" .= beneficiaryBankDetailsCountry + +newtype ProcessorToken = ProcessorToken + { unProcessorToken :: Text + } + deriving (Eq, Show, ToJSON, FromJSON) + +instance HasCodec ProcessorToken where + codec = dimapCodec ProcessorToken unProcessorToken codec + +newtype AddressLine = AddressLine + { unAddressLine :: Text + } + deriving (Eq, Show, ToJSON, FromJSON) + +instance HasCodec AddressLine where + codec = dimapCodec AddressLine unAddressLine codec + +newtype URL = URL {unURL :: Text} + deriving stock (Eq, Show, Lift) + deriving newtype (ToJSON) + +-- From https://daringfireball.net/2010/07/improved_regex_for_matching_urls +urlRegex :: Regex +urlRegex = + [re|(?i)\b((?:[a-z][\w-]+:(?:/{1,3}|[a-z0-9%])|www\d{0,3}[.]|[a-z0-9.\-]+[.][a-z]{2,4}/)(?:[^\s()<>]+|\(([^\s()<>]+|(\([^\s()<>]+\)))*\))+(?:\(([^\s()<>]+|(\([^\s()<>]+\)))*\)|[^\s`!()\[\]{};:'".,<>?«»“”‘’]))|] + +mkURL :: Text -> Maybe URL +mkURL t = + if t =~ urlRegex + then Just (URL t) + else Nothing + +urlToText :: URL -> Text +urlToText (URL t) = t + +urlToByteString :: URL -> BS8.ByteString +urlToByteString url = TE.encodeUtf8 $ urlToText url + +instance FromJSON URL where + parseJSON = withText "URL" $ \t -> + case mkURL t of + Nothing -> fail $ "Invalid URL: " ++ T.unpack t + Just url -> pure url + +instance HasCodec URL where + codec = dimapCodec URL unURL codec + +newtype AccountNumber = AccountNumber {unAccountNumber :: Text} + deriving stock (Eq, Show, Lift) + deriving newtype (ToJSON) + +-- Account numbers can have capital letters or digits +accountNumberRegex :: Regex +accountNumberRegex = [re|^[A-Z0-9]{4,17}$|] + +mkAccountNumber :: Text -> Maybe AccountNumber +mkAccountNumber t = + if t =~ accountNumberRegex + then Just (AccountNumber t) + else Nothing + +accountNumberToText :: AccountNumber -> Text +accountNumberToText (AccountNumber t) = t + +type AccountNumberMask = Refined (SizeEqualTo 4) Text + +accountNumberLastFour :: AccountNumber -> AccountNumberMask +accountNumberLastFour (AccountNumber n) = + reallyUnsafeRefine + . T.takeEnd 4 + $ n + +accountNumberToByteString :: AccountNumber -> BS8.ByteString +accountNumberToByteString accountNumber = TE.encodeUtf8 $ accountNumberToText accountNumber + +instance FromJSON AccountNumber where + parseJSON = withText "AccountNumber" $ \t -> + case mkAccountNumber t of + Nothing -> fail $ "Invalid AccountNumber: " ++ T.unpack t + Just accountNumber -> pure accountNumber + +instance HasCodec AccountNumber where + codec = dimapCodec AccountNumber unAccountNumber codec + +compileAccountNumber :: QuasiQuoter +compileAccountNumber = + QuasiQuoter + { quoteExp = compileAccountNumber', + quotePat = error "AccountNumber is not a pattern; use accountNumberToText instead", + quoteDec = error "accountNumber is not supported at top-level", + quoteType = error "accountNumber is not supported as a type" + } + where + compileAccountNumber' :: String -> Q Exp + compileAccountNumber' s = case mkAccountNumber (T.pack s) of + Nothing -> fail ("Invalid AccountNumber: " ++ s ++ ". Must be 4-17 digits, with no other characters.") + Just accountNumber -> [|accountNumber|] + +newtype RoutingNumber = RoutingNumber {unRoutingNumber :: Text} + deriving stock (Show, Lift) + deriving newtype (Eq, ToJSON) + +routingNumberRegex :: Regex +routingNumberRegex = [re|^[0-9]{9}$|] + +mkRoutingNumber :: Text -> Maybe RoutingNumber +mkRoutingNumber t = + if t =~ routingNumberRegex + then Just (RoutingNumber t) + else Nothing + +routingNumberToText :: RoutingNumber -> Text +routingNumberToText (RoutingNumber t) = t + +routingNumberToByteString :: RoutingNumber -> BS8.ByteString +routingNumberToByteString routingNumber = TE.encodeUtf8 $ routingNumberToText routingNumber + +instance HasCodec RoutingNumber where + codec = dimapCodec RoutingNumber unRoutingNumber codec + +instance FromJSON RoutingNumber where + parseJSON = withText "RoutingNumber" $ \t -> + case mkRoutingNumber t of + Nothing -> fail $ "Invalid RoutingNumber: " ++ T.unpack t + Just routingNumber -> pure routingNumber + +compileRoutingNumber :: QuasiQuoter +compileRoutingNumber = + QuasiQuoter + { quoteExp = compileRoutingNumber', + quotePat = error "RoutingNumber is not a pattern; use routingNumberToText instead", + quoteDec = error "routingNumber is not supported at top-level", + quoteType = error "routingNumber is not supported as a type" + } + where + compileRoutingNumber' :: String -> Q Exp + compileRoutingNumber' s = case mkRoutingNumber (T.pack s) of + Nothing -> fail ("Invalid RoutingNumber: " ++ s ++ ". Must be nine digits, with no other characters.") + Just routingNumber -> [|routingNumber|] + +newtype Iban = Iban {unIban :: Text} + deriving stock (Show, Read, Lift) + deriving newtype (Eq, ToJSON) + +mkIban :: Text -> Maybe Iban +mkIban t = if T.length t <= 34 then Just (Iban t) else Nothing + +instance FromJSON Iban where + parseJSON = withText "Iban" $ \t -> case mkIban t of + Nothing -> fail $ "Invalid Iban: " ++ T.unpack t + Just iban -> pure iban + +instance HasCodec Iban where + codec = dimapCodec Iban unIban codec + +compileIban :: QuasiQuoter +compileIban = + QuasiQuoter + { quoteExp = compileIban', + quotePat = error "Iban is not a pattern - use `ibanToText` instead", + quoteDec = error "Iban is not supported at top-level", + quoteType = error "Iban is not supported as a type" + } + where + compileIban' :: String -> Q Exp + compileIban' s = case mkIban (T.pack s) of + Nothing -> fail $ "Invalid Iban: " ++ s + Just txt -> [|txt|] + +ibanToText :: Iban -> Text +ibanToText (Iban t) = t + +-- | A newtype around email text. +-- This newtype verifies the email is formatted correctly using HTML5's email regexp https:\/\/www.w3.org\/TR\/html5\/forms.html#valid-e-mail-address +newtype Email = Email {getEmailText :: Text} + deriving stock (Show, Lift) + deriving newtype (Eq, Ord, ToJSON) + +emailRegex :: Regex +emailRegex = [re|^[a-zA-Z0-9.!#$%&'*+/=?^_`{|}~-]+@[a-zA-Z0-9](?:[a-zA-Z0-9-]{0,61}[a-zA-Z0-9])?(?:\.[a-zA-Z0-9](?:[a-zA-Z0-9-]{0,61}[a-zA-Z0-9])?)*$|] + +-- | Attempt to create an email from text, returning 'Nothing' if it doesn't +-- match our email regular expression. +mkEmail :: Text -> Maybe Email +mkEmail t = + if t =~ emailRegex + then Just (Email t) + else Nothing + +-- | Convenience function for APIs that take emails as 'Text' +emailToText :: Email -> Text +emailToText = getEmailText + +-- | Convenience function for APIs that take emails as 'BS8.ByteString' +emailToByteString :: Email -> BS8.ByteString +emailToByteString email = TE.encodeUtf8 $ emailToText email + +instance HasCodec Email where + codec = dimapCodec Email getEmailText codec + +instance FromJSON Email where + parseJSON (Aeson.String t) = case mkEmail t of + Nothing -> fail $ "Invalid email address: " ++ show t + Just email -> pure email + parseJSON v = fail $ "When trying to parse an Email, expected String, encountered " ++ show v + +-- | Create an email at compile time +-- Usage: +-- > [compileEmail|dmarticus@gmail.com|] +compileEmail :: QuasiQuoter +compileEmail = + QuasiQuoter + { quoteExp = compileEmail', + quotePat = error "Email is not a pattern; use `emailToText` instead", + quoteDec = error "email is not supported at top-level", + quoteType = error "email is not supported as a type" + } + where + compileEmail' :: String -> Q Exp + compileEmail' s = case mkEmail (T.pack s) of + Nothing -> fail ("Invalid Email: " ++ s ++ ". Make sure you aren't wrapping the email in quotes.") + Just email -> [|email|] + +newtype City = City + { unCity :: Text + } + deriving (Eq, Show, ToJSON, FromJSON) + +instance HasCodec City where + codec = dimapCodec City unCity codec + +-- TODO consider adding validation. Risk here is that I block valid codes. +newtype PostalCode = PostalCode + { unPostalCode :: Text + } + deriving (Eq, Show, ToJSON, FromJSON) + +instance HasCodec PostalCode where + codec = dimapCodec PostalCode unPostalCode codec + +newtype SwiftCode = SwiftCode + { unSwiftCode :: Text + } + deriving stock (Show, Lift) + deriving newtype (Eq, Ord, ToJSON) + +swiftCountryCodes :: Set.Set Text +swiftCountryCodes = Set.fromList $ "XK" : (alphaTwoUpper <$> ([minBound .. maxBound] :: [Country])) + +swiftCodeRegex :: Regex +swiftCodeRegex = [re|^[A-Z]{6}[A-Z0-9]{2}(?:[A-Z0-9]{3})?$|] + +mkSwiftCode :: Text -> Maybe SwiftCode +mkSwiftCode txt = do + let t = T.toUpper $ T.strip txt + guard $ t =~ swiftCodeRegex + guard $ Set.member (getCountryFromSwiftCodeText t) swiftCountryCodes + pure $ SwiftCode t + +instance HasCodec SwiftCode where + codec = dimapCodec SwiftCode unSwiftCode codec + +instance FromJSON SwiftCode where + parseJSON = withText "SwiftCode" $ \t -> case mkSwiftCode t of + Nothing -> fail $ "Invalid SwiftCode: " ++ T.unpack t + Just swift -> pure swift + +compileSwiftCode :: QuasiQuoter +compileSwiftCode = + QuasiQuoter + { quoteExp = compileSwiftCode', + quotePat = error "SwiftCode is not a pattern; use swiftCodeToText instead", + quoteDec = error "SwiftCode is not supported at top-level", + quoteType = error "SwiftCode is not supported as a type" + } + where + compileSwiftCode' :: String -> Q Exp + compileSwiftCode' s = case mkSwiftCode (T.pack s) of + Nothing -> fail $ "Invalid SwiftCode: " ++ s + Just txt -> [|txt|] + +swiftCodeToText :: SwiftCode -> Text +swiftCodeToText (SwiftCode t) = t + +-- | Extracts an ISO 3166-1 alpha-2 country code (or XK for Kosovo) from a SWIFT code, e.g. BOFAUS3N -> US +getCountryFromSwiftCodeText :: Text -> Text +getCountryFromSwiftCodeText = T.take 2 . T.drop 4 + +getCountryFromSwiftCode :: SwiftCode -> Text +getCountryFromSwiftCode = getCountryFromSwiftCodeText . swiftCodeToText + +-- | SwiftCodes can be either 11 or 8 digits, this ensures you're always working with the 8 digit variety. +get8DigitSwiftCode :: SwiftCode -> SwiftCode +get8DigitSwiftCode = coerce . T.take 8 . coerce + +-- | Gets the branch code from an 11-digit SwiftCode (this is the last 3 digits of an 11-digit SwiftCode), otherwise returns Nothing. +getBranchCodeFromSwiftCode :: SwiftCode -> Maybe Text +getBranchCodeFromSwiftCode swiftCode = do + let swiftCodeText = swiftCodeToText swiftCode + guard (T.length swiftCodeText == 11) + pure (T.drop 8 swiftCodeText) + +-- TODO consider adding validation (should district be state? Can I just use an enum?) +-- District will be a state only if it's US or Canada... will need to be clever here I think. +-- Maybe can have those two fields be modeled with a sum type? +newtype District = District + { unDistrict :: Text + } + deriving (Eq, Show) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec District) + +instance HasCodec District where + codec = dimapCodec District unDistrict codec + +-- TODO: Look into making this use Country +newtype ISO3166Alpha2 = ISO3166Alpha2 + { unISO3166Alpha2 :: Text + } + deriving newtype (Eq, Show, Ord) + deriving + ( FromJSON, + ToJSON + ) + via (Autodocodec ISO3166Alpha2) + +instance HasCodec ISO3166Alpha2 where + codec = dimapCodec ISO3166Alpha2 unISO3166Alpha2 codec + +newtype TrackingReference = TrackingReference + { unTrackingReference :: Text + } + deriving (Eq, Show, ToJSON, FromJSON) + +instance HasCodec TrackingReference where + codec = dimapCodec TrackingReference unTrackingReference codec + +-- TODO consider adding validation to this type if necessary. +-- The string looks like this 0xcac04f0069e4ac9314ac4e608e99278a3bebabcd +newtype HexString = HexString + { unHexString :: Text + } + deriving (Eq, Show, ToJSON, FromJSON) + +instance HasCodec HexString where + codec = dimapCodec HexString unHexString codec + +-- TODO consider adding validation if necessary +-- From Circle's docs: "A walletId is a numeric value but should be treated as a string as format may change in the future" +newtype WalletId = WalletId + { unWalletId :: Text + } + deriving (Eq, Show, ToJSON, FromJSON) + +instance HasCodec WalletId where + codec = dimapCodec WalletId unWalletId codec + +-- TODO what to do about this orphan instance? +instance HasCodec UUID where + codec = bimapCodec f UUID.toText codec + where + f t = + case UUID.fromText t of + Nothing -> Left "Invalid Text when parsing UUID" + Just u -> Right u diff --git a/test/Tests.hs b/test/Tests.hs new file mode 100644 --- /dev/null +++ b/test/Tests.hs @@ -0,0 +1,667 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} + +module Main where + +import Circle.Client +import Circle.Types +import Control.Monad +import Control.Monad.IO.Class (liftIO) +import Data.Foldable (for_) +import Data.Maybe (fromJust) +import Data.Text as T +import Data.UUID as UUID +import Data.UUID.V4 as UUID +import Network.HTTP.Client (newManager) +import Network.HTTP.Client.TLS (tlsManagerSettings) +import System.Random +import Test.Hspec +import Test.Hspec.Expectations.Contrib (isRight) + +--------------------------------------------------------------- +-- Tests +--------------------------------------------------------------- + +main :: IO () +main = do + manager <- newManager tlsManagerSettings + config <- sandboxEnvConfig Nothing + hspec $ + parallel $ do + describe "/configuration endpoint" $ do + describe "management" $ do + it "gets configuration info" $ do + configurationInfo <- circleTest config manager getConfigurationInfo + configurationInfo `shouldSatisfy` isRight + describe "/encryption/public" $ do + it "gets public key info" $ do + keyInfo <- circleTest config manager getPublicKey + keyInfo `shouldSatisfy` isRight + describe "/channels" $ do + it "lists all channels" $ do + channels <- circleTest config manager listAllChannels + channels `shouldSatisfy` isRight + describe "/stablecoins" $ do + it "lists all stablecoins" $ do + stablecoins <- circleTest config manager listAllStablecoins + stablecoins `shouldSatisfy` isRight + -- TODO: Skip the subscription tests because I I accidentally hit my subscription limit for the sandbox account and can't add new ones + -- However, I can't delete the subscriptions either, because they're still in the 'pending' state. + -- At least this code worked and the tests proved it before it failed! + xdescribe "/notifications/subscriptions" $ do + it "creates a new subscription" $ do + subscription <- circleTest config manager $ createSubscription testSubscriptionBody + subscription `shouldSatisfy` isRight + it "deletes a subscription" $ do + randomSubscriptionId <- liftIO $ UUID.nextRandom + deletionResponse <- circleTest config manager $ deleteSubscription randomSubscriptionId + deletionResponse `shouldSatisfy` isRight + it "lists all subscription" $ do + subscriptions <- circleTest config manager listAllNotificationSubscriptions + subscriptions `shouldSatisfy` isRight + describe "/businessAccount/banks/wires endpoint" $ do + describe "create business wire account" $ do + it "creates a new business wire account" $ do + wireAccountIdempotencyKey <- liftIO $ UUID.nextRandom + newWireAccount <- circleTest config manager $ createBusinessWireAccount (testUSWireAccountDetails wireAccountIdempotencyKey) + newWireAccount `shouldSatisfy` isRight + describe "list business wire accounts" $ do + it "gets a list of business wire accounts" $ do + wireAccounts <- circleTest config manager listBusinessWireAccounts + wireAccounts `shouldSatisfy` isRight + describe "get business wire account" $ do + it "gets a single business wire account" $ do + wireAccountIdempotencyKey <- liftIO $ UUID.nextRandom + wireAccount1 <- circleTest config manager $ createBusinessWireAccount (testUSWireAccountDetails wireAccountIdempotencyKey) + wireAccount1 `shouldSatisfy` isRight + let Right CircleResponseBody {circleResponseData} = wireAccount1 + for_ circleResponseData $ \WireAccountResponseBody {..} -> do + wireAccount <- circleTest config manager $ getBusinessWireAccount wireAccountResponseBodyId + wireAccount `shouldSatisfy` isRight + it "gets wire instructions for a business wire account" $ do + wireAccountIdempotencyKey <- liftIO $ UUID.nextRandom + wireAccount2 <- circleTest config manager $ createBusinessWireAccount (testUSWireAccountDetails wireAccountIdempotencyKey) + wireAccount2 `shouldSatisfy` isRight + let Right CircleResponseBody {circleResponseData} = wireAccount2 + for_ circleResponseData $ \WireAccountResponseBody {..} -> do + wireAccountInstructions <- circleTest config manager $ getBusinessWireAccountInstructions wireAccountResponseBodyId + wireAccountInstructions `shouldSatisfy` isRight + describe "/businessAccount/balances endpoint" $ do + -- TODO: could be interesting to actually seed balances, I'll do that when I wrap that API endpoint + describe "list business account balances balances" $ do + it "should list all balances for all business wire accounts" $ do + businessBalances <- circleTest config manager listAllBusinessBalances + businessBalances `shouldSatisfy` isRight + describe "/businessAccount/banks/sen endpoint" $ do + describe "create SEN account" $ do + it "creates a new SEN account" $ do + senAccountIdempotencyKey <- liftIO $ UUID.nextRandom + newSENAccount <- circleTest config manager $ createSENAccount (testSENAccountDetails senAccountIdempotencyKey) + newSENAccount `shouldSatisfy` isRight + describe "list SEN accounts" $ do + it "gets a list of SEN accounts" $ do + senAccounts <- circleTest config manager listSENAccounts + senAccounts `shouldSatisfy` isRight + describe "get SEN account" $ do + it "gets a single SEN account" $ do + senAccountIdempotencyKey <- liftIO $ UUID.nextRandom + senAccount1 <- circleTest config manager $ createSENAccount (testSENAccountDetails senAccountIdempotencyKey) + senAccount1 `shouldSatisfy` isRight + let Right CircleResponseBody {circleResponseData} = senAccount1 + for_ circleResponseData $ \SENAccountResponseBody {..} -> do + senAccount <- circleTest config manager $ getSENAccount senAccountResponseBodyId + senAccount `shouldSatisfy` isRight + it "gets instructions for a SEN account" $ do + senAccountIdempotencyKey <- liftIO $ UUID.nextRandom + senAccount2 <- circleTest config manager $ createSENAccount (testSENAccountDetails senAccountIdempotencyKey) + senAccount2 `shouldSatisfy` isRight + let Right CircleResponseBody {circleResponseData} = senAccount2 + for_ circleResponseData $ \SENAccountResponseBody {..} -> do + senAccountInstructions <- circleTest config manager $ getSENAccountInstructions senAccountResponseBodyId + senAccountInstructions `shouldSatisfy` isRight + describe "/balances endpoint" $ do + -- TODO: need to actually seed balances, I'll do that when I wrap that API endpoint + describe "list balances" $ do + it "should list all balances for the newly-created wire account" $ do + balances <- circleTest config manager listAllBalances + balances `shouldSatisfy` isRight + describe "/businessAccount/transfers endpoint" $ do + describe "list transfers" $ do + it "should list all transfers for a given business account" $ do + transfers <- circleTest config manager listAllBusinessAccountTransfers + transfers `shouldSatisfy` isRight + describe "get transfer" $ do + it "will attempt to return transfer data for a single transfer" $ do + testTransferId <- liftIO UUID.nextRandom + transfer <- circleTest config manager (getBusinessAccountTransfer testTransferId) + transfer `shouldSatisfy` isRight + describe "create transfer" $ do + it "will attempt to create a new transfer" $ do + businessTransferRequestIdempotencyKey <- liftIO $ UUID.nextRandom + transferDestinationAddress <- liftIO $ UUID.nextRandom + newTransfer <- circleTest config manager $ createBusinessAccountTransfer (testBusinessTransferRequestBody businessTransferRequestIdempotencyKey transferDestinationAddress) + newTransfer `shouldSatisfy` isRight + describe "/businessAccount/wallets/addresses endpoint" $ do + describe "list business account deposit addresses" $ do + it "should list all business account deposit addresses for a given business account" $ do + businessAccountRecipientAddresses <- circleTest config manager listAllBusinessAccountRecipientAddresses + businessAccountRecipientAddresses `shouldSatisfy` isRight + describe "create recipient address" $ do + it "will attempt to create a recipient address" $ do + recipientAddressIdempotencyKey <- liftIO $ UUID.nextRandom + -- need to do this because each addressId needs to be unique, even in the sandbox + randomHexString <- replicateM 20 (randomRIO ('a', 'z')) + recipientAddress <- circleTest config manager $ createBusinessAccountRecipientAddress (testRecipientAddressRequestBody recipientAddressIdempotencyKey (HexString (T.pack randomHexString))) + recipientAddress `shouldSatisfy` isRight + describe "list business account deposit addresses" $ do + it "should list all deposit addresses for a given business account" $ do + businessAccountDepositAddresses <- circleTest config manager listAllBusinessAccountDepositAddresses + businessAccountDepositAddresses `shouldSatisfy` isRight + describe "create business account deposit address" $ do + it "will attempt to create a new business account deposit address" $ do + let depositAddressIdempotencyKey = fromJust $ UUID.fromText "ba943ff1-ca16-49b2-ba55-1057e70ca5c7" + businessAccountDepositAddress <- circleTest config manager $ createBusinessAccountDepositAddress (testDepositAddressRequestBody depositAddressIdempotencyKey) + businessAccountDepositAddress `shouldSatisfy` isRight + describe "/businessAccount/deposits endpoint" $ do + describe "list deposits" $ do + it "should list all deposits" $ do + deposits <- circleTest config manager listAllBusinessAccountDeposits + deposits `shouldSatisfy` isRight + describe "/businessAccount/payouts endpoint" $ do + describe "list payouts" $ do + -- NB: This request fails without money in the account. + it " should list a subset of payouts for a given business account given the query params" $ do + subsetOfPayouts <- circleTest config manager $ listAllBusinessAccountPayouts -&- PaginationQueryParams (PageBefore "a8899b8e-782a-4526-b674-0efe1e04526d") + subsetOfPayouts `shouldSatisfy` isRight + it "should list all payouts for a given business account" $ do + payouts <- circleTest config manager listAllBusinessAccountPayouts + payouts `shouldSatisfy` isRight + describe "get payout" $ do + it "will attempt to return the payout data for the payout Id provided" $ do + fakePayoutId <- liftIO $ UUID.nextRandom + failedPayout <- circleTest config manager (getBusinessAccountPayout fakePayoutId) + failedPayout `shouldSatisfy` isRight + let Right CircleResponseBody {circleResponseMessage} = failedPayout + -- NB: this request will fail if there's no payoutId + circleResponseMessage `shouldBe` Just (ResponseMessage "Resource not found") + describe "create payout" $ do + it "fails to create a new payout because no such account exists" $ do + businessPayoutIdempotencyKey <- liftIO $ UUID.nextRandom + destinationAccountId <- liftIO $ UUID.nextRandom + failedPayoutResultsNoAccount <- circleTest config manager $ createBusinessAccountPayout (testBusinessPayoutRequestBody businessPayoutIdempotencyKey destinationAccountId) + failedPayoutResultsNoAccount `shouldSatisfy` isRight + let Right CircleResponseBody {circleResponseMessage} = failedPayoutResultsNoAccount + circleResponseMessage `shouldBe` Just (ResponseMessage "Fiat account not found") + it "fails to create a new payout because the account has insufficient funds" $ do + wireAccountIdempotencyKey <- liftIO $ UUID.nextRandom + createdAccount <- circleTest config manager $ createBusinessWireAccount (testUSWireAccountDetails wireAccountIdempotencyKey) + createdAccount `shouldSatisfy` isRight + let Right CircleResponseBody {circleResponseData} = createdAccount + for_ circleResponseData $ \WireAccountResponseBody {..} -> do + payoutIdempotencyKey <- liftIO $ UUID.nextRandom + -- this request will fail because there is no money in the account + -- but the _method_ still works + failedPayoutResultInsufficientFunds <- circleTest config manager $ createBusinessAccountPayout (testBusinessPayoutRequestBody payoutIdempotencyKey wireAccountResponseBodyId) + failedPayoutResultInsufficientFunds `shouldSatisfy` isRight + let Right CircleResponseBody {circleResponseMessage} = failedPayoutResultInsufficientFunds + circleResponseMessage `shouldBe` Just (ResponseMessage "Account has insufficient funds") + describe "/payments endpoint" $ do + describe "create payment" $ do + it "should create a payment" $ do + paymentRequestIdempotencyKey <- liftIO $ UUID.nextRandom + paymentSourceId <- liftIO $ UUID.nextRandom + payment <- circleTest config manager $ createPayment (testFiatPayment paymentRequestIdempotencyKey paymentSourceId) + payment `shouldSatisfy` isRight + describe "get payment" $ do + it "should get a newly-created payment" $ do + paymentRequestIdempotencyKey <- liftIO $ UUID.nextRandom + paymentSourceId <- liftIO $ UUID.nextRandom + newlyCreatedPayment <- circleTest config manager $ createPayment (testFiatPayment paymentRequestIdempotencyKey paymentSourceId) + newlyCreatedPayment `shouldSatisfy` isRight + let Right CircleResponseBody {circleResponseData} = newlyCreatedPayment + let Just (This FiatOrCryptoPaymentResponseBody {fiatOrCryptoPaymentId}) = circleResponseData + thePayment <- circleTest config manager $ getPayment fiatOrCryptoPaymentId + thePayment `shouldSatisfy` isRight + -- NB: skipping this failing suite; these test don't pass because the payment will fail immediately if it's in the sandbox + xdescribe "cancel payment" $ do + it "should cancel a newly-created payment" $ do + paymentRequestIdempotencyKey <- liftIO $ UUID.nextRandom + paymentSourceId <- liftIO $ UUID.nextRandom + paymentToCancel <- circleTest config manager $ createPayment (testFiatPayment paymentRequestIdempotencyKey paymentSourceId) + paymentToCancel `shouldSatisfy` isRight + let Right CircleResponseBody {circleResponseData} = paymentToCancel + let Just (This FiatOrCryptoPaymentResponseBody {fiatOrCryptoPaymentId}) = circleResponseData + cancelPaymentIdempotencyKey <- liftIO $ UUID.nextRandom + cancellablePayment <- circleTest config manager $ cancelPayment fiatOrCryptoPaymentId (testCancelPaymentBody cancelPaymentIdempotencyKey) + cancellablePayment `shouldSatisfy` isRight + -- NB: skipping this failing test; the test doesn't pass because the payment will fail immediately if it's in the sandbox + xdescribe "refund payment" $ do + it "should refund a newly-created payment" $ do + paymentRequestIdempotencyKey <- liftIO $ UUID.nextRandom + paymentSourceId <- liftIO $ UUID.nextRandom + paymentToRefund <- circleTest config manager $ createPayment (testFiatPayment paymentRequestIdempotencyKey paymentSourceId) + paymentToRefund `shouldSatisfy` isRight + let Right CircleResponseBody {circleResponseData} = paymentToRefund + let Just (This FiatOrCryptoPaymentResponseBody {fiatOrCryptoPaymentId}) = circleResponseData + refundPaymentIdempotencyKey <- liftIO $ UUID.nextRandom + refundablePayment <- circleTest config manager $ refundPayment fiatOrCryptoPaymentId (testRefundPaymentBody refundPaymentIdempotencyKey) + refundablePayment `shouldSatisfy` isRight + describe "list payments" $ do + it "should list all payments" $ do + payments <- circleTest config manager listAllPayments + payments `shouldSatisfy` isRight + let Right CircleResponseBody {circleResponseCode, circleResponseMessage} = payments + circleResponseCode `shouldBe` Nothing + circleResponseMessage `shouldBe` Nothing + describe "mock payments" $ do + it "should create a mock silvergate payment" $ do + mockSilvergatePayment <- circleTest config manager $ createMockSilvergatePayment mockSilvergatePaymentBody + mockSilvergatePayment `shouldSatisfy` isRight + it "should create a mock wire payment" $ do + mockSilvergatePayment <- circleTest config manager $ createMockWirePayment mockWirePaymentBody + mockSilvergatePayment `shouldSatisfy` isRight + it "should create a mock SEPA payment" $ do + mockSepaPayment <- circleTest config manager $ createMockSEPAPayment mockSEPAPaymentBody + mockSepaPayment `shouldSatisfy` isRight + describe "/transfers endpoint" $ do + describe "create an on-chain transfer" $ do + it "should create an on-chain transfers" $ do + onChainTransferIdempotencyKey <- liftIO $ UUID.nextRandom + newOnChainTransfer <- circleTest config manager $ createOnChainTransfer (testOnChainTransferRequestBody onChainTransferIdempotencyKey testSourceWallet testDestinationWallet) + newOnChainTransfer `shouldSatisfy` isRight + describe "list on-chain transfers" $ do + it "should list all on-chain transfers" $ do + onChainTransfers <- circleTest config manager listAllOnChainTransfers + onChainTransfers `shouldSatisfy` isRight + describe "get an on-chain transfer" $ do + it "should get an on-chain transfers" $ do + uuid <- liftIO $ UUID.nextRandom + onChainTransfer <- circleTest config manager $ getOnChainTransfer uuid + onChainTransfer `shouldSatisfy` isRight + describe "/cards endpoint" $ do + describe "create card" $ do + it "should create a new card, get it, and then update it" $ do + cardIdempotencyKeyUUID <- liftIO $ UUID.nextRandom + newCard <- circleTest config manager $ createCard (testCreateCardRequestBody cardIdempotencyKeyUUID testPaymentMetadata) + newCard `shouldSatisfy` isRight + let Right CircleResponseBody {circleResponseCode, circleResponseMessage, circleResponseData} = newCard + circleResponseCode `shouldBe` Nothing + circleResponseMessage `shouldBe` Nothing + for_ circleResponseData $ \CardResponseBody {..} -> do + card <- circleTest config manager $ getCard cardId + card `shouldSatisfy` isRight + updatedCard <- circleTest config manager $ updateCard cardId testUpdateCardBody + updatedCard `shouldSatisfy` isRight + describe "list cards" $ do + it "should list all cards" $ do + cards <- circleTest config manager listAllCards + cards `shouldSatisfy` isRight + describe "banks/wires endpoint" $ do + describe "create wire account" $ do + it "creates a new wire account" $ do + wireAccountIdempotencyKey <- liftIO $ UUID.nextRandom + newWireAccount <- circleTest config manager $ createWireAccount (testUSWireAccountDetails wireAccountIdempotencyKey) + newWireAccount `shouldSatisfy` isRight + describe "get wire account" $ do + it "gets a single wire account" $ do + wireAccountIdempotencyKey <- liftIO $ UUID.nextRandom + wireAccount1 <- circleTest config manager $ createWireAccount (testUSWireAccountDetails wireAccountIdempotencyKey) + wireAccount1 `shouldSatisfy` isRight + let Right CircleResponseBody {circleResponseData} = wireAccount1 + for_ circleResponseData $ \WireAccountResponseBody {..} -> do + wireAccount <- circleTest config manager $ getWireAccount wireAccountResponseBodyId + wireAccount `shouldSatisfy` isRight + it "gets wire instructions for a wire account" $ do + wireAccountIdempotencyKey <- liftIO $ UUID.nextRandom + wireAccount2 <- circleTest config manager $ createWireAccount (testUSWireAccountDetails wireAccountIdempotencyKey) + wireAccount2 `shouldSatisfy` isRight + let Right CircleResponseBody {circleResponseData} = wireAccount2 + for_ circleResponseData $ \WireAccountResponseBody {..} -> do + wireAccountInstructions <- circleTest config manager $ getWireAccountInstructions wireAccountResponseBodyId + wireAccountInstructions `shouldSatisfy` isRight + describe "/settlements endpoint" $ do + describe "list all settlements" $ do + it "should list all settlements" $ do + settlements <- circleTest config manager listAllSettlements + settlements `shouldSatisfy` isRight + describe "/reversals endpoint" $ do + describe "list all reversals" $ do + it "should list all reversals" $ do + reversals <- circleTest config manager listAllACHReversals + reversals `shouldSatisfy` isRight + describe "/paymentIntents endpoint" $ do + -- NB: these all 403 in the sandbox. L L L. + describe "list all paymentIntents" $ do + it "should list all paymentIntents" $ do + paymentIntents <- circleTest config manager listAllPaymentIntents + paymentIntents `shouldSatisfy` isRight + describe "create new paymentIntent" $ do + it "should create a new paymentIntent" $ do + createPaymentIntentIdempotencyKey <- liftIO $ UUID.nextRandom + paymentIntent <- circleTest config manager $ createPaymentIntent (testPaymentIntentRequestBody createPaymentIntentIdempotencyKey) + paymentIntent `shouldSatisfy` isRight + describe "/payouts endpoint" $ do + describe "list all payouts from a non-business account" $ do + it "should list all payouts" $ do + payouts <- circleTest config manager listAllPayouts + payouts `shouldSatisfy` isRight + describe "create a new payout from a non-business account" $ do + it "should create a new payout" $ do + createPayoutIdempotencyKey <- liftIO $ UUID.nextRandom + destinationAccountId <- liftIO $ UUID.nextRandom + payout <- circleTest config manager $ createPayout (testPayoutRequestBody createPayoutIdempotencyKey destinationAccountId) + payout `shouldSatisfy` isRight + describe "get an existing payout from a non-business account" $ do + it "should get a payout" $ do + testPayoutId <- liftIO $ UUID.nextRandom + payout <- circleTest config manager $ getPayout testPayoutId + payout `shouldSatisfy` isRight + describe "/returns endpoint" $ do + describe "list all returns" $ do + it "should list all wire and ACH payout returns" $ do + payouts <- circleTest config manager listAllReturns + payouts `shouldSatisfy` isRight + describe "/wallets endpoint" $ do + describe "list all wallets" $ do + it "should retrieve a list of a user's wallets" $ do + wallets <- circleTest config manager listAllWallets + wallets `shouldSatisfy` isRight + describe "get an existing wallet" $ do + it "should get a wallet" $ do + testWalletId <- liftIO $ UUID.nextRandom + wallet <- circleTest config manager $ getWallet testWalletId + wallet `shouldSatisfy` isRight + describe "create a new end user wallet" $ do + it "should create a new wallet" $ do + testWalletIdempotencyKey <- liftIO $ UUID.nextRandom + newWallet <- circleTest config manager $ createWallet (testCreateWalletRequestBody testWalletIdempotencyKey) + newWallet `shouldSatisfy` isRight + describe "create deposit address" $ do + -- NB: this tests 404s bc no wallet Id + it "will attempt to create a new deposit address for a given wallet" $ do + testRandomWalletId <- liftIO $ UUID.nextRandom + depositAddressIdempotencyKey <- liftIO $ UUID.nextRandom + depositAddress <- circleTest config manager $ createDepositAddress testRandomWalletId (testDepositAddressRequestBody depositAddressIdempotencyKey) + depositAddress `shouldSatisfy` isRight + describe "list recipient addresses associated with a wallet ID" $ do + -- TODO: this tests 404s bc no wallet Id + it "should list all deposit addresses for a given account" $ do + testRandomWalletId <- liftIO $ UUID.nextRandom + recipientAddresses <- circleTest config manager $ listAllAddresses testRandomWalletId + recipientAddresses `shouldSatisfy` isRight + +--------------------------------------------------------------- +-- Test Data +--------------------------------------------------------------- + +testUSWireAccountDetails :: UUID -> WireAccountRequestBody +testUSWireAccountDetails wireAccountIdempotencyKey = + USBankAccount + ( USBankAccountRequestBody + wireAccountIdempotencyKey + [compileAccountNumber|446043103366|] + [compileRoutingNumber|021000021|] + ( BillingDetails + "Test Recipient" + (City "Snoqualmie") + (ISO3166Alpha2 "US") + (AddressLine "6501 Railroad Avenue SE") + (Just (AddressLine "Room 315")) + (Just (District "WA")) + (PostalCode "85283") + ) + ( BankAddress + (Just "Test Bank") + (Just (City "Snoqualmie")) + (Just (ISO3166Alpha2 "US")) + (Just (AddressLine "6501 Railroad Avenue SE")) + (Just (AddressLine "Room 315")) + (Just (District "WA")) + ) + ) + +testBusinessTransferRequestBody :: UUID -> UUID -> BusinessTransferRequestBody +testBusinessTransferRequestBody businessTransferRequestIdempotencyKey transferDestinationAddress = + BusinessTransferRequestBody + businessTransferRequestIdempotencyKey + ( TransferDestination + VerifiedBlockchain + transferDestinationAddress + ) + ( MoneyAmount + (Amount "100.00") + USD + ) + +testOnChainTransferRequestBody :: UUID -> SourceWallet -> DestinationWallet -> OnChainTransferRequestBody +testOnChainTransferRequestBody onChainTransferIdempotencyKey sourceWallet destinationWallet = + OnChainTransferRequestBody + onChainTransferIdempotencyKey + sourceWallet + (This destinationWallet) + ( MoneyAmount + (Amount "100.00") + USD + ) + +testRecipientAddressRequestBody :: UUID -> HexString -> RecipientAddressRequestBody +testRecipientAddressRequestBody recipientAddressIdempotencyKey blockchainAddress = + RecipientAddressRequestBody + recipientAddressIdempotencyKey + blockchainAddress + Nothing + ChainETH + USD + "test address" + +testDepositAddressRequestBody :: UUID -> DepositAddressRequestBody +testDepositAddressRequestBody depositAddressIdempotencyKey = + DepositAddressRequestBody + depositAddressIdempotencyKey + USD + ChainETH + +testSENAccountDetails :: UUID -> SENAccountRequestBody +testSENAccountDetails senAccountIdempotencyKey = + SENAccountRequestBody + senAccountIdempotencyKey + [compileAccountNumber|446043103367|] + (Just USD) + +testSubscriptionBody :: SubscriptionRequestBody +testSubscriptionBody = + SubscriptionRequestBody "https://example.org/handler/for/notifications" + +testPaymentMetadata :: RequestMetadata +testPaymentMetadata = + RequestMetadata + [compileEmail|dylan@test.com|] + Nothing + (SessionId "DE6FA86F60BB47B379307F851E238617") + (IPAddress "244.28.239.130") + +testPayoutMetadata :: PayoutMetadata +testPayoutMetadata = + PayoutMetadata + [compileEmail|dylan@test.com|] + +testCreateCardRequestBody :: UUID -> RequestMetadata -> CreateCardRequestBody +testCreateCardRequestBody cardIdempotencyKeyUUID = + CreateCardRequestBody + cardIdempotencyKeyUUID + (Just "key1") + (Just "LS0tLS1CRUdJTiBQR1AgTUVTU0FHRS0tLS0tCgp3Y0JNQTBYV1NGbEZScFZoQVFmL2J2bVVkNG5LZ3dkbExKVTlEdEFEK0p5c0VOTUxuOUlRUWVGWnZJUWEKMGgzQklpRFNRU0RMZmI0NEs2SXZMeTZRbm54bmFLcWx0MjNUSmtPd2hGWFIrdnNSMU5IbnVHN0lUNWJECmZzeVdleXlNK1JLNUVHV0thZ3NmQ2tWamh2NGloY29xUnlTTGtJbWVmRzVaR0tMRkJTTTBsTFNPWFRURQpiMy91eU1zMVJNb3ZiclNvbXkxa3BybzUveWxabWVtV2ZsU1pWQlhNcTc1dGc1YjVSRVIraXM5ckc0cS8KMXl0M0FOYXA3UDhKekFhZVlyTnVNZGhGZFhvK0NFMC9CQnN3L0NIZXdhTDk4SmRVUEV0NjA5WFRHTG9kCjZtamY0YUtMQ01xd0RFMkNVb3dPdE8vMzVIMitnVDZKS3FoMmtjQUQyaXFlb3luNWcralRHaFNyd3NKWgpIdEphQWVZZXpGQUVOaFo3Q01IOGNsdnhZVWNORnJuNXlMRXVGTkwwZkczZy95S3loclhxQ0o3UFo5b3UKMFVxQjkzQURKWDlJZjRBeVQ2bU9MZm9wUytpT2lLall4bG1NLzhlVWc3OGp1OVJ5T1BXelhyTzdLWTNHClFSWm8KPXc1dEYKLS0tLS1FTkQgUEdQIE1FU1NBR0UtLS0tLQo") + ( BillingDetails + "Test Recipient" + (City "Snoqualmie") + (ISO3166Alpha2 "US") + (AddressLine "6501 Railroad Avenue SE") + (Just (AddressLine "Room 315")) + (Just (District "WA")) + (PostalCode "85283") + ) + 12 + 2027 + +testFiatPayment :: UUID -> UUID -> CreatePaymentRequestBody +testFiatPayment paymentRequestIdempotencyKey paymentSourceId = + CreatePaymentRequestBody + paymentRequestIdempotencyKey + "key1" + testPaymentMetadata + ( MoneyAmount + (Amount "100.00") + USD + ) + (Just True) + VerificationCVV + Nothing + Nothing + ( PaymentSource + paymentSourceId + Card + ) + Nothing + Nothing + Nothing + +testCancelPaymentBody :: UUID -> CancelPaymentRequestBody +testCancelPaymentBody cancelPaymentIdempotencyKey = + CancelPaymentRequestBody + cancelPaymentIdempotencyKey + (Just CancelPaymentReasonDuplicate) + +testRefundPaymentBody :: UUID -> RefundPaymentRequestBody +testRefundPaymentBody refundPaymentIdempotencyKey = + RefundPaymentRequestBody + refundPaymentIdempotencyKey + ( MoneyAmount + (Amount "100.00") + USD + ) + Nothing + +testBusinessPayoutRequestBody :: UUID -> UUID -> BusinessPayoutRequestBody +testBusinessPayoutRequestBody payoutIdempotencyKey wireAccountId = + BusinessPayoutRequestBody + payoutIdempotencyKey + ( DestinationBankAccount + Wire + wireAccountId + Nothing + ) + ( MoneyAmount + (Amount "100.00") + USD + ) + +testPayoutRequestBody :: UUID -> UUID -> PayoutRequestBody +testPayoutRequestBody payoutIdempotencyKey wireAccountId = + PayoutRequestBody + payoutIdempotencyKey + Nothing + ( DestinationBankAccount + Wire + wireAccountId + Nothing + ) + ( MoneyAmount + (Amount "100.00") + USD + ) + testPayoutMetadata + +testUpdateCardBody :: UpdateCardRequestBody +testUpdateCardBody = + UpdateCardRequestBody + (Just "key1") + (Just "LS0tLS1CRUdJTiBQR1AgTUVTU0FHRS0tLS0tCgp3Y0JNQTBYV1NGbEZScFZoQVFmL2J2bVVkNG5LZ3dkbExKVTlEdEFEK0p5c0VOTUxuOUlRUWVGWnZJUWEKMGgzQklpRFNRU0RMZmI0NEs2SXZMeTZRbm54bmFLcWx0MjNUSmtPd2hGWFIrdnNSMU5IbnVHN0lUNWJECmZzeVdleXlNK1JLNUVHV0thZ3NmQ2tWamh2NGloY29xUnlTTGtJbWVmRzVaR0tMRkJTTTBsTFNPWFRURQpiMy91eU1zMVJNb3ZiclNvbXkxa3BybzUveWxabWVtV2ZsU1pWQlhNcTc1dGc1YjVSRVIraXM5ckc0cS8KMXl0M0FOYXA3UDhKekFhZVlyTnVNZGhGZFhvK0NFMC9CQnN3L0NIZXdhTDk4SmRVUEV0NjA5WFRHTG9kCjZtamY0YUtMQ01xd0RFMkNVb3dPdE8vMzVIMitnVDZKS3FoMmtjQUQyaXFlb3luNWcralRHaFNyd3NKWgpIdEphQWVZZXpGQUVOaFo3Q01IOGNsdnhZVWNORnJuNXlMRXVGTkwwZkczZy95S3loclhxQ0o3UFo5b3UKMFVxQjkzQURKWDlJZjRBeVQ2bU9MZm9wUytpT2lLall4bG1NLzhlVWc3OGp1OVJ5T1BXelhyTzdLWTNHClFSWm8KPXc1dEYKLS0tLS1FTkQgUEdQIE1FU1NBR0UtLS0tLQo") + 1 + 2028 + +testCreateWalletRequestBody :: UUID -> CreateWalletRequestBody +testCreateWalletRequestBody idempotencyKey = + CreateWalletRequestBody + idempotencyKey + (Just "test wallet") + +testPaymentIntentRequestBody :: UUID -> CreatePaymentIntentRequestBody +testPaymentIntentRequestBody createPaymentIntentIdempotencyKey = + CreatePaymentIntentRequestBody + createPaymentIntentIdempotencyKey + ( MoneyAmount + (Amount "100.00") + USD + ) + USD + [testPaymentMethod] + +testPaymentMethod :: PaymentMethodData +testPaymentMethod = + PaymentMethodData + "blockchain" + ChainETH + Nothing + +testIdentity :: Identity +testIdentity = + Identity + Individual + "Mario" + [ Address + (Just (City "Snoqualmie")) + (Just (ISO3166Alpha2 "US")) + (Just (AddressLine "6501 Railroad Avenue SE")) + (Just (AddressLine "Room 315")) + (Just (District "WA")) + ] + +testSourceWallet :: SourceWallet +testSourceWallet = + SourceWallet + Wallet + (WalletId "987654321") + [testIdentity] + +testDestinationWallet :: DestinationWallet +testDestinationWallet = + DestinationWallet + Wallet + (WalletId "123456789") + Nothing + Nothing + +mockSilvergatePaymentBody :: MockSenOrWirePaymentRequestBody +mockSilvergatePaymentBody = + MockSenOrWirePaymentRequestBody + (TrackingReference "CIR13FB13A") + ( MoneyAmount + (Amount "100.00") + USD + ) + ( MockBeneficiaryBankDetails + [compileAccountNumber|446043103366|] + ) + +mockWirePaymentBody :: MockSenOrWirePaymentRequestBody +mockWirePaymentBody = + MockSenOrWirePaymentRequestBody + (TrackingReference "CIR13FB13A") + ( MoneyAmount + (Amount "100.00") + USD + ) + ( MockBeneficiaryBankDetails + [compileAccountNumber|446043103366|] + ) + +mockSEPAPaymentBody :: MockSEPAPaymentRequestBody +mockSEPAPaymentBody = + MockSEPAPaymentRequestBody + (TrackingReference "CIR13FB13A") + ( MoneyAmount + (Amount "100.00") + USD + )