bitx-bitcoin (empty) → 0.1.0.0
raw patch · 14 files changed
+1870/−0 lines, 14 filesdep +Decimaldep +aesondep +basebuild-type:Customsetup-changed
Dependencies added: Decimal, aeson, base, bitx-bitcoin, bytestring, hspec, http-conduit, network, record, split, text, time
Files
- LICENSE +25/−0
- README.md +5/−0
- Setup.hs +2/−0
- bitx-bitcoin.cabal +103/−0
- src/Network/Bitcoin/BitX.hs +36/−0
- src/Network/Bitcoin/BitX/Internal.hs +108/−0
- src/Network/Bitcoin/BitX/Private.hs +246/−0
- src/Network/Bitcoin/BitX/Private/Auth.hs +73/−0
- src/Network/Bitcoin/BitX/Private/Quote.hs +98/−0
- src/Network/Bitcoin/BitX/Public.hs +65/−0
- src/Network/Bitcoin/BitX/Response.hs +40/−0
- src/Network/Bitcoin/BitX/Types.hs +489/−0
- src/Network/Bitcoin/BitX/Types/Internal.hs +579/−0
- test/Spec.hs +1/−0
+ LICENSE view
@@ -0,0 +1,25 @@+https://creativecommons.org/publicdomain/zero/1.0/+CC0 1.0 Universal (CC0 1.0) -- Public Domain Dedication++No Copyright+============++The person who associated a work with this deed has dedicated the work to the+public domain by waiving all of his or her rights to the work worldwide under+copyright law, including all related and neighboring rights, to the extent+allowed by law.++You can copy, modify, distribute and perform the work, even for commercial+purposes, all without asking permission. See Other Information below.++Other Information+=================++In no way are the patent or trademark rights of any person affected by CC0, nor+are the rights that other persons may have in the work or in how the work is+used, such as publicity or privacy rights.++Unless expressly stated otherwise, the person who associated a work with this+deed makes no warranties about the work, and disclaims liability for all uses of+the work, to the fullest extent permitted by applicable law. When using or+citing the work, you should not imply endorsement by the author or the affirmer.
+ README.md view
@@ -0,0 +1,5 @@+[](https://travis-ci.org/tebello-thejane/bitx-haskell) + +(Hopefully useful) Haskell bindings to the BitX bitcoin exchange's API. + +**This library is not yet complete.**
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bitx-bitcoin.cabal view
@@ -0,0 +1,103 @@+-- 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+synopsis: A Haskell library for working with the BitX bitcoin exchange.++description:+ Haskell bindings to the BitX REST API, as described here: <https://bitx.co/api>.+ .+ 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+ 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.+ .+ If you need to make sure that nothing funny happens in the code, apart from reading+ the source yourself, you should also perform a few test transations with very small+ denominations, as I will strive to do every time before releasing a new version.+ .+ For a very small usage example, see "Network.Bitcoin.BitX.Public".++license: PublicDomain++license-file: LICENSE++author: Tebello Thejane++maintainer: Tebello Thejane <zyxoas+hackage@gmail.com>++category: Web++build-type: Custom++extra-source-files:+ README.md++cabal-version: >=1.10++--------------------------------------------------------------------------------++library+ exposed-modules:+ Network.Bitcoin.BitX+ Network.Bitcoin.BitX.Public+ Network.Bitcoin.BitX.Private+ Network.Bitcoin.BitX.Types+ Network.Bitcoin.BitX.Private.Quote+ Network.Bitcoin.BitX.Private.Auth+ Network.Bitcoin.BitX.Response++ ghc-options: -Wall+ if impl(ghc >= 6.8)+ ghc-options: -fwarn-tabs++ other-modules:+ Network.Bitcoin.BitX.Internal+ Network.Bitcoin.BitX.Types.Internal++ -- 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,+ text,+ time,+ http-conduit >= 2.0.0,+ bytestring >= 0.10.0.0,+ Decimal >= 0.3.1,+ network >= 2.0,+ split >= 0.2.0.0++ default-language: Haskell2010+ hs-source-dirs: src++--------------------------------------------------------------------------------++source-repository head+ type:+ git+ location:+ git://github.com/tebello-thejane/bitx-haskell.git++--------------------------------------------------------------------------------++test-suite spec+ type:+ exitcode-stdio-1.0+ ghc-options:+ -Wall+ hs-source-dirs:+ test+ main-is:+ Spec.hs+ default-language: Haskell2010+ build-depends: base == 4.*,+ bitx-bitcoin,+ hspec == 2.*,+ aeson,+ record,+ bytestring,+ time
+ src/Network/Bitcoin/BitX.hs view
@@ -0,0 +1,36 @@+{-# OPTIONS_HADDOCK prune #-}++-----------------------------------------------------------------------------+-- |+-- Module : Network.Bitcoin.BitX+-- Copyright : No Rights Reserved+-- License : Public Domain+--+-- Maintainer : Tebello Thejane <zyxoas+hackage@gmail.com>+-- Stability : Experimental+-- Portability : non-portable (GHC Extensions)+--+-- This module re-exports the entire API. In practice it will be sufficient+-- for every use case.+-----------------------------------------------------------------------------++module Network.Bitcoin.BitX+ (+ module Network.Bitcoin.BitX.Types,+ 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.Response,+ BitXAesRecordConvert(..),+ POSTEncodeable(..)+ )+ where++import Network.Bitcoin.BitX.Types+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.Types.Internal+import Network.Bitcoin.BitX.Response
+ src/Network/Bitcoin/BitX/Internal.hs view
@@ -0,0 +1,108 @@+{-# LANGUAGE OverloadedStrings, QuasiQuotes, TemplateHaskell, DataKinds #-}++module Network.Bitcoin.BitX.Internal+ (+ simpleBitXGetAuth_,+ simpleBitXGet_,+ simpleBitXPOSTAuth_,+ simpleBitXMETHAuth_,+ consumeResponseBody_,+ bitXAPIPrefix+ )+where++import Network.Bitcoin.BitX.Types+import Network.Bitcoin.BitX.Types.Internal+import qualified Network.HTTP.Conduit as NetCon+import Network.HTTP.Conduit (Response(..), Request(..))+import Control.Exception (try, SomeException)+import qualified Data.Aeson as Aeson (decode)+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString as BS+import Data.Maybe (fromJust)+import Network (withSocketsDo)+import Record (lens)+import Record.Lens (view)+import qualified Data.Text.Encoding as Txt+import qualified Data.Text as Txt+import Network.Bitcoin.BitX.Response++bitXAPIPrefix :: String+bitXAPIPrefix = "https://api.mybitx.com/api/"++bitXAPIRoot :: String+bitXAPIRoot = bitXAPIPrefix ++ "1/"++simpleBitXGetAuth_ :: BitXAesRecordConvert rec aes => BitXAuth -> String -> IO (BitXAPIResponse rec)+simpleBitXGetAuth_ auth verb = withSocketsDo $ do+ response <- try . NetCon.withManager . NetCon.httpLbs . NetCon.applyBasicAuth+ userID+ userSecret+ . fromJust . NetCon.parseUrl $ (bitXAPIRoot ++ verb)+ :: IO (Either SomeException (Response BL.ByteString))+ consumeResponseBody_ response+ where+ userID = Txt.encodeUtf8 $ (view [lens| id |] auth)+ userSecret = Txt.encodeUtf8 $ (view [lens| secret |] auth)++simpleBitXPOSTAuth_ :: (BitXAesRecordConvert rec aes, POSTEncodeable inprec) => BitXAuth -> inprec+ -> String -> IO (BitXAPIResponse rec)+simpleBitXPOSTAuth_ auth encrec verb = withSocketsDo $ do+ response <- try . NetCon.withManager . NetCon.httpLbs . NetCon.applyBasicAuth+ userID+ userSecret+ . NetCon.urlEncodedBody (postEncode encrec)+ . fromJust . NetCon.parseUrl $ (bitXAPIRoot ++ verb)+ :: IO (Either SomeException (Response BL.ByteString))+ consumeResponseBody_ response+ where+ userID = Txt.encodeUtf8 $ (view [lens| id |] auth)+ userSecret = Txt.encodeUtf8 $ (view [lens| secret |] auth)++simpleBitXMETHAuth_ :: BitXAesRecordConvert rec aes => BitXAuth -> BS.ByteString+ -> String -> IO (BitXAPIResponse rec)+simpleBitXMETHAuth_ auth meth verb = withSocketsDo $ do+ let initReq = (fromJust (NetCon.parseUrl $ (bitXAPIRoot ++ verb))) { method = meth }+ response <- try . NetCon.withManager . NetCon.httpLbs . NetCon.applyBasicAuth+ userID+ userSecret $ initReq+ :: IO (Either SomeException (Response BL.ByteString))+ consumeResponseBody_ response+ where+ userID = Txt.encodeUtf8 $ (view [lens| id |] auth)+ userSecret = Txt.encodeUtf8 $ (view [lens| secret |] auth)++simpleBitXGet_ :: BitXAesRecordConvert rec aes => String -> IO (BitXAPIResponse rec)+simpleBitXGet_ verb = withSocketsDo $ do+ resp <- try . NetCon.withManager . NetCon.httpLbs+ . fromJust . NetCon.parseUrl $ (bitXAPIRoot ++ verb)+ :: IO (Either SomeException (Response BL.ByteString))+ consumeResponse resp++consumeResponse :: BitXAesRecordConvert rec aes => Either SomeException (NetCon.Response BL.ByteString)+ -> IO (BitXAPIResponse rec)+consumeResponse resp =+ case resp of+ Left ex -> return $ ExceptionResponse . Txt.pack . show $ ex+ Right k -> bitXErrorOrPayload k++consumeResponseBody_ :: BitXAesRecordConvert rec aes => Either SomeException (NetCon.Response BL.ByteString)+ -> IO (BitXAPIResponse rec)+consumeResponseBody_ resp =+ case resp of+ Left ex -> return $ 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+
+ src/Network/Bitcoin/BitX/Private.hs view
@@ -0,0 +1,246 @@+{-# LANGUAGE OverloadedStrings #-}++-----------------------------------------------------------------------------+-- |+-- Module : Network.Bitcoin.BitX.Private+-- Copyright : No Rights Reserved+-- License : Public Domain+--+-- Maintainer : Tebello Thejane <zyxoas+hackage@gmail.com>+-- Stability : Experimental+-- Portability : non-portable (GHC Extensions)+--+-- =The private BitX API.+--+-- Each one of the calls takes at least a 'BitXAuth' containing a previously-created API id and+-- secret (created by 'Network.Bitcoin.BitX.Private.Auth.authGrant', or created by visiting+-- <https://bitx.co/settings#/api_keys>), and may either return a+-- useful 'record', a 'BitXError' if BitX actually returned an error, or 'Nothing' if some exception+-- occured (or if the data returned by BitX was unparseable).+--+-- =Permissions+--+-- Each API key is granted a set of permissions when it is created. The key can only be used to call+-- the permitted API functions.+--+-- Here is a list of the possible permissions:+--+-- * @Perm_R_Balance = 1@ (View balance)+-- * @Perm_R_Transactions = 2@ (View transactions)+-- * @Perm_W_Send = 4@ (Send to any address)+-- * @Perm_R_Addresses = 8@ (View addresses)+-- * @Perm_W_Addresses = 16@ (Create addresses)+-- * @Perm_R_Orders = 32@ (View orders)+-- * @Perm_W_Orders = 64@ (Create orders)+-- * @Perm_R_Withdrawals = 128@ (View withdrawals)+-- * @Perm_W_Withdrawals = 256@ (Create withdrawals)+-- * @Perm_R_Merchant = 512@ (View merchant invoices)+-- * @Perm_W_Merchant = 1024@ (Create merchant invoices)+--+-- A set of permissions is represented as the bitwise OR of each permission in the set. For example+-- the set of permissions required to view balances and orders is @Perm_R_Balance | Perm_R_Orders =+-- 33.@+--+-----------------------------------------------------------------------------++module Network.Bitcoin.BitX.Private+ (+ getAllOrders,+ postOrder,+ stopOrder,+ getOrder,+ getBalances,+ getFundingAddress,+ newFundingAddress,+ getWithdrawalRequests,+ newWithdrawalRequest,+ getWithdrawalRequest,+ sendToAddress,+ --cancelWithdrawalRequest,+ getTransactions,+ getPendingTransactions+ ) 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.++@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++{- | Return account balances++@Perm_R_Balance@ permission required. -}++getBalances :: BitXAuth -> IO (BitXAPIResponse [Balance])+getBalances auth = simpleBitXGetAuth_ auth "balance"++{- | Returns the default receive address associated with your account and the amount received via+the address++You can specify an optional address parameter to return information for a non-default receive+address. In the response, total_received is the total confirmed Bitcoin amount received excluding+unconfirmed transactions. total_unconfirmed is the total sum of unconfirmed receive transactions.++@Perm_R_Addresses@ permission is required.+-}++getFundingAddress :: BitXAuth -> Asset -> Maybe String -> IO (BitXAPIResponse FundingAddress)+getFundingAddress auth asset addr = simpleBitXGetAuth_ auth url+ where+ url = "funding_address?asset=" ++ show asset ++ case addr of+ Nothing -> ""+ Just ad -> "&address=" ++ ad++{- | Create receive address++Allocates a new receive address to your account. There is a limit of 50 receive addresses per user.++@Perm_R_Addresses@ permission is required.+-}++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.++If the email address is not associated with an existing BitX account, an invitation to create an account+and claim the funds will be sent.++__Warning! Bitcoin transactions are irreversible. Please ensure your program has been thoroughly__+__tested before using this call.__+++@Perm_W_Send@ permission required. Note that when creating an API key on the BitX site, selecting+"Full access" is not sufficient to add the @Perm_W_Send@ permission. Instead, the permission needs+to be enabled explicitely by selecting "Custom."-}++sendToAddress :: BitXAuth -> BitcoinSendRequest -> IO (BitXAPIResponse RequestSuccess)+sendToAddress auth sreq = simpleBitXPOSTAuth_ auth sreq "send"++{- | Return a list of transaction entries from an account.++Transaction entry rows are numbered sequentially starting from 1, where 1 is the oldest entry. The+range of rows to return are specified with the min_row (inclusive) and max_row (exclusive)+parameters. At most 1000 rows can be requested per call.++If min_row or max_row is nonpositive, the range wraps around the most recent row. For example, to+fetch the 100 most recent rows, use min_row=-100 and max_row=0.++@Perm_R_Transactions@ permission required.+-}++getTransactions+ :: BitXAuth+ -> AccountID+ -> Int -- ^ First row returned, inclusive+ -> 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++{- | Pending transactions++Return a list of all pending transactions related to the account.++Unlike account entries, pending transactions are not numbered, and may be reordered, deleted or+updated at any time.++@Perm_R_Transactions@ permission required.+-}++getPendingTransactions :: BitXAuth -> AccountID -> IO (BitXAPIResponse [Transaction])+getPendingTransactions auth accid = liftM imebPendingTransactionsToimebTransactions $ simpleBitXGetAuth_ auth $+ "accounts/" ++ Txt.unpack accid ++ "/pending"+ where+ imebPendingTransactionsToimebTransactions (ValidResponse v) = ValidResponse $ pendingTransactionsToTransactions v+ imebPendingTransactionsToimebTransactions (ExceptionResponse x) = ExceptionResponse x+ imebPendingTransactionsToimebTransactions (ErrorResponse e) = ErrorResponse e+ imebPendingTransactionsToimebTransactions (UnparseableResponse u) = UnparseableResponse u
+ src/Network/Bitcoin/BitX/Private/Auth.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE OverloadedStrings, QuasiQuotes, DataKinds #-}++-----------------------------------------------------------------------------+-- |+-- Module : Network.Bitcoin.BitX.Private.Auth+-- Copyright : No Rights Reserved+-- License : Public Domain+--+-- Maintainer : Tebello Thejane <zyxoas+hackage@gmail.com>+-- 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 <support@bitx.co>,+-- 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 <https://bitx.co/oauth2/authorize?client_id=your_client_id&scope=your_requested_permissions&state=your_unique_state>,+-- 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: <https://example.com/callback?code=authorization_code&state=your_unique_state>+--+-- 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
+ src/Network/Bitcoin/BitX/Private/Quote.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE OverloadedStrings #-}++-----------------------------------------------------------------------------+-- |+-- Module : Network.Bitcoin.BitX.Private.Quote+-- Copyright : No Rights Reserved+-- License : Public Domain+--+-- Maintainer : Tebello Thejane <zyxoas+hackage@gmail.com>+-- Stability : Experimental+-- Portability : non-portable (GHC Extensions)+--+-- The API for dealing with quotes.+--+-- Quotes allow you to lock in an exchange rate for a short time with the+-- option of either accepting or rejecting the quote.+--+-- Quotes can be useful for various customer-facing applications where+-- price fluctuations would be confusing.+--+-- The API is used as follows: First create a quote for the transaction that+-- you want to perform. If you decide to accept the quote before it expires,+-- you will exercise the quote. If you decide not to accept it, you will+-- discard the quote. You can also retrieve the status of a quote at any time.+--+-----------------------------------------------------------------------------++module Network.Bitcoin.BitX.Private.Quote+ (+ newQuote,+ getQuote,+ exerciseQuote,+ discardQuote+ ) where++import Network.Bitcoin.BitX.Internal+import Network.Bitcoin.BitX.Types+import Data.Text (Text)+import qualified Data.Text as Txt+import Network.Bitcoin.BitX.Response++{- | Create a quote++Creates a new quote to buy or sell a particular amount.++You can specify either the exact amount that you want to pay or the exact amount that you want to+receive.++For example, to buy exactly 0.1 Bitcoin using ZAR, you would create a quote to BUY 0.1 XBTZAR.+The returned quote includes the appropriate ZAR amount. To buy Bitcoin using exactly ZAR 100,+you would create a quote to SELL 100 ZARXBT. The returned quote specifies the Bitcoin as the+counter amount that will be returned.++An error is returned if your account is not verified for the currency pair, or if your account+would have insufficient balance to ever exercise the quote.++The currency pair can also be flipped if you want to buy or sell the counter currency (e.g. ZARXBT).++@Perm_W_Orders@ permission required.+-}++newQuote :: BitXAuth -> QuoteRequest -> IO (BitXAPIResponse OrderQuote)+newQuote auth qreq = simpleBitXPOSTAuth_ auth qreq "quotes"++{- | Get a quote++Get the latest status of a quote, retrieved by ID.++@Perm_R_Orders@ permission required.+-}++getQuote :: BitXAuth -> Text -> IO (BitXAPIResponse OrderQuote)+getQuote auth qid = simpleBitXGetAuth_ auth $ "quotes/" ++ Txt.unpack qid++{- | Exercise a quote++Exercise a quote to perform the trade. If there is sufficient balance available in your account,+it will be debited and the counter amount credited.++An error is returned if the quote has expired or if you have insufficient available balance.++@Perm_W_Orders@ permission required.+-}++exerciseQuote :: BitXAuth -> Text -> IO (BitXAPIResponse OrderQuote)+exerciseQuote auth qid = simpleBitXMETHAuth_ auth "PUT" $ "quotes/" ++ Txt.unpack qid++{- | Discard a quote++Discard a quote. Once a quote has been discarded, it cannot be exercised even if it has not expired+yet.++@Perm_W_Orders@ permission required.+-}++discardQuote :: BitXAuth -> Text -> IO (BitXAPIResponse OrderQuote)+discardQuote auth qid = simpleBitXMETHAuth_ auth "DELETE" $ "quotes/" ++ Txt.unpack qid+
+ src/Network/Bitcoin/BitX/Public.hs view
@@ -0,0 +1,65 @@+-----------------------------------------------------------------------------+-- |+-- Module : Network.Bitcoin.BitX.Public+-- Copyright : No Rights Reserved+-- License : Public Domain+--+-- Maintainer : Tebello Thejane <zyxoas+hackage@gmail.com>+-- Stability : Experimental+-- Portability : non-portable (GHC Extensions)+--+-- =Usage example+--+-- As a small example, to get the current selling price of bitcoin on the BitX exchange, do the following:+--+-- @+--{-\# LANGUAGE QuasiQuotes \#-}+--+--import Record.Lens+--import Record+--import Network.Bitcoin.BitX+--+--main = do+-- bitXResponse <- 'getTicker' 'XBTZAR'+-- case bitXResponse of+-- 'ValidResponse' tic -> print ('view' [lens| ask |] tic)+-- _ -> error "Ah well..."+-- @+--+-----------------------------------------------------------------------------++module Network.Bitcoin.BitX.Public+ (+ getTicker,+ getTickers,+ getOrderBook,+ getTrades+ ) where++import Network.Bitcoin.BitX.Internal+import Network.Bitcoin.BitX.Types+import Network.Bitcoin.BitX.Response++{- | Returns the latest ticker indicators. -}++getTicker :: CcyPair -> IO (BitXAPIResponse Ticker)+getTicker cyp = simpleBitXGet_ $ "ticker?pair=" ++ show cyp++{- | Returns the latest ticker indicators from all active BitX exchanges. -}++getTickers :: IO (BitXAPIResponse [Ticker])+getTickers = simpleBitXGet_ "tickers"++{- | Returns a list of bids and asks in the order book.++Ask orders are sorted by price ascending. Bid orders are sorted by price descending.+Note that multiple orders at the same price are not necessarily conflated. -}++getOrderBook :: CcyPair -> IO (BitXAPIResponse Orderbook)+getOrderBook cyp = simpleBitXGet_ $ "orderbook?pair=" ++ show cyp++{- | Returns a list of the most recent trades -}++getTrades :: CcyPair -> IO (BitXAPIResponse [Trade])+getTrades cyp = simpleBitXGet_ $ "trades?pair=" ++ show cyp+
+ src/Network/Bitcoin/BitX/Response.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE StandaloneDeriving #-}++-----------------------------------------------------------------------------+-- |+-- Module : Network.Bitcoin.BitX.Response+-- Copyright : No Rights Reserved+-- License : Public Domain+--+-- Maintainer : Tebello Thejane <zyxoas+hackage@gmail.com>+-- Stability : Experimental+-- Portability : non-portable (GHC Extensions)+--+-- The common return type of the API.+--+-----------------------------------------------------------------------------++module Network.Bitcoin.BitX.Response+ (+ BitXAPIResponse(..)+ ) where+++import Network.HTTP.Conduit (Response(..))+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.+ | 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.+ | 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)
+ src/Network/Bitcoin/BitX/Types.hs view
@@ -0,0 +1,489 @@+{-# LANGUAGE DeriveGeneric, DefaultSignatures, QuasiQuotes, OverloadedStrings, DataKinds,+ MultiParamTypeClasses #-}+++-----------------------------------------------------------------------------+-- |+-- Module : Network.Bitcoin.BitX.Types+-- Copyright : No Rights Reserved+-- License : Public Domain+--+-- Maintainer : Tebello Thejane <zyxoas+hackage@gmail.com>+-- Stability : Experimental+-- Portability : non-portable (GHC Extensions)+--+-- The types used for the various BitX API calls.+--+-- Note that these are all `record` types, as provided by Nikita Volkov's+-- "Record" library. The main motivation for using the @record@ library was+-- 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+--+-- @+-- type BitXAuth =+-- ['record'|+-- {id :: 'Text',+-- secret :: 'Text'} |]+-- @+--+-- To declare a BitXAuth, one might use+--+-- @+-- myAuth :: BitXAuth+-- myAuth =+-- [record|+-- {id = "46793",+-- secret = "387ffBd56eEAA7C59"} |]+-- @+--+-- and to read the fields you would use+--+-- @+-- theID = 'view' ['lens'| id |] myAuth+-- @+--+-- Note that all uses of Volkov's `record`s requires importing "Record" and+-- enabling the 'DataKinds' and 'QuasiQuotes' extensions.+--+-- See <http://nikita-volkov.github.io/record/>+--+-----------------------------------------------------------------------------++module Network.Bitcoin.BitX.Types+ (+ Ticker,+ CcyPair(..),+ Orderbook,+ Order,+ Bid,+ Ask,+ Trade,+ BitXAuth,+ PrivateOrder,+ OrderID,+ OrderType(..),+ RequestStatus(..),+ OrderRequest,+ RequestSuccess,+ BitXError,+ PrivateOrderWithTrades,+ AccountID,+ Asset(..),+ Balance,+ FundingAddress,+ WithdrawalRequest,+ NewWithdrawal,+ WithdrawalType(..),+ BitcoinSendRequest,+ QuoteRequest,+ OrderQuote,+ QuoteType(..),+ BitXClientAuth,+ Transaction+ ) where++import Data.Aeson (FromJSON(..))+import Data.Text (Text)+import Data.Time.Clock+import Record+import GHC.Generics (Generic)+import Data.Decimal++-- | A possible error which the BitX API might return,+-- instead of returning the requested data. Note that as yet there is no+-- exhaustive list of error codes available, so comparisons will have to be+-- done via Text comparisons (as opposed to typed pattern matching). Sorry...+--+-- @+--type BitXError =+-- [record|+-- {error :: 'Text',+-- errorCode :: 'Text'} |]+-- @++type BitXError =+ [record|+ {error :: Text,+ errorCode :: Text} |]++-- | The state of a single market, identified by the currency pair.+-- As usual, the ask\/sell price is the price of the last filled ask order, and the bid\/buy price is+-- the price of the last filled bid order. Necessarily @bid <= ask.@+--+-- @+--type Ticker =+-- [record|+-- {ask :: 'Decimal',+-- timestamp :: 'UTCTime',+-- bid :: 'Decimal',+-- rolling24HourVolume :: 'Decimal',+-- lastTrade :: 'Decimal',+-- pair :: 'CcyPair'} |]+-- @++type Ticker =+ [record|+ {ask :: Decimal,+ timestamp :: UTCTime,+ bid :: Decimal,+ rolling24HourVolume :: Decimal,+ lastTrade :: Decimal,+ pair :: CcyPair} |]++-- | A currency pair+data CcyPair =+ XBTZAR -- ^ Bitcoin vs. ZAR+ | XBTNAD -- ^ Bitcoin vs. Namibian Dollar+ | ZARXBT -- ^ ZAR vs. Namibian Dollar+ | NADXBT -- ^ Namibian Dollar vs. Bitcoin+ | XBTKES -- ^ Bitcoin vs. Kenyan Shilling+ | KESXBT -- ^ Kenyan Shilling vs Bitcoin+ | XBTMYR -- ^ Bitcoin vs. Malaysian Ringgit+ | MYRXBT -- ^ Malaysian Ringgit vs. Bitcoin+ deriving (Show, Generic, Eq)++-- | A trade-able asset. Essentially, a currency.+data Asset =+ ZAR -- ^ South African Rand+ | NAD -- ^ Namibian Dollar+ | XBT -- ^ Bitcoin+ | KES -- ^ Kenyan Shilling+ | MYR -- ^ Malaysian Ringgit+ deriving (Show, Generic, Eq)++-- | The current state of the publically accessible orderbook.+-- Bid orders are requests to buy, ask orders are requests to sell.+--+-- @+--type Orderbook =+-- [record|+-- {timestamp :: 'UTCTime',+-- bids :: ['Bid'],+-- asks :: ['Ask']} |]+-- @++type Orderbook =+ [record|+ {timestamp :: UTCTime,+ bids :: [Bid],+ asks :: [Ask]} |]++-- | A single placed order in the orderbook+--+-- @+--type Order =+-- [record|+-- {volume :: 'Decimal',+-- price :: 'Decimal'} |]+-- @++type Order =+ [record|+ {volume :: Decimal,+ price :: Decimal} |]++-- | Convenient type alias for a bid order+type Bid = Order++-- | Convenient type alias for an ask order+type Ask = Order++type Trade =+ [record|+ {volume :: Decimal,+ timestamp :: UTCTime,+ price :: Decimal} |]++-- | An auth type used by all private API calls, after authorisation.+--+-- @+--type BitXAuth =+-- [record|+-- {id :: 'Text',+-- secret :: 'Text'} |]+-- @+type BitXAuth =+ [record|+ {id :: Text,+ secret :: Text} |]++type BitXClientAuth = BitXAuth++-- | A recently placed (private) order, containing a lot more information than is available on the+-- public order book.+--+-- @+--type PrivateOrder =+-- [record|+-- {base :: 'Decimal',+-- counter :: 'Decimal',+-- creationTimestamp :: 'UTCTime',+-- expirationTimestamp :: 'UTCTime',+-- feeBase :: 'Decimal',+-- feeCounter :: 'Decimal',+-- limitPrice :: 'Decimal',+-- limitVolume :: 'Decimal',+-- id :: 'OrderID',+-- pair :: 'CcyPair',+-- state :: 'RequestStatus',+-- type :: 'OrderType' } |]+-- @+type PrivateOrder =+ [record|+ {base :: Decimal,+ counter :: Decimal,+ creationTimestamp :: UTCTime,+ expirationTimestamp :: UTCTime,+ feeBase :: Decimal,+ feeCounter :: Decimal,+ limitPrice :: Decimal,+ limitVolume :: Decimal,+ id :: OrderID,+ pair :: CcyPair,+ state :: RequestStatus,+ type :: OrderType } |]++-- | A recently placed (private) order, containing a lot more information than is available on the+-- public order book, together with details of any trades which have (partially) filled it.+--+-- @+--type PrivateOrderWithTrades =+-- [record|+-- {base :: 'Decimal',+-- counter :: 'Decimal',+-- creationTimestamp :: 'UTCTime',+-- expirationTimestamp :: 'UTCTime',+-- feeBase :: 'Decimal',+-- feeCounter :: 'Decimal',+-- limitPrice :: 'Decimal',+-- limitVolume :: 'Decimal',+-- id :: 'OrderID',+-- pair :: 'CcyPair',+-- state :: 'RequestStatus',+-- type :: 'OrderType',+-- trades :: ['Trade'] } |]+-- @+type PrivateOrderWithTrades =+ [record|+ {base :: Decimal,+ counter :: Decimal,+ creationTimestamp :: UTCTime,+ expirationTimestamp :: UTCTime,+ feeBase :: Decimal,+ feeCounter :: Decimal,+ limitPrice :: Decimal,+ limitVolume :: Decimal,+ id :: OrderID,+ pair :: CcyPair,+ state :: RequestStatus,+ type :: OrderType,+ trades :: [Trade] } |]++-- | A transaction on a private user account.+--+-- @+--type Transaction =+-- [record|+-- {rowIndex :: 'Int',+-- timestamp :: 'UTCTime',+-- balance :: 'Decimal',+-- available :: 'Decimal',+-- balanceDelta :: 'Decimal',+-- availableDelta :: 'Decimal',+-- currency :: 'Asset',+-- description :: 'Text'}|]+-- @+type Transaction =+ [record|+ {rowIndex :: Int,+ timestamp :: UTCTime,+ balance :: Decimal,+ available :: Decimal,+ balanceDelta :: Decimal,+ availableDelta :: Decimal,+ currency :: Asset,+ description :: Text}|]++type OrderID = Text++-- | The type of a placed order.+data OrderType =+ ASK -- ^ A request to sell+ | BID -- ^ A request to buy+ deriving (Show, Generic, Eq)++-- | The state of a (private) placed request -- either an order or a withdrawal request.+data RequestStatus =+ PENDING -- ^ Not yet completed. An order will stay in 'PENDING' state even as it is partially+ -- filled, and will move to 'COMPLETE' once it has been completely filled.+ | COMPLETE -- ^ Completed.+ | CANCELLED -- ^ Cancelled. Note that an order cannot be in 'CANCELLED' state, since cancelling+ -- an order removes it from the orderbook.+ deriving (Show, Generic, Eq)++-- | A request to place an order.+--+-- @+--type OrderRequest =+-- [record|+-- {pair :: 'CcyPair',+-- type :: 'OrderType',+-- volume :: 'Decimal',+-- price :: 'Decimal' } |]+-- @+type OrderRequest =+ [record|+ {pair :: CcyPair,+ type :: OrderType,+ volume :: Decimal,+ price :: Decimal } |]++type AccountID = Text++-- | The current balance of a private account.+--+-- @+--type Balance =+-- [record|+-- {id :: 'AccountID',+-- asset :: 'Asset',+-- balance :: 'Decimal',+-- reserved :: 'Decimal',+-- unconfirmed :: 'Decimal' } |]+-- @+type Balance =+ [record|+ {id :: AccountID,+ asset :: Asset,+ balance :: Decimal,+ reserved :: Decimal,+ unconfirmed :: Decimal } |]++-- | A registered address for an acocunt.+--+-- @+--type FundingAddress =+-- [record|+-- {asset :: 'Asset',+-- address :: 'Text',+-- totalReceived :: 'Decimal',+-- totalUnconfirmed :: 'Decimal'} |]+-- @+type FundingAddress =+ [record|+ {asset :: Asset,+ address :: Text,+ totalReceived :: Decimal,+ totalUnconfirmed :: Decimal} |]++-- | The state of a request to withdraw from an account.+--+-- @+--type WithdrawalRequest =+-- [record|+-- {status :: 'RequestStatus',+-- id :: 'Text' } |]+-- @+type WithdrawalRequest =+ [record|+ {status :: RequestStatus,+ id :: Text } |]++-- | A request to withdraw from an account.+--+-- @+--type NewWithdrawal =+-- [record|+-- {type :: 'WithdrawalType',+-- amount :: 'Decimal' } |]+-- @+type NewWithdrawal =+ [record|+ {type :: WithdrawalType,+ amount :: Decimal } |]++-- | A request to send bitcoin to a bitcoin address or email address.+--+-- @+--type BitcoinSendRequest =+-- [record|+-- {amount :: 'Decimal',+-- currency :: 'Asset',+-- address :: 'Text',+-- description :: 'Maybe' 'Text',+-- message :: 'Maybe' 'Text'} |]+-- @+type BitcoinSendRequest =+ [record|+ {amount :: Decimal,+ currency :: Asset,+ address :: Text,+ description :: Maybe Text,+ message :: Maybe Text} |]++-- | A request to lock in a quote.+--+-- @+--type QuoteRequest =+-- [record|+-- {type :: 'QuoteType',+-- pair :: 'CcyPair',+-- baseAmount :: 'Decimal'} |]+-- @+type QuoteRequest =+ [record|+ {type :: QuoteType,+ pair :: CcyPair,+ baseAmount :: Decimal} |]++-- | A temporarily locked in quote.+--+-- @+--type OrderQuote =+-- [record|+-- {id :: 'Text',+-- type :: 'QuoteType',+-- pair :: 'CcyPair',+-- baseAmount :: 'Decimal',+-- counterAmount :: 'Decimal',+-- createdAt :: 'UTCTime',+-- expiresAt :: 'UTCTime',+-- discarded :: 'Bool',+-- exercised :: 'Bool'} |]+-- @+type OrderQuote =+ [record|+ {id :: Text,+ type :: QuoteType,+ pair :: CcyPair,+ baseAmount :: Decimal,+ counterAmount :: Decimal,+ createdAt :: UTCTime,+ expiresAt :: UTCTime,+ discarded :: Bool,+ exercised :: Bool} |]++-- | The type of a withdrawal request.+data WithdrawalType =+ ZAR_EFT -- ^ ZAR by Electronic Funds Transfer+ | NAD_EFT -- ^ Namibian Dollar by EFT+ | KES_MPESA -- ^ Kenyan Shilling by Vodafone MPESA+ | MYR_IBG -- ^ Malaysian Ringgit by Interbank GIRO (?)+ | IDR_LLG -- ^ Indonesian Rupiah by Lalu Lintas Giro (??)+ deriving (Show, Generic, Eq)++data QuoteType = BUY | SELL deriving (Show, Generic, Eq)++type RequestSuccess = Bool++instance FromJSON CcyPair++instance FromJSON Asset++instance FromJSON OrderType++instance FromJSON WithdrawalType++instance FromJSON QuoteType
+ src/Network/Bitcoin/BitX/Types/Internal.hs view
@@ -0,0 +1,579 @@+{-# LANGUAGE QuasiQuotes, OverloadedStrings, TemplateHaskell, MultiParamTypeClasses,+ FunctionalDependencies, FlexibleInstances, DataKinds, CPP #-}++{-# OPTIONS_GHC -fno-warn-unused-binds #-}++module Network.Bitcoin.BitX.Types.Internal+ (+ BitXAesRecordConvert(..),+ POSTEncodeable(..),+ --showableToBytestring_,+ Transaction_(..),+ pendingTransactionsToTransactions,+ PendingTransactions__+ )+where++import Network.Bitcoin.BitX.Types+import Data.Aeson (FromJSON(..), parseJSON, Value(..))+import qualified Data.Aeson.TH as AesTH+import qualified Data.Text as Txt+import qualified Data.Text.Encoding as Txt+import Data.Text (Text)+import Data.Time.Clock (UTCTime)+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)+import Record+import Record.Lens (view)+#if MIN_VERSION_base(4,8,0)+-- base 4.8 re-exports Monoid and its functions/constants+#else+import Data.Monoid (mempty)+#endif+import Data.Decimal (Decimal)+import Data.ByteString (ByteString)+import Data.List.Split (splitOn)++timestampParse_ :: Integer -> UTCTime+timestampParse_ = posixSecondsToUTCTime+ . fromRational . toRational+ . ( / 1000)+ . (fromIntegral :: Integer -> Decimal)++class (FromJSON aes) => BitXAesRecordConvert rec aes | rec -> aes where+ aesToRec :: aes -> rec++class POSTEncodeable rec where+ postEncode :: rec -> [(ByteString, ByteString)]+++showableToBytestring_ :: (Show a) => a -> ByteString+showableToBytestring_ = Txt.encodeUtf8 . Txt.pack . show++-- | Wrapper around Decimal and FromJSON instance, to facilitate automatic JSON instances++newtype QuotedDecimal = QuotedDecimal Decimal deriving (Read, Show)++instance FromJSON QuotedDecimal where+ parseJSON (String x) = return . QuotedDecimal . read . Txt.unpack $ x+ parseJSON (Number x) = return . QuotedDecimal . read . show $ x+ parseJSON _ = mempty++--instance ToJSON QuotedDecimal where+-- toJSON (QuotedDecimal q) = Number . realToFrac $ q++qdToDecimal :: QuotedDecimal -> Decimal+qdToDecimal (QuotedDecimal dec) = dec++-- | Wrapper around UTCTime and FromJSON instance, to facilitate automatic JSON instances++newtype TimestampMS = TimestampMS Integer deriving (Read, Show)++instance FromJSON TimestampMS where+ parseJSON (Number x) = return . TimestampMS . round $ x+ parseJSON _ = mempty++--instance ToJSON TimestampMS where+-- toJSON (TimestampMS t) = Number . fromIntegral $ t++tsmsToUTCTime :: TimestampMS -> UTCTime+tsmsToUTCTime (TimestampMS ms) = timestampParse_ ms+++newtype OrderType_ = OrderType_ Text deriving (Read, Show)++instance FromJSON OrderType_ where+ parseJSON (String x) = return . OrderType_ $ x+ parseJSON _ = mempty++orderTypeParse :: OrderType_ -> OrderType+orderTypeParse (OrderType_ "BUY") = BID+orderTypeParse (OrderType_ "BID") = BID+orderTypeParse (OrderType_ "ASK") = ASK+orderTypeParse (OrderType_ "SELL") = ASK+orderTypeParse (OrderType_ _ ) = error "Yet another surprise from the BitX API..."+++newtype RequestStatus_ = RequestStatus_ Text deriving (Read, Show)++instance FromJSON RequestStatus_ where+ parseJSON (String x) = return . RequestStatus_ $ x+ parseJSON _ = mempty++requestStatusParse :: RequestStatus_ -> RequestStatus+requestStatusParse (RequestStatus_ "PENDING") = PENDING+requestStatusParse (RequestStatus_ "COMPLETE") = COMPLETE+requestStatusParse (RequestStatus_ "COMPLETED") = COMPLETE+requestStatusParse (RequestStatus_ "CANCELLED") = CANCELLED+requestStatusParse (RequestStatus_ _ ) = error "Yet another surprise from the BitX API..."++-------------------------------------------- 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'pair :: CcyPair+ }++$(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"}+ ''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} |]++--------------------------------------------- Tickers type -----------------------------------------++data Tickers_ = Tickers_+ { tickers'tickers :: [Ticker_]+ }++$(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"}+ ''Tickers_)++instance BitXAesRecordConvert [Ticker] Tickers_ where+ aesToRec (Tickers_ tickers''tickers) =+ map aesToRec tickers''tickers++-------------------------------------------- BitXError type ----------------------------------------++data BitXError_= BitXError_+ { bitXError'error :: Text,+ bitXError'error_code :: Text+ } deriving (Show, Eq)++$(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} |]++-------------------------------------------- Order type --------------------------------------------++data Order_ = Order_+ { order'volume :: QuotedDecimal,+ order'price :: QuotedDecimal+ }++$(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} |]++-------------------------------------------- Orderbook type ----------------------------------------++data Orderbook_ = Orderbook_+ { orderbook'timestamp :: TimestampMS,+ orderbook'bids :: [Bid_],+ orderbook'asks :: [Ask_]+ }++type Bid_ = Order_+type Ask_ = Order_++$(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"}+ ''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} |]++-------------------------------------------- Trade type --------------------------------------------++data Trade_ = Trade_+ { trade'volume :: QuotedDecimal+ , trade'timestamp :: TimestampMS+ , trade'price :: QuotedDecimal+ }++$(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} |]++----------------------------------------- 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++------------------------------------------ PrivateOrder type ---------------------------------------++data PrivateOrder_ = PrivateOrder_+ { privateOrder'base :: QuotedDecimal+ , privateOrder'counter :: QuotedDecimal+ , 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'order_id :: OrderID+ , privateOrder'pair :: CcyPair+ , privateOrder'state :: RequestStatus_+ , privateOrder'type :: OrderType_+ }++$(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"}+ ''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} |]++------------------------------------------ PrivateOrders type --------------------------------------++data PrivateOrders_ = PrivateOrders_+ {privateOrders'orders :: [PrivateOrder_]+ }++$(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"}+ ''PrivateOrders_)++instance BitXAesRecordConvert [PrivateOrder] PrivateOrders_ where+ aesToRec (PrivateOrders_ privateOrders''orders) =+ map aesToRec privateOrders''orders++------------------------------------------ OrderRequest type ---------------------------------------++instance POSTEncodeable OrderRequest where+ postEncode oreq =+ [("pair", showableToBytestring_ (view [lens| pair |] oreq)),+ ("type", showableToBytestring_ (view [lens| type |] oreq)),+ ("volume", showableToBytestring_ (view [lens| volume |] oreq)),+ ("price", showableToBytestring_ (view [lens| price |] oreq))]++-------------------------------------------- OrderIDRec type ---------------------------------------++data OrderIDRec_ = OrderIDRec_+ { orderIDResponse'order_id :: OrderID+ }++$(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"}+ ''OrderIDRec_)++instance BitXAesRecordConvert OrderID OrderIDRec_ where+ aesToRec (OrderIDRec_ orderIDResponse''order_id) =+ orderIDResponse''order_id++instance POSTEncodeable OrderID where+ postEncode oid =+ [("order_id", Txt.encodeUtf8 oid)]++----------------------------------------- RequestSuccess type --------------------------------------++data RequestSuccess_ = RequestSuccess_+ { requestSuccess'success :: Bool+ }++$(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"}+ ''RequestSuccess_)++instance BitXAesRecordConvert RequestSuccess RequestSuccess_ where+ aesToRec (RequestSuccess_ requestSuccess''success) =+ requestSuccess''success++------------------------------------- PrivateOrderWithTrades type ----------------------------------++data PrivateOrderWithTrades_ = PrivateOrderWithTrades_+ { privateOrderWithTrades'base :: QuotedDecimal+ , privateOrderWithTrades'counter :: QuotedDecimal+ , 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'order_id :: OrderID+ , privateOrderWithTrades'pair :: CcyPair+ , privateOrderWithTrades'state :: RequestStatus_+ , privateOrderWithTrades'type :: OrderType_+ , privateOrderWithTrades'trades :: [Trade_]+ }++$(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"}+ ''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} |]++-------------------------------------------- Balance type ------------------------------------------++data Balance_ = Balance_+ { balance'account_id :: AccountID+ , balance'asset :: Asset+ , balance'balance :: QuotedDecimal+ , balance'reserved :: QuotedDecimal+ , balance'unconfirmed :: QuotedDecimal+ }++$(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} |]++-------------------------------------------- Balances type -----------------------------------------++data Balances_ = Balances_+ {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++----------------------------------------- FundingAddress type --------------------------------------++data FundingAddress_ = FundingAddress_+ { fundingAdress'asset :: Asset+ , fundingAdress'address :: Text+ , fundingAdress'total_received :: QuotedDecimal+ , fundingAdress'total_unconfirmed :: QuotedDecimal+ }++$(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} |]++--------------------------------------------- Asset type -------------------------------------------++instance POSTEncodeable Asset where+ postEncode asset =+ [("asset", showableToBytestring_ asset)]++-------------------------------------- WithdrawalRequest type --------------------------------------++data WithdrawalRequest_ = WithdrawalRequest_+ { withdrawalRequest'status :: RequestStatus_+ , withdrawalRequest'id :: Text+ }++$(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"}+ ''WithdrawalRequest_)++instance BitXAesRecordConvert WithdrawalRequest WithdrawalRequest_ where+ aesToRec (WithdrawalRequest_ withdrawalRequest''status withdrawalRequest''id) =+ [record| {status = requestStatusParse withdrawalRequest''status,+ id = withdrawalRequest''id} |]++-------------------------------------- WithdrawalRequests type -------------------------------------++data WithdrawalRequests_ = WithdrawalRequests_+ { withdrawalRequests'withdrawals :: [WithdrawalRequest_]+ }++$(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"}+ ''WithdrawalRequests_)++instance BitXAesRecordConvert [WithdrawalRequest] WithdrawalRequests_ where+ aesToRec (WithdrawalRequests_ withdrawalRequests''withdrawals) =+ map aesToRec withdrawalRequests''withdrawals++----------------------------------------- NewWithdrawal type ---------------------------------------++instance POSTEncodeable NewWithdrawal where+ postEncode nwthd =+ [("type", showableToBytestring_ (view [lens| type |] nwthd)),+ ("amount", showableToBytestring_ (view [lens| amount |] nwthd))]++-------------------------------------- BitcoinSendRequest type -------------------------------------++instance POSTEncodeable BitcoinSendRequest where+ postEncode oreq =+ [("amount", showableToBytestring_ (view [lens| amount |] oreq)),+ ("currency", showableToBytestring_ (view [lens| currency |] oreq)),+ ("address", Txt.encodeUtf8 (view [lens| address |] oreq)),+ ("description", Txt.encodeUtf8 . unjustText $ (view [lens| description |] oreq)),+ ("message", Txt.encodeUtf8 . unjustText $ (view [lens| message |] oreq))]+ where+ unjustText (Just a) = a+ unjustText Nothing = ""++----------------------------------------- QuoteRequest type ----------------------------------------++instance POSTEncodeable QuoteRequest where+ postEncode oreq =+ [("type", showableToBytestring_ (view [lens| type |] oreq)),+ ("pair", showableToBytestring_ (view [lens| pair |] oreq)),+ ("base_amount", showableToBytestring_ (view [lens| baseAmount |] oreq))]++------------------------------------------ OrderQuote type -----------------------------------------++data OrderQuote_ = OrderQuote_+ { orderQuote'id :: Text+ , orderQuote'type :: QuoteType+ , orderQuote'pair :: CcyPair+ , orderQuote'base_amount :: QuotedDecimal+ , orderQuote'counter_amount :: QuotedDecimal+ , orderQuote'created_at :: TimestampMS+ , orderQuote'expires_at :: TimestampMS+ , orderQuote'discarded :: Bool+ , orderQuote'exercised :: Bool+ }++$(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"}+ ''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} |]++-------------------------------------------- BitXAuth type -----------------------------------------++data BitXAuth_ = BitXAuth_+ { bitXAuth'api_key_id :: Text+ , bitXAuth'api_key_secret :: Text+ }++$(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"}+ ''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} |]++------------------------------------------ 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'currency :: Asset+ , transaction'description :: Text+ }++$(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"}+ ''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} |]++---------------------------------------- Transactions type -----------------------------------------++data Transactions_ = Transactions_+ { transactions'transactions :: [Transaction_]+ }++$(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"}+ ''Transactions_)++instance BitXAesRecordConvert [Transaction] Transactions_ where+ aesToRec (Transactions_ transactions''transactions) =+ map aesToRec transactions''transactions+++data PendingTransactions_ = PendingTransactions_+ { transactions'pending :: [Transaction_]+ }++$(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"}+ ''PendingTransactions_)++instance BitXAesRecordConvert PendingTransactions__ PendingTransactions_ where+ aesToRec (PendingTransactions_ transactions''pending) =+ [record| {transactions = map aesToRec transactions''pending}|]++type PendingTransactions__ =+ [record|+ {transactions :: [Transaction]}|]++pendingTransactionsToTransactions :: PendingTransactions__ -> [Transaction]+pendingTransactionsToTransactions pts = (view [lens| transactions |] pts)+
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}