bitx-bitcoin 0.7.0.2 → 0.8.0.0

raw patch · 12 files changed

+93/−59 lines, 12 files

Files

• CHANGES +6/−0
• README.md +5/−4
• bitx-bitcoin.cabal +2/−2
• src/Network/Bitcoin/BitX/Internal.hs +15/−5
• src/Network/Bitcoin/BitX/Private.hs +4/−4
• src/Network/Bitcoin/BitX/Public.hs +20/−19
• src/Network/Bitcoin/BitX/Response.hs +4/−2
• src/Network/Bitcoin/BitX/Types.hs +6/−3
• src/Network/Bitcoin/BitX/Types/Internal.hs +8/−8
• test/Example.hs +5/−5
• test/Network/Bitcoin/BitX/Spec/Specs/AesonRecordSpec.hs +17/−6
• test/Network/Bitcoin/BitX/Spec/Specs/LensSpec.hs +1/−1

@@ -1,3 +1,9 @@+v0.8.0.0+* Added Singapore Dollar.+* The UnparseableResponse now provides the Aeson error. BREAKING CHANGE.+* Last_trade and Bid and Ask prices don't always appear in the Ticker type. BREAKING CHANGE.+* GHC 8.0 is now officially supported.+ v0.7.0.2 * Forgot to export "status" lens, 

@@ -8,8 +8,6 @@ BitX exchange, do the following:  ```haskell-{-# LANGUAGE DataKinds #-}- import Control.Lens ((^.)) import Network.Bitcoin.BitX (BitXAPIResponse(..), getTicker, CcyPair(..)) import qualified Network.Bitcoin.BitX as BitX@@ -21,12 +19,15 @@ main = do   bitXResponse <- getTicker XBTZAR   case bitXResponse of-    ValidResponse tic        -> print (tic ^. BitX.ask)+    ValidResponse tic        ->+      case tic ^. BitX.ask of+        Nothing              ->  putStrLn "The BTC-ZAR exchange not currently have an ask price..."+        Just p               ->  putStrLn ("1 bitcoin will set you back ZAR" ++ show p ++ ".00.")     ErrorResponse err        ->         error $ "BitX error received: \"" ++ unpack (err ^. BitX.error) ++ "\""     ExceptionResponse ex     ->         error $ "Exception was thrown: \"" ++ show ex ++ "\""-    UnparseableResponse resp ->+    UnparseableResponse _ resp ->         error $ "Bad HTTP response; HTTP status code was: \"" ++ (show . statusCode . responseStatus $ resp) ++ "\"" ``` 

@@ -1,5 +1,5 @@ name:                bitx-bitcoin-version:             0.7.0.2+version:             0.8.0.0 synopsis:            A Haskell library for working with the BitX bitcoin exchange.  description:@@ -11,7 +11,7 @@     the code of the author of this library, or BitX's code. This is just common sense.     .     If you need to make sure that nothing funny happens in the code, apart from reading-    the source yourself, you should also perform a few test transations with very small+    the source yourself, you should also perform a few test transactions with very small     denominations, as I will strive to do every time before releasing a new version.     .     For a very small usage example, see "Network.Bitcoin.BitX.Public".

@@ -18,20 +18,20 @@ import Network.HTTP.Types (status503) import Network.HTTP.Client (Response(..), Request(..)) import Control.Exception (try)-import qualified Data.Aeson as Aeson (decode)+import qualified Data.Aeson as Aeson (decode, eitherDecode) import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString as BS import Data.Maybe (fromJust) import Network (withSocketsDo) import qualified Data.Text.Encoding as Txt import Network.Bitcoin.BitX.Response-import Control.Applicative ((<|>)) import Lens.Micro ((^.)) import Control.Concurrent (threadDelay) #if __GLASGOW_HASKELL__ >= 710 -- <$> is in base since 4.8 (GHC 7.10) due to the AMP+import Control.Applicative ((<|>)) #else-import Control.Applicative ((<$>))+import Control.Applicative ((<|>), (<$>)) #endif  bitXAPIPrefix :: String@@ -106,10 +106,20 @@ bitXErrorOrPayload :: BitXAesRecordConvert recd => Response BL.ByteString -> BitXAPIResponse recd bitXErrorOrPayload resp = fromJust $         ErrorResponse . aesToRec <$> Aeson.decode body -- is it a BitX error?-    <|> ValidResponse . aesToRec <$> Aeson.decode body-    <|> Just (UnparseableResponse  resp)+    <|> ValidResponse . aesToRec <$> eitherToMaybe respBody -- I can't get the typechecker to work if I use "Aeson.decode body" here+    <|> Just (UnparseableResponse aesonErr resp)     where+        aesonErr = fromLeft respBody+        respBody = Aeson.eitherDecode body         body = NetCon.responseBody resp++fromLeft :: Either a b -> a+fromLeft (Left a) = a+fromLeft     _    = Prelude.error "fromLeft called on Right value. This is not supposed to happen..."++eitherToMaybe :: Either a b -> Maybe b+eitherToMaybe (Left _) = Nothing+eitherToMaybe (Right b) = Just b  isRateLimited :: Either NetCon.HttpException a -> Bool isRateLimited (Left  (NetCon.StatusCodeException st _ _)) = st == status503

@@ -180,7 +180,7 @@ getPendingTransactions auth accid = liftM imebPendingTransactionsToimebTransactions $ simpleBitXGetAuth_ auth $     "accounts/" ++ Txt.unpack accid ++ "/pending"     where-        imebPendingTransactionsToimebTransactions (ValidResponse v)       = ValidResponse $ pendingTransactionsToTransactions v-        imebPendingTransactionsToimebTransactions (ExceptionResponse x)   = ExceptionResponse x-        imebPendingTransactionsToimebTransactions (ErrorResponse e)       = ErrorResponse e-        imebPendingTransactionsToimebTransactions (UnparseableResponse u) = UnparseableResponse u+        imebPendingTransactionsToimebTransactions (ValidResponse v)         = ValidResponse $ pendingTransactionsToTransactions v+        imebPendingTransactionsToimebTransactions (ExceptionResponse x)     = ExceptionResponse x+        imebPendingTransactionsToimebTransactions (ErrorResponse e)         = ErrorResponse e+        imebPendingTransactionsToimebTransactions (UnparseableResponse a u) = UnparseableResponse a u

@@ -13,25 +13,26 @@ -- As a small example, to get the current selling price of bitcoin on the BitX exchange, do the following: -- -- @---{-\# LANGUAGE DataKinds \#-}
---
---import Control.Lens ((^.))
---import Network.Bitcoin.BitX (BitXAPIResponse(..), getTicker, CcyPair(..))
---import qualified Network.Bitcoin.BitX as BitX
---import Data.Text (unpack)
---import Network.HTTP.Types.Status (Status(..))
---import Network.HTTP.Conduit (responseStatus)
---
---main :: IO ()
---main = do
---  bitXResponse <- getTicker XBTZAR
---  case bitXResponse of
---    ValidResponse tic        -> print (tic ^. BitX.ask)
---    ErrorResponse err        ->
---        error $ "BitX error received: \\"" ++ unpack (err ^. BitX.error) ++ "\\""
---    ExceptionResponse ex     ->
---        error $ "Exception was thrown: \\"" ++ show ex ++ "\\""
---    UnparseableResponse resp ->
+--import Control.Lens ((^.))+--import Network.Bitcoin.BitX (BitXAPIResponse(..), getTicker, CcyPair(..))+--import qualified Network.Bitcoin.BitX as BitX+--import Data.Text (unpack)+--import Network.HTTP.Types.Status (Status(..))+--import Network.HTTP.Conduit (responseStatus)+--+--main :: IO ()+--main = do+--  bitXResponse <- getTicker XBTZAR+--  case bitXResponse of+--    ValidResponse tic+--      case tic ^. BitX.ask of+--        Nothing              ->  putStrLn "The BTC-ZAR exchange not currently have an ask price..."+--        Just p               ->  putStrLn ("1 bitcoin will set you back ZAR" ++ show p ++ ".00.")+--    ErrorResponse err        ->+--        error $ "BitX error received: \\"" ++ unpack (err ^. BitX.error) ++ "\\""+--    ExceptionResponse ex     ->+--        error $ "Exception was thrown: \\"" ++ show ex ++ "\\""+--    UnparseableResponse _ resp -> --        error $ "Bad HTTP response; HTTP status code was: \\"" ++ (show . statusCode . responseStatus $ resp) ++ "\\"" -- @ --

@@ -30,7 +30,9 @@     | ErrorResponse BitXError -- ^ BitX returned an error record instead of returning the data we                               -- were expecting.     | ValidResponse recd -- ^ We received the data type we were expecting.-    | UnparseableResponse (Response ByteString) -- ^ BitX retuned data which couldn't be parsed,-                                                -- such as some text which was probably not JSON format.+    | UnparseableResponse String (Response ByteString) -- ^ BitX retuned data which couldn't be parsed,+                                                       -- such as some text which was probably not JSON format.+                                                       -- The first value is the error given by Aeson upon trying+                                                       -- to parse the response body.  deriving instance Show recd => Show (BitXAPIResponse recd)

@@ -181,6 +181,8 @@     | NGNXBT -- ^ Nigerian Naira vs. Bitcoin     | XBTIDR -- ^ Bitcoin vs. Indonesian Rupiah     | IDRXBT -- ^ Indonesian Rupiah vs. Bitcoin+    | XBTSGD -- ^ Bitcoin vs. Singapore Dollar+    | SGDXBT -- ^ Singapore Dollar vs. Bitcoin   deriving (Show, Generic, Eq)  -- | The state of a single market, identified by the currency pair.@@ -188,9 +190,9 @@ -- the price of the last filled bid order. Necessarily @bid <= ask.@ data Ticker = Ticker {     tickerTimestamp :: UTCTime,-    tickerBid :: Int,-    tickerAsk :: Int,-    tickerLastTrade :: Int,+    tickerBid :: Maybe Int,+    tickerAsk :: Maybe Int,+    tickerLastTrade :: Maybe Int,     tickerRolling24HourVolume :: Scientific,     tickerPair :: CcyPair     } deriving (Eq, Show)@@ -206,6 +208,7 @@     | MYR -- ^ Malaysian Ringgit     | NGN -- ^ Nigerian Naira     | IDR -- ^ Indonesian Rupiah+    | SGD -- ^ Singapore Dollar   deriving (Show, Generic, Eq)  -- | The type of a withdrawal request.

@@ -37,7 +37,7 @@  {-# ANN module ("HLint: ignore Use camelCase" :: String) #-} -newtype UnixStampMS = UnixStampMS {unUnixStampMS_ :: Integer} deriving (Eq, Ord, Show, Num, Integral, Real, Enum)+newtype UnixStampMS = UnixStampMS {_unUnixStampMS :: Integer} deriving (Eq, Ord, Show, Num, Integral, Real, Enum)  instance Arbitrary UnixStampMS where     arbitrary = do@@ -57,7 +57,7 @@ -- >>> import Test.QuickCheck  -- |--- prop> \ n -> (timeToTimestamp $ timestampParse_ $ unUnixStampMS_ n) == unUnixStampMS_ n+-- prop> \ n -> (timeToTimestamp $ timestampParse_ $ _unUnixStampMS n) == _unUnixStampMS n --  class FromJSON (Aes recd) => BitXAesRecordConvert recd where@@ -150,9 +150,9 @@  data Ticker_ = Ticker_     { ticker'timestamp :: TimestampMS-    , ticker'bid :: QuotedInt-    , ticker'ask :: QuotedInt-    , ticker'last_trade :: QuotedInt+    , ticker'bid :: Maybe QuotedInt+    , ticker'ask :: Maybe QuotedInt+    , ticker'last_trade :: Maybe QuotedInt     , ticker'rolling_24_hour_volume :: QuotedScientific     , ticker'pair :: Types.CcyPair     }@@ -164,9 +164,9 @@     type Aes Types.Ticker = Ticker_     aesToRec Ticker_ {..} =         Types.Ticker {tickerTimestamp = tsmsToUTCTime ticker'timestamp,-                  tickerBid = qiToInt ticker'bid,-                  tickerAsk = qiToInt ticker'ask,-                  tickerLastTrade = qiToInt ticker'last_trade,+                  tickerBid = fmap qiToInt ticker'bid,+                  tickerAsk = fmap qiToInt ticker'ask,+                  tickerLastTrade = fmap qiToInt ticker'last_trade,                   tickerRolling24HourVolume = qsToScientific ticker'rolling_24_hour_volume,                   tickerPair = ticker'pair} 

@@ -1,5 +1,3 @@-{-# LANGUAGE DataKinds #-}- import Lens.Micro ((^.)) import Network.Bitcoin.BitX (BitXAPIResponse(..), getTicker, CcyPair(..)) import qualified Network.Bitcoin.BitX as BitX@@ -11,11 +9,13 @@ main = do   bitXResponse <- getTicker XBTZAR   case bitXResponse of-    ValidResponse tic        -> putStrLn ("1 bitcoin will set you back ZAR" ++ show (tic ^. BitX.ask) ++ ".00.")+    ValidResponse tic        ->+      case tic ^. BitX.ask of+        Nothing              -> putStrLn "The BTC-ZAR exchange not currently have an ask price..."+        Just p               -> putStrLn ("1 bitcoin will set you back ZAR" ++ show p ++ ".00.")     ErrorResponse err        ->         error $ "BitX error received: \"" ++ unpack (err ^. BitX.error) ++ "\""     ExceptionResponse ex     ->         error $ "Exception was thrown: \"" ++ show ex ++ "\""-    UnparseableResponse resp ->+    UnparseableResponse _ resp ->         error $ "Bad HTTP response; HTTP status code was: \"" ++ (show . statusCode . responseStatus $ resp) ++ "\""-

@@ -23,11 +23,22 @@             \ \"last_trade\":\"3116.00\",\"rolling_24_hour_volume\":\"19.776608\",\"pair\":\"XBTZAR\"}"         Ticker {              tickerTimestamp = posixSecondsToUTCTime 1431811395.699,-             tickerBid = 3083,-             tickerAsk = 3115,-             tickerLastTrade = 3116,+             tickerBid = Just 3083,+             tickerAsk = Just 3115,+             tickerLastTrade = Just 3116,              tickerRolling24HourVolume = 19.776608,              tickerPair = XBTZAR}+    it "Ticker with missing fields is parsed properly" $+      recordAesCheck+        "{\"timestamp\":1431811395699,\"bid\":\"3083.00\",\+            \ \"last_trade\":\"3116.00\",\"rolling_24_hour_volume\":\"19.776608\",\"pair\":\"XBTZAR\"}"+        Ticker {+             tickerTimestamp = posixSecondsToUTCTime 1431811395.699,+             tickerBid = Just 3083,+             tickerAsk = Nothing,+             tickerLastTrade = Just 3116,+             tickerRolling24HourVolume = 19.776608,+             tickerPair = XBTZAR}     it "Balance is parsed properly" $       recordAesCheck         "{\"account_id\":\"314159\",\"asset\":\"ZAR\",\"balance\":\"2159.15\",\"reserved\":\"320.43\",\@@ -171,9 +182,9 @@ tickerInner :: Ticker tickerInner =     Ticker (posixSecondsToUTCTime 1431811395.699)-        3083-        3115-        3116+        (Just 3083)+        (Just 3115)+        (Just 3116)         19.776608         XBTZAR 

@@ -30,7 +30,7 @@  _ticker :: Maybe Int _ticker = do-    let x = BitX.Ticker (posixSecondsToUTCTime 0) 0 0 0 0 XBTZAR+    let x = BitX.Ticker (posixSecondsToUTCTime 0) Nothing Nothing Nothing 0 XBTZAR     let _ = x ^. BitX.timestamp     let _ = x ^. BitX.bid     let _ = x ^. BitX.ask