coinbase-exchange (empty) → 0.1.0.0
raw patch · 14 files changed
+1495/−0 lines, 14 filesdep +aesondep +aeson-casingdep +basesetup-changed
Dependencies added: aeson, aeson-casing, base, base64-bytestring, byteable, bytestring, coinbase-exchange, conduit, conduit-extra, cryptohash, deepseq, hashable, http-client, http-client-tls, http-conduit, http-types, mtl, network, old-locale, resourcet, scientific, tasty, tasty-hunit, tasty-quickcheck, tasty-th, text, time, transformers, transformers-base, uuid, uuid-aeson, vector, websockets, wuss
Files
- LICENSE +20/−0
- Setup.hs +2/−0
- coinbase-exchange.cabal +106/−0
- sbox/Main.hs +68/−0
- src/Coinbase/Exchange/MarketData.hs +113/−0
- src/Coinbase/Exchange/Private.hs +88/−0
- src/Coinbase/Exchange/Rest.hs +140/−0
- src/Coinbase/Exchange/Socket.hs +23/−0
- src/Coinbase/Exchange/Types.hs +128/−0
- src/Coinbase/Exchange/Types/Core.hs +152/−0
- src/Coinbase/Exchange/Types/MarketData.hs +218/−0
- src/Coinbase/Exchange/Types/Private.hs +324/−0
- src/Coinbase/Exchange/Types/Socket.hs +84/−0
- test/Main.hs +29/−0
+ LICENSE view
@@ -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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ coinbase-exchange.cabal view
@@ -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
+ sbox/Main.hs view
@@ -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 ()
+ src/Coinbase/Exchange/MarketData.hs view
@@ -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
+ src/Coinbase/Exchange/Private.hs view
@@ -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
+ src/Coinbase/Exchange/Rest.hs view
@@ -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
+ src/Coinbase/Exchange/Socket.hs view
@@ -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
+ src/Coinbase/Exchange/Types.hs view
@@ -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
+ src/Coinbase/Exchange/Types/Core.hs view
@@ -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"+ }+ }
+ src/Coinbase/Exchange/Types/MarketData.hs view
@@ -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
+ src/Coinbase/Exchange/Types/Private.hs view
@@ -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
+ src/Coinbase/Exchange/Types/Socket.hs view
@@ -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
+ test/Main.hs view
@@ -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+ ]