diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -21,12 +21,12 @@ - [x] Get An Account - [ ] Get Account History - [ ] Get Holds - - [ ] Orders + - [x] Orders - [x] Place a New Order - [x] Cancel an Order - [x] Cancel all - [x] List Orders - - [ ] Get an Order + - [x] Get an Order - [x] Fills - [x] List Fills - [ ] Deposits @@ -53,7 +53,7 @@ - [x] The status channel - [x] The ticker channel - [x] The level2 channel - - [ ] The user channel + - [x] The user channel - [x] The matches channel - [x] The full channel - FIX API @@ -88,7 +88,7 @@ ```haskell main :: IO () main = do - msgs <- subscribeToFeed [ProductId "BTC-USD"] [Ticker] + msgs <- subscribeToFeed [ProductId "BTC-USD"] [Ticker] Nothing forever $ Streams.read msgs >>= print ``` diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,44 @@ +# Version 0.8.0.0 + +## Breaking API changes: + +- `Environment` concept has been introduced. This allows the user to specify an endpoint (production, sandbox) + in which to query or stream. + + - `run` (and associated functions) now take an `Environment` as the first parameter. `runSandbox` and associated + functions have been removed. + - `runWithManager` now has different parameter ordering. Signature is `runWithManager :: Manager -> Environment -> ClientM a -> IO a` + - `runCbAuthT` now takes a `Runner a`, where `Runner a = ClientM a -> IO a`; allows users to specify an environment in which to run + +- `placeOrder` now has `Maybe ClientOrderId` as the first parameter that allows users to assign `client_oid` to + submitted orders. The `client_oid` field is visible on the `Full` channel. + +- `CoinbasePro.WebSocketFeed.subscribeToFeed` has two additional parameters: + + - `Environment` + - `Maybe CoinbaseProCredentials`: allows users to authenticate on subscription. See `User` + +- Moved `UserId` and `ProfileId` to `CoinbasePro.Types` from `CoinbasePro.WebSocketFeed.Channel.Full.Activate` + +## Additional Features: + +- Added `User` channel functionality that allows users to see `user_id` and `profile_id` on messages that pertain to the subscriber. + See [documentation](https://docs.pro.coinbase.com/#the-user-channel) for more details + + - `user_id` and `profile_id` fields are now parsed from `Full` channel messages if available. + +- `CoinbasePro.Types.ClientOrderId` has been introduced to specify `client_oid` in `placeOrder` API request. + - `client_oid` is now parsed from `CoinbasePro.WebSocketFeed.Channel.Full.Received. + +- `CoinbasePro.Authenticated.getOrder` allows users to query status of order + +- `CoinbasePro.Authenticated.getClientOrder` allows users to query status of order using `client_oid` + + +## Misc + +- minor cleanups of unused imports + # Version 0.7.2.0 - Upgraded to stack lts-14.17 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: e58a9cfeb1d43417b9df67df9f0855f31e070618162e2ef3836257eb606a9670 +-- hash: a870948505578ac331822c4d53b73343bd8cea3178cd634aace31f0a118981a3 name: coinbase-pro -version: 0.7.2.0 +version: 0.8.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: 2019 Michael Dunn +copyright: 2020 Michael Dunn license: MIT license-file: LICENSE build-type: Simple @@ -36,6 +36,7 @@ CoinbasePro.Authenticated.Headers CoinbasePro.Authenticated.Orders CoinbasePro.Authenticated.Request + CoinbasePro.Environment CoinbasePro.Headers CoinbasePro.MarketData.AggregateOrderBook CoinbasePro.MarketData.FullOrderBook @@ -88,6 +89,7 @@ , transformers >=0.5 && <0.6 , unagi-streams >=0.2 && <0.3 , unordered-containers >=0.2 && <0.3 + , uuid >=1.3 && <1.4 , vector >=0.12 && <0.13 , websockets >=0.12 && <0.13 , wuss >=1.1 && <1.2 @@ -126,6 +128,7 @@ , transformers >=0.5 && <0.6 , unagi-streams >=0.2 && <0.3 , unordered-containers >=0.2 && <0.3 + , uuid >=1.3 && <1.4 , vector >=0.12 && <0.13 , websockets >=0.12 && <0.13 , wuss >=1.1 && <1.2 @@ -164,6 +167,7 @@ , transformers >=0.5 && <0.6 , unagi-streams >=0.2 && <0.3 , unordered-containers >=0.2 && <0.3 + , uuid >=1.3 && <1.4 , vector >=0.12 && <0.13 , websockets >=0.12 && <0.13 , wuss >=1.1 && <1.2 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 @@ -9,6 +9,7 @@ import CoinbasePro.Authenticated.Headers import CoinbasePro.Authenticated.Orders import CoinbasePro.Authenticated.Request +import CoinbasePro.Environment import CoinbasePro.MarketData.Types hiding (time) import CoinbasePro.Request import CoinbasePro.Types hiding (time) @@ -17,21 +18,21 @@ main :: IO () main = do - run (stats btcusd) >>= print - run (candles btcusd Nothing Nothing Minute) >>= print - run (trades btcusd) >>= print - run time >>= print - run products >>= print - run (aggregateOrderBook btcusd (Just Best)) >>= print - run (aggregateOrderBook btcusd (Just TopFifty)) >>= print - run (fullOrderBook btcusd) >>= print - runCbAuthT cpc $ 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 accounts >>= liftIO . print account aid >>= liftIO . print fills (Just btcusd) Nothing >>= liftIO . print listOrders (Just [All]) (Just btcusd) >>= liftIO . print - placeOrder btcusd Sell (Size 0.001) (Price 99999.00) True Nothing Nothing Nothing >>= liftIO . print - placeOrder btcusd Buy (Size 1.0) (Price 1.00) True Nothing Nothing Nothing >>= 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" diff --git a/src/example/stream/Main.hs b/src/example/stream/Main.hs --- a/src/example/stream/Main.hs +++ b/src/example/stream/Main.hs @@ -5,11 +5,13 @@ import Control.Monad (forever) import qualified System.IO.Streams as Streams +import CoinbasePro.Environment (Environment (..)) import CoinbasePro.Types (ProductId (..)) import CoinbasePro.WebSocketFeed (subscribeToFeed) import CoinbasePro.WebSocketFeed.Request (ChannelName (..)) + main :: IO () main = do - msgs <- subscribeToFeed [ProductId "BTC-USD"] [Status] + msgs <- subscribeToFeed [ProductId "BTC-USD"] [Full] Sandbox Nothing forever $ Streams.read msgs >>= 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 @@ -6,6 +6,8 @@ ( accounts , account , listOrders + , getOrder + , getClientOrder , placeOrder , cancelOrder , cancelAll @@ -23,6 +25,7 @@ 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, @@ -42,7 +45,8 @@ import CoinbasePro.Request (RequestPath) -import CoinbasePro.Types (OrderId (..), OrderType, +import CoinbasePro.Types (ClientOrderId (..), + OrderId (..), OrderType, Price, ProductId (..), Side, Size) @@ -76,12 +80,35 @@ defaultStatus = fromMaybe [All] +-- | https://docs.pro.coinbase.com/#get-an-order +getOrder :: OrderId -> CBAuthT ClientM Order +getOrder oid = authRequest methodGet (mkRequestPath "/orders") "" $ API.getOrder oid + where + mkRequestPath rp = rp ++ "/" ++ unpack (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 + where + mkRequestPath rp = rp ++ toString (unClientOrderId cloid) + + -- | https://docs.pro.coinbase.com/?javascript#place-a-new-order -placeOrder :: ProductId -> Side -> Size -> Price -> Bool -> Maybe OrderType -> Maybe STP -> Maybe TimeInForce -> CBAuthT ClientM Order -placeOrder prid sd sz price po ot stp tif = +placeOrder :: Maybe ClientOrderId + -> ProductId + -> Side + -> Size + -> Price + -> Bool + -> Maybe OrderType + -> Maybe STP + -> 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 where - body = PlaceOrderBody prid sd sz price po ot stp tif + body = PlaceOrderBody clordid prid sd sz price po ot stp tif -- | https://docs.pro.coinbase.com/?javascript#cancel-an-order 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 @@ -6,6 +6,8 @@ ( accounts , singleAccount , listOrders + , getOrder + , getClientOrder , placeOrder , cancelOrder , cancelAll @@ -29,13 +31,16 @@ Status (..)) import CoinbasePro.Authenticated.Request (AuthDelete, AuthGet, AuthPost) -import CoinbasePro.Types (OrderId (..), +import CoinbasePro.Types (ClientOrderId (..), + OrderId (..), ProductId (..)) type API = "accounts" :> AuthGet [Account] :<|> "accounts" :> Capture "account-id" AccountId :> AuthGet Account :<|> "orders" :> QueryParams "status" Status :> QueryParam "product_id" ProductId :> AuthGet [Order] + :<|> "orders" :> Capture "order_id" OrderId :> AuthGet Order + :<|> "orders" :> Capture "client_oid" ClientOrderId :> AuthGet Order :<|> "orders" :> ReqBody '[JSON] PlaceOrderBody :> AuthPost Order :<|> "orders" :> Capture "order_id" OrderId :> AuthDelete NoContent :<|> "orders" :> QueryParam "product_id" ProductId :> AuthDelete [OrderId] @@ -51,10 +56,12 @@ accounts :: AuthenticatedRequest (AuthProtect "CBAuth") -> ClientM [Account] singleAccount :: AccountId -> AuthenticatedRequest (AuthProtect "CBAuth") -> ClientM Account listOrders :: [Status] -> Maybe ProductId -> AuthenticatedRequest (AuthProtect "CBAuth") -> ClientM [Order] +getOrder :: OrderId -> AuthenticatedRequest (AuthProtect "CBAuth") -> ClientM Order +getClientOrder :: ClientOrderId -> AuthenticatedRequest (AuthProtect "CBAuth") -> ClientM Order placeOrder :: PlaceOrderBody -> AuthenticatedRequest (AuthProtect "CBAuth") -> ClientM Order cancelOrder :: OrderId -> AuthenticatedRequest (AuthProtect "CBAuth") -> ClientM NoContent cancelAll :: Maybe ProductId -> AuthenticatedRequest (AuthProtect "CBAuth") -> ClientM [OrderId] 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 :<|> placeOrder :<|> cancelOrder :<|> cancelAll :<|> fills :<|> fees :<|> trailingVolume = client api +accounts :<|> singleAccount :<|> listOrders :<|> getOrder :<|> getClientOrder :<|> placeOrder :<|> cancelOrder :<|> cancelAll :<|> fills :<|> fees :<|> trailingVolume = client api 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 @@ -5,6 +5,7 @@ , CBAccessPassphrase(..) ) where +import Data.Aeson (ToJSON (..), Value (String)) import Data.ByteString (ByteString) import Data.Text (pack) import Data.Text.Encoding (decodeUtf8) @@ -20,6 +21,10 @@ toQueryParam (CBAccessKey k) = pack k +instance ToJSON CBAccessKey where + toJSON (CBAccessKey k) = String $ pack k + + newtype CBAccessSign = CBAccessSign ByteString deriving (Eq, Show) @@ -29,6 +34,10 @@ toQueryParam (CBAccessSign s) = decodeUtf8 s +instance ToJSON CBAccessSign where + toJSON (CBAccessSign s) = String $ decodeUtf8 s + + newtype CBAccessTimeStamp = CBAccessTimeStamp String deriving (Eq, Show) @@ -38,8 +47,16 @@ toQueryParam (CBAccessTimeStamp ts) = pack ts +instance ToJSON CBAccessTimeStamp where + toJSON (CBAccessTimeStamp ts) = String $ pack ts + + newtype CBAccessPassphrase = CBAccessPassphrase String deriving (Eq, Show) + + +instance ToJSON CBAccessPassphrase where + toJSON (CBAccessPassphrase p) = String $ pack p instance ToHttpApiData CBAccessPassphrase where 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 @@ -23,8 +23,9 @@ import Data.Text (pack, toLower, unpack) import Web.HttpApiData (ToHttpApiData (..)) -import CoinbasePro.Types (CreatedAt, OrderId, OrderType, Price, - ProductId, Side, Size, filterOrderFieldName) +import CoinbasePro.Types (ClientOrderId, CreatedAt, OrderId, + OrderType, Price, ProductId, Side, Size, + filterOrderFieldName) -- TODO: All is not a status @@ -110,7 +111,8 @@ data PlaceOrderBody = PlaceOrderBody - { bProductId :: ProductId + { bClientOid :: Maybe ClientOrderId + , bProductId :: ProductId , bSide :: Side , bSize :: Size , bPrice :: Price 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 @@ -16,6 +16,8 @@ , AuthDelete , authRequest + , mkCBAccessSign + , mkCBAccessTimeStamp ) where import Control.Monad.IO.Class (MonadIO, liftIO) @@ -47,7 +49,7 @@ CBAccessSign (..), CBAccessTimeStamp (..)) import CoinbasePro.Headers (userAgent) -import CoinbasePro.Request (Body, RequestPath, run) +import CoinbasePro.Request (Body, RequestPath, Runner) newtype CBSecretKey = CBSecretKey String @@ -65,8 +67,8 @@ deriving (Functor, Applicative, Monad, MonadIO, MonadTrans) -runCbAuthT :: CoinbaseProCredentials -> CBAuthT ClientM a -> IO a -runCbAuthT cpc = run . flip runReaderT cpc . unCbAuth +runCbAuthT :: Runner a -> CoinbaseProCredentials -> CBAuthT ClientM a -> IO a +runCbAuthT runEnv cpc = runEnv . flip runReaderT cpc . unCbAuth type instance AuthClientData (AuthProtect "CBAuth") = (CBAccessKey, CBAccessSign, CBAccessTimeStamp, CBAccessPassphrase) diff --git a/src/lib/CoinbasePro/Environment.hs b/src/lib/CoinbasePro/Environment.hs new file mode 100644 --- /dev/null +++ b/src/lib/CoinbasePro/Environment.hs @@ -0,0 +1,46 @@ +module CoinbasePro.Environment + ( Environment (..) + , WSConnection (..) + + , apiEndpoint + , wsEndpoint + ) where + + +import Network.Socket (HostName) +import Network.Socket.Internal (PortNumber) + + +data Environment = Production | Sandbox + + +apiEndpoint :: Environment -> String +apiEndpoint Production = productionAPIEndpoint +apiEndpoint Sandbox = sandboxAPIEndpoint + + +productionAPIEndpoint :: String +productionAPIEndpoint = "api.pro.coinbase.com" + + +sandboxAPIEndpoint :: String +sandboxAPIEndpoint = "api-public.sandbox.pro.coinbase.com" + + +data WSConnection = WSConnection + { host :: HostName + , port :: PortNumber + } deriving (Eq, Show) + + +wsEndpoint :: Environment -> WSConnection +wsEndpoint Production = productionWSEndpoint +wsEndpoint Sandbox = sandboxWSEndpoint + + +productionWSEndpoint :: WSConnection +productionWSEndpoint = WSConnection "ws-feed.pro.coinbase.com" 443 + + +sandboxWSEndpoint :: WSConnection +sandboxWSEndpoint = WSConnection "ws-feed-public.sandbox.pro.coinbase.com" 443 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.7" +userAgent = UserAgent "coinbase-pro/0.8" type UserAgentHeader = RequiredHeader "User-Agent" UserAgent 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,6 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} module CoinbasePro.Request ( RequestPath @@ -10,15 +9,11 @@ , CBGet , CBRequest - -- * Production , run , run_ , runWithManager - -- * Sandbox - , runSandbox - , runSandbox_ - , runSandboxWithManager + , Runner ) where import Control.Exception (throw) @@ -28,6 +23,7 @@ import Servant.API ((:>), Get, JSON) import Servant.Client +import CoinbasePro.Environment (Environment, apiEndpoint) import CoinbasePro.Headers (UserAgent, UserAgentHeader) @@ -41,19 +37,24 @@ type Body = String +type Runner a = ClientM a -> IO a + + ------------------------------------------------------------------------------ -- | Runs a coinbase pro HTTPS request and returns the result `a` -- --- > run products >>= print +-- > run Production products >>= print -- -run :: ClientM a -> IO a -run f = flip runWithManager f =<< newManager tlsManagerSettings +run :: Environment -> ClientM a -> IO a +run env f = do + mgr <- newManager tlsManagerSettings + runWithManager mgr env f ------------------------------------------------------------------------------ -- | Same as 'run', except uses `()` instead of a type `a` -run_ :: ClientM a -> IO () -run_ = void . run +run_ :: Environment -> ClientM a -> IO () +run_ = (void .) . run ------------------------------------------------------------------------------ @@ -63,43 +64,12 @@ -- @ -- do $ -- mgr <- newManager tlsManagerSettings --- prds <- runWithManager mgr products --- print prds --- @ --- -runWithManager :: Manager -> ClientM a -> IO a -runWithManager mgr f = either throw return =<< - runClientM f (mkClientEnv mgr (BaseUrl Https production 443 mempty)) - where - production = "api.pro.coinbase.com" - ------------------------------------------------------------------------------- --- | Runs a coinbase pro HTTPS request in sandbox and returns the result 'a' --- --- > run products >>= print --- -runSandbox :: ClientM a -> IO a -runSandbox f = flip runSandboxWithManager f =<< newManager tlsManagerSettings - - ------------------------------------------------------------------------------- --- | Same as 'runSandbox', except uses '()' instead of a type 'a' -runSandbox_ :: ClientM a -> IO () -runSandbox_ = void . runSandbox - - ------------------------------------------------------------------------------- --- | Allows the user to use their own 'Network.HTTP.Client.Types.ManagerSettings` --- --- @ --- do $ --- mgr <- newManager tlsManagerSettings --- prds <- runSandboxWithManager mgr products +-- prds <- runWithManager mgr Production products -- print prds -- @ -- -runSandboxWithManager :: Manager -> ClientM a -> IO a -runSandboxWithManager mgr f = either throw return =<< - runClientM f (mkClientEnv mgr (BaseUrl Https sandbox 443 mempty)) +runWithManager :: Manager -> Environment -> ClientM a -> IO a +runWithManager mgr env f = either throw return =<< + runClientM f (mkClientEnv mgr (BaseUrl Https api 443 mempty)) where - sandbox = "api-public.sandbox.pro.coinbase.com" + api = apiEndpoint env 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 @@ -5,9 +5,12 @@ module CoinbasePro.Types ( OrderId (..) + , ClientOrderId (..) , Price (..) , ProductId (..) , Sequence + , UserId + , ProfileId , Side (..) , Size (..) , Volume (..) @@ -23,9 +26,9 @@ , filterOrderFieldName ) where -import Data.Aeson (FromJSON, ToJSON, Value (Null), - parseJSON, toJSON, withArray, - withObject, withText, (.:), (.:?)) +import Data.Aeson (FromJSON, ToJSON, parseJSON, toJSON, + withArray, withObject, withText, (.:), + (.:?)) import qualified Data.Aeson as A import Data.Aeson.Casing (camelCase, snakeCase) import Data.Aeson.TH (constructorTagModifier, defaultOptions, @@ -34,13 +37,17 @@ import Data.Text (Text, pack, toLower, unpack) import Data.Time.Clock (UTCTime) import Data.Time.Clock.POSIX (posixSecondsToUTCTime) +import Data.UUID (UUID, toText) import qualified Data.Vector as V import Servant.API import Text.Printf (printf) -type Sequence = Int +type UserId = Text +type ProfileId = Text +type Sequence = Int + data Side = Buy | Sell deriving (Eq, Ord, Show) @@ -64,6 +71,19 @@ { fieldLabelModifier = snakeCase , unwrapUnaryRecords = True } ''OrderId + + +newtype ClientOrderId = ClientOrderId { unClientOrderId :: UUID } + deriving (Eq, Ord, Show) + + +instance ToHttpApiData ClientOrderId where + toUrlPiece = ("client:" <>) . toText . unClientOrderId + + +deriveJSON defaultOptions + { unwrapUnaryRecords = True + } ''ClientOrderId newtype ProductId = ProductId { unProductId :: Text } 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 @@ -22,7 +22,6 @@ CBTime, FullBookLevel (..), Product, Trade) -import CoinbasePro.Request (run) import CoinbasePro.Types (Candle, CandleGranularity, Currency, ProductId, 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 @@ -4,34 +4,58 @@ import Control.Concurrent (forkIO) import Control.Monad (forever) +import Control.Monad.IO.Class (liftIO) import Data.Aeson (eitherDecode', encode) import Data.Either (either) +import Data.Maybe (maybe) +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.Environment (Environment, + WSConnection (..), + wsEndpoint) import CoinbasePro.Types (ProductId) import CoinbasePro.WebSocketFeed.Channel (ChannelMessage (..)) -import CoinbasePro.WebSocketFeed.Request (ChannelName (..), +import CoinbasePro.WebSocketFeed.Request (AuthenticatedWebSocketFeedRequest (..), + ChannelName (..), RequestMessageType (..), - WebSocketFeedRequest (..), - wsEndpoint) -import qualified CoinbasePro.WebSocketFeed.Request as WR + WebSocketFeedRequest (..)) -subscribeToFeed :: [ProductId] -> [ChannelName] -> IO (Streams.InputStream ChannelMessage) -subscribeToFeed prids channels = do +subscribeToFeed :: [ProductId] -> [ChannelName] -> Environment -> Maybe CoinbaseProCredentials -> IO (Streams.InputStream ChannelMessage) +subscribeToFeed prds channels env = subscribe (wsEndpoint env) prds channels + + +subscribe :: WSConnection -> [ProductId] -> [ChannelName] -> Maybe CoinbaseProCredentials -> IO (Streams.InputStream ChannelMessage) +subscribe wsConn prids channels cpc = do (is, os) <- makeChanPipe + req <- mkWsRequest cpc + _ <- forkIO . WU.runSecureClient wsHost wsPort "/" $ \conn -> do - WS.sendTextData conn $ encode request + WS.sendTextData conn req forever $ parseFeed conn >>= Streams.writeTo os . Just + return is where - wsHost = WR.host wsEndpoint - wsPort = WR.port wsEndpoint + wsHost = host wsConn + wsPort = port wsConn - request = WebSocketFeedRequest Subscribe prids channels + 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 "" + return $ AuthenticatedWebSocketFeedRequest wsRequest cbs (cbAccessKey cpc') (cbAccessPassphrase cpc') ts + + authSubscriptionPath = "/users/self/verify" parseFeed :: WS.Connection -> IO ChannelMessage diff --git a/src/lib/CoinbasePro/WebSocketFeed/Channel.hs b/src/lib/CoinbasePro/WebSocketFeed/Channel.hs --- a/src/lib/CoinbasePro/WebSocketFeed/Channel.hs +++ b/src/lib/CoinbasePro/WebSocketFeed/Channel.hs @@ -23,6 +23,7 @@ import CoinbasePro.WebSocketFeed.Channel.Ticker (Ticker (..)) import CoinbasePro.WebSocketFeed.Response (Subscription) + data ChannelMessage = ActivateMessage Activate | ChangeMessage Change 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 @@ -11,12 +11,10 @@ import Data.Text (Text) import Data.Time.Clock (UTCTime) -import CoinbasePro.Types (Funds, OrderId, Price, ProductId, Side, - Size) +import CoinbasePro.Types (Funds, OrderId, Price, ProductId, ProfileId, + Side, Size, UserId) -type UserId = Int -type ProfileId = Text type StopType = Text type TakerFeeRate = Double @@ -24,8 +22,6 @@ data Activate = Activate { productId :: ProductId , timestamp :: UTCTime - , userId :: UserId - , profileId :: ProfileId , orderId :: OrderId , stopType :: StopType , side :: Side @@ -34,6 +30,8 @@ , funds :: Funds , takerFeeRate :: TakerFeeRate , private :: Bool + , userId :: UserId + , profileId :: ProfileId } deriving (Eq, Ord, Show) diff --git a/src/lib/CoinbasePro/WebSocketFeed/Channel/Full/Change.hs b/src/lib/CoinbasePro/WebSocketFeed/Channel/Full/Change.hs --- a/src/lib/CoinbasePro/WebSocketFeed/Channel/Full/Change.hs +++ b/src/lib/CoinbasePro/WebSocketFeed/Channel/Full/Change.hs @@ -10,8 +10,8 @@ fieldLabelModifier) import Data.Time.Clock (UTCTime) -import CoinbasePro.Types (Funds, OrderId, Price, ProductId, Sequence, - Side, Size) +import CoinbasePro.Types (Funds, OrderId, Price, ProductId, ProfileId, + Sequence, Side, Size, UserId) data Change = Change @@ -25,6 +25,8 @@ , oldFunds :: Maybe Funds , price :: Maybe Price , side :: Side + , userId :: Maybe UserId + , profileId :: Maybe ProfileId } deriving (Eq, Ord, Show) diff --git a/src/lib/CoinbasePro/WebSocketFeed/Channel/Full/Done.hs b/src/lib/CoinbasePro/WebSocketFeed/Channel/Full/Done.hs --- a/src/lib/CoinbasePro/WebSocketFeed/Channel/Full/Done.hs +++ b/src/lib/CoinbasePro/WebSocketFeed/Channel/Full/Done.hs @@ -13,8 +13,8 @@ import Data.Text (Text) import Data.Time.Clock (UTCTime) -import CoinbasePro.Types (OrderId, Price, ProductId, Sequence, Side, - Size) +import CoinbasePro.Types (OrderId, Price, ProductId, ProfileId, + Sequence, Side, Size, UserId) type Reason = Text @@ -36,6 +36,8 @@ , reason :: Reason , side :: Side , remainingSize :: Maybe Size + , userId :: Maybe UserId + , profileId :: Maybe ProfileId } deriving (Eq, Ord, Show) diff --git a/src/lib/CoinbasePro/WebSocketFeed/Channel/Full/Match.hs b/src/lib/CoinbasePro/WebSocketFeed/Channel/Full/Match.hs --- a/src/lib/CoinbasePro/WebSocketFeed/Channel/Full/Match.hs +++ b/src/lib/CoinbasePro/WebSocketFeed/Channel/Full/Match.hs @@ -10,8 +10,8 @@ fieldLabelModifier) import Data.Time.Clock (UTCTime) -import CoinbasePro.Types (OrderId, Price, ProductId, Sequence, Side, - Size) +import CoinbasePro.Types (OrderId, Price, ProductId, ProfileId, + Sequence, Side, Size, UserId) type TradeId = Int @@ -27,6 +27,8 @@ , size :: Size , price :: Price , side :: Side + , userId :: Maybe UserId + , profileId :: Maybe ProfileId } deriving (Eq, Ord, Show) diff --git a/src/lib/CoinbasePro/WebSocketFeed/Channel/Full/Open.hs b/src/lib/CoinbasePro/WebSocketFeed/Channel/Full/Open.hs --- a/src/lib/CoinbasePro/WebSocketFeed/Channel/Full/Open.hs +++ b/src/lib/CoinbasePro/WebSocketFeed/Channel/Full/Open.hs @@ -10,8 +10,8 @@ fieldLabelModifier) import Data.Time.Clock (UTCTime) -import CoinbasePro.Types (OrderId, Price, ProductId, Sequence, Side, - Size) +import CoinbasePro.Types (OrderId, Price, ProductId, ProfileId, + Sequence, Side, Size, UserId) data Open = Open @@ -22,6 +22,8 @@ , price :: Price , remainingSize :: Maybe Size , side :: Side + , userId :: Maybe UserId + , profileId :: Maybe ProfileId } deriving (Eq, Ord, Show) diff --git a/src/lib/CoinbasePro/WebSocketFeed/Channel/Full/Received.hs b/src/lib/CoinbasePro/WebSocketFeed/Channel/Full/Received.hs --- a/src/lib/CoinbasePro/WebSocketFeed/Channel/Full/Received.hs +++ b/src/lib/CoinbasePro/WebSocketFeed/Channel/Full/Received.hs @@ -1,17 +1,16 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} module CoinbasePro.WebSocketFeed.Channel.Full.Received ( Received (..) ) where -import Data.Aeson.Casing (snakeCase) -import Data.Aeson.TH (defaultOptions, deriveJSON, - fieldLabelModifier) +import Data.Aeson (FromJSON (..), withObject, (.:), (.:?)) import Data.Time.Clock (UTCTime) +import Data.UUID (fromString) -import CoinbasePro.Types (Funds, OrderId, OrderType, Price, ProductId, - Sequence, Side, Size) +import CoinbasePro.Types (ClientOrderId (..), Funds, OrderId, + OrderType, Price, ProductId, ProfileId, + Sequence, Side, Size, UserId) data Received = Received @@ -19,12 +18,29 @@ , productId :: ProductId , sequence :: Sequence , orderId :: OrderId + , clientOid :: Maybe ClientOrderId , size :: Maybe Size , price :: Maybe Price , funds :: Maybe Funds , side :: Side , orderType :: OrderType + , userId :: Maybe UserId + , profileId :: Maybe ProfileId } deriving (Eq, Ord, Show) -deriveJSON defaultOptions {fieldLabelModifier = snakeCase} ''Received +instance FromJSON Received where + parseJSON = withObject "received" $ \o -> do + t <- o .: "time" + prd <- o .: "product_id" + sq <- o .: "sequence" + oid <- o .: "order_id" + cloid <- (ClientOrderId <$>) . fromString <$> (o .: "client_oid") + sz <- o .:? "size" + px <- o .:? "price" + fs <- o .:? "funds" + sd <- o .: "side" + ot <- o .: "order_type" + ui <- o .:? "user_id" + pfid <- o .:? "profile_id" + return $ Received t prd sq oid cloid sz px fs sd ot ui pfid diff --git a/src/lib/CoinbasePro/WebSocketFeed/Channel/Status.hs b/src/lib/CoinbasePro/WebSocketFeed/Channel/Status.hs --- a/src/lib/CoinbasePro/WebSocketFeed/Channel/Status.hs +++ b/src/lib/CoinbasePro/WebSocketFeed/Channel/Status.hs @@ -6,10 +6,6 @@ import Data.Aeson (FromJSON, parseJSON, withObject, (.:)) -import Data.Aeson.Casing (snakeCase) -import Data.Aeson.TH (defaultOptions, deriveJSON, - fieldLabelModifier) -import Data.Text (Text) import CoinbasePro.MarketData.Types (Product) import CoinbasePro.Types (Currency) 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 @@ -1,33 +1,21 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} module CoinbasePro.WebSocketFeed.Request - ( WSConnection (..) - , RequestMessageType (..) + ( RequestMessageType (..) , ChannelName(..) , WebSocketFeedRequest (..) - - , wsEndpoint + , AuthenticatedWebSocketFeedRequest (..) ) where -import Data.Aeson (FromJSON (..), ToJSON (..), object, - withText, (.=)) -import Network.Socket (HostName) -import Network.Socket.Internal (PortNumber) - -import CoinbasePro.Types (ProductId) - - -data WSConnection = WSConnection - { host :: HostName - , port :: PortNumber - } deriving (Eq, Show) - +import Data.Aeson (FromJSON (..), ToJSON (..), + object, withText, (.=)) -wsEndpoint :: WSConnection -wsEndpoint = WSConnection h p - where - h = "ws-feed.pro.coinbase.com" - p = 443 +import CoinbasePro.Authenticated.Headers (CBAccessKey (..), + CBAccessPassphrase (..), + CBAccessSign (..), + CBAccessTimeStamp (..)) +import CoinbasePro.Types (ProductId) data RequestMessageType = Subscribe | Unsubscribe @@ -62,8 +50,7 @@ instance FromJSON ChannelName where - parseJSON = withText "channel name" $ \t -> - case t of + parseJSON = withText "channel name" $ \case "heartbeat" -> return Heartbeat "status" -> return Status "ticker" -> return Ticker @@ -85,4 +72,24 @@ [ "type" .= show rmt , "product_ids" .= rpi , "channels" .= rc + ] + +data AuthenticatedWebSocketFeedRequest = AuthenticatedWebSocketFeedRequest + { request :: WebSocketFeedRequest + , cbSig :: CBAccessSign + , cbKey :: CBAccessKey + , cbPassphrase :: CBAccessPassphrase + , cbTimestamp :: CBAccessTimeStamp + } deriving (Eq) + + +instance ToJSON AuthenticatedWebSocketFeedRequest where + toJSON (AuthenticatedWebSocketFeedRequest req s k p t) = object + [ "type" .= show (reqMsgType req) + , "product_ids" .= reqProductIds req + , "channels" .= reqChannels req + , "signature" .= s + , "key" .= k + , "passphrase" .= p + , "timestamp" .= t ]