diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2015 Andrew Rademacher + +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/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-exchange.cabal b/coinbase-exchange.cabal new file mode 100644 --- /dev/null +++ b/coinbase-exchange.cabal @@ -0,0 +1,106 @@ +name: coinbase-exchange +version: 0.1.0.0 +synopsis: Connector library for the coinbase exchange. +description: Access library for the coinbase exchange. Allows the use + of both the public market data API as well as the private + account data API. Additionally provides types to connect + to the streaming API via a websocket. +license: MIT +license-file: LICENSE +author: Andrew Rademacher +maintainer: andrewrademacher@gmail.com +category: Web +build-type: Simple +cabal-version: >=1.10 + +library + hs-source-dirs: src + default-language: Haskell2010 + + exposed-modules: Coinbase.Exchange.MarketData + , Coinbase.Exchange.Private + , Coinbase.Exchange.Socket + , Coinbase.Exchange.Types.Core + , Coinbase.Exchange.Types.MarketData + , Coinbase.Exchange.Types.Private + , Coinbase.Exchange.Types.Socket + , Coinbase.Exchange.Types + + other-modules: Coinbase.Exchange.Rest + + build-depends: base ==4.7.* + , mtl ==2.2.* + , resourcet ==1.1.* + , transformers-base ==0.4.* + , conduit ==1.2.* + , conduit-extra ==1.1.* + , http-conduit ==2.1.* + , aeson ==0.8.* + , aeson-casing ==0.1.* + , http-types ==0.8.* + , text ==1.2.* + , bytestring ==0.10.* + , base64-bytestring ==1.0.* + , time ==1.4.* + , scientific ==0.3.* + , uuid ==1.3.* + , uuid-aeson ==0.1.* + , vector ==0.10.* + , hashable ==1.2.* + , deepseq ==1.3.* + , network ==2.6.* + , websockets ==0.9.* + , wuss ==1.0.* + , cryptohash ==0.11.* + , byteable ==0.1.* + + , old-locale + +executable sandbox + main-is: Main.hs + hs-source-dirs: sbox + default-language: Haskell2010 + + build-depends: base ==4.7.* + , http-client ==0.4.* + , http-client-tls ==0.2.* + + , uuid + , text + , aeson + , bytestring + , time + , old-locale + , conduit + , conduit-extra + , http-conduit + , resourcet + , websockets + , transformers + , network + , wuss + , scientific + + , coinbase-exchange + +test-suite test-coinbase + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: test + default-language: Haskell2010 + + build-depends: base ==4.7.* + , tasty ==0.10.* + , tasty-th ==0.1.* + , tasty-quickcheck ==0.8.* + , tasty-hunit ==0.9.* + + , uuid + , bytestring + , time + , old-locale + , http-client-tls + , http-conduit + , transformers + + , coinbase-exchange diff --git a/sbox/Main.hs b/sbox/Main.hs new file mode 100644 --- /dev/null +++ b/sbox/Main.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import Control.Concurrent +import Control.Monad +import Data.Aeson +import qualified Data.ByteString.Char8 as CBS +import Data.Maybe +import Data.Time +import Data.UUID +import Network.HTTP.Client +import Network.HTTP.Client.TLS +import qualified Network.WebSockets as WS +import System.Environment +import System.Locale + +import Coinbase.Exchange.MarketData +import Coinbase.Exchange.Private +import Coinbase.Exchange.Socket +import Coinbase.Exchange.Types +import Coinbase.Exchange.Types.Core +import Coinbase.Exchange.Types.Private +import Coinbase.Exchange.Types.Socket + +main :: IO () +main = putStrLn "Use GHCi." + +testCoinbaseTime :: String +testCoinbaseTime = "2015-05-06 21:58:22.84227+0000" + +btc :: ProductId +btc = "BTC-USD" + +start :: Maybe UTCTime +start = Just $ readTime defaultTimeLocale "%FT%X%z" "2015-04-12T20:22:37+0000" + +end :: Maybe UTCTime +end = Just $ readTime defaultTimeLocale "%FT%X%z" "2015-04-23T20:22:37+0000" + +accountId :: AccountId +accountId = AccountId $ fromJust $ fromString "52072cbb-4e76-496f-a479-166cb4d177fa" + +withCoinbase :: Exchange a -> IO a +withCoinbase act = do + mgr <- newManager tlsManagerSettings + tKey <- liftM CBS.pack $ getEnv "COINBASE_KEY" + tSecret <- liftM CBS.pack $ getEnv "COINBASE_SECRET" + tPass <- liftM CBS.pack $ getEnv "COINBASE_PASSPHRASE" + + case mkToken tKey tSecret tPass of + Right tok -> do res <- runExchange (ExchangeConf mgr (Just tok) Sandbox) act + case res of + Right s -> return s + Left f -> error $ show f + Left er -> error $ show er + +printSocket :: IO () +printSocket = subscribe Live btc $ \conn -> do + putStrLn "Connected." + _ <- forkIO $ forever $ do + ds <- WS.receiveData conn + let res = eitherDecode ds + case res :: Either String ExchangeMessage of + Left er -> print er + Right v -> print v + _ <- forever $ threadDelay (1000000 * 60) + return () diff --git a/src/Coinbase/Exchange/MarketData.hs b/src/Coinbase/Exchange/MarketData.hs new file mode 100644 --- /dev/null +++ b/src/Coinbase/Exchange/MarketData.hs @@ -0,0 +1,113 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} + +module Coinbase.Exchange.MarketData + ( getProducts + , getTopOfBook + , getTop50OfBook + , getOrderBook + + , getProductTicker + , getTrades + , getHistory + , getStats + + , getCurrencies + , getExchangeTime + + , module Coinbase.Exchange.Types.MarketData + ) where + +import Control.Monad.Except +import Control.Monad.Reader +import Control.Monad.Trans.Resource +import Data.List +import qualified Data.Text as T +import Data.Time +import Data.UUID.Aeson () + +#if MIN_VERSION_time(1,5,0) +import Data.Time.Format (defaultTimeLocale) +#else +import System.Locale (defaultTimeLocale) +#endif + +import Coinbase.Exchange.Rest +import Coinbase.Exchange.Types +import Coinbase.Exchange.Types.Core +import Coinbase.Exchange.Types.MarketData + +-- Products + +getProducts :: (MonadResource m, MonadReader ExchangeConf m, MonadError ExchangeFailure m) + => m [Product] +getProducts = coinbaseGet False "/products" voidBody + +-- Order Book + +getTopOfBook :: (MonadResource m, MonadReader ExchangeConf m, MonadError ExchangeFailure m) + => ProductId -> m (Book Aggregate) +getTopOfBook (ProductId p) = coinbaseGet False ("/products/" ++ T.unpack p ++ "/book?level=1") voidBody + +getTop50OfBook :: (MonadResource m, MonadReader ExchangeConf m, MonadError ExchangeFailure m) + => ProductId -> m (Book Aggregate) +getTop50OfBook (ProductId p) = coinbaseGet False ("/products/" ++ T.unpack p ++ "/book?level=2") voidBody + +getOrderBook :: (MonadResource m, MonadReader ExchangeConf m, MonadError ExchangeFailure m) + => ProductId -> m (Book OrderId) +getOrderBook (ProductId p) = coinbaseGet False ("/products/" ++ T.unpack p ++ "/book?level=3") voidBody + +-- Product Ticker + +getProductTicker :: (MonadResource m, MonadReader ExchangeConf m, MonadError ExchangeFailure m) + => ProductId -> m Tick +getProductTicker (ProductId p) = coinbaseGet False ("/products/" ++ T.unpack p ++ "/ticker") voidBody + +-- Product Trades + +-- | Currently Broken: coinbase api doesn't return valid ISO 8601 dates for this route. +getTrades :: (MonadResource m, MonadReader ExchangeConf m, MonadError ExchangeFailure m) + => ProductId -> m [Trade] +getTrades (ProductId p) = coinbaseGet False ("/products/" ++ T.unpack p ++ "/trades") voidBody + +-- Historic Rates (Candles) + +type StartTime = UTCTime +type EndTime = UTCTime +type Scale = Int + +getHistory :: (MonadResource m, MonadReader ExchangeConf m, MonadError ExchangeFailure m) + => ProductId -> Maybe StartTime -> Maybe EndTime -> Maybe Scale -> m [Candle] +getHistory (ProductId p) start end scale = coinbaseGet False path voidBody + where path = "/products/" ++ T.unpack p ++ "/candles?" ++ params + params = intercalate "&" $ map (\(k, v) -> k ++ "=" ++ v) $ start' ++ end' ++ scale' + start' = case start of Nothing -> [] + Just t -> [( "start", fmt t)] + end' = case end of Nothing -> [] + Just t -> [( "end", fmt t)] + scale' = case scale of Nothing -> [] + Just s -> [("granularity", show s)] + fmt t = let t' = formatTime defaultTimeLocale "%FT%T." t + in t' ++ take 6 (formatTime defaultTimeLocale "%q" t) ++ "Z" + +-- Product Stats + +getStats :: (MonadResource m, MonadReader ExchangeConf m, MonadError ExchangeFailure m) + => ProductId -> m Stats +getStats (ProductId p) = coinbaseGet False ("/products/" ++ T.unpack p ++ "/stats") voidBody + +-- Exchange Currencies + +getCurrencies :: (MonadResource m, MonadReader ExchangeConf m, MonadError ExchangeFailure m) + => m [Currency] +getCurrencies = coinbaseGet False "/currencies" voidBody + +-- Exchange Time + +getExchangeTime :: (MonadResource m, MonadReader ExchangeConf m, MonadError ExchangeFailure m) + => m ExchangeTime +getExchangeTime = coinbaseGet False "/time" voidBody diff --git a/src/Coinbase/Exchange/Private.hs b/src/Coinbase/Exchange/Private.hs new file mode 100644 --- /dev/null +++ b/src/Coinbase/Exchange/Private.hs @@ -0,0 +1,88 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} + +module Coinbase.Exchange.Private + ( getAccountList + , getAccount + , getAccountLedger + , getAccountHolds + + , createOrder + , cancelOrder + , getOrderList + , getOrder + + , getFills + + , createTransfer + + , module Coinbase.Exchange.Types.Private + ) where + +import Control.Monad.Except +import Control.Monad.Reader +import Control.Monad.Trans.Resource +import Data.Char +import Data.List +import qualified Data.Text as T +import Data.UUID + +import Coinbase.Exchange.Rest +import Coinbase.Exchange.Types +import Coinbase.Exchange.Types.Core +import Coinbase.Exchange.Types.Private + +-- Accounts + +getAccountList :: (MonadResource m, MonadReader ExchangeConf m, MonadError ExchangeFailure m) + => m [Account] +getAccountList = coinbaseGet True "/accounts" voidBody + +getAccount :: (MonadResource m, MonadReader ExchangeConf m, MonadError ExchangeFailure m) + => AccountId -> m Account +getAccount (AccountId i) = coinbaseGet True ("/accounts/" ++ toString i) voidBody + +getAccountLedger :: (MonadResource m, MonadReader ExchangeConf m, MonadError ExchangeFailure m) + => AccountId -> m [Entry] +getAccountLedger (AccountId i) = coinbaseGet True ("/accounts/" ++ toString i ++ "/ledger") voidBody + +getAccountHolds :: (MonadResource m, MonadReader ExchangeConf m, MonadError ExchangeFailure m) + => AccountId -> m [Hold] +getAccountHolds (AccountId i) = coinbaseGet True ("/accounts/" ++ toString i ++ "/holds") voidBody + +-- Orders + +createOrder :: (MonadResource m, MonadReader ExchangeConf m, MonadError ExchangeFailure m) + => NewOrder -> m OrderId +createOrder = liftM ocId . coinbasePost True "/orders" . Just + +cancelOrder :: (MonadResource m, MonadReader ExchangeConf m, MonadError ExchangeFailure m) + => OrderId -> m () +cancelOrder (OrderId o) = coinbaseDelete True ("/orders/" ++ toString o) voidBody + +getOrderList :: (MonadResource m, MonadReader ExchangeConf m, MonadError ExchangeFailure m) + => [OrderStatus] -> m [Order] +getOrderList os = coinbaseGet True ("/orders?" ++ query os) voidBody + where query [] = "status=all" + query xs = intercalate "&" $ map (\x -> "status=" ++ map toLower (show x)) xs + +getOrder :: (MonadResource m, MonadReader ExchangeConf m, MonadError ExchangeFailure m) + => OrderId -> m Order +getOrder (OrderId o) = coinbaseGet True ("/orders/" ++ toString o) voidBody + +-- Fills + +getFills :: (MonadResource m, MonadReader ExchangeConf m, MonadError ExchangeFailure m) + => Maybe OrderId -> Maybe ProductId -> m [Fill] +getFills moid mpid = coinbaseGet True ("/fills?" ++ oid ++ "&" ++ pid) voidBody + where oid = case moid of Just v -> "order_id=" ++ toString (unOrderId v) + Nothing -> "" + pid = case mpid of Just v -> "product_id=" ++ T.unpack (unProductId v) + Nothing -> "" + +-- Transfers + +createTransfer :: (MonadResource m, MonadReader ExchangeConf m, MonadError ExchangeFailure m) + => Transfer -> m () +createTransfer = coinbasePost True "/transfers" . Just diff --git a/src/Coinbase/Exchange/Rest.hs b/src/Coinbase/Exchange/Rest.hs new file mode 100644 --- /dev/null +++ b/src/Coinbase/Exchange/Rest.hs @@ -0,0 +1,140 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} + +module Coinbase.Exchange.Rest + ( coinbaseGet + , coinbasePost + , coinbaseDelete + , voidBody + ) where + +import Control.Monad.Except +import Control.Monad.Reader +import Control.Monad.Trans.Resource +import Crypto.Hash +import Data.Aeson +import Data.Byteable +import qualified Data.ByteString as BS +import qualified Data.ByteString.Base64 as Base64 +import qualified Data.ByteString.Char8 as CBS +import qualified Data.ByteString.Lazy as LBS +import Data.Conduit +import Data.Conduit.Attoparsec (sinkParser) +import qualified Data.Conduit.Binary as CB +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import Data.Time +import Data.Time.Clock.POSIX +import Network.HTTP.Conduit +import Network.HTTP.Types +import Text.Printf + +import Coinbase.Exchange.Types + +type Signed = Bool + +voidBody :: Maybe () +voidBody = Nothing + +coinbaseGet :: ( ToJSON a + , FromJSON b + , MonadResource m + , MonadReader ExchangeConf m + , MonadError ExchangeFailure m ) + => Signed -> Path -> Maybe a -> m b +coinbaseGet sgn p ma = coinbaseRequest "GET" sgn p ma >>= processResponse + +coinbasePost :: ( ToJSON a + , FromJSON b + , MonadResource m + , MonadReader ExchangeConf m + , MonadError ExchangeFailure m ) + => Signed -> Path -> Maybe a -> m b +coinbasePost sgn p ma = coinbaseRequest "POST" sgn p ma >>= processResponse + +coinbaseDelete :: ( ToJSON a + , MonadResource m + , MonadReader ExchangeConf m + , MonadError ExchangeFailure m ) + => Signed -> Path -> Maybe a -> m () +coinbaseDelete sgn p ma = coinbaseRequest "DELETE" sgn p ma >>= processEmpty + +coinbaseRequest :: ( ToJSON a + , MonadResource m + , MonadReader ExchangeConf m + , MonadError ExchangeFailure m ) + => Method -> Signed -> Path -> Maybe a -> m (Response (ResumableSource m BS.ByteString)) +coinbaseRequest meth sgn p ma = do + conf <- ask + req <- case apiType conf of + Sandbox -> parseUrl $ sandboxRest ++ p + Live -> parseUrl $ liveRest ++ p + let req' = req { method = meth + , requestHeaders = [ ("user-agent", "haskell") + , ("accept", "application/json") + ] + } + + flip http (manager conf) =<< signMessage sgn meth p + =<< encodeBody ma req' + +encodeBody :: (ToJSON a, Monad m) + => Maybe a -> Request -> m Request +encodeBody (Just a) req = return req + { requestHeaders = requestHeaders req ++ + [ ("content-type", "application/json") ] + , requestBody = RequestBodyBS $ LBS.toStrict $ encode a + } +encodeBody Nothing req = return req + +signMessage :: (MonadIO m, MonadReader ExchangeConf m, MonadError ExchangeFailure m) + => Signed -> Method -> Path -> Request -> m Request +signMessage True meth p req = do + conf <- ask + case authToken conf of + Just tok -> do time <- liftM (realToFrac . utcTimeToPOSIXSeconds) (liftIO getCurrentTime) + >>= \t -> return . CBS.pack $ printf "%.0f" (t::Double) + rBody <- pullBody $ requestBody req + let presign = CBS.concat [time, meth, CBS.pack p, rBody] + sign = toBytes (hmac (secret tok) presign :: HMAC SHA256) + return req + { requestBody = RequestBodyBS rBody + , requestHeaders = requestHeaders req ++ + [ ("cb-access-key", key tok) + , ("cb-access-sign", Base64.encode sign) + , ("cb-access-timestamp", time) + , ("cb-access-passphrase", passphrase tok) + ] + } + Nothing -> throwError $ AuthenticationRequiredFailure $ T.pack p + where pullBody (RequestBodyBS b) = return b + pullBody (RequestBodyLBS b) = return $ LBS.toStrict b + pullBody _ = throwError AuthenticationRequiresByteStrings +signMessage False _ _ req = return req + +-- + +processResponse :: ( FromJSON b + , MonadResource m + , MonadReader ExchangeConf m + , MonadError ExchangeFailure m ) + => Response (ResumableSource m BS.ByteString) -> m b +processResponse res = + case responseStatus res of + s | s == status200 -> do body <- responseBody res $$+- sinkParser (fmap fromJSON json) + case body of + Success b -> return b + Error er -> throwError $ ParseFailure $ T.pack er + | otherwise -> do body <- responseBody res $$+- CB.sinkLbs + throwError $ ApiFailure $ T.decodeUtf8 $ LBS.toStrict body + +processEmpty :: ( MonadResource m + , MonadReader ExchangeConf m + , MonadError ExchangeFailure m ) + => Response (ResumableSource m BS.ByteString) -> m () +processEmpty res = + case responseStatus res of + s | s == status200 -> return () + | otherwise -> do body <- responseBody res $$+- CB.sinkLbs + throwError $ ApiFailure $ T.decodeUtf8 $ LBS.toStrict body diff --git a/src/Coinbase/Exchange/Socket.hs b/src/Coinbase/Exchange/Socket.hs new file mode 100644 --- /dev/null +++ b/src/Coinbase/Exchange/Socket.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Coinbase.Exchange.Socket + ( subscribe + , module Coinbase.Exchange.Types.Socket + ) where + +import Data.Aeson +import Network.Socket +import qualified Network.WebSockets as WS +import Wuss + +import Coinbase.Exchange.Types +import Coinbase.Exchange.Types.Core +import Coinbase.Exchange.Types.Socket + +subscribe :: ApiType -> ProductId -> WS.ClientApp () -> IO () +subscribe atype pid app = withSocketsDo $ + runSecureClient location 443 "/" $ \conn -> do + WS.sendBinaryData conn $ encode (Subscribe pid) + app conn + where location = case atype of Sandbox -> sandboxSocket + Live -> liveSocket diff --git a/src/Coinbase/Exchange/Types.hs b/src/Coinbase/Exchange/Types.hs new file mode 100644 --- /dev/null +++ b/src/Coinbase/Exchange/Types.hs @@ -0,0 +1,128 @@ +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE UndecidableInstances #-} + +module Coinbase.Exchange.Types + ( ApiType (..) + , Endpoint + , Path + + , website + , sandboxRest + , sandboxSocket + , liveRest + , liveSocket + + , Key + , Secret + , Passphrase + + , Token + , key + , secret + , passphrase + , mkToken + + , ExchangeConf (..) + , ExchangeFailure (..) + + , Exchange + , ExceptT + , runExchange + , runExchangeT + + , getManager + ) where + +import Control.Applicative +import Control.Monad.Base +import Control.Monad.Except +import Control.Monad.Reader +import Control.Monad.Trans.Resource +import Data.ByteString +import qualified Data.ByteString.Base64 as Base64 +import Data.Text (Text) +import Network.HTTP.Conduit + +-- API URLs + +data ApiType + = Sandbox + | Live + deriving (Show) + +type Endpoint = String +type Path = String + +website :: Endpoint +website = "https://public.sandbox.exchange.coinbase.com" + +sandboxRest :: Endpoint +sandboxRest = "https://api-public.sandbox.exchange.coinbase.com" + +sandboxSocket :: Endpoint +sandboxSocket = "ws-feed-public.sandbox.exchange.coinbase.com" + +liveRest :: Endpoint +liveRest = "https://api.exchange.coinbase.com" + +liveSocket :: Endpoint +liveSocket = "ws-feed.exchange.coinbase.com" + +-- Monad Stack + +type Key = ByteString +type Secret = ByteString +type Passphrase = ByteString + +data Token + = Token + { key :: ByteString + , secret :: ByteString + , passphrase :: ByteString + } + +mkToken :: Key -> Secret -> Passphrase -> Either String Token +mkToken k s p = case Base64.decode s of + Right s' -> Right $ Token k s' p + Left e -> Left e + +data ExchangeConf + = ExchangeConf + { manager :: Manager + , authToken :: Maybe Token + , apiType :: ApiType + } + +data ExchangeFailure = ParseFailure Text + | ApiFailure Text + | AuthenticationRequiredFailure Text + | AuthenticationRequiresByteStrings + deriving (Show) + +type Exchange a = ExchangeT IO a + +newtype ExchangeT m a = ExchangeT { unExchangeT :: ResourceT (ReaderT ExchangeConf (ExceptT ExchangeFailure m)) a } + deriving ( Functor, Applicative, Monad, MonadIO, MonadThrow + , MonadError ExchangeFailure + , MonadReader ExchangeConf + ) + +deriving instance (MonadBase IO m) => MonadBase IO (ExchangeT m) +deriving instance (Monad m, MonadThrow m, MonadIO m, MonadBase IO m) => MonadResource (ExchangeT m) + +runExchange :: ExchangeConf -> Exchange a -> IO (Either ExchangeFailure a) +runExchange = runExchangeT + +runExchangeT :: MonadBaseControl IO m => ExchangeConf -> ExchangeT m a -> m (Either ExchangeFailure a) +runExchangeT conf = runExceptT . flip runReaderT conf . runResourceT . unExchangeT + +-- Utils + +getManager :: (MonadReader ExchangeConf m) => m Manager +getManager = do + conf <- ask + return $ manager conf diff --git a/src/Coinbase/Exchange/Types/Core.hs b/src/Coinbase/Exchange/Types/Core.hs new file mode 100644 --- /dev/null +++ b/src/Coinbase/Exchange/Types/Core.hs @@ -0,0 +1,152 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module Coinbase.Exchange.Types.Core where + +import Control.Applicative +import Control.DeepSeq +import Control.Monad +import Data.Aeson.Casing +import Data.Aeson.Types +import Data.Char +import Data.Data +import Data.Hashable +import Data.Int +import Data.Maybe +import Data.Scientific +import Data.String +import Data.Text (Text) +import qualified Data.Text as T +import Data.Time +import Data.UUID +import Data.UUID.Aeson () +import Data.Word +import GHC.Generics +#if MIN_VERSION_time(1,5,0) +import Data.Time.Format (dateTimeFmt, defaultTimeLocale) +#else +import System.Locale (dateTimeFmt, defaultTimeLocale) +#endif + + +newtype ProductId = ProductId { unProductId :: Text } + deriving (Eq, Ord, Show, Read, Data, Typeable, Generic, IsString, NFData, Hashable, FromJSON, ToJSON) + +newtype Price = Price { unPrice :: CoinScientific } + deriving (Eq, Ord, Num, Fractional, Real, RealFrac, Show, Read, Data, Typeable, Generic, NFData, Hashable, FromJSON, ToJSON) + +newtype Size = Size { unSize :: CoinScientific } + deriving (Eq, Ord, Num, Fractional, Real, RealFrac, Show, Read, Data, Typeable, Generic, NFData, Hashable, FromJSON, ToJSON) + +newtype OrderId = OrderId { unOrderId :: UUID } + deriving (Eq, Ord, Show, Read, Data, Typeable, Generic, NFData, Hashable, FromJSON, ToJSON) + +newtype Aggregate = Aggregate { unAggregate :: Int64 } + deriving (Eq, Ord, Show, Read, Num, Data, Typeable, Generic, NFData, Hashable, FromJSON, ToJSON) + +-- + +data Side = Buy | Sell + deriving (Eq, Ord, Show, Read, Data, Typeable, Generic) + +instance NFData Side +instance Hashable Side +instance ToJSON Side where + toJSON = genericToJSON coinbaseAesonOptions +instance FromJSON Side where + parseJSON = genericParseJSON coinbaseAesonOptions + +-- + +newtype TradeId = TradeId { unTradeId :: Word64 } + deriving (Eq, Ord, Num, Show, Read, Data, Typeable, Generic, NFData, Hashable) + +instance ToJSON TradeId where + toJSON = String . T.pack . show . unTradeId +instance FromJSON TradeId where + parseJSON (String t) = pure $ TradeId $ read $ T.unpack t + parseJSON (Number n) = pure $ TradeId $ floor n + parseJSON _ = mzero + +-- + +newtype CurrencyId = CurrencyId { unCurrencyId :: Text } + deriving (Eq, Ord, Show, Read, Data, Typeable, Generic, IsString, NFData, Hashable, FromJSON, ToJSON) + +---- + +data OrderStatus + = Done + | Settled + | Open + | Pending + deriving (Eq, Show, Read, Data, Typeable, Generic) + +instance NFData OrderStatus +instance Hashable OrderStatus +instance ToJSON OrderStatus where + toJSON = genericToJSON coinbaseAesonOptions +instance FromJSON OrderStatus where + parseJSON = genericParseJSON coinbaseAesonOptions + +-- + +newtype ClientOrderId = ClientOrderId { unClientOrderId :: UUID } + deriving (Eq, Ord, Show, Read, Data, Typeable, Generic, NFData, Hashable, FromJSON, ToJSON) + +-- + +data Reason = Filled | Canceled + deriving (Eq, Show, Read, Data, Typeable, Generic) + +instance NFData Reason +instance Hashable Reason +instance ToJSON Reason where + toJSON = genericToJSON defaultOptions { constructorTagModifier = map toLower } +instance FromJSON Reason where + parseJSON = genericParseJSON defaultOptions { constructorTagModifier = map toLower } + +---- + +newtype CoinScientific = CoinScientific { unCoinScientific :: Scientific } + deriving (Eq, Ord, Num, Fractional, Real, RealFrac, Show, Read, Data, Typeable, NFData, Hashable) + +instance ToJSON CoinScientific where + toJSON (CoinScientific v) = String . T.pack . show $ v +instance FromJSON CoinScientific where + parseJSON = withText "CoinScientific" $ \t -> + case maybeRead (T.unpack t) of + Just n -> pure $ CoinScientific n + Nothing -> fail "Could not parse string scientific." + +maybeRead :: (Read a) => String -> Maybe a +maybeRead = fmap fst . listToMaybe . reads + +---- + +newtype CoinbaseTime = CoinbaseTime { unCoinbaseTime :: UTCTime } + deriving (Eq, Ord, Show, Read, Data, Typeable, NFData) + +instance ToJSON CoinbaseTime where + toJSON (CoinbaseTime t) = String $ T.pack $ + formatTime defaultTimeLocale coinbaseTimeFormat t ++ "00" +instance FromJSON CoinbaseTime where + parseJSON = withText "Coinbase Time" $ \t -> + case parseTime defaultTimeLocale coinbaseTimeFormat (T.unpack t ++ "00") of + Just d -> pure $ CoinbaseTime d + _ -> fail "could not parse coinbase time format." + +coinbaseTimeFormat :: String +coinbaseTimeFormat = "%F %T%Q%z" + +---- + +coinbaseAesonOptions :: Options +coinbaseAesonOptions = (aesonPrefix snakeCase) + { constructorTagModifier = map toLower + , sumEncoding = defaultTaggedObject + { tagFieldName = "type" + } + } diff --git a/src/Coinbase/Exchange/Types/MarketData.hs b/src/Coinbase/Exchange/Types/MarketData.hs new file mode 100644 --- /dev/null +++ b/src/Coinbase/Exchange/Types/MarketData.hs @@ -0,0 +1,218 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +module Coinbase.Exchange.Types.MarketData where + +import Control.Applicative +import Control.DeepSeq +import Control.Monad.Except +import Data.Aeson.Casing +import Data.Aeson.Types +import Data.Data +import Data.Hashable +import Data.Int +import Data.Scientific +import Data.String +import Data.Text (Text) +import Data.Time +import Data.Time.Clock.POSIX +import Data.UUID.Aeson () +import qualified Data.Vector as V +import Data.Word +import GHC.Generics + +import Coinbase.Exchange.Types.Core hiding (OrderStatus (..)) + +-- Products + +data Product + = Product + { prodId :: ProductId + , prodBaseCurrency :: CurrencyId + , prodQuoteCurrency :: CurrencyId + , prodBaseMinSize :: Scientific + , prodBaseMaxSize :: Scientific + , prodQuoteIncrement :: Scientific + , prodDisplayName :: Text + } + deriving (Show, Data, Typeable, Generic) + +instance NFData Product +instance ToJSON Product where + toJSON = genericToJSON coinbaseAesonOptions +instance FromJSON Product where + parseJSON = genericParseJSON coinbaseAesonOptions + +-- Order Book + +data Book a + = Book + { bookSequence :: Word64 + , bookBids :: [Bid a] + , bookAsks :: [Ask a] + } + deriving (Show, Data, Typeable, Generic) + +instance (NFData a) => NFData (Book a) +instance (ToJSON a) => ToJSON (Book a) where + toJSON = genericToJSON coinbaseAesonOptions +instance (FromJSON a) => FromJSON (Book a) where + parseJSON = genericParseJSON coinbaseAesonOptions + +data Ask a = Ask Price Size a + deriving (Eq, Ord, Show, Read, Data, Typeable, Generic) + +instance (NFData a) => NFData (Ask a) +instance (ToJSON a) => ToJSON (Ask a) where + toJSON = genericToJSON defaultOptions +instance (FromJSON a) => FromJSON (Ask a) where + parseJSON = genericParseJSON defaultOptions + +data Bid a = Bid Price Size a + deriving (Eq, Ord, Show, Read, Data, Typeable, Generic) + +instance (NFData a) => NFData (Bid a) +instance (ToJSON a) => ToJSON (Bid a) where + toJSON = genericToJSON defaultOptions +instance (FromJSON a) => FromJSON (Bid a) where + parseJSON = genericParseJSON defaultOptions + +-- Product Ticker + +data Tick + = Tick + { tickTradeId :: Word64 + , tickPrice :: Price + , tickSize :: Size + , tickTime :: Maybe UTCTime + } + deriving (Show, Data, Typeable, Generic) + +instance NFData Tick +instance ToJSON Tick where + toJSON = genericToJSON coinbaseAesonOptions +instance FromJSON Tick where + parseJSON = genericParseJSON coinbaseAesonOptions + +-- Product Trades + +data Trade + = Trade + { tradeTime :: UTCTime + , tradeTradeId :: TradeId + , tradePrice :: Price + , tradeSize :: Size + , tradeSide :: Side + } + deriving (Show, Data, Typeable, Generic) + +instance NFData Trade +instance ToJSON Trade where + toJSON Trade{..} = object [ "time" .= CoinbaseTime tradeTime + , "trade_id" .= tradeTradeId + , "price" .= tradePrice + , "size" .= tradeSize + , "side" .= tradeSide + ] +instance FromJSON Trade where + parseJSON (Object m) = Trade <$> liftM unCoinbaseTime (m .: "time") + <*> m .: "trade_id" + <*> m .: "price" + <*> m .: "size" + <*> m .: "side" + parseJSON _ = mzero + +-- Historic Rates (Candles) + +data Candle = Candle UTCTime Low High Open Close Volume + deriving (Show, Data, Typeable, Generic) + +instance NFData Candle +instance FromJSON Candle where + parseJSON (Array v) + = case V.length v of + 6 -> Candle <$> liftM (posixSecondsToUTCTime . fromIntegral) (parseJSON (v V.! 0) :: Parser Int64) + <*> parseJSON (v V.! 1) + <*> parseJSON (v V.! 2) + <*> parseJSON (v V.! 3) + <*> parseJSON (v V.! 4) + <*> parseJSON (v V.! 5) + _ -> mzero + parseJSON _ = mzero + +newtype Low = Low { unLow :: Double } + deriving (Eq, Ord, Num, Fractional, Real, RealFrac, Show, Read, Data, Typeable, Generic, NFData, Hashable, FromJSON, ToJSON) + +newtype High = High { unHigh :: Double } + deriving (Eq, Ord, Num, Fractional, Real, RealFrac, Show, Read, Data, Typeable, Generic, NFData, Hashable, FromJSON, ToJSON) + +newtype Open = Open { unOpen :: Double } + deriving (Eq, Ord, Num, Fractional, Real, RealFrac, Show, Read, Data, Typeable, Generic, NFData, Hashable, FromJSON, ToJSON) + +newtype Close = Close { unClose :: Double } + deriving (Eq, Ord, Num, Fractional, Real, RealFrac, Show, Read, Data, Typeable, Generic, NFData, Hashable, FromJSON, ToJSON) + +newtype Volume = Volume { unVolume :: Double } + deriving (Eq, Ord, Num, Fractional, Real, RealFrac, Show, Read, Data, Typeable, Generic, NFData, Hashable, FromJSON, ToJSON) + +-- Product Stats + +data Stats + = Stats + { statsOpen :: Open + , statsHigh :: High + , statsLow :: Low + , statsVolume :: Volume + } + deriving (Show, Data, Typeable, Generic) + +instance NFData Stats +instance ToJSON Stats where + toJSON Stats{..} = object + [ "open" .= show statsOpen + , "high" .= show statsHigh + , "low" .= show statsLow + , "volume" .= show statsVolume + ] +instance FromJSON Stats where + parseJSON (Object m) + = Stats <$> liftM (Open . read) (m .: "open") + <*> liftM (High . read) (m .: "high") + <*> liftM (Low . read) (m .: "low") + <*> liftM (Volume . read) (m .: "volume") + parseJSON _ = mzero + +-- Exchange Currencies + +data Currency + = Currency + { curId :: CurrencyId + , curName :: Text + , curMinSize :: CoinScientific + } + deriving (Show, Data, Typeable, Generic) + +instance NFData Currency +instance ToJSON Currency where + toJSON = genericToJSON coinbaseAesonOptions +instance FromJSON Currency where + parseJSON = genericParseJSON coinbaseAesonOptions + +-- Exchange Time + +data ExchangeTime + = ExchangeTime + { timeIso :: UTCTime + , timeEpoch :: Double + } + deriving (Show, Data, Typeable, Generic) + +instance ToJSON ExchangeTime where + toJSON = genericToJSON coinbaseAesonOptions +instance FromJSON ExchangeTime where + parseJSON = genericParseJSON coinbaseAesonOptions diff --git a/src/Coinbase/Exchange/Types/Private.hs b/src/Coinbase/Exchange/Types/Private.hs new file mode 100644 --- /dev/null +++ b/src/Coinbase/Exchange/Types/Private.hs @@ -0,0 +1,324 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +module Coinbase.Exchange.Types.Private where + +import Control.Applicative +import Control.DeepSeq +import Control.Monad +import Data.Aeson.Casing +import Data.Aeson.Types +import Data.Char +import Data.Data +import Data.Hashable +import Data.Text (Text) +import qualified Data.Text as T +import Data.Time +import Data.UUID +import Data.Word +import GHC.Generics + +import Coinbase.Exchange.Types +import Coinbase.Exchange.Types.Core + +-- Accounts + +newtype AccountId = AccountId { unAccountId :: UUID } + deriving (Eq, Ord, Show, Read, Data, Typeable, Generic, NFData, Hashable, FromJSON, ToJSON) + +data Account + = Account + { accId :: AccountId + , accBalance :: CoinScientific + , accHold :: CoinScientific + , accAvailable :: CoinScientific + , accCurrency :: CurrencyId + } + deriving (Show, Data, Typeable, Generic) + +instance NFData Account +instance ToJSON Account where + toJSON = genericToJSON coinbaseAesonOptions +instance FromJSON Account where + parseJSON = genericParseJSON coinbaseAesonOptions + +-- + +newtype EntryId = EntryId { unEntryId :: Word64 } + deriving (Eq, Ord, Num, Show, Read, Data, Typeable, Generic, NFData, Hashable, FromJSON, ToJSON) + +data Entry + = Entry + { entryId :: EntryId + , entryCreatedAt :: UTCTime + , entryAmount :: CoinScientific + , entryBalance :: CoinScientific + , entryType :: EntryType + , entryDetails :: EntryDetails + } + deriving (Show, Data, Typeable, Generic) + +instance NFData Entry +instance ToJSON Entry where + toJSON Entry{..} = object [ "id" .= entryId + , "created_at" .= CoinbaseTime entryCreatedAt + , "amount" .= entryAmount + , "balance" .= entryBalance + , "type" .= entryType + , "details" .= entryDetails + ] +instance FromJSON Entry where + parseJSON (Object m) = Entry + <$> m .: "id" + <*> liftM unCoinbaseTime (m .: "created_at") + <*> m .: "amount" + <*> m .: "balance" + <*> m .: "type" + <*> m .: "details" + parseJSON _ = mzero + +data EntryType + = Match + | Fee + | Transfer + deriving (Eq, Ord, Show, Read, Data, Typeable, Generic) + +instance NFData EntryType +instance Hashable EntryType +instance ToJSON EntryType where + toJSON = genericToJSON defaultOptions { constructorTagModifier = map toLower } +instance FromJSON EntryType where + parseJSON = genericParseJSON defaultOptions { constructorTagModifier = map toLower } + +data EntryDetails + = EntryDetails + { detailOrderId :: Maybe OrderId + , detailTradeId :: Maybe TradeId + , detailProductId :: Maybe ProductId + } + deriving (Show, Data, Typeable, Generic) + +instance NFData EntryDetails +instance ToJSON EntryDetails where + toJSON = genericToJSON coinbaseAesonOptions +instance FromJSON EntryDetails where + parseJSON = genericParseJSON coinbaseAesonOptions + +-- + +newtype HoldId = HoldId { unHoldId :: UUID } + deriving (Eq, Ord, Show, Read, Data, Typeable, Generic, NFData, Hashable, FromJSON, ToJSON) + +data Hold + = OrderHold + { holdId :: HoldId + , holdAccountId :: AccountId + , holdCreatedAt :: UTCTime + , holdUpdatedAt :: UTCTime + , holdAmount :: CoinScientific + , holdOrderRef :: OrderId + } + | TransferHold + { holdId :: HoldId + , holdAccountId :: AccountId + , holdCreatedAt :: UTCTime + , holdUpdatedAt :: UTCTime + , holdAmount :: CoinScientific + , holdTransferRef :: TransferId + } + deriving (Show, Data, Typeable, Generic) + +instance NFData Hold +instance ToJSON Hold where + toJSON = genericToJSON coinbaseAesonOptions +instance FromJSON Hold where + parseJSON = genericParseJSON coinbaseAesonOptions + +-- Orders + +data SelfTrade + = DecrementAndCancel + | CancelOldest + | CancelNewest + | CancelBoth + deriving (Eq, Ord, Show, Read, Data, Typeable, Generic) + +instance NFData SelfTrade +instance Hashable SelfTrade +instance ToJSON SelfTrade where + toJSON DecrementAndCancel = String "dc" + toJSON CancelOldest = String "co" + toJSON CancelNewest = String "cn" + toJSON CancelBoth = String "cb" +instance FromJSON SelfTrade where + parseJSON (String "dc") = return DecrementAndCancel + parseJSON (String "co") = return CancelOldest + parseJSON (String "cn") = return CancelNewest + parseJSON (String "cb") = return CancelBoth + parseJSON _ = mzero + +data NewOrder + = NewOrder + { noSize :: Size + , noPrice :: Price + , noSide :: Side + , noProductId :: ProductId + , noClientOid :: Maybe ClientOrderId + , noSelfTrade :: Maybe SelfTrade + } + deriving (Show, Data, Typeable, Generic) + +instance NFData NewOrder +instance ToJSON NewOrder where + toJSON = genericToJSON coinbaseAesonOptions +instance FromJSON NewOrder where + parseJSON = genericParseJSON coinbaseAesonOptions + +data OrderConfirmation + = OrderConfirmation + { ocId :: OrderId + } + deriving (Show, Data, Typeable, Generic) + +instance NFData OrderConfirmation +instance ToJSON OrderConfirmation where + toJSON = genericToJSON coinbaseAesonOptions +instance FromJSON OrderConfirmation where + parseJSON = genericParseJSON coinbaseAesonOptions + +data Order + = Order + { orderId :: OrderId + , orderSize :: Size + , orderPrice :: Price + , orderProductId :: ProductId + , orderStatus :: OrderStatus + , orderFilledSize :: Maybe Size + , orderFilledFees :: Maybe Price + , orderSettled :: Bool + , orderSide :: Side + , orderCreatedAt :: UTCTime + , orderDoneAt :: Maybe UTCTime + , orderDoneReason :: Maybe Reason + } + deriving (Show, Data, Typeable, Generic) + +instance NFData Order +instance ToJSON Order where + toJSON Order{..} = object + [ "id" .= orderId + , "size" .= orderSize + , "price" .= orderPrice + , "product_id" .= orderProductId + , "status" .= orderStatus + , "filled_size" .= orderFilledSize + , "filled_fees" .= orderFilledFees + , "settled" .= orderSettled + , "side" .= orderSide + , "created_at" .= CoinbaseTime orderCreatedAt + , "done_at" .= liftM CoinbaseTime orderDoneAt + , "done_reason" .= orderDoneReason + ] +instance FromJSON Order where + parseJSON (Object m) = Order + <$> m .: "id" + <*> m .: "size" + <*> m .: "price" + <*> m .: "product_id" + <*> m .: "status" + <*> m .:? "filled_size" + <*> m .:? "filled_fees" + <*> m .: "settled" + <*> m .: "side" + <*> liftM unCoinbaseTime (m .: "created_at") + <*> liftM (liftM unCoinbaseTime) (m .:? "done_at") + <*> m .:? "done_reason" + parseJSON _ = mzero + +-- Fills + +data Liquidity + = Maker + | Taker + deriving (Eq, Ord, Show, Read, Data, Typeable, Generic) + +instance NFData Liquidity +instance Hashable Liquidity +instance ToJSON Liquidity where + toJSON Maker = String "M" + toJSON Taker = String "T" +instance FromJSON Liquidity where + parseJSON (String "M") = return Maker + parseJSON (String "T") = return Taker + parseJSON _ = mzero + +data Fill + = Fill + { fillTradeId :: TradeId + , fillProductId :: ProductId + , fillPrice :: Price + , fillSize :: Size + , fillOrderId :: OrderId + , fillCreatedAt :: UTCTime + , fillLiquidity :: Liquidity + , fillFee :: Price + , fillSettled :: Bool + , fillSide :: Side + } + deriving (Show, Data, Typeable, Generic) + +instance NFData Fill +instance ToJSON Fill where + toJSON Fill{..} = object + [ "trade_id" .= fillTradeId + , "product_id" .= fillProductId + , "price" .= fillPrice + , "size" .= fillSize + , "order_id" .= fillOrderId + , "created_at" .= CoinbaseTime fillCreatedAt + , "liquidity" .= fillLiquidity + , "fee" .= fillFee + , "settled" .= fillSettled + , "side" .= fillSide + ] +instance FromJSON Fill where + parseJSON (Object m) = Fill + <$> m .: "trade_id" + <*> m .: "product_id" + <*> m .: "price" + <*> m .: "size" + <*> m .: "order_id" + <*> liftM unCoinbaseTime (m .: "created_at") + <*> m .: "liquidity" + <*> m .: "fee" + <*> m .: "settled" + <*> m .: "side" + parseJSON _ = mzero + +-- Transfers + +newtype TransferId = TransferId { unTransferId :: UUID } + deriving (Eq, Ord, Show, Read, Data, Typeable, Generic, NFData, FromJSON, ToJSON) + +newtype CoinbaseAccountId = CoinbaseAccountId { unCoinbaseAccountId :: UUID } + deriving (Eq, Ord, Show, Read, Data, Typeable, Generic, NFData, FromJSON, ToJSON) + +data Transfer + = Deposit + { transAmount :: Size + , transCoinbaseAccount :: CoinbaseAccountId + } + | Withdraw + { transAmount :: Size + , transCoinbaseAccount :: CoinbaseAccountId + } + deriving (Show, Data, Typeable, Generic) + +instance NFData Transfer +instance ToJSON Transfer where + toJSON = genericToJSON coinbaseAesonOptions +instance FromJSON Transfer where + parseJSON = genericParseJSON coinbaseAesonOptions diff --git a/src/Coinbase/Exchange/Types/Socket.hs b/src/Coinbase/Exchange/Types/Socket.hs new file mode 100644 --- /dev/null +++ b/src/Coinbase/Exchange/Types/Socket.hs @@ -0,0 +1,84 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} + +module Coinbase.Exchange.Types.Socket where + +import Control.DeepSeq +import Data.Aeson.Types +import Data.Data +import Data.Hashable +import Data.Text (Text) +import Data.Time +import Data.Word +import GHC.Generics + +import Coinbase.Exchange.Types.Core + +newtype Sequence = Sequence { unSequence :: Word64 } + deriving (Eq, Ord, Num, Show, Read, Data, Typeable, Generic, NFData, Hashable, FromJSON, ToJSON) + +data ExchangeMessage + = Subscribe + { msgProductId :: ProductId + } + | Received + { msgTime :: UTCTime + , msgProductId :: ProductId + , msgSequence :: Sequence + , msgOrderId :: OrderId + , msgSize :: Size + , msgPrice :: Price + , msgSide :: Side + , msgClientOid :: Maybe ClientOrderId + } + | Open + { msgTime :: UTCTime + , msgProductId :: ProductId + , msgSequence :: Sequence + , msgOrderId :: OrderId + , msgPrice :: Price + , msgRemainingSize :: Size + , msgSide :: Side + } + | Done + { msgTime :: UTCTime + , msgProductId :: ProductId + , msgSequence :: Sequence + , msgPrice :: Price + , msgOrderId :: OrderId + , msgReason :: Reason + , msgSide :: Side + } + | Match + { msgTradeId :: TradeId + , msgSequence :: Sequence + , msgMakerOrderId :: OrderId + , msgTakerOrderId :: OrderId + , msgTime :: UTCTime + , msgProductId :: ProductId + , msgSize :: Size + , msgPrice :: Price + , msgSide :: Side + } + | Change + { msgTime :: UTCTime + , msgSequence :: Sequence + , msgOrderId :: OrderId + , msgProductId :: ProductId + , msgNewSize :: Size + , msgOldSize :: Size + , msgPrice :: Price + , msgSide :: Side + } + | Error + { msgMessage :: Text + } + deriving (Eq, Show, Read, Data, Typeable, Generic) + +instance NFData ExchangeMessage +instance ToJSON ExchangeMessage where + toJSON = genericToJSON coinbaseAesonOptions +instance FromJSON ExchangeMessage where + parseJSON = genericParseJSON coinbaseAesonOptions diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,29 @@ +module Main where + +import Control.Monad +import qualified Data.ByteString.Char8 as CBS +import Network.HTTP.Client.TLS +import Network.HTTP.Conduit +import System.Environment +import Test.Tasty + +import Coinbase.Exchange.Types + +import qualified Coinbase.Exchange.MarketData.Test as MarketData +import qualified Coinbase.Exchange.Private.Test as Private +main :: IO () +main = do + mgr <- newManager tlsManagerSettings + tKey <- liftM CBS.pack $ getEnv "COINBASE_KEY" + tSecret <- liftM CBS.pack $ getEnv "COINBASE_SECRET" + tPass <- liftM CBS.pack $ getEnv "COINBASE_PASSPHRASE" + + case mkToken tKey tSecret tPass of + Right tok -> defaultMain (tests $ ExchangeConf mgr (Just tok) Sandbox) + Left er -> error $ show er + +tests :: ExchangeConf -> TestTree +tests conf = testGroup "Tests" + [ MarketData.tests conf + , Private.tests conf + ]