diff --git a/CHANGES b/CHANGES new file mode 100644 --- /dev/null +++ b/CHANGES @@ -0,0 +1,9 @@ +v0.2.0.0 +* Replaced Decimal with Scientific. BREAKING CHANGE. +* Divided much of the Private module into smaller sub-modules. BREAKING CHANGE. +* Added the new endpoint for creating accounts. +* Remove ill-thought-out Auth module. +* Lots of internal improvements. + +v0.1.0.0 +* Initial release! diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,5 +1,35 @@ [![Build Status](https://travis-ci.org/tebello-thejane/bitx-haskell.svg?branch=master)](https://travis-ci.org/tebello-thejane/bitx-haskell) +[![Hackage](https://budueba.com/hackage/bitx-bitcoin)](https://hackage.haskell.org/package/bitx-bitcoin) +[![CC0 1.0 Universal (Public Domain)](http://i.creativecommons.org/p/zero/1.0/88x31.png)](http://creativecommons.org/publicdomain/zero/1.0/) + (Hopefully useful) Haskell bindings to the BitX bitcoin exchange's API. -**This library is not yet complete.** +As a minimal example, to get the current selling price (in South African Rand) of bitcoin on the BitX exchange, do the following: + +```haskell +{-# LANGUAGE QuasiQuotes #-} + +import Record.Lens (view) +import Record (lens) +import Network.Bitcoin.BitX (BitXAPIResponse(..), getTicker, CcyPair(..)) +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 (view [lens| ask |] tic) + ErrorResponse err -> + error $ "BitX error received: \"" ++ (unpack (view [lens| error |] err)) ++ "\"" + ExceptionResponse ex -> + error $ "Exception was thrown: \"" ++ (unpack ex) ++ "\"" + UnparseableResponse resp -> + error $ "Bad HTTP response; HTTP status code was: \"" ++ (show . statusCode . responseStatus $ resp) ++ "\"" +``` + +Note that the code snippet above depends on [http-types](https://hackage.haskell.org/package/http-types), [http-conduit](https://hackage.haskell.org/package/http-conduit), [record](https://hackage.haskell.org/package/record), and finally **bitx-bitcoin**. + +Note that this library **will not** build on Windows currently, due to networking dependencies which have no Windows support. diff --git a/bitx-bitcoin.cabal b/bitx-bitcoin.cabal --- a/bitx-bitcoin.cabal +++ b/bitx-bitcoin.cabal @@ -1,15 +1,12 @@ --- Initial bitx-bitcoin.cabal generated by cabal init. For further --- documentation, see http://haskell.org/cabal/users-guide/ - name: bitx-bitcoin -version: 0.1.0.0 +version: 0.2.0.0 synopsis: A Haskell library for working with the BitX bitcoin exchange. description: Haskell bindings to the BitX REST API, as described here: . . Note that since this library interfaces directly with a financial API, great care - must be taken in its use. In particular, the author cannot be held account for any + must be taken in its use. In particular, the author cannot be held accountable for any financial losses as a result of programming error, whether that error is in your code, the code of the author of this library, or BitX's code. This is just common sense. . @@ -27,15 +24,18 @@ maintainer: Tebello Thejane -category: Web +category: Web, Bitcoin, Finance build-type: Custom extra-source-files: README.md + CHANGES cabal-version: >=1.10 +homepage: https://github.com/tebello-thejane/bitx-haskell + -------------------------------------------------------------------------------- library @@ -45,7 +45,9 @@ Network.Bitcoin.BitX.Private Network.Bitcoin.BitX.Types Network.Bitcoin.BitX.Private.Quote - Network.Bitcoin.BitX.Private.Auth + -- Network.Bitcoin.BitX.Private.Auth + Network.Bitcoin.BitX.Private.Order + Network.Bitcoin.BitX.Private.Withdrawal Network.Bitcoin.BitX.Response ghc-options: -Wall @@ -59,7 +61,6 @@ -- LANGUAGE extensions used by modules in this package. -- other-extensions: - -- Other library packages from which modules are imported. build-depends: base >=4.5 && <5, aeson >= 0.8.0.0, record >= 0.3.1.1, @@ -67,9 +68,9 @@ time, http-conduit >= 2.0.0, bytestring >= 0.10.0.0, - Decimal >= 0.3.1, network >= 2.0, - split >= 0.2.0.0 + split >= 0.2.0.0, + scientific default-language: Haskell2010 hs-source-dirs: src @@ -101,3 +102,10 @@ record, bytestring, time + other-modules: + Network.Bitcoin.BitX.Spec.Common + Network.Bitcoin.BitX.Spec.Specs.AesonRecordSpec + Network.Bitcoin.BitX.Spec.Specs.NetSpec + Network.Bitcoin.BitX.Spec.Specs.PostSpec + Network.Bitcoin.BitX.Spec.Specs.JsonSpec + 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 @@ -20,7 +20,9 @@ module Network.Bitcoin.BitX.Private, module Network.Bitcoin.BitX.Public, module Network.Bitcoin.BitX.Private.Quote, - module Network.Bitcoin.BitX.Private.Auth, + --module Network.Bitcoin.BitX.Private.Auth, + module Network.Bitcoin.BitX.Private.Order, + module Network.Bitcoin.BitX.Private.Withdrawal, module Network.Bitcoin.BitX.Response, BitXAesRecordConvert(..), POSTEncodeable(..) @@ -31,6 +33,8 @@ import Network.Bitcoin.BitX.Private import Network.Bitcoin.BitX.Public import Network.Bitcoin.BitX.Private.Quote -import Network.Bitcoin.BitX.Private.Auth +--import Network.Bitcoin.BitX.Private.Auth +import Network.Bitcoin.BitX.Private.Order +import Network.Bitcoin.BitX.Private.Withdrawal import Network.Bitcoin.BitX.Types.Internal import Network.Bitcoin.BitX.Response 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 @@ -26,6 +26,7 @@ import qualified Data.Text.Encoding as Txt import qualified Data.Text as Txt import Network.Bitcoin.BitX.Response +import Control.Applicative ((<$>), (<|>)) bitXAPIPrefix :: String bitXAPIPrefix = "https://api.mybitx.com/api/" @@ -40,7 +41,7 @@ userSecret . fromJust . NetCon.parseUrl $ (bitXAPIRoot ++ verb) :: IO (Either SomeException (Response BL.ByteString)) - consumeResponseBody_ response + return $ consumeResponseBody_ response where userID = Txt.encodeUtf8 $ (view [lens| id |] auth) userSecret = Txt.encodeUtf8 $ (view [lens| secret |] auth) @@ -54,7 +55,7 @@ . NetCon.urlEncodedBody (postEncode encrec) . fromJust . NetCon.parseUrl $ (bitXAPIRoot ++ verb) :: IO (Either SomeException (Response BL.ByteString)) - consumeResponseBody_ response + return $ consumeResponseBody_ response where userID = Txt.encodeUtf8 $ (view [lens| id |] auth) userSecret = Txt.encodeUtf8 $ (view [lens| secret |] auth) @@ -67,7 +68,7 @@ userID userSecret $ initReq :: IO (Either SomeException (Response BL.ByteString)) - consumeResponseBody_ response + return $ consumeResponseBody_ response where userID = Txt.encodeUtf8 $ (view [lens| id |] auth) userSecret = Txt.encodeUtf8 $ (view [lens| secret |] auth) @@ -77,32 +78,26 @@ resp <- try . NetCon.withManager . NetCon.httpLbs . fromJust . NetCon.parseUrl $ (bitXAPIRoot ++ verb) :: IO (Either SomeException (Response BL.ByteString)) - consumeResponse resp + return $ consumeResponse resp consumeResponse :: BitXAesRecordConvert rec aes => Either SomeException (NetCon.Response BL.ByteString) - -> IO (BitXAPIResponse rec) + -> BitXAPIResponse rec consumeResponse resp = case resp of - Left ex -> return $ ExceptionResponse . Txt.pack . show $ ex + Left ex -> ExceptionResponse . Txt.pack . show $ ex Right k -> bitXErrorOrPayload k consumeResponseBody_ :: BitXAesRecordConvert rec aes => Either SomeException (NetCon.Response BL.ByteString) - -> IO (BitXAPIResponse rec) + -> BitXAPIResponse rec consumeResponseBody_ resp = case resp of - Left ex -> return $ ExceptionResponse . Txt.pack . show $ ex + Left ex -> ExceptionResponse . Txt.pack . show $ ex Right k -> bitXErrorOrPayload k -bitXErrorOrPayload :: BitXAesRecordConvert rec aes => Response BL.ByteString -> IO (BitXAPIResponse rec) -bitXErrorOrPayload resp = do - let respTE = Aeson.decode body -- is it a BitX error? - case respTE of - Just e -> return . ErrorResponse . aesToRec $ e - Nothing -> do - let respTT = Aeson.decode body - case respTT of - Just t -> return . ValidResponse . aesToRec $ t - Nothing -> return . UnparseableResponse $ resp - where - body = NetCon.responseBody resp - +bitXErrorOrPayload :: BitXAesRecordConvert rec aes => Response BL.ByteString -> BitXAPIResponse rec +bitXErrorOrPayload resp = fromJust $ + ErrorResponse . aesToRec <$> Aeson.decode body -- is it a BitX error? + <|> ValidResponse . aesToRec <$> Aeson.decode body + <|> Just (UnparseableResponse resp) + where + body = NetCon.responseBody resp 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 @@ -45,78 +45,44 @@ module Network.Bitcoin.BitX.Private ( - getAllOrders, - postOrder, - stopOrder, - getOrder, + newAccount, getBalances, getFundingAddress, newFundingAddress, - getWithdrawalRequests, - newWithdrawalRequest, - getWithdrawalRequest, sendToAddress, - --cancelWithdrawalRequest, getTransactions, - getPendingTransactions + getPendingTransactions, + + module Network.Bitcoin.BitX.Private.Order, + module Network.Bitcoin.BitX.Private.Quote, + --module Network.Bitcoin.BitX.Private.Auth + module Network.Bitcoin.BitX.Private.Withdrawal ) where import Network.Bitcoin.BitX.Internal import Network.Bitcoin.BitX.Types import Network.Bitcoin.BitX.Types.Internal import qualified Data.Text as Txt -import Data.Text (Text) import Control.Monad (liftM) import Network.Bitcoin.BitX.Response -{- | Returns a list of the most recently placed orders. - -If the second parameter is @Nothing@ then this will return orders for all markets, whereas if it is -@Just cpy@ for some @CcyPair cpy@ then the results will be specific to that market. - -If the third parameter is @Nothing@ then this will return orders in all states, whereas if it is -@Just COMPLETE@ or @Just PENDING@ then it will return only completed or pending orders, respectively. - -This list is truncated after 100 items. - -@Perm_R_Orders@ permission is required. - -} - -getAllOrders :: BitXAuth -> Maybe CcyPair -> Maybe RequestStatus -> IO (BitXAPIResponse [PrivateOrder]) -getAllOrders auth pair status = simpleBitXGetAuth_ auth url - where - url = "listorders" ++ case (pair, status) 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 - -{- | Create a new order. - -__Warning! Orders cannot be reversed once they have executed. Please ensure your program has been__ -__thoroughly tested before submitting orders.__ - -@Perm_W_Orders@ permission is required. - -} - -postOrder :: BitXAuth -> OrderRequest -> IO (BitXAPIResponse OrderID) -postOrder auth oreq = simpleBitXPOSTAuth_ auth oreq "postorder" - -{- | Request to stop an order. +import Network.Bitcoin.BitX.Private.Order +--import Network.Bitcoin.BitX.Private.Auth +import Network.Bitcoin.BitX.Private.Quote +import Network.Bitcoin.BitX.Private.Withdrawal -@Perm_W_Orders@ permission is required. - -} +{- | Create an additional account for the specified currency -stopOrder :: BitXAuth -> OrderID -> IO (BitXAPIResponse RequestSuccess) -stopOrder auth oid = simpleBitXPOSTAuth_ auth oid "stoporder" +Note that the 'id' field of the second parameter can be left blank. The call will return an `Account` +object resembling the parameter, but with the 'id' field filled in with the newly created account's +id. -{- | Get an order by its ID +You must be verified to trade the currency in question in order to be able to create an account. -@Perm_R_Orders@ permission is required. - -} +@Perm_W_Addresses@ permission required. -} -getOrder :: BitXAuth -> OrderID -> IO (BitXAPIResponse PrivateOrderWithTrades) -getOrder auth oid = simpleBitXGetAuth_ auth $ "orders/" ++ Txt.unpack oid +newAccount :: BitXAuth -> Account -> IO (BitXAPIResponse Account) +newAccount auth acc = simpleBitXPOSTAuth_ auth acc "accounts" {- | Return account balances @@ -151,43 +117,6 @@ newFundingAddress :: BitXAuth -> Asset -> IO (BitXAPIResponse FundingAddress) newFundingAddress auth asset = simpleBitXPOSTAuth_ auth asset "funding_address" - -{- | List withdrawal requests - -Returns a list of withdrawal requests. - -@Perm_R_Withdrawals@ permission required.-} - -getWithdrawalRequests :: BitXAuth -> IO (BitXAPIResponse [WithdrawalRequest]) -getWithdrawalRequests auth = simpleBitXGetAuth_ auth "withdrawals/" - -{- | Request a withdrawal - -Creates a new withdrawal request. - -@Perm_W_Withdrawals@ permission required.-} - -newWithdrawalRequest :: BitXAuth -> NewWithdrawal -> IO (BitXAPIResponse WithdrawalRequest) -newWithdrawalRequest auth nwithd = simpleBitXPOSTAuth_ auth nwithd "withdrawals" - -{- | Get the status of a withdrawal request - -Returns the status of a particular withdrawal request. - -@Perm_R_Withdrawals@ permission required.-} - -getWithdrawalRequest :: BitXAuth -> Text -- ^ The withdrawal ID - -> IO (BitXAPIResponse WithdrawalRequest) -getWithdrawalRequest auth wthid = simpleBitXGetAuth_ auth $ "withdrawals/" ++ Txt.unpack wthid - -{- | Cancel a withdrawal request - -This can only be done if the request is still in state PENDING. - -@Perm_W_Withdrawals@ permission required.-} - ---cancelWithdrawalRequest :: BitXAuth -> String -> IO (Maybe (Either BitXError WithdrawalRequest)) ---cancelWithdrawalRequest auth wthid = simpleBitXMETHAuth_ auth "DELETE" $ "withdrawals/" ++ wthid {- | Send Bitcoin from your account to a Bitcoin address or email address. diff --git a/src/Network/Bitcoin/BitX/Private/Auth.hs b/src/Network/Bitcoin/BitX/Private/Auth.hs deleted file mode 100644 --- a/src/Network/Bitcoin/BitX/Private/Auth.hs +++ /dev/null @@ -1,73 +0,0 @@ -{-# LANGUAGE OverloadedStrings, QuasiQuotes, DataKinds #-} - ------------------------------------------------------------------------------ --- | --- Module : Network.Bitcoin.BitX.Private.Auth --- Copyright : No Rights Reserved --- License : Public Domain --- --- Maintainer : Tebello Thejane --- Stability : Experimental --- Portability : non-portable (GHC Extensions) --- --- The single function in this module, allows your application to use the --- private BitX API via OAuth2. --- --- To use OAuth2, you first need to contact the BitX team , --- and provide them with --- * Application name --- * Application description --- * Website URL --- * Permissions required --- * Redirect URL --- * Your BitX account username --- --- Next, the user needs to be sent to , --- where they can confirm the request. If they do confirm the request, they --- will be sent to your redirect URL, with an authorisation code as one of --- the GET parameter: --- --- The permissions are explained in the "Network.Bitcoin.BitX.Private" module. --- ------------------------------------------------------------------------------ - -module Network.Bitcoin.BitX.Private.Auth - ( - authGrant - ) where - -import Network.Bitcoin.BitX.Types -import Network.Bitcoin.BitX.Internal -import qualified Network.HTTP.Conduit as NetCon -import Network.HTTP.Conduit (Response(..)) -import Control.Exception (try, SomeException) -import qualified Data.ByteString.Lazy as BL -import Data.Maybe (fromJust) -import Network (withSocketsDo) -import Record (lens) -import Record.Lens (view) -import qualified Data.Text.Encoding as Txt -import Data.Text (Text) -import Network.Bitcoin.BitX.Response - -{- | Grant - -Once your application has received an authorization code, it can exchange it for an API key. This is -done by calling the grant endpoint. The resulting API key can be used to access the BitX API calls -for which it has the appropriate permissions. --} - -authGrant :: BitXClientAuth -> Text -> IO (BitXAPIResponse BitXAuth) -authGrant cauth authCode = withSocketsDo $ do - response <- try . NetCon.withManager . NetCon.httpLbs . NetCon.applyBasicAuth - userID - userSecret - . NetCon.urlEncodedBody - [("grant_type", "authorization_code"), - ("code", Txt.encodeUtf8 authCode)] - . fromJust . NetCon.parseUrl $ bitXAPIPrefix ++ "oauth2/grant" - :: IO (Either SomeException (Response BL.ByteString)) - consumeResponseBody_ response - where - userID = Txt.encodeUtf8 $ view [lens| id |] cauth - userSecret = Txt.encodeUtf8 $ view [lens| secret |] cauth diff --git a/src/Network/Bitcoin/BitX/Private/Order.hs b/src/Network/Bitcoin/BitX/Private/Order.hs new file mode 100644 --- /dev/null +++ b/src/Network/Bitcoin/BitX/Private/Order.hs @@ -0,0 +1,82 @@ +{-# LANGUAGE OverloadedStrings #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Network.Bitcoin.BitX.Private.Order +-- Copyright : No Rights Reserved +-- License : Public Domain +-- +-- Maintainer : Tebello Thejane +-- Stability : Experimental +-- Portability : non-portable (GHC Extensions) +-- +-- Creating and working with orders +-- +-- Trading on the market is done by submitting trade orders. After a new order has been created, +-- it is submitted for processing by the order matching engine. The order then either matches +-- against an existing order in the order book and is filled or it rests in the order book until it +-- is stopped. +-- +----------------------------------------------------------------------------- + +module Network.Bitcoin.BitX.Private.Order + ( + getAllOrders, + postOrder, + stopOrder, + getOrder + ) where + +import Network.Bitcoin.BitX.Internal +import Network.Bitcoin.BitX.Types +import qualified Data.Text as Txt +import Network.Bitcoin.BitX.Response + +{- | Returns a list of the most recently placed orders. + +If the second parameter is @Nothing@ then this will return orders for all markets, whereas if it is +@Just cpy@ for some @CcyPair cpy@ then the results will be specific to that market. + +If the third parameter is @Nothing@ then this will return orders in all states, whereas if it is +@Just COMPLETE@ or @Just PENDING@ then it will return only completed or pending orders, respectively. + +This list is truncated after 100 items. + +@Perm_R_Orders@ permission is required. + -} + +getAllOrders :: BitXAuth -> Maybe CcyPair -> Maybe RequestStatus -> IO (BitXAPIResponse [PrivateOrder]) +getAllOrders auth pair status = simpleBitXGetAuth_ auth url + where + url = "listorders" ++ case (pair, status) 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 + +{- | Create a new order. + +__Warning! Orders cannot be reversed once they have executed. Please ensure your program has been__ +__thoroughly tested before submitting orders.__ + +@Perm_W_Orders@ permission is required. + -} + +postOrder :: BitXAuth -> OrderRequest -> IO (BitXAPIResponse OrderID) +postOrder auth oreq = simpleBitXPOSTAuth_ auth oreq "postorder" + +{- | Request to stop an order. + +@Perm_W_Orders@ permission is required. + -} + +stopOrder :: BitXAuth -> OrderID -> IO (BitXAPIResponse RequestSuccess) +stopOrder auth oid = simpleBitXPOSTAuth_ auth oid "stoporder" + +{- | Get an order by its ID + +@Perm_R_Orders@ permission is required. + -} + +getOrder :: BitXAuth -> OrderID -> IO (BitXAPIResponse PrivateOrderWithTrades) +getOrder auth oid = simpleBitXGetAuth_ auth $ "orders/" ++ Txt.unpack oid diff --git a/src/Network/Bitcoin/BitX/Private/Withdrawal.hs b/src/Network/Bitcoin/BitX/Private/Withdrawal.hs new file mode 100644 --- /dev/null +++ b/src/Network/Bitcoin/BitX/Private/Withdrawal.hs @@ -0,0 +1,64 @@ +{-# LANGUAGE OverloadedStrings #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Network.Bitcoin.BitX.Private.Withdrawal +-- Copyright : No Rights Reserved +-- License : Public Domain +-- +-- Maintainer : Tebello Thejane +-- Stability : Experimental +-- Portability : non-portable (GHC Extensions) +-- +----------------------------------------------------------------------------- + +module Network.Bitcoin.BitX.Private.Withdrawal + ( + getWithdrawalRequests, + newWithdrawalRequest, + getWithdrawalRequest + --cancelWithdrawalRequest + ) where + +import Network.Bitcoin.BitX.Internal +import Network.Bitcoin.BitX.Types +import qualified Data.Text as Txt +import Data.Text (Text) +import Network.Bitcoin.BitX.Response + +{- | List withdrawal requests + +Returns a list of withdrawal requests. + +@Perm_R_Withdrawals@ permission required.-} + +getWithdrawalRequests :: BitXAuth -> IO (BitXAPIResponse [WithdrawalRequest]) +getWithdrawalRequests auth = simpleBitXGetAuth_ auth "withdrawals" + +{- | Request a withdrawal + +Creates a new withdrawal request. + +@Perm_W_Withdrawals@ permission required.-} + +newWithdrawalRequest :: BitXAuth -> NewWithdrawal -> IO (BitXAPIResponse WithdrawalRequest) +newWithdrawalRequest auth nwithd = simpleBitXPOSTAuth_ auth nwithd "withdrawals" + +{- | Get the status of a withdrawal request + +Returns the status of a particular withdrawal request. + +@Perm_R_Withdrawals@ permission required.-} + +getWithdrawalRequest :: BitXAuth -> Text -- ^ The withdrawal ID + -> IO (BitXAPIResponse WithdrawalRequest) +getWithdrawalRequest auth wthid = simpleBitXGetAuth_ auth $ "withdrawals/" ++ Txt.unpack wthid + +--{- | Cancel a withdrawal request + +--This can only be done if the request is still in state PENDING. + +-- @Perm_W_Withdrawals@ permission required.-} + +--cancelWithdrawalRequest :: BitXAuth -> String -> IO (Maybe (Either BitXError WithdrawalRequest)) +--cancelWithdrawalRequest auth wthid = simpleBitXMETHAuth_ auth "DELETE" $ "withdrawals/" ++ wthid 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 @@ -15,15 +15,25 @@ -- @ --{-\# LANGUAGE QuasiQuotes \#-} -- ---import Record.Lens ---import Record ---import Network.Bitcoin.BitX +--import Record.Lens (view) +--import Record (lens) +--import Network.Bitcoin.BitX (BitXAPIResponse(..), getTicker, CcyPair(..)) +--import Data.Text (unpack) +--import Network.HTTP.Types.Status (Status(..)) +--import Network.HTTP.Conduit (responseStatus) -- +--main :: IO () --main = do --- bitXResponse <- 'getTicker' 'XBTZAR' +-- bitXResponse <- getTicker XBTZAR -- case bitXResponse of --- 'ValidResponse' tic -> print ('view' [lens| ask |] tic) --- _ -> error "Ah well..." +-- ValidResponse tic -> print (view [lens| ask |] tic) +-- ErrorResponse err -> +-- error $ "BitX error received: \"" ++ (unpack (view [lens| error |] err)) ++ "\"" +-- ExceptionResponse ex -> +-- error $ "Exception was thrown: \"" ++ (unpack ex) ++ "\"" +-- UnparseableResponse resp -> +-- error $ "Bad HTTP response; HTTP status code was: \"" +-- ++ (show . statusCode . responseStatus $ resp) ++ "\"" -- @ -- ----------------------------------------------------------------------------- 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 @@ -1,7 +1,6 @@ {-# LANGUAGE DeriveGeneric, DefaultSignatures, QuasiQuotes, OverloadedStrings, DataKinds, MultiParamTypeClasses #-} - ----------------------------------------------------------------------------- -- | -- Module : Network.Bitcoin.BitX.Types @@ -19,7 +18,7 @@ -- to avoid using record field prefixes and other awkward hacks to get around -- the fact that Haskell does not yet have a real records' system. -- --- For example, the declaration of `BitXError` is +-- For example, the declaration of `BitXAuth` is -- -- @ -- type BitXAuth = @@ -81,7 +80,8 @@ OrderQuote, QuoteType(..), BitXClientAuth, - Transaction + Transaction, + Account ) where import Data.Aeson (FromJSON(..)) @@ -89,7 +89,7 @@ import Data.Time.Clock import Record import GHC.Generics (Generic) -import Data.Decimal +import Data.Scientific (Scientific) -- | A possible error which the BitX API might return, -- instead of returning the requested data. Note that as yet there is no @@ -115,21 +115,21 @@ -- @ --type Ticker = -- [record| --- {ask :: 'Decimal', +-- {ask :: 'Scientific', -- timestamp :: 'UTCTime', --- bid :: 'Decimal', --- rolling24HourVolume :: 'Decimal', --- lastTrade :: 'Decimal', +-- bid :: 'Scientific', +-- rolling24HourVolume :: 'Scientific', +-- lastTrade :: 'Scientific', -- pair :: 'CcyPair'} |] -- @ type Ticker = [record| - {ask :: Decimal, + {ask :: Scientific, timestamp :: UTCTime, - bid :: Decimal, - rolling24HourVolume :: Decimal, - lastTrade :: Decimal, + bid :: Scientific, + rolling24HourVolume :: Scientific, + lastTrade :: Scientific, pair :: CcyPair} |] -- | A currency pair @@ -175,14 +175,14 @@ -- @ --type Order = -- [record| --- {volume :: 'Decimal', --- price :: 'Decimal'} |] +-- {volume :: 'Scientific', +-- price :: 'Scientific'} |] -- @ type Order = [record| - {volume :: Decimal, - price :: Decimal} |] + {volume :: Scientific, + price :: Scientific} |] -- | Convenient type alias for a bid order type Bid = Order @@ -192,9 +192,9 @@ type Trade = [record| - {volume :: Decimal, + {volume :: Scientific, timestamp :: UTCTime, - price :: Decimal} |] + price :: Scientific} |] -- | An auth type used by all private API calls, after authorisation. -- @@ -217,14 +217,14 @@ -- @ --type PrivateOrder = -- [record| --- {base :: 'Decimal', --- counter :: 'Decimal', +-- {base :: 'Scientific', +-- counter :: 'Scientific', -- creationTimestamp :: 'UTCTime', -- expirationTimestamp :: 'UTCTime', --- feeBase :: 'Decimal', --- feeCounter :: 'Decimal', --- limitPrice :: 'Decimal', --- limitVolume :: 'Decimal', +-- feeBase :: 'Scientific', +-- feeCounter :: 'Scientific', +-- limitPrice :: 'Scientific', +-- limitVolume :: 'Scientific', -- id :: 'OrderID', -- pair :: 'CcyPair', -- state :: 'RequestStatus', @@ -232,14 +232,14 @@ -- @ type PrivateOrder = [record| - {base :: Decimal, - counter :: Decimal, + {base :: Scientific, + counter :: Scientific, creationTimestamp :: UTCTime, expirationTimestamp :: UTCTime, - feeBase :: Decimal, - feeCounter :: Decimal, - limitPrice :: Decimal, - limitVolume :: Decimal, + feeBase :: Scientific, + feeCounter :: Scientific, + limitPrice :: Scientific, + limitVolume :: Scientific, id :: OrderID, pair :: CcyPair, state :: RequestStatus, @@ -251,14 +251,14 @@ -- @ --type PrivateOrderWithTrades = -- [record| --- {base :: 'Decimal', --- counter :: 'Decimal', +-- {base :: 'Scientific', +-- counter :: 'Scientific', -- creationTimestamp :: 'UTCTime', -- expirationTimestamp :: 'UTCTime', --- feeBase :: 'Decimal', --- feeCounter :: 'Decimal', --- limitPrice :: 'Decimal', --- limitVolume :: 'Decimal', +-- feeBase :: 'Scientific', +-- feeCounter :: 'Scientific', +-- limitPrice :: 'Scientific', +-- limitVolume :: 'Scientific', -- id :: 'OrderID', -- pair :: 'CcyPair', -- state :: 'RequestStatus', @@ -267,14 +267,14 @@ -- @ type PrivateOrderWithTrades = [record| - {base :: Decimal, - counter :: Decimal, + {base :: Scientific, + counter :: Scientific, creationTimestamp :: UTCTime, expirationTimestamp :: UTCTime, - feeBase :: Decimal, - feeCounter :: Decimal, - limitPrice :: Decimal, - limitVolume :: Decimal, + feeBase :: Scientific, + feeCounter :: Scientific, + limitPrice :: Scientific, + limitVolume :: Scientific, id :: OrderID, pair :: CcyPair, state :: RequestStatus, @@ -288,10 +288,10 @@ -- [record| -- {rowIndex :: 'Int', -- timestamp :: 'UTCTime', --- balance :: 'Decimal', --- available :: 'Decimal', --- balanceDelta :: 'Decimal', --- availableDelta :: 'Decimal', +-- balance :: 'Scientific', +-- available :: 'Scientific', +-- balanceDelta :: 'Scientific', +-- availableDelta :: 'Scientific', -- currency :: 'Asset', -- description :: 'Text'}|] -- @ @@ -299,10 +299,10 @@ [record| {rowIndex :: Int, timestamp :: UTCTime, - balance :: Decimal, - available :: Decimal, - balanceDelta :: Decimal, - availableDelta :: Decimal, + balance :: Scientific, + available :: Scientific, + balanceDelta :: Scientific, + availableDelta :: Scientific, currency :: Asset, description :: Text}|] @@ -330,15 +330,15 @@ -- [record| -- {pair :: 'CcyPair', -- type :: 'OrderType', --- volume :: 'Decimal', --- price :: 'Decimal' } |] +-- volume :: 'Scientific', +-- price :: 'Scientific' } |] -- @ type OrderRequest = [record| {pair :: CcyPair, type :: OrderType, - volume :: Decimal, - price :: Decimal } |] + volume :: Scientific, + price :: Scientific } |] type AccountID = Text @@ -349,17 +349,17 @@ -- [record| -- {id :: 'AccountID', -- asset :: 'Asset', --- balance :: 'Decimal', --- reserved :: 'Decimal', --- unconfirmed :: 'Decimal' } |] +-- balance :: 'Scientific', +-- reserved :: 'Scientific', +-- unconfirmed :: 'Scientific' } |] -- @ type Balance = [record| {id :: AccountID, asset :: Asset, - balance :: Decimal, - reserved :: Decimal, - unconfirmed :: Decimal } |] + balance :: Scientific, + reserved :: Scientific, + unconfirmed :: Scientific } |] -- | A registered address for an acocunt. -- @@ -368,15 +368,15 @@ -- [record| -- {asset :: 'Asset', -- address :: 'Text', --- totalReceived :: 'Decimal', --- totalUnconfirmed :: 'Decimal'} |] +-- totalReceived :: 'Scientific', +-- totalUnconfirmed :: 'Scientific'} |] -- @ type FundingAddress = [record| {asset :: Asset, address :: Text, - totalReceived :: Decimal, - totalUnconfirmed :: Decimal} |] + totalReceived :: Scientific, + totalUnconfirmed :: Scientific} |] -- | The state of a request to withdraw from an account. -- @@ -397,19 +397,19 @@ --type NewWithdrawal = -- [record| -- {type :: 'WithdrawalType', --- amount :: 'Decimal' } |] +-- amount :: 'Scientific' } |] -- @ type NewWithdrawal = [record| {type :: WithdrawalType, - amount :: Decimal } |] + amount :: Scientific } |] -- | A request to send bitcoin to a bitcoin address or email address. -- -- @ --type BitcoinSendRequest = -- [record| --- {amount :: 'Decimal', +-- {amount :: 'Scientific', -- currency :: 'Asset', -- address :: 'Text', -- description :: 'Maybe' 'Text', @@ -417,7 +417,7 @@ -- @ type BitcoinSendRequest = [record| - {amount :: Decimal, + {amount :: Scientific, currency :: Asset, address :: Text, description :: Maybe Text, @@ -430,13 +430,13 @@ -- [record| -- {type :: 'QuoteType', -- pair :: 'CcyPair', --- baseAmount :: 'Decimal'} |] +-- baseAmount :: 'Scientific'} |] -- @ type QuoteRequest = [record| {type :: QuoteType, pair :: CcyPair, - baseAmount :: Decimal} |] + baseAmount :: Scientific} |] -- | A temporarily locked in quote. -- @@ -446,8 +446,8 @@ -- {id :: 'Text', -- type :: 'QuoteType', -- pair :: 'CcyPair', --- baseAmount :: 'Decimal', --- counterAmount :: 'Decimal', +-- baseAmount :: 'Scientific', +-- counterAmount :: 'Scientific', -- createdAt :: 'UTCTime', -- expiresAt :: 'UTCTime', -- discarded :: 'Bool', @@ -458,12 +458,27 @@ {id :: Text, type :: QuoteType, pair :: CcyPair, - baseAmount :: Decimal, - counterAmount :: Decimal, + baseAmount :: Scientific, + counterAmount :: Scientific, createdAt :: UTCTime, expiresAt :: UTCTime, discarded :: Bool, exercised :: Bool} |] + +-- | A registered account. +-- +-- @ +--type Account = +-- [record| +-- {id :: Text, +-- name :: Text, +-- currency :: Asset} |] +-- @ +type Account = + [record| + {id :: Text, + name :: Text, + currency :: Asset} |] -- | The type of a withdrawal request. data WithdrawalType = 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 @@ -1,7 +1,5 @@ {-# LANGUAGE QuasiQuotes, OverloadedStrings, TemplateHaskell, MultiParamTypeClasses, - FunctionalDependencies, FlexibleInstances, DataKinds, CPP #-} - -{-# OPTIONS_GHC -fno-warn-unused-binds #-} + FunctionalDependencies, FlexibleInstances, DataKinds, CPP, RecordWildCards #-} module Network.Bitcoin.BitX.Types.Internal ( @@ -29,15 +27,19 @@ #else import Data.Monoid (mempty) #endif -import Data.Decimal (Decimal) +import Data.Scientific (Scientific) +--import Data.Scientific (Scientific) import Data.ByteString (ByteString) import Data.List.Split (splitOn) +#if MIN_VERSION_base(4,7,0) +import Data.Coerce +#endif timestampParse_ :: Integer -> UTCTime timestampParse_ = posixSecondsToUTCTime - . fromRational . toRational - . ( / 1000) - . (fromIntegral :: Integer -> Decimal) + . realToFrac + . ( / 1000) + . (fromIntegral :: Integer -> Scientific) class (FromJSON aes) => BitXAesRecordConvert rec aes | rec -> aes where aesToRec :: aes -> rec @@ -49,20 +51,25 @@ showableToBytestring_ :: (Show a) => a -> ByteString showableToBytestring_ = Txt.encodeUtf8 . Txt.pack . show --- | Wrapper around Decimal and FromJSON instance, to facilitate automatic JSON instances +-- | Wrapper around Scientific and FromJSON instance, to facilitate automatic JSON instances -newtype QuotedDecimal = QuotedDecimal Decimal deriving (Read, Show) +newtype QuotedScientific = QuotedScientific Scientific deriving (Read, Show) -instance FromJSON QuotedDecimal where - parseJSON (String x) = return . QuotedDecimal . read . Txt.unpack $ x - parseJSON (Number x) = return . QuotedDecimal . read . show $ x +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 QuotedDecimal where --- toJSON (QuotedDecimal q) = Number . realToFrac $ q +--instance ToJSON QuotedScientific where +-- toJSON (QuotedScientific q) = Number . realToFrac $ q -qdToDecimal :: QuotedDecimal -> Decimal -qdToDecimal (QuotedDecimal dec) = dec +qsToScientific :: QuotedScientific -> Scientific +#if MIN_VERSION_base(4,7,0) +qsToScientific = coerce +{-# INLINE qsToScientific #-} +#else +qsToScientific (QuotedScientific sci) = sci +#endif -- | Wrapper around UTCTime and FromJSON instance, to facilitate automatic JSON instances @@ -90,7 +97,8 @@ orderTypeParse (OrderType_ "BID") = BID orderTypeParse (OrderType_ "ASK") = ASK orderTypeParse (OrderType_ "SELL") = ASK -orderTypeParse (OrderType_ _ ) = error "Yet another surprise from the BitX API..." +orderTypeParse (OrderType_ x ) = + error $ "Yet another surprise from the BitX API: unexpected OrderType " ++ Txt.unpack x newtype RequestStatus_ = RequestStatus_ Text deriving (Read, Show) @@ -104,16 +112,17 @@ requestStatusParse (RequestStatus_ "COMPLETE") = COMPLETE requestStatusParse (RequestStatus_ "COMPLETED") = COMPLETE requestStatusParse (RequestStatus_ "CANCELLED") = CANCELLED -requestStatusParse (RequestStatus_ _ ) = error "Yet another surprise from the BitX API..." +requestStatusParse (RequestStatus_ x ) = + error $ "Yet another surprise from the BitX API: unexpected RequestStatus " ++ Txt.unpack x -------------------------------------------- Ticker type ------------------------------------------- data Ticker_ = Ticker_ { ticker'timestamp :: TimestampMS - , ticker'bid :: QuotedDecimal - , ticker'ask :: QuotedDecimal - , ticker'last_trade :: QuotedDecimal - , ticker'rolling_24_hour_volume :: QuotedDecimal + , ticker'bid :: QuotedScientific + , ticker'ask :: QuotedScientific + , ticker'last_trade :: QuotedScientific + , ticker'rolling_24_hour_volume :: QuotedScientific , ticker'pair :: CcyPair } @@ -121,14 +130,13 @@ ''Ticker_) instance BitXAesRecordConvert Ticker Ticker_ where - aesToRec (Ticker_ ticker''timestamp ticker''bid ticker''ask ticker''lastTrade - ticker''rolling24HourVolume ticker''pair) = - [record| {timestamp = tsmsToUTCTime ticker''timestamp, - bid = qdToDecimal ticker''bid, - ask = qdToDecimal ticker''ask, - lastTrade = qdToDecimal ticker''lastTrade, - rolling24HourVolume = qdToDecimal ticker''rolling24HourVolume, - pair = ticker''pair} |] + aesToRec (Ticker_ {..}) = + [record| {timestamp = tsmsToUTCTime ticker'timestamp, + bid = qsToScientific ticker'bid, + ask = qsToScientific ticker'ask, + lastTrade = qsToScientific ticker'last_trade, + rolling24HourVolume = qsToScientific ticker'rolling_24_hour_volume, + pair = ticker'pair} |] --------------------------------------------- Tickers type ----------------------------------------- @@ -140,8 +148,8 @@ ''Tickers_) instance BitXAesRecordConvert [Ticker] Tickers_ where - aesToRec (Tickers_ tickers''tickers) = - map aesToRec tickers''tickers + aesToRec (Tickers_ {..}) = + map aesToRec tickers'tickers -------------------------------------------- BitXError type ---------------------------------------- @@ -153,23 +161,23 @@ $(AesTH.deriveJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"} ''BitXError_) instance BitXAesRecordConvert BitXError BitXError_ where - aesToRec (BitXError_ bitXError''error bitXError''error_code) = - [record| {error = bitXError''error, - errorCode = bitXError''error_code} |] + aesToRec (BitXError_ {..}) = + [record| {error = bitXError'error, + errorCode = bitXError'error_code} |] -------------------------------------------- Order type -------------------------------------------- data Order_ = Order_ - { order'volume :: QuotedDecimal, - order'price :: QuotedDecimal + { order'volume :: QuotedScientific, + order'price :: QuotedScientific } $(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"} ''Order_) instance BitXAesRecordConvert Order Order_ where - aesToRec (Order_ order''volume order''price) = - [record| {volume = qdToDecimal order''volume, - price = qdToDecimal order''price} |] + aesToRec (Order_ {..}) = + [record| {volume = qsToScientific order'volume, + price = qsToScientific order'price} |] -------------------------------------------- Orderbook type ---------------------------------------- @@ -186,53 +194,52 @@ ''Orderbook_) instance BitXAesRecordConvert Orderbook Orderbook_ where - aesToRec (Orderbook_ orderbook''timestamp orderbook''bids orderbook''asks) = - [record| {timestamp = tsmsToUTCTime orderbook''timestamp, - bids = map aesToRec orderbook''bids, - asks = map aesToRec orderbook''asks} |] + aesToRec (Orderbook_ {..}) = + [record| {timestamp = tsmsToUTCTime orderbook'timestamp, + bids = map aesToRec orderbook'bids, + asks = map aesToRec orderbook'asks} |] -------------------------------------------- Trade type -------------------------------------------- data Trade_ = Trade_ - { trade'volume :: QuotedDecimal + { trade'volume :: QuotedScientific , trade'timestamp :: TimestampMS - , trade'price :: QuotedDecimal + , trade'price :: QuotedScientific } $(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"} ''Trade_) instance BitXAesRecordConvert Trade Trade_ where - aesToRec (Trade_ trade''volume trade''timestamp trade''price) = - [record| {volume = qdToDecimal trade''volume, - timestamp = tsmsToUTCTime trade''timestamp, - price = qdToDecimal trade''price} |] + aesToRec (Trade_ {..}) = + [record| {volume = qsToScientific trade'volume, + timestamp = tsmsToUTCTime trade'timestamp, + price = qsToScientific trade'price} |] ----------------------------------------- PublicTrades type ---------------------------------------- data PublicTrades_ = PublicTrades_ { publicTrades'trades :: [Trade_] - --, publicTrades'currency :: Asset } $(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"} ''PublicTrades_) instance BitXAesRecordConvert [Trade] PublicTrades_ where - aesToRec (PublicTrades_ publicTrades''trades {-publicTrades''currency-}) = - map aesToRec publicTrades''trades + aesToRec (PublicTrades_ {..}) = + map aesToRec publicTrades'trades ------------------------------------------ PrivateOrder type --------------------------------------- data PrivateOrder_ = PrivateOrder_ - { privateOrder'base :: QuotedDecimal - , privateOrder'counter :: QuotedDecimal + { privateOrder'base :: QuotedScientific + , privateOrder'counter :: QuotedScientific , privateOrder'creation_timestamp :: TimestampMS , privateOrder'expiration_timestamp :: TimestampMS - , privateOrder'fee_base :: QuotedDecimal - , privateOrder'fee_counter :: QuotedDecimal - , privateOrder'limit_price :: QuotedDecimal - , privateOrder'limit_volume :: QuotedDecimal + , privateOrder'fee_base :: QuotedScientific + , privateOrder'fee_counter :: QuotedScientific + , privateOrder'limit_price :: QuotedScientific + , privateOrder'limit_volume :: QuotedScientific , privateOrder'order_id :: OrderID , privateOrder'pair :: CcyPair , privateOrder'state :: RequestStatus_ @@ -243,22 +250,19 @@ ''PrivateOrder_) instance BitXAesRecordConvert PrivateOrder PrivateOrder_ where - aesToRec (PrivateOrder_ privateOrder''base privateOrder''counter - privateOrder''creation_timestamp privateOrder''expiration_timestamp privateOrder''fee_base - privateOrder''fee_counter privateOrder''limit_price privateOrder''limit_volume - privateOrder''order_id privateOrder''pair privateOrder''state privateOrder''type) = - [record| {base = qdToDecimal privateOrder''base, - counter = qdToDecimal privateOrder''counter, - creationTimestamp = tsmsToUTCTime privateOrder''creation_timestamp, - expirationTimestamp = tsmsToUTCTime privateOrder''expiration_timestamp, - feeBase = qdToDecimal privateOrder''fee_base, - feeCounter = qdToDecimal privateOrder''fee_counter, - limitPrice = qdToDecimal privateOrder''limit_price, - limitVolume = qdToDecimal privateOrder''limit_volume, - id = privateOrder''order_id, - pair = privateOrder''pair, - state = requestStatusParse privateOrder''state, - type = orderTypeParse privateOrder''type} |] + aesToRec (PrivateOrder_ {..}) = + [record| {base = qsToScientific privateOrder'base, + counter = qsToScientific privateOrder'counter, + creationTimestamp = tsmsToUTCTime privateOrder'creation_timestamp, + expirationTimestamp = tsmsToUTCTime privateOrder'expiration_timestamp, + feeBase = qsToScientific privateOrder'fee_base, + feeCounter = qsToScientific privateOrder'fee_counter, + limitPrice = qsToScientific privateOrder'limit_price, + limitVolume = qsToScientific privateOrder'limit_volume, + id = privateOrder'order_id, + pair = privateOrder'pair, + state = requestStatusParse privateOrder'state, + type = orderTypeParse privateOrder'type} |] ------------------------------------------ PrivateOrders type -------------------------------------- @@ -270,8 +274,8 @@ ''PrivateOrders_) instance BitXAesRecordConvert [PrivateOrder] PrivateOrders_ where - aesToRec (PrivateOrders_ privateOrders''orders) = - map aesToRec privateOrders''orders + aesToRec (PrivateOrders_ {..}) = + map aesToRec privateOrders'orders ------------------------------------------ OrderRequest type --------------------------------------- @@ -292,8 +296,8 @@ ''OrderIDRec_) instance BitXAesRecordConvert OrderID OrderIDRec_ where - aesToRec (OrderIDRec_ orderIDResponse''order_id) = - orderIDResponse''order_id + aesToRec (OrderIDRec_ {..}) = + orderIDResponse'order_id instance POSTEncodeable OrderID where postEncode oid = @@ -309,20 +313,20 @@ ''RequestSuccess_) instance BitXAesRecordConvert RequestSuccess RequestSuccess_ where - aesToRec (RequestSuccess_ requestSuccess''success) = - requestSuccess''success + aesToRec (RequestSuccess_ {..}) = + requestSuccess'success ------------------------------------- PrivateOrderWithTrades type ---------------------------------- data PrivateOrderWithTrades_ = PrivateOrderWithTrades_ - { privateOrderWithTrades'base :: QuotedDecimal - , privateOrderWithTrades'counter :: QuotedDecimal + { privateOrderWithTrades'base :: QuotedScientific + , privateOrderWithTrades'counter :: QuotedScientific , privateOrderWithTrades'creation_timestamp :: TimestampMS , privateOrderWithTrades'expiration_timestamp :: TimestampMS - , privateOrderWithTrades'fee_base :: QuotedDecimal - , privateOrderWithTrades'fee_counter :: QuotedDecimal - , privateOrderWithTrades'limit_price :: QuotedDecimal - , privateOrderWithTrades'limit_volume :: QuotedDecimal + , privateOrderWithTrades'fee_base :: QuotedScientific + , privateOrderWithTrades'fee_counter :: QuotedScientific + , privateOrderWithTrades'limit_price :: QuotedScientific + , privateOrderWithTrades'limit_volume :: QuotedScientific , privateOrderWithTrades'order_id :: OrderID , privateOrderWithTrades'pair :: CcyPair , privateOrderWithTrades'state :: RequestStatus_ @@ -334,79 +338,73 @@ ''PrivateOrderWithTrades_) instance BitXAesRecordConvert PrivateOrderWithTrades PrivateOrderWithTrades_ where - aesToRec (PrivateOrderWithTrades_ privateOrder''base privateOrder''counter - privateOrder''creation_timestamp privateOrder''expiration_timestamp privateOrder''fee_base - privateOrder''fee_counter privateOrder''limit_price privateOrder''limit_volume - privateOrder''order_id privateOrder''pair privateOrder''state privateOrder''type - privateOrderWithTrades''trades) = - [record| {base = qdToDecimal privateOrder''base, - counter = qdToDecimal privateOrder''counter, - creationTimestamp = tsmsToUTCTime privateOrder''creation_timestamp, - expirationTimestamp = tsmsToUTCTime privateOrder''expiration_timestamp, - feeBase = qdToDecimal privateOrder''fee_base, - feeCounter = qdToDecimal privateOrder''fee_counter, - limitPrice = qdToDecimal privateOrder''limit_price, - limitVolume = qdToDecimal privateOrder''limit_volume, - id = privateOrder''order_id, - pair = privateOrder''pair, - state = requestStatusParse privateOrder''state, - type = orderTypeParse privateOrder''type, - trades = map aesToRec privateOrderWithTrades''trades} |] + aesToRec (PrivateOrderWithTrades_ {..}) = + [record| {base = qsToScientific privateOrderWithTrades'base, + counter = qsToScientific privateOrderWithTrades'counter, + creationTimestamp = tsmsToUTCTime privateOrderWithTrades'creation_timestamp, + expirationTimestamp = tsmsToUTCTime privateOrderWithTrades'expiration_timestamp, + feeBase = qsToScientific privateOrderWithTrades'fee_base, + feeCounter = qsToScientific privateOrderWithTrades'fee_counter, + limitPrice = qsToScientific privateOrderWithTrades'limit_price, + limitVolume = qsToScientific privateOrderWithTrades'limit_volume, + id = privateOrderWithTrades'order_id, + pair = privateOrderWithTrades'pair, + state = requestStatusParse privateOrderWithTrades'state, + type = orderTypeParse privateOrderWithTrades'type, + trades = map aesToRec privateOrderWithTrades'trades} |] -------------------------------------------- Balance type ------------------------------------------ data Balance_ = Balance_ { balance'account_id :: AccountID , balance'asset :: Asset - , balance'balance :: QuotedDecimal - , balance'reserved :: QuotedDecimal - , balance'unconfirmed :: QuotedDecimal + , balance'balance :: QuotedScientific + , balance'reserved :: QuotedScientific + , balance'unconfirmed :: QuotedScientific } $(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"} ''Balance_) instance BitXAesRecordConvert Balance Balance_ where - aesToRec (Balance_ balance''account_id balance''asset balance''balance balance''reserved - balance''unconfirmed) = - [record| {id = balance''account_id, - asset = balance''asset, - balance = qdToDecimal balance''balance, - reserved = qdToDecimal balance''reserved, - unconfirmed = qdToDecimal balance''unconfirmed} |] + aesToRec (Balance_ {..}) = + [record| {id = balance'account_id, + asset = balance'asset, + balance = qsToScientific balance'balance, + reserved = qsToScientific balance'reserved, + unconfirmed = qsToScientific balance'unconfirmed} |] -------------------------------------------- Balances type ----------------------------------------- data Balances_ = Balances_ - {balances'balance :: [Balance_] + { balances'balance :: [Balance_] } $(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"} ''Balances_) instance BitXAesRecordConvert [Balance] Balances_ where - aesToRec (Balances_ balances''balances) = - map aesToRec balances''balances + aesToRec (Balances_ {..}) = + map aesToRec balances'balance ----------------------------------------- FundingAddress type -------------------------------------- data FundingAddress_ = FundingAddress_ { fundingAdress'asset :: Asset , fundingAdress'address :: Text - , fundingAdress'total_received :: QuotedDecimal - , fundingAdress'total_unconfirmed :: QuotedDecimal + , fundingAdress'total_received :: QuotedScientific + , fundingAdress'total_unconfirmed :: QuotedScientific } $(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"} ''FundingAddress_) instance BitXAesRecordConvert FundingAddress FundingAddress_ where - aesToRec (FundingAddress_ fundingAdress''asset fundingAdress''address - fundingAdress''total_received fundingAdress''total_unconfirmed) = - [record| {asset = fundingAdress''asset, - address = fundingAdress''address, - totalReceived = qdToDecimal fundingAdress''total_received, - totalUnconfirmed = qdToDecimal fundingAdress''total_unconfirmed} |] + aesToRec (FundingAddress_ {..}) = + [record| {asset = fundingAdress'asset, + address = fundingAdress'address, + totalReceived = qsToScientific fundingAdress'total_received, + totalUnconfirmed = qsToScientific fundingAdress'total_unconfirmed} |] --------------------------------------------- Asset type ------------------------------------------- @@ -425,9 +423,9 @@ ''WithdrawalRequest_) instance BitXAesRecordConvert WithdrawalRequest WithdrawalRequest_ where - aesToRec (WithdrawalRequest_ withdrawalRequest''status withdrawalRequest''id) = - [record| {status = requestStatusParse withdrawalRequest''status, - id = withdrawalRequest''id} |] + aesToRec (WithdrawalRequest_ {..}) = + [record| {status = requestStatusParse withdrawalRequest'status, + id = withdrawalRequest'id} |] -------------------------------------- WithdrawalRequests type ------------------------------------- @@ -439,8 +437,8 @@ ''WithdrawalRequests_) instance BitXAesRecordConvert [WithdrawalRequest] WithdrawalRequests_ where - aesToRec (WithdrawalRequests_ withdrawalRequests''withdrawals) = - map aesToRec withdrawalRequests''withdrawals + aesToRec (WithdrawalRequests_ {..}) = + map aesToRec withdrawalRequests'withdrawals ----------------------------------------- NewWithdrawal type --------------------------------------- @@ -476,8 +474,8 @@ { orderQuote'id :: Text , orderQuote'type :: QuoteType , orderQuote'pair :: CcyPair - , orderQuote'base_amount :: QuotedDecimal - , orderQuote'counter_amount :: QuotedDecimal + , orderQuote'base_amount :: QuotedScientific + , orderQuote'counter_amount :: QuotedScientific , orderQuote'created_at :: TimestampMS , orderQuote'expires_at :: TimestampMS , orderQuote'discarded :: Bool @@ -488,18 +486,16 @@ ''OrderQuote_) instance BitXAesRecordConvert OrderQuote OrderQuote_ where - aesToRec (OrderQuote_ orderQuote''id orderQuote''type orderQuote''pair orderQuote''base_amount - orderQuote''counter_amount orderQuote''created_at orderQuote''expires_at orderQuote''discarded - orderQuote''exercised) = - [record| {id = orderQuote''id, - type = orderQuote''type, - pair = orderQuote''pair, - baseAmount = qdToDecimal orderQuote''base_amount, - counterAmount = qdToDecimal orderQuote''counter_amount, - createdAt = tsmsToUTCTime orderQuote''created_at, - expiresAt = tsmsToUTCTime orderQuote''expires_at, - discarded = orderQuote''discarded, - exercised = orderQuote''exercised} |] + aesToRec (OrderQuote_ {..}) = + [record| {id = orderQuote'id, + type = orderQuote'type, + pair = orderQuote'pair, + baseAmount = qsToScientific orderQuote'base_amount, + counterAmount = qsToScientific orderQuote'counter_amount, + createdAt = tsmsToUTCTime orderQuote'created_at, + expiresAt = tsmsToUTCTime orderQuote'expires_at, + discarded = orderQuote'discarded, + exercised = orderQuote'exercised} |] -------------------------------------------- BitXAuth type ----------------------------------------- @@ -512,19 +508,19 @@ ''BitXAuth_) instance BitXAesRecordConvert BitXAuth BitXAuth_ where - aesToRec (BitXAuth_ bitXAuth''api_key_id bitXAuth''api_key_secret) = - [record| {id = bitXAuth''api_key_id, - secret = bitXAuth''api_key_secret} |] + aesToRec (BitXAuth_ {..}) = + [record| {id = bitXAuth'api_key_id, + secret = bitXAuth'api_key_secret} |] ------------------------------------------ Transaction type ---------------------------------------- data Transaction_ = Transaction_ { transaction'row_index :: Int , transaction'timestamp :: TimestampMS - , transaction'balance :: QuotedDecimal - , transaction'available :: QuotedDecimal - , transaction'balance_delta :: QuotedDecimal - , transaction'available_delta :: QuotedDecimal + , transaction'balance :: QuotedScientific + , transaction'available :: QuotedScientific + , transaction'balance_delta :: QuotedScientific + , transaction'available_delta :: QuotedScientific , transaction'currency :: Asset , transaction'description :: Text } @@ -533,17 +529,15 @@ ''Transaction_) instance BitXAesRecordConvert Transaction Transaction_ where - aesToRec (Transaction_ transaction''row_index transaction''timestamp transaction''balance - transaction''available transaction''balance_delta transaction''available_delta - transaction''currency transaction''description) = - [record| {rowIndex = transaction''row_index, - timestamp = tsmsToUTCTime transaction''timestamp, - balance = qdToDecimal transaction''balance, - available = qdToDecimal transaction''available, - balanceDelta = qdToDecimal transaction''balance_delta, - availableDelta = qdToDecimal transaction''available_delta, - currency = transaction''currency, - description = transaction''description} |] + aesToRec (Transaction_ {..}) = + [record| {rowIndex = transaction'row_index, + timestamp = tsmsToUTCTime transaction'timestamp, + balance = qsToScientific transaction'balance, + available = qsToScientific transaction'available, + balanceDelta = qsToScientific transaction'balance_delta, + availableDelta = qsToScientific transaction'available_delta, + currency = transaction'currency, + description = transaction'description} |] ---------------------------------------- Transactions type ----------------------------------------- @@ -555,8 +549,8 @@ ''Transactions_) instance BitXAesRecordConvert [Transaction] Transactions_ where - aesToRec (Transactions_ transactions''transactions) = - map aesToRec transactions''transactions + aesToRec (Transactions_ {..}) = + map aesToRec transactions'transactions data PendingTransactions_ = PendingTransactions_ @@ -567,8 +561,8 @@ ''PendingTransactions_) instance BitXAesRecordConvert PendingTransactions__ PendingTransactions_ where - aesToRec (PendingTransactions_ transactions''pending) = - [record| {transactions = map aesToRec transactions''pending}|] + aesToRec (PendingTransactions_ {..}) = + [record| {transactions = map aesToRec transactions'pending}|] type PendingTransactions__ = [record| @@ -577,3 +571,24 @@ pendingTransactionsToTransactions :: PendingTransactions__ -> [Transaction] pendingTransactionsToTransactions pts = (view [lens| transactions |] pts) +-------------------------------------------- Account type ------------------------------------------ + +data Account_ = Account_ + { account'id :: Text + , account'name :: Text + , account'currency :: Asset + } + +$(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"} + ''Account_) + +instance BitXAesRecordConvert Account Account_ where + aesToRec (Account_ {..}) = + [record| {id = account'id, + name = account'name, + currency = account'currency} |] + +instance POSTEncodeable Account where + postEncode acc = + [("name", showableToBytestring_ (view [lens| name |] acc)), + ("currency", showableToBytestring_ (view [lens| currency |] acc))] diff --git a/test/Network/Bitcoin/BitX/Spec/Common.hs b/test/Network/Bitcoin/BitX/Spec/Common.hs new file mode 100644 --- /dev/null +++ b/test/Network/Bitcoin/BitX/Spec/Common.hs @@ -0,0 +1,12 @@ +module Network.Bitcoin.BitX.Spec.Common + ( + recordAesCheck + ) where + +import Test.Hspec +import Data.Aeson +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 diff --git a/test/Network/Bitcoin/BitX/Spec/Specs/AesonRecordSpec.hs b/test/Network/Bitcoin/BitX/Spec/Specs/AesonRecordSpec.hs new file mode 100644 --- /dev/null +++ b/test/Network/Bitcoin/BitX/Spec/Specs/AesonRecordSpec.hs @@ -0,0 +1,225 @@ +{-# LANGUAGE OverloadedStrings, QuasiQuotes, DataKinds #-} + +module Network.Bitcoin.BitX.Spec.Specs.AesonRecordSpec + ( + spec + ) where + +import Test.Hspec +import Network.Bitcoin.BitX.Types +import Record +import Data.Time.Clock.POSIX +import Network.Bitcoin.BitX.Spec.Common + +spec :: Spec +spec = do + describe "FromJSON to Record" $ do + it "BitXError is parsed properly" $ do + recordAesCheck + "{\"error\" : \"oops\", \"error_code\" : \"ABadError\"}" + ([record| {error = "oops", errorCode = "ABadError"} |] :: BitXError) + it "Ticker is parsed properly" $ do + recordAesCheck + "{\"timestamp\":1431811395699,\"bid\":\"3083.00\",\"ask\":\"3115.00\",\ + \ \"last_trade\":\"3116.00\",\"rolling_24_hour_volume\":\"19.776608\",\"pair\":\"XBTZAR\"}" + ([record| + {ask = 3115.00, + timestamp = (posixSecondsToUTCTime 1431811395.699), + bid = 3083.0, + rolling24HourVolume = 19.776608, + lastTrade = 3116.00, + pair = XBTZAR} |] :: Ticker) + it "Balance is parsed properly" $ do + recordAesCheck + "{\"account_id\":\"314159\",\"asset\":\"ZAR\",\"balance\":\"2159.15\",\"reserved\":\"320\",\ + \ \"unconfirmed\":\"175\"}" + ([record| + {id = "314159", + asset = ZAR, + balance = 2159.15, + reserved = 320, + unconfirmed = 175} |] :: Balance) + it "Order is parsed properly" $ do + recordAesCheck + "{\"volume\":\"314159\",\"price\":\"4321\"}" + ([record| + {volume = 314159, + price = 4321} |] :: Order) + it "WithdrawalRequest is parsed properly" $ do + recordAesCheck + "{\"status\":\"PENDING\",\"id\":\"271828\"}" + ([record| + {status = PENDING, + id = "271828" } |] :: WithdrawalRequest) + it "Tickers is parsed properly" $ do + recordAesCheck + "{\"tickers\":[{\"timestamp\":1431811395699,\"bid\":\"3083.00\",\"ask\":\"3115.00\",\ + \ \"last_trade\":\"3116.00\",\"rolling_24_hour_volume\":\"19.776608\",\ + \ \"pair\":\"XBTZAR\"}]}" + [tickerInner] + it "Orderbook is parsed properly" $ do + recordAesCheck + "{\"timestamp\":1431811395699,\"bids\":[{\"volume\":\"654.98\",\"price\":\"3789.66\"}],\ + \ \"asks\":[{\"volume\":\"654.98\",\"price\":\"3789.66\"}]}" + ([record| + {timestamp = (posixSecondsToUTCTime 1431811395.699), + bids = [orderInner], + asks = [orderInner] } |] :: Orderbook) + it "Trade is parsed properly" $ do + recordAesCheck + "{\"timestamp\":1431811395699,\"volume\":\"6754.09\",\"price\":\"5327.765\"}" + ([record| + {timestamp = (posixSecondsToUTCTime 1431811395.699), + volume = 6754.09, + price = 5327.765 } |] :: Trade) + it "PublicTrades is parsed properly" $ do + recordAesCheck + "{\"trades\":[{\"timestamp\":1431811395699,\"volume\":\"6754.09\",\ + \ \"price\":\"5327.765\"}],\"currency\":\"ZAR\"}" + [tradeInner] + it "PrivateOrder is parsed properly" $ do + recordAesCheck + "{\"base\":\"568.7\", \"counter\":3764.2,\"creation_timestamp\":478873467, \ + \ \"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\"}" + ([record| + {base = 568.7, + counter = 3764.2, + creationTimestamp = (posixSecondsToUTCTime 478873.467), + expirationTimestamp = (posixSecondsToUTCTime 8768834.222), + feeBase = 3687.3, + feeCounter = 12.9, + limitPrice = 765, + limitVolume = 55.2, + id = "83YG", + pair = NADXBT, + state = COMPLETE, + type = BID } |] :: PrivateOrder) + it "PrivateOrders is parsed properly" $ do + recordAesCheck + "{\"orders\":[{\"base\":\"568.7\", \"counter\":3764.2,\"creation_timestamp\":478873467, \ + \ \"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\"}]}" + [privateOrderInner] + it "OrderID is parsed properly" $ do + recordAesCheck + "{\"order_id\":\"57983\"}" + ("57983" :: OrderID) + it "PublicTrades is parsed properly" $ do + recordAesCheck + "{\"trades\":[{\"timestamp\":1431811395699,\"volume\":\"6754.09\",\"price\":\"5327.765\"}], \ + \ \"currency\":\"ZAR\"}" + [tradeInner] + it "RequestSuccess is parsed properly" $ do + recordAesCheck + "{\"success\":true}" + (True :: RequestSuccess) + it "PrivateOrderWithTrades is parsed properly" $ do + recordAesCheck + "{\"base\":\"568.7\", \"counter\":3764.2,\"creation_timestamp\":478873467, \ + \ \"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\"}]}" + ([record| + {base = 568.7, + counter = 3764.2, + creationTimestamp = (posixSecondsToUTCTime 478873.467), + expirationTimestamp = (posixSecondsToUTCTime 8768834.222), + feeBase = 3687.3, + feeCounter = 12.9, + limitPrice = 765, + limitVolume = 55.2, + id = "83YG", + pair = NADXBT, + state = COMPLETE, + type = BID, + trades = [tradeInner]} |] :: PrivateOrderWithTrades) + it "WithdrawalRequest is parsed properly" $ do + recordAesCheck + "{\"status\":\"PENDING\", \"id\":\"7yrfU4987\"}" + ([record| + {status = PENDING, + id = "7yrfU4987" } |] :: WithdrawalRequest) + it "FundingAddress is parsed properly" $ do + recordAesCheck + "{\"asset\":\"ZAR\", \"address\":\"093gu959t894G\", \"total_received\":\"432.5\", \ + \ \"total_unconfirmed\":\"0.023\"}" + ([record| + {asset = ZAR, + address = "093gu959t894G", + totalReceived = 432.5, + totalUnconfirmed = 0.023} |] :: FundingAddress) + it "Transaction is parsed properly" $ do + recordAesCheck + "{\"row_index\":1,\"timestamp\":1387527013000,\"balance\":0.0199, \"available\":0.0299, \ + \ \"account_id\":\"3485527347968330182\", \"balance_delta\":0.0399, \ + \ \"available_delta\":0.0099, \"currency\":\"XBT\",\"description\":\"Bought BTC 0.01 for R 79.00\"}" + ([record| + {rowIndex = 1, + timestamp = (posixSecondsToUTCTime 1387527013), + balance = 0.0199, + available = 0.0299, + balanceDelta = 0.0399, + availableDelta = 0.0099, + currency = XBT, + description = "Bought BTC 0.01 for R 79.00"}|] :: Transaction) + it "Transactions is parsed properly" $ do + recordAesCheck + "{\"transactions\":[{\"row_index\":1,\"timestamp\":1387527013000,\"balance\":0.0199, \"available\":0.0299, \ + \ \"account_id\":\"3485527347968330182\", \"balance_delta\":0.0399, \ + \ \"available_delta\":0.0099, \"currency\":\"XBT\",\"description\":\"Bought BTC 0.01 for R 79.00\"}]}" + [transactionInner] + +tickerInner :: Ticker +tickerInner = + [record| + {ask = 3115.00, + timestamp = (posixSecondsToUTCTime 1431811395.699), + bid = 3083.0, + rolling24HourVolume = 19.776608, + lastTrade = 3116.00, + pair = XBTZAR} |] + +orderInner :: Order +orderInner = + [record| + {volume = 654.98, + price = 3789.66} |] + +tradeInner :: Trade +tradeInner = + [record| + {timestamp = (posixSecondsToUTCTime 1431811395.699), + volume = 6754.09, + price = 5327.765 } |] + +privateOrderInner :: PrivateOrder +privateOrderInner = + [record| + {base = 568.7, + counter = 3764.2, + creationTimestamp = (posixSecondsToUTCTime 478873.467), + expirationTimestamp = (posixSecondsToUTCTime 8768834.222), + feeBase = 3687.3, + feeCounter = 12.9, + limitPrice = 765, + limitVolume = 55.2, + id = "83YG", + pair = NADXBT, + state = COMPLETE, + type = BID } |] + +transactionInner :: Transaction +transactionInner = + [record| + {rowIndex = 1, + timestamp = (posixSecondsToUTCTime 1387527013), + balance = 0.0199, + available = 0.0299, + balanceDelta = 0.0399, + availableDelta = 0.0099, + currency = XBT, + description = "Bought BTC 0.01 for R 79.00"}|] diff --git a/test/Network/Bitcoin/BitX/Spec/Specs/JsonSpec.hs b/test/Network/Bitcoin/BitX/Spec/Specs/JsonSpec.hs new file mode 100644 --- /dev/null +++ b/test/Network/Bitcoin/BitX/Spec/Specs/JsonSpec.hs @@ -0,0 +1,116 @@ +{-# LANGUAGE OverloadedStrings, QuasiQuotes, DataKinds #-} + +module Network.Bitcoin.BitX.Spec.Specs.JsonSpec + ( + spec + ) where + +import Test.Hspec +import Network.Bitcoin.BitX.Types +import Record +import Network.Bitcoin.BitX.Spec.Common +import Data.Time.Clock.POSIX + +spec :: Spec +spec = do + describe "FromJSON intances" $ do + it "QuotedDecimal is parsed whether quoted or not, for floating point numbers" $ do + recordAesCheck + "{\"volume\":314159.23,\"price\":\"4321.56\"}" + ([record| + {volume = 314159.23, + price = 4321.56} |] :: Order) + it "QuotedDecimal is parsed whether quoted or not, for integral numbers" $ do + recordAesCheck + "{\"volume\":314159,\"price\":\"4321\"}" + ([record| + {volume = 314159, + price = 4321} |] :: Order) + it "OrderType BUY is parsed properly" $ do + recordAesCheck + "{\"base\":\"568.7\", \"counter\":3764.2,\"creation_timestamp\":478873467, \ + \\"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\":\"BUY\"}" + ([record| + {base = 568.7, + counter = 3764.2, + creationTimestamp = (posixSecondsToUTCTime 478873.467), + expirationTimestamp = (posixSecondsToUTCTime 8768834.222), + feeBase = 3687.3, + feeCounter = 12.9, + limitPrice = 765, + limitVolume = 55.2, + id = "83YG", + pair = NADXBT, + state = COMPLETE, + type = BID } |] :: PrivateOrder) + it "OrderType BID is parsed properly" $ do + recordAesCheck + "{\"base\":\"568.7\", \"counter\":3764.2,\"creation_timestamp\":478873467, \ + \\"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\"}" + ([record| + {base = 568.7, + counter = 3764.2, + creationTimestamp = (posixSecondsToUTCTime 478873.467), + expirationTimestamp = (posixSecondsToUTCTime 8768834.222), + feeBase = 3687.3, + feeCounter = 12.9, + limitPrice = 765, + limitVolume = 55.2, + id = "83YG", + pair = NADXBT, + state = COMPLETE, + type = BID } |] :: PrivateOrder) + it "OrderType ASK is parsed properly" $ do + recordAesCheck + "{\"base\":\"568.7\", \"counter\":3764.2,\"creation_timestamp\":478873467, \ + \\"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\":\"ASK\"}" + ([record| + {base = 568.7, + counter = 3764.2, + creationTimestamp = (posixSecondsToUTCTime 478873.467), + expirationTimestamp = (posixSecondsToUTCTime 8768834.222), + feeBase = 3687.3, + feeCounter = 12.9, + limitPrice = 765, + limitVolume = 55.2, + id = "83YG", + pair = NADXBT, + state = COMPLETE, + type = ASK } |] :: PrivateOrder) + it "OrderType SELL is parsed properly" $ do + recordAesCheck + "{\"base\":\"568.7\", \"counter\":3764.2,\"creation_timestamp\":478873467, \ + \\"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\":\"SELL\"}" + ([record| + {base = 568.7, + counter = 3764.2, + creationTimestamp = (posixSecondsToUTCTime 478873.467), + expirationTimestamp = (posixSecondsToUTCTime 8768834.222), + feeBase = 3687.3, + feeCounter = 12.9, + limitPrice = 765, + limitVolume = 55.2, + id = "83YG", + pair = NADXBT, + state = COMPLETE, + type = ASK } |] :: PrivateOrder) + it "RequestStatus COMPLETE is parsed properly" $ do + recordAesCheck + "{\"status\":\"COMPLETE\", \"id\":\"\"}" + ([record| + {status = COMPLETE, + id = "" } |] :: WithdrawalRequest) + it "RequestStatus COMPLETED is parsed properly" $ do + recordAesCheck + "{\"status\":\"COMPLETED\", \"id\":\"\"}" + ([record| + {status = COMPLETE, + id = "" } |] :: WithdrawalRequest) diff --git a/test/Network/Bitcoin/BitX/Spec/Specs/NetSpec.hs b/test/Network/Bitcoin/BitX/Spec/Specs/NetSpec.hs new file mode 100644 --- /dev/null +++ b/test/Network/Bitcoin/BitX/Spec/Specs/NetSpec.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE OverloadedStrings, QuasiQuotes, DataKinds, TemplateHaskell #-} + +module Network.Bitcoin.BitX.Spec.Specs.NetSpec + ( + spec + ) where + +import Test.Hspec +import Network.Bitcoin.BitX.Types +import Network.Bitcoin.BitX.Public +import System.IO.Unsafe (unsafePerformIO) +import Network.Bitcoin.BitX.Response + +spec :: Spec +spec = do + describe "Public BitX connectivity" $ do + it "getTicker connects to BitX and works" $ do + connectsAndParsesOkay $ getTicker XBTZAR + it "getTickers connects to BitX and works" $ do + connectsAndParsesOkay $ getTickers + it "getOrderBook connects to BitX and works" $ do + connectsAndParsesOkay $ getOrderBook XBTZAR + it "getTrades connects to BitX and works" $ do + connectsAndParsesOkay $ getTrades XBTKES + +connectsAndParsesOkay :: IO (BitXAPIResponse rec) -> Bool +connectsAndParsesOkay = isValidResponse . unsafePerformIO + +isValidResponse :: BitXAPIResponse rec -> Bool +isValidResponse (ValidResponse _) = True +isValidResponse _ = False diff --git a/test/Network/Bitcoin/BitX/Spec/Specs/PostSpec.hs b/test/Network/Bitcoin/BitX/Spec/Specs/PostSpec.hs new file mode 100644 --- /dev/null +++ b/test/Network/Bitcoin/BitX/Spec/Specs/PostSpec.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE OverloadedStrings, QuasiQuotes, DataKinds #-} + +module Network.Bitcoin.BitX.Spec.Specs.PostSpec + ( + spec + ) where + +import Test.Hspec +import Network.Bitcoin.BitX +import Record + +spec :: Spec +spec = do + describe "PostEncode test" $ do + it "OrderRequest is post-encoded properly" $ do + postEncode + ([record| + {pair = XBTZAR, + type = BID, + volume = 83.02, + price = 15.23 } |] :: OrderRequest) + `shouldBe` + [("pair", "XBTZAR"), + ("type", "BID"), + ("volume", "83.02"), + ("price", "15.23")] + it "Asset is post-encoded properly" $ do + postEncode ZAR + `shouldBe` + [("asset", "ZAR")] + it "NewWithdrawal is post-encoded properly" $ do + postEncode + ([record| + {type = ZAR_EFT, + amount = 83.02} |] :: NewWithdrawal) + `shouldBe` + [("type", "ZAR_EFT"), + ("amount", "83.02")] + it "BitcoinSendRequest is post-encoded properly" $ do + postEncode + ([record| + {amount = 83.02, + currency = XBT, + address = "ahglk98aslfk", + description = Just "Send some coinz to dis ere dude.", + message = Just "Dude, ere'z your coinz."} |] :: BitcoinSendRequest) + `shouldBe` + [("amount", "83.02"), + ("currency", "XBT"), + ("address", "ahglk98aslfk"), + ("description", "Send some coinz to dis ere dude."), + ("message", "Dude, ere'z your coinz.")] + it "QuoteRequest is post-encoded properly" $ do + postEncode + ([record| + {type = BUY, + pair = XBTKES, + baseAmount = 566.76} |] :: QuoteRequest) + `shouldBe` + [("type", "BUY"), + ("pair", "XBTKES"), + ("base_amount", "566.76")]