bitx-bitcoin 0.3.0.0 → 0.4.0.0

raw patch · 13 files changed

+68/−63 lines, 13 filesdep ~aesondep ~basedep ~bytestringPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: aeson, base, bytestring, network

API changes (from Hackage documentation)

Files

• CHANGES +3/−0
• README.md +1/−1
• bitx-bitcoin.cabal +5/−6
• src/Network/Bitcoin/BitX.hs +2/−0
• src/Network/Bitcoin/BitX/Internal.hs +22/−22
• src/Network/Bitcoin/BitX/Private.hs +2/−0
• src/Network/Bitcoin/BitX/Private/Quote.hs +0/−1
• src/Network/Bitcoin/BitX/Public.hs +1/−2
• src/Network/Bitcoin/BitX/Response.hs +5/−8
• src/Network/Bitcoin/BitX/Types/Internal.hs +14/−12
• test/Network/Bitcoin/BitX/Spec/Common.hs +2/−2
• test/Network/Bitcoin/BitX/Spec/Specs/LensSpec.hs +2/−0
• test/Network/Bitcoin/BitX/Spec/Specs/NetSpec.hs +9/−9

@@ -1,3 +1,6 @@+v0.4.0.0+* ExceptionResponse now holds the actual exception, rather than its text representation. BREAKING CHANGE.+ v0.3.0.0 * Replaced Volkov records with (micro)lenses. BREAKING CHANGE. * Implemented a (naive) mechanism to work around nginx rate limiting.

@@ -25,7 +25,7 @@     ErrorResponse err        ->
         error $ "BitX error received: \"" ++ unpack (err ^. BitX.error) ++ "\""
     ExceptionResponse ex     ->
-        error $ "Exception was thrown: \"" ++ unpack ex ++ "\""
+        error $ "Exception was thrown: \"" ++ show ex ++ "\""
     UnparseableResponse resp ->
         error $ "Bad HTTP response; HTTP status code was: \"" ++ (show . statusCode . responseStatus $ resp) ++ "\""
 ```

@@ -1,5 +1,5 @@ name:                bitx-bitcoin-version:             0.3.0.0+version:             0.4.0.0 synopsis:            A Haskell library for working with the BitX bitcoin exchange.  description:@@ -59,12 +59,12 @@     Network.Bitcoin.BitX.Types.Internal    build-depends:       base >=4.5 && <5,-                       aeson >= 0.8.0.0,+                       aeson >= 0.8.0.1,                        text,                        time,                        http-conduit >= 2.0.0,-                       bytestring >= 0.10.0.0,-                       network >= 2.0,+                       bytestring,+                       network,                        split >= 0.2.0.0,                        scientific,                        microlens,@@ -94,7 +94,7 @@   main-is:       Spec.hs   default-language:    Haskell2010-  build-depends:       base == 4.*,+  build-depends:       base,                        bitx-bitcoin,                        hspec == 2.*,                        aeson,@@ -108,4 +108,3 @@     Network.Bitcoin.BitX.Spec.Specs.PostSpec     Network.Bitcoin.BitX.Spec.Specs.JsonSpec     Network.Bitcoin.BitX.Spec.Specs.LensSpec-

@@ -38,3 +38,5 @@ import Network.Bitcoin.BitX.Private.Withdrawal import Network.Bitcoin.BitX.Types.Internal import Network.Bitcoin.BitX.Response++{-# ANN module ("HLint: ignore Use import/export shortcut" :: String) #-}

@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings, QuasiQuotes, TemplateHaskell, DataKinds, CPP #-}+{-# LANGUAGE OverloadedStrings, DataKinds, CPP #-}  module Network.Bitcoin.BitX.Internal     (@@ -23,7 +23,6 @@ import Data.Maybe (fromJust) import Network (withSocketsDo) import qualified Data.Text.Encoding as Txt-import qualified Data.Text as Txt import Network.Bitcoin.BitX.Response import Control.Applicative ((<|>)) import Lens.Micro ((^.))@@ -46,39 +45,39 @@ authConnect :: BitXAuth -> Request -> IO (Either NetCon.HttpException (Response BL.ByteString)) authConnect auth req = do     manager <- globalManager-    try . (flip NetCon.httpLbs) manager . NetCon.applyBasicAuth userID userSecret $ req+    try . flip NetCon.httpLbs manager . NetCon.applyBasicAuth userID userSecret $ req     where-        userID = Txt.encodeUtf8 $ (auth ^. Types.id)-        userSecret = Txt.encodeUtf8 $ (auth ^. Types.secret)+        userID = Txt.encodeUtf8 (auth ^. Types.id)+        userSecret = Txt.encodeUtf8 (auth ^. Types.secret) -simpleBitXGetAuth_ :: BitXAesRecordConvert rec aes => BitXAuth -> String -> IO (BitXAPIResponse rec)-simpleBitXGetAuth_ auth verb = withSocketsDo $ do+simpleBitXGetAuth_ :: BitXAesRecordConvert recd aes => BitXAuth -> String -> IO (BitXAPIResponse recd)+simpleBitXGetAuth_ auth verb = withSocketsDo $     rateLimit         (authConnect auth             . fromJust . NetCon.parseUrl $ (bitXAPIRoot ++ verb))         consumeResponseIO -simpleBitXPOSTAuth_ :: (BitXAesRecordConvert rec aes, POSTEncodeable inprec) => BitXAuth -> inprec-    -> String -> IO (BitXAPIResponse rec)-simpleBitXPOSTAuth_ auth encrec verb = withSocketsDo $ do+simpleBitXPOSTAuth_ :: (BitXAesRecordConvert recd aes, POSTEncodeable inprec) => BitXAuth -> inprec+    -> String -> IO (BitXAPIResponse recd)+simpleBitXPOSTAuth_ auth encrec verb = withSocketsDo $     rateLimit         (authConnect auth             . NetCon.urlEncodedBody (postEncode encrec)             . fromJust . NetCon.parseUrl $ (bitXAPIRoot ++ verb))         consumeResponseIO -simpleBitXMETHAuth_ :: BitXAesRecordConvert rec aes => BitXAuth -> BS.ByteString-    -> String -> IO (BitXAPIResponse rec)-simpleBitXMETHAuth_ auth meth verb = withSocketsDo $ do+simpleBitXMETHAuth_ :: BitXAesRecordConvert recd aes => BitXAuth -> BS.ByteString+    -> String -> IO (BitXAPIResponse recd)+simpleBitXMETHAuth_ auth meth verb = withSocketsDo $     rateLimit-        (authConnect auth (fromJust (NetCon.parseUrl $ (bitXAPIRoot ++ verb))) { method = meth })+        (authConnect auth (fromJust (NetCon.parseUrl (bitXAPIRoot ++ verb))) { method = meth })         consumeResponseIO -simpleBitXGet_ :: BitXAesRecordConvert rec aes => String -> IO (BitXAPIResponse rec)+simpleBitXGet_ :: BitXAesRecordConvert recd aes => String -> IO (BitXAPIResponse recd) simpleBitXGet_ verb = withSocketsDo $ do     manager <- globalManager     rateLimit-        (try . (flip NetCon.httpLbs) manager . fromJust . NetCon.parseUrl $ (bitXAPIRoot ++ verb))+        (try . flip NetCon.httpLbs manager . fromJust . NetCon.parseUrl $ (bitXAPIRoot ++ verb))         consumeResponseIO  rateLimit :: IO (Either NetCon.HttpException c) -> (Either NetCon.HttpException c -> IO d) -> IO d@@ -86,24 +85,25 @@     where         go del = do             resp <- act1-            if isRateLimited resp then+            if isRateLimited resp then do+                putStrLn ("Rate limited: " ++ show del)                 if del > maxLimit                     then act2 resp                     else do                         threadDelay del                         go (incDelay del)             else act2 resp-        maxLimit = (30 * 1000 * 1000) -- 30 seconds probably means something else is wrong...+        maxLimit = 5 * 1000 * 1000 -- 5 seconds probably means something else is wrong...         incDelay = round . (* (1.5 :: Double)) . fromIntegral -consumeResponseIO :: BitXAesRecordConvert rec aes => Either NetCon.HttpException (NetCon.Response BL.ByteString)-    -> IO (BitXAPIResponse rec)+consumeResponseIO :: BitXAesRecordConvert recd aes => Either NetCon.HttpException (NetCon.Response BL.ByteString)+    -> IO (BitXAPIResponse recd) consumeResponseIO resp =     return $ case resp of-        Left ex -> ExceptionResponse . Txt.pack . show $ ex+        Left ex -> ExceptionResponse ex         Right k -> bitXErrorOrPayload k -bitXErrorOrPayload :: BitXAesRecordConvert rec aes => Response BL.ByteString -> BitXAPIResponse rec+bitXErrorOrPayload :: BitXAesRecordConvert recd aes => Response BL.ByteString -> BitXAPIResponse recd bitXErrorOrPayload resp = fromJust $         ErrorResponse . aesToRec <$> Aeson.decode body -- is it a BitX error?     <|> ValidResponse . aesToRec <$> Aeson.decode body

@@ -80,6 +80,8 @@ import Network.Bitcoin.BitX.Private.Quote import Network.Bitcoin.BitX.Private.Withdrawal +{-# ANN module ("HLint: ignore Use import/export shortcut" :: String) #-}+ {- | Create an additional account for the specified currency  Note that the 'id' field of the second parameter can be left blank. The call will return an `Account`

@@ -95,4 +95,3 @@  discardQuote :: BitXAuth -> Text -> IO (BitXAPIResponse OrderQuote) discardQuote auth qid = simpleBitXMETHAuth_ auth "DELETE" $ "quotes/" ++ Txt.unpack qid-

@@ -30,7 +30,7 @@ --    ErrorResponse err        ->
 --        error $ "BitX error received: \\"" ++ unpack (err ^. BitX.error) ++ "\\""
 --    ExceptionResponse ex     ->
---        error $ "Exception was thrown: \\"" ++ unpack ex ++ "\\""
+--        error $ "Exception was thrown: \\"" ++ show ex ++ "\\""
 --    UnparseableResponse resp ->
 --        error $ "Bad HTTP response; HTTP status code was: \\"" ++ (show . statusCode . responseStatus $ resp) ++ "\\"" -- @@@ -71,4 +71,3 @@  getTrades :: CcyPair -> IO (BitXAPIResponse [Trade]) getTrades cyp = simpleBitXGet_ $ "trades?pair=" ++ show cyp-

@@ -19,21 +19,18 @@     BitXAPIResponse(..)   ) where -import Network.HTTP.Conduit (Response(..))+import Network.HTTP.Conduit (Response(..), HttpException) import Data.ByteString.Lazy (ByteString) import Network.Bitcoin.BitX.Types-import Data.Text (Text)  -- | This retun type enumerates all possible failure modes. -data BitXAPIResponse rec =-      ExceptionResponse Text -- ^ Some exception occured while making the call to BitX, and this was-                             -- the exception text.+data BitXAPIResponse recd =+      ExceptionResponse HttpException -- ^ Some exception occured while making the call to BitX.     | ErrorResponse BitXError -- ^ BitX returned an error record instead of returning the data we                               -- were expecting.-    | ValidResponse rec -- ^ We received the data type 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. -deriving instance Show rec => Show (BitXAPIResponse rec)-deriving instance Eq rec => Eq (BitXAPIResponse rec)+deriving instance Show recd => Show (BitXAPIResponse recd)

@@ -31,17 +31,19 @@ import Data.Coerce #endif +{-# ANN module ("HLint: ignore Use camelCase" :: String) #-}+ timestampParse_ :: Integer -> UTCTime timestampParse_ = posixSecondsToUTCTime     . realToFrac     . ( / 1000)     . (fromIntegral :: Integer -> Scientific) -class (FromJSON aes) => BitXAesRecordConvert rec aes | rec -> aes where-    aesToRec :: aes -> rec+class (FromJSON aes) => BitXAesRecordConvert recd aes | recd -> aes where+    aesToRec :: aes -> recd -class POSTEncodeable rec where-    postEncode :: rec -> [(ByteString, ByteString)]+class POSTEncodeable recd where+    postEncode :: recd -> [(ByteString, ByteString)]   showableToBytestring_ :: (Show a) => a -> ByteString@@ -171,8 +173,8 @@  instance BitXAesRecordConvert Types.Order Order_ where     aesToRec (Order_ {..}) =-        Types.Order {orderVolume = (qsToScientific order'volume),-              orderPrice = (qsToScientific order'price)}+        Types.Order {orderVolume = qsToScientific order'volume,+              orderPrice = qsToScientific order'price}  -------------------------------------------- Orderbook type ---------------------------------------- @@ -190,9 +192,9 @@  instance BitXAesRecordConvert Types.Orderbook Orderbook_ where     aesToRec (Orderbook_ {..}) =-        Types.Orderbook {orderbookTimestamp = (tsmsToUTCTime orderbook'timestamp),-                  orderbookBids = (map aesToRec orderbook'bids),-                  orderbookAsks = (map aesToRec orderbook'asks)}+        Types.Orderbook {orderbookTimestamp = tsmsToUTCTime orderbook'timestamp,+                  orderbookBids = map aesToRec orderbook'bids,+                  orderbookAsks = map aesToRec orderbook'asks}  -------------------------------------------- Trade type -------------------------------------------- @@ -207,9 +209,9 @@  instance BitXAesRecordConvert Types.Trade Trade_ where     aesToRec (Trade_ {..}) =-        Types.Trade { tradeTimestamp = (tsmsToUTCTime trade'timestamp),-            tradeVolume = (qsToScientific trade'volume),-            tradePrice = (qsToScientific trade'price) }+        Types.Trade { tradeTimestamp = tsmsToUTCTime trade'timestamp,+            tradeVolume = qsToScientific trade'volume,+            tradePrice = qsToScientific trade'price }  ----------------------------------------- PublicTrades type ---------------------------------------- 

@@ -8,5 +8,5 @@ import Network.Bitcoin.BitX (BitXAesRecordConvert(..)) import Data.ByteString.Lazy (ByteString) -recordAesCheck :: (BitXAesRecordConvert rec aes, Show rec, Eq rec) => ByteString -> rec -> Expectation-recordAesCheck aesTxt recd = (fmap aesToRec $ decode aesTxt) `shouldBe` Just recd+recordAesCheck :: (BitXAesRecordConvert recd aes, Show recd, Eq recd) => ByteString -> recd -> Expectation+recordAesCheck aesTxt recd = fmap aesToRec (decode aesTxt) `shouldBe` Just recd

@@ -11,6 +11,8 @@ import Network.Bitcoin.BitX.Types import Data.Time.Clock.POSIX +{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}+ spec :: Spec spec =   describe "Lens functionality test" $

@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings, QuasiQuotes, DataKinds, TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings, DataKinds #-}  module Network.Bitcoin.BitX.Spec.Specs.NetSpec     (@@ -12,20 +12,20 @@ import Network.Bitcoin.BitX.Response  spec :: Spec-spec = do+spec =   describe "Public BitX connectivity" $ do-    it "getTicker connects to BitX and works" $ do+    it "getTicker connects to BitX and works" $       connectsAndParsesOkay $ getTicker XBTZAR-    it "getTickers connects to BitX and works" $ do-      connectsAndParsesOkay $ getTickers-    it "getOrderBook connects to BitX and works" $ do+    it "getTickers connects to BitX and works" $+      connectsAndParsesOkay getTickers+    it "getOrderBook connects to BitX and works" $       connectsAndParsesOkay $ getOrderBook XBTZAR-    it "getTrades connects to BitX and works" $ do+    it "getTrades connects to BitX and works" $       connectsAndParsesOkay $ getTrades XBTKES -connectsAndParsesOkay :: IO (BitXAPIResponse rec) -> Bool+connectsAndParsesOkay :: IO (BitXAPIResponse recd) -> Bool connectsAndParsesOkay = isValidResponse . unsafePerformIO -isValidResponse :: BitXAPIResponse rec -> Bool+isValidResponse :: BitXAPIResponse recd -> Bool isValidResponse (ValidResponse _) = True isValidResponse        _          = False