diff --git a/CHANGES b/CHANGES --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,7 @@ +v0.5.0.0 +* Prices should be integers, not real. BREAKING CHANGE. +* Dropped support for versions of GHC lower than 7.8.1. + v0.4.0.0 * ExceptionResponse now holds the actual exception, rather than its text representation. BREAKING CHANGE. @@ -14,3 +18,4 @@ v0.1.0.0 * Initial release! + diff --git a/bitx-bitcoin.cabal b/bitx-bitcoin.cabal --- a/bitx-bitcoin.cabal +++ b/bitx-bitcoin.cabal @@ -1,5 +1,5 @@ name: bitx-bitcoin -version: 0.4.0.1 +version: 0.5.0.0 synopsis: A Haskell library for working with the BitX bitcoin exchange. description: @@ -36,7 +36,7 @@ homepage: https://github.com/tebello-thejane/bitx-haskell -tested-with: GHC >=7.6.1 && <=7.10.2 +tested-with: GHC >=7.8.1 && <=7.10.2 -------------------------------------------------------------------------------- @@ -59,9 +59,10 @@ other-modules: Network.Bitcoin.BitX.Internal Network.Bitcoin.BitX.Types.Internal + Network.Bitcoin.BitX.Types.Internal.Decimal build-depends: base >=4.5 && <5, - aeson >= 0.8.0.1, + aeson >= 0.8, text, time, http-conduit >= 2.0.0, @@ -105,7 +106,7 @@ microlens, directory, text, - pretty-show + safe other-modules: Network.Bitcoin.BitX.Spec.Common Network.Bitcoin.BitX.Spec.Specs.AesonRecordSpec @@ -114,3 +115,14 @@ Network.Bitcoin.BitX.Spec.Specs.JsonSpec Network.Bitcoin.BitX.Spec.Specs.LensSpec Network.Bitcoin.BitX.Spec.Specs.PrivateSpec + +-------------------------------------------------------------------------------- + +test-suite doctests + type: exitcode-stdio-1.0 + ghc-options: -threaded + main-is: Doctests.hs + build-depends: base, + doctest >= 0.8 + hs-source-dirs: test + default-language: Haskell2010 diff --git a/src/Network/Bitcoin/BitX.hs b/src/Network/Bitcoin/BitX.hs --- a/src/Network/Bitcoin/BitX.hs +++ b/src/Network/Bitcoin/BitX.hs @@ -3,8 +3,8 @@ ----------------------------------------------------------------------------- -- | -- Module : Network.Bitcoin.BitX --- Copyright : No Rights Reserved --- License : Public Domain +-- Copyright : 2015 Tebello Thejane +-- License : BSD3 -- -- Maintainer : Tebello Thejane -- Stability : Experimental @@ -39,5 +39,5 @@ import Network.Bitcoin.BitX.Types.Internal import Network.Bitcoin.BitX.Response -{-# ANN module ("HLint: ignore Use import/export shortcut" :: String) #-} +{-# ANN module "HLint: ignore Use import/export shortcut" #-} diff --git a/src/Network/Bitcoin/BitX/Private.hs b/src/Network/Bitcoin/BitX/Private.hs --- a/src/Network/Bitcoin/BitX/Private.hs +++ b/src/Network/Bitcoin/BitX/Private.hs @@ -3,8 +3,8 @@ ----------------------------------------------------------------------------- -- | -- Module : Network.Bitcoin.BitX.Private --- Copyright : No Rights Reserved --- License : Public Domain +-- Copyright : 2015 Tebello Thejane +-- License : BSD3 -- -- Maintainer : Tebello Thejane -- Stability : Experimental diff --git a/src/Network/Bitcoin/BitX/Private/Order.hs b/src/Network/Bitcoin/BitX/Private/Order.hs --- a/src/Network/Bitcoin/BitX/Private/Order.hs +++ b/src/Network/Bitcoin/BitX/Private/Order.hs @@ -3,8 +3,8 @@ ----------------------------------------------------------------------------- -- | -- Module : Network.Bitcoin.BitX.Private.Order --- Copyright : No Rights Reserved --- License : Public Domain +-- Copyright : 2015 Tebello Thejane +-- License : BSD3 -- -- Maintainer : Tebello Thejane -- Stability : Experimental diff --git a/src/Network/Bitcoin/BitX/Private/Quote.hs b/src/Network/Bitcoin/BitX/Private/Quote.hs --- a/src/Network/Bitcoin/BitX/Private/Quote.hs +++ b/src/Network/Bitcoin/BitX/Private/Quote.hs @@ -3,8 +3,8 @@ ----------------------------------------------------------------------------- -- | -- Module : Network.Bitcoin.BitX.Private.Quote --- Copyright : No Rights Reserved --- License : Public Domain +-- Copyright : 2015 Tebello Thejane +-- License : BSD3 -- -- Maintainer : Tebello Thejane -- Stability : Experimental diff --git a/src/Network/Bitcoin/BitX/Private/Withdrawal.hs b/src/Network/Bitcoin/BitX/Private/Withdrawal.hs --- a/src/Network/Bitcoin/BitX/Private/Withdrawal.hs +++ b/src/Network/Bitcoin/BitX/Private/Withdrawal.hs @@ -3,8 +3,8 @@ ----------------------------------------------------------------------------- -- | -- Module : Network.Bitcoin.BitX.Private.Withdrawal --- Copyright : No Rights Reserved --- License : Public Domain +-- Copyright : 2015 Tebello Thejane +-- License : BSD3 -- -- Maintainer : Tebello Thejane -- Stability : Experimental diff --git a/src/Network/Bitcoin/BitX/Public.hs b/src/Network/Bitcoin/BitX/Public.hs --- a/src/Network/Bitcoin/BitX/Public.hs +++ b/src/Network/Bitcoin/BitX/Public.hs @@ -1,8 +1,8 @@ ----------------------------------------------------------------------------- -- | -- Module : Network.Bitcoin.BitX.Public --- Copyright : No Rights Reserved --- License : Public Domain +-- Copyright : 2015 Tebello Thejane +-- License : BSD3 -- -- Maintainer : Tebello Thejane -- Stability : Experimental diff --git a/src/Network/Bitcoin/BitX/Response.hs b/src/Network/Bitcoin/BitX/Response.hs --- a/src/Network/Bitcoin/BitX/Response.hs +++ b/src/Network/Bitcoin/BitX/Response.hs @@ -3,8 +3,8 @@ ----------------------------------------------------------------------------- -- | -- Module : Network.Bitcoin.BitX.Response --- Copyright : No Rights Reserved --- License : Public Domain +-- Copyright : 2015 Tebello Thejane +-- License : BSD3 -- -- Maintainer : Tebello Thejane -- Stability : Experimental diff --git a/src/Network/Bitcoin/BitX/Types.hs b/src/Network/Bitcoin/BitX/Types.hs --- a/src/Network/Bitcoin/BitX/Types.hs +++ b/src/Network/Bitcoin/BitX/Types.hs @@ -4,8 +4,8 @@ ----------------------------------------------------------------------------- -- | -- Module : Network.Bitcoin.BitX.Types --- Copyright : No Rights Reserved --- License : Public Domain +-- Copyright : 2015 Tebello Thejane +-- License : BSD3 -- -- Maintainer : Tebello Thejane -- Stability : Experimental @@ -181,9 +181,9 @@ -- the price of the last filled bid order. Necessarily @bid <= ask.@ data Ticker = Ticker { tickerTimestamp :: UTCTime, - tickerBid :: Scientific, - tickerAsk :: Scientific, - tickerLastTrade :: Scientific, + tickerBid :: Int, + tickerAsk :: Int, + tickerLastTrade :: Int, tickerRolling24HourVolume :: Scientific, tickerPair :: CcyPair } deriving (Eq, Show) @@ -216,7 +216,7 @@ -- | A single placed order in the orderbook data Order = Order { orderVolume :: Scientific, - orderPrice :: Scientific + orderPrice :: Int } deriving (Eq, Show) makeFields ''Order @@ -240,7 +240,7 @@ data Trade = Trade { tradeTimestamp :: UTCTime, tradeVolume :: Scientific, - tradePrice :: Scientific + tradePrice :: Int } deriving (Eq, Show) makeFields ''Trade @@ -267,7 +267,7 @@ privateOrderExpirationTimestamp :: UTCTime, privateOrderFeeBase :: Scientific, privateOrderFeeCounter :: Scientific, - privateOrderLimitPrice :: Scientific, + privateOrderLimitPrice :: Int, privateOrderLimitVolume :: Scientific, privateOrderId :: OrderID, privateOrderPair :: CcyPair, @@ -285,7 +285,7 @@ privateOrderWithTradesExpirationTimestamp :: UTCTime, privateOrderWithTradesFeeBase :: Scientific, privateOrderWithTradesFeeCounter :: Scientific, - privateOrderWithTradesLimitPrice :: Scientific, + privateOrderWithTradesLimitPrice :: Int, privateOrderWithTradesLimitVolume :: Scientific, privateOrderWithTradesId :: OrderID, privateOrderWithTradesPair :: CcyPair, @@ -313,7 +313,7 @@ {orderRequestPair :: CcyPair, orderRequestOrderType :: OrderType, orderRequestVolume :: Scientific, - orderRequestPrice :: Scientific } deriving (Eq, Show) + orderRequestPrice :: Int } deriving (Eq, Show) makeFields ''OrderRequest @@ -394,7 +394,7 @@ orderQuoteCreatedAt :: UTCTime, orderQuoteExpiresAt :: UTCTime, orderQuoteDiscarded :: Bool, - orderQuoteExercised :: Bool} + orderQuoteExercised :: Bool} deriving (Eq, Show) makeFields ''OrderQuote @@ -402,7 +402,7 @@ data Account = Account {accountId :: Text, accountName :: Text, - accountCurrency :: Asset} + accountCurrency :: Asset} deriving (Eq, Show) makeFields ''Account diff --git a/src/Network/Bitcoin/BitX/Types/Internal.hs b/src/Network/Bitcoin/BitX/Types/Internal.hs --- a/src/Network/Bitcoin/BitX/Types/Internal.hs +++ b/src/Network/Bitcoin/BitX/Types/Internal.hs @@ -10,6 +10,7 @@ ) where +import Network.Bitcoin.BitX.Types.Internal.Decimal import qualified Network.Bitcoin.BitX.Types as Types import Data.Aeson (FromJSON(..), parseJSON, Value(..)) import qualified Data.Aeson.TH as AesTH @@ -26,12 +27,11 @@ #endif import Data.Scientific (Scientific) import Data.ByteString (ByteString) -import Data.ByteString.Char8 (pack) import Data.List.Split (splitOn) +import qualified Data.ByteString.Char8 as BS8 (pack) #if MIN_VERSION_base(4,7,0) import Data.Coerce #endif -import Numeric (showFFloat) {-# ANN module ("HLint: ignore Use camelCase" :: String) #-} @@ -51,20 +51,23 @@ showableToBytestring_ :: Show a => a -> ByteString showableToBytestring_ = Txt.encodeUtf8 . Txt.pack . show -realToDecimalByteString_ :: Real a => a -> ByteString -realToDecimalByteString_ k = pack . reverse . dropWhile (== '0') . reverse $ (showFFloat (Just 6) . (fromRational :: Rational -> Double) . toRational $ k) "" +--realToDecimalByteString_ :: Real a => a -> ByteString +--realToDecimalByteString_ k = pack . reverse . dropWhile (== '0') . reverse $ (showFFloat (Just 6) . (fromRational :: Rational -> Double) . toRational $ k) "" --- | Wrapper around Scientific and FromJSON instance, to facilitate automatic JSON instances +-- | Wrappers around Scientific and Int, and FromJSON instance, to facilitate automatic JSON instances newtype QuotedScientific = QuotedScientific Scientific deriving (Read, Show) +newtype QuotedInt = QuotedInt Int deriving (Read, Show) instance FromJSON QuotedScientific where parseJSON (String x) = return . QuotedScientific . read . Txt.unpack $ x parseJSON (Number x) = return . QuotedScientific . read . show $ x parseJSON _ = mempty ---instance ToJSON QuotedScientific where --- toJSON (QuotedScientific q) = Number . realToFrac $ q +instance FromJSON QuotedInt where + parseJSON (String x) = return . QuotedInt . read . Txt.unpack $ x + parseJSON (Number x) = return . QuotedInt . (truncate :: Scientific -> Int) . read . show $ x + parseJSON _ = mempty qsToScientific :: QuotedScientific -> Scientific #if MIN_VERSION_base(4,7,0) @@ -74,6 +77,14 @@ qsToScientific (QuotedScientific sci) = sci #endif +qiToInt :: QuotedInt -> Int +#if MIN_VERSION_base(4,7,0) +qiToInt = coerce +{-# INLINE qiToInt #-} +#else +qiToInt (QuotedInt i) = i +#endif + -- | Wrapper around UTCTime and FromJSON instance, to facilitate automatic JSON instances newtype TimestampMS = TimestampMS Integer deriving (Read, Show) @@ -122,9 +133,9 @@ data Ticker_ = Ticker_ { ticker'timestamp :: TimestampMS - , ticker'bid :: QuotedScientific - , ticker'ask :: QuotedScientific - , ticker'last_trade :: QuotedScientific + , ticker'bid :: QuotedInt + , ticker'ask :: QuotedInt + , ticker'last_trade :: QuotedInt , ticker'rolling_24_hour_volume :: QuotedScientific , ticker'pair :: Types.CcyPair } @@ -135,9 +146,9 @@ instance BitXAesRecordConvert Types.Ticker Ticker_ where aesToRec (Ticker_ {..}) = Types.Ticker {tickerTimestamp = tsmsToUTCTime ticker'timestamp, - tickerBid = qsToScientific ticker'bid, - tickerAsk = qsToScientific ticker'ask, - tickerLastTrade = qsToScientific ticker'last_trade, + tickerBid = qiToInt ticker'bid, + tickerAsk = qiToInt ticker'ask, + tickerLastTrade = qiToInt ticker'last_trade, tickerRolling24HourVolume = qsToScientific ticker'rolling_24_hour_volume, tickerPair = ticker'pair} @@ -171,7 +182,7 @@ data Order_ = Order_ { order'volume :: QuotedScientific, - order'price :: QuotedScientific + order'price :: QuotedInt } $(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"} ''Order_) @@ -179,7 +190,7 @@ instance BitXAesRecordConvert Types.Order Order_ where aesToRec (Order_ {..}) = Types.Order {orderVolume = qsToScientific order'volume, - orderPrice = qsToScientific order'price} + orderPrice = qiToInt order'price} -------------------------------------------- Orderbook type ---------------------------------------- @@ -206,7 +217,7 @@ data Trade_ = Trade_ { trade'volume :: QuotedScientific , trade'timestamp :: TimestampMS - , trade'price :: QuotedScientific + , trade'price :: QuotedInt } $(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"} @@ -216,7 +227,7 @@ aesToRec (Trade_ {..}) = Types.Trade { tradeTimestamp = tsmsToUTCTime trade'timestamp, tradeVolume = qsToScientific trade'volume, - tradePrice = qsToScientific trade'price } + tradePrice = qiToInt trade'price } ----------------------------------------- PublicTrades type ---------------------------------------- @@ -240,7 +251,7 @@ , privateOrder'expiration_timestamp :: TimestampMS , privateOrder'fee_base :: QuotedScientific , privateOrder'fee_counter :: QuotedScientific - , privateOrder'limit_price :: QuotedScientific + , privateOrder'limit_price :: QuotedInt , privateOrder'limit_volume :: QuotedScientific , privateOrder'order_id :: Types.OrderID , privateOrder'pair :: Types.CcyPair @@ -259,7 +270,7 @@ privateOrderExpirationTimestamp = tsmsToUTCTime privateOrder'expiration_timestamp, privateOrderFeeBase = qsToScientific privateOrder'fee_base, privateOrderFeeCounter = qsToScientific privateOrder'fee_counter, - privateOrderLimitPrice = qsToScientific privateOrder'limit_price, + privateOrderLimitPrice = qiToInt privateOrder'limit_price, privateOrderLimitVolume = qsToScientific privateOrder'limit_volume, privateOrderId = privateOrder'order_id, privateOrderPair = privateOrder'pair, @@ -286,7 +297,7 @@ [("pair", showableToBytestring_ (oreq ^. Types.pair)), ("type", showableToBytestring_ (oreq ^. Types.orderType)), ("volume", realToDecimalByteString_ (oreq ^. Types.volume)), - ("price", realToDecimalByteString_ (oreq ^. Types.price))] + ("price", BS8.pack . show $ (oreq ^. Types.price))] -------------------------------------------- OrderIDRec type --------------------------------------- @@ -327,7 +338,7 @@ , privateOrderWithTrades'expiration_timestamp :: TimestampMS , privateOrderWithTrades'fee_base :: QuotedScientific , privateOrderWithTrades'fee_counter :: QuotedScientific - , privateOrderWithTrades'limit_price :: QuotedScientific + , privateOrderWithTrades'limit_price :: QuotedInt , privateOrderWithTrades'limit_volume :: QuotedScientific , privateOrderWithTrades'order_id :: Types.OrderID , privateOrderWithTrades'pair :: Types.CcyPair @@ -347,7 +358,7 @@ privateOrderWithTradesExpirationTimestamp = tsmsToUTCTime privateOrderWithTrades'expiration_timestamp, privateOrderWithTradesFeeBase = qsToScientific privateOrderWithTrades'fee_base, privateOrderWithTradesFeeCounter = qsToScientific privateOrderWithTrades'fee_counter, - privateOrderWithTradesLimitPrice = qsToScientific privateOrderWithTrades'limit_price, + privateOrderWithTradesLimitPrice = qiToInt privateOrderWithTrades'limit_price, privateOrderWithTradesLimitVolume = qsToScientific privateOrderWithTrades'limit_volume, privateOrderWithTradesId = privateOrderWithTrades'order_id, privateOrderWithTradesPair = privateOrderWithTrades'pair, diff --git a/src/Network/Bitcoin/BitX/Types/Internal/Decimal.hs b/src/Network/Bitcoin/BitX/Types/Internal/Decimal.hs new file mode 100644 --- /dev/null +++ b/src/Network/Bitcoin/BitX/Types/Internal/Decimal.hs @@ -0,0 +1,67 @@ +module Network.Bitcoin.BitX.Types.Internal.Decimal + ( + realToDecimalByteString_ + ) +where + +import Data.ByteString (ByteString) +import Data.ByteString.Char8 (pack) + +import Numeric (showFFloat) + +realToDecimalByteString_ :: (RealFrac a) => a -> ByteString +realToDecimalByteString_ k = + pack + . handleIntegers + . reverse . dropWhile (== '0') . reverse + $ (showFFloat Nothing . (fromRational :: Rational -> Double) + . toRational $ truncate6 k) "" + +truncate6 :: RealFrac a => a -> Double +truncate6 k = + (/ (1000 * 1000 :: Double)) . fromInteger + $ truncate (k * 1000 * 1000) + +handleIntegers :: String -> String +handleIntegers x = + if last x == '.' + then init x + else x + +-- | +-- >>> realToDecimalByteString_ 3 +-- "3" +-- +-- >>> realToDecimalByteString_ 123456789 +-- "123456789" +-- +-- >>> realToDecimalByteString_ 100 +-- "100" +-- +-- >>> realToDecimalByteString_ 0.3 +-- "0.3" +-- +-- >>> realToDecimalByteString_ 0.12 +-- "0.12" +-- +-- >>> realToDecimalByteString_ 10.1 +-- "10.1" +-- +-- >>> realToDecimalByteString_ 3.0 +-- "3" +-- +-- >>> realToDecimalByteString_ 0.001 +-- "0.001" +-- +-- >>> realToDecimalByteString_ 0.000001 +-- "0.000001" +-- +-- >>> realToDecimalByteString_ 0.0000001 +-- "0" +-- +-- >>> realToDecimalByteString_ 0 +-- "0" +-- +-- >>> realToDecimalByteString_ 123.1234567 +-- "123.123456" +-- diff --git a/test/Doctests.hs b/test/Doctests.hs new file mode 100644 --- /dev/null +++ b/test/Doctests.hs @@ -0,0 +1,3 @@ +import Test.DocTest + +main = doctest ["-isrc", "src/Network/Bitcoin/BitX/Types/Internal/Decimal.hs"] diff --git a/test/Network/Bitcoin/BitX/Spec/Specs/AesonRecordSpec.hs b/test/Network/Bitcoin/BitX/Spec/Specs/AesonRecordSpec.hs --- a/test/Network/Bitcoin/BitX/Spec/Specs/AesonRecordSpec.hs +++ b/test/Network/Bitcoin/BitX/Spec/Specs/AesonRecordSpec.hs @@ -19,13 +19,13 @@ BitXError {bitXErrorError = "oops", bitXErrorErrorCode = "ABadError"} it "Ticker is parsed properly" $ recordAesCheck - "{\"timestamp\":1431811395699,\"bid\":\"3083.00\",\"ask\":\"3115.00\",\ - \ \"last_trade\":\"3116.00\",\"rolling_24_hour_volume\":\"19.776608\",\"pair\":\"XBTZAR\"}" + "{\"timestamp\":1431811395699,\"bid\":\"3083\",\"ask\":\"3115\",\ + \ \"last_trade\":\"3116\",\"rolling_24_hour_volume\":\"19.776608\",\"pair\":\"XBTZAR\"}" Ticker { tickerTimestamp = posixSecondsToUTCTime 1431811395.699, - tickerBid = 3083.0, - tickerAsk = 3115.00, - tickerLastTrade = 3116.00, + tickerBid = 3083, + tickerAsk = 3115, + tickerLastTrade = 3116, tickerRolling24HourVolume = 19.776608, tickerPair = XBTZAR} it "Balance is parsed properly" $ @@ -40,7 +40,7 @@ balanceUnconfirmed = 175} it "Order is parsed properly" $ recordAesCheck - "{\"volume\":\"314159\",\"price\":\"4321\"}" + "{\"volume\":\"314159\",\"price\":4321}" Order {orderVolume = 314159, orderPrice = 4321} it "WithdrawalRequest is parsed properly" $ recordAesCheck @@ -50,29 +50,29 @@ withdrawalRequestId = "271828" } it "Tickers is parsed properly" $ recordAesCheck - "{\"tickers\":[{\"timestamp\":1431811395699,\"bid\":\"3083.00\",\"ask\":\"3115.00\",\ - \ \"last_trade\":\"3116.00\",\"rolling_24_hour_volume\":\"19.776608\",\ + "{\"tickers\":[{\"timestamp\":1431811395699,\"bid\":\"3083\",\"ask\":\"3115\",\ + \ \"last_trade\":\"3116\",\"rolling_24_hour_volume\":\"19.776608\",\ \ \"pair\":\"XBTZAR\"}]}" [tickerInner] it "Orderbook is parsed properly" $ recordAesCheck - "{\"timestamp\":1431811395699,\"bids\":[{\"volume\":\"654.98\",\"price\":\"3789.66\"}],\ - \ \"asks\":[{\"volume\":\"654.98\",\"price\":\"3789.66\"}]}" + "{\"timestamp\":1431811395699,\"bids\":[{\"volume\":\"654.98\",\"price\":\"3789\"}],\ + \ \"asks\":[{\"volume\":\"654.98\",\"price\":\"3789\"}]}" Orderbook {orderbookTimestamp = posixSecondsToUTCTime 1431811395.699, orderbookBids = [orderInner], orderbookAsks = [orderInner]} it "Trade is parsed properly" $ recordAesCheck - "{\"timestamp\":1431811395699,\"volume\":\"6754.09\",\"price\":\"5327.765\"}" + "{\"timestamp\":1431811395699,\"volume\":\"6754.09\",\"price\":\"5327\"}" Trade {tradeTimestamp = posixSecondsToUTCTime 1431811395.699, tradeVolume = 6754.09, - tradePrice = 5327.765} + tradePrice = 5327} it "PublicTrades is parsed properly" $ recordAesCheck "{\"trades\":[{\"timestamp\":1431811395699,\"volume\":\"6754.09\",\ - \ \"price\":\"5327.765\"}],\"currency\":\"ZAR\"}" + \ \"price\":\"5327\"}],\"currency\":\"ZAR\"}" [tradeInner] it "PrivateOrder is parsed properly" $ recordAesCheck @@ -106,7 +106,7 @@ ("57983" :: OrderID) it "PublicTrades is parsed properly" $ recordAesCheck - "{\"trades\":[{\"timestamp\":1431811395699,\"volume\":\"6754.09\",\"price\":\"5327.765\"}], \ + "{\"trades\":[{\"timestamp\":1431811395699,\"volume\":\"6754.09\",\"price\":\"5327\"}], \ \ \"currency\":\"ZAR\"}" [tradeInner] it "RequestSuccess is parsed properly" $ @@ -119,7 +119,7 @@ \ \"expiration_timestamp\":8768834222, \"fee_base\":\"3687.3\", \"fee_counter\":12.9,\ \ \"limit_price\":765,\"limit_volume\":55.2,\"order_id\":\"83YG\",\"pair\":\"NADXBT\",\ \ \"state\":\"COMPLETE\",\"type\":\"BID\", \"trades\":[{\"timestamp\":1431811395699, \ - \ \"volume\":\"6754.09\",\"price\":\"5327.765\"}]}" + \ \"volume\":\"6754.09\",\"price\":\"5327\"}]}" PrivateOrderWithTrades {privateOrderWithTradesBase = 568.7, privateOrderWithTradesCounter = 3764.2, @@ -173,22 +173,22 @@ tickerInner :: Ticker tickerInner = Ticker (posixSecondsToUTCTime 1431811395.699) - 3083.0 - 3115.00 - 3116.00 + 3083 + 3115 + 3116 19.776608 XBTZAR orderInner :: Order orderInner = - Order 654.98 3789.66 + Order 654.98 3789 tradeInner :: Trade tradeInner = Trade { tradeTimestamp = posixSecondsToUTCTime 1431811395.699, tradeVolume = 6754.09, - tradePrice = 5327.765} + tradePrice = 5327} privateOrderInner :: PrivateOrder privateOrderInner = diff --git a/test/Network/Bitcoin/BitX/Spec/Specs/JsonSpec.hs b/test/Network/Bitcoin/BitX/Spec/Specs/JsonSpec.hs --- a/test/Network/Bitcoin/BitX/Spec/Specs/JsonSpec.hs +++ b/test/Network/Bitcoin/BitX/Spec/Specs/JsonSpec.hs @@ -13,14 +13,30 @@ spec :: Spec spec = describe "FromJSON intances" $ do - it "QuotedDecimal is parsed whether quoted or not, for floating point numbers" $ + it "QuotedScientific is parsed when quoted, for floating point numbers" $ recordAesCheck - "{\"volume\":314159.23,\"price\":\"4321.56\"}" - (Order 314159.23 4321.56) - it "QuotedDecimal is parsed whether quoted or not, for integral numbers" $ + "{\"volume\":\"314159.23\",\"price\":\"4321\"}" + (Order 314159.23 4321) + it "QuotedScientific is parsed when not quoted, for floating point numbers" $ recordAesCheck + "{\"volume\":314159.23,\"price\":\"4321\"}" + (Order 314159.23 4321) + it "QuotedScientific is parsed when quoted, for integral numbers" $ + recordAesCheck + "{\"volume\":\"314159\",\"price\":\"4321\"}" + (Order 314159 4321) + it "QuotedScientific is parsed when not quoted, for integral numbers" $ + recordAesCheck "{\"volume\":314159,\"price\":\"4321\"}" (Order 314159 4321) + it "QuotedInt is parsed when quoted" $ + recordAesCheck + "{\"volume\":0,\"price\":\"4321\"}" + (Order 0 4321) + it "QuotedInt is parsed when not quoted" $ + recordAesCheck + "{\"volume\":0,\"price\":4321}" + (Order 0 4321) it "OrderType BUY is parsed properly" $ recordAesCheck "{\"base\":\"568.7\", \"counter\":3764.2,\"creation_timestamp\":478873467, \ diff --git a/test/Network/Bitcoin/BitX/Spec/Specs/PostSpec.hs b/test/Network/Bitcoin/BitX/Spec/Specs/PostSpec.hs --- a/test/Network/Bitcoin/BitX/Spec/Specs/PostSpec.hs +++ b/test/Network/Bitcoin/BitX/Spec/Specs/PostSpec.hs @@ -17,12 +17,12 @@ {orderRequestPair = XBTZAR, orderRequestOrderType = BID, orderRequestVolume = 83.02, - orderRequestPrice = 15.23 } + orderRequestPrice = 15 } `shouldBe` [("pair", "XBTZAR"), ("type", "BID"), ("volume", "83.02"), - ("price", "15.23")] + ("price", "15")] it "Asset is post-encoded properly" $ postEncode ZAR `shouldBe` diff --git a/test/Network/Bitcoin/BitX/Spec/Specs/PrivateSpec.hs b/test/Network/Bitcoin/BitX/Spec/Specs/PrivateSpec.hs --- a/test/Network/Bitcoin/BitX/Spec/Specs/PrivateSpec.hs +++ b/test/Network/Bitcoin/BitX/Spec/Specs/PrivateSpec.hs @@ -14,27 +14,31 @@ import Data.Maybe (isJust, fromJust) import Data.Text (pack) import Lens.Micro -import Debug.Trace +--import Debug.Trace import Network.Bitcoin.BitX.Spec.Specs.NetSpec -import Text.Show.Pretty +--import Text.Show.Pretty (parseValue, valToStr) +import Safe spec :: Spec -spec = - describe "Private functionality test" $ do +spec = describe "Private functionality test" $ do mauth <- runIO privateAuth if isJust mauth then do let auth = fromJust mauth it "getBalances connects to BitX and works" $ connectsAndParsesOkay $ BitX.getBalances auth - else do + it "getAllOrders connects to BitX and works" $ + connectsAndParsesOkay $ BitX.getAllOrders auth Nothing Nothing + else it "API key file not found -- skipping private tests" $ True `shouldBe` True connectsAndParsesOkay :: Show recd => IO (BitXAPIResponse recd) -> Bool -connectsAndParsesOkay k = isValidResponse $ tracePretty (unsafePerformIO k) +connectsAndParsesOkay = isValidResponse . unsafePerformIO +--connectsAndParsesOkay k = isValidResponse $ tracePretty (unsafePerformIO k) -tracePretty a = trace (valToStr . fromJust . parseValue $ show a) a +--tracePretty :: Show a => a -> a +--tracePretty a = trace (show a) a keyFileName :: FilePath keyFileName = "PRIVATE_API_KEY" @@ -46,9 +50,16 @@ then do contents <- readFile keyFileName let lns = lines contents - return . Just $ - mkBitXAuth - & BitX.id .~ pack (head lns) - & BitX.secret .~ pack (lns !! 1) + let key_id = headMay lns + let key_secret = atMay lns 1 + + if isJust key_id && isJust key_secret + then + return . Just $ + mkBitXAuth + & BitX.id .~ pack (fromJust key_id) + & BitX.secret .~ pack (fromJust key_secret) + else + return Nothing else return Nothing