-------------------------------------------
-------------------------------------------
{-# 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 :: WireAccountRequestBody
-> CircleAPIRequest WireAccountRequest TupleBS8 ByteString
createBusinessWireAccount WireAccountRequestBody
wireAccountBody = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest WireAccountRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodPost Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"businessAccount/banks/wires"
    params :: Params b c
params = case WireAccountRequestBody
wireAccountBody of
      USBankAccount USBankAccountRequestBody
usBankAccountBody -> Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params (Body -> Maybe Body
forall a. a -> Maybe a
Just (Body -> Maybe Body) -> Body -> Maybe Body
forall a b. (a -> b) -> a -> b
$ ByteString -> Body
Body (USBankAccountRequestBody -> ByteString
forall a. ToJSON a => a -> ByteString
encode USBankAccountRequestBody
usBankAccountBody)) []
      IBANBankAccount IBANBankAccountRequestBody
ibanBankAccountBody -> Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params (Body -> Maybe Body
forall a. a -> Maybe a
Just (Body -> Maybe Body) -> Body -> Maybe Body
forall a b. (a -> b) -> a -> b
$ ByteString -> Body
Body (IBANBankAccountRequestBody -> ByteString
forall a. ToJSON a => a -> ByteString
encode IBANBankAccountRequestBody
ibanBankAccountBody)) []
      NonIBANBankAccount NonIBANBankAccountRequestBody
nonIBANBankAccountBody -> Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params (Body -> Maybe Body
forall a. a -> Maybe a
Just (Body -> Maybe Body) -> Body -> Maybe Body
forall a b. (a -> b) -> a -> b
$ ByteString -> Body
Body (NonIBANBankAccountRequestBody -> ByteString
forall a. ToJSON a => a -> ByteString
encode NonIBANBankAccountRequestBody
nonIBANBankAccountBody)) []

-- | Get a list of business account wire accounts
-- https://developers.circle.com/reference/listbusinesswireaccounts
listBusinessWireAccounts :: CircleAPIRequest WireAccountsRequest TupleBS8 BSL.ByteString
listBusinessWireAccounts :: CircleAPIRequest WireAccountsRequest TupleBS8 ByteString
listBusinessWireAccounts = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest WireAccountsRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"businessAccount/banks/wires"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
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 :: UUID -> CircleAPIRequest WireAccountRequest TupleBS8 ByteString
getBusinessWireAccount UUID
wireAccountId = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest WireAccountRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"businessAccount/banks/wires/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UUID -> Text
UUID.toText UUID
wireAccountId
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
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 :: UUID
-> CircleAPIRequest WireInstructionsRequest TupleBS8 ByteString
getBusinessWireAccountInstructions UUID
wireAccountId = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest WireInstructionsRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"businessAccount/banks/wires/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UUID -> Text
UUID.toText UUID
wireAccountId Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/instructions"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
Nothing []

---------------------------------------------------------------
-- /businessAccount/balances endpoint
---------------------------------------------------------------

-- | List all business balances
-- https://developers.circle.com/reference/listbusinesspayouts
listAllBusinessBalances :: CircleAPIRequest BalanceRequest TupleBS8 BSL.ByteString
listAllBusinessBalances :: CircleAPIRequest BalanceRequest TupleBS8 ByteString
listAllBusinessBalances = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest BalanceRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"businessAccount/balances"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
Nothing []

---------------------------------------------------------------
-- /configuration endpoint
---------------------------------------------------------------

-- | Get configuration info
-- https://developers.circle.com/reference/getaccountconfig
getConfigurationInfo :: CircleAPIRequest ConfigurationRequest TupleBS8 BSL.ByteString
getConfigurationInfo :: CircleAPIRequest ConfigurationRequest TupleBS8 ByteString
getConfigurationInfo = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest ConfigurationRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"configuration"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
Nothing []

---------------------------------------------------------------
-- /encryption/public endpoint
---------------------------------------------------------------

-- | Get encryption info
-- https://developers.circle.com/reference/getpublickey
getPublicKey :: CircleAPIRequest EncryptionRequest TupleBS8 BSL.ByteString
getPublicKey :: CircleAPIRequest EncryptionRequest TupleBS8 ByteString
getPublicKey = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest EncryptionRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"encryption/public"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
Nothing []

---------------------------------------------------------------
-- /channels endpoint
---------------------------------------------------------------

-- | List all channels
-- https://developers.circle.com/reference/listchannels
listAllChannels :: CircleAPIRequest ChannelsRequest TupleBS8 BSL.ByteString
listAllChannels :: CircleAPIRequest ChannelsRequest TupleBS8 ByteString
listAllChannels = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest ChannelsRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"channels"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
Nothing []

---------------------------------------------------------------
-- /stablecoins endpoint
---------------------------------------------------------------

-- | List all stablecoins
-- https://developers.circle.com/reference/listchannels
listAllStablecoins :: CircleAPIRequest StablecoinsRequest TupleBS8 BSL.ByteString
listAllStablecoins :: CircleAPIRequest StablecoinsRequest TupleBS8 ByteString
listAllStablecoins = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest StablecoinsRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"stablecoins"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
Nothing []

---------------------------------------------------------------
-- /notifications/subscriptions endpoint
---------------------------------------------------------------

-- | List all subscriptions
-- https://developers.circle.com/reference/listsubscriptions
listAllNotificationSubscriptions :: CircleAPIRequest SubscriptionsRequest TupleBS8 BSL.ByteString
listAllNotificationSubscriptions :: CircleAPIRequest SubscriptionsRequest TupleBS8 ByteString
listAllNotificationSubscriptions = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest SubscriptionsRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"notifications/subscriptions"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
Nothing []

-- | Create new subscription
-- https://developers.circle.com/reference/createsubscribtion
createSubscription :: SubscriptionRequestBody -> CircleAPIRequest SubscriptionRequest TupleBS8 BSL.ByteString
createSubscription :: SubscriptionRequestBody
-> CircleAPIRequest SubscriptionRequest TupleBS8 ByteString
createSubscription SubscriptionRequestBody
subscriptionBody = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest SubscriptionRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodPost Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"notifications/subscriptions"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params (Body -> Maybe Body
forall a. a -> Maybe a
Just (Body -> Maybe Body) -> Body -> Maybe Body
forall a b. (a -> b) -> a -> b
$ ByteString -> Body
Body (SubscriptionRequestBody -> ByteString
forall a. ToJSON a => a -> ByteString
encode SubscriptionRequestBody
subscriptionBody)) []

-- | Delete subscription
-- https://developers.circle.com/reference/deletesubscribtion
deleteSubscription :: UUID -> CircleAPIRequest SubscriptionsRequest TupleBS8 BSL.ByteString
deleteSubscription :: UUID -> CircleAPIRequest SubscriptionsRequest TupleBS8 ByteString
deleteSubscription UUID
resourceId = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest SubscriptionsRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodDelete Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"notifications/subscriptions" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UUID -> Text
UUID.toText UUID
resourceId
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
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 :: CircleAPIRequest PayoutsRequest TupleBS8 ByteString
listAllBusinessAccountPayouts = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest PayoutsRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"businessAccount/payouts"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
Nothing []

-- | Gets a specific payout associated with a business account
-- https://developers.circle.com/reference/getbusinesspayout
getBusinessAccountPayout :: UUID -> CircleAPIRequest PayoutRequest TupleBS8 BSL.ByteString
getBusinessAccountPayout :: UUID -> CircleAPIRequest PayoutRequest TupleBS8 ByteString
getBusinessAccountPayout UUID
payoutId = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest PayoutRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"businessAccount/payouts" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UUID -> Text
UUID.toText UUID
payoutId
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
Nothing []

-- | Creates a business account payout
-- https://developers.circle.com/reference/createbusinesspayout
createBusinessAccountPayout :: BusinessPayoutRequestBody -> CircleAPIRequest PayoutRequest TupleBS8 BSL.ByteString
createBusinessAccountPayout :: BusinessPayoutRequestBody
-> CircleAPIRequest PayoutRequest TupleBS8 ByteString
createBusinessAccountPayout BusinessPayoutRequestBody
payoutBody = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest PayoutRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodPost Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"businessAccount/payouts"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params (Body -> Maybe Body
forall a. a -> Maybe a
Just (Body -> Maybe Body) -> Body -> Maybe Body
forall a b. (a -> b) -> a -> b
$ ByteString -> Body
Body (BusinessPayoutRequestBody -> ByteString
forall a. ToJSON a => a -> ByteString
encode BusinessPayoutRequestBody
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 :: CircleAPIRequest TransfersRequest TupleBS8 ByteString
listAllBusinessAccountTransfers = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest TransfersRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"businessAccount/transfers"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
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 :: UUID -> CircleAPIRequest TransferRequest TupleBS8 ByteString
getBusinessAccountTransfer UUID
transferId = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest TransferRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"businessAccount/transfers/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (UUID -> String
forall a. Show a => a -> String
show UUID
transferId)
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
Nothing []

-- | Create a new transfer
-- https://developers.circle.com/reference/createbusinesstransfer
createBusinessAccountTransfer :: BusinessTransferRequestBody -> CircleAPIRequest TransferRequest TupleBS8 BSL.ByteString
createBusinessAccountTransfer :: BusinessTransferRequestBody
-> CircleAPIRequest TransferRequest TupleBS8 ByteString
createBusinessAccountTransfer BusinessTransferRequestBody
transferBody = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest TransferRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodPost Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"businessAccount/transfers"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params (Body -> Maybe Body
forall a. a -> Maybe a
Just (Body -> Maybe Body) -> Body -> Maybe Body
forall a b. (a -> b) -> a -> b
$ ByteString -> Body
Body (BusinessTransferRequestBody -> ByteString
forall a. ToJSON a => a -> ByteString
encode BusinessTransferRequestBody
transferBody)) []

---------------------------------------------------------------
-- /businessAccount/wallets/addresses endpoint
---------------------------------------------------------------

-- | List all deposit addresses
-- https://developers.circle.com/developer/v1/reference/getbusinessdepositaddress
listAllBusinessAccountDepositAddresses :: CircleAPIRequest DepositAddressesRequest TupleBS8 BSL.ByteString
listAllBusinessAccountDepositAddresses :: CircleAPIRequest DepositAddressesRequest TupleBS8 ByteString
listAllBusinessAccountDepositAddresses = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest DepositAddressesRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"businessAccount/wallets/addresses/deposit"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
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 :: DepositAddressRequestBody
-> CircleAPIRequest DepositAddressRequest TupleBS8 ByteString
createBusinessAccountDepositAddress DepositAddressRequestBody
depositAddressBody = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest DepositAddressRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodPost Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"businessAccount/wallets/addresses/deposit"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params (Body -> Maybe Body
forall a. a -> Maybe a
Just (Body -> Maybe Body) -> Body -> Maybe Body
forall a b. (a -> b) -> a -> b
$ ByteString -> Body
Body (DepositAddressRequestBody -> ByteString
forall a. ToJSON a => a -> ByteString
encode DepositAddressRequestBody
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 :: CircleAPIRequest RecipientAddressesRequest TupleBS8 ByteString
listAllBusinessAccountRecipientAddresses = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest RecipientAddressesRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"businessAccount/wallets/addresses/recipient"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
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 :: RecipientAddressRequestBody
-> CircleAPIRequest RecipientAddressRequest TupleBS8 ByteString
createBusinessAccountRecipientAddress RecipientAddressRequestBody
recipientAddressBody = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest RecipientAddressRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodPost Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"businessAccount/wallets/addresses/recipient"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params (Body -> Maybe Body
forall a. a -> Maybe a
Just (Body -> Maybe Body) -> Body -> Maybe Body
forall a b. (a -> b) -> a -> b
$ ByteString -> Body
Body (RecipientAddressRequestBody -> ByteString
forall a. ToJSON a => a -> ByteString
encode RecipientAddressRequestBody
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 :: CircleAPIRequest DepositsRequest TupleBS8 ByteString
listAllBusinessAccountDeposits = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest DepositsRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"businessAccount/deposits"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
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 :: SignetBankAccountRequestBody
-> CircleAPIRequest SignetBankAccountRequest TupleBS8 ByteString
createSignetBankAccount SignetBankAccountRequestBody
signetBankAccountBody = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest SignetBankAccountRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodPost Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"businessAccount/banks/signet"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params (Body -> Maybe Body
forall a. a -> Maybe a
Just (Body -> Maybe Body) -> Body -> Maybe Body
forall a b. (a -> b) -> a -> b
$ ByteString -> Body
Body (SignetBankAccountRequestBody -> ByteString
forall a. ToJSON a => a -> ByteString
encode SignetBankAccountRequestBody
signetBankAccountBody)) []

-- | Get a list of Signet accounts
-- https://developers.circle.com/developer/v1/reference/listbusinesssignetaccounts
listSignetAccounts :: CircleAPIRequest SignetBankAccountsRequest TupleBS8 BSL.ByteString
listSignetAccounts :: CircleAPIRequest SignetBankAccountsRequest TupleBS8 ByteString
listSignetAccounts = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest SignetBankAccountsRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"businessAccount/banks/signet"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
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 :: UUID
-> CircleAPIRequest
     SignetBankAccountRequestBody TupleBS8 ByteString
getSignetAccount UUID
signetBankAccountId = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest
     SignetBankAccountRequestBody TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"businessAccount/banks/signet/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UUID -> Text
UUID.toText UUID
signetBankAccountId
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
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 :: UUID
-> CircleAPIRequest
     SignetBankInstructionsResponseData TupleBS8 ByteString
getSignetAccountInstructions UUID
signetBankAccountId = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest
     SignetBankInstructionsResponseData TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"businessAccount/banks/signet/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UUID -> Text
UUID.toText UUID
signetBankAccountId Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/instructions"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
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 :: SENAccountRequestBody
-> CircleAPIRequest SENAccountRequest TupleBS8 ByteString
createSENAccount SENAccountRequestBody
senAccountBody = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest SENAccountRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodPost Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"businessAccount/banks/sen"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params (Body -> Maybe Body
forall a. a -> Maybe a
Just (Body -> Maybe Body) -> Body -> Maybe Body
forall a b. (a -> b) -> a -> b
$ ByteString -> Body
Body (SENAccountRequestBody -> ByteString
forall a. ToJSON a => a -> ByteString
encode SENAccountRequestBody
senAccountBody)) []

-- | Get a list of SEN accounts
-- https://developers.circle.com/developer/v1/reference/listbusinesssenaccounts
listSENAccounts :: CircleAPIRequest SENAccountsRequest TupleBS8 BSL.ByteString
listSENAccounts :: CircleAPIRequest SENAccountsRequest TupleBS8 ByteString
listSENAccounts = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest SENAccountsRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"businessAccount/banks/sen"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
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 :: UUID -> CircleAPIRequest SENAccountRequest TupleBS8 ByteString
getSENAccount UUID
senAccountId = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest SENAccountRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"businessAccount/banks/sen/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UUID -> Text
UUID.toText UUID
senAccountId
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
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 :: UUID -> CircleAPIRequest SENInstructionsRequest TupleBS8 ByteString
getSENAccountInstructions UUID
senAccountId = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest SENInstructionsRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"businessAccount/banks/sen/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UUID -> Text
UUID.toText UUID
senAccountId Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/instructions"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
Nothing []

---------------------------------------------------------------
-- /payments endpoint
---------------------------------------------------------------

-- | List all payments
-- https://developers.circle.com/developer/v1/reference/listpayments
listAllPayments :: CircleAPIRequest PaymentsRequest TupleBS8 BSL.ByteString
listAllPayments :: CircleAPIRequest PaymentsRequest TupleBS8 ByteString
listAllPayments = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest PaymentsRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"payments"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
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 :: CreatePaymentRequestBody
-> CircleAPIRequest PaymentRequest TupleBS8 ByteString
createPayment CreatePaymentRequestBody
createPaymentBody = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest PaymentRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodPost Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"payments"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params (Body -> Maybe Body
forall a. a -> Maybe a
Just (Body -> Maybe Body) -> Body -> Maybe Body
forall a b. (a -> b) -> a -> b
$ ByteString -> Body
Body (CreatePaymentRequestBody -> ByteString
forall a. ToJSON a => a -> ByteString
encode CreatePaymentRequestBody
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 :: UUID -> CircleAPIRequest PaymentRequest TupleBS8 ByteString
getPayment UUID
paymentId = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest PaymentRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"payments/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UUID -> Text
UUID.toText UUID
paymentId
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
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 :: UUID
-> CancelPaymentRequestBody
-> CircleAPIRequest PaymentRequest TupleBS8 ByteString
cancelPayment UUID
paymentId CancelPaymentRequestBody
cancelPaymentBody = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest PaymentRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodPost Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"payments/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UUID -> Text
UUID.toText UUID
paymentId Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/cancel"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params (Body -> Maybe Body
forall a. a -> Maybe a
Just (Body -> Maybe Body) -> Body -> Maybe Body
forall a b. (a -> b) -> a -> b
$ ByteString -> Body
Body (CancelPaymentRequestBody -> ByteString
forall a. ToJSON a => a -> ByteString
encode CancelPaymentRequestBody
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 :: UUID
-> RefundPaymentRequestBody
-> CircleAPIRequest PaymentRequest TupleBS8 ByteString
refundPayment UUID
paymentId RefundPaymentRequestBody
refundPaymentBody = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest PaymentRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodPost Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"payments/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UUID -> Text
UUID.toText UUID
paymentId Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/refund"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params (Body -> Maybe Body
forall a. a -> Maybe a
Just (Body -> Maybe Body) -> Body -> Maybe Body
forall a b. (a -> b) -> a -> b
$ ByteString -> Body
Body (RefundPaymentRequestBody -> ByteString
forall a. ToJSON a => a -> ByteString
encode RefundPaymentRequestBody
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 :: MockSenOrWirePaymentRequestBody
-> CircleAPIRequest MockPaymentRequest TupleBS8 ByteString
createMockWirePayment MockSenOrWirePaymentRequestBody
wireBody = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest MockPaymentRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodPost Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"mocks/payments/wire"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params (Body -> Maybe Body
forall a. a -> Maybe a
Just (Body -> Maybe Body) -> Body -> Maybe Body
forall a b. (a -> b) -> a -> b
$ ByteString -> Body
Body (MockSenOrWirePaymentRequestBody -> ByteString
forall a. ToJSON a => a -> ByteString
encode MockSenOrWirePaymentRequestBody
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 :: MockSEPAPaymentRequestBody
-> CircleAPIRequest MockPaymentRequest TupleBS8 ByteString
createMockSEPAPayment MockSEPAPaymentRequestBody
sepaBody = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest MockPaymentRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodPost Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"mocks/payments/sepa"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params (Body -> Maybe Body
forall a. a -> Maybe a
Just (Body -> Maybe Body) -> Body -> Maybe Body
forall a b. (a -> b) -> a -> b
$ ByteString -> Body
Body (MockSEPAPaymentRequestBody -> ByteString
forall a. ToJSON a => a -> ByteString
encode MockSEPAPaymentRequestBody
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 :: MockSenOrWirePaymentRequestBody
-> CircleAPIRequest MockPaymentRequest TupleBS8 ByteString
createMockSilvergatePayment MockSenOrWirePaymentRequestBody
senBody = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest MockPaymentRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodPost Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"mocks/payments/sen"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params (Body -> Maybe Body
forall a. a -> Maybe a
Just (Body -> Maybe Body) -> Body -> Maybe Body
forall a b. (a -> b) -> a -> b
$ ByteString -> Body
Body (MockSenOrWirePaymentRequestBody -> ByteString
forall a. ToJSON a => a -> ByteString
encode MockSenOrWirePaymentRequestBody
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 :: CreateMockACHBankAccountRequestBody
-> CircleAPIRequest MockAccountRequest TupleBS8 ByteString
createMockACHBankAccount CreateMockACHBankAccountRequestBody
achPaymentBody = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest MockAccountRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodPost Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"mocks/ach/account"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params (Body -> Maybe Body
forall a. a -> Maybe a
Just (Body -> Maybe Body) -> Body -> Maybe Body
forall a b. (a -> b) -> a -> b
$ ByteString -> Body
Body (CreateMockACHBankAccountRequestBody -> ByteString
forall a. ToJSON a => a -> ByteString
encode CreateMockACHBankAccountRequestBody
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 :: UUID -> CircleAPIRequest MockChargebackRequest TupleBS8 ByteString
createMockChargeback UUID
paymentId = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest MockChargebackRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"mocks/cards/chargebacks"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params (Body -> Maybe Body
forall a. a -> Maybe a
Just (Body -> Maybe Body) -> Body -> Maybe Body
forall a b. (a -> b) -> a -> b
$ ByteString -> Body
Body (UUID -> ByteString
forall a. ToJSON a => a -> ByteString
encode UUID
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 :: CircleAPIRequest OnChainTransfersRequest TupleBS8 ByteString
listAllOnChainTransfers = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest OnChainTransfersRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"transfers"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
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 :: UUID -> CircleAPIRequest TransferRequest TupleBS8 ByteString
getOnChainTransfer UUID
transferId = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest TransferRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"transfers/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UUID -> Text
UUID.toText UUID
transferId
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
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 :: OnChainTransferRequestBody
-> CircleAPIRequest TransferRequest TupleBS8 ByteString
createOnChainTransfer OnChainTransferRequestBody
onChainTransferBody = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest TransferRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodPost Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"transfers"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params (Body -> Maybe Body
forall a. a -> Maybe a
Just (Body -> Maybe Body) -> Body -> Maybe Body
forall a b. (a -> b) -> a -> b
$ ByteString -> Body
Body (OnChainTransferRequestBody -> ByteString
forall a. ToJSON a => a -> ByteString
encode OnChainTransferRequestBody
onChainTransferBody)) []

---------------------------------------------------------------
-- /cards endpoint
---------------------------------------------------------------

-- | List all cards
-- https://developers.circle.com/developer/v1/reference/listcards
listAllCards :: CircleAPIRequest CardsRequest TupleBS8 BSL.ByteString
listAllCards :: CircleAPIRequest CardsRequest TupleBS8 ByteString
listAllCards = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest CardsRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"cards"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
Nothing []

-- | Get a card
-- https://developers.circle.com/developer/v1/reference/payments-cards-get-id
getCard :: UUID -> CircleAPIRequest CardRequest TupleBS8 BSL.ByteString
getCard :: UUID -> CircleAPIRequest CardRequest TupleBS8 ByteString
getCard UUID
cardId = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest CardRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"cards/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UUID -> Text
UUID.toText UUID
cardId
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
Nothing []

-- | Create a card
-- https://developers.circle.com/developer/v1/reference/payments-cards-create
createCard :: CreateCardRequestBody -> CircleAPIRequest CardRequest TupleBS8 BSL.ByteString
createCard :: CreateCardRequestBody
-> CircleAPIRequest CardRequest TupleBS8 ByteString
createCard CreateCardRequestBody
createCardBody = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest CardRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodPost Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"cards"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params (Body -> Maybe Body
forall a. a -> Maybe a
Just (Body -> Maybe Body) -> Body -> Maybe Body
forall a b. (a -> b) -> a -> b
$ ByteString -> Body
Body (CreateCardRequestBody -> ByteString
forall a. ToJSON a => a -> ByteString
encode CreateCardRequestBody
createCardBody)) []

-- | Update a card
-- https://developers.circle.com/developer/v1/reference/updatecard
updateCard :: UUID -> UpdateCardRequestBody -> CircleAPIRequest CardRequest TupleBS8 BSL.ByteString
updateCard :: UUID
-> UpdateCardRequestBody
-> CircleAPIRequest CardRequest TupleBS8 ByteString
updateCard UUID
cardId UpdateCardRequestBody
updateCardBody = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest CardRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodPut Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"cards/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UUID -> Text
UUID.toText UUID
cardId
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params (Body -> Maybe Body
forall a. a -> Maybe a
Just (Body -> Maybe Body) -> Body -> Maybe Body
forall a b. (a -> b) -> a -> b
$ ByteString -> Body
Body (UpdateCardRequestBody -> ByteString
forall a. ToJSON a => a -> ByteString
encode UpdateCardRequestBody
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 :: WireAccountRequestBody
-> CircleAPIRequest WireAccountRequest TupleBS8 ByteString
createWireAccount WireAccountRequestBody
wireAccountBody = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest WireAccountRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodPost Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"banks/wires"
    params :: Params b c
params = case WireAccountRequestBody
wireAccountBody of
      USBankAccount USBankAccountRequestBody
usBankAccountBody -> Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params (Body -> Maybe Body
forall a. a -> Maybe a
Just (Body -> Maybe Body) -> Body -> Maybe Body
forall a b. (a -> b) -> a -> b
$ ByteString -> Body
Body (USBankAccountRequestBody -> ByteString
forall a. ToJSON a => a -> ByteString
encode USBankAccountRequestBody
usBankAccountBody)) []
      IBANBankAccount IBANBankAccountRequestBody
ibanBankAccountBody -> Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params (Body -> Maybe Body
forall a. a -> Maybe a
Just (Body -> Maybe Body) -> Body -> Maybe Body
forall a b. (a -> b) -> a -> b
$ ByteString -> Body
Body (IBANBankAccountRequestBody -> ByteString
forall a. ToJSON a => a -> ByteString
encode IBANBankAccountRequestBody
ibanBankAccountBody)) []
      NonIBANBankAccount NonIBANBankAccountRequestBody
nonIBANBankAccountBody -> Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params (Body -> Maybe Body
forall a. a -> Maybe a
Just (Body -> Maybe Body) -> Body -> Maybe Body
forall a b. (a -> b) -> a -> b
$ ByteString -> Body
Body (NonIBANBankAccountRequestBody -> ByteString
forall a. ToJSON a => a -> ByteString
encode NonIBANBankAccountRequestBody
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 :: UUID -> CircleAPIRequest WireAccountRequest TupleBS8 ByteString
getWireAccount UUID
wireAccountId = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest WireAccountRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"banks/wires/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UUID -> Text
UUID.toText UUID
wireAccountId
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
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 :: UUID
-> CircleAPIRequest WireInstructionsRequest TupleBS8 ByteString
getWireAccountInstructions UUID
wireAccountId = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest WireInstructionsRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"banks/wires/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UUID -> Text
UUID.toText UUID
wireAccountId Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/instructions"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
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 :: CreateACHBankAccountRequestBody
-> CircleAPIRequest ACHBankAccountRequest TupleBS8 ByteString
createACHAccount CreateACHBankAccountRequestBody
achAccountBody = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest ACHBankAccountRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodPost Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"banks/ach"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params (Body -> Maybe Body
forall a. a -> Maybe a
Just (Body -> Maybe Body) -> Body -> Maybe Body
forall a b. (a -> b) -> a -> b
$ ByteString -> Body
Body (CreateACHBankAccountRequestBody -> ByteString
forall a. ToJSON a => a -> ByteString
encode CreateACHBankAccountRequestBody
achAccountBody)) []

-- | Get an ACH account
-- https://developers.circle.com/developer/v1/reference/getachaccount-1
getACHAccount :: UUID -> CircleAPIRequest ACHBankAccountRequest TupleBS8 BSL.ByteString
getACHAccount :: UUID -> CircleAPIRequest ACHBankAccountRequest TupleBS8 ByteString
getACHAccount UUID
achAccountId = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest ACHBankAccountRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"banks/ach/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UUID -> Text
UUID.toText UUID
achAccountId
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
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 :: SEPAAccountRequestBody
-> CircleAPIRequest SEPAAccountRequest TupleBS8 ByteString
createSEPAAccount SEPAAccountRequestBody
sepaAccountBody = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest SEPAAccountRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodPost Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"banks/sepa"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params (Body -> Maybe Body
forall a. a -> Maybe a
Just (Body -> Maybe Body) -> Body -> Maybe Body
forall a b. (a -> b) -> a -> b
$ ByteString -> Body
Body (SEPAAccountRequestBody -> ByteString
forall a. ToJSON a => a -> ByteString
encode SEPAAccountRequestBody
sepaAccountBody)) []

-- | Get a SEPA account (in beta)
-- https://developers.circle.com/developer/v1/reference/getsepaaccount-1
getSEPAAccount :: UUID -> CircleAPIRequest SEPAAccountRequest TupleBS8 BSL.ByteString
getSEPAAccount :: UUID -> CircleAPIRequest SEPAAccountRequest TupleBS8 ByteString
getSEPAAccount UUID
sepaAccountId = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest SEPAAccountRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"banks/sepa/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UUID -> Text
UUID.toText UUID
sepaAccountId
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
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 :: UUID
-> CircleAPIRequest SEPAInstructionsRequest TupleBS8 ByteString
getSEPAAccountInstructions UUID
sepaAccountId = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest SEPAInstructionsRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"banks/sepa/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UUID -> Text
UUID.toText UUID
sepaAccountId Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/instructions"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
Nothing []

---------------------------------------------------------------
-- /settlements endpoint
---------------------------------------------------------------

-- | List all settlements
-- https://developers.circle.com/developer/v1/reference/listsettlements
listAllSettlements :: CircleAPIRequest SettlementsRequest TupleBS8 BSL.ByteString
listAllSettlements :: CircleAPIRequest SettlementsRequest TupleBS8 ByteString
listAllSettlements = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest SettlementsRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"settlements"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
Nothing []

-- | Get a settlement
-- https://developers.circle.com/developer/v1/reference/payments-settlements-get-id
getSettlement :: UUID -> CircleAPIRequest SettlementRequest TupleBS8 BSL.ByteString
getSettlement :: UUID -> CircleAPIRequest SettlementRequest TupleBS8 ByteString
getSettlement UUID
settlementId = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest SettlementRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"settlements/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UUID -> Text
UUID.toText UUID
settlementId
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
Nothing []

---------------------------------------------------------------
-- /chargebacks endpoint
---------------------------------------------------------------

-- | List all chargebacks
-- https://developers.circle.com/developer/v1/reference/listchargebacks
listAllChargebacks :: CircleAPIRequest ChargebacksRequest TupleBS8 BSL.ByteString
listAllChargebacks :: CircleAPIRequest ChargebacksRequest TupleBS8 ByteString
listAllChargebacks = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest ChargebacksRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"chargebacks"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
Nothing []

-- | Get a chargeback
-- https://developers.circle.com/developer/v1/reference/payments-chargebacks-get-id
getChargeback :: UUID -> CircleAPIRequest ChargebackRequest TupleBS8 BSL.ByteString
getChargeback :: UUID -> CircleAPIRequest ChargebackRequest TupleBS8 ByteString
getChargeback UUID
chargebackId = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest ChargebackRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"chargebacks/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UUID -> Text
UUID.toText UUID
chargebackId
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
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 :: CircleAPIRequest ReversalsRequest TupleBS8 ByteString
listAllACHReversals = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest ReversalsRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"reversals"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
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 :: CircleAPIRequest BalanceRequest TupleBS8 ByteString
listAllBalances = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest BalanceRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"balances"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
Nothing []

---------------------------------------------------------------
-- /paymentIntents endpoint
---------------------------------------------------------------

-- | List all payment intents
-- https://developers.circle.com/developer/v1/reference/listpaymentintents
listAllPaymentIntents :: CircleAPIRequest PaymentIntentsRequest TupleBS8 BSL.ByteString
listAllPaymentIntents :: CircleAPIRequest PaymentIntentsRequest TupleBS8 ByteString
listAllPaymentIntents = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest PaymentIntentsRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"paymentIntents"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
Nothing []

-- | Create a payment intent
-- https://developers.circle.com/developer/v1/reference/createpaymentintent
createPaymentIntent :: CreatePaymentIntentRequestBody -> CircleAPIRequest PaymentIntentRequest TupleBS8 BSL.ByteString
createPaymentIntent :: CreatePaymentIntentRequestBody
-> CircleAPIRequest PaymentIntentRequest TupleBS8 ByteString
createPaymentIntent CreatePaymentIntentRequestBody
createPaymentBody = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest PaymentIntentRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodPost Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"paymentIntents"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params (Body -> Maybe Body
forall a. a -> Maybe a
Just (Body -> Maybe Body) -> Body -> Maybe Body
forall a b. (a -> b) -> a -> b
$ ByteString -> Body
Body (CreatePaymentIntentRequestBody -> ByteString
forall a. ToJSON a => a -> ByteString
encode CreatePaymentIntentRequestBody
createPaymentBody)) []

-- | Get a payment intent
-- https://developers.circle.com/developer/v1/reference/getpaymentintent
getPaymentIntent :: UUID -> CircleAPIRequest PaymentIntentRequest TupleBS8 BSL.ByteString
getPaymentIntent :: UUID -> CircleAPIRequest PaymentIntentRequest TupleBS8 ByteString
getPaymentIntent UUID
paymentIntentId = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest PaymentIntentRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"paymentIntents/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UUID -> Text
UUID.toText UUID
paymentIntentId
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
Nothing []

-- | Expire a payment intent
-- https://developers.circle.com/developer/v1/reference/expirepaymentintent
expirePaymentIntent :: UUID -> CircleAPIRequest PaymentIntentRequest TupleBS8 BSL.ByteString
expirePaymentIntent :: UUID -> CircleAPIRequest PaymentIntentRequest TupleBS8 ByteString
expirePaymentIntent UUID
paymentIntentId = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest PaymentIntentRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodPost Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"paymentIntents/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UUID -> Text
UUID.toText UUID
paymentIntentId Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/expire"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
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 :: CircleAPIRequest PayoutsRequest TupleBS8 ByteString
listAllPayouts = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest PayoutsRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"payouts"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
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 :: UUID -> CircleAPIRequest PayoutRequest TupleBS8 ByteString
getPayout UUID
payoutId = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest PayoutRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"payouts" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UUID -> Text
UUID.toText UUID
payoutId
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
Nothing []

-- | Creates a payout
-- https://developers.circle.com/developer/v1/reference/payouts-payouts-create
createPayout :: PayoutRequestBody -> CircleAPIRequest PayoutRequest TupleBS8 BSL.ByteString
createPayout :: PayoutRequestBody
-> CircleAPIRequest PayoutRequest TupleBS8 ByteString
createPayout PayoutRequestBody
payoutBody = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest PayoutRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodPost Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"payouts"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params (Body -> Maybe Body
forall a. a -> Maybe a
Just (Body -> Maybe Body) -> Body -> Maybe Body
forall a b. (a -> b) -> a -> b
$ ByteString -> Body
Body (PayoutRequestBody -> ByteString
forall a. ToJSON a => a -> ByteString
encode PayoutRequestBody
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 :: CircleAPIRequest TransfersRequest TupleBS8 ByteString
listAllTransfers = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest TransfersRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"transfers"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
Nothing []

-- | Get a transfer based on a transfer ID
-- https://developers.circle.com/reference/getbusinesstransfer
getTransfer :: UUID -> CircleAPIRequest TransferRequest TupleBS8 BSL.ByteString
getTransfer :: UUID -> CircleAPIRequest TransferRequest TupleBS8 ByteString
getTransfer UUID
transferId = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest TransferRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"transfers/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UUID -> Text
UUID.toText UUID
transferId
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
Nothing []

-- | Create a new transfer
-- https://developers.circle.com/developer/v1/reference/payouts-transfers-create
createTransfer :: TransferRequestBody -> CircleAPIRequest TransferRequest TupleBS8 BSL.ByteString
createTransfer :: TransferRequestBody
-> CircleAPIRequest TransferRequest TupleBS8 ByteString
createTransfer TransferRequestBody
transferBody = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest TransferRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodPost Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"transfers"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params (Body -> Maybe Body
forall a. a -> Maybe a
Just (Body -> Maybe Body) -> Body -> Maybe Body
forall a b. (a -> b) -> a -> b
$ ByteString -> Body
Body (TransferRequestBody -> ByteString
forall a. ToJSON a => a -> ByteString
encode TransferRequestBody
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 :: CircleAPIRequest ReturnsRequest TupleBS8 ByteString
listAllReturns = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest ReturnsRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"returns"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
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 :: CircleAPIRequest WalletsRequest TupleBS8 ByteString
listAllWallets = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest WalletsRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"wallets"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
Nothing []

-- | Get a wallet
-- https://developers.circle.com/developer/v1/reference/accounts-wallets-get-id
getWallet :: UUID -> CircleAPIRequest WalletRequest TupleBS8 BSL.ByteString
getWallet :: UUID -> CircleAPIRequest WalletRequest TupleBS8 ByteString
getWallet UUID
walletId = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest WalletRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"wallets/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UUID -> Text
UUID.toText UUID
walletId
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
Nothing []

-- | Creates an end user wallet.
-- https://developers.circle.com/developer/v1/reference/accounts-wallets-create
createWallet :: CreateWalletRequestBody -> CircleAPIRequest WalletRequest TupleBS8 BSL.ByteString
createWallet :: CreateWalletRequestBody
-> CircleAPIRequest WalletRequest TupleBS8 ByteString
createWallet CreateWalletRequestBody
walletBody = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest WalletRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodPost Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"wallets"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params (Body -> Maybe Body
forall a. a -> Maybe a
Just (Body -> Maybe Body) -> Body -> Maybe Body
forall a b. (a -> b) -> a -> b
$ ByteString -> Body
Body (CreateWalletRequestBody -> ByteString
forall a. ToJSON a => a -> ByteString
encode CreateWalletRequestBody
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 :: UUID
-> DepositAddressRequestBody
-> CircleAPIRequest DepositAddressRequest TupleBS8 ByteString
createDepositAddress UUID
walletId DepositAddressRequestBody
depositAddressBody = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest DepositAddressRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodPost Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"wallets/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UUID -> Text
UUID.toText UUID
walletId Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/addresses"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params (Body -> Maybe Body
forall a. a -> Maybe a
Just (Body -> Maybe Body) -> Body -> Maybe Body
forall a b. (a -> b) -> a -> b
$ ByteString -> Body
Body (DepositAddressRequestBody -> ByteString
forall a. ToJSON a => a -> ByteString
encode DepositAddressRequestBody
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 :: UUID
-> CircleAPIRequest RecipientAddressesRequest TupleBS8 ByteString
listAllAddresses UUID
walletId = do
  Method
-> Text
-> Params TupleBS8 ByteString
-> CircleAPIRequest RecipientAddressesRequest TupleBS8 ByteString
forall a b c.
Method
-> Text -> Params TupleBS8 ByteString -> CircleAPIRequest a b c
mkCircleAPIRequest Method
NHTM.methodGet Text
url Params TupleBS8 ByteString
forall b c. Params b c
params
  where
    url :: Text
url = Text
"wallets/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UUID -> Text
UUID.toText UUID
walletId Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/addresses"
    params :: Params b c
params = Maybe Body -> [Query] -> Params b c
forall b c. Maybe Body -> [Query] -> Params b c
Params Maybe Body
forall a. Maybe a
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 :: CircleConfig
-> CircleAPIRequest a TupleBS8 ByteString
-> IO (Either CircleError (CircleRequest a))
circle CircleConfig
config CircleAPIRequest a TupleBS8 ByteString
request = do
  Reply
response <- CircleConfig -> CircleAPIRequest a TupleBS8 ByteString -> IO Reply
forall a.
CircleConfig -> CircleAPIRequest a TupleBS8 ByteString -> IO Reply
circle' CircleConfig
config CircleAPIRequest a TupleBS8 ByteString
request
  let result :: Either String (CircleRequest a)
result = ByteString -> Either String (CircleRequest a)
forall a. FromJSON a => ByteString -> Either String a
eitherDecode (ByteString -> Either String (CircleRequest a))
-> ByteString -> Either String (CircleRequest a)
forall a b. (a -> b) -> a -> b
$ Reply -> ByteString
forall body. Response body -> body
responseBody Reply
response
  case Either String (CircleRequest a)
result of
    Left String
s -> Either CircleError (CircleRequest a)
-> IO (Either CircleError (CircleRequest a))
forall (m :: * -> *) a. Monad m => a -> m a
return (CircleError -> Either CircleError (CircleRequest a)
forall a b. a -> Either a b
Left (Text -> Reply -> CircleError
CircleError (String -> Text
T.pack String
s) Reply
response))
    Right CircleRequest a
r -> Either CircleError (CircleRequest a)
-> IO (Either CircleError (CircleRequest a))
forall (m :: * -> *) a. Monad m => a -> m a
return (CircleRequest a -> Either CircleError (CircleRequest a)
forall a b. b -> Either a b
Right CircleRequest a
r)
  where
    circle' ::
      CircleConfig ->
      CircleAPIRequest a TupleBS8 BSL.ByteString ->
      IO Reply
    circle' :: CircleConfig -> CircleAPIRequest a TupleBS8 ByteString -> IO Reply
circle' CircleConfig {CircleHost
ApiToken
token :: CircleConfig -> ApiToken
host :: CircleConfig -> CircleHost
token :: ApiToken
host :: CircleHost
..} CircleAPIRequest {Method
Text
Params TupleBS8 ByteString
params :: forall a b c. CircleAPIRequest a b c -> Params TupleBS8 ByteString
endpoint :: forall a b c. CircleAPIRequest a b c -> Text
rMethod :: forall a b c. CircleAPIRequest a b c -> Method
params :: Params TupleBS8 ByteString
endpoint :: Text
rMethod :: Method
..} = do
      Manager
manager <- ManagerSettings -> IO Manager
newManager ManagerSettings
tlsManagerSettings
      Request
initReq <- String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest (String -> IO Request) -> String -> IO Request
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
T.append (CircleHost -> Text
hostUri CircleHost
host) Text
endpoint
      let reqBody :: ByteString
reqBody
            | Method
rMethod Method -> Method -> Bool
forall a. Eq a => a -> a -> Bool
== Method
NHTM.methodGet = ByteString
forall a. Monoid a => a
mempty
            | Maybe Body -> Bool
forall a. Maybe a -> Bool
isNothing (Params TupleBS8 ByteString -> Maybe Body
forall b c. Params b c -> Maybe Body
paramsBody Params TupleBS8 ByteString
params) = ByteString
forall a. Monoid a => a
mempty
            | Bool
otherwise = Body -> ByteString
unBody (Body -> ByteString) -> Body -> ByteString
forall a b. (a -> b) -> a -> b
$ Maybe Body -> Body
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Body -> Body) -> Maybe Body -> Body
forall a b. (a -> b) -> a -> b
$ Params TupleBS8 ByteString -> Maybe Body
forall b c. Params b c -> Maybe Body
paramsBody Params TupleBS8 ByteString
params
          req :: Request
req =
            Request
initReq
              { method :: Method
method = Method
rMethod,
                requestBody :: RequestBody
requestBody = ByteString -> RequestBody
RequestBodyLBS ByteString
reqBody,
                requestHeaders :: RequestHeaders
requestHeaders = [(HeaderName
hContentType, Method
"application/json"), (HeaderName
hAccept, Method
"application/json")],
                queryString :: Method
queryString = [Query] -> Method
paramsToByteString ([Query] -> Method) -> [Query] -> Method
forall a b. (a -> b) -> a -> b
$ Params TupleBS8 ByteString -> [Query]
forall b c. Params b c -> [Query]
paramsQuery Params TupleBS8 ByteString
params
              }
          circleToken :: Method
circleToken = ApiToken -> Method
unApiToken ApiToken
token
          authorizedRequest :: Request
authorizedRequest = Method -> Request -> Request
applyBearerAuth Method
circleToken Request
req
      Request -> Manager -> IO Reply
httpLbs Request
authorizedRequest Manager
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 :: CircleConfig
-> Manager
-> CircleAPIRequest a TupleBS8 ByteString
-> IO (Either CircleError (CircleRequest a))
circleTest CircleConfig
config Manager
tlsManager CircleAPIRequest a TupleBS8 ByteString
request = do
  Reply
response <- CircleConfig
-> CircleAPIRequest a TupleBS8 ByteString -> Manager -> IO Reply
forall a.
CircleConfig
-> CircleAPIRequest a TupleBS8 ByteString -> Manager -> IO Reply
circleTest' CircleConfig
config CircleAPIRequest a TupleBS8 ByteString
request Manager
tlsManager
  let result :: Either String (CircleRequest a)
result = ByteString -> Either String (CircleRequest a)
forall a. FromJSON a => ByteString -> Either String a
eitherDecode (ByteString -> Either String (CircleRequest a))
-> ByteString -> Either String (CircleRequest a)
forall a b. (a -> b) -> a -> b
$ Reply -> ByteString
forall body. Response body -> body
responseBody Reply
response
  case Either String (CircleRequest a)
result of
    Left String
s -> Either CircleError (CircleRequest a)
-> IO (Either CircleError (CircleRequest a))
forall (m :: * -> *) a. Monad m => a -> m a
return (CircleError -> Either CircleError (CircleRequest a)
forall a b. a -> Either a b
Left (Text -> Reply -> CircleError
CircleError (String -> Text
T.pack String
s) Reply
response))
    Right CircleRequest a
r -> Either CircleError (CircleRequest a)
-> IO (Either CircleError (CircleRequest a))
forall (m :: * -> *) a. Monad m => a -> m a
return (CircleRequest a -> Either CircleError (CircleRequest a)
forall a b. b -> Either a b
Right CircleRequest a
r)
  where
    circleTest' ::
      CircleConfig ->
      CircleAPIRequest a TupleBS8 BSL.ByteString ->
      Manager ->
      IO Reply
    circleTest' :: CircleConfig
-> CircleAPIRequest a TupleBS8 ByteString -> Manager -> IO Reply
circleTest' CircleConfig {CircleHost
ApiToken
token :: ApiToken
host :: CircleHost
token :: CircleConfig -> ApiToken
host :: CircleConfig -> CircleHost
..} CircleAPIRequest {Method
Text
Params TupleBS8 ByteString
params :: Params TupleBS8 ByteString
endpoint :: Text
rMethod :: Method
params :: forall a b c. CircleAPIRequest a b c -> Params TupleBS8 ByteString
endpoint :: forall a b c. CircleAPIRequest a b c -> Text
rMethod :: forall a b c. CircleAPIRequest a b c -> Method
..} Manager
manager = do
      Request
initReq <- String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest (String -> IO Request) -> String -> IO Request
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
T.append (CircleHost -> Text
hostUri CircleHost
host) Text
endpoint
      let reqBody :: ByteString
reqBody
            | Method
rMethod Method -> Method -> Bool
forall a. Eq a => a -> a -> Bool
== Method
NHTM.methodGet = ByteString
forall a. Monoid a => a
mempty
            | Maybe Body -> Bool
forall a. Maybe a -> Bool
isNothing (Params TupleBS8 ByteString -> Maybe Body
forall b c. Params b c -> Maybe Body
paramsBody Params TupleBS8 ByteString
params) = ByteString
forall a. Monoid a => a
mempty
            | Bool
otherwise = Body -> ByteString
unBody (Body -> ByteString) -> Body -> ByteString
forall a b. (a -> b) -> a -> b
$ Maybe Body -> Body
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Body -> Body) -> Maybe Body -> Body
forall a b. (a -> b) -> a -> b
$ Params TupleBS8 ByteString -> Maybe Body
forall b c. Params b c -> Maybe Body
paramsBody Params TupleBS8 ByteString
params
          req :: Request
req =
            Request
initReq
              { method :: Method
method = Method
rMethod,
                requestBody :: RequestBody
requestBody = ByteString -> RequestBody
RequestBodyLBS ByteString
reqBody,
                requestHeaders :: RequestHeaders
requestHeaders = [(HeaderName
hContentType, Method
"application/json"), (HeaderName
hAccept, Method
"application/json")],
                queryString :: Method
queryString = [Query] -> Method
paramsToByteString ([Query] -> Method) -> [Query] -> Method
forall a b. (a -> b) -> a -> b
$ Params TupleBS8 ByteString -> [Query]
forall b c. Params b c -> [Query]
paramsQuery Params TupleBS8 ByteString
params
              }
          circleToken :: Method
circleToken = ApiToken -> Method
unApiToken ApiToken
token
          authorizedRequest :: Request
authorizedRequest = Method -> Request -> Request
applyBearerAuth Method
circleToken Request
req
      Request -> Manager -> IO Reply
httpLbs Request
authorizedRequest Manager
manager

-- | Conversion of a key value pair to a query parameterized string
paramsToByteString ::
  [Query] ->
  BS8.ByteString
paramsToByteString :: [Query] -> Method
paramsToByteString [] = Method
forall a. Monoid a => a
mempty
paramsToByteString [Query
x] = TupleBS8 -> Method
forall a b. (a, b) -> a
fst (Query -> TupleBS8
unQuery Query
x) Method -> Method -> Method
forall a. Semigroup a => a -> a -> a
<> Method
"=" Method -> Method -> Method
forall a. Semigroup a => a -> a -> a
<> TupleBS8 -> Method
forall a b. (a, b) -> b
snd (Query -> TupleBS8
unQuery Query
x)
paramsToByteString (Query
x : [Query]
xs) =
  [Method] -> Method
forall a. Monoid a => [a] -> a
mconcat [TupleBS8 -> Method
forall a b. (a, b) -> a
fst (TupleBS8 -> Method) -> TupleBS8 -> Method
forall a b. (a -> b) -> a -> b
$ Query -> TupleBS8
unQuery Query
x, Method
"=", TupleBS8 -> Method
forall a b. (a, b) -> b
snd (TupleBS8 -> Method) -> TupleBS8 -> Method
forall a b. (a -> b) -> a -> b
$ Query -> TupleBS8
unQuery Query
x, Method
"&"] Method -> Method -> Method
forall a. Semigroup a => a -> a -> a
<> [Query] -> Method
paramsToByteString [Query]
xs