diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,5 @@ +[![Build Status](https://travis-ci.org/tebello-thejane/bitx-haskell.svg?branch=master)](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.** diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/bitx-bitcoin.cabal b/bitx-bitcoin.cabal new file mode 100644 --- /dev/null +++ b/bitx-bitcoin.cabal @@ -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: . + . + 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 + +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 diff --git a/src/Network/Bitcoin/BitX.hs b/src/Network/Bitcoin/BitX.hs new file mode 100644 --- /dev/null +++ b/src/Network/Bitcoin/BitX.hs @@ -0,0 +1,36 @@ +{-# OPTIONS_HADDOCK prune #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Network.Bitcoin.BitX +-- Copyright : No Rights Reserved +-- License : Public Domain +-- +-- Maintainer : Tebello Thejane +-- 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 diff --git a/src/Network/Bitcoin/BitX/Internal.hs b/src/Network/Bitcoin/BitX/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Network/Bitcoin/BitX/Internal.hs @@ -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 + diff --git a/src/Network/Bitcoin/BitX/Private.hs b/src/Network/Bitcoin/BitX/Private.hs new file mode 100644 --- /dev/null +++ b/src/Network/Bitcoin/BitX/Private.hs @@ -0,0 +1,246 @@ +{-# LANGUAGE OverloadedStrings #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Network.Bitcoin.BitX.Private +-- Copyright : No Rights Reserved +-- License : Public Domain +-- +-- Maintainer : Tebello Thejane +-- 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 +-- ), 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 diff --git a/src/Network/Bitcoin/BitX/Private/Auth.hs b/src/Network/Bitcoin/BitX/Private/Auth.hs new file mode 100644 --- /dev/null +++ b/src/Network/Bitcoin/BitX/Private/Auth.hs @@ -0,0 +1,73 @@ +{-# 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/Quote.hs b/src/Network/Bitcoin/BitX/Private/Quote.hs new file mode 100644 --- /dev/null +++ b/src/Network/Bitcoin/BitX/Private/Quote.hs @@ -0,0 +1,98 @@ +{-# LANGUAGE OverloadedStrings #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Network.Bitcoin.BitX.Private.Quote +-- Copyright : No Rights Reserved +-- License : Public Domain +-- +-- Maintainer : Tebello Thejane +-- 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 + diff --git a/src/Network/Bitcoin/BitX/Public.hs b/src/Network/Bitcoin/BitX/Public.hs new file mode 100644 --- /dev/null +++ b/src/Network/Bitcoin/BitX/Public.hs @@ -0,0 +1,65 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Network.Bitcoin.BitX.Public +-- Copyright : No Rights Reserved +-- License : Public Domain +-- +-- Maintainer : Tebello Thejane +-- 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 + diff --git a/src/Network/Bitcoin/BitX/Response.hs b/src/Network/Bitcoin/BitX/Response.hs new file mode 100644 --- /dev/null +++ b/src/Network/Bitcoin/BitX/Response.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE StandaloneDeriving #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Network.Bitcoin.BitX.Response +-- Copyright : No Rights Reserved +-- License : Public Domain +-- +-- Maintainer : Tebello Thejane +-- 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) diff --git a/src/Network/Bitcoin/BitX/Types.hs b/src/Network/Bitcoin/BitX/Types.hs new file mode 100644 --- /dev/null +++ b/src/Network/Bitcoin/BitX/Types.hs @@ -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 +-- 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 +-- +----------------------------------------------------------------------------- + +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 diff --git a/src/Network/Bitcoin/BitX/Types/Internal.hs b/src/Network/Bitcoin/BitX/Types/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Network/Bitcoin/BitX/Types/Internal.hs @@ -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) + diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}