diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,25 +1,30 @@ -https://creativecommons.org/publicdomain/zero/1.0/ -CC0 1.0 Universal (CC0 1.0) -- Public Domain Dedication +Copyright (c) 2015, Tebello Thejane -No Copyright -============ +All rights reserved. -The person who associated a work with this deed has dedicated the work to the -public domain by waiving all of his or her rights to the work worldwide under -copyright law, including all related and neighboring rights, to the extent -allowed by law. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: -You can copy, modify, distribute and perform the work, even for commercial -purposes, all without asking permission. See Other Information below. + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. -Other Information -================= + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. -In no way are the patent or trademark rights of any person affected by CC0, nor -are the rights that other persons may have in the work or in how the work is -used, such as publicity or privacy rights. + * Neither the name of Tebello Thejane nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. -Unless expressly stated otherwise, the person who associated a work with this -deed makes no warranties about the work, and disclaims liability for all uses of -the work, to the fullest extent permitted by applicable law. When using or -citing the work, you should not imply endorsement by the author or the affirmer. +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 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.0 +version: 0.4.0.1 synopsis: A Haskell library for working with the BitX bitcoin exchange. description: @@ -16,7 +16,7 @@ . For a very small usage example, see "Network.Bitcoin.BitX.Public". -license: PublicDomain +license: BSD3 license-file: LICENSE @@ -36,6 +36,8 @@ homepage: https://github.com/tebello-thejane/bitx-haskell +tested-with: GHC >=7.6.1 && <=7.10.2 + -------------------------------------------------------------------------------- library @@ -100,7 +102,10 @@ aeson, bytestring, time, - microlens + microlens, + directory, + text, + pretty-show other-modules: Network.Bitcoin.BitX.Spec.Common Network.Bitcoin.BitX.Spec.Specs.AesonRecordSpec @@ -108,3 +113,4 @@ Network.Bitcoin.BitX.Spec.Specs.PostSpec Network.Bitcoin.BitX.Spec.Specs.JsonSpec Network.Bitcoin.BitX.Spec.Specs.LensSpec + Network.Bitcoin.BitX.Spec.Specs.PrivateSpec 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 @@ -40,3 +40,4 @@ import Network.Bitcoin.BitX.Response {-# ANN module ("HLint: ignore Use import/export shortcut" :: String) #-} + diff --git a/src/Network/Bitcoin/BitX/Internal.hs b/src/Network/Bitcoin/BitX/Internal.hs --- a/src/Network/Bitcoin/BitX/Internal.hs +++ b/src/Network/Bitcoin/BitX/Internal.hs @@ -85,8 +85,7 @@ where go del = do resp <- act1 - if isRateLimited resp then do - putStrLn ("Rate limited: " ++ show del) + if isRateLimited resp then if del > maxLimit then act2 resp else do 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 @@ -13,7 +13,7 @@ -- =The private BitX API. -- -- Each one of the calls takes at least a 'BitXAuth' containing a previously-created API id and --- secret (created by 'Network.Bitcoin.BitX.Private.Auth.authGrant', or created by visiting +-- secret (created by visiting -- ), and will return a 'BitXAPIResponse'.. -- -- It would probably be best to create the 'BitXAuth' record using the constructor 'mkBitXAuth' and 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 @@ -26,10 +26,12 @@ #endif import Data.Scientific (Scientific) import Data.ByteString (ByteString) +import Data.ByteString.Char8 (pack) import Data.List.Split (splitOn) #if MIN_VERSION_base(4,7,0) import Data.Coerce #endif +import Numeric (showFFloat) {-# ANN module ("HLint: ignore Use camelCase" :: String) #-} @@ -46,9 +48,12 @@ postEncode :: recd -> [(ByteString, ByteString)] -showableToBytestring_ :: (Show a) => a -> ByteString +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) "" + -- | Wrapper around Scientific and FromJSON instance, to facilitate automatic JSON instances newtype QuotedScientific = QuotedScientific Scientific deriving (Read, Show) @@ -280,8 +285,8 @@ postEncode oreq = [("pair", showableToBytestring_ (oreq ^. Types.pair)), ("type", showableToBytestring_ (oreq ^. Types.orderType)), - ("volume", showableToBytestring_ (oreq ^. Types.volume)), - ("price", showableToBytestring_ (oreq ^. Types.price))] + ("volume", realToDecimalByteString_ (oreq ^. Types.volume)), + ("price", realToDecimalByteString_ (oreq ^. Types.price))] -------------------------------------------- OrderIDRec type --------------------------------------- @@ -442,13 +447,13 @@ instance POSTEncodeable Types.NewWithdrawal where postEncode nwthd = [("type", showableToBytestring_ (nwthd ^. Types.withdrawalType)), - ("amount", showableToBytestring_ (nwthd ^. Types.amount))] + ("amount", realToDecimalByteString_ (nwthd ^. Types.amount))] -------------------------------------- BitcoinSendRequest type ------------------------------------- instance POSTEncodeable Types.BitcoinSendRequest where postEncode oreq = - [("amount", showableToBytestring_ (oreq ^. Types.amount)), + [("amount", realToDecimalByteString_ (oreq ^. Types.amount)), ("currency", showableToBytestring_ (oreq ^. Types.currency)), ("address", Txt.encodeUtf8 (oreq ^. Types.address)), ("description", Txt.encodeUtf8 . unjustText $ (oreq ^. Types.description)), @@ -463,7 +468,7 @@ postEncode oreq = [("type", showableToBytestring_ (oreq ^. Types.quoteType)), ("pair", showableToBytestring_ (oreq ^. Types.pair)), - ("base_amount", showableToBytestring_ (oreq ^. Types.baseAmount))] + ("base_amount", realToDecimalByteString_ (oreq ^. Types.baseAmount))] ------------------------------------------ OrderQuote type ----------------------------------------- diff --git a/test/Network/Bitcoin/BitX/Spec/Specs/NetSpec.hs b/test/Network/Bitcoin/BitX/Spec/Specs/NetSpec.hs --- a/test/Network/Bitcoin/BitX/Spec/Specs/NetSpec.hs +++ b/test/Network/Bitcoin/BitX/Spec/Specs/NetSpec.hs @@ -2,7 +2,8 @@ module Network.Bitcoin.BitX.Spec.Specs.NetSpec ( - spec + spec, + isValidResponse ) where import Test.Hspec diff --git a/test/Network/Bitcoin/BitX/Spec/Specs/PrivateSpec.hs b/test/Network/Bitcoin/BitX/Spec/Specs/PrivateSpec.hs new file mode 100644 --- /dev/null +++ b/test/Network/Bitcoin/BitX/Spec/Specs/PrivateSpec.hs @@ -0,0 +1,54 @@ +{-# LANGUAGE OverloadedStrings, DataKinds #-} + +module Network.Bitcoin.BitX.Spec.Specs.PrivateSpec + ( + Network.Bitcoin.BitX.Spec.Specs.PrivateSpec.spec + ) where + +import Test.Hspec +import Network.Bitcoin.BitX.Types +import qualified Network.Bitcoin.BitX as BitX +import System.IO.Unsafe (unsafePerformIO) +import Network.Bitcoin.BitX.Response +import System.Directory (doesFileExist) +import Data.Maybe (isJust, fromJust) +import Data.Text (pack) +import Lens.Micro +import Debug.Trace +import Network.Bitcoin.BitX.Spec.Specs.NetSpec +import Text.Show.Pretty + +spec :: Spec +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 "API key file not found -- skipping private tests" $ + True `shouldBe` True + +connectsAndParsesOkay :: Show recd => IO (BitXAPIResponse recd) -> Bool +connectsAndParsesOkay k = isValidResponse $ tracePretty (unsafePerformIO k) + +tracePretty a = trace (valToStr . fromJust . parseValue $ show a) a + +keyFileName :: FilePath +keyFileName = "PRIVATE_API_KEY" + +privateAuth :: IO ( Maybe BitXAuth) +privateAuth = do + ex <- doesFileExist keyFileName + if ex + then do + contents <- readFile keyFileName + let lns = lines contents + return . Just $ + mkBitXAuth + & BitX.id .~ pack (head lns) + & BitX.secret .~ pack (lns !! 1) + else + return Nothing