diff --git a/CHANGES b/CHANGES --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,6 @@ +v0.9.0.0 +* Use (strict) Text consistantly instead of random string-like types. BREAKING CHANGE. + v0.8.0.0 * Added Singapore Dollar. * The UnparseableResponse now provides the Aeson error. BREAKING CHANGE. diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2015, Tebello Thejane +Copyright (c) 2016, Tebello Thejane All rights reserved. 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.8.0.0 +version: 0.9.0.0 synopsis: A Haskell library for working with the BitX bitcoin exchange. description: 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,7 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Network.Bitcoin.BitX --- Copyright : 2015 Tebello Thejane +-- Copyright : 2016 Tebello Thejane -- License : BSD3 -- -- Maintainer : Tebello Thejane 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 @@ -15,18 +15,23 @@ import Network.Bitcoin.BitX.Types.Internal import qualified Network.HTTP.Client as NetCon import qualified Network.HTTP.Client.TLS as NetCon -import Network.HTTP.Types (status503) +import Network.HTTP.Types.Status (status503, status429) import Network.HTTP.Client (Response(..), Request(..)) import Control.Exception (try) import qualified Data.Aeson as Aeson (decode, eitherDecode) import qualified Data.ByteString.Lazy as BL +import Data.ByteString.Lazy (toStrict) import qualified Data.ByteString as BS 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 Lens.Micro ((^.)) import Control.Concurrent (threadDelay) +import Data.Text (Text, pack) +import Data.Text.Encoding (decodeUtf8) +import Data.Monoid ((<>)) #if __GLASGOW_HASKELL__ >= 710 -- <$> is in base since 4.8 (GHC 7.10) due to the AMP import Control.Applicative ((<|>)) @@ -34,11 +39,11 @@ import Control.Applicative ((<|>), (<$>)) #endif -bitXAPIPrefix :: String +bitXAPIPrefix :: Text bitXAPIPrefix = "https://api.mybitx.com/api/" -bitXAPIRoot :: String -bitXAPIRoot = bitXAPIPrefix ++ "1/" +bitXAPIRoot :: Text +bitXAPIRoot = bitXAPIPrefix <> "1/" globalManager :: IO NetCon.Manager globalManager = NetCon.newManager NetCon.tlsManagerSettings @@ -51,34 +56,34 @@ userID = Txt.encodeUtf8 (auth ^. Types.id) userSecret = Txt.encodeUtf8 (auth ^. Types.secret) -simpleBitXGetAuth_ :: BitXAesRecordConvert recd => BitXAuth -> String -> IO (BitXAPIResponse recd) +simpleBitXGetAuth_ :: BitXAesRecordConvert recd => BitXAuth -> Text -> IO (BitXAPIResponse recd) simpleBitXGetAuth_ auth verb = withSocketsDo $ rateLimit (authConnect auth - . fromJust . NetCon.parseUrl $ (bitXAPIRoot ++ verb)) + . fromJust . NetCon.parseUrl $ Txt.unpack (bitXAPIRoot <> verb)) consumeResponseIO simpleBitXPOSTAuth_ :: (BitXAesRecordConvert recd, POSTEncodeable inprec) => BitXAuth -> inprec - -> String -> IO (BitXAPIResponse recd) + -> Text -> IO (BitXAPIResponse recd) simpleBitXPOSTAuth_ auth encrec verb = withSocketsDo $ rateLimit (authConnect auth . NetCon.urlEncodedBody (postEncode encrec) - . fromJust . NetCon.parseUrl $ (bitXAPIRoot ++ verb)) + . fromJust . NetCon.parseUrl $ Txt.unpack (bitXAPIRoot <> verb)) consumeResponseIO simpleBitXMETHAuth_ :: BitXAesRecordConvert recd => BitXAuth -> BS.ByteString - -> String -> IO (BitXAPIResponse recd) + -> Text -> IO (BitXAPIResponse recd) simpleBitXMETHAuth_ auth meth verb = withSocketsDo $ rateLimit - (authConnect auth (fromJust (NetCon.parseUrl (bitXAPIRoot ++ verb))) { method = meth }) + (authConnect auth (fromJust (NetCon.parseUrl $ Txt.unpack (bitXAPIRoot <> verb))) { method = meth }) consumeResponseIO -simpleBitXGet_ :: BitXAesRecordConvert recd => String -> IO (BitXAPIResponse recd) +simpleBitXGet_ :: BitXAesRecordConvert recd => Text -> 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 $ Txt.unpack (bitXAPIRoot <> verb)) consumeResponseIO rateLimit :: IO (Either NetCon.HttpException c) -> (Either NetCon.HttpException c -> IO d) -> IO d @@ -107,9 +112,9 @@ bitXErrorOrPayload resp = fromJust $ ErrorResponse . aesToRec <$> Aeson.decode body -- is it a BitX error? <|> ValidResponse . aesToRec <$> eitherToMaybe respBody -- I can't get the typechecker to work if I use "Aeson.decode body" here - <|> Just (UnparseableResponse aesonErr resp) + <|> Just (UnparseableResponse aesonErr $ fmap (decodeUtf8 . toStrict) resp) where - aesonErr = fromLeft respBody + aesonErr = pack $ fromLeft respBody respBody = Aeson.eitherDecode body body = NetCon.responseBody resp @@ -122,5 +127,5 @@ eitherToMaybe (Right b) = Just b isRateLimited :: Either NetCon.HttpException a -> Bool -isRateLimited (Left (NetCon.StatusCodeException st _ _)) = st == status503 +isRateLimited (Left (NetCon.StatusCodeException st _ _)) = st == status503 || st == status429 isRateLimited _ = False 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,7 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Network.Bitcoin.BitX.Private --- Copyright : 2015 Tebello Thejane +-- Copyright : 2016 Tebello Thejane -- License : BSD3 -- -- Maintainer : Tebello Thejane @@ -72,13 +72,13 @@ import Network.Bitcoin.BitX.Types import Network.Bitcoin.BitX.Types.Internal import qualified Data.Text as Txt -import Control.Monad (liftM) import Network.Bitcoin.BitX.Response import Network.Bitcoin.BitX.Private.Order --import Network.Bitcoin.BitX.Private.Auth import Network.Bitcoin.BitX.Private.Quote import Network.Bitcoin.BitX.Private.Withdrawal +import Data.Monoid ((<>)) {-# ANN module ("HLint: ignore Use import/export shortcut" :: String) #-} @@ -112,12 +112,12 @@ @Perm_R_Addresses@ permission is required. -} -getFundingAddress :: BitXAuth -> Asset -> Maybe String -> IO (BitXAPIResponse FundingAddress) +getFundingAddress :: BitXAuth -> Asset -> Maybe Txt.Text -> IO (BitXAPIResponse FundingAddress) getFundingAddress auth fasset addr = simpleBitXGetAuth_ auth url where - url = "funding_address?asset=" ++ show fasset ++ case addr of + url = "funding_address?asset=" <> Txt.pack (show fasset) <> case addr of Nothing -> "" - Just ad -> "&address=" ++ ad + Just ad -> "&address=" <> ad {- | Create receive address @@ -164,7 +164,7 @@ -> Int -- ^ Last row returned, exclusive -> IO (BitXAPIResponse [Transaction]) getTransactions auth accid minr maxr = simpleBitXGetAuth_ auth $ - "accounts/" ++ Txt.unpack accid ++ "/transactions?min_row=" ++ show minr ++ "&max_row=" ++ show maxr + "accounts/" <> accid <> "/transactions?min_row=" <> Txt.pack (show minr) <> "&max_row=" <> Txt.pack (show maxr) {- | Pending transactions @@ -177,8 +177,8 @@ -} getPendingTransactions :: BitXAuth -> AccountID -> IO (BitXAPIResponse [Transaction]) -getPendingTransactions auth accid = liftM imebPendingTransactionsToimebTransactions $ simpleBitXGetAuth_ auth $ - "accounts/" ++ Txt.unpack accid ++ "/pending" +getPendingTransactions auth accid = fmap imebPendingTransactionsToimebTransactions $ simpleBitXGetAuth_ auth $ + "accounts/" <> accid <> "/pending" where imebPendingTransactionsToimebTransactions (ValidResponse v) = ValidResponse $ pendingTransactionsToTransactions v imebPendingTransactionsToimebTransactions (ExceptionResponse x) = ExceptionResponse x 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,7 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Network.Bitcoin.BitX.Private.Order --- Copyright : 2015 Tebello Thejane +-- Copyright : 2016 Tebello Thejane -- License : BSD3 -- -- Maintainer : Tebello Thejane @@ -32,6 +32,7 @@ import Network.Bitcoin.BitX.Types import qualified Data.Text as Txt import Network.Bitcoin.BitX.Response +import Data.Monoid ((<>)) {- | Returns a list of the most recently placed orders. @@ -49,11 +50,11 @@ getAllOrders :: BitXAuth -> Maybe CcyPair -> Maybe RequestStatus -> IO (BitXAPIResponse [PrivateOrder]) getAllOrders auth cpair stat = simpleBitXGetAuth_ auth url where - url = "listorders" ++ case (cpair, stat) of + url = "listorders" <> case (cpair, stat) of (Nothing, Nothing) -> "" - (Just pr, Nothing) -> "?pair=" ++ show pr - (Nothing, Just st) -> "?state=" ++ show st - (Just pr, Just st) -> "?pair=" ++ show pr ++ "&state=" ++ show st + (Just pr, Nothing) -> "?pair=" <> Txt.pack (show pr) + (Nothing, Just st) -> "?state=" <> Txt.pack (show st) + (Just pr, Just st) -> "?pair=" <> Txt.pack (show pr) <> "&state=" <> Txt.pack (show st) {- | Create a new order. @@ -80,7 +81,7 @@ -} getOrder :: BitXAuth -> OrderID -> IO (BitXAPIResponse PrivateOrderWithTrades) -getOrder auth oid = simpleBitXGetAuth_ auth $ "orders/" ++ Txt.unpack oid +getOrder auth oid = simpleBitXGetAuth_ auth $ "orders/" <> oid {- | Create a new market order. 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,7 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Network.Bitcoin.BitX.Private.Quote --- Copyright : 2015 Tebello Thejane +-- Copyright : 2016 Tebello Thejane -- License : BSD3 -- -- Maintainer : Tebello Thejane @@ -38,6 +38,7 @@ import Data.Text (Text) import qualified Data.Text as Txt import Network.Bitcoin.BitX.Response +import Data.Monoid ((<>)) {- | Create a quote @@ -70,7 +71,7 @@ -} getQuote :: BitXAuth -> Text -> IO (BitXAPIResponse OrderQuote) -getQuote auth qid = simpleBitXGetAuth_ auth $ "quotes/" ++ Txt.unpack qid +getQuote auth qid = simpleBitXGetAuth_ auth $ "quotes/" <> qid {- | Exercise a quote @@ -83,7 +84,7 @@ -} exerciseQuote :: BitXAuth -> Text -> IO (BitXAPIResponse OrderQuote) -exerciseQuote auth qid = simpleBitXMETHAuth_ auth "PUT" $ "quotes/" ++ Txt.unpack qid +exerciseQuote auth qid = simpleBitXMETHAuth_ auth "PUT" $ "quotes/" <> qid {- | Discard a quote @@ -94,4 +95,4 @@ -} discardQuote :: BitXAuth -> Text -> IO (BitXAPIResponse OrderQuote) -discardQuote auth qid = simpleBitXMETHAuth_ auth "DELETE" $ "quotes/" ++ Txt.unpack qid +discardQuote auth qid = simpleBitXMETHAuth_ auth "DELETE" $ "quotes/" <> qid 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,7 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Network.Bitcoin.BitX.Private.Withdrawal --- Copyright : 2015 Tebello Thejane +-- Copyright : 2016 Tebello Thejane -- License : BSD3 -- -- Maintainer : Tebello Thejane @@ -25,6 +25,7 @@ import qualified Data.Text as Txt import Data.Text (Text) import Network.Bitcoin.BitX.Response +import Data.Monoid ((<>)) {- | List withdrawal requests @@ -52,7 +53,7 @@ getWithdrawalRequest :: BitXAuth -> Text -> IO (BitXAPIResponse WithdrawalRequest) -getWithdrawalRequest auth wthid = simpleBitXGetAuth_ auth $ "withdrawals/" ++ Txt.unpack wthid +getWithdrawalRequest auth wthid = simpleBitXGetAuth_ auth $ "withdrawals/" <> wthid --{- | Cancel a withdrawal request 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,7 +1,8 @@ +{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- Module : Network.Bitcoin.BitX.Public --- Copyright : 2015 Tebello Thejane +-- Copyright : 2016 Tebello Thejane -- License : BSD3 -- -- Maintainer : Tebello Thejane @@ -51,11 +52,13 @@ import Network.Bitcoin.BitX.Types.Internal import Network.Bitcoin.BitX.Response import Data.Time.Clock (UTCTime) +import Data.Text (pack) +import Data.Monoid ((<>)) {- | Returns the latest ticker indicators. -} getTicker :: CcyPair -> IO (BitXAPIResponse Ticker) -getTicker cyp = simpleBitXGet_ $ "ticker?pair=" ++ show cyp +getTicker cyp = simpleBitXGet_ $ "ticker?pair=" <> pack (show cyp) {- | Returns the latest ticker indicators from all active BitX exchanges. -} @@ -68,10 +71,10 @@ Note that multiple orders at the same price are not necessarily conflated. -} getOrderBook :: CcyPair -> IO (BitXAPIResponse Orderbook) -getOrderBook cyp = simpleBitXGet_ $ "orderbook?pair=" ++ show cyp +getOrderBook cyp = simpleBitXGet_ $ "orderbook?pair=" <> pack (show cyp) {- | Returns a list of the most recent trades -} getTrades :: Maybe UTCTime -> CcyPair -> IO (BitXAPIResponse [Trade]) -getTrades Nothing cyp = simpleBitXGet_ $ "trades?pair=" ++ show cyp -getTrades (Just since) cyp = simpleBitXGet_ $ "trades?pair=" ++ show cyp ++ "since=" ++ show (timeToTimestamp since) +getTrades Nothing cyp = simpleBitXGet_ $ "trades?pair=" <> pack (show cyp) +getTrades (Just since) cyp = simpleBitXGet_ $ "trades?pair=" <> pack (show cyp) <> "since=" <> pack (show (timeToTimestamp since)) 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,7 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Network.Bitcoin.BitX.Response --- Copyright : 2015 Tebello Thejane +-- Copyright : 2016 Tebello Thejane -- License : BSD3 -- -- Maintainer : Tebello Thejane @@ -20,8 +20,8 @@ ) where import Network.HTTP.Client (Response(..), HttpException) -import Data.ByteString.Lazy (ByteString) import Network.Bitcoin.BitX.Types +import Data.Text (Text) -- | This retun type enumerates all possible failure modes. @@ -30,9 +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 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. + | UnparseableResponse Text (Response Text) -- ^ 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) 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,7 +4,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Network.Bitcoin.BitX.Types --- Copyright : 2015 Tebello Thejane +-- Copyright : 2016 Tebello Thejane -- License : BSD3 -- -- Maintainer : Tebello Thejane