diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for bittrex + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/ChangeLog.md b/ChangeLog.md deleted file mode 100644 --- a/ChangeLog.md +++ /dev/null @@ -1,5 +0,0 @@ -# Revision history for bittrex - -## 0.1.0.0 -- YYYY-mm-dd - -* First version. Released on an unsuspecting world. diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,2 @@ -import Distribution.Simple +import Distribution.Simple main = defaultMain diff --git a/bittrex.cabal b/bittrex.cabal --- a/bittrex.cabal +++ b/bittrex.cabal @@ -1,23 +1,22 @@ -name: bittrex -version: 0.5.0.0 -synopsis: API bindings to bittrex.com -description: Haskell bindings to the Bittrex exchange -homepage: https://github.com/dmjio/bittrex -license: BSD3 -license-file: LICENSE -author: David Johnson -maintainer: djohnson.m@gmail.com -copyright: David Johnson (c) 2017 -category: Web -build-type: Simple -extra-source-files: ChangeLog.md -cabal-version: >=1.10 +name: bittrex +version: 0.6.0.0 +synopsis: Bindings for the Bittrex API +description: Haskell bindings to the Bittrex exchange +homepage: https://github.com/dmjio/bittrex +license: BSD3 +license-file: LICENSE +author: David Johnson +maintainer: djohnson.m@gmail.com +copyright: © David Johnson 2017-2018 + , © Remy Goldschmidt 2017-2018 +category: Web +build-type: Simple +extra-source-files: CHANGELOG.md +cabal-version: >= 1.10 -executable example - main-is: Main.hs - hs-source-dirs: example - default-language: Haskell2010 - build-depends: base, bittrex, text +source-repository head + type: git + location: git://github.com/dmjio/bittrex.git library exposed-modules: Bittrex @@ -27,8 +26,8 @@ other-modules: Bittrex.Internal hs-source-dirs: src default-language: Haskell2010 - build-depends: aeson - , base < 5 + build-depends: base < 5 + , aeson , bytestring , http-client-tls , lens @@ -39,7 +38,13 @@ , text , time , wreq + , flow -source-repository head - type: git - location: git://github.com/dmjio/bittrex.git +executable example + main-is: Main.hs + hs-source-dirs: example + default-language: Haskell2010 + build-depends: bittrex + , base + , text + , turtle diff --git a/example/Main.hs b/example/Main.hs --- a/example/Main.hs +++ b/example/Main.hs @@ -2,53 +2,72 @@ import Bittrex import Control.Monad -import Data.Text (Text) -import qualified Data.Text.IO as T +import Data.Function ((&)) +import Data.Maybe +import Data.Text (Text) +import qualified Data.Text.IO as T +import System.Environment (getEnv, lookupEnv) main :: IO () main = do - [api,secret] <- lines <$> readFile "/Users/david/.bittrex" + -- Get Bittrex API credentials + + homeDirectory <- getEnv "HOME" + credentialFile <- fromMaybe (homeDirectory ++ "/.bittrex") + <$> lookupEnv "BITTREX_CREDENTIAL_FILE" + [api, secret] <- lines <$> readFile credentialFile let keys = APIKeys api secret - -- Public Usage - putStrLn "Markets" + -- Define helper functions + + let putHeader x = putStrLn ("\ESC[1m" ++ x ++ "\ESC[0m") + let printInd x = let indent = " " + wrap line = indent ++ "\ESC[34m" ++ line ++ "\ESC[0m" + shown = unlines $ map wrap $ lines $ show x + in putStrLn shown + + -- Public API example + + putHeader "Markets" Right ms <- getMarkets - forM_ ms (print . marketName) + forM_ ms (printInd . marketName) - putStrLn "Currencies" + putHeader "Currencies" Right cs <- getCurrencies - mapM_ print cs + mapM_ printInd cs - putStrLn "Ticker for BTC-DOGE market" + putHeader "Ticker for BTC-DOGE market" t <- getTicker (MarketName BTC_DOGE) - print t + printInd t - putStrLn "Summary of BTC-DOGE market" + putHeader "Summary of BTC-DOGE market" Right t <- getMarketSummary (MarketName BTC_DOGE) - print t + printInd t - putStrLn "Get market summaries" + putHeader "Get market summaries" Right t <- getMarketSummaries - print t + printInd t - putStrLn "Order book sells for for BTC-DOGE market" + putHeader "Order book sells for for BTC-DOGE market" book <- getOrderBookSells (MarketName BTC_DOGE) - print book + printInd book - putStrLn "Order book buys for for BTC-DOGE market" + putHeader "Order book buys for for BTC-DOGE market" book <- getOrderBookBuys (MarketName BTC_DOGE) - print book + printInd book - putStrLn "Market history for BTC-DOGE" + putHeader "Market history for BTC-DOGE" Right history <- getMarketHistory (MarketName BTC_DOGE) - forM_ history print + forM_ history printInd - -- Market usage - putStrLn "Retrieve your open orders" + -- Market API example + + putHeader "Retrieve your open orders" Right openOrders <- getOpenOrders keys (MarketName BTC_DOGE) - forM_ openOrders print + forM_ openOrders printInd - -- Account usage, - putStrLn "Check your balances (for all currencies)" + -- Account API example + + putHeader "Check your balances (for all currencies)" Right balances <- getBalances keys - forM_ balances print + forM_ balances printInd diff --git a/src/Bittrex.hs b/src/Bittrex.hs --- a/src/Bittrex.hs +++ b/src/Bittrex.hs @@ -1,9 +1,15 @@ +-------------------------------------------------------------------------------- + module Bittrex ( module Bittrex.API , module Bittrex.Types , module Bittrex.Util ) where -import Bittrex.API -import Bittrex.Types -import Bittrex.Util +-------------------------------------------------------------------------------- + +import Bittrex.API +import Bittrex.Types +import Bittrex.Util + +-------------------------------------------------------------------------------- diff --git a/src/Bittrex/API.hs b/src/Bittrex/API.hs --- a/src/Bittrex/API.hs +++ b/src/Bittrex/API.hs @@ -1,11 +1,15 @@ -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} +-------------------------------------------------------------------------------- + {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-------------------------------------------------------------------------------- + module Bittrex.API - ( - -- * Overview + ( -- * Overview -- $intro -- * Public @@ -17,11 +21,13 @@ , getOrderBookBuys , getOrderBookSells , getMarketHistory + -- * Market , buyLimit , sellLimit , cancel , getOpenOrders + -- * Account , getBalances , getBalance @@ -33,280 +39,330 @@ , getDepositHistory ) where +-------------------------------------------------------------------------------- + import Data.Aeson import Data.Char import Data.Monoid import Data.Scientific import Data.Text (Text) -import qualified Data.Text as T +import qualified Data.Text as Text +import Bittrex.Internal import Bittrex.Types import Bittrex.Util -import Bittrex.Internal +-------------------------------------------------------------------------------- + -- $intro --- Bittrex provides a simple and powerful REST API to allow you to programatically perform nearly all actions you can from our web interface. --- --- All requests use the application/json content type and go over https. --- The base url is https://bittrex.com/api/{version}/. +-- Bittrex provides a simple and powerful REST API to allow you to +-- programmatically perform nearly all actions you can from our web interface. -- --- All requests are GET requests and all responses come in a default response object with the result in the result field. Always check the success flag to ensure that your API call succeeded. +-- All requests use the @application/json@ content type and go over HTTPS. +-- The base url is . -- --- We are currently restricting orders to 500 open orders and 200,000 orders a day. We reserve the right to change these settings as we tune the system. If you are affected by these limits as an active trader, please email support@bittrex.com. +-- All requests are GET requests and all responses come in a default response +-- object with the result in the result field. Always check the success flag to +-- ensure that your API call succeeded. -- --- If you have any questions, feedback or recommendation for API support you can post a question in our support center. +-- We are currently restricting orders to 500 open orders and 200,000 orders +-- a day. We reserve the right to change these settings as we tune the system. +-- If you are affected by these limits as an active trader, please email +-- . -- +-- If you have any questions, feedback or recommendation for API support you +-- can post a question in our support center. --- | Used to get the open and available trading markets at Bittrex along with other meta data. +-------------------------------------------------------------------------------- + +-- | Used to get the open and available trading markets at Bittrex along with +-- other meta data. getMarkets :: IO (Either ErrorMessage [Market]) -getMarkets = callAPI defOpts { path = "getmarkets" } +getMarkets + = callAPI (defOpts { apiOptsPath = "getmarkets" }) +-------------------------------------------------------------------------------- + -- | Used to get all supported currencies at Bittrex along with other meta data. getCurrencies :: IO (Either ErrorMessage [Currency]) -getCurrencies = callAPI defOpts { path = "getcurrencies" } +getCurrencies + = callAPI (defOpts { apiOptsPath = "getcurrencies" }) +-------------------------------------------------------------------------------- + -- | Used to get the current tick values for a market. getTicker - :: MarketName -- ^ a string literal for the market (ex: `BTC-LTC`) + :: MarketName + -- ^ A string literal for the market (e.g.: @BTC-LTC@). -> IO (Either ErrorMessage Ticker) -getTicker market = - callAPI defOpts { - qParams = [("market", toMarket market)] - , path = "getticker" - } +getTicker market + = callAPI (defOpts { apiOptsQueryParams = [("market", toMarket market)] + , apiOptsPath = "getticker" + }) --- | Used to get the last 24 hour summary of all active exchanges +-------------------------------------------------------------------------------- + +-- | This function returns a summary of the last 24 hours for all +-- active exchanges. getMarketSummaries :: IO (Either ErrorMessage [MarketSummary]) -getMarketSummaries = - callAPI defOpts { path = "getmarketsummaries" } +getMarketSummaries + = callAPI (defOpts { apiOptsPath = "getmarketsummaries" }) --- | Used to get the last 24 hour summary of all active exchanges +-------------------------------------------------------------------------------- + +-- | This function returns a summary of the last 24 hours for the given market. getMarketSummary - :: MarketName -- ^ a string literal for the market (ex: `BTC-LTC`) + :: MarketName + -- ^ A string literal for the market (e.g.: @BTC-LTC@). -> IO (Either ErrorMessage [MarketSummary]) -getMarketSummary market = - callAPI defOpts { - qParams = pure ("market", toMarket market) - , path = "getmarketsummary" - } +getMarketSummary market + = callAPI (defOpts { apiOptsQueryParams = pure ("market", toMarket market) + , apiOptsPath = "getmarketsummary" + }) +-------------------------------------------------------------------------------- + -- | Used to get retrieve the orderbook for a given market getOrderBookBuys - :: MarketName -- ^ a string literal for the market (ex: `BTC-LTC`) --- -> OrderBookType -- ^ buy, sell or both to identify the type of orderbook to return. + :: MarketName + -- ^ A string literal for the market (e.g.: @BTC-LTC@). + -- -> OrderBookType + -- -- ^ buy, sell or both to identify the type of orderbook to return. -> IO (Either ErrorMessage [OrderBookEntry]) -getOrderBookBuys market = - callAPI defOpts { - path = "getorderbook" - , qParams = [ ("market", toMarket market) - , ("type", "buy") - ] - } +getOrderBookBuys market + = callAPI (defOpts { apiOptsPath = "getorderbook" + , apiOptsQueryParams = [ ("market", toMarket market) + , ("type", "buy") + ] + }) +-------------------------------------------------------------------------------- + -- | Used to get retrieve the orderbook for a given market getOrderBookSells - :: MarketName -- ^ a string literal for the market (ex: `BTC-LTC`) --- -> OrderBookType -- ^ buy, sell or both to identify the type of orderbook to return. + :: MarketName + -- ^ A string literal for the market (e.g.: @BTC-LTC@). + -- -> OrderBookType + -- -- ^ buy, sell or both to identify the type of orderbook to return. -> IO (Either ErrorMessage [OrderBookEntry]) -getOrderBookSells market = - callAPI defOpts { - path = "getorderbook" - , qParams = [ ("market", toMarket market) - , ("type", "sell") - ] - } +getOrderBookSells market + = callAPI (defOpts { apiOptsPath = "getorderbook" + , apiOptsQueryParams = [ ("market", toMarket market) + , ("type", "sell") + ] + }) -- | Used to retrieve the latest trades that have occured for a specific market. getMarketHistory - :: MarketName -- ^ string literal for the market (ex: `BTC-LTC`) + :: MarketName + -- ^ A string literal for the market (e.g.: @BTC-LTC@). -> IO (Either ErrorMessage [MarketHistory]) -getMarketHistory market = - callAPI defOpts { - path = "getmarkethistory" - , qParams = pure ("market", toMarket market) - } +getMarketHistory market + = callAPI (defOpts { apiOptsPath = "getmarkethistory" + , apiOptsQueryParams = pure ("market", toMarket market) + }) --- | Get all orders that you currently have opened. A specific market can be requested +-- | Get all orders that you currently have opened. +-- A specific market can be requested using the 'MarketName' parameter. getOpenOrders - :: APIKeys -- ^ Bittrex API credentials - -> MarketName -- ^ String literal for the market (ie. BTC-LTC) + :: APIKeys + -- ^ Your Bittrex API credentials. + -> MarketName + -- ^ String literal for the market (e.g.: @BTC-LTC@). -> IO (Either ErrorMessage [OpenOrder]) -getOpenOrders keys market = - callAPI defOpts { - path = "getopenorders" - , apiType = MarketAPI - , qParams = pure ("market", toMarket market) - , keys = keys - } +getOpenOrders keys market + = callAPI (defOpts { apiOptsPath = "getopenorders" + , apiOptsAPIType = MarketAPI + , apiOptsQueryParams = pure ("market", toMarket market) + , apiOptsKeys = keys + }) -- | Used to place a buy order in a specific market. Use buylimit to place limit orders. Make sure you have the proper permissions set on your API keys for this call to work buyLimit - :: APIKeys -- ^ Bittrex API credentials - -> MarketName -- ^ A string literal for the market (ex: BTC-LTC) - -> Quantity -- ^ The amount to purchase - -> Rate -- ^ The rate at which to place the order. + :: APIKeys + -- ^ Your Bittrex API credentials. + -> MarketName + -- ^ A string literal for the market (e.g.: @BTC-LTC@). + -> Quantity + -- ^ The amount to purchase. + -> Rate + -- ^ The rate at which to place the order. -> IO (Either ErrorMessage UUID) -buyLimit keys market quantity rate = - callAPI defOpts { - path = "buylimit" - , keys = keys - , apiType = MarketAPI - , qParams = [ ("market", toMarket market ) - , ("quantity", show quantity ) - , ("rate", show rate ) - ] - } +buyLimit keys market quantity rate + = callAPI (defOpts { apiOptsPath = "buylimit" + , apiOptsKeys = keys + , apiOptsAPIType = MarketAPI + , apiOptsQueryParams = [ ("market", toMarket market) + , ("quantity", show quantity) + , ("rate", show rate) + ] + }) -- | Used to place an sell order in a specific market. Use selllimit to place limit orders. -- Make sure you have the proper permissions set on your API keys for this call to workn sellLimit - :: APIKeys -- ^ Bittrex API credentials - -> MarketName -- ^ A string literal for the market (ex: BTC-LTC) - -> Quantity -- ^ The amount to purchase - -> Rate -- ^ The rate at which to place the order + :: APIKeys + -- ^ Your Bittrex API credentials. + -> MarketName + -- ^ A string literal for the market (e.g.: @BTC-LTC@) + -> Quantity + -- ^ The amount to purchase + -> Rate + -- ^ The rate at which to place the order -> IO (Either ErrorMessage UUID) -sellLimit keys market quantity rate = - callAPI defOpts { - path = "selllimit" - , keys = keys - , apiType = MarketAPI - , qParams = [ ("market", toMarket market ) - , ("quantity", show quantity ) - , ("rate", show rate ) - ] - } +sellLimit keys market quantity rate + = callAPI (defOpts { apiOptsPath = "selllimit" + , apiOptsKeys = keys + , apiOptsAPIType = MarketAPI + , apiOptsQueryParams = [ ("market", toMarket market) + , ("quantity", show quantity) + , ("rate", show rate) + ] + }) -- | Used to cancel a buy or sell order. cancel - :: APIKeys -- ^ Bittrex API credentials - -> UUID -- ^ uuid of buy or sell order + :: APIKeys + -- ^ Your Bittrex API credentials. + -> UUID + -- ^ The UUID of the buy or sell order. -> IO (Either ErrorMessage (Maybe Text)) -cancel keys (UUID uuid) = - callAPI defOpts { - path = "cancel" - , keys = keys - , apiType = MarketAPI - , qParams = [ ("uuid", T.unpack uuid ) ] - } +cancel keys (UUID uuid) + = callAPI (defOpts { apiOptsPath = "cancel" + , apiOptsKeys = keys + , apiOptsAPIType = MarketAPI + , apiOptsQueryParams = [ ("uuid", Text.unpack uuid) ] + }) -- | Used to retrieve all balances from your account getBalances - :: APIKeys -- ^ Bittrex API credentials + :: APIKeys + -- ^ Your Bittrex API credentials. -> IO (Either ErrorMessage [Balance]) -getBalances keys = - callAPI defOpts { - path = "getbalances" - , keys = keys - , apiType = AccountAPI - } +getBalances keys + = callAPI (defOpts { apiOptsPath = "getbalances" + , apiOptsKeys = keys + , apiOptsAPIType = AccountAPI + }) -- | Used to retrieve the balance from your account for a specific currency. getBalance - :: APIKeys -- ^ Bittrex API credentials - -> CurrencyName -- ^ a string literal for the currency (ex: LTC) + :: APIKeys + -- ^ Your Bittrex API credentials. + -> CurrencyName + -- ^ A string literal for the currency (e.g.: @LTC@). -> IO (Either ErrorMessage Balance) -getBalance keys currency = - callAPI defOpts { - path = "getbalance" - , keys = keys - , apiType = AccountAPI - , qParams = pure ("currency", T.unpack currency ) - } +getBalance keys curr + = callAPI (defOpts { apiOptsPath = "getbalance" + , apiOptsKeys = keys + , apiOptsAPIType = AccountAPI + , apiOptsQueryParams = pure ("currency", Text.unpack curr) + }) -- | Used to retrieve or generate an address for a specific currency. --- If one does not exist, the call will fail and return ADDRESS_GENERATING until one is available. +-- If one does not exist, the call will fail and return 'ADDRESS_GENERATING' +-- until one is available. getDepositAddress - :: APIKeys -- ^ Bittrex API credentials - -> CurrencyName -- ^ a string literal for the currency (ie. BTC) + :: APIKeys + -- ^ Your Bittrex API credentials. + -> CurrencyName + -- ^ A string literal for the currency (e.g.: @BTC@). -> IO (Either ErrorMessage DepositAddress) -getDepositAddress keys currency = - callAPI defOpts { - path = "getdepositaddress" - , apiType = AccountAPI - , keys = keys - , qParams = pure ("currency", T.unpack currency ) - } +getDepositAddress keys curr + = callAPI (defOpts { apiOptsPath = "getdepositaddress" + , apiOptsAPIType = AccountAPI + , apiOptsKeys = keys + , apiOptsQueryParams = pure ("currency", Text.unpack curr) + }) -- | Used to retrieve your withdrawal history. getWithdrawalHistory - :: APIKeys -- ^ Bittrex API credentials + :: APIKeys + -- ^ Your Bittrex API credentials. -> CurrencyName + -- ^ A string literal for the currency (e.g.: @BTC@). -> IO (Either ErrorMessage [WithdrawalHistory]) -getWithdrawalHistory keys currency = - callAPI defOpts { - path = "getwithdrawalhistory" - , apiType = AccountAPI - , keys = keys - , qParams = pure ( "currency" - , show currency - ) - } +getWithdrawalHistory keys curr + = callAPI (defOpts { apiOptsPath = "getwithdrawalhistory" + , apiOptsAPIType = AccountAPI + , apiOptsKeys = keys + , apiOptsQueryParams = pure ("currency", show curr) + }) -- | Used to retrieve your order history. getOrderHistory - :: APIKeys -- ^ Bittrex API credentials - -> Maybe MarketName -- ^ a string literal for the market (ie. BTC-LTC). If ommited, will return for all markets - -> IO (Either ErrorMessage [OrderHistory] ) -getOrderHistory keys market = - callAPI defOpts { - path = "getorderhistory" - , apiType = AccountAPI - , keys = keys - , qParams = [ ("market", toMarket m ) - | Just m <- pure market - ] - } + :: APIKeys + -- ^ Your Bittrex API credentials. + -> Maybe MarketName + -- ^ A string literal for the market (e.g.: @BTC-LTC@). + -- If this is 'Nothing', all markets will be returned. + -> IO (Either ErrorMessage [OrderHistory]) +getOrderHistory keys market + = callAPI (defOpts { apiOptsPath = "getorderhistory" + , apiOptsAPIType = AccountAPI + , apiOptsKeys = keys + , apiOptsQueryParams = [ ("market", toMarket m) + | Just m <- pure market ] + }) -- | Used to retrieve a single order by uuid. getOrder - :: APIKeys -- ^ Bittrex API credentials - -> UUID -- ^ the uuid of the buy or sell order + :: APIKeys + -- ^ Your Bittrex API credentials. + -> UUID + -- ^ The UUID of the buy or sell order. -> IO (Either ErrorMessage Order) -getOrder keys (UUID uuid) = - callAPI defOpts { - path = "getorder" - , keys = keys - , apiType = AccountAPI - , qParams = [ ("uuid", T.unpack uuid) ] - } +getOrder keys (UUID uuid) + = callAPI (defOpts { apiOptsPath = "getorder" + , apiOptsKeys = keys + , apiOptsAPIType = AccountAPI + , apiOptsQueryParams = [ ("uuid", Text.unpack uuid) ] + }) -- | Used to withdraw funds from your account. note: please account for txfee. withdraw - :: APIKeys -- ^ Bittrex API credentials - -> CurrencyName -- ^ A string literal for the currency (ie. BTC) - -> Quantity -- ^ The quantity of coins to withdraw - -> Address -- ^ The address where to send the funds. - -> Maybe PaymentId -- ^ used for CryptoNotes/BitShareX/Nxt optional field (memo/paymentid) + :: APIKeys + -- ^ Your Bittrex API credentials. + -> CurrencyName + -- ^ A string literal for the currency (e.g.: @BTC@). + -> Quantity + -- ^ The quantity of coins to withdraw + -> Address + -- ^ The address where to send the funds. + -> Maybe PaymentId + -- ^ used for the optional field representing the memo / payment ID on + -- CryptoNotes, BitShareX, and Nxt transactions. -> IO (Either ErrorMessage UUID) -withdraw keys currency quantity address payment = - callAPI defOpts { - path = "withdraw" - , keys = keys - , apiType = AccountAPI - , qParams = [ ("currency", T.unpack currency ) - , ("quantity", show quantity ) - , ("address", address ) - ] <> [ ("paymentid", show p ) - | Just p <- pure payment - ] - } +withdraw keys curr quantity address payment + = callAPI (defOpts { apiOptsPath = "withdraw" + , apiOptsKeys = keys + , apiOptsAPIType = AccountAPI + , apiOptsQueryParams = [ ("currency", Text.unpack curr) + , ("quantity", show quantity) + , ("address", address) + ] <> [ ("paymentid", show p) + | Just p <- pure payment + ] + }) -- | Used to retrieve your deposit history. getDepositHistory :: APIKeys - -- ^ Bittrex API credentials + -- ^ Your Bittrex API credentials. -> Maybe CurrencyName - -- ^ A string literal for the currecy (ie. BTC). If `Nothing`, will return for all currencies + -- ^ A string literal for the currency (e.g.: @BTC@). + -- If this is 'Nothing', all currencies will be returned. -> IO (Either ErrorMessage [DepositHistory]) -getDepositHistory keys currency = - callAPI defOpts { - path = "getdeposithistory" - , apiType = AccountAPI - , keys = keys - , qParams = [ ("currency", show c) - | Just c <- pure currency - ] - } +getDepositHistory keys curr + = callAPI (defOpts { apiOptsPath = "getdeposithistory" + , apiOptsAPIType = AccountAPI + , apiOptsKeys = keys + , apiOptsQueryParams = [ ("currency", show c) + | Just c <- pure curr + ] + }) + +-------------------------------------------------------------------------------- diff --git a/src/Bittrex/Internal.hs b/src/Bittrex/Internal.hs --- a/src/Bittrex/Internal.hs +++ b/src/Bittrex/Internal.hs @@ -1,67 +1,75 @@ -{-# LANGUAGE RecordWildCards #-} +-------------------------------------------------------------------------------- + {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +-------------------------------------------------------------------------------- + module Bittrex.Internal where -import Control.Lens +-------------------------------------------------------------------------------- + +import Bittrex.Types +import qualified Control.Lens as Lens import Data.Aeson -import Data.Aeson.Lens (key, nth) -import qualified Data.ByteString.Char8 as BC -import qualified Data.ByteString.Lazy as L -import Data.Char +import Data.Aeson.Lens (key, nth) +import qualified Data.ByteString.Char8 as BSC8 +import qualified Data.ByteString.Lazy as LBS +import Data.Char (toLower) import Data.Digest.Pure.SHA -import Data.List -import Data.List.Split (splitOn) +import Data.List (intercalate) +import Data.List.Split (splitOn) import Data.Monoid +import qualified Data.Text as Text import Data.Time.Clock.POSIX -import Network.Wreq import Debug.Trace -import Bittrex.Types +import Flow ((.>), (|>)) +import Network.Wreq +-------------------------------------------------------------------------------- + -- | Default API options defOpts :: APIOpts defOpts = APIOpts PublicAPI [] "v1.1" mempty (APIKeys mempty mempty) -- | Internal, used for dispatching an API call callAPI - :: FromJSON v + :: (FromJSON v) => APIOpts -> IO (Either ErrorMessage v) -callAPI APIOpts {..} = do - let APIKeys {..} = keys +callAPI (APIOpts {..}) = do + let (APIKeys {..}) = apiOptsKeys nonce <- head . splitOn "." . show <$> getPOSIXTime - let addAuth = apiType `elem` [AccountAPI, MarketAPI] - authParams = concat - [ [ ("apikey", apiKey) | addAuth ] - , [ ("nonce", nonce) | addAuth ] - ] - addHeader o = - if addAuth - then o & header "apisign" .~ [ - BC.pack $ showDigest $ - hmacSha512 (L.fromStrict (BC.pack secretKey)) $ - L.fromStrict (BC.pack urlForHash) - ] - else o - urlForHash = init $ - mconcat [ url - , "?" - , go =<< do qParams ++ authParams - ] - go (k,v) = k <> "=" <> v <> "&" - url = intercalate "/" [ "https://bittrex.com/api" - , version - , toLower <$> show apiType - , path - ] + let addAuth = apiOptsAPIType `elem` [AccountAPI, MarketAPI] + let authParams = [ [("apikey", apiKey) | addAuth] + , [("nonce", nonce) | addAuth] + ] |> mconcat + let url = [ "https://bittrex.com/api" + , Text.unpack apiOptsVersion + , toLower <$> show apiOptsAPIType + , Text.unpack apiOptsPath + ] |> intercalate "/" + let go (k, v) = k <> "=" <> v <> "&" + let urlForHash = [ url, "?", go =<< do apiOptsQueryParams ++ authParams + ] |> mconcat |> init + let addHeader o = let secretLBS = LBS.fromStrict (BSC8.pack secretKey) + apisign = BSC8.pack + $ showDigest + $ hmacSha512 secretLBS + $ LBS.fromStrict (BSC8.pack urlForHash) + in if addAuth + then o |> Lens.set (header "apisign") [apisign] + else o r <- getWith (addHeader defaults) urlForHash - let Just (Bool success) = r ^? responseBody . key "success" - Just result = r ^? responseBody . key "result" - Just msg = r ^? responseBody . key "message" + let Just (Bool success) = r |> Lens.preview (responseBody . key "success") + let Just result = r |> Lens.preview (responseBody . key "result") + let Just msg = r |> Lens.preview (responseBody . key "message") pure $ if success - then case fromJSON result of - Error s -> Left (DecodeFailure s result) - Success m -> Right m - else case fromJSON msg of - Success m -> Left (BittrexError m) - Error s -> Left (DecodeFailure s msg) + then case fromJSON result of + Error s -> Left (DecodeFailure s result) + Success m -> Right m + else case fromJSON msg of + Error s -> Left (DecodeFailure s msg) + Success m -> Left (BittrexError m) +-------------------------------------------------------------------------------- diff --git a/src/Bittrex/Types.hs b/src/Bittrex/Types.hs --- a/src/Bittrex/Types.hs +++ b/src/Bittrex/Types.hs @@ -1,67 +1,95 @@ -{-# LANGUAGE OverloadedStrings #-} +-------------------------------------------------------------------------------- + {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE StandaloneDeriving #-} + +-------------------------------------------------------------------------------- + module Bittrex.Types where +-------------------------------------------------------------------------------- + import Data.Aeson -import Data.Aeson.Types hiding (parse) -import Data.ByteString (ByteString) -import qualified Data.ByteString as B -import qualified Data.ByteString.Lazy as L +import qualified Data.Aeson.Types as Aeson import Data.Fixed import Data.Scientific -import Data.Text (Text) -import qualified Data.Text as T +import Data.Text (Text) +import qualified Data.Text as Text import Data.Time import Data.Time.Format -import GHC.Generics -import Text.Read (readMaybe) +import Flow ((.>)) +import GHC.Generics (Generic) +import Text.Read (readMaybe) +-------------------------------------------------------------------------------- + data E8 instance HasResolution E8 where - resolution _ = 10^8 + resolution _ = 10 ^ 8 -type Params = [(String,String)] +-------------------------------------------------------------------------------- +type Params = [(String, String)] + +-------------------------------------------------------------------------------- + +newtype Time + = Time UTCTime + deriving (Eq, Show) + +instance FromJSON Time where + parseJSON = withText "Time" $ \t -> pure (Time (parse (Text.unpack t))) + where + parse :: String -> UTCTime + parse = parseTimeOrError True defaultTimeLocale + $ iso8601DateFormat (Just "%H:%M:%S%Q") + +-------------------------------------------------------------------------------- + data APIType = PublicAPI | AccountAPI | MarketAPI deriving (Eq) -newtype Time = Time UTCTime - deriving (Show, Eq) - -instance FromJSON Time where - parseJSON = withText "Time" $ \t -> do - pure $ Time $ parse (T.unpack t) - where - parse :: String -> UTCTime - parse = - parseTimeOrError True defaultTimeLocale $ - iso8601DateFormat (Just "%H:%M:%S%Q") - - instance Show APIType where show AccountAPI = "account" show PublicAPI = "public" show MarketAPI = "market" +-------------------------------------------------------------------------------- + data APIOpts = APIOpts - { apiType :: APIType - , qParams :: Params - , version :: String - , path :: String - , keys :: APIKeys - } deriving (Show, Eq) + { apiOptsAPIType :: !APIType + , apiOptsQueryParams :: !Params + , apiOptsVersion :: !Text + , apiOptsPath :: !Text + , apiOptsKeys :: !APIKeys + } + deriving (Eq, Show) +-------------------------------------------------------------------------------- + +-- FIXME: this is a weird hack + data ErrorMessage - = BittrexError BittrexError - | DecodeFailure String Value - deriving (Show, Eq, Generic) + = BittrexError !BittrexError + | DecodeFailure !String !Aeson.Value + deriving (Eq, Show, Generic) +-- instance FromJSON ErrorMessage where +-- parseJSON value = do +-- case Aeson.fromJSON value of +-- (Aeson.Error msg) -> pure (DecodeFailure msg value) +-- (Aeson.Success be) -> pure (BittrexError be) + +-------------------------------------------------------------------------------- + data BittrexError = INVALID_MARKET | MARKET_NOT_PROVIDED @@ -73,22 +101,40 @@ | INVALID_CURRENCY | WITHDRAWAL_TOO_SMALL | CURRENCY_DOES_NOT_EXIST - deriving (Show, Eq, Generic) + | ADDRESS_GENERATING + deriving (Eq, Show, Generic) -instance FromJSON ErrorMessage -instance FromJSON BittrexError +instance FromJSON BittrexError where + parseJSON (String "INVALID_MARKET") = pure INVALID_MARKET + parseJSON (String "MARKET_NOT_PROVIDED") = pure MARKET_NOT_PROVIDED + parseJSON (String "APIKEY_NOT_PROVIDED") = pure APIKEY_NOT_PROVIDED + parseJSON (String "APIKEY_INVALID") = pure APIKEY_INVALID + parseJSON (String "INVALID_SIGNATURE") = pure INVALID_SIGNATURE + parseJSON (String "NONCE_NOT_PROVIDED") = pure NONCE_NOT_PROVIDED + parseJSON (String "INVALID_PERMISSION") = pure INVALID_PERMISSION + parseJSON (String "INVALID_CURRENCY") = pure INVALID_CURRENCY + parseJSON (String "WITHDRAWAL_TOO_SMALL") = pure WITHDRAWAL_TOO_SMALL + parseJSON (String "CURRENCY_DOES_NOT_EXIST") = pure CURRENCY_DOES_NOT_EXIST + parseJSON (String "ADDRESS_GENERATING") = pure ADDRESS_GENERATING +instance ToJSON BittrexError where + toJSON = show .> toJSON + +-------------------------------------------------------------------------------- + data MarketName = NewMarket Text | MarketName MarketName' - deriving (Show, Eq) + deriving (Eq, Show) instance FromJSON MarketName where - parseJSON = withText "Market Name" $ \t -> - pure $ case readMaybe $ T.unpack (T.replace "-" "_" t) of - Nothing -> NewMarket t - Just k -> MarketName k + parseJSON = withText "Market Name" $ \t -> do + case readMaybe (Text.unpack (Text.replace "-" "_" t)) of + Nothing -> pure (NewMarket t) + (Just k) -> pure (MarketName k) +-------------------------------------------------------------------------------- + data MarketName' = BTC_LTC | BTC_DOGE @@ -361,380 +407,673 @@ | USDT_NXT | BTC_UKG | ETH_UKG - deriving (Show, Eq, Generic, Read) + deriving (Eq, Show, Read, Generic) -newtype Bid = Bid (Fixed E8) - deriving (Show, Eq, Num, FromJSON) +-------------------------------------------------------------------------------- -newtype Ask = Ask (Fixed E8) - deriving (Show, Eq, Num, FromJSON) +newtype Bid + = Bid (Fixed E8) + deriving (Eq, Num, Show, Ord, Generic) -newtype Last = Last (Fixed E8) - deriving (Show, Eq, Num, FromJSON) +deriving instance FromJSON Bid -newtype High = High (Fixed E8) - deriving (Show, Eq, Num, FromJSON) +-------------------------------------------------------------------------------- -newtype Low = Low (Fixed E8) - deriving (Show, Eq, Num, FromJSON) +newtype Ask + = Ask (Fixed E8) + deriving (Eq, Num, Show, Ord, Generic) -newtype Volume = Volume (Fixed E8) - deriving (Show, Eq, Num, FromJSON) +deriving instance FromJSON Ask -newtype BaseVolume = BaseVolume (Fixed E8) - deriving (Show, Eq, Num, FromJSON) +-------------------------------------------------------------------------------- -newtype PrevDay = PrevDay (Fixed E8) - deriving (Show, Eq, Num, FromJSON) +newtype Last + = Last (Fixed E8) + deriving (Eq, Num, Show, Ord, Generic) -newtype Quantity = Quantity (Fixed E8) - deriving (Show, Eq, Num, FromJSON) +deriving instance FromJSON Last -newtype Rate = Rate (Fixed E8) - deriving (Show, Eq, Num, FromJSON) +-------------------------------------------------------------------------------- -newtype Price = Price (Fixed E8) - deriving (Show, Eq, Num, FromJSON) +newtype High + = High (Fixed E8) + deriving (Eq, Num, Show, Ord, Generic) -newtype Total = Total (Fixed E8) - deriving (Show, Eq, Num, FromJSON) +deriving instance FromJSON High -newtype QuantityRemaining = QuantityRemaining (Fixed E8) - deriving (Show, Eq, Num, FromJSON) +-------------------------------------------------------------------------------- -newtype Limit = Limit (Fixed E8) - deriving (Show, Eq, Num, FromJSON) +newtype Low + = Low (Fixed E8) + deriving (Eq, Num, Show, Ord, Generic) -newtype CommissionPaid = CommissionPaid (Fixed E8) - deriving (Show, Eq, Num, FromJSON) +deriving instance FromJSON Low -newtype Balance' = Balance' (Fixed E8) - deriving (Show, Eq, Num, FromJSON) +-------------------------------------------------------------------------------- -newtype Available = Available (Fixed E8) - deriving (Show, Eq, Num, FromJSON) +newtype Volume + = Volume (Fixed E8) + deriving (Eq, Num, Show, Ord, Generic) -newtype Pending = Pending (Fixed E8) - deriving (Show, Eq, Num, FromJSON) +deriving instance FromJSON Volume -newtype Reserved = Reserved (Fixed E8) - deriving (Show, Eq, Num, FromJSON) +-------------------------------------------------------------------------------- -newtype ReserveRemaining = ReserveRemaining (Fixed E8) - deriving (Show, Eq, Num, FromJSON) +newtype BaseVolume + = BaseVolume (Fixed E8) + deriving (Eq, Num, Show, Ord, Generic) -newtype CommissionReserved = CommissionReserved (Fixed E8) - deriving (Show, Eq, Num, FromJSON) +deriving instance FromJSON BaseVolume -newtype CommissionReserveRemaining = CommissionReserveRemaining (Fixed E8) - deriving (Show, Eq, Num, FromJSON) +-------------------------------------------------------------------------------- -newtype TxCost = TxCost (Fixed E8) - deriving (Show, Eq, Num, FromJSON) +newtype PrevDay + = PrevDay (Fixed E8) + deriving (Eq, Num, Show, Ord, Generic) -newtype Amount = Amount (Fixed E8) - deriving (Show, Eq, Num, FromJSON) +deriving instance FromJSON PrevDay -newtype Commission = Commission (Fixed E8) - deriving (Show, Eq, Num, FromJSON) +-------------------------------------------------------------------------------- +newtype Quantity + = Quantity (Fixed E8) + deriving (Eq, Num, Show, Ord, Generic) + +deriving instance FromJSON Quantity + +-------------------------------------------------------------------------------- + +newtype Rate + = Rate (Fixed E8) + deriving (Eq, Num, Show, Ord, Generic) + +deriving instance FromJSON Rate + +-------------------------------------------------------------------------------- + +newtype Price + = Price (Fixed E8) + deriving (Eq, Num, Show, Ord, Generic) + +deriving instance FromJSON Price + +-------------------------------------------------------------------------------- + +newtype Total + = Total (Fixed E8) + deriving (Eq, Num, Show, Ord, Generic) + +deriving instance FromJSON Total + +-------------------------------------------------------------------------------- + +newtype QuantityRemaining + = QuantityRemaining (Fixed E8) + deriving (Eq, Num, Show, Ord, Generic) + +deriving instance FromJSON QuantityRemaining + +-------------------------------------------------------------------------------- + +newtype Limit + = Limit (Fixed E8) + deriving (Eq, Num, Show, Ord, Generic) + +deriving instance FromJSON Limit + +-------------------------------------------------------------------------------- + +newtype CommissionPaid + = CommissionPaid (Fixed E8) + deriving (Eq, Num, Show, Ord, Generic) + +deriving instance FromJSON CommissionPaid + +-------------------------------------------------------------------------------- + +-- FIXME: rename this... + +newtype Balance' + = Balance' (Fixed E8) + deriving (Eq, Num, Show, Ord, Generic) + +deriving instance FromJSON Balance' + +-------------------------------------------------------------------------------- + +newtype Available + = Available (Fixed E8) + deriving (Eq, Num, Show, Ord, Generic) + +deriving instance FromJSON Available + +-------------------------------------------------------------------------------- + +newtype Pending + = Pending (Fixed E8) + deriving (Eq, Num, Show, Ord, Generic) + +deriving instance FromJSON Pending + +-------------------------------------------------------------------------------- + +newtype Reserved + = Reserved (Fixed E8) + deriving (Eq, Num, Show, Ord, Generic) + +deriving instance FromJSON Reserved + +-------------------------------------------------------------------------------- + +newtype ReserveRemaining + = ReserveRemaining (Fixed E8) + deriving (Eq, Num, Show, Ord, Generic) + +deriving instance FromJSON ReserveRemaining + +-------------------------------------------------------------------------------- + +newtype CommissionReserved + = CommissionReserved (Fixed E8) + deriving (Eq, Num, Show, Ord, Generic) + +deriving instance FromJSON CommissionReserved + +-------------------------------------------------------------------------------- + +newtype CommissionReserveRemaining + = CommissionReserveRemaining (Fixed E8) + deriving (Eq, Num, Show, Ord, Generic) + +deriving instance FromJSON CommissionReserveRemaining + +-------------------------------------------------------------------------------- + +newtype TxCost + = TxCost (Fixed E8) + deriving (Eq, Num, Show, Ord, Generic) + +deriving instance FromJSON TxCost + +-------------------------------------------------------------------------------- + +newtype Amount + = Amount (Fixed E8) + deriving (Eq, Num, Show, Ord, Generic) + +deriving instance FromJSON Amount + +-------------------------------------------------------------------------------- + +newtype Commission + = Commission (Fixed E8) + deriving (Eq, Num, Show, Ord, Generic) + +deriving instance FromJSON Commission + +-------------------------------------------------------------------------------- + data Ticker = Ticker - { bid :: Bid - , ask :: Ask - , last :: Last - } deriving (Generic, Show) + { tickerBid :: !Bid + , tickerAsk :: !Ask + , tickerLast :: !Last + } + deriving (Show, Generic) instance FromJSON Ticker where - parseJSON = withObject "Ticker" $ \o -> - Ticker <$> o .: "Bid" - <*> o .: "Ask" - <*> o .: "Last" + parseJSON = withObject "Ticker" $ \o -> do + tickerBid <- o .: "Bid" + tickerAsk <- o .: "Ask" + tickerLast <- o .: "Last" + pure (Ticker {..}) -newtype MinTradeSize = MinTradeSize (Fixed E8) - deriving (Show, Eq, Num, FromJSON) +-------------------------------------------------------------------------------- -newtype TxFee = TxFee (Fixed E8) - deriving (Show, Eq, Num, FromJSON) +newtype MinTradeSize + = MinTradeSize (Fixed E8) + deriving (Eq, Num, Show, Ord, Generic) +deriving instance FromJSON MinTradeSize + +-------------------------------------------------------------------------------- + +newtype TxFee + = TxFee (Fixed E8) + deriving (Eq, Num, Show, Ord, Generic) + +deriving instance FromJSON TxFee + +-------------------------------------------------------------------------------- + data Market = Market - { marketCurrency :: Text - , baseCurrency :: Text - , marketCurrencyLong :: Text - , baseCurrencyLong :: Text - , minTradeSize :: MinTradeSize - , marketName :: MarketName - , isActive :: Bool - , created :: Time - } deriving (Show, Eq) + { marketMarketCurrency :: !Text + , marketBaseCurrency :: !Text + , marketMarketCurrencyLong :: !Text + , marketBaseCurrencyLong :: !Text + , marketMinTradeSize :: !MinTradeSize + , marketName :: !MarketName + , marketIsActive :: !Bool + , marketCreated :: !Time + } + deriving (Eq, Show) instance FromJSON Market where - parseJSON = withObject "Market" $ \o -> - Market <$> o .: "MarketCurrency" - <*> o .: "BaseCurrency" - <*> o .: "MarketCurrencyLong" - <*> o .: "BaseCurrencyLong" - <*> o .: "MinTradeSize" - <*> o .: "MarketName" - <*> o .: "IsActive" - <*> o .: "Created" + parseJSON = withObject "Market" $ \o -> do + marketMarketCurrency <- o .: "MarketCurrency" + marketBaseCurrency <- o .: "BaseCurrency" + marketMarketCurrencyLong <- o .: "MarketCurrencyLong" + marketBaseCurrencyLong <- o .: "BaseCurrencyLong" + marketMinTradeSize <- o .: "MinTradeSize" + marketName <- o .: "MarketName" + marketIsActive <- o .: "IsActive" + marketCreated <- o .: "Created" + pure (Market {..}) +-------------------------------------------------------------------------------- + data Currency = Currency - { currency :: Text - , currencyLong :: Text - , minConfirmation :: Int - , txFee :: TxFee - , currencyIsActive :: Bool - , coinType :: Text - , baseAddress :: Maybe Text - } deriving (Show, Eq) + { currencyName :: !Text + , currencyNameLong :: !Text + , currencyMinConfirmation :: !Int + , currencyTxFee :: !TxFee + , currencyIsActive :: !Bool + , currencyCoinType :: !Text + , currencyBaseAddress :: !(Maybe Text) + } + deriving (Eq, Show) instance FromJSON Currency where - parseJSON = withObject "Currency" $ \o -> - Currency - <$> o .: "Currency" - <*> o .: "CurrencyLong" - <*> o .: "MinConfirmation" - <*> o .: "TxFee" - <*> o .: "IsActive" - <*> o .: "CoinType" - <*> o .: "BaseAddress" + parseJSON = withObject "Currency" $ \o -> do + currencyName <- o .: "Currency" + currencyNameLong <- o .: "CurrencyLong" + currencyMinConfirmation <- o .: "MinConfirmation" + currencyTxFee <- o .: "TxFee" + currencyIsActive <- o .: "IsActive" + currencyCoinType <- o .: "CoinType" + currencyBaseAddress <- o .:? "BaseAddress" + pure (Currency {..}) +-------------------------------------------------------------------------------- + data OrderBookEntry = OrderBookEntry - { quantity :: Quantity - , rate :: Rate - } deriving (Show, Eq) + { orderBookEntryQuantity :: !Quantity + , orderBookEntryRate :: !Rate + } + deriving (Eq, Show) -instance FromJSON OrderBook where - parseJSON = withObject "OrderBook" $ \o -> - OrderBook <$> o .: "buy" - <*> o .: "sell" +instance FromJSON OrderBookEntry where + parseJSON = withObject "OrderBookEntry" $ \o -> do + orderBookEntryQuantity <- o .: "Quantity" + orderBookEntryRate <- o .: "Rate" + pure (OrderBookEntry {..}) +-------------------------------------------------------------------------------- + data OrderBook = OrderBook - { buy :: [OrderBookEntry] - , sell :: [OrderBookEntry] - } deriving (Show, Eq) + { orderBookBuy :: ![OrderBookEntry] + , orderBookSell :: ![OrderBookEntry] + } + deriving (Eq, Show) -instance FromJSON OrderBookEntry where - parseJSON = withObject "OrderBookEntry" $ \o -> - OrderBookEntry <$> o .: "Quantity" - <*> o .: "Rate" +instance FromJSON OrderBook where + parseJSON = withObject "OrderBook" $ \o -> do + orderBookBuy <- o .: "buy" + orderBookSell <- o .: "sell" + pure (OrderBook {..}) +-------------------------------------------------------------------------------- + data MarketHistory = MarketHistory - { mhId :: Integer - , mhTimeStamp :: Time - , mhQuantity :: Quantity - , mhPrice :: Price - , mhTotal :: Total - , mhFillType :: Text - , mhOrderType :: Text - } deriving (Show, Eq) + { marketHistoryId :: !Integer -- FIXME + , marketHistoryTimeStamp :: !Time + , marketHistoryQuantity :: !Quantity + , marketHistoryPrice :: !Price + , marketHistoryTotal :: !Total + , marketHistoryFillType :: !Text + , marketHistoryOrderType :: !Text + } + deriving (Eq, Show) instance FromJSON MarketHistory where - parseJSON = withObject "MarketHistory" $ \o -> - MarketHistory <$> o .: "Id" - <*> o .: "TimeStamp" - <*> o .: "Quantity" - <*> o .: "Price" - <*> o .: "Total" - <*> o .: "FillType" - <*> o .: "OrderType" + parseJSON = withObject "MarketHistory" $ \o -> do + marketHistoryId <- o .: "Id" + marketHistoryTimeStamp <- o .: "TimeStamp" + marketHistoryQuantity <- o .: "Quantity" + marketHistoryPrice <- o .: "Price" + marketHistoryTotal <- o .: "Total" + marketHistoryFillType <- o .: "FillType" + marketHistoryOrderType <- o .: "OrderType" + pure (MarketHistory {..}) +-------------------------------------------------------------------------------- + -- | API Keys -data APIKeys = APIKeys - { apiKey :: String - , secretKey :: String - } deriving (Show, Eq) +data APIKeys + = APIKeys + { apiKey :: !String -- FIXME: should be Text?? + , secretKey :: !String -- FIXME: should be Text?? + } + deriving (Eq, Show) -type Address = String -type PaymentId = String +-------------------------------------------------------------------------------- +type Address = String -- FIXME: should be Text?? + +-------------------------------------------------------------------------------- + +type PaymentId = String -- FIXME: should be Text?? + +-------------------------------------------------------------------------------- + data WithdrawalHistory = WithdrawalHistory - { whPaymentUuid :: Text - , whCurrency :: Text - , whAmount :: Amount - , whAddress :: Text - , whOpened :: Text - , whAuthorized :: Bool - , whPendingPayment :: Bool - , whTxCost :: Scientific - , whTxId :: Text - , whCanceled :: Bool - , whInvalidAddress :: Bool - } deriving (Show, Eq, Generic) + { withdrawalHistoryPaymentUUID :: !Text + , withdrawalHistoryCurrency :: !Text + , withdrawalHistoryAmount :: !Amount + , withdrawalHistoryAddress :: !Text + , withdrawalHistoryOpened :: !Text + , withdrawalHistoryAuthorized :: !Bool + , withdrawalHistoryPendingPayment :: !Bool + , withdrawalHistoryTxCost :: !Scientific + , withdrawalHistoryTxId :: !Text + , withdrawalHistoryCanceled :: !Bool + , withdrawalHistoryInvalidAddress :: !Bool + } + deriving (Eq, Show, Generic) instance FromJSON WithdrawalHistory where - parseJSON = genericParseJSON defaultOptions { - fieldLabelModifier = drop 2 - } + parseJSON = withObject "WithdrawalHistory" $ \o -> do + withdrawalHistoryPaymentUUID <- o .: "PaymentUuid" + withdrawalHistoryCurrency <- o .: "Currency" + withdrawalHistoryAmount <- o .: "Amount" + withdrawalHistoryAddress <- o .: "Address" + withdrawalHistoryOpened <- o .: "Opened" + withdrawalHistoryAuthorized <- o .: "Authorized" + withdrawalHistoryPendingPayment <- o .: "PendingPayment" + withdrawalHistoryTxCost <- o .: "TxCost" + withdrawalHistoryTxId <- o .: "TxId" + withdrawalHistoryCanceled <- o .: "Canceled" + withdrawalHistoryInvalidAddress <- o .: "InvalidAddress" + pure (WithdrawalHistory {..}) +-------------------------------------------------------------------------------- + data DepositHistory = DepositHistory - { dhCurrency :: Text - , dhAmount :: Scientific - , dhLastUpdated :: Text - , dhConfirmations :: Scientific - , dhId :: Scientific - , dhTxId :: Text - , dhCryptoAddress :: Text - } deriving (Show, Eq, Generic) + { depositHistoryCurrency :: !Text + , depositHistoryAmount :: !Scientific + , depositHistoryLastUpdated :: !Text + , depositHistoryConfirmations :: !Scientific + , depositHistoryId :: !Scientific + , depositHistoryTxId :: !Text + , depositHistoryCryptoAddress :: !Text + } + deriving (Eq, Show, Generic) instance FromJSON DepositHistory where - parseJSON = genericParseJSON defaultOptions { - fieldLabelModifier = drop 2 - } + parseJSON = withObject "DepositHistory" $ \o -> do + depositHistoryCurrency <- o .: "Currency" + depositHistoryAmount <- o .: "Amount" + depositHistoryLastUpdated <- o .: "LastUpdated" + depositHistoryConfirmations <- o .: "Confirmations" + depositHistoryId <- o .: "Id" + depositHistoryTxId <- o .: "TxId" + depositHistoryCryptoAddress <- o .: "CryptoAddress" + pure (DepositHistory {..}) +-------------------------------------------------------------------------------- + type CurrencyName = Text +-------------------------------------------------------------------------------- + data DepositAddress = DepositAddress - { daCurrency :: Text - , daAddress :: Text - } deriving (Show, Eq, Generic) + { depositAddressCurrency :: !Text + , depositAddressAddress :: !Text + } + deriving (Eq, Show, Generic) instance FromJSON DepositAddress where - parseJSON = genericParseJSON defaultOptions { - fieldLabelModifier = drop 2 - } + parseJSON = withObject "DepositAddress" $ \o -> do + depositAddressCurrency <- o .: "Currency" + depositAddressAddress <- o .: "Address" + pure (DepositAddress {..}) -newtype UUID = UUID Text - deriving (Show, Eq) +-------------------------------------------------------------------------------- +newtype UUID + = UUID Text + deriving (Eq, Show) + instance FromJSON UUID where - parseJSON = withObject "UUID" $ \o -> + parseJSON = withObject "UUID" $ \o -> do UUID <$> o .: "uuid" +-------------------------------------------------------------------------------- + data Balance = Balance - { bCurrency :: Text - , bBalance :: Balance' - , bAvailable :: Available - , bPending :: Pending - , bCryptoAddress :: Text - , bUuid :: Maybe Text - } deriving (Show, Eq, Generic) + { balanceCurrency :: !Text + , balanceBalance :: !Balance' + , balanceAvailable :: !Available + , balancePending :: !Pending + , balanceCryptoAddress :: !(Maybe Text) + , balanceUUID :: !(Maybe Text) + } + deriving (Eq, Show, Generic) instance FromJSON Balance where - parseJSON = genericParseJSON defaultOptions { - fieldLabelModifier = drop 1 - } + parseJSON = withObject "Balance" $ \o -> do + balanceCurrency <- o .: "Currency" + balanceBalance <- o .: "Balance" + balanceAvailable <- o .: "Available" + balancePending <- o .: "Pending" + balanceCryptoAddress <- o .:? "CryptoAddress" + balanceUUID <- o .:? "Uuid" + pure (Balance {..}) +-------------------------------------------------------------------------------- + data OrderType = SELL | BUY | LIMIT_SELL | LIMIT_BUY - deriving (Show, Generic, Eq) + deriving (Eq, Show, Generic) -instance FromJSON OrderType +instance FromJSON OrderType where + parseJSON (String "SELL") = pure SELL + parseJSON (String "BUY") = pure BUY + parseJSON (String "LIMIT_SELL") = pure LIMIT_SELL + parseJSON (String "LIMIT_BUY") = pure LIMIT_BUY +-------------------------------------------------------------------------------- + data OpenOrder = OpenOrder - { ooUuid :: Maybe Text - , ooOrderUuid :: Text - , ooExchange :: Text - , ooOrderType :: OrderType - , ooQuantity :: Quantity - , ooQuantityRemaining :: QuantityRemaining - , ooLimit :: Limit - , ooCommissionPaid :: CommissionPaid - , ooPrice :: Price - , ooPricePerUnit :: Maybe Price - , ooOpened :: Time - , ooClosed :: Maybe Time - , ooCancelInitiated :: Bool - , ooImmediateOrCancel :: Bool - , ooIsConditional :: Bool - , ooCondition :: Maybe Text - , ooConditionTarget :: Maybe Text - } deriving (Show, Eq, Generic) + { openOrderUUID :: !(Maybe Text) + , openOrderOrderUUID :: !Text + , openOrderExchange :: !Text + , openOrderOrderType :: !OrderType + , openOrderQuantity :: !Quantity + , openOrderQuantityRemaining :: !QuantityRemaining + , openOrderLimit :: !Limit + , openOrderCommissionPaid :: !CommissionPaid + , openOrderPrice :: !Price + , openOrderPricePerUnit :: !(Maybe Price) + , openOrderOpened :: !Time + , openOrderClosed :: !(Maybe Time) + , openOrderCancelInitiated :: !Bool + , openOrderImmediateOrCancel :: !Bool + , openOrderIsConditional :: !Bool + , openOrderCondition :: !(Maybe Text) + , openOrderConditionTarget :: !(Maybe Text) + } + deriving (Eq, Show, Generic) instance FromJSON OpenOrder where - parseJSON = genericParseJSON defaultOptions { - fieldLabelModifier = drop 2 - } + parseJSON = withObject "OpenOrder" $ \o -> do + openOrderUUID <- o .:? "Uuid" + openOrderOrderUUID <- o .: "OrderUuid" + openOrderExchange <- o .: "Exchange" + openOrderOrderType <- o .: "OrderType" + openOrderQuantity <- o .: "Quantity" + openOrderQuantityRemaining <- o .: "QuantityRemaining" + openOrderLimit <- o .: "Limit" + openOrderCommissionPaid <- o .: "CommissionPaid" + openOrderPrice <- o .: "Price" + openOrderPricePerUnit <- o .:? "PricePerUnit" + openOrderOpened <- o .: "Opened" + openOrderClosed <- o .:? "Closed" + openOrderCancelInitiated <- o .: "CancelInitiated" + openOrderImmediateOrCancel <- o .: "ImmediateOrCancel" + openOrderIsConditional <- o .: "IsConditional" + openOrderCondition <- o .:? "Condition" + openOrderConditionTarget <- o .:? "ConditionTarget" + pure (OpenOrder {..}) +-------------------------------------------------------------------------------- + data OrderHistory = OrderHistory - { ohOrderUuid :: Text - , ohExchange :: Text - , ohTimeStamp :: Time - , ohOrderType :: OrderType - , ohLimit :: Limit - , ohQuantity :: Quantity - , ohQuantityRemaining :: QuantityRemaining - , ohCommission :: Commission - , ohPrice :: Price - , ohPricePerUnit :: Maybe Price - , ohIsConditional :: Bool - , ohCondition :: Text - , ohConditionTarget :: Maybe Text - , ohImmediateOrCancel :: Bool - } deriving (Show, Eq, Generic) + { orderHistoryOrderUUID :: !Text + , orderHistoryExchange :: !Text + , orderHistoryTimeStamp :: !Time + , orderHistoryOrderType :: !OrderType + , orderHistoryLimit :: !Limit + , orderHistoryQuantity :: !Quantity + , orderHistoryQuantityRemaining :: !QuantityRemaining + , orderHistoryCommission :: !Commission + , orderHistoryPrice :: !Price + , orderHistoryPricePerUnit :: !(Maybe Price) + , orderHistoryIsConditional :: !Bool + , orderHistoryCondition :: !Text + , orderHistoryConditionTarget :: !(Maybe Text) + , orderHistoryImmediateOrCancel :: !Bool + } + deriving (Eq, Show, Generic) instance FromJSON OrderHistory where - parseJSON = genericParseJSON defaultOptions { - fieldLabelModifier = drop 2 - } + parseJSON = withObject "OrderHistory" $ \o -> do + orderHistoryOrderUUID <- o .: "OrderUuid" + orderHistoryExchange <- o .: "Exchange" + orderHistoryTimeStamp <- o .: "TimeStamp" + orderHistoryOrderType <- o .: "OrderType" + orderHistoryLimit <- o .: "Limit" + orderHistoryQuantity <- o .: "Quantity" + orderHistoryQuantityRemaining <- o .: "QuantityRemaining" + orderHistoryCommission <- o .: "Commission" + orderHistoryPrice <- o .: "Price" + orderHistoryPricePerUnit <- o .:? "PricePerUnit" + orderHistoryIsConditional <- o .: "IsConditional" + orderHistoryCondition <- o .: "Condition" + orderHistoryConditionTarget <- o .:? "ConditionTarget" + orderHistoryImmediateOrCancel <- o .: "ImmediateOrCancel" + pure (OrderHistory {..}) +-------------------------------------------------------------------------------- + data Order = Order - { oAccountId :: Maybe Text - , oOrderUuid :: Text - , oExchange :: Text - , oOrderType :: OrderType - , oQuantity :: Quantity - , oQuantityRemaining :: QuantityRemaining - , oLimit :: Limit - , oReserved :: Reserved - , oReservedRemaining :: ReserveRemaining - , oCommissionReserved :: CommissionReserved - , oCommissionReserveRemaining :: CommissionReserveRemaining - , oCommissionPaid :: CommissionPaid - , oPrice :: Price - , oPricePerUnit :: Maybe Price - , oOpened :: Time - , oClosed :: Maybe Time - , oIsOpen :: Bool - , oSentinel :: Text - , oCommission :: Commission - , oIsConditional :: Bool - , oCancelInitiated :: Bool - , oImmediateOrCancel :: Bool - , oCondition :: Text - , oConditionTarget :: Maybe Text - } deriving (Show, Eq, Generic) + { orderAccountID :: !(Maybe Text) + , orderOrderUUID :: !Text + , orderExchange :: !Text + , orderOrderType :: !OrderType + , orderQuantity :: !Quantity + , orderQuantityRemaining :: !QuantityRemaining + , orderLimit :: !Limit + , orderReserved :: !Reserved + , orderReservedRemaining :: !ReserveRemaining + , orderCommissionReserved :: !CommissionReserved + , orderCommissionReserveRemaining :: !CommissionReserveRemaining + , orderCommissionPaid :: !CommissionPaid + , orderPrice :: !Price + , orderPricePerUnit :: !(Maybe Price) + , orderOpened :: !Time + , orderClosed :: !(Maybe Time) + , orderIsOpen :: !Bool + , orderSentinel :: !Text + , orderCommission :: !Commission + , orderIsConditional :: !Bool + , orderCancelInitiated :: !Bool + , orderImmediateOrCancel :: !Bool + , orderCondition :: !Text + , orderConditionTarget :: !(Maybe Text) + } + deriving (Eq, Show, Generic) instance FromJSON Order where - parseJSON = genericParseJSON defaultOptions { - fieldLabelModifier = drop 1 - } + parseJSON = withObject "Order" $ \o -> do + orderAccountID <- o .:? "AccountId" + orderOrderUUID <- o .: "OrderUuid" + orderExchange <- o .: "Exchange" + orderOrderType <- o .: "OrderType" + orderQuantity <- o .: "Quantity" + orderQuantityRemaining <- o .: "QuantityRemaining" + orderLimit <- o .: "Limit" + orderReserved <- o .: "Reserved" + orderReservedRemaining <- o .: "ReservedRemaining" + orderCommissionReserved <- o .: "CommissionReserved" + orderCommissionReserveRemaining <- o .: "CommissionReserveRemaining" + orderCommissionPaid <- o .: "CommissionPaid" + orderPrice <- o .: "Price" + orderPricePerUnit <- o .:? "PricePerUnit" + orderOpened <- o .: "Opened" + orderClosed <- o .:? "Closed" + orderIsOpen <- o .: "IsOpen" + orderSentinel <- o .: "Sentinel" + orderCommission <- o .: "Commission" + orderIsConditional <- o .: "IsConditional" + orderCancelInitiated <- o .: "CancelInitiated" + orderImmediateOrCancel <- o .: "ImmediateOrCancel" + orderCondition <- o .: "Condition" + orderConditionTarget <- o .:? "ConditionTarget" + pure (Order {..}) +-------------------------------------------------------------------------------- + data MarketSummary = MarketSummary - { msMarketName :: MarketName - , msHigh :: High - , msLow :: Low - , msVolume :: Volume - , msLast :: Last - , msBaseVolume :: BaseVolume - , msTimeStamp :: Time - , msBid :: Bid - , msAsk :: Ask - , msOpenBuyOrders :: Int - , msOpenSellOrders :: Int - , msPrevDay :: PrevDay - , msCreated :: Time - , msDisplayMarketName :: Maybe Text - } deriving (Show, Eq, Generic) + { marketSummaryMarketName :: !MarketName + , marketSummaryHigh :: !High + , marketSummaryLow :: !Low + , marketSummaryVolume :: !Volume + , marketSummaryLast :: !Last + , marketSummaryBaseVolume :: !BaseVolume + , marketSummaryTimeStamp :: !Time + , marketSummaryBid :: !Bid + , marketSummaryAsk :: !Ask + , marketSummaryOpenBuyOrders :: !Int + , marketSummaryOpenSellOrders :: !Int + , marketSummaryPrevDay :: !PrevDay + , marketSummaryCreated :: !Time + , marketSummaryDisplayMarketName :: !(Maybe Text) + } + deriving (Eq, Show, Generic) instance FromJSON MarketSummary where - parseJSON = genericParseJSON defaultOptions { - fieldLabelModifier = drop 2 - } + parseJSON = withObject "MarketSummary" $ \o -> do + marketSummaryMarketName <- o .: "MarketName" + marketSummaryHigh <- o .: "High" + marketSummaryLow <- o .: "Low" + marketSummaryVolume <- o .: "Volume" + marketSummaryLast <- o .: "Last" + marketSummaryBaseVolume <- o .: "BaseVolume" + marketSummaryTimeStamp <- o .: "TimeStamp" + marketSummaryBid <- o .: "Bid" + marketSummaryAsk <- o .: "Ask" + marketSummaryOpenBuyOrders <- o .: "OpenBuyOrders" + marketSummaryOpenSellOrders <- o .: "OpenSellOrders" + marketSummaryPrevDay <- o .: "PrevDay" + marketSummaryCreated <- o .: "Created" + marketSummaryDisplayMarketName <- o .:? "DisplayMarketName" + pure (MarketSummary {..}) + +-------------------------------------------------------------------------------- diff --git a/src/Bittrex/Util.hs b/src/Bittrex/Util.hs --- a/src/Bittrex/Util.hs +++ b/src/Bittrex/Util.hs @@ -1,7 +1,7 @@ module Bittrex.Util ( toMarket ) where -import Data.Text (Text) -import qualified Data.Text as T +import Data.Text (Text) +import qualified Data.Text as T import Bittrex.Types