diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,6 +1,6 @@ The MIT License (MIT) -Copyright (c) 2018 Michael Dunn +Copyright (c) 2021 Michael Dunn Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -37,10 +37,9 @@ - [x] Payment Method - [x] Coinbase - [x] Generate a Crypto Deposit Address - - [ ] Withdrawals + - [x] Withdrawals - [x] List Withdrawals - [x] Single Withdrawal - - [ ] Canceled Withdrawal - [x] Payment Method - [x] Coinbase - [x] Crypto @@ -53,16 +52,16 @@ - [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] Reports + - [x] Create a new report + - [x] Get report status + - [x] Profiles + - [x] List Profiles + - [x] Get a Profile + - [x] Create a Profile Transfer - [x] User Account - [x] Trailing Volume - - [ ] Margin + - ~~[ ] Margin~~ (Disabled)[https://blog.coinbase.com/coinbase-pro-disables-margin-trading-42f5862f8a66] - [ ] Oracle - [ ] Get Oracle - Websocket Feed diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,13 @@ +# Version 0.9.1.0 + +- Minor refactors + linting. + +## Additional Features + +- Added support for the following endpoints: + - `Profiles` + - `Reports` + # Version 0.9.0.0 - Upgraded to lts-17.4 (ghc 8.10.4) diff --git a/coinbase-pro.cabal b/coinbase-pro.cabal --- a/coinbase-pro.cabal +++ b/coinbase-pro.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 6d5d68b6e7e2760dac46a876ebbca9195bb32e0cb846b290d8db552d28a24647 +-- hash: 99c50583d7d248741138631c4b28753ea1333f29565c1567516c183489a6d05d name: coinbase-pro -version: 0.9.0.0 +version: 0.9.1.0 synopsis: Client for Coinbase Pro description: Client for Coinbase Pro REST and Websocket APIs category: Web, Finance @@ -39,6 +39,8 @@ CoinbasePro.Authenticated.Limits CoinbasePro.Authenticated.Orders CoinbasePro.Authenticated.Payment + CoinbasePro.Authenticated.Profile + CoinbasePro.Authenticated.Report CoinbasePro.Authenticated.Request CoinbasePro.Authenticated.Transfer CoinbasePro.Authenticated.Withdrawal 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 @@ -3,11 +3,16 @@ module Main where import Control.Monad.IO.Class (liftIO) +import Data.Maybe (fromJust) +import Data.Time (defaultTimeLocale, + parseTimeOrError) +import Data.UUID (fromText) import CoinbasePro.Authenticated import CoinbasePro.Authenticated.Accounts import CoinbasePro.Authenticated.Headers import CoinbasePro.Authenticated.Orders +import CoinbasePro.Authenticated.Report import CoinbasePro.Authenticated.Request import CoinbasePro.Environment import CoinbasePro.MarketData.Types hiding (time) @@ -18,27 +23,38 @@ main :: IO () main = 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 + -- 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 - placeOrder Nothing btcusd Buy (Size 1.0) (Price 1.00) True Nothing Nothing Nothing >>= liftIO . print - cancelAll (Just btcusd) >>= liftIO . print + -- resp <- createReport fillReportReq + getReport rid >>= liftIO . print + -- profiles Nothing >>= liftIO . print + -- profile "94fa1f9e-131f-4295-b0d5-695b8a92c382" >>= liftIO . print + -- 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 + -- placeOrder Nothing btcusd Buy (Size 1.0) (Price 1.00) True Nothing Nothing Nothing >>= liftIO . print + -- cancelAll (Just btcusd) >>= liftIO . print where - accessKey = CBAccessKey "accesskey" - secretKey = CBSecretKey "secretkey" - passphrase = CBAccessPassphrase "passphrase" + accessKey = CBAccessKey "6e5972897a617f9c7807190c72019f2e" + secretKey = CBSecretKey "1MJfkRmYd+AgSo6SeGlKD1XZS7AkTikEagz0EKKn6hNHzY9Ff7+H2cc76E0vbzo+0yvwCNCBsIedi0QXwRSdGw==" + passphrase = CBAccessPassphrase "83f2vnptwln" cpc = CoinbaseProCredentials accessKey secretKey passphrase - aid = AccountId "accountid" + aid = AccountId "74598a56-abef-4ffe-8d98-dd3c878d718d" btcusd = ProductId "BTC-USD" + + startDate = parseTimeOrError False defaultTimeLocale "%Y-%m-%d" "2020-01-01" + endDate = parseTimeOrError False defaultTimeLocale "%Y-%m-%d" "2021-01-01" + actReportReq = accountsReportRequest aid Nothing startDate endDate Nothing Nothing + fillReportReq = fillsReportRequest btcusd Nothing startDate endDate Nothing Nothing + + rid = ReportId $ fromJust $ fromText "5b99f31a-7bcb-43f4-b8b3-7e1299e67a3e" 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,7 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} module CoinbasePro.Authenticated ( accounts @@ -30,11 +29,16 @@ , withdrawalFeeEstimate , paymentMethods , coinbaseAccounts + , profiles + , profile + , profileTransfer + , createReport + , getReport ) where import Control.Monad (void) -import Data.Aeson (encode) -import qualified Data.ByteString.Builder as BB +import Data.Aeson (ToJSON, encode) +import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy.Char8 as LC8 import Data.Maybe (fromMaybe) import qualified Data.Set as S @@ -44,7 +48,6 @@ import Data.UUID (toText) import Network.HTTP.Types (SimpleQuery, SimpleQueryItem, - encodePathSegments, methodDelete, methodGet, methodPost, @@ -73,18 +76,24 @@ statuses) import CoinbasePro.Authenticated.Payment (PaymentMethod, PaymentMethodId (..)) +import CoinbasePro.Authenticated.Profile (Profile, + ProfileTransfer (..)) +import CoinbasePro.Authenticated.Report (ReportId (..), + ReportRequest (..), + ReportResponse) 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.Request (emptyBody, + encodeRequestPath) import CoinbasePro.Types (ClientOrderId (..), @@ -96,6 +105,7 @@ ProfileId, Side, Size) + accountsPath :: Text accountsPath = "accounts" @@ -104,10 +114,38 @@ ordersPath = "orders" -encodeRequestPath :: [Text] -> RequestPath -encodeRequestPath = LC8.toStrict . BB.toLazyByteString . encodePathSegments +depositsPath :: Text +depositsPath = "deposits" +withdrawalsPath :: Text +withdrawalsPath = "withdrawals" + + +coinbaseAccountPath :: Text +coinbaseAccountPath = "coinbase-account" + + +profilesPath :: Text +profilesPath = "profiles" + + +transferPath :: Text +transferPath = "transfer" + + +usersPath :: Text +usersPath = "users" + + +selfPath :: Text +selfPath = "self" + + +reportsPath :: Text +reportsPath = "reports" + + mkSimpleQueryItem :: Show a => Text -> a -> SimpleQueryItem mkSimpleQueryItem s a = (encodeUtf8 s, encodeUtf8 $ pack (show a)) @@ -124,6 +162,10 @@ mkOrderIdQuery = optionalQuery "order_id" +encodeBody :: (ToJSON b) => b -> ByteString +encodeBody = LC8.toStrict . encode + + -- | https://docs.pro.coinbase.com/#accounts accounts :: CBAuthT ClientM [Account] accounts = authRequest methodGet requestPath emptyBody API.accounts @@ -198,11 +240,10 @@ -> Maybe TimeInForce -> CBAuthT ClientM Order placeOrder clordid prid sd sz price po ot stp tif = - authRequest methodPost requestPath seBody $ API.placeOrder body + authRequest methodPost requestPath (encodeBody body) $ API.placeOrder body where requestPath = encodeRequestPath [ordersPath] body = PlaceOrderBody clordid prid sd sz price po ot stp tif - seBody = LC8.toStrict $ encode body -- | https://docs.pro.coinbase.com/#cancel-an-order @@ -244,14 +285,14 @@ trailingVolume :: CBAuthT ClientM [TrailingVolume] trailingVolume = authRequest methodGet requestPath emptyBody API.trailingVolume where - requestPath = encodeRequestPath ["users", "self", "trailing-volume"] + requestPath = encodeRequestPath [usersPath, selfPath, "trailing-volume"] -- | 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"] + requestPath = encodeRequestPath [usersPath, selfPath, "exchange-limits"] -- | https://docs.pro.coinbase.com/#list-deposits @@ -288,7 +329,7 @@ lmQ = optionalQuery "limit" lm query = renderQuery True . simpleQueryToQuery $ typeQ <> profQ <> beforeQ <> afterQ <> lmQ - requestPath = encodeRequestPath ["transfers"] <> query + requestPath = encodeRequestPath [transferPath <> "s"] <> query -- | https://docs.pro.coinbase.com/#single-deposit @@ -296,7 +337,7 @@ transfer :: PaymentMethodId -> CBAuthT ClientM Transfer transfer pmt@(PaymentMethodId p) = authRequest methodGet requestPath emptyBody $ API.transfer pmt where - requestPath = encodeRequestPath ["transfers", p] + requestPath = encodeRequestPath [transferPath <> "s", p] -- | https://docs.pro.coinbase.com/#payment-method @@ -305,11 +346,10 @@ -> PaymentMethodId -> CBAuthT ClientM DepositResponse makeDeposit amt cur pmi = - authRequest methodPost requestPath seBody $ API.makeDeposit body + authRequest methodPost requestPath (encodeBody body) $ API.makeDeposit body where - requestPath = encodeRequestPath ["deposits", "payment-method"] + requestPath = encodeRequestPath [depositsPath, "payment-method"] body = DepositRequest amt cur pmi - seBody = LC8.toStrict $ encode body -- | https://docs.pro.coinbase.com/#coinbase @@ -318,11 +358,10 @@ -> AccountId -> CBAuthT ClientM DepositResponse makeCoinbaseDeposit amt cur act = - authRequest methodPost requestPath seBody $ API.makeCoinbaseDeposit body + authRequest methodPost requestPath (encodeBody body) $ API.makeCoinbaseDeposit body where - requestPath = encodeRequestPath ["deposits", "coinbase-account"] + requestPath = encodeRequestPath [depositsPath, coinbaseAccountPath] body = CoinbaseDepositRequest amt cur act - seBody = LC8.toStrict $ encode body -- | https://docs.pro.coinbase.com/#generate-a-crypto-deposit-address @@ -330,7 +369,7 @@ cryptoDepositAddress act = authRequest methodPost requestPath emptyBody $ API.cryptoDepositAddress act where - requestPath = encodeRequestPath ["coinbase-accounts", pack $ show act, "addresses"] + requestPath = encodeRequestPath [coinbaseAccountPath <> "s", pack $ show act, "addresses"] -- | https://docs.pro.coinbase.com/#payment-method55 @@ -339,11 +378,10 @@ -> PaymentMethodId -> CBAuthT ClientM WithdrawalResponse makeWithdrawal amt cur pmi = - authRequest methodPost requestPath seBody $ API.makeWithdrawal body + authRequest methodPost requestPath (encodeBody body) $ API.makeWithdrawal body where - requestPath = encodeRequestPath ["withdrawals", "payment-method"] + requestPath = encodeRequestPath [withdrawalsPath, "payment-method"] body = WithdrawalRequest amt cur pmi - seBody = LC8.toStrict $ encode body -- | https://docs.pro.coinbase.com/#coinbase56 @@ -352,11 +390,10 @@ -> AccountId -> CBAuthT ClientM WithdrawalResponse makeCoinbaseWithdrawal amt cur act = - authRequest methodPost requestPath seBody $ API.makeCoinbaseWithdrawal body + authRequest methodPost requestPath (encodeBody body) $ API.makeCoinbaseWithdrawal body where - requestPath = encodeRequestPath ["withdrawals", "coinbase-account"] + requestPath = encodeRequestPath [withdrawalsPath, coinbaseAccountPath] body = CoinbaseWithdrawalRequest amt cur act - seBody = LC8.toStrict $ encode body -- | https://docs.pro.coinbase.com/#crypto @@ -365,11 +402,10 @@ -> Text -> CBAuthT ClientM CryptoWithdrawalResponse makeCryptoWithdrawal amt cur addr = - authRequest methodPost requestPath seBody $ API.makeCryptoWithdrawal body + authRequest methodPost requestPath (encodeBody body) $ API.makeCryptoWithdrawal body where - requestPath = encodeRequestPath ["withdrawals", "crypto"] + requestPath = encodeRequestPath [withdrawalsPath, "crypto"] body = CryptoWithdrawalRequest amt cur addr - seBody = LC8.toStrict $ encode body -- | https://docs.pro.coinbase.com/#fee-estimate @@ -383,7 +419,7 @@ addrQ = return $ mkSimpleQueryItem "crypto_address" addr query = renderQuery True . simpleQueryToQuery $ curQ <> addrQ - requestPath = encodeRequestPath ["withdrawals", "fee-estimate"] <> query + requestPath = encodeRequestPath [withdrawalsPath, "fee-estimate"] <> query -- | https://docs.pro.coinbase.com/#list-payment-methods @@ -397,4 +433,47 @@ coinbaseAccounts :: CBAuthT ClientM [CoinbaseAccount] coinbaseAccounts = authRequest methodGet requestPath emptyBody API.coinbaseAccounts where - requestPath = encodeRequestPath ["coinbase-accounts"] + requestPath = encodeRequestPath [coinbaseAccountPath <> "s"] + + +-- | https://docs.pro.coinbase.com/#list-profiles +profiles :: Maybe Bool -> CBAuthT ClientM [Profile] +profiles active = authRequest methodGet requestPath emptyBody $ API.profiles active + where + activeQ = optionalQuery "active" active + + query = renderQuery True . simpleQueryToQuery $ activeQ + requestPath = encodeRequestPath [profilesPath] <> query + + +-- | https://docs.pro.coinbase.com/#get-a-profile +profile :: ProfileId -> CBAuthT ClientM Profile +profile profId = authRequest methodGet requestPath emptyBody $ API.profile profId + where + requestPath = encodeRequestPath [profilesPath, profId] + + +-- | https://docs.pro.coinbase.com/#create-profile-transfer +profileTransfer :: ProfileId + -> ProfileId + -> CurrencyType + -> String + -> CBAuthT ClientM () +profileTransfer fromProf toProf cur amt = void . authRequest methodPost requestPath (encodeBody body) $ API.profileTransfer body + where + requestPath = encodeRequestPath [profilesPath, transferPath] + body = ProfileTransfer fromProf toProf cur amt + + +-- | https://docs.pro.coinbase.com/#create-a-new-report +createReport :: ReportRequest -> CBAuthT ClientM ReportResponse +createReport req = authRequest methodPost requestPath (encodeBody req) $ API.createReport req + where + requestPath = encodeRequestPath [reportsPath] + + +-- | https://docs.pro.coinbase.com/#get-report-status +getReport :: ReportId -> CBAuthT ClientM ReportResponse +getReport rid = authRequest methodGet requestPath emptyBody $ API.getReport rid + where + requestPath = encodeRequestPath [reportsPath, toText $ unReportId rid] 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 @@ -28,6 +28,11 @@ , withdrawalFeeEstimate , paymentMethods , coinbaseAccounts + , profiles + , profile + , profileTransfer + , createReport + , getReport ) where import Data.Proxy (Proxy (..)) @@ -60,6 +65,11 @@ Status (..)) import CoinbasePro.Authenticated.Payment (PaymentMethod (..), PaymentMethodId) +import CoinbasePro.Authenticated.Profile (Profile, + ProfileTransfer) +import CoinbasePro.Authenticated.Report (ReportId, + ReportRequest (..), + ReportResponse (..)) import CoinbasePro.Authenticated.Request (AuthDelete, AuthGet, AuthPost) import CoinbasePro.Authenticated.Transfer (Transfer, @@ -112,6 +122,11 @@ :> AuthGet WithdrawalFeeEstimateResponse :<|> "payment-methods" :> AuthGet [PaymentMethod] :<|> "coinbase-accounts" :> AuthGet [CoinbaseAccount] + :<|> "profiles" :> QueryParam "active" Bool :> AuthGet [Profile] + :<|> "profiles" :> Capture "profile_id" ProfileId :> AuthGet Profile + :<|> "profiles" :> "transfer" :> ReqBody '[JSON] ProfileTransfer :> AuthPost NoContent + :<|> "reports" :> ReqBody '[JSON] ReportRequest :> AuthPost ReportResponse + :<|> "reports" :> Capture "report_id" ReportId :> AuthGet ReportResponse api :: Proxy API @@ -143,8 +158,14 @@ withdrawalFeeEstimate :: CurrencyType -> CryptoAddress -> AuthenticatedRequest (AuthProtect "CBAuth") -> ClientM WithdrawalFeeEstimateResponse paymentMethods :: AuthenticatedRequest (AuthProtect "CBAuth") -> ClientM [PaymentMethod] coinbaseAccounts :: AuthenticatedRequest (AuthProtect "CBAuth") -> ClientM [CoinbaseAccount] +profiles :: Maybe Bool -> AuthenticatedRequest (AuthProtect "CBAuth") -> ClientM [Profile] +profile :: ProfileId -> AuthenticatedRequest (AuthProtect "CBAuth") -> ClientM Profile +profileTransfer :: ProfileTransfer -> AuthenticatedRequest (AuthProtect "CBAuth") -> ClientM NoContent +createReport :: ReportRequest -> AuthenticatedRequest (AuthProtect "CBAuth") -> ClientM ReportResponse +getReport :: ReportId -> AuthenticatedRequest (AuthProtect "CBAuth") -> ClientM ReportResponse 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 + :<|> makeCryptoWithdrawal :<|> withdrawalFeeEstimate :<|> paymentMethods :<|> coinbaseAccounts :<|> profiles :<|> profile + :<|> profileTransfer :<|> createReport :<|> getReport = client api diff --git a/src/lib/CoinbasePro/Authenticated/Fills.hs b/src/lib/CoinbasePro/Authenticated/Fills.hs --- a/src/lib/CoinbasePro/Authenticated/Fills.hs +++ b/src/lib/CoinbasePro/Authenticated/Fills.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} module CoinbasePro.Authenticated.Fills @@ -17,8 +18,8 @@ instance FromJSON Liquidity where - parseJSON = withText "liquidity" $ \t -> - case t of + parseJSON = withText "liquidity" $ + \case "M" -> return Maker "T" -> return Taker _ -> fail "parse error" diff --git a/src/lib/CoinbasePro/Authenticated/Profile.hs b/src/lib/CoinbasePro/Authenticated/Profile.hs new file mode 100644 --- /dev/null +++ b/src/lib/CoinbasePro/Authenticated/Profile.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE TemplateHaskell #-} + +module CoinbasePro.Authenticated.Profile + ( Profile (..) + , ProfileTransfer (..) + ) where + +import Data.Aeson.Casing (snakeCase) +import Data.Aeson.TH (defaultOptions, deriveJSON, + fieldLabelModifier) +import Data.Text (Text) + +import CoinbasePro.Types (CreatedAt, CurrencyType, ProfileId, UserId) + +data Profile = Profile + { pId :: ProfileId + , pUserId :: UserId + , pName :: Text + , pActive :: Bool + , pIsDefault :: Bool + , pCreatedAt :: CreatedAt + } deriving Show + + +deriveJSON defaultOptions { fieldLabelModifier = snakeCase . drop 1 } ''Profile + + +data ProfileTransfer = ProfileTransfer + { from :: ProfileId + , to :: ProfileId + , currency :: CurrencyType + , amount :: String + } deriving Show + + +deriveJSON defaultOptions { fieldLabelModifier = snakeCase } ''ProfileTransfer diff --git a/src/lib/CoinbasePro/Authenticated/Report.hs b/src/lib/CoinbasePro/Authenticated/Report.hs new file mode 100644 --- /dev/null +++ b/src/lib/CoinbasePro/Authenticated/Report.hs @@ -0,0 +1,195 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +module CoinbasePro.Authenticated.Report + ( ReportId (..) + , ReportRequest (..) + , ReportResponse (..) + + , FillsReportRequest + , AccountsReportRequest + + , accountsReportRequest + , fillsReportRequest + ) where + +import Data.Aeson (ToJSON (..), object, (.=)) +import Data.Aeson.Casing (snakeCase) +import Data.Aeson.TH (constructorTagModifier, + defaultOptions, deriveJSON, + fieldLabelModifier, + unwrapUnaryRecords) +import qualified Data.Char as Char +import Data.Text (Text) +import Data.Time.Clock (UTCTime) +import Data.UUID (UUID) +import Servant.API (ToHttpApiData) + +import CoinbasePro.Authenticated.Accounts (AccountId) +import CoinbasePro.Types (CreatedAt, ProductId) + + +newtype ReportId = ReportId { unReportId:: UUID } + deriving (Eq, Show, ToHttpApiData) + + +deriveJSON defaultOptions + { fieldLabelModifier = snakeCase + , unwrapUnaryRecords = True + } ''ReportId + + +data ReportFormat = PDF | CSV + deriving Show + + +deriveJSON defaultOptions { constructorTagModifier = fmap Char.toLower } ''ReportFormat + + +newtype Email = Email Text + deriving Show + + +deriveJSON defaultOptions { fieldLabelModifier = snakeCase } ''Email + + +data Request = Request + { rStartDate :: UTCTime + , rEndDate :: UTCTime + , rFormat :: Maybe ReportFormat + , rEmail :: Maybe Email + } deriving Show + + +data FillsReportRequest = FillsReportRequest + { frProductId :: ProductId + , frAccountId :: Maybe AccountId + , frRequest :: Request + } deriving Show + + +data AccountsReportRequest = AccountsReportRequest + { arAccountId :: AccountId + , arProductId :: Maybe ProductId + , arRequest :: Request + } deriving Show + + +data ReportRequest = Fills FillsReportRequest | Accounts AccountsReportRequest + deriving Show + + +accountsReportRequest :: AccountId + -> Maybe ProductId + -- ^ start date + -> UTCTime + -- ^ end date + -> UTCTime + -- ^ pdf or csv + -> Maybe ReportFormat + -> Maybe Email + -> ReportRequest +accountsReportRequest aid prid start end format = + Accounts . AccountsReportRequest aid prid . Request start end format + + +fillsReportRequest :: ProductId + -> Maybe AccountId + -- ^ start date + -> UTCTime + -- ^ end date + -> UTCTime + -- ^ pdf or csv + -> Maybe ReportFormat + -> Maybe Email + -> ReportRequest +fillsReportRequest prid aid start end format = + Fills . FillsReportRequest prid aid . Request start end format + + +instance ToJSON ReportRequest where + toJSON (Fills frr) = + object ([ "type" .= ("fills" :: Text) + , "start_date" .= rStartDate (frRequest frr) + , "end_date" .= rEndDate (frRequest frr) + , "product_id" .= frProductId frr + ] <> maybe mempty (\aid -> ["account_id" .= aid]) (frAccountId frr) + <> maybe mempty (\em -> ["email" .= em]) (rEmail (frRequest frr)) + <> maybe mempty (\fmt -> ["format" .= fmt]) (rFormat (frRequest frr)) + ) + toJSON (Accounts arr) = + object ([ "type" .= ("account" :: Text) + , "start_date" .= rStartDate (arRequest arr) + , "end_date" .= rEndDate (arRequest arr) + , "account_id" .= arAccountId arr + ] <> maybe mempty (\prid -> ["product_id" .= prid]) (arProductId arr) + <> maybe mempty (\em -> ["email" .= em]) (rEmail (arRequest arr)) + <> maybe mempty (\fmt -> ["format" .= fmt]) (rFormat (arRequest arr)) + ) + + +data ReportRequestType = FillsType | AccountType + + +instance Show ReportRequestType where + show FillsType = "fills" + show AccountType = "account" + + +deriveJSON defaultOptions { constructorTagModifier = snakeCase . init . init . init . init } ''ReportRequestType + + +data ReportStatus = Pending | Creating | Ready + + +instance Show ReportStatus where + show Pending = "pending" + show Creating = "creating" + show Ready = "ready" + + +deriveJSON defaultOptions { constructorTagModifier = fmap Char.toLower + , fieldLabelModifier = snakeCase + } ''ReportStatus + + +data ReportParams = ReportParams + { startDate :: UTCTime + , endDate :: UTCTime + } deriving Show + + +deriveJSON defaultOptions { fieldLabelModifier = snakeCase } ''ReportParams + + +{-| + Example JSON Response: + { + "id": "0428b97b-bec1-429e-a94c-59232926778d", + "type": "fills", + "status": "pending", + "created_at": "2015-01-06T10:34:47.000Z", + "completed_at": undefined, + "expires_at": "2015-01-13T10:35:47.000Z", + "file_url": undefined, + "params": { + "start_date": "2014-11-01T00:00:00.000Z", + "end_date": "2014-11-30T23:59:59.000Z" + } + } +-} +data ReportResponse = ReportResponse + { rrId :: ReportId + , rrType :: ReportRequestType + , rrStatus :: ReportStatus + , rrCreatedAt :: Maybe CreatedAt + , rrCompletedAt :: Maybe UTCTime + , rrExpiresAt :: Maybe UTCTime + , rrFileUrl :: Maybe Text + , rrParams :: Maybe ReportParams + } deriving Show + + +deriveJSON defaultOptions { fieldLabelModifier = snakeCase . drop 2 } ''ReportResponse 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 @@ -1,7 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeOperators #-} module CoinbasePro.Headers ( RequiredHeader 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 @@ -18,19 +18,23 @@ , Runner , emptyBody + , encodeRequestPath ) 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 Control.Exception (throw) +import Control.Monad (void) +import Data.ByteString (ByteString) +import qualified Data.ByteString.Builder as BB +import qualified Data.ByteString.Lazy.Char8 as LC8 +import Data.Text (Text, unpack) +import Network.HTTP.Client (Manager, newManager) +import Network.HTTP.Client.TLS (tlsManagerSettings) +import Network.HTTP.Types (encodePathSegments) +import Servant.API (Get, JSON, (:>)) import Servant.Client -import CoinbasePro.Environment (Environment, apiEndpoint) -import CoinbasePro.Headers (UserAgent, UserAgentHeader) +import CoinbasePro.Environment (Environment, apiEndpoint) +import CoinbasePro.Headers (UserAgent, UserAgentHeader) type CBGet a = UserAgentHeader :> Get '[JSON] a @@ -85,3 +89,7 @@ emptyBody :: ByteString emptyBody = "" + + +encodeRequestPath :: [Text] -> RequestPath +encodeRequestPath = LC8.toStrict . BB.toLazyByteString . encodePathSegments 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 @@ -298,6 +298,12 @@ show (CurrencyType c) = unpack c +deriveJSON defaultOptions + { fieldLabelModifier = snakeCase + , unwrapUnaryRecords = True + } ''CurrencyType + + data Currency = Currency { id :: Text , name :: Text @@ -324,3 +330,9 @@ instance Show CryptoAddress where show (CryptoAddress ca) = unpack ca + + +deriveJSON defaultOptions + { fieldLabelModifier = snakeCase + , unwrapUnaryRecords = True + } ''CryptoAddress 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 @@ -1,5 +1,4 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE DataKinds #-} module CoinbasePro.Unauthenticated ( products 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 @@ -7,27 +7,22 @@ import Control.Concurrent (forkIO) import Control.Exception (Exception, throwIO) import Control.Monad (forever) -import Control.Monad.IO.Class (liftIO) import Data.Aeson (decode', encode) -import Network.HTTP.Types (methodGet) import qualified Network.WebSockets as WS import qualified System.IO.Streams as Streams import System.IO.Streams.Concurrent.Unagi (makeChanPipe) import qualified Wuss as WU -import CoinbasePro.Authenticated.Request (CoinbaseProCredentials (..), - mkCBAccessSign, - mkCBAccessTimeStamp) +import CoinbasePro.Authenticated.Request (CoinbaseProCredentials (..)) import CoinbasePro.Environment (Environment, WSConnection (..), wsEndpoint) -import CoinbasePro.Request (emptyBody) import CoinbasePro.Types (ProductId) import CoinbasePro.WebSocketFeed.Channel (ChannelMessage (..)) -import CoinbasePro.WebSocketFeed.Request (AuthenticatedWebSocketFeedRequest (..), - ChannelName (..), +import CoinbasePro.WebSocketFeed.Request (ChannelName (..), RequestMessageType (..), - WebSocketFeedRequest (..)) + WebSocketFeedRequest (..), + authenticatedWebSocketFeedRequest) data ParseException = ParseException deriving Show @@ -52,18 +47,11 @@ wsHost = host wsConn wsPort = port wsConn - mkWsRequest = maybe (return $ encode wsRequest) (fmap encode . authWsRequest) - - wsRequest = WebSocketFeedRequest Subscribe prids channels - - authWsRequest cpc' = do - ts <- liftIO mkCBAccessTimeStamp - let cbs = mkCBAccessSign (cbSecretKey cpc') ts methodGet authSubscriptionPath emptyBody - return $ AuthenticatedWebSocketFeedRequest wsRequest cbs (cbAccessKey cpc') (cbAccessPassphrase cpc') ts - - authSubscriptionPath = "/users/self/verify" + mkWsRequest = maybe (return $ encode wsRequest) (fmap encode . authWsRequest) + wsRequest = WebSocketFeedRequest Subscribe prids channels + authWsRequest = authenticatedWebSocketFeedRequest wsRequest parseFeed :: WS.Connection -> IO ChannelMessage -parseFeed conn = maybe err return =<< (decode' <$> WS.receiveData conn) +parseFeed conn = WS.receiveData conn >>= maybe err return . decode' where err = throwIO ParseException diff --git a/src/lib/CoinbasePro/WebSocketFeed/Request.hs b/src/lib/CoinbasePro/WebSocketFeed/Request.hs --- a/src/lib/CoinbasePro/WebSocketFeed/Request.hs +++ b/src/lib/CoinbasePro/WebSocketFeed/Request.hs @@ -5,16 +5,25 @@ ( RequestMessageType (..) , ChannelName(..) , WebSocketFeedRequest (..) - , AuthenticatedWebSocketFeedRequest (..) + , AuthenticatedWebSocketFeedRequest + + , authenticatedWebSocketFeedRequest ) where +import Control.Monad.IO.Class (liftIO) import Data.Aeson (FromJSON (..), ToJSON (..), object, withText, (.=)) +import Network.HTTP.Types (methodGet) import CoinbasePro.Authenticated.Headers (CBAccessKey (..), CBAccessPassphrase (..), CBAccessSign (..), CBAccessTimeStamp (..)) +import CoinbasePro.Authenticated.Request (CoinbaseProCredentials (..), + mkCBAccessSign, + mkCBAccessTimeStamp) +import CoinbasePro.Request (emptyBody, + encodeRequestPath) import CoinbasePro.Types (ProductId) @@ -74,13 +83,8 @@ , "channels" .= rc ] -data AuthenticatedWebSocketFeedRequest = AuthenticatedWebSocketFeedRequest - { request :: WebSocketFeedRequest - , cbSig :: CBAccessSign - , cbKey :: CBAccessKey - , cbPassphrase :: CBAccessPassphrase - , cbTimestamp :: CBAccessTimeStamp - } deriving (Eq) +data AuthenticatedWebSocketFeedRequest = + AuthenticatedWebSocketFeedRequest WebSocketFeedRequest CBAccessSign CBAccessKey CBAccessPassphrase CBAccessTimeStamp instance ToJSON AuthenticatedWebSocketFeedRequest where @@ -93,3 +97,13 @@ , "passphrase" .= p , "timestamp" .= t ] + +authenticatedWebSocketFeedRequest :: WebSocketFeedRequest + -> CoinbaseProCredentials + -> IO AuthenticatedWebSocketFeedRequest +authenticatedWebSocketFeedRequest wsRequest cpc = do + ts <- liftIO mkCBAccessTimeStamp + let cbs = mkCBAccessSign (cbSecretKey cpc) ts methodGet authSubscriptionPath emptyBody + return $ AuthenticatedWebSocketFeedRequest wsRequest cbs (cbAccessKey cpc) (cbAccessPassphrase cpc) ts + where + authSubscriptionPath = encodeRequestPath ["users", "self", "verify"] diff --git a/src/lib/CoinbasePro/WebSocketFeed/Response.hs b/src/lib/CoinbasePro/WebSocketFeed/Response.hs --- a/src/lib/CoinbasePro/WebSocketFeed/Response.hs +++ b/src/lib/CoinbasePro/WebSocketFeed/Response.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} module CoinbasePro.WebSocketFeed.Response @@ -24,8 +25,8 @@ instance FromJSON ResponseMessageType where - parseJSON v = withText "response message type" (\t -> - case t of + parseJSON v = withText "response message type" ( + \case "subscriptions" -> return Subscriptions _ -> typeMismatch "response message type" v) v