diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +The MIT License (MIT) + +Copyright (c) 2018 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 +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +THE SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,75 @@ +# coinbase-pro + +## Request API + +```haskell +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import Control.Monad.IO.Class (liftIO) + +import CoinbasePro.Authenticated +import CoinbasePro.Authenticated.Accounts +import CoinbasePro.Authenticated.Orders +import CoinbasePro.Headers +import CoinbasePro.MarketData.Types hiding (time) +import CoinbasePro.Request +import CoinbasePro.Types hiding (time) +import CoinbasePro.Unauthenticated + + +main :: IO () +main = do + stats btcusd >>= print + candles btcusd Nothing Nothing Minute >>= print + trades btcusd >>= print + time >>= print + products >>= print + aggregateOrderBook btcusd (Just Best) >>= print + aggregateOrderBook btcusd (Just TopFifty) >>= print + fullOrderBook btcusd >>= print + runCbAuthT cpc $ do + accounts >>= liftIO . print + account accountId >>= 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 + cancelOrder (OrderId "") + cancelAll (Just btcusd) >>= liftIO . print + where + accessKey = CBAccessKey "" + secretKey = CBSecretKey "" + passphrase = CBAccessPassphrase "" + cpc = CoinbaseProCredentials accessKey secretKey passphrase + accountId = AccountId "" + btcusd = ProductId "BTC-USD" +``` + +## Websocket API + +To print out all of the full order book updates for BTC-USD: + + +```haskell +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import Control.Monad (forever) +import qualified System.IO.Streams as Streams + +import CoinbasePro.Types (ProductId (..)) +import CoinbasePro.WebSocketFeed (subscribeToFeed) +import CoinbasePro.WebSocketFeed.Request (ChannelName (..)) + +main :: IO () +main = do + msgs <- subscribeToFeed [ProductId "BTC-USD"] [Ticker] + forever $ Streams.read msgs >>= print +``` + +## Example + +Example execs can be found in `src/example/` diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/coinbase-pro.cabal b/coinbase-pro.cabal new file mode 100644 --- /dev/null +++ b/coinbase-pro.cabal @@ -0,0 +1,168 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.31.1. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: 6124c5e7fa1107537d12c2dc21092272651258821d1fea3d0c16a0ea518f9ecd + +name: coinbase-pro +version: 0.5.0.0 +synopsis: Client for Coinbase Pro +description: Client for Coinbase Pro REST and Websocket APIs +category: Web, Finance +homepage: https://github.com/mdunnio/coinbase-pro#readme +bug-reports: https://github.com/mdunnio/coinbase-pro/issues +author: Michael Dunn +maintainer: Michael Dunn +copyright: 2019 Michael Dunn +license: MIT +license-file: LICENSE +build-type: Simple +extra-source-files: + README.md + +source-repository head + type: git + location: https://github.com/https://github.com/mdunnio/coinbase-pro + +library + exposed-modules: + CoinbasePro.Authenticated + CoinbasePro.Authenticated.Accounts + CoinbasePro.Authenticated.API + CoinbasePro.Authenticated.Fills + CoinbasePro.Authenticated.Headers + CoinbasePro.Authenticated.Orders + CoinbasePro.Authenticated.Request + CoinbasePro.Headers + CoinbasePro.MarketData.AggregateOrderBook + CoinbasePro.MarketData.FullOrderBook + CoinbasePro.MarketData.Types + CoinbasePro.Request + CoinbasePro.Types + CoinbasePro.Unauthenticated + CoinbasePro.Unauthenticated.API + CoinbasePro.WebSocketFeed + CoinbasePro.WebSocketFeed.Channel + CoinbasePro.WebSocketFeed.Channel.Full.Activate + CoinbasePro.WebSocketFeed.Channel.Full.Change + CoinbasePro.WebSocketFeed.Channel.Full.Done + CoinbasePro.WebSocketFeed.Channel.Full.Match + CoinbasePro.WebSocketFeed.Channel.Full.Open + CoinbasePro.WebSocketFeed.Channel.Full.Received + CoinbasePro.WebSocketFeed.Channel.Heartbeat + CoinbasePro.WebSocketFeed.Channel.Level2 + CoinbasePro.WebSocketFeed.Channel.Ticker + CoinbasePro.WebSocketFeed.Request + CoinbasePro.WebSocketFeed.Response + other-modules: + Paths_coinbase_pro + hs-source-dirs: + src/lib/ + build-depends: + HsOpenSSL >=0.11 && <0.12 + , aeson >=1.2 && <1.4 + , aeson-casing >=0.1 && <0.2 + , async >=2.1 && <2.3 + , base >=4.7 && <5 + , binary >=0.8 && <0.9 + , bytestring >=0.10 && <0.11 + , containers >=0.5 && <0.6 + , cryptonite >=0.24 && <0.26 + , http-api-data >=0.3 && <0.4 + , http-client >=0.5 && <0.6 + , http-client-tls >=0.3 && <0.4 + , http-streams >=0.8 && <0.9 + , http-types >=0.12 && <0.13 + , io-streams >=1.5 && <1.6 + , memory >=0.14 && <0.15 + , network >=2.6 && <2.7 + , servant >=0.14 && <0.15 + , servant-client >=0.14 && <0.15 + , servant-client-core >=0.14 && <0.15 + , text >=1.2 && <1.3 + , time >=1.8 && <1.9 + , transformers >=0.5 && <0.6 + , unagi-streams >=0.2 && <0.3 + , unordered-containers >=0.2 && <0.3 + , vector >=0.12 && <0.13 + , websockets >=0.12 && <0.13 + , wuss >=1.1 && <1.2 + default-language: Haskell2010 + +executable test-request + main-is: Main.hs + other-modules: + Paths_coinbase_pro + hs-source-dirs: + src/example/request/ + build-depends: + HsOpenSSL >=0.11 && <0.12 + , aeson >=1.2 && <1.4 + , aeson-casing >=0.1 && <0.2 + , async >=2.1 && <2.3 + , base >=4.7 && <5 + , binary >=0.8 && <0.9 + , bytestring >=0.10 && <0.11 + , coinbase-pro + , containers >=0.5 && <0.6 + , cryptonite >=0.24 && <0.26 + , http-api-data >=0.3 && <0.4 + , http-client >=0.5 && <0.6 + , http-client-tls >=0.3 && <0.4 + , http-streams >=0.8 && <0.9 + , http-types >=0.12 && <0.13 + , io-streams >=1.5 && <1.6 + , memory >=0.14 && <0.15 + , network >=2.6 && <2.7 + , servant >=0.14 && <0.15 + , servant-client >=0.14 && <0.15 + , servant-client-core >=0.14 && <0.15 + , text >=1.2 && <1.3 + , time >=1.8 && <1.9 + , transformers >=0.5 && <0.6 + , unagi-streams >=0.2 && <0.3 + , unordered-containers >=0.2 && <0.3 + , vector >=0.12 && <0.13 + , websockets >=0.12 && <0.13 + , wuss >=1.1 && <1.2 + default-language: Haskell2010 + +executable test-stream + main-is: Main.hs + other-modules: + Paths_coinbase_pro + hs-source-dirs: + src/example/stream/ + build-depends: + HsOpenSSL >=0.11 && <0.12 + , aeson >=1.2 && <1.4 + , aeson-casing >=0.1 && <0.2 + , async >=2.1 && <2.3 + , base >=4.7 && <5 + , binary >=0.8 && <0.9 + , bytestring >=0.10 && <0.11 + , coinbase-pro + , containers >=0.5 && <0.6 + , cryptonite >=0.24 && <0.26 + , http-api-data >=0.3 && <0.4 + , http-client >=0.5 && <0.6 + , http-client-tls >=0.3 && <0.4 + , http-streams >=0.8 && <0.9 + , http-types >=0.12 && <0.13 + , io-streams >=1.5 && <1.6 + , memory >=0.14 && <0.15 + , network >=2.6 && <2.7 + , servant >=0.14 && <0.15 + , servant-client >=0.14 && <0.15 + , servant-client-core >=0.14 && <0.15 + , text >=1.2 && <1.3 + , time >=1.8 && <1.9 + , transformers >=0.5 && <0.6 + , unagi-streams >=0.2 && <0.3 + , unordered-containers >=0.2 && <0.3 + , vector >=0.12 && <0.13 + , websockets >=0.12 && <0.13 + , wuss >=1.1 && <1.2 + default-language: Haskell2010 diff --git a/src/example/request/Main.hs b/src/example/request/Main.hs new file mode 100644 --- /dev/null +++ b/src/example/request/Main.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import Control.Monad.IO.Class (liftIO) + +import CoinbasePro.Authenticated +import CoinbasePro.Authenticated.Accounts +import CoinbasePro.Authenticated.Headers +import CoinbasePro.Authenticated.Orders +import CoinbasePro.Authenticated.Request +import CoinbasePro.MarketData.Types hiding (time) +import CoinbasePro.Types hiding (time) +import CoinbasePro.Unauthenticated + + +main :: IO () +main = do + stats btcusd >>= print + candles btcusd Nothing Nothing Minute >>= print + trades btcusd >>= print + time >>= print + products >>= print + aggregateOrderBook btcusd (Just Best) >>= print + aggregateOrderBook btcusd (Just TopFifty) >>= print + fullOrderBook btcusd >>= print + runCbAuthT 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 + cancelAll (Just btcusd) >>= liftIO . print + where + accessKey = CBAccessKey "accesskey" + secretKey = CBSecretKey "secretkey" + passphrase = CBAccessPassphrase "passphrase" + cpc = CoinbaseProCredentials accessKey secretKey passphrase + aid = AccountId "accountid" + btcusd = ProductId "BTC-USD" diff --git a/src/example/stream/Main.hs b/src/example/stream/Main.hs new file mode 100644 --- /dev/null +++ b/src/example/stream/Main.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import Control.Monad (forever) +import qualified System.IO.Streams as Streams + +import CoinbasePro.Types (ProductId (..)) +import CoinbasePro.WebSocketFeed (subscribeToFeed) +import CoinbasePro.WebSocketFeed.Request (ChannelName (..)) + +main :: IO () +main = do + msgs <- subscribeToFeed [ProductId "BTC-USD"] [Ticker] + forever $ Streams.read msgs >>= print diff --git a/src/lib/CoinbasePro/Authenticated.hs b/src/lib/CoinbasePro/Authenticated.hs new file mode 100644 --- /dev/null +++ b/src/lib/CoinbasePro/Authenticated.hs @@ -0,0 +1,122 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} + +module CoinbasePro.Authenticated + ( accounts + , account + , listOrders + , fills + , placeOrder + , cancelOrder + , cancelAll + ) where + + +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 Network.HTTP.Types (SimpleQuery, + SimpleQueryItem, + methodDelete, methodGet, + methodPost, renderQuery, + simpleQueryToQuery) +import Servant.Client (ClientM) + +import CoinbasePro.Authenticated.Accounts (Account, AccountId (..)) +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 (OrderId (..), OrderType, + Price, ProductId (..), + Side, Size) + + +-- | https://docs.pro.coinbase.com/?javascript#accounts +accounts :: CBAuthT ClientM [Account] +accounts = authRequest methodGet "/accounts" "" API.accounts + + +-- | https://docs.pro.coinbase.com/?javascript#get-an-account +account :: AccountId -> CBAuthT ClientM Account +account aid@(AccountId t) = authRequest methodGet requestPath "" $ API.singleAccount aid + where + requestPath = "/accounts/" ++ unpack t + + +-- | https://docs.pro.coinbase.com/?javascript#list-orders +listOrders :: Maybe [Status] -> Maybe ProductId -> CBAuthT ClientM [Order] +listOrders st prid = authRequest methodGet (mkRequestPath "/orders") "" $ API.listOrders (defaultStatus st) prid + where + mkRequestPath :: RequestPath -> RequestPath + mkRequestPath rp = rp ++ (C8.unpack . renderQuery True . simpleQueryToQuery $ mkOrderQuery st prid) + + mkOrderQuery :: Maybe [Status] -> Maybe ProductId -> SimpleQuery + mkOrderQuery ss p = mkStatusQuery ss <> mkProductQuery p + + mkStatusQuery :: Maybe [Status] -> [SimpleQueryItem] + mkStatusQuery ss = mkSimpleQueryItem "status" . toLower . pack . show <$> S.toList (unStatuses . statuses $ defaultStatus ss) + + defaultStatus :: Maybe [Status] -> [Status] + defaultStatus = fromMaybe [All] + + +-- | 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 = + authRequest methodPost "/orders" (LC8.unpack $ encode body) $ API.placeOrder body + where + body = PlaceOrderBody prid sd sz price po ot stp tif + + +-- | https://docs.pro.coinbase.com/?javascript#cancel-an-order +cancelOrder :: OrderId -> CBAuthT ClientM () +cancelOrder oid = void . authRequest methodDelete (mkRequestPath "/orders") "" $ API.cancelOrder oid + where + mkRequestPath :: RequestPath -> RequestPath + mkRequestPath rp = rp ++ "/" ++ unpack (unOrderId oid) + + +-- | https://docs.pro.coinbase.com/?javascript#cancel-all +cancelAll :: Maybe ProductId -> CBAuthT ClientM [OrderId] +cancelAll prid = authRequest methodDelete (mkRequestPath "/orders") "" (API.cancelAll prid) + where + mkRequestPath :: RequestPath -> RequestPath + mkRequestPath rp = rp ++ (C8.unpack . renderQuery True . simpleQueryToQuery $ mkProductQuery prid) + + +-- | https://docs.pro.coinbase.com/?javascript#fills +fills :: Maybe ProductId -> Maybe OrderId -> CBAuthT ClientM [Fill] +fills prid oid = authRequest methodGet mkRequestPath "" (API.fills prid oid) + where + brp = "/fills" + + mkRequestPath :: RequestPath + mkRequestPath = brp ++ (C8.unpack . renderQuery True . simpleQueryToQuery $ mkSimpleQuery prid oid) + + mkSimpleQuery :: Maybe ProductId -> Maybe OrderId -> SimpleQuery + mkSimpleQuery p o = mkProductQuery p <> mkOrderIdQuery o + + +mkSimpleQueryItem :: String -> Text -> SimpleQueryItem +mkSimpleQueryItem s t = (C8.pack s, C8.pack $ unpack t) + + +mkProductQuery :: Maybe ProductId -> [SimpleQueryItem] +mkProductQuery = maybe [] (return . mkSimpleQueryItem "product_id" . unProductId) + + +mkOrderIdQuery :: Maybe OrderId -> SimpleQuery +mkOrderIdQuery = maybe [] (return . mkSimpleQueryItem "order_id" . unOrderId) diff --git a/src/lib/CoinbasePro/Authenticated/API.hs b/src/lib/CoinbasePro/Authenticated/API.hs new file mode 100644 --- /dev/null +++ b/src/lib/CoinbasePro/Authenticated/API.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} + +module CoinbasePro.Authenticated.API + ( accounts + , singleAccount + , listOrders + , placeOrder + , cancelOrder + , cancelAll + , fills + ) where + +import Data.Proxy (Proxy (..)) +import Servant.API ((:<|>) (..), (:>), + AuthProtect, Capture, JSON, + NoContent, QueryParam, + QueryParams, ReqBody) +import Servant.Client +import Servant.Client.Core (AuthenticatedRequest) + +import CoinbasePro.Authenticated.Accounts (Account, AccountId (..)) +import CoinbasePro.Authenticated.Fills (Fill) +import CoinbasePro.Authenticated.Orders (Order, PlaceOrderBody (..), + Status (..)) +import CoinbasePro.Authenticated.Request (AuthDelete, AuthGet, + AuthPost) +import CoinbasePro.Types (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" :> ReqBody '[JSON] PlaceOrderBody :> AuthPost Order + :<|> "orders" :> Capture "order_id" OrderId :> AuthDelete NoContent + :<|> "orders" :> QueryParam "product_id" ProductId :> AuthDelete [OrderId] + :<|> "fills" :> QueryParam "product_id" ProductId :> QueryParam "order_id" OrderId :> AuthGet [Fill] + + +api :: Proxy API +api = Proxy + + +accounts :: AuthenticatedRequest (AuthProtect "CBAuth") -> ClientM [Account] +singleAccount :: AccountId -> AuthenticatedRequest (AuthProtect "CBAuth") -> ClientM Account +listOrders :: [Status] -> Maybe ProductId -> 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] +accounts :<|> singleAccount :<|> listOrders :<|> placeOrder :<|> cancelOrder :<|> cancelAll :<|> fills = client api diff --git a/src/lib/CoinbasePro/Authenticated/Accounts.hs b/src/lib/CoinbasePro/Authenticated/Accounts.hs new file mode 100644 --- /dev/null +++ b/src/lib/CoinbasePro/Authenticated/Accounts.hs @@ -0,0 +1,54 @@ +{-# LANGUAGE OverloadedStrings #-} + +module CoinbasePro.Authenticated.Accounts + ( Account (..) + , AccountId (..) + , Currency (..) + , Balance (..) + , ProfileId (..) + ) where + +import Data.Aeson (FromJSON (..), withObject, (.:)) +import Data.Text (Text) +import Web.HttpApiData (ToHttpApiData (..)) + + +newtype AccountId = AccountId Text + deriving (Eq, Show) + + +instance ToHttpApiData AccountId where + toUrlPiece (AccountId aid) = aid + toQueryParam (AccountId aid) = aid + + +newtype Currency = Currency Text + deriving (Eq, Show) + + +newtype Balance = Balance Double + deriving (Eq, Show) + + +newtype ProfileId = ProfileId Text + deriving (Eq, Show) + + +data Account = Account + { accountId :: AccountId + , currency :: Currency + , balance :: Balance + , available :: Balance + , hold :: Balance + , profileId :: ProfileId + } deriving (Eq, Show) + + +instance FromJSON Account where + parseJSON = withObject "account" $ \o -> Account + <$> (AccountId <$> o .: "id") + <*> (Currency <$> o .: "currency") + <*> (Balance . read <$> o .: "balance") + <*> (Balance . read <$> o .: "available") + <*> (Balance . read <$> o .: "hold") + <*> (ProfileId <$> o .: "profile_id") diff --git a/src/lib/CoinbasePro/Authenticated/Fills.hs b/src/lib/CoinbasePro/Authenticated/Fills.hs new file mode 100644 --- /dev/null +++ b/src/lib/CoinbasePro/Authenticated/Fills.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE OverloadedStrings #-} + +module CoinbasePro.Authenticated.Fills + ( Fill (..) + , TradeId + , Liquidity (..) + ) where + +import Data.Aeson (FromJSON (..), withObject, withText, (.:)) + +import CoinbasePro.Types (CreatedAt (..), OrderId, Price, ProductId, + Side, Size, TradeId (..)) + + +data Liquidity = Maker | Taker + deriving (Eq, Show) + + +instance FromJSON Liquidity where + parseJSON = withText "liquidity" $ \t -> + case t of + "M" -> return Maker + "T" -> return Taker + _ -> fail "parse error" + + +data Fill = Fill + { tradeId :: TradeId + , productId :: ProductId + , side :: Side + , price :: Price + , size :: Size + , orderId :: OrderId + , createdAt :: CreatedAt + , liquidiy :: Liquidity + , fee :: Double + , settled :: Bool + } deriving (Eq, Show) + + +instance FromJSON Fill where + parseJSON = withObject "fill" $ \o -> Fill + <$> (TradeId <$> o .: "trade_id") + <*> o .: "product_id" + <*> o .: "side" + <*> o .: "price" + <*> o .: "size" + <*> o .: "order_id" + <*> (CreatedAt <$> o .: "created_at") + <*> (o .: "liquidity") + <*> (read <$> o .: "fee") + <*> o .: "settled" diff --git a/src/lib/CoinbasePro/Authenticated/Headers.hs b/src/lib/CoinbasePro/Authenticated/Headers.hs new file mode 100644 --- /dev/null +++ b/src/lib/CoinbasePro/Authenticated/Headers.hs @@ -0,0 +1,47 @@ +module CoinbasePro.Authenticated.Headers + ( CBAccessKey(..) + , CBAccessSign(..) + , CBAccessTimeStamp(..) + , CBAccessPassphrase(..) + ) where + +import Data.ByteString (ByteString) +import Data.Text (pack) +import Data.Text.Encoding (decodeUtf8) +import Web.HttpApiData (ToHttpApiData (..)) + + +newtype CBAccessKey = CBAccessKey String + deriving (Eq, Show) + + +instance ToHttpApiData CBAccessKey where + toUrlPiece (CBAccessKey k) = pack k + toQueryParam (CBAccessKey k) = pack k + + +newtype CBAccessSign = CBAccessSign ByteString + deriving (Eq, Show) + + +instance ToHttpApiData CBAccessSign where + toUrlPiece (CBAccessSign s) = decodeUtf8 s + toQueryParam (CBAccessSign s) = decodeUtf8 s + + +newtype CBAccessTimeStamp = CBAccessTimeStamp String + deriving (Eq, Show) + + +instance ToHttpApiData CBAccessTimeStamp where + toUrlPiece (CBAccessTimeStamp ts) = pack ts + toQueryParam (CBAccessTimeStamp ts) = pack ts + + +newtype CBAccessPassphrase = CBAccessPassphrase String + deriving (Eq, Show) + + +instance ToHttpApiData CBAccessPassphrase where + toUrlPiece (CBAccessPassphrase p) = pack p + toQueryParam (CBAccessPassphrase p) = pack p diff --git a/src/lib/CoinbasePro/Authenticated/Orders.hs b/src/lib/CoinbasePro/Authenticated/Orders.hs new file mode 100644 --- /dev/null +++ b/src/lib/CoinbasePro/Authenticated/Orders.hs @@ -0,0 +1,123 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE TemplateHaskell #-} + +module CoinbasePro.Authenticated.Orders + ( Status (..) + , Statuses (..) + , Order (..) + , STP (..) + , TimeInForce (..) + , PlaceOrderBody (..) + + , statuses + ) where + + +import Data.Aeson (FromJSON, ToJSON, parseJSON, withText) +import Data.Aeson.Casing (camelCase, snakeCase) +import Data.Aeson.TH (constructorTagModifier, defaultOptions, + deriveJSON, fieldLabelModifier, + omitNothingFields) +import Data.Set (Set, fromList) +import Data.Text (pack, toLower, unpack) +import Web.HttpApiData (ToHttpApiData (..)) + +import CoinbasePro.Types (CreatedAt, OrderId, OrderType, Price, + ProductId, Side, Size, filterOrderFieldName) + + +-- TODO: All is not a status +data Status = Open | Pending | Active | Done | All + deriving (Eq, Ord, Show) + + +instance ToHttpApiData Status where + toUrlPiece = toLower . pack . show + toQueryParam = toLower . pack . show + + +newtype Statuses = Statuses { unStatuses :: Set Status } + deriving (Eq, Show) + + +statuses :: [Status] -> Statuses +statuses = Statuses . fromList + + +data TimeInForce = GTC | GTT | IOC | FOK + deriving (Eq, Ord, Show) + + +instance ToHttpApiData TimeInForce where + toUrlPiece = toLower . pack . show + toQueryParam = toLower . pack . show + + +data STP = DC | CO | CN | CB + deriving (Eq, Ord, Show) + + +instance ToHttpApiData STP where + toUrlPiece = toLower . pack . show + toQueryParam = toLower . pack . show + + +deriveJSON defaultOptions {constructorTagModifier = camelCase} ''Status +deriveJSON defaultOptions ''TimeInForce +deriveJSON defaultOptions {constructorTagModifier = camelCase} ''STP + + +newtype FillFees = FillFees { unFillFees :: Double } + deriving (Eq, Ord, Show, ToJSON) + + +instance FromJSON FillFees where + parseJSON = withText "fill_fees" $ \t -> + return . FillFees . read $ unpack t + + +newtype ExecutedValue = ExecutedValue { unExecutedValue :: Double } + deriving (Eq, Ord, Show, ToJSON) + + +instance FromJSON ExecutedValue where + parseJSON = withText "executed_value" $ \t -> + return . ExecutedValue . read $ unpack t + + +-- TODO: This might need to be split up into different order types. +data Order = Order + { id :: OrderId + , price :: Maybe Price + , size :: Maybe Size + , productId :: ProductId + , side :: Side + , stp :: Maybe STP + , orderType :: OrderType + , timeInForce :: Maybe TimeInForce + , postOnly :: Bool + , createdAt :: CreatedAt + , fillFees :: FillFees + , filledSize :: Size + , executedValue :: Maybe ExecutedValue + , status :: Status + , settled :: Bool + } deriving (Eq, Show) + + +deriveJSON defaultOptions {fieldLabelModifier = filterOrderFieldName . snakeCase} ''Order + + +data PlaceOrderBody = PlaceOrderBody + { bProductId :: ProductId + , bSide :: Side + , bSize :: Size + , bPrice :: Price + , bPostOnly :: Bool + , bOrderType :: Maybe OrderType + , bStp :: Maybe STP + , bTif :: Maybe TimeInForce + } deriving (Eq, Show) + + +deriveJSON defaultOptions {fieldLabelModifier = snakeCase . drop 1, omitNothingFields = True} ''PlaceOrderBody diff --git a/src/lib/CoinbasePro/Authenticated/Request.hs b/src/lib/CoinbasePro/Authenticated/Request.hs new file mode 100644 --- /dev/null +++ b/src/lib/CoinbasePro/Authenticated/Request.hs @@ -0,0 +1,121 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} + +module CoinbasePro.Authenticated.Request + ( CBAuthT (..) + , runCbAuthT + + , CoinbaseProCredentials (..) + , CBSecretKey (..) + + , AuthGet + , AuthPost + , AuthDelete + + , authRequest + ) where + +import Control.Monad.IO.Class (MonadIO, liftIO) +import Control.Monad.Trans.Class (MonadTrans, lift) +import Control.Monad.Trans.Reader (ReaderT, asks, runReaderT) +import Crypto.Hash.Algorithms (SHA256) +import qualified Crypto.MAC.HMAC as HMAC +import Data.ByteArray.Encoding (Base (Base64), + convertFromBase, + convertToBase) +import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as C8 +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.Client (ClientM) +import Servant.Client.Core (AuthClientData, + AuthenticatedRequest, + addHeader, + mkAuthenticatedRequest) +import qualified Servant.Client.Core as SCC + +import CoinbasePro.Authenticated.Headers (CBAccessKey (..), + CBAccessPassphrase (..), + CBAccessSign (..), + CBAccessTimeStamp (..)) +import CoinbasePro.Headers (userAgent) +import CoinbasePro.Request (Body, RequestPath, run) + + +newtype CBSecretKey = CBSecretKey String + deriving (Eq) + + +data CoinbaseProCredentials = CoinbaseProCredentials + { cbAccessKey :: CBAccessKey + , cbSecretKey :: CBSecretKey + , cbAccessPassphrase :: CBAccessPassphrase + } deriving (Eq) + + +newtype CBAuthT m a = CBAuthT { unCbAuth :: ReaderT CoinbaseProCredentials m a } + deriving (Functor, Applicative, Monad, MonadIO, MonadTrans) + + +runCbAuthT :: CoinbaseProCredentials -> CBAuthT ClientM a -> IO a +runCbAuthT cpc = run . flip runReaderT cpc . unCbAuth + + +type instance AuthClientData (AuthProtect "CBAuth") = (CBAccessKey, CBAccessSign, CBAccessTimeStamp, CBAccessPassphrase) + + +type CBAuthAPI (auth :: Symbol) method a = AuthProtect auth :> method '[JSON] a + + +type AuthGet a = CBAuthAPI "CBAuth" Get a +type AuthPost a = CBAuthAPI "CBAuth" Post a +type AuthDelete a = CBAuthAPI "CBAuth" Delete a + + +addAuthHeaders :: (CBAccessKey, CBAccessSign, CBAccessTimeStamp, CBAccessPassphrase) -> SCC.Request -> SCC.Request +addAuthHeaders (key, sig, timestamp, pass) req = + addHeader "CB-ACCESS-KEY" key + $ addHeader "CB-ACCESS-SIGN" sig + $ addHeader "CB-ACCESS-TIMESTAMP" timestamp + $ addHeader "CB-ACCESS-PASSPHRASE" pass + $ addHeader "User-Agent" userAgent req + + +authRequest :: Method -> RequestPath -> Body + -> (AuthenticatedRequest (AuthProtect "CBAuth") -> ClientM b) + -> CBAuthT ClientM b +authRequest method requestPath body f = do + ak <- CBAuthT $ asks cbAccessKey + sk <- CBAuthT $ asks cbSecretKey + pp <- CBAuthT $ asks cbAccessPassphrase + + ts <- liftIO mkCBAccessTimeStamp + let cbs = mkCBAccessSign sk ts method requestPath body + lift . f $ mkAuthenticatedRequest (ak, cbs, ts, pp) addAuthHeaders + + +mkCBAccessTimeStamp :: IO CBAccessTimeStamp +mkCBAccessTimeStamp = CBAccessTimeStamp . formatTime defaultTimeLocale "%s%Q" <$> getCurrentTime + + +mkCBAccessSign :: CBSecretKey -> CBAccessTimeStamp -> Method -> RequestPath -> Body -> CBAccessSign +mkCBAccessSign sk ts method requestPath body = CBAccessSign $ convertToBase Base64 hmac + where + dak = decodeApiKey sk + msg = mkMsg ts method requestPath body + 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 + + +decodeApiKey :: CBSecretKey -> ByteString +decodeApiKey (CBSecretKey s) = either error id . convertFromBase Base64 $ C8.pack s diff --git a/src/lib/CoinbasePro/Headers.hs b/src/lib/CoinbasePro/Headers.hs new file mode 100644 --- /dev/null +++ b/src/lib/CoinbasePro/Headers.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeOperators #-} + +module CoinbasePro.Headers + ( RequiredHeader + , UserAgent + , UserAgentHeader + + , userAgent + ) where + +import Data.Text (Text) +import Servant.API (Header', Required) +import Web.HttpApiData (ToHttpApiData (..)) + + +type RequiredHeader = Header' '[Required] + + +newtype UserAgent = UserAgent Text + deriving (Eq, Show, ToHttpApiData) + + +userAgent :: UserAgent +userAgent = UserAgent "coinbase-pro/0.5" + + +type UserAgentHeader = RequiredHeader "User-Agent" UserAgent diff --git a/src/lib/CoinbasePro/MarketData/AggregateOrderBook.hs b/src/lib/CoinbasePro/MarketData/AggregateOrderBook.hs new file mode 100644 --- /dev/null +++ b/src/lib/CoinbasePro/MarketData/AggregateOrderBook.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE OverloadedStrings #-} + +module CoinbasePro.MarketData.AggregateOrderBook + ( AggregateOrderBook(..) + , AggregateLevel(..) + ) where + +import Data.Aeson (FromJSON (..), withArray, withObject, (.:)) +import qualified Data.Vector as V +import Data.Word (Word64) + + +data AggregateOrderBook = AggregateOrderBook + { sequence :: Int + , bids :: [AggregateLevel] + , asks :: [AggregateLevel] + } deriving (Eq, Ord, Show) + + +instance FromJSON AggregateOrderBook where + parseJSON = withObject "aggregate orderbook" $ \o -> + AggregateOrderBook <$> + o .: "sequence" <*> + o .: "bids" <*> + o .: "asks" + + +data AggregateLevel = AggregateLevel + { price :: Double + , size :: Double + , numOrders :: Word64 + } deriving (Eq, Ord, Show) + + +instance FromJSON AggregateLevel where + parseJSON = withArray "level" $ \a -> do + let l = V.toList a + p <- parseJSON $ head l + sz <- parseJSON $ l !! 1 + nos <- parseJSON $ l !! 2 + return $ AggregateLevel (read p) (read sz) nos diff --git a/src/lib/CoinbasePro/MarketData/FullOrderBook.hs b/src/lib/CoinbasePro/MarketData/FullOrderBook.hs new file mode 100644 --- /dev/null +++ b/src/lib/CoinbasePro/MarketData/FullOrderBook.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE OverloadedStrings #-} + +module CoinbasePro.MarketData.FullOrderBook + ( FullOrderBook (..) + , Order (..) + ) where + +import Data.Aeson (FromJSON (..), withArray, withObject, (.:)) +import qualified Data.Vector as V + +import CoinbasePro.Types (OrderId (..), Price, Size) + + +data FullOrderBook = FullOrderBook + { sequence :: Int + , bids :: [Order] + , asks :: [Order] + } deriving (Eq, Ord, Show) + + +instance FromJSON FullOrderBook where + parseJSON = withObject "orderbook" $ \o -> + FullOrderBook <$> + o .: "sequence" <*> + o .: "bids" <*> + o .: "asks" + + +data Order = Order + { price :: Price + , size :: Size + , orderId :: OrderId + } deriving (Eq, Ord, Show) + + +instance FromJSON Order where + parseJSON = withArray "order" $ \a -> do + let l = V.toList a + px <- parseJSON $ head l + sz <- parseJSON $ l !! 1 + oid <- parseJSON $ l !! 2 + return $ Order px sz oid diff --git a/src/lib/CoinbasePro/MarketData/Types.hs b/src/lib/CoinbasePro/MarketData/Types.hs new file mode 100644 --- /dev/null +++ b/src/lib/CoinbasePro/MarketData/Types.hs @@ -0,0 +1,92 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +module CoinbasePro.MarketData.Types + ( Product (..) + , CBTime (..) + , AggregateBookLevel (..) + , FullBookLevel (..) + , Trade (..) + ) where + +import Data.Aeson (FromJSON (..), withObject, (.:)) +import Data.Aeson.Casing (snakeCase) +import Data.Aeson.TH (defaultOptions, deriveJSON, + fieldLabelModifier) +import Data.Text (Text, pack) +import Data.Time.Clock (UTCTime) +import Web.HttpApiData (ToHttpApiData (..)) + +import CoinbasePro.Types (Price, ProductId, Side, Size, TradeId) + + +data Product = Product + { productId :: ProductId + , baseCurrency :: Text + , quoteCurrency :: Text + , baseMinSize :: Double + , baseMaxSize :: Double + , quoteIncrement :: 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) + + +instance ToHttpApiData Product where + toUrlPiece = toUrlPiece . productId + toQueryParam = toQueryParam . productId + + +newtype CBTime = CBTime { unCBTime :: UTCTime } deriving (Eq, Show) + + +instance FromJSON CBTime where + parseJSON = withObject "time" $ \o -> + CBTime <$> o .: "iso" + + +data AggregateBookLevel = Best | TopFifty + deriving (Eq, Show) + + +instance ToHttpApiData AggregateBookLevel where + toUrlPiece = pack . show . aggregateBookLevel + toQueryParam = pack . show . aggregateBookLevel + + +aggregateBookLevel :: AggregateBookLevel -> Int +aggregateBookLevel Best = 1 +aggregateBookLevel TopFifty = 2 + + +data FullBookLevel = FullBookLevel + + +instance ToHttpApiData FullBookLevel where + toUrlPiece = pack . show . fullBookLevel + toQueryParam = pack . show . fullBookLevel + + +fullBookLevel :: FullBookLevel -> Int +fullBookLevel FullBookLevel = 3 + + +data Trade = Trade + { time :: UTCTime + , tradeId :: TradeId + , price :: Price + , size :: Size + , side :: Side + } deriving (Eq, Show) + + +deriveJSON defaultOptions { fieldLabelModifier = snakeCase } ''Trade diff --git a/src/lib/CoinbasePro/Request.hs b/src/lib/CoinbasePro/Request.hs new file mode 100644 --- /dev/null +++ b/src/lib/CoinbasePro/Request.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} + +module CoinbasePro.Request + ( RequestPath + , Body + + , CBGet + , CBRequest + + , run + , apiEndpoint + ) where + +import Control.Exception (throw) +import Network.HTTP.Client (newManager) +import Network.HTTP.Client.TLS (tlsManagerSettings) +import Servant.API ((:>), Get, JSON) +import Servant.Client + +import CoinbasePro.Headers (UserAgent, UserAgentHeader) + + +type CBGet a = UserAgentHeader :> Get '[JSON] a + + +type CBRequest a = UserAgent -> ClientM a + + +type RequestPath = String +type Body = String + + +apiEndpoint :: String +apiEndpoint = "api.pro.coinbase.com" + + +run :: ClientM a -> IO a +run f = do + mgr <- newManager tlsManagerSettings + result <- runClientM f (mkClientEnv mgr (BaseUrl Https apiEndpoint 443 mempty)) + either throw return result diff --git a/src/lib/CoinbasePro/Types.hs b/src/lib/CoinbasePro/Types.hs new file mode 100644 --- /dev/null +++ b/src/lib/CoinbasePro/Types.hs @@ -0,0 +1,211 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +module CoinbasePro.Types + ( OrderId (..) + , Price (..) + , ProductId (..) + , Sequence + , Side (..) + , Size (..) + , TradeId (..) + , Funds + , OrderType (..) + , CreatedAt (..) + , Candle (..) + , CandleGranularity (..) + , TwentyFourHourStats (..) + + , filterOrderFieldName + ) where + +import Data.Aeson (FromJSON, ToJSON, parseJSON, toJSON, + withArray, withText) +import qualified Data.Aeson as A +import Data.Aeson.Casing (camelCase, snakeCase) +import Data.Aeson.TH (constructorTagModifier, defaultOptions, + deriveJSON, fieldLabelModifier, + unwrapUnaryRecords) +import Data.Text (Text, pack, toLower, unpack) +import Data.Time.Clock (UTCTime) +import Data.Time.Clock.POSIX (posixSecondsToUTCTime) +import qualified Data.Vector as V +import Servant.API +import Text.Printf (printf) + + +type Sequence = Int + +data Side = Buy | Sell + deriving (Eq, Ord, Show) + + +instance ToHttpApiData Side where + toUrlPiece = toLower . pack . show + toQueryParam = toLower . pack . show + + +deriveJSON defaultOptions + { constructorTagModifier = camelCase + , fieldLabelModifier = snakeCase + } ''Side + + +newtype OrderId = OrderId { unOrderId :: Text } + deriving (Eq, Ord, Show, ToHttpApiData) + + +deriveJSON defaultOptions + { fieldLabelModifier = snakeCase + , unwrapUnaryRecords = True + } ''OrderId + + +newtype ProductId = ProductId { unProductId :: Text } + deriving (Eq, Ord, Show, ToHttpApiData) + + +deriveJSON defaultOptions + { fieldLabelModifier = snakeCase + , unwrapUnaryRecords = True + } ''ProductId + + +newtype Price = Price { unPrice :: Double } + deriving (Eq, Ord, Show, ToHttpApiData) + + +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 + + +newtype Size = Size { unSize :: Double } + deriving (Eq, Ord, Show, ToHttpApiData) + + +instance ToJSON Size where + toJSON (Size s) = A.String . pack $ printf "%.8f" s + + +instance FromJSON Size where + parseJSON = withText "size" $ \t -> + return . Size . read $ unpack t + + +newtype Volume = Volume { unVolume :: Double } + deriving (Eq, Ord, Show) + + +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 + + +newtype TradeId = TradeId Int + deriving (Eq, Show) + + +deriveJSON defaultOptions { fieldLabelModifier = snakeCase } ''TradeId + + +newtype Funds = Funds { unFunds :: Double } + deriving (Eq, Ord, Show, ToHttpApiData) + + +instance ToJSON Funds where + toJSON (Funds s) = A.String . pack $ printf "%.16f" s + + +instance FromJSON Funds where + parseJSON = withText "size" $ \t -> + return . Funds . read $ unpack t + + +data OrderType = Limit | Market + deriving (Eq, Ord, Show) + + +instance ToHttpApiData OrderType where + toUrlPiece = toLower . pack . show + toQueryParam = toLower . pack . show + + +deriveJSON defaultOptions {constructorTagModifier = camelCase} ''OrderType + + +newtype CreatedAt = CreatedAt UTCTime + deriving (Eq, Show) + + +deriveJSON defaultOptions ''CreatedAt + + +filterOrderFieldName :: String -> String +filterOrderFieldName "order_type" = "type" +filterOrderFieldName s = s + + +data Candle = Candle + { time :: UTCTime + , low :: Price + , high :: Price + , open :: Price + , close :: Price + , volume :: Double + } deriving (Eq, Show) + + +instance FromJSON Candle where + parseJSON = withArray "candle" $ \a -> do + let l = V.toList a + t <- posixSecondsToUTCTime <$> parseJSON (head l) + lw <- Price <$> parseJSON (l !! 1) + h <- Price <$> parseJSON (l !! 2) + o <- Price <$> parseJSON (l !! 3) + c <- Price <$> parseJSON (l !! 4) + v <- parseJSON $ l !! 5 + return $ Candle t lw h o c v + + +data CandleGranularity = Minute | FiveMinutes | FifteenMinutes | Hour | SixHours | Day + deriving (Eq, Ord, Show) + + +instance ToHttpApiData CandleGranularity where + toUrlPiece Minute = "60" + toUrlPiece FiveMinutes = "300" + toUrlPiece FifteenMinutes = "900" + toUrlPiece Hour = "3600" + toUrlPiece SixHours = "21600" + toUrlPiece Day = "86400" + + toQueryParam Minute = "60" + toQueryParam FiveMinutes = "300" + toQueryParam FifteenMinutes = "900" + toQueryParam Hour = "3600" + toQueryParam SixHours = "21600" + toQueryParam Day = "86400" + + +data TwentyFourHourStats = TwentyFourHourStats + { open24 :: Price + , high24 :: Price + , low24 :: Price + , volume24 :: Volume + , last24 :: Price + , volume30 :: Volume + } deriving (Eq, Show) + + +deriveJSON defaultOptions { fieldLabelModifier = init . init } ''TwentyFourHourStats diff --git a/src/lib/CoinbasePro/Unauthenticated.hs b/src/lib/CoinbasePro/Unauthenticated.hs new file mode 100644 --- /dev/null +++ b/src/lib/CoinbasePro/Unauthenticated.hs @@ -0,0 +1,63 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeOperators #-} + +module CoinbasePro.Unauthenticated + ( products + , time + , aggregateOrderBook + , fullOrderBook + , trades + , candles + , stats + ) where + +import Data.Time.Clock (UTCTime) + +import CoinbasePro.Headers (userAgent) +import CoinbasePro.MarketData.AggregateOrderBook (AggregateOrderBook) +import CoinbasePro.MarketData.FullOrderBook (FullOrderBook) +import CoinbasePro.MarketData.Types (AggregateBookLevel (..), + CBTime, + FullBookLevel (..), + Product, Trade) +import CoinbasePro.Request (run) +import CoinbasePro.Types (Candle, + CandleGranularity, + ProductId, + TwentyFourHourStats) +import qualified CoinbasePro.Unauthenticated.API as API + + +-- | https://docs.pro.coinbase.com/#get-products +products :: IO [Product] +products = run $ API.products userAgent + + +-- | https://docs.pro.coinbase.com/#time +time :: IO CBTime +time = run $ API.time userAgent + + +-- | https://docs.pro.coinbase.com/#get-product-order-book +aggregateOrderBook :: ProductId -> Maybe AggregateBookLevel -> IO AggregateOrderBook +aggregateOrderBook prid agg = run $ API.aggregateOrderBook prid agg userAgent + + +-- | https://docs.pro.coinbase.com/#get-product-order-book +fullOrderBook :: ProductId -> IO FullOrderBook +fullOrderBook prid = run $ API.fullOrderBook prid (Just FullBookLevel) userAgent + + +-- | https://docs.pro.coinbase.com/#get-trades +trades :: ProductId -> IO [Trade] +trades prid = run $ API.trades prid userAgent + + +-- | https://docs.pro.coinbase.com/#get-historic-rates +candles :: ProductId -> Maybe UTCTime -> Maybe UTCTime -> CandleGranularity -> IO [Candle] +candles prid start end cg = run $ API.candles prid start end cg userAgent + + +-- | https://docs.pro.coinbase.com/#get-24hr-stats +stats :: ProductId -> IO TwentyFourHourStats +stats prid = run $ API.stats prid userAgent diff --git a/src/lib/CoinbasePro/Unauthenticated/API.hs b/src/lib/CoinbasePro/Unauthenticated/API.hs new file mode 100644 --- /dev/null +++ b/src/lib/CoinbasePro/Unauthenticated/API.hs @@ -0,0 +1,89 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeOperators #-} + +module CoinbasePro.Unauthenticated.API + ( products + , aggregateOrderBook + , fullOrderBook + , trades + , candles + , stats + , time + ) where + +import Data.Proxy (Proxy (..)) +import Data.Time.Clock (UTCTime) +import Servant.API ((:<|>) (..), (:>), + Capture, QueryParam, + QueryParam', + Required) +import Servant.Client (client) + +import CoinbasePro.MarketData.AggregateOrderBook (AggregateOrderBook) +import CoinbasePro.MarketData.FullOrderBook (FullOrderBook) +import CoinbasePro.MarketData.Types (AggregateBookLevel (..), + CBTime, + FullBookLevel (..), + Product, Trade) +import CoinbasePro.Request (CBGet, CBRequest) +import CoinbasePro.Types (Candle, + CandleGranularity, + ProductId, + TwentyFourHourStats) + + +type Products = "products" :> CBGet [Product] + +type ProductAggregateOrderBook = "products" + :> Capture "product" ProductId + :> "book" + :> QueryParam "level" AggregateBookLevel + :> CBGet AggregateOrderBook + +type ProductFullOrderBook = "products" + :> Capture "product" ProductId + :> "book" + :> QueryParam "level" FullBookLevel + :> CBGet FullOrderBook + +type Trades = "products" + :> Capture "product" ProductId + :> "trades" + :> CBGet [Trade] + +type Candles = "products" + :> Capture "product" ProductId + :> "candles" + :> QueryParam "start" UTCTime + :> QueryParam "end" UTCTime + :> QueryParam' '[Required] "granularity" CandleGranularity + :> CBGet [Candle] + +type Stats = "products" + :> Capture "product" ProductId + :> "stats" + :> CBGet TwentyFourHourStats + +type Time = "time" :> CBGet CBTime + +type API = Products + :<|> ProductAggregateOrderBook + :<|> ProductFullOrderBook + :<|> Trades + :<|> Candles + :<|> Stats + :<|> Time + + +api :: Proxy API +api = Proxy + + +products :: CBRequest [Product] +aggregateOrderBook :: ProductId -> Maybe AggregateBookLevel -> CBRequest AggregateOrderBook +fullOrderBook :: ProductId -> Maybe FullBookLevel -> CBRequest FullOrderBook +trades :: ProductId -> CBRequest [Trade] +candles :: ProductId -> Maybe UTCTime -> Maybe UTCTime -> CandleGranularity -> CBRequest [Candle] +stats :: ProductId -> CBRequest TwentyFourHourStats +time :: CBRequest CBTime +products :<|> aggregateOrderBook :<|> fullOrderBook :<|> trades :<|> candles :<|> stats :<|> time = client api diff --git a/src/lib/CoinbasePro/WebSocketFeed.hs b/src/lib/CoinbasePro/WebSocketFeed.hs new file mode 100644 --- /dev/null +++ b/src/lib/CoinbasePro/WebSocketFeed.hs @@ -0,0 +1,38 @@ +module CoinbasePro.WebSocketFeed + ( subscribeToFeed + ) where + +import Control.Concurrent (forkIO) +import Control.Monad (forever) +import Data.Aeson (eitherDecode', encode) +import Data.Either (either) +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.Types (ProductId) +import CoinbasePro.WebSocketFeed.Channel (ChannelMessage (..)) +import CoinbasePro.WebSocketFeed.Request (ChannelName (..), + RequestMessageType (..), + WebSocketFeedRequest (..), + wsEndpoint) +import qualified CoinbasePro.WebSocketFeed.Request as WR + + +subscribeToFeed :: [ProductId] -> [ChannelName] -> IO (Streams.InputStream ChannelMessage) +subscribeToFeed prids channels = do + (is, os) <- makeChanPipe + _ <- forkIO . WU.runSecureClient wsHost wsPort "/" $ \conn -> do + WS.sendTextData conn $ encode request + forever $ parseFeed conn >>= Streams.writeTo os . Just + return is + where + wsHost = WR.host wsEndpoint + wsPort = WR.port wsEndpoint + + request = WebSocketFeedRequest Subscribe prids channels + + +parseFeed :: WS.Connection -> IO ChannelMessage +parseFeed conn = either fail return =<< (eitherDecode' <$> WS.receiveData conn :: IO (Either String ChannelMessage)) diff --git a/src/lib/CoinbasePro/WebSocketFeed/Channel.hs b/src/lib/CoinbasePro/WebSocketFeed/Channel.hs new file mode 100644 --- /dev/null +++ b/src/lib/CoinbasePro/WebSocketFeed/Channel.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE OverloadedStrings #-} + +module CoinbasePro.WebSocketFeed.Channel + ( ChannelMessage (..) + ) where + +import Data.Aeson (FromJSON (..), + Value (..), + withObject, + (.:)) + +import CoinbasePro.WebSocketFeed.Channel.Full.Activate (Activate (..)) +import CoinbasePro.WebSocketFeed.Channel.Full.Change (Change (..)) +import CoinbasePro.WebSocketFeed.Channel.Full.Done (Done (..)) +import CoinbasePro.WebSocketFeed.Channel.Full.Match (Match (..)) +import CoinbasePro.WebSocketFeed.Channel.Full.Open (Open (..)) +import CoinbasePro.WebSocketFeed.Channel.Full.Received (Received (..)) +import CoinbasePro.WebSocketFeed.Channel.Heartbeat (Heartbeat (..)) +import CoinbasePro.WebSocketFeed.Channel.Level2 (L2Update (..), + Snapshot (..)) +import qualified CoinbasePro.WebSocketFeed.Channel.Level2 as L2 +import CoinbasePro.WebSocketFeed.Channel.Ticker (Ticker (..)) +import CoinbasePro.WebSocketFeed.Response (Subscription) + +data ChannelMessage = + ActivateMessage Activate + | ChangeMessage Change + | DoneMessage Done + | HeartbeatMessage Heartbeat + | L2ChangeMessage L2.Change + | L2SnapshotMessage Snapshot + | L2UpdateMessage L2Update + | MatchMessage Match + | OpenMessage Open + | ReceivedMessage Received + | TickerMessage Ticker + | SubscriptionMessage Subscription + deriving (Show, Eq) + + +instance FromJSON ChannelMessage where + parseJSON = withObject "channel message" $ \o -> do + t <- String <$> o .: "type" + case t of + "activate" -> ActivateMessage <$> parseJSON (Object o) + "change" -> ChangeMessage <$> parseJSON (Object o) + "done" -> DoneMessage <$> parseJSON (Object o) + "heartbeat" -> HeartbeatMessage <$> parseJSON (Object o) + "l2update" -> L2UpdateMessage <$> parseJSON (Object o) + "last_match" -> MatchMessage <$> parseJSON (Object o) + "match" -> MatchMessage <$> parseJSON (Object o) + "open" -> OpenMessage <$> parseJSON (Object o) + "received" -> ReceivedMessage <$> parseJSON (Object o) + "snapshot" -> L2SnapshotMessage <$> parseJSON (Object o) + "subscriptions" -> SubscriptionMessage <$> parseJSON (Object o) + "ticker" -> TickerMessage <$> parseJSON (Object o) + _ -> fail "Unable to parse channel message" diff --git a/src/lib/CoinbasePro/WebSocketFeed/Channel/Full/Activate.hs b/src/lib/CoinbasePro/WebSocketFeed/Channel/Full/Activate.hs new file mode 100644 --- /dev/null +++ b/src/lib/CoinbasePro/WebSocketFeed/Channel/Full/Activate.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +module CoinbasePro.WebSocketFeed.Channel.Full.Activate + ( Activate (..) + ) where + +import Data.Aeson.Casing (snakeCase) +import Data.Aeson.TH (defaultOptions, deriveJSON, + fieldLabelModifier) +import Data.Text (Text) +import Data.Time.Clock (UTCTime) + +import CoinbasePro.Types (Funds, OrderId, Price, ProductId, Side, + Size) + + +type UserId = Int +type ProfileId = Text +type StopType = Text +type TakerFeeRate = Double + + +data Activate = Activate + { productId :: ProductId + , timestamp :: UTCTime + , userId :: UserId + , profileId :: ProfileId + , orderId :: OrderId + , stopType :: StopType + , side :: Side + , stopPrice :: Price + , size :: Size + , funds :: Funds + , takerFeeRate :: TakerFeeRate + , private :: Bool + } deriving (Eq, Ord, Show) + + +deriveJSON defaultOptions {fieldLabelModifier = snakeCase} ''Activate diff --git a/src/lib/CoinbasePro/WebSocketFeed/Channel/Full/Change.hs b/src/lib/CoinbasePro/WebSocketFeed/Channel/Full/Change.hs new file mode 100644 --- /dev/null +++ b/src/lib/CoinbasePro/WebSocketFeed/Channel/Full/Change.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +module CoinbasePro.WebSocketFeed.Channel.Full.Change + ( Change (..) + ) where + +import Data.Aeson.Casing (snakeCase) +import Data.Aeson.TH (defaultOptions, deriveJSON, + fieldLabelModifier) +import Data.Time.Clock (UTCTime) + +import CoinbasePro.Types (Funds, OrderId, Price, ProductId, Sequence, + Side, Size) + + +data Change = Change + { time :: UTCTime + , sequence :: Sequence + , orderId :: OrderId + , productId :: ProductId + , newSize :: Maybe Size + , oldSize :: Maybe Size + , newFunds :: Maybe Funds + , oldFunds :: Maybe Funds + , price :: Maybe Price + , side :: Side + } deriving (Eq, Ord, Show) + + +deriveJSON defaultOptions {fieldLabelModifier = snakeCase} ''Change diff --git a/src/lib/CoinbasePro/WebSocketFeed/Channel/Full/Done.hs b/src/lib/CoinbasePro/WebSocketFeed/Channel/Full/Done.hs new file mode 100644 --- /dev/null +++ b/src/lib/CoinbasePro/WebSocketFeed/Channel/Full/Done.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +module CoinbasePro.WebSocketFeed.Channel.Full.Done + ( Done (..) + ) where + +import Data.Aeson (FromJSON, parseJSON) +import Data.Aeson.Casing (snakeCase) +import Data.Aeson.TH (defaultOptions, deriveJSON, + fieldLabelModifier) +import Data.Text (Text) +import Data.Time.Clock (UTCTime) + +import CoinbasePro.Types (OrderId, Price, ProductId, Sequence, Side, + Size) + + +type Reason = Text + +newtype RemainingSize = RemainingSize { unRemainingSize :: Maybe Size } + deriving (Eq, Ord, Show) + + +instance FromJSON RemainingSize where + parseJSON = (RemainingSize <$>) . parseJSON + + +data Done = Done + { time :: UTCTime + , productId :: ProductId + , sequence :: Sequence + , price :: Maybe Price + , orderId :: OrderId + , reason :: Reason + , side :: Side + , remainingSize :: Maybe Size + } deriving (Eq, Ord, Show) + + +deriveJSON defaultOptions {fieldLabelModifier = snakeCase} ''Done diff --git a/src/lib/CoinbasePro/WebSocketFeed/Channel/Full/Match.hs b/src/lib/CoinbasePro/WebSocketFeed/Channel/Full/Match.hs new file mode 100644 --- /dev/null +++ b/src/lib/CoinbasePro/WebSocketFeed/Channel/Full/Match.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +module CoinbasePro.WebSocketFeed.Channel.Full.Match + ( Match (..) + ) where + +import Data.Aeson.Casing (snakeCase) +import Data.Aeson.TH (defaultOptions, deriveJSON, + fieldLabelModifier) +import Data.Time.Clock (UTCTime) + +import CoinbasePro.Types (OrderId, Price, ProductId, Sequence, Side, + Size) + + +type TradeId = Int + + +data Match = Match + { tradeId :: TradeId + , sequence :: Sequence + , makerOrderId :: OrderId + , takerOrderId :: OrderId + , time :: UTCTime + , productId :: ProductId + , size :: Size + , price :: Price + , side :: Side + } deriving (Eq, Ord, Show) + + +deriveJSON defaultOptions {fieldLabelModifier = snakeCase} ''Match diff --git a/src/lib/CoinbasePro/WebSocketFeed/Channel/Full/Open.hs b/src/lib/CoinbasePro/WebSocketFeed/Channel/Full/Open.hs new file mode 100644 --- /dev/null +++ b/src/lib/CoinbasePro/WebSocketFeed/Channel/Full/Open.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +module CoinbasePro.WebSocketFeed.Channel.Full.Open + ( Open (..) + ) where + +import Data.Aeson.Casing (snakeCase) +import Data.Aeson.TH (defaultOptions, deriveJSON, + fieldLabelModifier) +import Data.Time.Clock (UTCTime) + +import CoinbasePro.Types (OrderId, Price, ProductId, Sequence, Side, + Size) + + +data Open = Open + { time :: UTCTime + , productId :: ProductId + , sequence :: Sequence + , orderId :: OrderId + , price :: Price + , remainingSize :: Maybe Size + , side :: Side + } deriving (Eq, Ord, Show) + + +deriveJSON defaultOptions {fieldLabelModifier = snakeCase} ''Open diff --git a/src/lib/CoinbasePro/WebSocketFeed/Channel/Full/Received.hs b/src/lib/CoinbasePro/WebSocketFeed/Channel/Full/Received.hs new file mode 100644 --- /dev/null +++ b/src/lib/CoinbasePro/WebSocketFeed/Channel/Full/Received.hs @@ -0,0 +1,30 @@ +{-# 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.Time.Clock (UTCTime) + +import CoinbasePro.Types (Funds, OrderId, OrderType, Price, ProductId, + Sequence, Side, Size) + + +data Received = Received + { time :: UTCTime + , productId :: ProductId + , sequence :: Sequence + , orderId :: OrderId + , size :: Maybe Size + , price :: Maybe Price + , funds :: Maybe Funds + , side :: Side + , orderType :: OrderType + } deriving (Eq, Ord, Show) + + +deriveJSON defaultOptions {fieldLabelModifier = snakeCase} ''Received diff --git a/src/lib/CoinbasePro/WebSocketFeed/Channel/Heartbeat.hs b/src/lib/CoinbasePro/WebSocketFeed/Channel/Heartbeat.hs new file mode 100644 --- /dev/null +++ b/src/lib/CoinbasePro/WebSocketFeed/Channel/Heartbeat.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE OverloadedStrings #-} + +module CoinbasePro.WebSocketFeed.Channel.Heartbeat + ( Heartbeat (..) + )where + +import Data.Aeson (FromJSON (..), withObject, (.:)) +import Data.Text (Text) +import Data.Time.Clock (UTCTime) + + +data Heartbeat = Heartbeat + { sequence :: Int + , lastTradeId :: Int + , productId :: Text + , time :: UTCTime + } deriving (Eq, Ord, Show) + + +instance FromJSON Heartbeat where + parseJSON = withObject "heartbeat" $ \o -> + Heartbeat <$> + o .: "sequence" <*> + o .: "last_trade_id" <*> + o .: "product_id" <*> + o .: "time" diff --git a/src/lib/CoinbasePro/WebSocketFeed/Channel/Level2.hs b/src/lib/CoinbasePro/WebSocketFeed/Channel/Level2.hs new file mode 100644 --- /dev/null +++ b/src/lib/CoinbasePro/WebSocketFeed/Channel/Level2.hs @@ -0,0 +1,70 @@ +{-# LANGUAGE OverloadedStrings #-} + +module CoinbasePro.WebSocketFeed.Channel.Level2 + ( Snapshot (..) + , SnapshotLevel (..) + , Change (..) + , L2Update(..) + ) where + +import Data.Aeson (FromJSON (..), withArray, withObject, (.:)) +import Data.Text (Text) +import qualified Data.Vector as V + + +data SnapshotLevel = SnapshotLevel + { price :: Double + , size :: Double + } deriving (Eq, Ord, Show) + + +instance FromJSON SnapshotLevel where + parseJSON = withArray "snapshot level" $ \a -> do + let l = V.toList a + p <- parseJSON $ head l + sz <- parseJSON $ l !! 1 + return $ SnapshotLevel (read p) (read sz) + + +data Snapshot = Snapshot + { sProductId :: Text + , bids :: [SnapshotLevel] + , asks :: [SnapshotLevel] + } deriving (Eq, Ord, Show) + + +instance FromJSON Snapshot where + parseJSON = withObject "snapshot" $ \o -> + Snapshot <$> + o .: "product_id" <*> + o .: "bids" <*> + o .: "asks" + + +data Change = Change + { side :: Text + , cPrice :: Double + , cSize :: Double + } deriving (Eq, Ord, Show) + + +instance FromJSON Change where + parseJSON = withArray "change" $ \a -> do + let l = V.toList a + sd <- parseJSON $ head l + p <- parseJSON $ l !! 1 + sz <- parseJSON $ l !! 2 + return $ Change sd (read p) (read sz) + + +data L2Update = L2Update + { l2ProductId :: Text + , changes :: [Change] + } deriving (Eq, Ord, Show) + + +instance FromJSON L2Update where + parseJSON = withObject "l2update" $ \o -> + L2Update <$> + o .: "product_id" <*> + o .: "changes" diff --git a/src/lib/CoinbasePro/WebSocketFeed/Channel/Ticker.hs b/src/lib/CoinbasePro/WebSocketFeed/Channel/Ticker.hs new file mode 100644 --- /dev/null +++ b/src/lib/CoinbasePro/WebSocketFeed/Channel/Ticker.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +module CoinbasePro.WebSocketFeed.Channel.Ticker + ( Ticker (..) + ) where + +import Data.Aeson.Casing (snakeCase) +import Data.Aeson.TH (defaultOptions, deriveJSON, + fieldLabelModifier) +import Data.Time.Clock (UTCTime) + +import CoinbasePro.Types (Price, ProductId, Sequence, Side, Size) + + +data Ticker = Ticker + { tradeId :: Maybe Int + , sequence :: Sequence + , time :: Maybe UTCTime + , productId :: ProductId + , price :: Price + , side :: Maybe Side + , lastSize :: Maybe Size + , bestBid :: Price + , bestAsk :: Price + } deriving (Eq, Ord, Show) + + +deriveJSON defaultOptions {fieldLabelModifier = snakeCase} ''Ticker diff --git a/src/lib/CoinbasePro/WebSocketFeed/Request.hs b/src/lib/CoinbasePro/WebSocketFeed/Request.hs new file mode 100644 --- /dev/null +++ b/src/lib/CoinbasePro/WebSocketFeed/Request.hs @@ -0,0 +1,85 @@ +{-# LANGUAGE OverloadedStrings #-} + +module CoinbasePro.WebSocketFeed.Request + ( WSConnection (..) + , RequestMessageType (..) + , ChannelName(..) + , WebSocketFeedRequest (..) + + , wsEndpoint + ) 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) + + +wsEndpoint :: WSConnection +wsEndpoint = WSConnection h p + where + h = "ws-feed.pro.coinbase.com" + p = 443 + + +data RequestMessageType = Subscribe | Unsubscribe + deriving (Eq, Ord) + + +instance Show RequestMessageType where + show Subscribe = "subscribe" + show Unsubscribe = "unsubscribe" + + +data ChannelName = Heartbeat | Ticker | Level2 | Matches | Full + deriving (Eq, Ord) + + +instance Show ChannelName where + show Heartbeat = "heartbeat" + show Ticker = "ticker" + show Level2 = "level2" + show Matches = "matches" + show Full = "full" + + +instance ToJSON ChannelName where + toJSON Heartbeat = toJSON $ show Heartbeat + toJSON Ticker = toJSON $ show Ticker + toJSON Level2 = toJSON $ show Level2 + toJSON Matches = toJSON $ show Matches + toJSON Full = toJSON $ show Full + + +instance FromJSON ChannelName where + parseJSON = withText "channel name" $ \t -> + case t of + "heartbeat" -> return Heartbeat + "ticker" -> return Ticker + "level2" -> return Level2 + "matches" -> return Matches + "full" -> return Full + _ -> fail "Unable to parse channel" + + +data WebSocketFeedRequest = WebSocketFeedRequest + { reqMsgType :: RequestMessageType + , reqProductIds :: [ProductId] + , reqChannels :: [ChannelName] + } deriving (Eq, Ord, Show) + + +instance ToJSON WebSocketFeedRequest where + toJSON (WebSocketFeedRequest rmt rpi rc) = object + [ "type" .= show rmt + , "product_ids" .= rpi + , "channels" .= rc + ] diff --git a/src/lib/CoinbasePro/WebSocketFeed/Response.hs b/src/lib/CoinbasePro/WebSocketFeed/Response.hs new file mode 100644 --- /dev/null +++ b/src/lib/CoinbasePro/WebSocketFeed/Response.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE OverloadedStrings #-} + +module CoinbasePro.WebSocketFeed.Response + ( ResponseMessageType(..) + , ResponseChannel(..) + , Subscription (..) + ) where + + +import Data.Aeson (FromJSON (..), withObject, + withText, (.:)) +import Data.Aeson.Types (typeMismatch) +import Data.Text (Text) + +import CoinbasePro.WebSocketFeed.Request (ChannelName (..)) + + +data ResponseMessageType = Subscriptions + deriving (Eq, Ord) + + +instance Show ResponseMessageType where + show Subscriptions = "subscriptions" + + +instance FromJSON ResponseMessageType where + parseJSON v = withText "response message type" (\t -> + case t of + "subscriptions" -> return Subscriptions + _ -> typeMismatch "response message type" v) v + + +data ResponseChannel = ResponseChannel + { respChanName :: ChannelName + , respChanProductIds :: [Text] + } deriving (Eq, Ord, Show) + + +instance FromJSON ResponseChannel where + parseJSON = withObject "response channel" $ \o -> + ResponseChannel <$> + o .: "name" <*> + o .: "product_ids" + + +data Subscription = Subscription + { respMsgType :: ResponseMessageType + , respChannels :: [ResponseChannel] + } deriving (Eq, Ord, Show) + + +instance FromJSON Subscription where + parseJSON = withObject "subscription" $ \o -> + Subscription <$> + o .: "type" <*> + o .: "channels"