diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -16,11 +16,11 @@ - [x] Get Currencies - [x] Time - Private - - [ ] Accounts + - [x] Accounts - [x] List Accounts - [x] Get An Account - - [ ] Get Account History - - [ ] Get Holds + - [x] Get Account History + - [x] Get Holds - [x] Orders - [x] Place a New Order - [x] Cancel an Order @@ -29,24 +29,42 @@ - [x] Get an Order - [x] Fills - [x] List Fills - - [ ] Deposits - - [ ] Payment Method - - [ ] Coinbase + - [x] Limits + - [x] Get Current Exchange Limits + - [x] Deposits + - [x] List Deposits + - [x] Single Deposit + - [x] Payment Method + - [x] Coinbase + - [x] Generate a Crypto Deposit Address - [ ] Withdrawals - - [ ] Payment Method - - [ ] Coinbase - - [ ] Crypto + - [x] List Withdrawals + - [x] Single Withdrawal + - [ ] Canceled Withdrawal + - [x] Payment Method + - [x] Coinbase + - [x] Crypto + - [x] Fee Estimate - [ ] Stablecoin Conversions - [ ] Create Conversion - - [ ] Payment Methods - - [ ] List Payment Methods + - [x] Payment Methods + - [x] List Payment Methods + - [x] Coinbase Accounts + - [x] List Accounts - [x] Fees - [x] Get Current Fees - [ ] Reports - [ ] Create a new report - [ ] Get report status + - [ ] Profiles + - [ ] List Profiles + - [ ] Get a Profile + - [ ] Create a Profile Transfer - [x] User Account - [x] Trailing Volume + - [ ] Margin + - [ ] Oracle + - [ ] Get Oracle - Websocket Feed - [x] Channels - [x] The heartbeat channel @@ -65,13 +83,13 @@ ### Market Data Requests ```haskell -run (trades (ProductId "BTC-USD")) >>= print +run Sandbox (trades (ProductId "BTC-USD")) >>= print ``` ### Authenticated Private Requests ```haskell -runCbAuthT cpc $ do +runCbAuthT (run Sandbox) cpc $ do fills (Just btcusd) Nothing >>= liftIO . print where accessKey = CBAccessKey "" @@ -95,3 +113,8 @@ ## Example Example execs can be found in `src/example/` + +### Run Example + +To run any of the authenticated endpoints in `test-request`, the access key, +secret key, and passphrase must be provided. See _Authenticated Private Requests_ above. diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,32 @@ +# Version 0.9.0.0 + +- Upgraded to lts-17.4 (ghc 8.10.4) +- Added hie.yaml for use with haskell-language-server (hls) +- Removed `taker_fee_rate` from `Activate` websocket message +- Added `max_withdrawal_amount` to `CurrencyDetails` +- Changed `example/test-request` to `Sandbox` instead of `Production` +- Use `Network.HTTP.Types.encodePathSegments` when making `RequestPath` in authenticated requests +- Added `min_market_funds` and `max_market_funds` to `Product` +- Made several explicit `Show` instances +- Added support for the following endpoints: + - account history + - account holds + - exchange limits + - deposits + - withdrawals + - list payment methods + - listing coinbase accounts + - list tranfers endpoint + +# Version 0.8.2.0 + +- Changed `port` in `WSConnection` back to `PortNumber` instead of `Int` + +# Version 0.8.1.0 + +- Upgraded to lts-16.7 (ghc 8.8.3) +- Changed `port` in `WSConnection` to `Int` instead of `PortNumber` + # Version 0.8.0.0 ## Breaking API changes: diff --git a/coinbase-pro.cabal b/coinbase-pro.cabal --- a/coinbase-pro.cabal +++ b/coinbase-pro.cabal @@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.31.2. +-- This file has been generated from package.yaml by hpack version 0.33.0. -- -- see: https://github.com/sol/hpack -- --- hash: a870948505578ac331822c4d53b73343bd8cea3178cd634aace31f0a118981a3 +-- hash: 6d5d68b6e7e2760dac46a876ebbca9195bb32e0cb846b290d8db552d28a24647 name: coinbase-pro -version: 0.8.0.0 +version: 0.9.0.0 synopsis: Client for Coinbase Pro description: Client for Coinbase Pro REST and Websocket APIs category: Web, Finance @@ -15,7 +15,7 @@ bug-reports: https://github.com/mdunnio/coinbase-pro/issues author: Michael Dunn maintainer: Michael Dunn -copyright: 2020 Michael Dunn +copyright: 2021 Michael Dunn license: MIT license-file: LICENSE build-type: Simple @@ -32,10 +32,16 @@ CoinbasePro.Authenticated CoinbasePro.Authenticated.Accounts CoinbasePro.Authenticated.API + CoinbasePro.Authenticated.CoinbaseAccounts + CoinbasePro.Authenticated.Deposit CoinbasePro.Authenticated.Fills CoinbasePro.Authenticated.Headers + CoinbasePro.Authenticated.Limits CoinbasePro.Authenticated.Orders + CoinbasePro.Authenticated.Payment CoinbasePro.Authenticated.Request + CoinbasePro.Authenticated.Transfer + CoinbasePro.Authenticated.Withdrawal CoinbasePro.Environment CoinbasePro.Headers CoinbasePro.MarketData.AggregateOrderBook @@ -65,14 +71,14 @@ src/lib/ build-depends: HsOpenSSL >=0.11 && <0.12 - , aeson >=1.2 && <1.5 + , aeson >=1.2 && <1.6 , aeson-casing >=0.1 && <0.3 , async >=2.1 && <2.3 , base >=4.7 && <5 , binary >=0.8 && <0.9 , bytestring >=0.10 && <0.11 , containers >=0.5 && <0.7 - , cryptonite >=0.24 && <0.27 + , cryptonite >=0.24 && <0.28 , http-api-data >=0.3 && <0.5 , http-client >=0.5 && <0.7 , http-client-tls >=0.3 && <0.4 @@ -80,12 +86,12 @@ , http-types >=0.12 && <0.13 , io-streams >=1.5 && <1.6 , memory >=0.14 && <0.16 - , network >=2.6 && <2.9 - , servant >=0.14 && <0.17 - , servant-client >=0.14 && <0.17 - , servant-client-core >=0.14 && <0.17 + , network >=2.6 && <3.2 + , servant >=0.14 && <0.19 + , servant-client >=0.14 && <0.19 + , servant-client-core >=0.14 && <0.19 , text >=1.2 && <1.3 - , time >=1.8 && <1.9 + , time >=1.8 && <2.0 , transformers >=0.5 && <0.6 , unagi-streams >=0.2 && <0.3 , unordered-containers >=0.2 && <0.3 @@ -103,7 +109,7 @@ src/example/request/ build-depends: HsOpenSSL >=0.11 && <0.12 - , aeson >=1.2 && <1.5 + , aeson >=1.2 && <1.6 , aeson-casing >=0.1 && <0.3 , async >=2.1 && <2.3 , base >=4.7 && <5 @@ -111,7 +117,7 @@ , bytestring >=0.10 && <0.11 , coinbase-pro , containers >=0.5 && <0.7 - , cryptonite >=0.24 && <0.27 + , cryptonite >=0.24 && <0.28 , http-api-data >=0.3 && <0.5 , http-client >=0.5 && <0.7 , http-client-tls >=0.3 && <0.4 @@ -119,12 +125,12 @@ , http-types >=0.12 && <0.13 , io-streams >=1.5 && <1.6 , memory >=0.14 && <0.16 - , network >=2.6 && <2.9 - , servant >=0.14 && <0.17 - , servant-client >=0.14 && <0.17 - , servant-client-core >=0.14 && <0.17 + , network >=2.6 && <3.2 + , servant >=0.14 && <0.19 + , servant-client >=0.14 && <0.19 + , servant-client-core >=0.14 && <0.19 , text >=1.2 && <1.3 - , time >=1.8 && <1.9 + , time >=1.8 && <2.0 , transformers >=0.5 && <0.6 , unagi-streams >=0.2 && <0.3 , unordered-containers >=0.2 && <0.3 @@ -142,7 +148,7 @@ src/example/stream/ build-depends: HsOpenSSL >=0.11 && <0.12 - , aeson >=1.2 && <1.5 + , aeson >=1.2 && <1.6 , aeson-casing >=0.1 && <0.3 , async >=2.1 && <2.3 , base >=4.7 && <5 @@ -150,7 +156,7 @@ , bytestring >=0.10 && <0.11 , coinbase-pro , containers >=0.5 && <0.7 - , cryptonite >=0.24 && <0.27 + , cryptonite >=0.24 && <0.28 , http-api-data >=0.3 && <0.5 , http-client >=0.5 && <0.7 , http-client-tls >=0.3 && <0.4 @@ -158,12 +164,12 @@ , http-types >=0.12 && <0.13 , io-streams >=1.5 && <1.6 , memory >=0.14 && <0.16 - , network >=2.6 && <2.9 - , servant >=0.14 && <0.17 - , servant-client >=0.14 && <0.17 - , servant-client-core >=0.14 && <0.17 + , network >=2.6 && <3.2 + , servant >=0.14 && <0.19 + , servant-client >=0.14 && <0.19 + , servant-client-core >=0.14 && <0.19 , text >=1.2 && <1.3 - , time >=1.8 && <1.9 + , time >=1.8 && <2.0 , transformers >=0.5 && <0.6 , unagi-streams >=0.2 && <0.3 , unordered-containers >=0.2 && <0.3 diff --git a/src/example/request/Main.hs b/src/example/request/Main.hs --- a/src/example/request/Main.hs +++ b/src/example/request/Main.hs @@ -18,17 +18,18 @@ main :: IO () main = do - run Production (stats btcusd) >>= print - run Production (candles btcusd Nothing Nothing Minute) >>= print - run Production (trades btcusd) >>= print - run Production time >>= print - run Production products >>= print - run Production (aggregateOrderBook btcusd (Just Best)) >>= print - run Production (aggregateOrderBook btcusd (Just TopFifty)) >>= print - run Production (fullOrderBook btcusd) >>= print - runCbAuthT (run Production) cpc $ do + run Sandbox (stats btcusd) >>= print + run Sandbox (candles btcusd Nothing Nothing Minute) >>= print + run Sandbox (trades btcusd) >>= print + run Sandbox time >>= print + run Sandbox products >>= print + run Sandbox (aggregateOrderBook btcusd (Just Best)) >>= print + run Sandbox (aggregateOrderBook btcusd (Just TopFifty)) >>= print + run Sandbox (fullOrderBook btcusd) >>= print + runCbAuthT (run Sandbox) cpc $ do accounts >>= liftIO . print account aid >>= liftIO . print + accountHistory aid >>= liftIO . print fills (Just btcusd) Nothing >>= liftIO . print listOrders (Just [All]) (Just btcusd) >>= liftIO . print placeOrder Nothing btcusd Sell (Size 0.001) (Price 99999.00) True Nothing Nothing Nothing >>= liftIO . print diff --git a/src/lib/CoinbasePro/Authenticated.hs b/src/lib/CoinbasePro/Authenticated.hs --- a/src/lib/CoinbasePro/Authenticated.hs +++ b/src/lib/CoinbasePro/Authenticated.hs @@ -1,10 +1,13 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} module CoinbasePro.Authenticated ( accounts , account + , accountHistory + , accountHolds , listOrders , getOrder , getClientOrder @@ -14,67 +17,155 @@ , fills , fees , trailingVolume + , limits + , deposits + , withdrawals + , transfer + , makeDeposit + , makeCoinbaseDeposit + , cryptoDepositAddress + , makeWithdrawal + , makeCoinbaseWithdrawal + , makeCryptoWithdrawal + , withdrawalFeeEstimate + , paymentMethods + , coinbaseAccounts ) where +import Control.Monad (void) +import Data.Aeson (encode) +import qualified Data.ByteString.Builder as BB +import qualified Data.ByteString.Lazy.Char8 as LC8 +import Data.Maybe (fromMaybe) +import qualified Data.Set as S +import Data.Text (Text, pack) +import Data.Text.Encoding (encodeUtf8) +import Data.Time.Clock (UTCTime) +import Data.UUID (toText) +import Network.HTTP.Types (SimpleQuery, + SimpleQueryItem, + encodePathSegments, + methodDelete, + methodGet, + methodPost, + renderQuery, + simpleQueryToQuery) +import Servant.Client (ClientM) -import Control.Monad (void) -import Data.Aeson (encode) -import qualified Data.ByteString.Char8 as C8 -import qualified Data.ByteString.Lazy.Char8 as LC8 -import Data.Maybe (fromMaybe) -import qualified Data.Set as S -import Data.Text (Text, pack, toLower, - unpack) -import Data.UUID (toString) -import Network.HTTP.Types (SimpleQuery, - SimpleQueryItem, - methodDelete, methodGet, - methodPost, renderQuery, - simpleQueryToQuery) -import Servant.Client (ClientM) +import qualified CoinbasePro.Authenticated.API as API +import CoinbasePro.Authenticated.Accounts (Account, + AccountHistory, + AccountId (..), + Fees, Hold, + TrailingVolume (..)) +import CoinbasePro.Authenticated.CoinbaseAccounts (CoinbaseAccount) +import CoinbasePro.Authenticated.Deposit (CoinbaseDepositRequest (..), + CryptoDepositAddress, + DepositRequest (..), + DepositResponse) +import CoinbasePro.Authenticated.Fills (Fill) +import CoinbasePro.Authenticated.Limits (Limits) +import CoinbasePro.Authenticated.Orders (Order, + PlaceOrderBody (..), + STP, Status (..), + Statuses (..), + TimeInForce, + statuses) +import CoinbasePro.Authenticated.Payment (PaymentMethod, + PaymentMethodId (..)) +import CoinbasePro.Authenticated.Request (CBAuthT (..), + authRequest) +import CoinbasePro.Authenticated.Transfer (Transfer, + TransferType (..)) +import CoinbasePro.Authenticated.Withdrawal (CoinbaseWithdrawalRequest (..), + CryptoWithdrawalRequest (..), + CryptoWithdrawalResponse, + WithdrawalFeeEstimateResponse (..), + WithdrawalRequest (..), + WithdrawalResponse) +import CoinbasePro.Request (RequestPath, + emptyBody) -import CoinbasePro.Authenticated.Accounts (Account, AccountId (..), - Fees, TrailingVolume (..)) -import qualified CoinbasePro.Authenticated.API as API -import CoinbasePro.Authenticated.Fills (Fill) -import CoinbasePro.Authenticated.Orders (Order, PlaceOrderBody (..), - STP, Status (..), - Statuses (..), TimeInForce, - statuses) -import CoinbasePro.Authenticated.Request (CBAuthT (..), authRequest) -import CoinbasePro.Request (RequestPath) +import CoinbasePro.Types (ClientOrderId (..), + CryptoAddress (..), + CurrencyType (..), + OrderId (..), + OrderType, Price, + ProductId (..), + ProfileId, Side, + Size) -import CoinbasePro.Types (ClientOrderId (..), - OrderId (..), OrderType, - Price, ProductId (..), - Side, Size) +accountsPath :: Text +accountsPath = "accounts" --- | https://docs.pro.coinbase.com/?javascript#accounts +ordersPath :: Text +ordersPath = "orders" + + +encodeRequestPath :: [Text] -> RequestPath +encodeRequestPath = LC8.toStrict . BB.toLazyByteString . encodePathSegments + + +mkSimpleQueryItem :: Show a => Text -> a -> SimpleQueryItem +mkSimpleQueryItem s a = (encodeUtf8 s, encodeUtf8 $ pack (show a)) + + +optionalQuery :: Show a => Text -> Maybe a -> [SimpleQueryItem] +optionalQuery t = maybe [] (return . mkSimpleQueryItem t) + + +mkProductQuery :: Maybe ProductId -> [SimpleQueryItem] +mkProductQuery = optionalQuery "product_id" + + +mkOrderIdQuery :: Maybe OrderId -> SimpleQuery +mkOrderIdQuery = optionalQuery "order_id" + + +-- | https://docs.pro.coinbase.com/#accounts accounts :: CBAuthT ClientM [Account] -accounts = authRequest methodGet "/accounts" "" API.accounts +accounts = authRequest methodGet requestPath emptyBody API.accounts + where + requestPath = encodeRequestPath [accountsPath] --- | https://docs.pro.coinbase.com/?javascript#get-an-account +-- | https://docs.pro.coinbase.com/#get-an-account account :: AccountId -> CBAuthT ClientM Account -account aid@(AccountId t) = authRequest methodGet requestPath "" $ API.singleAccount aid +account aid@(AccountId t) = authRequest methodGet requestPath emptyBody $ API.singleAccount aid where - requestPath = "/accounts/" ++ unpack t + requestPath = encodeRequestPath [accountsPath, t] --- | https://docs.pro.coinbase.com/?javascript#list-orders +-- | https://docs.pro.coinbase.com/#get-account-history +accountHistory :: AccountId -> CBAuthT ClientM [AccountHistory] +accountHistory aid@(AccountId t) = authRequest methodGet requestPath emptyBody $ API.accountHistory aid + where + ledgerPath = "ledger" + requestPath = encodeRequestPath [accountsPath, t, ledgerPath] + + +-- | https://docs.pro.coinbase.com/#get-holds +accountHolds :: AccountId -> CBAuthT ClientM [Hold] +accountHolds aid@(AccountId t) = authRequest methodGet requestPath emptyBody $ API.accountHolds aid + where + holdsPath = "holds" + requestPath = encodeRequestPath [accountsPath, t, holdsPath] + + +-- | https://docs.pro.coinbase.com/#list-orders listOrders :: Maybe [Status] -> Maybe ProductId -> CBAuthT ClientM [Order] -listOrders st prid = authRequest methodGet (mkRequestPath "/orders") "" $ API.listOrders (defaultStatus st) prid +listOrders st prid = authRequest methodGet requestPath emptyBody $ API.listOrders (defaultStatus st) prid where - mkRequestPath :: RequestPath -> RequestPath - mkRequestPath rp = rp ++ (C8.unpack . renderQuery True . simpleQueryToQuery $ mkOrderQuery st prid) + query = renderQuery True . simpleQueryToQuery $ orderQuery st prid + requestPath = encodeRequestPath [ordersPath] <> query - mkOrderQuery :: Maybe [Status] -> Maybe ProductId -> SimpleQuery - mkOrderQuery ss p = mkStatusQuery ss <> mkProductQuery p + orderQuery :: Maybe [Status] -> Maybe ProductId -> SimpleQuery + orderQuery ss p = statusQuery ss <> mkProductQuery p - mkStatusQuery :: Maybe [Status] -> [SimpleQueryItem] - mkStatusQuery ss = mkSimpleQueryItem "status" . toLower . pack . show <$> S.toList (unStatuses . statuses $ defaultStatus ss) + statusQuery :: Maybe [Status] -> [SimpleQueryItem] + statusQuery ss = mkSimpleQueryItem "status" <$> S.toList (unStatuses . statuses $ defaultStatus ss) defaultStatus :: Maybe [Status] -> [Status] defaultStatus = fromMaybe [All] @@ -82,19 +173,20 @@ -- | https://docs.pro.coinbase.com/#get-an-order getOrder :: OrderId -> CBAuthT ClientM Order -getOrder oid = authRequest methodGet (mkRequestPath "/orders") "" $ API.getOrder oid +getOrder oid = authRequest methodGet requestPath emptyBody $ API.getOrder oid where - mkRequestPath rp = rp ++ "/" ++ unpack (unOrderId oid) + requestPath = encodeRequestPath [ordersPath, unOrderId oid] -- | https://docs.pro.coinbase.com/#get-an-order getClientOrder :: ClientOrderId -> CBAuthT ClientM Order -getClientOrder cloid = authRequest methodGet (mkRequestPath "/orders/client:") "" $ API.getClientOrder cloid +getClientOrder cloid = authRequest methodGet requestPath emptyBody $ API.getClientOrder cloid where - mkRequestPath rp = rp ++ toString (unClientOrderId cloid) + oid = toText $ unClientOrderId cloid + requestPath = encodeRequestPath [ordersPath, "client:" <> oid] --- | https://docs.pro.coinbase.com/?javascript#place-a-new-order +-- | https://docs.pro.coinbase.com/#place-a-new-order placeOrder :: Maybe ClientOrderId -> ProductId -> Side @@ -106,63 +198,203 @@ -> Maybe TimeInForce -> CBAuthT ClientM Order placeOrder clordid prid sd sz price po ot stp tif = - authRequest methodPost "/orders" (LC8.unpack $ encode body) $ API.placeOrder body + authRequest methodPost requestPath seBody $ API.placeOrder body where - body = PlaceOrderBody clordid prid sd sz price po ot stp tif + requestPath = encodeRequestPath [ordersPath] + body = PlaceOrderBody clordid prid sd sz price po ot stp tif + seBody = LC8.toStrict $ encode body --- | https://docs.pro.coinbase.com/?javascript#cancel-an-order +-- | https://docs.pro.coinbase.com/#cancel-an-order cancelOrder :: OrderId -> CBAuthT ClientM () -cancelOrder oid = void . authRequest methodDelete (mkRequestPath "/orders") "" $ API.cancelOrder oid +cancelOrder oid = void . authRequest methodDelete requestPath emptyBody $ API.cancelOrder oid where - mkRequestPath :: RequestPath -> RequestPath - mkRequestPath rp = rp ++ "/" ++ unpack (unOrderId oid) + requestPath = encodeRequestPath [ordersPath, unOrderId oid] --- | https://docs.pro.coinbase.com/?javascript#cancel-all +-- | https://docs.pro.coinbase.com/#cancel-all cancelAll :: Maybe ProductId -> CBAuthT ClientM [OrderId] -cancelAll prid = authRequest methodDelete (mkRequestPath "/orders") "" (API.cancelAll prid) +cancelAll prid = authRequest methodDelete requestPath emptyBody (API.cancelAll prid) where - mkRequestPath :: RequestPath -> RequestPath - mkRequestPath rp = rp ++ (C8.unpack . renderQuery True . simpleQueryToQuery $ mkProductQuery prid) + query = renderQuery True . simpleQueryToQuery $ mkProductQuery prid + requestPath = encodeRequestPath [ordersPath] <> query --- | https://docs.pro.coinbase.com/?javascript#fills +-- | https://docs.pro.coinbase.com/#fills fills :: Maybe ProductId -> Maybe OrderId -> CBAuthT ClientM [Fill] -fills prid oid = authRequest methodGet mkRequestPath "" (API.fills prid oid) +fills prid oid = authRequest methodGet requestPath emptyBody (API.fills prid oid) where - brp = "/fills" - - mkRequestPath :: RequestPath - mkRequestPath = brp ++ (C8.unpack . renderQuery True . simpleQueryToQuery $ mkSimpleQuery prid oid) + fillsPath = "fills" + query = renderQuery True . simpleQueryToQuery $ mkSimpleQuery prid oid + requestPath = encodeRequestPath [fillsPath] <> query mkSimpleQuery :: Maybe ProductId -> Maybe OrderId -> SimpleQuery mkSimpleQuery p o = mkProductQuery p <> mkOrderIdQuery o --- | https://docs.pro.coinbase.com/?javascript#get-current-fees +-- | https://docs.pro.coinbase.com/#get-current-fees fees :: CBAuthT ClientM Fees -fees = authRequest methodGet mkRequestPath "" API.fees +fees = authRequest methodGet feesRequestPath emptyBody API.fees where - mkRequestPath :: RequestPath - mkRequestPath = "/fees" + feesPath = "fees" + feesRequestPath = encodeRequestPath [feesPath] --- | https://docs.pro.coinbase.com/?javascript#trailing-volume +-- | https://docs.pro.coinbase.com/#trailing-volume trailingVolume :: CBAuthT ClientM [TrailingVolume] -trailingVolume = authRequest methodGet mkRequestPath "" API.trailingVolume +trailingVolume = authRequest methodGet requestPath emptyBody API.trailingVolume where - mkRequestPath :: RequestPath - mkRequestPath = "/users/self/trailing-volume" + requestPath = encodeRequestPath ["users", "self", "trailing-volume"] -mkSimpleQueryItem :: String -> Text -> SimpleQueryItem -mkSimpleQueryItem s t = (C8.pack s, C8.pack $ unpack t) +-- | https://docs.pro.coinbase.com/#get-current-exchange-limits +limits :: CBAuthT ClientM Limits +limits = authRequest methodGet requestPath emptyBody API.limits + where + requestPath = encodeRequestPath ["users", "self", "exchange-limits"] -mkProductQuery :: Maybe ProductId -> [SimpleQueryItem] -mkProductQuery = maybe [] (return . mkSimpleQueryItem "product_id" . unProductId) +-- | https://docs.pro.coinbase.com/#list-deposits +deposits :: Maybe ProfileId + -> Maybe UTCTime + -> Maybe UTCTime + -> Maybe Int + -> CBAuthT ClientM [Transfer] +deposits = transfers DepositTransferType -mkOrderIdQuery :: Maybe OrderId -> SimpleQuery -mkOrderIdQuery = maybe [] (return . mkSimpleQueryItem "order_id" . unOrderId) +-- | https://docs.pro.coinbase.com/#list-withdrawals +withdrawals :: Maybe ProfileId + -> Maybe UTCTime + -> Maybe UTCTime + -> Maybe Int + -> CBAuthT ClientM [Transfer] +withdrawals = transfers WithdrawTransferType + + +transfers :: TransferType + -> Maybe ProfileId + -> Maybe UTCTime + -> Maybe UTCTime + -> Maybe Int + -> CBAuthT ClientM [Transfer] +transfers tt prof before after lm = authRequest methodGet requestPath emptyBody $ + API.transfers tt prof before after lm + where + typeQ = return $ mkSimpleQueryItem "type" tt + profQ = optionalQuery "profile_id" prof + beforeQ = optionalQuery "before" before + afterQ = optionalQuery "after" after + lmQ = optionalQuery "limit" lm + + query = renderQuery True . simpleQueryToQuery $ typeQ <> profQ <> beforeQ <> afterQ <> lmQ + requestPath = encodeRequestPath ["transfers"] <> query + + +-- | https://docs.pro.coinbase.com/#single-deposit +-- | https://docs.pro.coinbase.com/#single-withdrawal +transfer :: PaymentMethodId -> CBAuthT ClientM Transfer +transfer pmt@(PaymentMethodId p) = authRequest methodGet requestPath emptyBody $ API.transfer pmt + where + requestPath = encodeRequestPath ["transfers", p] + + +-- | https://docs.pro.coinbase.com/#payment-method +makeDeposit :: Double + -> Text + -> PaymentMethodId + -> CBAuthT ClientM DepositResponse +makeDeposit amt cur pmi = + authRequest methodPost requestPath seBody $ API.makeDeposit body + where + requestPath = encodeRequestPath ["deposits", "payment-method"] + body = DepositRequest amt cur pmi + seBody = LC8.toStrict $ encode body + + +-- | https://docs.pro.coinbase.com/#coinbase +makeCoinbaseDeposit :: Double + -> Text + -> AccountId + -> CBAuthT ClientM DepositResponse +makeCoinbaseDeposit amt cur act = + authRequest methodPost requestPath seBody $ API.makeCoinbaseDeposit body + where + requestPath = encodeRequestPath ["deposits", "coinbase-account"] + body = CoinbaseDepositRequest amt cur act + seBody = LC8.toStrict $ encode body + + +-- | https://docs.pro.coinbase.com/#generate-a-crypto-deposit-address +cryptoDepositAddress :: AccountId -> CBAuthT ClientM CryptoDepositAddress +cryptoDepositAddress act = + authRequest methodPost requestPath emptyBody $ API.cryptoDepositAddress act + where + requestPath = encodeRequestPath ["coinbase-accounts", pack $ show act, "addresses"] + + +-- | https://docs.pro.coinbase.com/#payment-method55 +makeWithdrawal :: Double + -> Text + -> PaymentMethodId + -> CBAuthT ClientM WithdrawalResponse +makeWithdrawal amt cur pmi = + authRequest methodPost requestPath seBody $ API.makeWithdrawal body + where + requestPath = encodeRequestPath ["withdrawals", "payment-method"] + body = WithdrawalRequest amt cur pmi + seBody = LC8.toStrict $ encode body + + +-- | https://docs.pro.coinbase.com/#coinbase56 +makeCoinbaseWithdrawal :: Double + -> Text + -> AccountId + -> CBAuthT ClientM WithdrawalResponse +makeCoinbaseWithdrawal amt cur act = + authRequest methodPost requestPath seBody $ API.makeCoinbaseWithdrawal body + where + requestPath = encodeRequestPath ["withdrawals", "coinbase-account"] + body = CoinbaseWithdrawalRequest amt cur act + seBody = LC8.toStrict $ encode body + + +-- | https://docs.pro.coinbase.com/#crypto +makeCryptoWithdrawal :: Double + -> Text + -> Text + -> CBAuthT ClientM CryptoWithdrawalResponse +makeCryptoWithdrawal amt cur addr = + authRequest methodPost requestPath seBody $ API.makeCryptoWithdrawal body + where + requestPath = encodeRequestPath ["withdrawals", "crypto"] + body = CryptoWithdrawalRequest amt cur addr + seBody = LC8.toStrict $ encode body + + +-- | https://docs.pro.coinbase.com/#fee-estimate +withdrawalFeeEstimate :: CurrencyType + -> CryptoAddress + -> CBAuthT ClientM WithdrawalFeeEstimateResponse +withdrawalFeeEstimate cur addr = + authRequest methodGet requestPath emptyBody $ API.withdrawalFeeEstimate cur addr + where + curQ = return $ mkSimpleQueryItem "currency" cur + addrQ = return $ mkSimpleQueryItem "crypto_address" addr + + query = renderQuery True . simpleQueryToQuery $ curQ <> addrQ + requestPath = encodeRequestPath ["withdrawals", "fee-estimate"] <> query + + +-- | https://docs.pro.coinbase.com/#list-payment-methods +paymentMethods :: CBAuthT ClientM [PaymentMethod] +paymentMethods = authRequest methodGet requestPath emptyBody API.paymentMethods + where + requestPath = encodeRequestPath ["payment-methods"] + + +-- | https://docs.pro.coinbase.com/#list-accounts64 +coinbaseAccounts :: CBAuthT ClientM [CoinbaseAccount] +coinbaseAccounts = authRequest methodGet requestPath emptyBody API.coinbaseAccounts + where + requestPath = encodeRequestPath ["coinbase-accounts"] diff --git a/src/lib/CoinbasePro/Authenticated/API.hs b/src/lib/CoinbasePro/Authenticated/API.hs --- a/src/lib/CoinbasePro/Authenticated/API.hs +++ b/src/lib/CoinbasePro/Authenticated/API.hs @@ -5,6 +5,8 @@ module CoinbasePro.Authenticated.API ( accounts , singleAccount + , accountHistory + , accountHolds , listOrders , getOrder , getClientOrder @@ -14,30 +16,72 @@ , fills , fees , trailingVolume + , limits + , transfers + , transfer + , makeDeposit + , makeCoinbaseDeposit + , cryptoDepositAddress + , makeWithdrawal + , makeCoinbaseWithdrawal + , makeCryptoWithdrawal + , withdrawalFeeEstimate + , paymentMethods + , coinbaseAccounts ) where -import Data.Proxy (Proxy (..)) -import Servant.API ((:<|>) (..), (:>), - AuthProtect, Capture, JSON, - NoContent, QueryParam, - QueryParams, ReqBody) +import Data.Proxy (Proxy (..)) +import Data.Time.Clock (UTCTime) +import Servant.API (AuthProtect, + Capture, JSON, + NoContent, + QueryParam, + QueryParam', + QueryParams, + ReqBody, Required, + (:<|>) (..), (:>)) import Servant.Client -import Servant.Client.Core (AuthenticatedRequest) +import Servant.Client.Core (AuthenticatedRequest) -import CoinbasePro.Authenticated.Accounts (Account, AccountId (..), - Fees, TrailingVolume) -import CoinbasePro.Authenticated.Fills (Fill) -import CoinbasePro.Authenticated.Orders (Order, PlaceOrderBody (..), - Status (..)) -import CoinbasePro.Authenticated.Request (AuthDelete, AuthGet, - AuthPost) -import CoinbasePro.Types (ClientOrderId (..), - OrderId (..), - ProductId (..)) +import CoinbasePro.Authenticated.Accounts (Account, + AccountHistory, + AccountId (..), + Fees, Hold, + TrailingVolume) +import CoinbasePro.Authenticated.CoinbaseAccounts (CoinbaseAccount) +import CoinbasePro.Authenticated.Deposit (CoinbaseDepositRequest, + CryptoDepositAddress, + DepositRequest, + DepositResponse) +import CoinbasePro.Authenticated.Fills (Fill) +import CoinbasePro.Authenticated.Limits (Limits) +import CoinbasePro.Authenticated.Orders (Order, + PlaceOrderBody (..), + Status (..)) +import CoinbasePro.Authenticated.Payment (PaymentMethod (..), + PaymentMethodId) +import CoinbasePro.Authenticated.Request (AuthDelete, + AuthGet, AuthPost) +import CoinbasePro.Authenticated.Transfer (Transfer, + TransferType) +import CoinbasePro.Authenticated.Withdrawal (CoinbaseWithdrawalRequest (..), + CryptoWithdrawalRequest, + CryptoWithdrawalResponse, + WithdrawalFeeEstimateResponse, + WithdrawalRequest, + WithdrawalResponse) +import CoinbasePro.Types (ClientOrderId (..), + CryptoAddress, + CurrencyType, + OrderId (..), + ProductId (..), + ProfileId) type API = "accounts" :> AuthGet [Account] - :<|> "accounts" :> Capture "account-id" AccountId :> AuthGet Account + :<|> "accounts" :> Capture "account_id" AccountId :> AuthGet Account + :<|> "accounts" :> Capture "account_id" AccountId :> "ledger" :> AuthGet [AccountHistory] + :<|> "accounts" :> Capture "account_id" AccountId :> "holds" :> AuthGet [Hold] :<|> "orders" :> QueryParams "status" Status :> QueryParam "product_id" ProductId :> AuthGet [Order] :<|> "orders" :> Capture "order_id" OrderId :> AuthGet Order :<|> "orders" :> Capture "client_oid" ClientOrderId :> AuthGet Order @@ -47,6 +91,27 @@ :<|> "fills" :> QueryParam "product_id" ProductId :> QueryParam "order_id" OrderId :> AuthGet [Fill] :<|> "fees" :> AuthGet Fees :<|> "users" :> "self" :> "trailing-volume" :> AuthGet [TrailingVolume] + :<|> "users" :> "self" :> "exchange-limits" :> AuthGet Limits + :<|> "transfers" + :> QueryParam' '[Required] "type" TransferType + :> QueryParam "profile_id" ProfileId + :> QueryParam "before" UTCTime + :> QueryParam "after" UTCTime + :> QueryParam "limit" Int + :> AuthGet [Transfer] + :<|> "transfers" :> Capture "transfer_id" PaymentMethodId :> AuthGet Transfer + :<|> "deposits" :> "payment-method" :> ReqBody '[JSON] DepositRequest :> AuthPost DepositResponse + :<|> "deposits" :> "coinbase-account" :> ReqBody '[JSON] CoinbaseDepositRequest :> AuthPost DepositResponse + :<|> "coinbase-accounts" :> Capture "account_id" AccountId :> "addresses" :> AuthPost CryptoDepositAddress + :<|> "withdrawals" :> "payment-method" :> ReqBody '[JSON] WithdrawalRequest :> AuthPost WithdrawalResponse + :<|> "withdrawals" :> "coinbase-account" :> ReqBody '[JSON] CoinbaseWithdrawalRequest :> AuthPost WithdrawalResponse + :<|> "withdrawals" :> "crypto" :> ReqBody '[JSON] CryptoWithdrawalRequest :> AuthPost CryptoWithdrawalResponse + :<|> "withdrawals" :> "fee-estimate" + :> QueryParam' '[Required] "currency" CurrencyType + :> QueryParam' '[Required] "crypto_address" CryptoAddress + :> AuthGet WithdrawalFeeEstimateResponse + :<|> "payment-methods" :> AuthGet [PaymentMethod] + :<|> "coinbase-accounts" :> AuthGet [CoinbaseAccount] api :: Proxy API @@ -55,6 +120,8 @@ accounts :: AuthenticatedRequest (AuthProtect "CBAuth") -> ClientM [Account] singleAccount :: AccountId -> AuthenticatedRequest (AuthProtect "CBAuth") -> ClientM Account +accountHistory :: AccountId -> AuthenticatedRequest (AuthProtect "CBAuth") -> ClientM [AccountHistory] +accountHolds :: AccountId -> AuthenticatedRequest (AuthProtect "CBAuth") -> ClientM [Hold] listOrders :: [Status] -> Maybe ProductId -> AuthenticatedRequest (AuthProtect "CBAuth") -> ClientM [Order] getOrder :: OrderId -> AuthenticatedRequest (AuthProtect "CBAuth") -> ClientM Order getClientOrder :: ClientOrderId -> AuthenticatedRequest (AuthProtect "CBAuth") -> ClientM Order @@ -64,4 +131,20 @@ fills :: Maybe ProductId -> Maybe OrderId -> AuthenticatedRequest (AuthProtect "CBAuth") -> ClientM [Fill] fees :: AuthenticatedRequest (AuthProtect "CBAuth") -> ClientM Fees trailingVolume :: AuthenticatedRequest (AuthProtect "CBAuth") -> ClientM [TrailingVolume] -accounts :<|> singleAccount :<|> listOrders :<|> getOrder :<|> getClientOrder :<|> placeOrder :<|> cancelOrder :<|> cancelAll :<|> fills :<|> fees :<|> trailingVolume = client api +limits :: AuthenticatedRequest (AuthProtect "CBAuth") -> ClientM Limits +transfers :: TransferType -> Maybe ProfileId -> Maybe UTCTime -> Maybe UTCTime -> Maybe Int -> AuthenticatedRequest (AuthProtect "CBAuth") -> ClientM [Transfer] +transfer :: PaymentMethodId -> AuthenticatedRequest (AuthProtect "CBAuth") -> ClientM Transfer +makeDeposit :: DepositRequest -> AuthenticatedRequest (AuthProtect "CBAuth") -> ClientM DepositResponse +makeCoinbaseDeposit :: CoinbaseDepositRequest -> AuthenticatedRequest (AuthProtect "CBAuth") -> ClientM DepositResponse +cryptoDepositAddress :: AccountId -> AuthenticatedRequest (AuthProtect "CBAuth") -> ClientM CryptoDepositAddress +makeWithdrawal :: WithdrawalRequest -> AuthenticatedRequest (AuthProtect "CBAuth") -> ClientM WithdrawalResponse +makeCoinbaseWithdrawal :: CoinbaseWithdrawalRequest -> AuthenticatedRequest (AuthProtect "CBAuth") -> ClientM WithdrawalResponse +makeCryptoWithdrawal :: CryptoWithdrawalRequest -> AuthenticatedRequest (AuthProtect "CBAuth") -> ClientM CryptoWithdrawalResponse +withdrawalFeeEstimate :: CurrencyType -> CryptoAddress -> AuthenticatedRequest (AuthProtect "CBAuth") -> ClientM WithdrawalFeeEstimateResponse +paymentMethods :: AuthenticatedRequest (AuthProtect "CBAuth") -> ClientM [PaymentMethod] +coinbaseAccounts :: AuthenticatedRequest (AuthProtect "CBAuth") -> ClientM [CoinbaseAccount] +accounts + :<|> singleAccount :<|> accountHistory :<|> accountHolds :<|> listOrders :<|> getOrder :<|> getClientOrder :<|> placeOrder + :<|> cancelOrder :<|> cancelAll :<|> fills :<|> fees :<|> trailingVolume :<|> limits :<|> transfers :<|> transfer + :<|> makeDeposit :<|> makeCoinbaseDeposit :<|> cryptoDepositAddress :<|> makeWithdrawal :<|> makeCoinbaseWithdrawal + :<|> makeCryptoWithdrawal :<|> withdrawalFeeEstimate :<|> paymentMethods :<|> coinbaseAccounts = client api diff --git a/src/lib/CoinbasePro/Authenticated/Accounts.hs b/src/lib/CoinbasePro/Authenticated/Accounts.hs --- a/src/lib/CoinbasePro/Authenticated/Accounts.hs +++ b/src/lib/CoinbasePro/Authenticated/Accounts.hs @@ -10,23 +10,39 @@ , ProfileId (..) , Fees (..) , TrailingVolume (..) + , AccountHistory (..) + , Hold (..) ) where -import Data.Aeson (FromJSON (..), ToJSON, withObject, (.:)) +import Data.Aeson (FromJSON (..), ToJSON, withObject, withText, + (.:), (.:?)) +import qualified Data.Aeson as A import Data.Aeson.Casing (snakeCase) -import Data.Aeson.TH (defaultOptions, deriveJSON, - fieldLabelModifier) -import Data.Text (Text) +import Data.Aeson.TH (constructorTagModifier, defaultOptions, + deriveJSON, fieldLabelModifier) +import qualified Data.Char as Char +import Data.Text (Text, pack, unpack) import Data.Time.Clock (UTCTime) +import Text.Printf (printf) import Web.HttpApiData (ToHttpApiData (..)) -import CoinbasePro.Types (ProductId, Volume (..)) +import CoinbasePro.Types (CreatedAt (..), OrderId, ProductId, + TradeId (..), Volume (..)) newtype AccountId = AccountId Text - deriving (Eq, Show) + deriving Eq +instance Show AccountId where + show (AccountId t) = unpack t + + +deriveJSON defaultOptions + { fieldLabelModifier = snakeCase + } ''AccountId + + instance ToHttpApiData AccountId where toUrlPiece (AccountId aid) = aid toQueryParam (AccountId aid) = aid @@ -40,6 +56,15 @@ deriving (Eq, Show) +instance ToJSON Balance where + toJSON (Balance s) = A.String . pack $ printf "%.16f" s + + +instance FromJSON Balance where + parseJSON = withText "balance" $ \t -> + return . Balance . read $ unpack t + + newtype ProfileId = ProfileId Text deriving (Eq, Show) @@ -91,3 +116,73 @@ deriveJSON defaultOptions { fieldLabelModifier = snakeCase } ''TrailingVolume + + +data AccountHistoryType = Transfer | Match | Fee | Rebate | Conversion + deriving (Eq, Show) + + +deriveJSON defaultOptions { constructorTagModifier = fmap Char.toLower } ''AccountHistoryType + + +data Details = Details + { dOrderId :: Maybe OrderId + , dTradeId :: Maybe TradeId + , dProductId :: Maybe ProductId + } deriving (Eq, Show) + + +instance FromJSON Details where + parseJSON = withObject "details" $ \o -> Details + <$> (o .:? "order_id") + <*> (fmap (TradeId . read) <$> o .:? "trade_id") + <*> (o .:? "product_id") + + +data AccountHistory = AccountHistory + { hAccountId :: AccountId + , hCreatedAt :: CreatedAt + , hAmount :: Double + , hBalance :: Balance + , hType :: AccountHistoryType + , hDetails :: Maybe Details + } deriving (Eq, Show) + + +instance FromJSON AccountHistory where + parseJSON = withObject "account_history" $ \o -> AccountHistory + <$> (AccountId <$> o .: "id") + <*> (CreatedAt <$> o .: "created_at") + <*> (read <$> o .: "amount") + <*> (Balance . read <$> o .: "balance") + <*> (o .: "type") + <*> (o .: "details") + + +newtype HoldId = HoldId Text + deriving (Eq, Show, ToJSON, FromJSON) + + +data HoldType = Order | HoldTransfer + deriving (Eq, Show) + + +newtype HoldRef = HoldRef Text + deriving (Eq, Show, ToJSON, FromJSON) + + +deriveJSON defaultOptions { constructorTagModifier = fmap Char.toLower } ''HoldType + + +data Hold = Hold + { holdId :: HoldId + , holdAccountId :: AccountId + , holdCreatedAt :: CreatedAt + , holdUpdatedAt :: CreatedAt + , holdAmount :: Double + , holdType :: HoldType + , holdRef :: HoldRef + } deriving (Eq, Show) + + +deriveJSON defaultOptions { constructorTagModifier = fmap Char.toLower . drop 4, fieldLabelModifier = snakeCase } ''Hold diff --git a/src/lib/CoinbasePro/Authenticated/CoinbaseAccounts.hs b/src/lib/CoinbasePro/Authenticated/CoinbaseAccounts.hs new file mode 100644 --- /dev/null +++ b/src/lib/CoinbasePro/Authenticated/CoinbaseAccounts.hs @@ -0,0 +1,140 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +module CoinbasePro.Authenticated.CoinbaseAccounts + ( CoinbaseAccount (..) + ) where + +import Data.Aeson (FromJSON (..), Value (..), withObject, (.:), + (.:?)) +import Data.Aeson.Casing (snakeCase) +import Data.Aeson.TH (defaultOptions, deriveJSON, + fieldLabelModifier) +import Data.Text (Text) + + +data BankCountry = BankCountry + { code :: Text + , name :: Text + } deriving Show + + +deriveJSON defaultOptions + { fieldLabelModifier = snakeCase + } ''BankCountry + + +data WireDepositInformation = WireDepositInformation + { accountNumber :: Maybe Text + , routingNumber :: Text + , bankName :: Text + , bankAddress :: Text + , bankCountry :: BankCountry + , accountName :: Text + , accountAddress :: Text + , reference :: Text + } deriving Show + + +instance FromJSON WireDepositInformation where + parseJSON = withObject "wire deposit information" $ \o -> WireDepositInformation + <$> o .: "account_number" + <*> o .: "routing_number" + <*> o .: "bank_name" + <*> o .: "bank_address" + <*> (parseJSON =<< (o .: "bank_country")) + <*> o .: "account_name" + <*> o .: "account_address" + <*> o .: "reference" + + +data SepaDepositInformation = SepaDepositInformation + { sIban :: Text + , sSwift :: Text + , sBankName :: Text + , sBankAddress :: Text + , sBankCountryName :: Text + , sAccountName :: Text + , sAccountAddress :: Text + , sReference :: Text + } deriving Show + + +deriveJSON defaultOptions + { fieldLabelModifier = snakeCase . drop 1 + } ''SepaDepositInformation + + +data DepositInformation = Wire WireDepositInformation | Sepa SepaDepositInformation + deriving Show + + +-- TODO: this is slightly messy, potentially refactor +instance FromJSON DepositInformation where + parseJSON = withObject "deposit_information" $ \o -> do + w <- o .:? "wire_deposit_information" + case w of + Just (Object w') -> Wire <$> parseJSON (Object w') + Nothing -> do + s <- o .:? "sepa_deposit_information" + case s of + Just (Object s') -> Sepa <$> parseJSON (Object s') + _ -> fail "Unable to parse deposit information" + _ -> fail "Unable to parse deposit information" + + +data Account = Account + { aId :: Text + , aName :: Text + , aBalance :: Double + , aCurrency :: Text + , aType :: Text + , aPrimary :: Bool + , aActive :: Bool + } deriving (Show) + + +instance FromJSON Account where + parseJSON = withObject "account" $ \o -> Account + <$> o .: "id" + <*> o .: "name" + <*> (read <$> o .: "balance") + <*> o .: "currency" + <*> o .: "type" + <*> o .: "primary" + <*> o .: "active" + + +data FiatAccount = FiatAccount + { fAccount :: Account + , fDepositInformation :: DepositInformation + } deriving Show + + +instance FromJSON FiatAccount where + parseJSON = withObject "fiat account" $ \o -> FiatAccount + <$> parseJSON (Object o) + <*> parseJSON (Object o) + + +newtype CryptoAccount = CryptoAccount Account + deriving Show + + +instance FromJSON CryptoAccount where + parseJSON = withObject "crypto account" $ \o -> CryptoAccount + <$> parseJSON (Object o) + + +data CoinbaseAccount = Fiat FiatAccount | Crypto CryptoAccount + deriving Show + + +instance FromJSON CoinbaseAccount where + parseJSON = withObject "coinbase account" $ \o -> do + t <- String <$> o .: "type" + case t of + "fiat" -> Fiat <$> parseJSON (Object o) + "wallet" -> Crypto <$> parseJSON (Object o) + _ -> fail "Unable to parse coinbase account" diff --git a/src/lib/CoinbasePro/Authenticated/Deposit.hs b/src/lib/CoinbasePro/Authenticated/Deposit.hs new file mode 100644 --- /dev/null +++ b/src/lib/CoinbasePro/Authenticated/Deposit.hs @@ -0,0 +1,92 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +module CoinbasePro.Authenticated.Deposit + ( DepositDetails (..) + , DepositRequest (..) + , DepositResponse (..) + , CoinbaseDepositRequest (..) + , CryptoDepositAddress (..) + ) where + +import Data.Aeson.Casing (snakeCase) +import Data.Aeson.TH (defaultOptions, deriveJSON, + fieldLabelModifier) +import Data.Text (Text) +import Data.Time.Clock (UTCTime) +import Data.UUID (UUID) + +import CoinbasePro.Authenticated.Accounts (AccountId) +import CoinbasePro.Authenticated.Payment (PaymentMethodId (..)) +import CoinbasePro.Types (CreatedAt) + + +data DepositDetails = DepositDetails + { cryptoAddress :: Maybe Text + , destinationTag :: Maybe Text + , coinbaseAccountId :: AccountId + , destinationTagName :: Maybe Text + , coinbaseTransactionId :: Text + , cryptoTransactionHash :: Maybe Text + } deriving (Eq, Show) + + +deriveJSON defaultOptions { fieldLabelModifier = snakeCase } ''DepositDetails + + +data DepositRequest = DepositRequest + { amount :: Double + , currency :: Text + , paymentMethodId :: PaymentMethodId + } deriving (Eq, Show) + + +deriveJSON defaultOptions { fieldLabelModifier = snakeCase } ''DepositRequest + + +data CoinbaseDepositRequest = CoinbaseDepositRequest + { cAmount :: Double + , cCurrency :: Text + , cCoinbaseAccountId :: AccountId + } deriving (Eq, Show) + + +deriveJSON defaultOptions { fieldLabelModifier = snakeCase . drop 1 } ''CoinbaseDepositRequest + + +data DepositResponse = DepositResponse + { rId :: UUID + , rAmount :: Double + , rCurrency :: Text + , rPayoutAt :: UTCTime + } deriving (Eq, Show) + + +deriveJSON defaultOptions { fieldLabelModifier = snakeCase . drop 1 } ''DepositResponse + + +data AddressInfo = AddressInfo + { aiAddress :: Text + , aiDestinationTag :: Maybe Int + } deriving Show + + +deriveJSON defaultOptions { fieldLabelModifier = snakeCase . drop 2 } ''AddressInfo + + +data CryptoDepositAddress = CryptoDepositAddress + { cdaId :: UUID + , cdaAddress :: Text + , cdaDestinationTag :: Maybe Int + , cdaAddressInfo :: AddressInfo + , cdaCreatedAt :: CreatedAt + , cdaUpdatedAt :: UTCTime + , cdaNetwork :: Text + , cdaResource :: Text + , cdaDepositUri :: Text + , cdaExchangeDepositAddress :: Bool + } deriving Show + + +deriveJSON defaultOptions { fieldLabelModifier = snakeCase . drop 3 } ''CryptoDepositAddress diff --git a/src/lib/CoinbasePro/Authenticated/Headers.hs b/src/lib/CoinbasePro/Authenticated/Headers.hs --- a/src/lib/CoinbasePro/Authenticated/Headers.hs +++ b/src/lib/CoinbasePro/Authenticated/Headers.hs @@ -6,23 +6,24 @@ ) where import Data.Aeson (ToJSON (..), Value (String)) +import qualified Data.Aeson as A import Data.ByteString (ByteString) -import Data.Text (pack) +import Data.Text (Text) import Data.Text.Encoding (decodeUtf8) import Web.HttpApiData (ToHttpApiData (..)) -newtype CBAccessKey = CBAccessKey String +newtype CBAccessKey = CBAccessKey Text deriving (Eq, Show) instance ToHttpApiData CBAccessKey where - toUrlPiece (CBAccessKey k) = pack k - toQueryParam (CBAccessKey k) = pack k + toUrlPiece (CBAccessKey k) = k + toQueryParam (CBAccessKey k) = k instance ToJSON CBAccessKey where - toJSON (CBAccessKey k) = String $ pack k + toJSON (CBAccessKey k) = A.String k newtype CBAccessSign = CBAccessSign ByteString @@ -35,30 +36,30 @@ instance ToJSON CBAccessSign where - toJSON (CBAccessSign s) = String $ decodeUtf8 s + toJSON (CBAccessSign s) = A.String $ decodeUtf8 s -newtype CBAccessTimeStamp = CBAccessTimeStamp String +newtype CBAccessTimeStamp = CBAccessTimeStamp Text deriving (Eq, Show) instance ToHttpApiData CBAccessTimeStamp where - toUrlPiece (CBAccessTimeStamp ts) = pack ts - toQueryParam (CBAccessTimeStamp ts) = pack ts + toUrlPiece (CBAccessTimeStamp ts) = ts + toQueryParam (CBAccessTimeStamp ts) = ts instance ToJSON CBAccessTimeStamp where - toJSON (CBAccessTimeStamp ts) = String $ pack ts + toJSON (CBAccessTimeStamp ts) = String ts -newtype CBAccessPassphrase = CBAccessPassphrase String +newtype CBAccessPassphrase = CBAccessPassphrase Text deriving (Eq, Show) instance ToJSON CBAccessPassphrase where - toJSON (CBAccessPassphrase p) = String $ pack p + toJSON (CBAccessPassphrase p) = A.String p instance ToHttpApiData CBAccessPassphrase where - toUrlPiece (CBAccessPassphrase p) = pack p - toQueryParam (CBAccessPassphrase p) = pack p + toUrlPiece (CBAccessPassphrase p) = p + toQueryParam (CBAccessPassphrase p) = p diff --git a/src/lib/CoinbasePro/Authenticated/Limits.hs b/src/lib/CoinbasePro/Authenticated/Limits.hs new file mode 100644 --- /dev/null +++ b/src/lib/CoinbasePro/Authenticated/Limits.hs @@ -0,0 +1,77 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE TemplateHaskell #-} + +module CoinbasePro.Authenticated.Limits + ( Limits (..) + ) where + +import Data.Aeson (FromJSON, ToJSON, parseJSON, withText) +import Data.Aeson.Casing (snakeCase) +import Data.Aeson.TH (defaultOptions, deriveJSON, + fieldLabelModifier) +import Data.Map.Strict (Map) +import Data.Text (Text, unpack) + +import CoinbasePro.Types (ProductId) + + +newtype LimitCurrency = LimitCurrency Text + deriving (Eq, Show, ToJSON, FromJSON) + + +newtype Max = Max Double + deriving (Eq, Show, ToJSON, FromJSON) + + +newtype Remaining = Remaining Double + deriving (Eq, Show, ToJSON, FromJSON) + + +newtype PeriodInDays = PeriodInDays Int + deriving (Eq, Show, ToJSON) + + +instance FromJSON PeriodInDays where + parseJSON = withText "period_in_days" $ \t -> + return . PeriodInDays . read $ unpack t + + +data Limit = Limit + { max :: Max + , remaining :: Remaining + , periodInDays :: Maybe PeriodInDays + } deriving (Eq, Show) + + +deriveJSON defaultOptions { fieldLabelModifier = snakeCase } ''Limit + + +type LimitMap = Map ProductId Limit + + +data TransferLimits = TransferLimits + { ach :: Maybe LimitMap + , achNoBalance :: Maybe LimitMap + , creditDebitCard :: Maybe LimitMap + , achCurm :: Maybe LimitMap + , secure3dBuy :: Maybe LimitMap + , exchangeWithdraw :: Maybe LimitMap + , exchangeAch :: Maybe LimitMap + , paypalWithdrawal :: Maybe LimitMap + , instantAchWithdrawal :: Maybe LimitMap + , instantBuy :: Maybe LimitMap + , buy :: Maybe LimitMap + , sell :: Maybe LimitMap + } deriving (Eq, Show) + + +deriveJSON defaultOptions { fieldLabelModifier = snakeCase } ''TransferLimits + + +data Limits = Limits + { limitCurrency :: LimitCurrency + , transferLimits :: TransferLimits + } deriving (Eq, Show) + + +deriveJSON defaultOptions { fieldLabelModifier = snakeCase } ''Limits diff --git a/src/lib/CoinbasePro/Authenticated/Orders.hs b/src/lib/CoinbasePro/Authenticated/Orders.hs --- a/src/lib/CoinbasePro/Authenticated/Orders.hs +++ b/src/lib/CoinbasePro/Authenticated/Orders.hs @@ -30,12 +30,20 @@ -- TODO: All is not a status data Status = Open | Pending | Active | Done | All - deriving (Eq, Ord, Show) + deriving (Eq, Ord) +instance Show Status where + show Open = "open" + show Pending = "pending" + show Active = "active" + show Done = "done" + show All = "all" + + instance ToHttpApiData Status where - toUrlPiece = toLower . pack . show - toQueryParam = toLower . pack . show + toUrlPiece = pack . show + toQueryParam = pack . show newtype Statuses = Statuses { unStatuses :: Set Status } diff --git a/src/lib/CoinbasePro/Authenticated/Payment.hs b/src/lib/CoinbasePro/Authenticated/Payment.hs new file mode 100644 --- /dev/null +++ b/src/lib/CoinbasePro/Authenticated/Payment.hs @@ -0,0 +1,79 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +module CoinbasePro.Authenticated.Payment + ( PaymentMethodId (..) + , PaymentMethod (..) + ) where + +import Data.Aeson.Casing (snakeCase) +import Data.Aeson.TH (defaultOptions, deriveJSON, + fieldLabelModifier) +import Data.Text (Text, toLower, unpack) +import Servant.API + + +newtype PaymentMethodId = PaymentMethodId Text + deriving Eq + + +instance Show PaymentMethodId where + show (PaymentMethodId p) = unpack p + + +deriveJSON defaultOptions { fieldLabelModifier = snakeCase } ''PaymentMethodId + + +instance ToHttpApiData PaymentMethodId where + toUrlPiece (PaymentMethodId p) = toLower p + toQueryParam (PaymentMethodId p) = toLower p + + +data LimitTotal = LimitTotal + { ltAmount :: Double + , ltCurrency :: Text + } deriving (Eq, Show) + + +deriveJSON defaultOptions { fieldLabelModifier = snakeCase . drop 2} ''LimitTotal + + +data LimitRemaining = LimitRemaining + { lrAmount :: Double + , lrCurrency :: Text + } deriving (Eq, Show) + + +deriveJSON defaultOptions { fieldLabelModifier = snakeCase . drop 2} ''LimitRemaining + + +data Limit = Limit + { periodInDays :: Int + , total :: LimitTotal + , remaining :: LimitRemaining + } deriving (Eq, Show) + + +deriveJSON defaultOptions { fieldLabelModifier = snakeCase } ''Limit + + +data PaymentMethod = PaymentMethod + { pmId :: PaymentMethodId + , pmType :: Text + , pmName :: Text + , pmCurrency :: Text + , pmPrimaryBuy :: Bool + , pmPrimarySell :: Bool + , pmAllowBuy :: Bool + , pmAllowSell :: Bool + , pmAllowDeposit :: Bool + , pmAllowWithdraw :: Bool + , pmBuyLimits :: Maybe [Limit] + , pmInstantBuyLimits :: Maybe [Limit] + , pmSellLimits :: Maybe [Limit] + , pmDepositLimits :: Maybe [Limit] + } deriving (Eq, Show) + + +deriveJSON defaultOptions { fieldLabelModifier = snakeCase . drop 2 } ''PaymentMethod diff --git a/src/lib/CoinbasePro/Authenticated/Request.hs b/src/lib/CoinbasePro/Authenticated/Request.hs --- a/src/lib/CoinbasePro/Authenticated/Request.hs +++ b/src/lib/CoinbasePro/Authenticated/Request.hs @@ -30,13 +30,15 @@ convertToBase) import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as C8 +import Data.Text (pack) +import Data.Text.Encoding (encodeUtf8) import Data.Time.Clock (getCurrentTime) import Data.Time.Format (defaultTimeLocale, formatTime) import GHC.TypeLits (Symbol) import Network.HTTP.Types (Method) -import Servant.API ((:>), AuthProtect, Delete, - Get, JSON, Post) +import Servant.API (AuthProtect, Delete, Get, + JSON, Post, (:>)) import Servant.Client (ClientM) import Servant.Client.Core (AuthClientData, AuthenticatedRequest, @@ -105,7 +107,7 @@ mkCBAccessTimeStamp :: IO CBAccessTimeStamp -mkCBAccessTimeStamp = CBAccessTimeStamp . formatTime defaultTimeLocale "%s%Q" <$> getCurrentTime +mkCBAccessTimeStamp = CBAccessTimeStamp . pack . formatTime defaultTimeLocale "%s%Q" <$> getCurrentTime mkCBAccessSign :: CBSecretKey -> CBAccessTimeStamp -> Method -> RequestPath -> Body -> CBAccessSign @@ -116,7 +118,7 @@ hmac = HMAC.hmac dak msg :: HMAC.HMAC SHA256 mkMsg :: CBAccessTimeStamp -> Method -> RequestPath -> Body -> ByteString - mkMsg (CBAccessTimeStamp s) m rp b = C8.pack $ s ++ C8.unpack m ++ rp ++ b + mkMsg (CBAccessTimeStamp s) m rp b = encodeUtf8 s <> m <> rp <> b decodeApiKey :: CBSecretKey -> ByteString diff --git a/src/lib/CoinbasePro/Authenticated/Transfer.hs b/src/lib/CoinbasePro/Authenticated/Transfer.hs new file mode 100644 --- /dev/null +++ b/src/lib/CoinbasePro/Authenticated/Transfer.hs @@ -0,0 +1,101 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} + +module CoinbasePro.Authenticated.Transfer + ( TransferType (..) + , Transfer (..) + ) where + +import Data.Aeson (FromJSON (..), ToJSON, + Value (..), parseJSON, + withObject, (.:), (.:?)) +import Data.Text (Text, pack) +import Data.Time.Clock (UTCTime) +import Servant.API + +import CoinbasePro.Authenticated.Accounts (AccountId) +import CoinbasePro.Authenticated.Deposit (DepositDetails) +import CoinbasePro.Authenticated.Withdrawal (WithdrawalDetails) +import CoinbasePro.Types (CreatedAt, UserId) + + +data TransferType = WithdrawTransferType | DepositTransferType + + +instance Show TransferType where + show WithdrawTransferType = "withdraw" + show DepositTransferType = "deposit" + + +instance ToHttpApiData TransferType where + toUrlPiece = pack . show + toQueryParam = pack . show + + +newtype UserNonce = UserNonce Int + deriving (Eq, Show, ToJSON, FromJSON) + + +data TransferDetails = TransferDetails + { tId :: Text + , tType :: Text + , tCreatedAt :: CreatedAt + , tCompletedAt :: UTCTime + , tCanceledAt :: Maybe UTCTime + , tProcessedAt :: Maybe UTCTime + , tAccountId :: AccountId + , tUserId :: UserId + , tUserNonce :: Maybe UserNonce + , tAmount :: Double + } deriving Show + + +instance FromJSON TransferDetails where + parseJSON = withObject "transfer" $ \o -> TransferDetails + <$> (o .: "id") + <*> (o .: "type") + <*> (o .: "created_at") + <*> (o .: "completed_at") + <*> (o .:? "canceled_at") + <*> (o .:? "processed_at") + <*> (o .: "account_id") + <*> (o .: "user_id") + <*> (o .:? "user_nonce") + <*> (read <$> o .: "amount") + + +data WithdrawalTransfer = WithdrawalTransfer + { wTransfer :: TransferDetails + , wDetails :: WithdrawalDetails + } deriving Show + + +instance FromJSON WithdrawalTransfer where + parseJSON = withObject "withdrawal transfer" $ \o -> WithdrawalTransfer + <$> parseJSON (Object o) + <*> o .: "details" + + +data DepositTransfer = DepositTransfer + { dTransfer :: TransferDetails + , dDetails :: DepositDetails + } deriving Show + + +instance FromJSON DepositTransfer where + parseJSON = withObject "deposit transfer" $ \o -> DepositTransfer + <$> parseJSON (Object o) + <*> o .: "details" + + +data Transfer = Withdrawal WithdrawalTransfer | Deposit DepositTransfer + deriving Show + + +instance FromJSON Transfer where + parseJSON = withObject "transfer" $ \o -> do + t <- String <$> o .: "type" + case t of + "withdraw" -> Withdrawal <$> parseJSON (Object o) + "deposit" -> Deposit <$> parseJSON (Object o) + _ -> fail "Unable to parse transfer" diff --git a/src/lib/CoinbasePro/Authenticated/Withdrawal.hs b/src/lib/CoinbasePro/Authenticated/Withdrawal.hs new file mode 100644 --- /dev/null +++ b/src/lib/CoinbasePro/Authenticated/Withdrawal.hs @@ -0,0 +1,121 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +module CoinbasePro.Authenticated.Withdrawal + ( WithdrawalDetails (..) + , WithdrawalRequest (..) + , WithdrawalResponse (..) + , CoinbaseWithdrawalRequest (..) + , CryptoWithdrawalRequest (..) + , CryptoWithdrawalResponse (..) + , WithdrawalFeeEstimateResponse (..) + ) where + +import Data.Aeson (FromJSON, parseJSON, + withObject, (.:), (.:?)) +import Data.Aeson.Casing (snakeCase) +import Data.Aeson.TH (defaultOptions, deriveJSON, + fieldLabelModifier) +import Data.Text (Text) +import Data.Time.Clock (UTCTime) +import Data.UUID (UUID) + +import CoinbasePro.Authenticated.Accounts (AccountId) +import CoinbasePro.Authenticated.Payment (PaymentMethodId) + + +data WithdrawalDetails = WithdrawalDetails + { destinationTag :: Maybe Text + , sentToAddress :: Maybe Text + , coinbaseAccountId :: Text + , destinationTagName :: Maybe Text + , coinbaseWithdrawalId :: Maybe Text + , coinbaseTransactionId :: Text + , cryptoPaymentMethodId :: Text + , fee :: Maybe Double + , subtotal :: Maybe Double + } deriving (Eq, Show) + + +instance FromJSON WithdrawalDetails where + parseJSON = withObject "withdrawal details" $ \o -> WithdrawalDetails + <$> o .:? "destination_tag" + <*> o .:? "sent_to_address" + <*> o .: "coinbase_account_id" + <*> o .:? "destination_tag_name" + <*> o .:? "coinbase_withdrawal_id" + <*> o .: "coinbase_transaction_id" + <*> o .: "coinbase_payment_method_id" + <*> (maybe Nothing read <$> o .:? "fee") + <*> (maybe Nothing read <$> o .:? "subtotal") + + +data WithdrawalRequest = WithdrawalRequest + { amount :: Double + , currency :: Text + , paymentMethodId :: PaymentMethodId + } deriving (Eq, Show) + + +deriveJSON defaultOptions { fieldLabelModifier = snakeCase } ''WithdrawalRequest + + +data WithdrawalResponse = WithdrawalResponse + { wId :: UUID + , wAmount :: Double + , wCurrency :: Text + , wPayoutAt :: UTCTime + } deriving (Eq, Show) + + +instance FromJSON WithdrawalResponse where + parseJSON = withObject "withdrawal response" $ \o -> WithdrawalResponse + <$> o .: "id" + <*> (read <$> o .: "amount") + <*> o .: "currency" + <*> o .: "payout_at" + + +data CoinbaseWithdrawalRequest = CoinbaseWithdrawalRequest + { cAmount :: Double + , cCurrency :: Text + , cCoinbaseAccountId :: AccountId + } deriving (Eq, Show) + + +deriveJSON defaultOptions { fieldLabelModifier = snakeCase . drop 1 } ''CoinbaseWithdrawalRequest + + +data CryptoWithdrawalRequest = CryptoWithdrawalRequest + { crAmount :: Double + , crCurrency :: Text + , crCryptoAddress :: Text + } deriving (Eq, Show) + + +deriveJSON defaultOptions { fieldLabelModifier = snakeCase . drop 2 } ''CryptoWithdrawalRequest + + +data CryptoWithdrawalResponse = CryptoWithdrawalResponse + { cwId :: UUID + , cwAmount :: Double + , cwCurrency :: Text + , cwFee :: Double + , cwSubtotal :: Double + } deriving (Eq, Show) + + +instance FromJSON CryptoWithdrawalResponse where + parseJSON = withObject "crypto withdrawal response" $ \o -> CryptoWithdrawalResponse + <$> o .: "id" + <*> (read <$> o .: "amount") + <*> o .: "currency" + <*> (read <$> o .: "fee") + <*> (read <$> o .: "subtotal") + + +newtype WithdrawalFeeEstimateResponse = WithdrawalFeeEstimateResponse + { wfFee :: Double} deriving (Eq, Show) + + +deriveJSON defaultOptions { fieldLabelModifier = snakeCase . drop 2 } ''WithdrawalFeeEstimateResponse diff --git a/src/lib/CoinbasePro/Environment.hs b/src/lib/CoinbasePro/Environment.hs --- a/src/lib/CoinbasePro/Environment.hs +++ b/src/lib/CoinbasePro/Environment.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE OverloadedStrings #-} + module CoinbasePro.Environment ( Environment (..) , WSConnection (..) @@ -7,23 +9,23 @@ ) where -import Network.Socket (HostName) -import Network.Socket.Internal (PortNumber) +import Data.Text (Text) +import Network.Socket (HostName, PortNumber) data Environment = Production | Sandbox -apiEndpoint :: Environment -> String +apiEndpoint :: Environment -> Text apiEndpoint Production = productionAPIEndpoint apiEndpoint Sandbox = sandboxAPIEndpoint -productionAPIEndpoint :: String +productionAPIEndpoint :: Text productionAPIEndpoint = "api.pro.coinbase.com" -sandboxAPIEndpoint :: String +sandboxAPIEndpoint :: Text sandboxAPIEndpoint = "api-public.sandbox.pro.coinbase.com" diff --git a/src/lib/CoinbasePro/Headers.hs b/src/lib/CoinbasePro/Headers.hs --- a/src/lib/CoinbasePro/Headers.hs +++ b/src/lib/CoinbasePro/Headers.hs @@ -24,7 +24,7 @@ userAgent :: UserAgent -userAgent = UserAgent "coinbase-pro/0.8" +userAgent = UserAgent "coinbase-pro/0.9" type UserAgentHeader = RequiredHeader "User-Agent" UserAgent diff --git a/src/lib/CoinbasePro/MarketData/Types.hs b/src/lib/CoinbasePro/MarketData/Types.hs --- a/src/lib/CoinbasePro/MarketData/Types.hs +++ b/src/lib/CoinbasePro/MarketData/Types.hs @@ -27,22 +27,25 @@ , baseMinSize :: Double , baseMaxSize :: Double , quoteIncrement :: Double + , minMarketFunds :: Double + , maxMarketFunds :: Double } deriving (Eq, Show) instance FromJSON Product where - parseJSON = withObject "product" $ \o -> do - prid <- o .: "id" - bc <- o .: "base_currency" - qc <- o .: "quote_currency" - bmins <- o .: "base_min_size" - bmaxs <- o .: "base_max_size" - qi <- o .: "quote_increment" - return $ Product prid bc qc (read bmins) (read bmaxs) (read qi) + parseJSON = withObject "product" $ \o -> Product + <$> o .: "id" + <*> o .: "base_currency" + <*> o .: "quote_currency" + <*> (read <$> o .: "base_min_size") + <*> (read <$> o .: "base_max_size") + <*> (read <$> o .: "quote_increment") + <*> (read <$> o .: "min_market_funds") + <*> (read <$> o .: "max_market_funds") instance ToHttpApiData Product where - toUrlPiece = toUrlPiece . productId + toUrlPiece = toUrlPiece . productId toQueryParam = toQueryParam . productId diff --git a/src/lib/CoinbasePro/Request.hs b/src/lib/CoinbasePro/Request.hs --- a/src/lib/CoinbasePro/Request.hs +++ b/src/lib/CoinbasePro/Request.hs @@ -1,7 +1,9 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} + module CoinbasePro.Request ( RequestPath , Body @@ -14,13 +16,17 @@ , runWithManager , Runner + + , emptyBody ) where import Control.Exception (throw) import Control.Monad (void) +import Data.ByteString (ByteString) +import Data.Text (unpack) import Network.HTTP.Client (Manager, newManager) import Network.HTTP.Client.TLS (tlsManagerSettings) -import Servant.API ((:>), Get, JSON) +import Servant.API (Get, JSON, (:>)) import Servant.Client import CoinbasePro.Environment (Environment, apiEndpoint) @@ -32,9 +38,11 @@ type CBRequest a = UserAgent -> ClientM a +-- ^ Serialized as a part of building CBAccessSign +type RequestPath = ByteString -type RequestPath = String -type Body = String +-- ^ Serialized as a part of building CBAccessSign +type Body = ByteString type Runner a = ClientM a -> IO a @@ -72,4 +80,8 @@ runWithManager mgr env f = either throw return =<< runClientM f (mkClientEnv mgr (BaseUrl Https api 443 mempty)) where - api = apiEndpoint env + api = unpack $ apiEndpoint env + + +emptyBody :: ByteString +emptyBody = "" diff --git a/src/lib/CoinbasePro/Types.hs b/src/lib/CoinbasePro/Types.hs --- a/src/lib/CoinbasePro/Types.hs +++ b/src/lib/CoinbasePro/Types.hs @@ -21,14 +21,16 @@ , Candle (..) , CandleGranularity (..) , TwentyFourHourStats (..) + , CurrencyType (..) , Currency (..) + , CryptoAddress (..) , filterOrderFieldName ) where -import Data.Aeson (FromJSON, ToJSON, parseJSON, toJSON, - withArray, withObject, withText, (.:), - (.:?)) +import Data.Aeson (FromJSON, FromJSONKey, ToJSON, + ToJSONKey, parseJSON, toJSON, withArray, + withObject, withText, (.:), (.:?)) import qualified Data.Aeson as A import Data.Aeson.Casing (camelCase, snakeCase) import Data.Aeson.TH (constructorTagModifier, defaultOptions, @@ -37,7 +39,7 @@ import Data.Text (Text, pack, toLower, unpack) import Data.Time.Clock (UTCTime) import Data.Time.Clock.POSIX (posixSecondsToUTCTime) -import Data.UUID (UUID, toText) +import Data.UUID (UUID, toString, toText) import qualified Data.Vector as V import Servant.API import Text.Printf (printf) @@ -64,9 +66,13 @@ newtype OrderId = OrderId { unOrderId :: Text } - deriving (Eq, Ord, Show, ToHttpApiData) + deriving (Eq, Ord, ToHttpApiData) +instance Show OrderId where + show (OrderId t) = unpack t + + deriveJSON defaultOptions { fieldLabelModifier = snakeCase , unwrapUnaryRecords = True @@ -74,9 +80,13 @@ newtype ClientOrderId = ClientOrderId { unClientOrderId :: UUID } - deriving (Eq, Ord, Show) + deriving (Eq, Ord) +instance Show ClientOrderId where + show (ClientOrderId t) = toString t + + instance ToHttpApiData ClientOrderId where toUrlPiece = ("client:" <>) . toText . unClientOrderId @@ -87,9 +97,13 @@ newtype ProductId = ProductId { unProductId :: Text } - deriving (Eq, Ord, Show, ToHttpApiData) + deriving (Eq, Ord, ToHttpApiData, ToJSONKey, FromJSONKey) +instance Show ProductId where + show (ProductId t) = unpack t + + deriveJSON defaultOptions { fieldLabelModifier = snakeCase , unwrapUnaryRecords = True @@ -97,24 +111,32 @@ newtype Price = Price { unPrice :: Double } - deriving (Eq, Ord, Show, ToHttpApiData) + deriving (Eq, Ord, ToHttpApiData) +instance Show Price where + show (Price d) = printf "%.8f" d + + instance FromJSON Price where parseJSON = withText "price" $ \t -> return . Price . read $ unpack t instance ToJSON Price where - toJSON (Price p) = A.String . pack $ printf "%.8f" p + toJSON = A.String . pack . show newtype Size = Size { unSize :: Double } - deriving (Eq, Ord, Show, ToHttpApiData) + deriving (Eq, Ord, ToHttpApiData) +instance Show Size where + show (Size d) = printf "%.8f" d + + instance ToJSON Size where - toJSON (Size s) = A.String . pack $ printf "%.8f" s + toJSON = A.String . pack . show instance FromJSON Size where @@ -123,16 +145,20 @@ newtype Volume = Volume { unVolume :: Double } - deriving (Eq, Ord, Show) + deriving (Eq, Ord) +instance Show Volume where + show (Volume d) = printf "%.8f" d + + instance FromJSON Volume where parseJSON = withText "volume" $ \t -> return . Volume . read $ unpack t instance ToJSON Volume where - toJSON (Volume v) = A.String . pack $ printf "%.8f" v + toJSON = A.String . pack . show newtype TradeId = TradeId Int @@ -142,16 +168,20 @@ deriveJSON defaultOptions { fieldLabelModifier = snakeCase } ''TradeId -newtype Funds = Funds { unFunds :: Double } - deriving (Eq, Ord, Show, ToHttpApiData) +newtype Funds = Funds Double + deriving (Eq, Ord, ToHttpApiData) +instance Show Funds where + show (Funds d) = printf "%.16f" d + + instance ToJSON Funds where - toJSON (Funds s) = A.String . pack $ printf "%.16f" s + toJSON = A.String . pack . show instance FromJSON Funds where - parseJSON = withText "size" $ \t -> + parseJSON = withText "funds" $ \t -> return . Funds . read $ unpack t @@ -243,6 +273,7 @@ , pushPaymentMethods :: [Text] , groupTypes :: Maybe [Text] , maxPrecision :: Maybe Double + , maxWithdrawalAmount :: Maybe Double } deriving (Eq, Show) @@ -256,8 +287,17 @@ <*> o .: "push_payment_methods" <*> o .:? "group_types" <*> o .:? "max_precision" + <*> o .:? "max_withdrawal_amount" +newtype CurrencyType = CurrencyType Text + deriving ToHttpApiData + + +instance Show CurrencyType where + show (CurrencyType c) = unpack c + + data Currency = Currency { id :: Text , name :: Text @@ -276,3 +316,11 @@ <*> o .: "status" <*> o .:? "message" <*> o .: "details" + + +newtype CryptoAddress = CryptoAddress Text + deriving ToHttpApiData + + +instance Show CryptoAddress where + show (CryptoAddress ca) = unpack ca diff --git a/src/lib/CoinbasePro/Unauthenticated.hs b/src/lib/CoinbasePro/Unauthenticated.hs --- a/src/lib/CoinbasePro/Unauthenticated.hs +++ b/src/lib/CoinbasePro/Unauthenticated.hs @@ -59,7 +59,7 @@ stats prid = API.stats prid userAgent --- | https://docs.pro.coinbase.com/?javascript#get-currencies +-- | https://docs.pro.coinbase.com/#get-currencies currencies :: ClientM [Currency] currencies = API.currencies userAgent diff --git a/src/lib/CoinbasePro/WebSocketFeed.hs b/src/lib/CoinbasePro/WebSocketFeed.hs --- a/src/lib/CoinbasePro/WebSocketFeed.hs +++ b/src/lib/CoinbasePro/WebSocketFeed.hs @@ -1,13 +1,14 @@ +{-# LANGUAGE OverloadedStrings #-} + module CoinbasePro.WebSocketFeed ( subscribeToFeed ) where import Control.Concurrent (forkIO) +import Control.Exception (Exception, throwIO) import Control.Monad (forever) import Control.Monad.IO.Class (liftIO) -import Data.Aeson (eitherDecode', encode) -import Data.Either (either) -import Data.Maybe (maybe) +import Data.Aeson (decode', encode) import Network.HTTP.Types (methodGet) import qualified Network.WebSockets as WS import qualified System.IO.Streams as Streams @@ -20,6 +21,7 @@ import CoinbasePro.Environment (Environment, WSConnection (..), wsEndpoint) +import CoinbasePro.Request (emptyBody) import CoinbasePro.Types (ProductId) import CoinbasePro.WebSocketFeed.Channel (ChannelMessage (..)) import CoinbasePro.WebSocketFeed.Request (AuthenticatedWebSocketFeedRequest (..), @@ -28,6 +30,10 @@ WebSocketFeedRequest (..)) +data ParseException = ParseException deriving Show +instance Exception ParseException + + subscribeToFeed :: [ProductId] -> [ChannelName] -> Environment -> Maybe CoinbaseProCredentials -> IO (Streams.InputStream ChannelMessage) subscribeToFeed prds channels env = subscribe (wsEndpoint env) prds channels @@ -52,11 +58,12 @@ authWsRequest cpc' = do ts <- liftIO mkCBAccessTimeStamp - let cbs = mkCBAccessSign (cbSecretKey cpc') ts methodGet authSubscriptionPath "" + let cbs = mkCBAccessSign (cbSecretKey cpc') ts methodGet authSubscriptionPath emptyBody return $ AuthenticatedWebSocketFeedRequest wsRequest cbs (cbAccessKey cpc') (cbAccessPassphrase cpc') ts authSubscriptionPath = "/users/self/verify" parseFeed :: WS.Connection -> IO ChannelMessage -parseFeed conn = either fail return =<< (eitherDecode' <$> WS.receiveData conn :: IO (Either String ChannelMessage)) +parseFeed conn = maybe err return =<< (decode' <$> WS.receiveData conn) + where err = throwIO ParseException diff --git a/src/lib/CoinbasePro/WebSocketFeed/Channel/Full/Activate.hs b/src/lib/CoinbasePro/WebSocketFeed/Channel/Full/Activate.hs --- a/src/lib/CoinbasePro/WebSocketFeed/Channel/Full/Activate.hs +++ b/src/lib/CoinbasePro/WebSocketFeed/Channel/Full/Activate.hs @@ -16,22 +16,20 @@ type StopType = Text -type TakerFeeRate = Double data Activate = Activate - { productId :: ProductId - , timestamp :: UTCTime - , orderId :: OrderId - , stopType :: StopType - , side :: Side - , stopPrice :: Price - , size :: Size - , funds :: Funds - , takerFeeRate :: TakerFeeRate - , private :: Bool - , userId :: UserId - , profileId :: ProfileId + { productId :: ProductId + , timestamp :: UTCTime + , orderId :: OrderId + , stopType :: StopType + , side :: Side + , stopPrice :: Price + , size :: Size + , funds :: Funds + , private :: Bool + , userId :: UserId + , profileId :: ProfileId } deriving (Eq, Ord, Show)