diff --git a/CHANGES b/CHANGES --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,7 @@ +v0.3.0.0 +* Replaced Volkov records with (micro)lenses. BREAKING CHANGE. +* Implemented a (naive) mechanism to work around nginx rate limiting. + v0.2.0.0 * Replaced Decimal with Scientific. BREAKING CHANGE. * Divided much of the Private module into smaller sub-modules. BREAKING CHANGE. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -2,16 +2,17 @@ [![Hackage](https://budueba.com/hackage/bitx-bitcoin)](https://hackage.haskell.org/package/bitx-bitcoin) [![CC0 Public Domain](http://b.repl.ca/v1/CC0-Public_Domain-brightgreen.png)](http://creativecommons.org/publicdomain/zero/1.0/) -(Hopefully useful) Haskell bindings to the BitX bitcoin exchange's API. - -As a minimal example, to get the current selling price (in South African Rand) of bitcoin on the BitX exchange, do the following: +(Hopefully useful) Haskell bindings to the [BitX](https://bitx.co/) bitcoin exchange's [API](https://bitx.co/api). + +As a minimal example, to get the current selling price (in South African Rand) of bitcoin on the +BitX exchange, do the following: ```haskell -{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE DataKinds #-} -import Record.Lens (view) -import Record (lens) +import Control.Lens ((^.)) import Network.Bitcoin.BitX (BitXAPIResponse(..), getTicker, CcyPair(..)) +import qualified Network.Bitcoin.BitX as BitX import Data.Text (unpack) import Network.HTTP.Types.Status (Status(..)) import Network.HTTP.Conduit (responseStatus) @@ -20,15 +21,20 @@ main = do bitXResponse <- getTicker XBTZAR case bitXResponse of - ValidResponse tic -> print (view [lens| ask |] tic) + ValidResponse tic -> print (tic ^. BitX.ask) ErrorResponse err -> - error $ "BitX error received: \"" ++ (unpack (view [lens| error |] err)) ++ "\"" + error $ "BitX error received: \"" ++ unpack (err ^. BitX.error) ++ "\"" ExceptionResponse ex -> - error $ "Exception was thrown: \"" ++ (unpack ex) ++ "\"" + error $ "Exception was thrown: \"" ++ unpack ex ++ "\"" UnparseableResponse resp -> error $ "Bad HTTP response; HTTP status code was: \"" ++ (show . statusCode . responseStatus $ resp) ++ "\"" ``` -Note that the code snippet above depends on [http-types](https://hackage.haskell.org/package/http-types), [http-conduit](https://hackage.haskell.org/package/http-conduit), [record](https://hackage.haskell.org/package/record), and finally **bitx-bitcoin**. +Note that the code snippet above depends on [http-types](https://hackage.haskell.org/package/http-types), +[http-conduit](https://hackage.haskell.org/package/http-conduit), [lens](https://hackage.haskell.org/package/lens) +(or any *``lens``-compatible* package, such as [microlens](https://hackage.haskell.org/package/microlens)), +and finally **bitx-bitcoin**. -Note that this library **will not** build on Windows currently, due to networking dependencies which have no Windows support. +This library is known to work on Windows, but if you wish to use it then you will have to do a bit +more work due to the ``Network`` library not building on Windows out of the box. See +[this blog post by Neil Mitchell](http://neilmitchell.blogspot.com/2010/12/installing-haskell-network-library-on.html). diff --git a/bitx-bitcoin.cabal b/bitx-bitcoin.cabal --- a/bitx-bitcoin.cabal +++ b/bitx-bitcoin.cabal @@ -1,5 +1,5 @@ name: bitx-bitcoin -version: 0.2.0.2 +version: 0.3.0.0 synopsis: A Haskell library for working with the BitX bitcoin exchange. description: @@ -26,7 +26,7 @@ category: Web, Bitcoin, Finance -build-type: Custom +build-type: Simple extra-source-files: README.md @@ -58,19 +58,18 @@ Network.Bitcoin.BitX.Internal Network.Bitcoin.BitX.Types.Internal - -- LANGUAGE extensions used by modules in this package. - -- other-extensions: - build-depends: base >=4.5 && <5, aeson >= 0.8.0.0, - record >= 0.3.1.1 && <0.4.0.0, text, time, http-conduit >= 2.0.0, bytestring >= 0.10.0.0, network >= 2.0, split >= 0.2.0.0, - scientific + scientific, + microlens, + microlens-th, + http-types default-language: Haskell2010 hs-source-dirs: src @@ -99,13 +98,14 @@ bitx-bitcoin, hspec == 2.*, aeson, - record == 0.3.*, bytestring, - time + time, + microlens other-modules: Network.Bitcoin.BitX.Spec.Common Network.Bitcoin.BitX.Spec.Specs.AesonRecordSpec Network.Bitcoin.BitX.Spec.Specs.NetSpec Network.Bitcoin.BitX.Spec.Specs.PostSpec Network.Bitcoin.BitX.Spec.Specs.JsonSpec + Network.Bitcoin.BitX.Spec.Specs.LensSpec diff --git a/src/Network/Bitcoin/BitX/Internal.hs b/src/Network/Bitcoin/BitX/Internal.hs --- a/src/Network/Bitcoin/BitX/Internal.hs +++ b/src/Network/Bitcoin/BitX/Internal.hs @@ -6,27 +6,28 @@ simpleBitXGet_, simpleBitXPOSTAuth_, simpleBitXMETHAuth_, - consumeResponseBody_, bitXAPIPrefix ) where import Network.Bitcoin.BitX.Types +import qualified Network.Bitcoin.BitX.Types as Types import Network.Bitcoin.BitX.Types.Internal import qualified Network.HTTP.Conduit as NetCon +import Network.HTTP.Types (status503) import Network.HTTP.Conduit (Response(..), Request(..)) -import Control.Exception (try, SomeException) +import Control.Exception (try) 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 import Control.Applicative ((<|>)) +import Lens.Micro ((^.)) +import Control.Concurrent (threadDelay) #if MIN_VERSION_base(4,8,0) -- <$> is in base since 4.8 due to the AMP #else @@ -39,63 +40,66 @@ bitXAPIRoot :: String bitXAPIRoot = bitXAPIPrefix ++ "1/" +globalManager :: IO NetCon.Manager +globalManager = NetCon.newManager NetCon.tlsManagerSettings + +authConnect :: BitXAuth -> Request -> IO (Either NetCon.HttpException (Response BL.ByteString)) +authConnect auth req = do + manager <- globalManager + try . (flip NetCon.httpLbs) manager . NetCon.applyBasicAuth userID userSecret $ req + where + userID = Txt.encodeUtf8 $ (auth ^. Types.id) + userSecret = Txt.encodeUtf8 $ (auth ^. Types.secret) + simpleBitXGetAuth_ :: BitXAesRecordConvert rec aes => BitXAuth -> String -> IO (BitXAPIResponse rec) simpleBitXGetAuth_ auth verb = withSocketsDo $ do - response <- try . NetCon.withManager . NetCon.httpLbs . NetCon.applyBasicAuth - userID - userSecret - . fromJust . NetCon.parseUrl $ (bitXAPIRoot ++ verb) - :: IO (Either SomeException (Response BL.ByteString)) - return $ consumeResponseBody_ response - where - userID = Txt.encodeUtf8 $ (view [lens| id |] auth) - userSecret = Txt.encodeUtf8 $ (view [lens| secret |] auth) + rateLimit + (authConnect auth + . fromJust . NetCon.parseUrl $ (bitXAPIRoot ++ verb)) + consumeResponseIO simpleBitXPOSTAuth_ :: (BitXAesRecordConvert rec aes, POSTEncodeable inprec) => BitXAuth -> inprec -> String -> IO (BitXAPIResponse rec) simpleBitXPOSTAuth_ auth encrec verb = withSocketsDo $ do - 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)) - return $ consumeResponseBody_ response - where - userID = Txt.encodeUtf8 $ (view [lens| id |] auth) - userSecret = Txt.encodeUtf8 $ (view [lens| secret |] auth) + rateLimit + (authConnect auth + . NetCon.urlEncodedBody (postEncode encrec) + . fromJust . NetCon.parseUrl $ (bitXAPIRoot ++ verb)) + consumeResponseIO simpleBitXMETHAuth_ :: BitXAesRecordConvert rec aes => BitXAuth -> BS.ByteString -> String -> IO (BitXAPIResponse rec) simpleBitXMETHAuth_ auth meth verb = withSocketsDo $ do - 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)) - return $ consumeResponseBody_ response - where - userID = Txt.encodeUtf8 $ (view [lens| id |] auth) - userSecret = Txt.encodeUtf8 $ (view [lens| secret |] auth) + rateLimit + (authConnect auth (fromJust (NetCon.parseUrl $ (bitXAPIRoot ++ verb))) { method = meth }) + consumeResponseIO 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)) - return $ consumeResponse resp + manager <- globalManager + rateLimit + (try . (flip NetCon.httpLbs) manager . fromJust . NetCon.parseUrl $ (bitXAPIRoot ++ verb)) + consumeResponseIO -consumeResponse :: BitXAesRecordConvert rec aes => Either SomeException (NetCon.Response BL.ByteString) - -> BitXAPIResponse rec -consumeResponse resp = - case resp of - Left ex -> ExceptionResponse . Txt.pack . show $ ex - Right k -> bitXErrorOrPayload k +rateLimit :: IO (Either NetCon.HttpException c) -> (Either NetCon.HttpException c -> IO d) -> IO d +rateLimit act1 act2 = go 500000 + where + go del = do + resp <- act1 + if isRateLimited resp then + if del > maxLimit + then act2 resp + else do + threadDelay del + go (incDelay del) + else act2 resp + maxLimit = (30 * 1000 * 1000) -- 30 seconds probably means something else is wrong... + incDelay = round . (* (1.5 :: Double)) . fromIntegral -consumeResponseBody_ :: BitXAesRecordConvert rec aes => Either SomeException (NetCon.Response BL.ByteString) - -> BitXAPIResponse rec -consumeResponseBody_ resp = - case resp of +consumeResponseIO :: BitXAesRecordConvert rec aes => Either NetCon.HttpException (NetCon.Response BL.ByteString) + -> IO (BitXAPIResponse rec) +consumeResponseIO resp = + return $ case resp of Left ex -> ExceptionResponse . Txt.pack . show $ ex Right k -> bitXErrorOrPayload k @@ -106,3 +110,7 @@ <|> Just (UnparseableResponse resp) where body = NetCon.responseBody resp + +isRateLimited :: Either NetCon.HttpException a -> Bool +isRateLimited (Left (NetCon.StatusCodeException st _ _)) = st == status503 +isRateLimited _ = False diff --git a/src/Network/Bitcoin/BitX/Private.hs b/src/Network/Bitcoin/BitX/Private.hs --- a/src/Network/Bitcoin/BitX/Private.hs +++ b/src/Network/Bitcoin/BitX/Private.hs @@ -14,10 +14,19 @@ -- -- 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). +-- ), and will return a 'BitXAPIResponse'.. -- +-- It would probably be best to create the 'BitXAuth' record using the constructor 'mkBitXAuth' and +-- lens setters: +-- +-- @ +-- let auth = mkBitXAuth +-- '&' BitX.id '.~' "dude" +-- & BitX.secret .~ "mySecret" +-- let resp = BitX.getBalances auth +-- ... +-- @ +-- -- =Permissions -- -- Each API key is granted a set of permissions when it is created. The key can only be used to call @@ -102,9 +111,9 @@ -} getFundingAddress :: BitXAuth -> Asset -> Maybe String -> IO (BitXAPIResponse FundingAddress) -getFundingAddress auth asset addr = simpleBitXGetAuth_ auth url +getFundingAddress auth fasset addr = simpleBitXGetAuth_ auth url where - url = "funding_address?asset=" ++ show asset ++ case addr of + url = "funding_address?asset=" ++ show fasset ++ case addr of Nothing -> "" Just ad -> "&address=" ++ ad @@ -116,7 +125,7 @@ -} newFundingAddress :: BitXAuth -> Asset -> IO (BitXAPIResponse FundingAddress) -newFundingAddress auth asset = simpleBitXPOSTAuth_ auth asset "funding_address" +newFundingAddress auth fasset = simpleBitXPOSTAuth_ auth fasset "funding_address" {- | Send Bitcoin from your account to a Bitcoin address or email address. diff --git a/src/Network/Bitcoin/BitX/Private/Order.hs b/src/Network/Bitcoin/BitX/Private/Order.hs --- a/src/Network/Bitcoin/BitX/Private/Order.hs +++ b/src/Network/Bitcoin/BitX/Private/Order.hs @@ -46,9 +46,9 @@ -} getAllOrders :: BitXAuth -> Maybe CcyPair -> Maybe RequestStatus -> IO (BitXAPIResponse [PrivateOrder]) -getAllOrders auth pair status = simpleBitXGetAuth_ auth url +getAllOrders auth cpair status = simpleBitXGetAuth_ auth url where - url = "listorders" ++ case (pair, status) of + url = "listorders" ++ case (cpair, status) of (Nothing, Nothing) -> "" (Just pr, Nothing) -> "?pair=" ++ show pr (Nothing, Just st) -> "?state=" ++ show st diff --git a/src/Network/Bitcoin/BitX/Private/Withdrawal.hs b/src/Network/Bitcoin/BitX/Private/Withdrawal.hs --- a/src/Network/Bitcoin/BitX/Private/Withdrawal.hs +++ b/src/Network/Bitcoin/BitX/Private/Withdrawal.hs @@ -44,13 +44,13 @@ newWithdrawalRequest :: BitXAuth -> NewWithdrawal -> IO (BitXAPIResponse WithdrawalRequest) newWithdrawalRequest auth nwithd = simpleBitXPOSTAuth_ auth nwithd "withdrawals" -{- | Get the status of a withdrawal request +{- | Get the status of a withdrawal request by ID Returns the status of a particular withdrawal request. @Perm_R_Withdrawals@ permission required.-} -getWithdrawalRequest :: BitXAuth -> Text -- ^ The withdrawal ID +getWithdrawalRequest :: BitXAuth -> Text -> IO (BitXAPIResponse WithdrawalRequest) getWithdrawalRequest auth wthid = simpleBitXGetAuth_ auth $ "withdrawals/" ++ Txt.unpack wthid diff --git a/src/Network/Bitcoin/BitX/Public.hs b/src/Network/Bitcoin/BitX/Public.hs --- a/src/Network/Bitcoin/BitX/Public.hs +++ b/src/Network/Bitcoin/BitX/Public.hs @@ -13,27 +13,26 @@ -- As a small example, to get the current selling price of bitcoin on the BitX exchange, do the following: -- -- @ ---{-\# LANGUAGE QuasiQuotes \#-} --- ---import Record.Lens (view) ---import Record (lens) ---import Network.Bitcoin.BitX (BitXAPIResponse(..), getTicker, CcyPair(..)) ---import Data.Text (unpack) ---import Network.HTTP.Types.Status (Status(..)) ---import Network.HTTP.Conduit (responseStatus) --- ---main :: IO () ---main = do --- bitXResponse <- getTicker XBTZAR --- case bitXResponse of --- ValidResponse tic -> print (view [lens| ask |] tic) --- ErrorResponse err -> --- error $ "BitX error received: \"" ++ (unpack (view [lens| error |] err)) ++ "\"" --- ExceptionResponse ex -> --- error $ "Exception was thrown: \"" ++ (unpack ex) ++ "\"" --- UnparseableResponse resp -> --- error $ "Bad HTTP response; HTTP status code was: \"" --- ++ (show . statusCode . responseStatus $ resp) ++ "\"" +--{-\# LANGUAGE DataKinds \#-} +-- +--import Control.Lens ((^.)) +--import Network.Bitcoin.BitX (BitXAPIResponse(..), getTicker, CcyPair(..)) +--import qualified Network.Bitcoin.BitX as BitX +--import Data.Text (unpack) +--import Network.HTTP.Types.Status (Status(..)) +--import Network.HTTP.Conduit (responseStatus) +-- +--main :: IO () +--main = do +-- bitXResponse <- getTicker XBTZAR +-- case bitXResponse of +-- ValidResponse tic -> print (tic ^. BitX.ask) +-- ErrorResponse err -> +-- error $ "BitX error received: \\"" ++ unpack (err ^. BitX.error) ++ "\\"" +-- ExceptionResponse ex -> +-- error $ "Exception was thrown: \\"" ++ unpack ex ++ "\\"" +-- UnparseableResponse resp -> +-- error $ "Bad HTTP response; HTTP status code was: \\"" ++ (show . statusCode . responseStatus $ resp) ++ "\\"" -- @ -- ----------------------------------------------------------------------------- diff --git a/src/Network/Bitcoin/BitX/Response.hs b/src/Network/Bitcoin/BitX/Response.hs --- a/src/Network/Bitcoin/BitX/Response.hs +++ b/src/Network/Bitcoin/BitX/Response.hs @@ -19,7 +19,6 @@ BitXAPIResponse(..) ) where - import Network.HTTP.Conduit (Response(..)) import Data.ByteString.Lazy (ByteString) import Network.Bitcoin.BitX.Types diff --git a/src/Network/Bitcoin/BitX/Types.hs b/src/Network/Bitcoin/BitX/Types.hs --- a/src/Network/Bitcoin/BitX/Types.hs +++ b/src/Network/Bitcoin/BitX/Types.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE DeriveGeneric, DefaultSignatures, QuasiQuotes, OverloadedStrings, DataKinds, - MultiParamTypeClasses #-} +{-# LANGUAGE DeriveGeneric, QuasiQuotes, OverloadedStrings, DataKinds, + MultiParamTypeClasses, TemplateHaskell, FunctionalDependencies, FlexibleInstances #-} ----------------------------------------------------------------------------- -- | @@ -13,124 +13,154 @@ -- -- 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 `BitXAuth` 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, + Ticker(..), CcyPair(..), - Orderbook, - Order, + Orderbook(..), + Order(..), Bid, Ask, - Trade, - BitXAuth, - PrivateOrder, + Trade(..), + BitXAuth(..), + PrivateOrder(..), OrderID, OrderType(..), RequestStatus(..), - OrderRequest, + OrderRequest(..), RequestSuccess, - BitXError, - PrivateOrderWithTrades, + BitXError(..), + PrivateOrderWithTrades(..), AccountID, Asset(..), - Balance, - FundingAddress, - WithdrawalRequest, - NewWithdrawal, + Balance(..), + FundingAddress(..), + WithdrawalRequest(..), + NewWithdrawal(..), WithdrawalType(..), - BitcoinSendRequest, - QuoteRequest, - OrderQuote, + BitcoinSendRequest(..), + QuoteRequest(..), + OrderQuote(..), QuoteType(..), BitXClientAuth, - Transaction, - Account + Transaction(..), + Account(..), + +-- | Convenient constructors for records which serve as input parameters to functions. These are not +-- completely safe (since you can forget to set a field and the Haskell compiler won't notice), +-- but they are a bit more convenient than dealing with the raw records directly, as long as +-- you're careful. + mkBitXAuth, + mkAccount, + mkBitcoinSendRequest, + mkOrderRequest, + mkQuoteRequest, + mkNewWithdrawal, + +-- | Lens @Has*@ instances for convenient record accessors and mutators. +-- +-- For a broader view of how these function (and why you can generally ignore them) see the +-- documentation for 'lens''s 'Control.Lens.TH.makeFields'. +-- +-- Essentially, an instance declaration of the form +-- +-- @ +-- instance HasFoo MyRecord Int +-- @ +-- implies that we can pretend that the data type @MyRecord@ has a field called @Foo@ of type @Int@ +-- (although in reality the field would be called @myRecordFoo@ or such), and that there exists a +-- lens called @foo@ which can be used -- among other things -- as a setter and getter on +-- @MyRecord@. + HasError(..), + HasErrorCode(..), + HasTimestamp(..), + HasBid(..), + HasAsk(..), + HasLastTrade(..), + HasRolling24HourVolume(..), + HasPair(..), + HasVolume(..), + HasPrice(..), + HasBids(..), + HasAsks(..), + HasSecret(..), + HasId(..), + HasBase(..), + HasCounter(..), + HasCreationTimestamp(..), + HasExpirationTimestamp(..), + HasFeeBase(..), + HasFeeCounter(..), + HasLimitPrice(..), + HasState(..), + HasOrderType(..), + HasLimitVolume(..), + HasTrades(..), + HasRowIndex(..), + HasBalance(..), + HasAvailable(..), + HasBalanceDelta(..), + HasAvailableDelta(..), + HasCurrency(..), + HasDescription(..), + HasAsset(..), + HasReserved(..), + HasUnconfirmed(..), + HasAddress(..), + HasTotalReceived(..), + HasTotalUnconfirmed(..), + HasAmount(..), + HasWithdrawalType(..), + HasMessage(..), + HasQuoteType(..), + HasBaseAmount(..), + HasCounterAmount(..), + HasCreatedAt(..), + HasExpiresAt(..), + HasDiscarded(..), + HasExercised(..), + HasName(..) ) where import Data.Aeson (FromJSON(..)) import Data.Text (Text) import Data.Time.Clock -import Record import GHC.Generics (Generic) import Data.Scientific (Scientific) +import Lens.Micro.TH (makeFields) +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) + +type AccountID = Text + -- | 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 :: 'Scientific', --- timestamp :: 'UTCTime', --- bid :: 'Scientific', --- rolling24HourVolume :: 'Scientific', --- lastTrade :: 'Scientific', --- pair :: 'CcyPair'} |] --- @ +data BitXError = BitXError { + bitXErrorError :: Text, + bitXErrorErrorCode :: Text + } deriving (Eq, Show) -type Ticker = - [record| - {ask :: Scientific, - timestamp :: UTCTime, - bid :: Scientific, - rolling24HourVolume :: Scientific, - lastTrade :: Scientific, - pair :: CcyPair} |] +makeFields ''BitXError -- | A currency pair data CcyPair = @@ -146,6 +176,20 @@ | NGNXBT -- ^ Nigerian Naira vs. Bitcoin deriving (Show, Generic, Eq) +-- | 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.@ +data Ticker = Ticker { + tickerTimestamp :: UTCTime, + tickerBid :: Scientific, + tickerAsk :: Scientific, + tickerLastTrade :: Scientific, + tickerRolling24HourVolume :: Scientific, + tickerPair :: CcyPair + } deriving (Eq, Show) + +makeFields ''Ticker + -- | A trade-able asset. Essentially, a currency. data Asset = ZAR -- ^ South African Rand @@ -156,36 +200,26 @@ | NGN -- ^ Nigerian Naira 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']} |] --- @ +-- | 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) -type Orderbook = - [record| - {timestamp :: UTCTime, - bids :: [Bid], - asks :: [Ask]} |] +data QuoteType = BUY | SELL deriving (Show, Generic, Eq) +type RequestSuccess = Bool + -- | A single placed order in the orderbook --- --- @ ---type Order = --- [record| --- {volume :: 'Scientific', --- price :: 'Scientific'} |] --- @ +data Order = Order { + orderVolume :: Scientific, + orderPrice :: Scientific + } deriving (Eq, Show) -type Order = - [record| - {volume :: Scientific, - price :: Scientific} |] +makeFields ''Order -- | Convenient type alias for a bid order type Bid = Order @@ -193,308 +227,188 @@ -- | Convenient type alias for an ask order type Ask = Order -type Trade = - [record| - {volume :: Scientific, - timestamp :: UTCTime, - price :: Scientific} |] +-- | The current state of the publically accessible orderbook. +-- Bid orders are requests to buy, ask orders are requests to sell. +data Orderbook = Orderbook { + orderbookTimestamp :: UTCTime, + orderbookBids :: [Bid], + orderbookAsks :: [Ask] + } deriving (Eq, Show) +makeFields ''Orderbook + +data Trade = Trade { + tradeTimestamp :: UTCTime, + tradeVolume :: Scientific, + tradePrice :: Scientific + } deriving (Eq, Show) + +makeFields ''Trade + -- | 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} |] +data BitXAuth = BitXAuth + {bitXAuthId :: Text, + bitXAuthSecret :: Text} deriving (Eq, Show) +-- |@mkBitXAuth = BitXAuth "" ""@ +mkBitXAuth :: BitXAuth +mkBitXAuth = BitXAuth "" "" + +makeFields ''BitXAuth + 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 :: 'Scientific', --- counter :: 'Scientific', --- creationTimestamp :: 'UTCTime', --- expirationTimestamp :: 'UTCTime', --- feeBase :: 'Scientific', --- feeCounter :: 'Scientific', --- limitPrice :: 'Scientific', --- limitVolume :: 'Scientific', --- id :: 'OrderID', --- pair :: 'CcyPair', --- state :: 'RequestStatus', --- type :: 'OrderType' } |] --- @ -type PrivateOrder = - [record| - {base :: Scientific, - counter :: Scientific, - creationTimestamp :: UTCTime, - expirationTimestamp :: UTCTime, - feeBase :: Scientific, - feeCounter :: Scientific, - limitPrice :: Scientific, - limitVolume :: Scientific, - id :: OrderID, - pair :: CcyPair, - state :: RequestStatus, - type :: OrderType } |] +data PrivateOrder = PrivateOrder + {privateOrderBase :: Scientific, + privateOrderCounter :: Scientific, + privateOrderCreationTimestamp :: UTCTime, + privateOrderExpirationTimestamp :: UTCTime, + privateOrderFeeBase :: Scientific, + privateOrderFeeCounter :: Scientific, + privateOrderLimitPrice :: Scientific, + privateOrderLimitVolume :: Scientific, + privateOrderId :: OrderID, + privateOrderPair :: CcyPair, + privateOrderState :: RequestStatus, + privateOrderOrderType :: OrderType } deriving (Eq, Show) +makeFields ''PrivateOrder + -- | 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 :: 'Scientific', --- counter :: 'Scientific', --- creationTimestamp :: 'UTCTime', --- expirationTimestamp :: 'UTCTime', --- feeBase :: 'Scientific', --- feeCounter :: 'Scientific', --- limitPrice :: 'Scientific', --- limitVolume :: 'Scientific', --- id :: 'OrderID', --- pair :: 'CcyPair', --- state :: 'RequestStatus', --- type :: 'OrderType', --- trades :: ['Trade'] } |] --- @ -type PrivateOrderWithTrades = - [record| - {base :: Scientific, - counter :: Scientific, - creationTimestamp :: UTCTime, - expirationTimestamp :: UTCTime, - feeBase :: Scientific, - feeCounter :: Scientific, - limitPrice :: Scientific, - limitVolume :: Scientific, - 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 :: 'Scientific', --- available :: 'Scientific', --- balanceDelta :: 'Scientific', --- availableDelta :: 'Scientific', --- currency :: 'Asset', --- description :: 'Text'}|] --- @ -type Transaction = - [record| - {rowIndex :: Int, - timestamp :: UTCTime, - balance :: Scientific, - available :: Scientific, - balanceDelta :: Scientific, - availableDelta :: Scientific, - currency :: Asset, - description :: Text}|] +data PrivateOrderWithTrades = PrivateOrderWithTrades + {privateOrderWithTradesBase :: Scientific, + privateOrderWithTradesCounter :: Scientific, + privateOrderWithTradesCreationTimestamp :: UTCTime, + privateOrderWithTradesExpirationTimestamp :: UTCTime, + privateOrderWithTradesFeeBase :: Scientific, + privateOrderWithTradesFeeCounter :: Scientific, + privateOrderWithTradesLimitPrice :: Scientific, + privateOrderWithTradesLimitVolume :: Scientific, + privateOrderWithTradesId :: OrderID, + privateOrderWithTradesPair :: CcyPair, + privateOrderWithTradesState :: RequestStatus, + privateOrderWithTradesOrderType :: OrderType, + privateOrderWithTradesTrades :: [Trade] } deriving (Eq, Show) -type OrderID = Text +makeFields ''PrivateOrderWithTrades --- | The type of a placed order. -data OrderType = - ASK -- ^ A request to sell - | BID -- ^ A request to buy - deriving (Show, Generic, Eq) +-- | A transaction on a private user account. +data Transaction = Transaction + {transactionRowIndex :: Int, + transactionTimestamp :: UTCTime, + transactionBalance :: Scientific, + transactionAvailable :: Scientific, + transactionBalanceDelta :: Scientific, + transactionAvailableDelta :: Scientific, + transactionCurrency :: Asset, + transactionDescription :: Text} deriving (Eq, Show) --- | 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) +makeFields ''Transaction -- | A request to place an order. --- --- @ ---type OrderRequest = --- [record| --- {pair :: 'CcyPair', --- type :: 'OrderType', --- volume :: 'Scientific', --- price :: 'Scientific' } |] --- @ -type OrderRequest = - [record| - {pair :: CcyPair, - type :: OrderType, - volume :: Scientific, - price :: Scientific } |] +data OrderRequest = OrderRequest + {orderRequestPair :: CcyPair, + orderRequestOrderType :: OrderType, + orderRequestVolume :: Scientific, + orderRequestPrice :: Scientific } deriving (Eq, Show) -type AccountID = Text +makeFields ''OrderRequest +-- |@mkOrderRequest = OrderRequest ZARXBT BID 0 0@ +mkOrderRequest :: OrderRequest +mkOrderRequest = OrderRequest ZARXBT BID 0 0 + -- | The current balance of a private account. --- --- @ ---type Balance = --- [record| --- {id :: 'AccountID', --- asset :: 'Asset', --- balance :: 'Scientific', --- reserved :: 'Scientific', --- unconfirmed :: 'Scientific' } |] --- @ -type Balance = - [record| - {id :: AccountID, - asset :: Asset, - balance :: Scientific, - reserved :: Scientific, - unconfirmed :: Scientific } |] +data Balance = Balance + {balanceId :: AccountID, + balanceAsset :: Asset, + balanceBalance :: Scientific, + balanceReserved :: Scientific, + balanceUnconfirmed :: Scientific } deriving (Eq, Show) +makeFields ''Balance + -- | A registered address for an acocunt. --- --- @ ---type FundingAddress = --- [record| --- {asset :: 'Asset', --- address :: 'Text', --- totalReceived :: 'Scientific', --- totalUnconfirmed :: 'Scientific'} |] --- @ -type FundingAddress = - [record| - {asset :: Asset, - address :: Text, - totalReceived :: Scientific, - totalUnconfirmed :: Scientific} |] +data FundingAddress = FundingAddress + {fundingAddressAsset :: Asset, + fundingAddressAddress :: Text, + fundingAddressTotalReceived :: Scientific, + fundingAddressTotalUnconfirmed :: Scientific} deriving (Eq, Show) +makeFields ''FundingAddress + -- | The state of a request to withdraw from an account. --- --- @ ---type WithdrawalRequest = --- [record| --- {status :: 'RequestStatus', --- id :: 'Text' } |] --- @ -type WithdrawalRequest = - [record| - {status :: RequestStatus, - id :: Text } |] +data WithdrawalRequest = WithdrawalRequest + {withdrawalRequestStatus :: RequestStatus, + withdrawalRequestId :: Text } deriving (Eq, Show) +makeFields ''WithdrawalRequest + -- | A request to withdraw from an account. --- --- @ ---type NewWithdrawal = --- [record| --- {type :: 'WithdrawalType', --- amount :: 'Scientific' } |] --- @ -type NewWithdrawal = - [record| - {type :: WithdrawalType, - amount :: Scientific } |] +data NewWithdrawal = NewWithdrawal + {newWithdrawalWithdrawalType :: WithdrawalType, + newWithdrawalAmount :: Scientific } deriving (Eq, Show) +makeFields ''NewWithdrawal + +-- |@mkNewWithdrawal = NewWithdrawal ZAR_EFT 0@ +mkNewWithdrawal :: NewWithdrawal +mkNewWithdrawal = NewWithdrawal ZAR_EFT 0 + -- | A request to send bitcoin to a bitcoin address or email address. --- --- @ ---type BitcoinSendRequest = --- [record| --- {amount :: 'Scientific', --- currency :: 'Asset', --- address :: 'Text', --- description :: 'Maybe' 'Text', --- message :: 'Maybe' 'Text'} |] --- @ -type BitcoinSendRequest = - [record| - {amount :: Scientific, - currency :: Asset, - address :: Text, - description :: Maybe Text, - message :: Maybe Text} |] +data BitcoinSendRequest = BitcoinSendRequest + {bitcoinSendRequestAmount :: Scientific, + bitcoinSendRequestCurrency :: Asset, + bitcoinSendRequestAddress :: Text, + bitcoinSendRequestDescription :: Maybe Text, + bitcoinSendRequestMessage :: Maybe Text} deriving (Eq, Show) +makeFields ''BitcoinSendRequest + +-- |@mkBitcoinSendRequest = BitcoinSendRequest 0 ZAR "" Nothing Nothing@ +mkBitcoinSendRequest :: BitcoinSendRequest +mkBitcoinSendRequest = BitcoinSendRequest 0 ZAR "" Nothing Nothing + -- | A request to lock in a quote. --- --- @ ---type QuoteRequest = --- [record| --- {type :: 'QuoteType', --- pair :: 'CcyPair', --- baseAmount :: 'Scientific'} |] --- @ -type QuoteRequest = - [record| - {type :: QuoteType, - pair :: CcyPair, - baseAmount :: Scientific} |] +data QuoteRequest = QuoteRequest + {quoteRequestQuoteType :: QuoteType, + quoteRequestPair :: CcyPair, + quoteRequestBaseAmount :: Scientific} deriving (Eq, Show) --- | A temporarily locked in quote. --- --- @ ---type OrderQuote = --- [record| --- {id :: 'Text', --- type :: 'QuoteType', --- pair :: 'CcyPair', --- baseAmount :: 'Scientific', --- counterAmount :: 'Scientific', --- createdAt :: 'UTCTime', --- expiresAt :: 'UTCTime', --- discarded :: 'Bool', --- exercised :: 'Bool'} |] --- @ -type OrderQuote = - [record| - {id :: Text, - type :: QuoteType, - pair :: CcyPair, - baseAmount :: Scientific, - counterAmount :: Scientific, - createdAt :: UTCTime, - expiresAt :: UTCTime, - discarded :: Bool, - exercised :: Bool} |] +makeFields ''QuoteRequest --- | A registered account. --- --- @ ---type Account = --- [record| --- {id :: Text, --- name :: Text, --- currency :: Asset} |] --- @ -type Account = - [record| - {id :: Text, - name :: Text, - currency :: Asset} |] +-- |@mkQuoteRequest = QuoteRequest BUY ZARXBT 0@ +mkQuoteRequest :: QuoteRequest +mkQuoteRequest = QuoteRequest BUY ZARXBT 0 --- | 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) +-- | A temporarily locked-in quote. +data OrderQuote = OrderQuote + {orderQuoteId :: Text, + orderQuoteQuoteType :: QuoteType, + orderQuotePair :: CcyPair, + orderQuoteBaseAmount :: Scientific, + orderQuoteCounterAmount :: Scientific, + orderQuoteCreatedAt :: UTCTime, + orderQuoteExpiresAt :: UTCTime, + orderQuoteDiscarded :: Bool, + orderQuoteExercised :: Bool} -data QuoteType = BUY | SELL deriving (Show, Generic, Eq) +makeFields ''OrderQuote -type RequestSuccess = Bool +-- | A registered account. +data Account = Account + {accountId :: Text, + accountName :: Text, + accountCurrency :: Asset} + +makeFields ''Account + +-- |@mkAccount = Account "" "" ZAR@ +mkAccount :: Account +mkAccount = Account "" "" ZAR instance FromJSON CcyPair diff --git a/src/Network/Bitcoin/BitX/Types/Internal.hs b/src/Network/Bitcoin/BitX/Types/Internal.hs --- a/src/Network/Bitcoin/BitX/Types/Internal.hs +++ b/src/Network/Bitcoin/BitX/Types/Internal.hs @@ -5,14 +5,12 @@ ( BitXAesRecordConvert(..), POSTEncodeable(..), - --showableToBytestring_, Transaction_(..), - pendingTransactionsToTransactions, - PendingTransactions__ + pendingTransactionsToTransactions ) where -import Network.Bitcoin.BitX.Types +import qualified Network.Bitcoin.BitX.Types as Types import Data.Aeson (FromJSON(..), parseJSON, Value(..)) import qualified Data.Aeson.TH as AesTH import qualified Data.Text as Txt @@ -20,15 +18,13 @@ import Data.Text (Text) import Data.Time.Clock (UTCTime) import Data.Time.Clock.POSIX (posixSecondsToUTCTime) -import Record -import Record.Lens (view) +import Lens.Micro ((^.)) #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.Scientific (Scientific) ---import Data.Scientific (Scientific) import Data.ByteString (ByteString) import Data.List.Split (splitOn) #if MIN_VERSION_base(4,7,0) @@ -92,11 +88,11 @@ 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_ -> Types.OrderType +orderTypeParse (OrderType_ "BUY") = Types.BID +orderTypeParse (OrderType_ "BID") = Types.BID +orderTypeParse (OrderType_ "ASK") = Types.ASK +orderTypeParse (OrderType_ "SELL") = Types.ASK orderTypeParse (OrderType_ x ) = error $ "Yet another surprise from the BitX API: unexpected OrderType " ++ Txt.unpack x @@ -107,11 +103,11 @@ 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_ -> Types.RequestStatus +requestStatusParse (RequestStatus_ "PENDING") = Types.PENDING +requestStatusParse (RequestStatus_ "COMPLETE") = Types.COMPLETE +requestStatusParse (RequestStatus_ "COMPLETED") = Types.COMPLETE +requestStatusParse (RequestStatus_ "CANCELLED") = Types.CANCELLED requestStatusParse (RequestStatus_ x ) = error $ "Yet another surprise from the BitX API: unexpected RequestStatus " ++ Txt.unpack x @@ -123,20 +119,20 @@ , ticker'ask :: QuotedScientific , ticker'last_trade :: QuotedScientific , ticker'rolling_24_hour_volume :: QuotedScientific - , ticker'pair :: CcyPair + , ticker'pair :: Types.CcyPair } $(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"} ''Ticker_) -instance BitXAesRecordConvert Ticker Ticker_ where +instance BitXAesRecordConvert Types.Ticker Ticker_ where aesToRec (Ticker_ {..}) = - [record| {timestamp = tsmsToUTCTime ticker'timestamp, - bid = qsToScientific ticker'bid, - ask = qsToScientific ticker'ask, - lastTrade = qsToScientific ticker'last_trade, - rolling24HourVolume = qsToScientific ticker'rolling_24_hour_volume, - pair = ticker'pair} |] + Types.Ticker {tickerTimestamp = tsmsToUTCTime ticker'timestamp, + tickerBid = qsToScientific ticker'bid, + tickerAsk = qsToScientific ticker'ask, + tickerLastTrade = qsToScientific ticker'last_trade, + tickerRolling24HourVolume = qsToScientific ticker'rolling_24_hour_volume, + tickerPair = ticker'pair} --------------------------------------------- Tickers type ----------------------------------------- @@ -147,7 +143,7 @@ $(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"} ''Tickers_) -instance BitXAesRecordConvert [Ticker] Tickers_ where +instance BitXAesRecordConvert [Types.Ticker] Tickers_ where aesToRec (Tickers_ {..}) = map aesToRec tickers'tickers @@ -160,10 +156,9 @@ $(AesTH.deriveJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"} ''BitXError_) -instance BitXAesRecordConvert BitXError BitXError_ where +instance BitXAesRecordConvert Types.BitXError BitXError_ where aesToRec (BitXError_ {..}) = - [record| {error = bitXError'error, - errorCode = bitXError'error_code} |] + Types.BitXError { bitXErrorError = bitXError'error, bitXErrorErrorCode = bitXError'error_code} -------------------------------------------- Order type -------------------------------------------- @@ -174,10 +169,10 @@ $(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"} ''Order_) -instance BitXAesRecordConvert Order Order_ where +instance BitXAesRecordConvert Types.Order Order_ where aesToRec (Order_ {..}) = - [record| {volume = qsToScientific order'volume, - price = qsToScientific order'price} |] + Types.Order {orderVolume = (qsToScientific order'volume), + orderPrice = (qsToScientific order'price)} -------------------------------------------- Orderbook type ---------------------------------------- @@ -193,11 +188,11 @@ $(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"} ''Orderbook_) -instance BitXAesRecordConvert Orderbook Orderbook_ where +instance BitXAesRecordConvert Types.Orderbook Orderbook_ where aesToRec (Orderbook_ {..}) = - [record| {timestamp = tsmsToUTCTime orderbook'timestamp, - bids = map aesToRec orderbook'bids, - asks = map aesToRec orderbook'asks} |] + Types.Orderbook {orderbookTimestamp = (tsmsToUTCTime orderbook'timestamp), + orderbookBids = (map aesToRec orderbook'bids), + orderbookAsks = (map aesToRec orderbook'asks)} -------------------------------------------- Trade type -------------------------------------------- @@ -210,11 +205,11 @@ $(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"} ''Trade_) -instance BitXAesRecordConvert Trade Trade_ where +instance BitXAesRecordConvert Types.Trade Trade_ where aesToRec (Trade_ {..}) = - [record| {volume = qsToScientific trade'volume, - timestamp = tsmsToUTCTime trade'timestamp, - price = qsToScientific trade'price} |] + Types.Trade { tradeTimestamp = (tsmsToUTCTime trade'timestamp), + tradeVolume = (qsToScientific trade'volume), + tradePrice = (qsToScientific trade'price) } ----------------------------------------- PublicTrades type ---------------------------------------- @@ -225,7 +220,7 @@ $(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"} ''PublicTrades_) -instance BitXAesRecordConvert [Trade] PublicTrades_ where +instance BitXAesRecordConvert [Types.Trade] PublicTrades_ where aesToRec (PublicTrades_ {..}) = map aesToRec publicTrades'trades @@ -240,8 +235,8 @@ , privateOrder'fee_counter :: QuotedScientific , privateOrder'limit_price :: QuotedScientific , privateOrder'limit_volume :: QuotedScientific - , privateOrder'order_id :: OrderID - , privateOrder'pair :: CcyPair + , privateOrder'order_id :: Types.OrderID + , privateOrder'pair :: Types.CcyPair , privateOrder'state :: RequestStatus_ , privateOrder'type :: OrderType_ } @@ -249,20 +244,20 @@ $(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"} ''PrivateOrder_) -instance BitXAesRecordConvert PrivateOrder PrivateOrder_ where +instance BitXAesRecordConvert Types.PrivateOrder PrivateOrder_ where aesToRec (PrivateOrder_ {..}) = - [record| {base = qsToScientific privateOrder'base, - counter = qsToScientific privateOrder'counter, - creationTimestamp = tsmsToUTCTime privateOrder'creation_timestamp, - expirationTimestamp = tsmsToUTCTime privateOrder'expiration_timestamp, - feeBase = qsToScientific privateOrder'fee_base, - feeCounter = qsToScientific privateOrder'fee_counter, - limitPrice = qsToScientific privateOrder'limit_price, - limitVolume = qsToScientific privateOrder'limit_volume, - id = privateOrder'order_id, - pair = privateOrder'pair, - state = requestStatusParse privateOrder'state, - type = orderTypeParse privateOrder'type} |] + Types.PrivateOrder {privateOrderBase = qsToScientific privateOrder'base, + privateOrderCounter = qsToScientific privateOrder'counter, + privateOrderCreationTimestamp = tsmsToUTCTime privateOrder'creation_timestamp, + privateOrderExpirationTimestamp = tsmsToUTCTime privateOrder'expiration_timestamp, + privateOrderFeeBase = qsToScientific privateOrder'fee_base, + privateOrderFeeCounter = qsToScientific privateOrder'fee_counter, + privateOrderLimitPrice = qsToScientific privateOrder'limit_price, + privateOrderLimitVolume = qsToScientific privateOrder'limit_volume, + privateOrderId = privateOrder'order_id, + privateOrderPair = privateOrder'pair, + privateOrderState = requestStatusParse privateOrder'state, + privateOrderOrderType = orderTypeParse privateOrder'type} ------------------------------------------ PrivateOrders type -------------------------------------- @@ -273,33 +268,33 @@ $(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"} ''PrivateOrders_) -instance BitXAesRecordConvert [PrivateOrder] PrivateOrders_ where +instance BitXAesRecordConvert [Types.PrivateOrder] PrivateOrders_ where aesToRec (PrivateOrders_ {..}) = map aesToRec privateOrders'orders ------------------------------------------ OrderRequest type --------------------------------------- -instance POSTEncodeable OrderRequest where +instance POSTEncodeable Types.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))] + [("pair", showableToBytestring_ (oreq ^. Types.pair)), + ("type", showableToBytestring_ (oreq ^. Types.orderType)), + ("volume", showableToBytestring_ (oreq ^. Types.volume)), + ("price", showableToBytestring_ (oreq ^. Types.price))] -------------------------------------------- OrderIDRec type --------------------------------------- data OrderIDRec_ = OrderIDRec_ - { orderIDResponse'order_id :: OrderID + { orderIDResponse'order_id :: Types.OrderID } $(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"} ''OrderIDRec_) -instance BitXAesRecordConvert OrderID OrderIDRec_ where +instance BitXAesRecordConvert Types.OrderID OrderIDRec_ where aesToRec (OrderIDRec_ {..}) = orderIDResponse'order_id -instance POSTEncodeable OrderID where +instance POSTEncodeable Types.OrderID where postEncode oid = [("order_id", Txt.encodeUtf8 oid)] @@ -312,7 +307,7 @@ $(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"} ''RequestSuccess_) -instance BitXAesRecordConvert RequestSuccess RequestSuccess_ where +instance BitXAesRecordConvert Types.RequestSuccess RequestSuccess_ where aesToRec (RequestSuccess_ {..}) = requestSuccess'success @@ -327,8 +322,8 @@ , privateOrderWithTrades'fee_counter :: QuotedScientific , privateOrderWithTrades'limit_price :: QuotedScientific , privateOrderWithTrades'limit_volume :: QuotedScientific - , privateOrderWithTrades'order_id :: OrderID - , privateOrderWithTrades'pair :: CcyPair + , privateOrderWithTrades'order_id :: Types.OrderID + , privateOrderWithTrades'pair :: Types.CcyPair , privateOrderWithTrades'state :: RequestStatus_ , privateOrderWithTrades'type :: OrderType_ , privateOrderWithTrades'trades :: [Trade_] @@ -337,27 +332,27 @@ $(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"} ''PrivateOrderWithTrades_) -instance BitXAesRecordConvert PrivateOrderWithTrades PrivateOrderWithTrades_ where +instance BitXAesRecordConvert Types.PrivateOrderWithTrades PrivateOrderWithTrades_ where aesToRec (PrivateOrderWithTrades_ {..}) = - [record| {base = qsToScientific privateOrderWithTrades'base, - counter = qsToScientific privateOrderWithTrades'counter, - creationTimestamp = tsmsToUTCTime privateOrderWithTrades'creation_timestamp, - expirationTimestamp = tsmsToUTCTime privateOrderWithTrades'expiration_timestamp, - feeBase = qsToScientific privateOrderWithTrades'fee_base, - feeCounter = qsToScientific privateOrderWithTrades'fee_counter, - limitPrice = qsToScientific privateOrderWithTrades'limit_price, - limitVolume = qsToScientific privateOrderWithTrades'limit_volume, - id = privateOrderWithTrades'order_id, - pair = privateOrderWithTrades'pair, - state = requestStatusParse privateOrderWithTrades'state, - type = orderTypeParse privateOrderWithTrades'type, - trades = map aesToRec privateOrderWithTrades'trades} |] + Types.PrivateOrderWithTrades {privateOrderWithTradesBase = qsToScientific privateOrderWithTrades'base, + privateOrderWithTradesCounter = qsToScientific privateOrderWithTrades'counter, + privateOrderWithTradesCreationTimestamp = tsmsToUTCTime privateOrderWithTrades'creation_timestamp, + privateOrderWithTradesExpirationTimestamp = tsmsToUTCTime privateOrderWithTrades'expiration_timestamp, + privateOrderWithTradesFeeBase = qsToScientific privateOrderWithTrades'fee_base, + privateOrderWithTradesFeeCounter = qsToScientific privateOrderWithTrades'fee_counter, + privateOrderWithTradesLimitPrice = qsToScientific privateOrderWithTrades'limit_price, + privateOrderWithTradesLimitVolume = qsToScientific privateOrderWithTrades'limit_volume, + privateOrderWithTradesId = privateOrderWithTrades'order_id, + privateOrderWithTradesPair = privateOrderWithTrades'pair, + privateOrderWithTradesState = requestStatusParse privateOrderWithTrades'state, + privateOrderWithTradesOrderType = orderTypeParse privateOrderWithTrades'type, + privateOrderWithTradesTrades = map aesToRec privateOrderWithTrades'trades} -------------------------------------------- Balance type ------------------------------------------ data Balance_ = Balance_ - { balance'account_id :: AccountID - , balance'asset :: Asset + { balance'account_id :: Types.AccountID + , balance'asset :: Types.Asset , balance'balance :: QuotedScientific , balance'reserved :: QuotedScientific , balance'unconfirmed :: QuotedScientific @@ -366,13 +361,13 @@ $(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"} ''Balance_) -instance BitXAesRecordConvert Balance Balance_ where +instance BitXAesRecordConvert Types.Balance Balance_ where aesToRec (Balance_ {..}) = - [record| {id = balance'account_id, - asset = balance'asset, - balance = qsToScientific balance'balance, - reserved = qsToScientific balance'reserved, - unconfirmed = qsToScientific balance'unconfirmed} |] + Types.Balance {balanceId = balance'account_id, + balanceAsset = balance'asset, + balanceBalance = qsToScientific balance'balance, + balanceReserved = qsToScientific balance'reserved, + balanceUnconfirmed = qsToScientific balance'unconfirmed} -------------------------------------------- Balances type ----------------------------------------- @@ -383,14 +378,14 @@ $(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"} ''Balances_) -instance BitXAesRecordConvert [Balance] Balances_ where +instance BitXAesRecordConvert [Types.Balance] Balances_ where aesToRec (Balances_ {..}) = map aesToRec balances'balance ----------------------------------------- FundingAddress type -------------------------------------- data FundingAddress_ = FundingAddress_ - { fundingAdress'asset :: Asset + { fundingAdress'asset :: Types.Asset , fundingAdress'address :: Text , fundingAdress'total_received :: QuotedScientific , fundingAdress'total_unconfirmed :: QuotedScientific @@ -399,16 +394,16 @@ $(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"} ''FundingAddress_) -instance BitXAesRecordConvert FundingAddress FundingAddress_ where +instance BitXAesRecordConvert Types.FundingAddress FundingAddress_ where aesToRec (FundingAddress_ {..}) = - [record| {asset = fundingAdress'asset, - address = fundingAdress'address, - totalReceived = qsToScientific fundingAdress'total_received, - totalUnconfirmed = qsToScientific fundingAdress'total_unconfirmed} |] + Types.FundingAddress {fundingAddressAsset = fundingAdress'asset, + fundingAddressAddress = fundingAdress'address, + fundingAddressTotalReceived = qsToScientific fundingAdress'total_received, + fundingAddressTotalUnconfirmed = qsToScientific fundingAdress'total_unconfirmed} --------------------------------------------- Asset type ------------------------------------------- -instance POSTEncodeable Asset where +instance POSTEncodeable Types.Asset where postEncode asset = [("asset", showableToBytestring_ asset)] @@ -422,10 +417,10 @@ $(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"} ''WithdrawalRequest_) -instance BitXAesRecordConvert WithdrawalRequest WithdrawalRequest_ where +instance BitXAesRecordConvert Types.WithdrawalRequest WithdrawalRequest_ where aesToRec (WithdrawalRequest_ {..}) = - [record| {status = requestStatusParse withdrawalRequest'status, - id = withdrawalRequest'id} |] + Types.WithdrawalRequest {withdrawalRequestStatus = requestStatusParse withdrawalRequest'status, + withdrawalRequestId = withdrawalRequest'id} -------------------------------------- WithdrawalRequests type ------------------------------------- @@ -436,44 +431,44 @@ $(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"} ''WithdrawalRequests_) -instance BitXAesRecordConvert [WithdrawalRequest] WithdrawalRequests_ where +instance BitXAesRecordConvert [Types.WithdrawalRequest] WithdrawalRequests_ where aesToRec (WithdrawalRequests_ {..}) = map aesToRec withdrawalRequests'withdrawals ----------------------------------------- NewWithdrawal type --------------------------------------- -instance POSTEncodeable NewWithdrawal where +instance POSTEncodeable Types.NewWithdrawal where postEncode nwthd = - [("type", showableToBytestring_ (view [lens| type |] nwthd)), - ("amount", showableToBytestring_ (view [lens| amount |] nwthd))] + [("type", showableToBytestring_ (nwthd ^. Types.withdrawalType)), + ("amount", showableToBytestring_ (nwthd ^. Types.amount))] -------------------------------------- BitcoinSendRequest type ------------------------------------- -instance POSTEncodeable BitcoinSendRequest where +instance POSTEncodeable Types.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))] + [("amount", showableToBytestring_ (oreq ^. Types.amount)), + ("currency", showableToBytestring_ (oreq ^. Types.currency)), + ("address", Txt.encodeUtf8 (oreq ^. Types.address)), + ("description", Txt.encodeUtf8 . unjustText $ (oreq ^. Types.description)), + ("message", Txt.encodeUtf8 . unjustText $ (oreq ^. Types.message))] where unjustText (Just a) = a unjustText Nothing = "" ----------------------------------------- QuoteRequest type ---------------------------------------- -instance POSTEncodeable QuoteRequest where +instance POSTEncodeable Types.QuoteRequest where postEncode oreq = - [("type", showableToBytestring_ (view [lens| type |] oreq)), - ("pair", showableToBytestring_ (view [lens| pair |] oreq)), - ("base_amount", showableToBytestring_ (view [lens| baseAmount |] oreq))] + [("type", showableToBytestring_ (oreq ^. Types.quoteType)), + ("pair", showableToBytestring_ (oreq ^. Types.pair)), + ("base_amount", showableToBytestring_ (oreq ^. Types.baseAmount))] ------------------------------------------ OrderQuote type ----------------------------------------- data OrderQuote_ = OrderQuote_ { orderQuote'id :: Text - , orderQuote'type :: QuoteType - , orderQuote'pair :: CcyPair + , orderQuote'type :: Types.QuoteType + , orderQuote'pair :: Types.CcyPair , orderQuote'base_amount :: QuotedScientific , orderQuote'counter_amount :: QuotedScientific , orderQuote'created_at :: TimestampMS @@ -485,17 +480,17 @@ $(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"} ''OrderQuote_) -instance BitXAesRecordConvert OrderQuote OrderQuote_ where +instance BitXAesRecordConvert Types.OrderQuote OrderQuote_ where aesToRec (OrderQuote_ {..}) = - [record| {id = orderQuote'id, - type = orderQuote'type, - pair = orderQuote'pair, - baseAmount = qsToScientific orderQuote'base_amount, - counterAmount = qsToScientific orderQuote'counter_amount, - createdAt = tsmsToUTCTime orderQuote'created_at, - expiresAt = tsmsToUTCTime orderQuote'expires_at, - discarded = orderQuote'discarded, - exercised = orderQuote'exercised} |] + Types.OrderQuote {orderQuoteId = orderQuote'id, + orderQuoteQuoteType = orderQuote'type, + orderQuotePair = orderQuote'pair, + orderQuoteBaseAmount = qsToScientific orderQuote'base_amount, + orderQuoteCounterAmount = qsToScientific orderQuote'counter_amount, + orderQuoteCreatedAt = tsmsToUTCTime orderQuote'created_at, + orderQuoteExpiresAt = tsmsToUTCTime orderQuote'expires_at, + orderQuoteDiscarded = orderQuote'discarded, + orderQuoteExercised = orderQuote'exercised} -------------------------------------------- BitXAuth type ----------------------------------------- @@ -507,10 +502,10 @@ $(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"} ''BitXAuth_) -instance BitXAesRecordConvert BitXAuth BitXAuth_ where +instance BitXAesRecordConvert Types.BitXAuth BitXAuth_ where aesToRec (BitXAuth_ {..}) = - [record| {id = bitXAuth'api_key_id, - secret = bitXAuth'api_key_secret} |] + Types.BitXAuth {bitXAuthId = bitXAuth'api_key_id, + bitXAuthSecret = bitXAuth'api_key_secret} ------------------------------------------ Transaction type ---------------------------------------- @@ -521,23 +516,23 @@ , transaction'available :: QuotedScientific , transaction'balance_delta :: QuotedScientific , transaction'available_delta :: QuotedScientific - , transaction'currency :: Asset + , transaction'currency :: Types.Asset , transaction'description :: Text } $(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"} ''Transaction_) -instance BitXAesRecordConvert Transaction Transaction_ where +instance BitXAesRecordConvert Types.Transaction Transaction_ where aesToRec (Transaction_ {..}) = - [record| {rowIndex = transaction'row_index, - timestamp = tsmsToUTCTime transaction'timestamp, - balance = qsToScientific transaction'balance, - available = qsToScientific transaction'available, - balanceDelta = qsToScientific transaction'balance_delta, - availableDelta = qsToScientific transaction'available_delta, - currency = transaction'currency, - description = transaction'description} |] + Types.Transaction {transactionRowIndex = transaction'row_index, + transactionTimestamp = tsmsToUTCTime transaction'timestamp, + transactionBalance = qsToScientific transaction'balance, + transactionAvailable = qsToScientific transaction'available, + transactionBalanceDelta = qsToScientific transaction'balance_delta, + transactionAvailableDelta = qsToScientific transaction'available_delta, + transactionCurrency = transaction'currency, + transactionDescription = transaction'description} ---------------------------------------- Transactions type ----------------------------------------- @@ -548,7 +543,7 @@ $(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"} ''Transactions_) -instance BitXAesRecordConvert [Transaction] Transactions_ where +instance BitXAesRecordConvert [Types.Transaction] Transactions_ where aesToRec (Transactions_ {..}) = map aesToRec transactions'transactions @@ -562,33 +557,32 @@ instance BitXAesRecordConvert PendingTransactions__ PendingTransactions_ where aesToRec (PendingTransactions_ {..}) = - [record| {transactions = map aesToRec transactions'pending}|] + PendingTransactions__ {pendingTransactions__transactions = map aesToRec transactions'pending} -type PendingTransactions__ = - [record| - {transactions :: [Transaction]}|] +data PendingTransactions__ = PendingTransactions__ + {pendingTransactions__transactions :: [Types.Transaction]} -pendingTransactionsToTransactions :: PendingTransactions__ -> [Transaction] -pendingTransactionsToTransactions pts = (view [lens| transactions |] pts) +pendingTransactionsToTransactions :: PendingTransactions__ -> [Types.Transaction] +pendingTransactionsToTransactions (PendingTransactions__ tx) = tx -------------------------------------------- Account type ------------------------------------------ data Account_ = Account_ { account'id :: Text , account'name :: Text - , account'currency :: Asset + , account'currency :: Types.Asset } $(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"} ''Account_) -instance BitXAesRecordConvert Account Account_ where +instance BitXAesRecordConvert Types.Account Account_ where aesToRec (Account_ {..}) = - [record| {id = account'id, - name = account'name, - currency = account'currency} |] + Types.Account {accountId = account'id, + accountName = account'name, + accountCurrency = account'currency} -instance POSTEncodeable Account where +instance POSTEncodeable Types.Account where postEncode acc = - [("name", showableToBytestring_ (view [lens| name |] acc)), - ("currency", showableToBytestring_ (view [lens| currency |] acc))] + [("name", showableToBytestring_ (acc ^. Types.name)), + ("currency", showableToBytestring_ (acc ^. Types.currency))] diff --git a/test/Network/Bitcoin/BitX/Spec/Specs/AesonRecordSpec.hs b/test/Network/Bitcoin/BitX/Spec/Specs/AesonRecordSpec.hs --- a/test/Network/Bitcoin/BitX/Spec/Specs/AesonRecordSpec.hs +++ b/test/Network/Bitcoin/BitX/Spec/Specs/AesonRecordSpec.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings, QuasiQuotes, DataKinds #-} +{-# LANGUAGE OverloadedStrings, DataKinds #-} module Network.Bitcoin.BitX.Spec.Specs.AesonRecordSpec ( @@ -7,166 +7,163 @@ import Test.Hspec import Network.Bitcoin.BitX.Types -import Record import Data.Time.Clock.POSIX import Network.Bitcoin.BitX.Spec.Common spec :: Spec -spec = do +spec = describe "FromJSON to Record" $ do - it "BitXError is parsed properly" $ do + it "BitXError is parsed properly" $ recordAesCheck "{\"error\" : \"oops\", \"error_code\" : \"ABadError\"}" - ([record| {error = "oops", errorCode = "ABadError"} |] :: BitXError) - it "Ticker is parsed properly" $ do + BitXError {bitXErrorError = "oops", bitXErrorErrorCode = "ABadError"} + it "Ticker is parsed properly" $ recordAesCheck "{\"timestamp\":1431811395699,\"bid\":\"3083.00\",\"ask\":\"3115.00\",\ \ \"last_trade\":\"3116.00\",\"rolling_24_hour_volume\":\"19.776608\",\"pair\":\"XBTZAR\"}" - ([record| - {ask = 3115.00, - timestamp = (posixSecondsToUTCTime 1431811395.699), - bid = 3083.0, - rolling24HourVolume = 19.776608, - lastTrade = 3116.00, - pair = XBTZAR} |] :: Ticker) - it "Balance is parsed properly" $ do + Ticker { + tickerTimestamp = posixSecondsToUTCTime 1431811395.699, + tickerBid = 3083.0, + tickerAsk = 3115.00, + tickerLastTrade = 3116.00, + tickerRolling24HourVolume = 19.776608, + tickerPair = XBTZAR} + it "Balance is parsed properly" $ recordAesCheck "{\"account_id\":\"314159\",\"asset\":\"ZAR\",\"balance\":\"2159.15\",\"reserved\":\"320\",\ \ \"unconfirmed\":\"175\"}" - ([record| - {id = "314159", - asset = ZAR, - balance = 2159.15, - reserved = 320, - unconfirmed = 175} |] :: Balance) - it "Order is parsed properly" $ do + Balance + {balanceId = "314159", + balanceAsset = ZAR, + balanceBalance = 2159.15, + balanceReserved = 320, + balanceUnconfirmed = 175} + it "Order is parsed properly" $ recordAesCheck "{\"volume\":\"314159\",\"price\":\"4321\"}" - ([record| - {volume = 314159, - price = 4321} |] :: Order) - it "WithdrawalRequest is parsed properly" $ do + Order {orderVolume = 314159, orderPrice = 4321} + it "WithdrawalRequest is parsed properly" $ recordAesCheck "{\"status\":\"PENDING\",\"id\":\"271828\"}" - ([record| - {status = PENDING, - id = "271828" } |] :: WithdrawalRequest) - it "Tickers is parsed properly" $ do + WithdrawalRequest + {withdrawalRequestStatus = PENDING, + withdrawalRequestId = "271828" } + it "Tickers is parsed properly" $ recordAesCheck "{\"tickers\":[{\"timestamp\":1431811395699,\"bid\":\"3083.00\",\"ask\":\"3115.00\",\ \ \"last_trade\":\"3116.00\",\"rolling_24_hour_volume\":\"19.776608\",\ \ \"pair\":\"XBTZAR\"}]}" [tickerInner] - it "Orderbook is parsed properly" $ do + it "Orderbook is parsed properly" $ recordAesCheck "{\"timestamp\":1431811395699,\"bids\":[{\"volume\":\"654.98\",\"price\":\"3789.66\"}],\ \ \"asks\":[{\"volume\":\"654.98\",\"price\":\"3789.66\"}]}" - ([record| - {timestamp = (posixSecondsToUTCTime 1431811395.699), - bids = [orderInner], - asks = [orderInner] } |] :: Orderbook) - it "Trade is parsed properly" $ do + Orderbook + {orderbookTimestamp = posixSecondsToUTCTime 1431811395.699, + orderbookBids = [orderInner], + orderbookAsks = [orderInner]} + it "Trade is parsed properly" $ recordAesCheck "{\"timestamp\":1431811395699,\"volume\":\"6754.09\",\"price\":\"5327.765\"}" - ([record| - {timestamp = (posixSecondsToUTCTime 1431811395.699), - volume = 6754.09, - price = 5327.765 } |] :: Trade) - it "PublicTrades is parsed properly" $ do + Trade + {tradeTimestamp = posixSecondsToUTCTime 1431811395.699, + tradeVolume = 6754.09, + tradePrice = 5327.765} + it "PublicTrades is parsed properly" $ recordAesCheck "{\"trades\":[{\"timestamp\":1431811395699,\"volume\":\"6754.09\",\ \ \"price\":\"5327.765\"}],\"currency\":\"ZAR\"}" [tradeInner] - it "PrivateOrder is parsed properly" $ do + it "PrivateOrder is parsed properly" $ recordAesCheck "{\"base\":\"568.7\", \"counter\":3764.2,\"creation_timestamp\":478873467, \ \ \"expiration_timestamp\":8768834222, \"fee_base\":\"3687.3\", \"fee_counter\":12.9,\ \ \"limit_price\":765,\"limit_volume\":55.2,\"order_id\":\"83YG\",\"pair\":\"NADXBT\",\ \ \"state\":\"COMPLETE\",\"type\":\"BID\"}" - ([record| - {base = 568.7, - counter = 3764.2, - creationTimestamp = (posixSecondsToUTCTime 478873.467), - expirationTimestamp = (posixSecondsToUTCTime 8768834.222), - feeBase = 3687.3, - feeCounter = 12.9, - limitPrice = 765, - limitVolume = 55.2, - id = "83YG", - pair = NADXBT, - state = COMPLETE, - type = BID } |] :: PrivateOrder) - it "PrivateOrders is parsed properly" $ do + PrivateOrder + {privateOrderBase = 568.7, + privateOrderCounter = 3764.2, + privateOrderCreationTimestamp = posixSecondsToUTCTime 478873.467, + privateOrderExpirationTimestamp = posixSecondsToUTCTime 8768834.222, + privateOrderFeeBase = 3687.3, + privateOrderFeeCounter = 12.9, + privateOrderLimitPrice = 765, + privateOrderLimitVolume = 55.2, + privateOrderId = "83YG", + privateOrderPair = NADXBT, + privateOrderState = COMPLETE, + privateOrderOrderType = BID} + it "PrivateOrders is parsed properly" $ recordAesCheck "{\"orders\":[{\"base\":\"568.7\", \"counter\":3764.2,\"creation_timestamp\":478873467, \ \ \"expiration_timestamp\":8768834222, \"fee_base\":\"3687.3\", \"fee_counter\":12.9,\ \ \"limit_price\":765,\"limit_volume\":55.2,\"order_id\":\"83YG\",\"pair\":\"NADXBT\",\ \ \"state\":\"COMPLETE\",\"type\":\"BID\"}]}" [privateOrderInner] - it "OrderID is parsed properly" $ do + it "OrderID is parsed properly" $ recordAesCheck "{\"order_id\":\"57983\"}" ("57983" :: OrderID) - it "PublicTrades is parsed properly" $ do + it "PublicTrades is parsed properly" $ recordAesCheck "{\"trades\":[{\"timestamp\":1431811395699,\"volume\":\"6754.09\",\"price\":\"5327.765\"}], \ \ \"currency\":\"ZAR\"}" [tradeInner] - it "RequestSuccess is parsed properly" $ do + it "RequestSuccess is parsed properly" $ recordAesCheck "{\"success\":true}" (True :: RequestSuccess) - it "PrivateOrderWithTrades is parsed properly" $ do + it "PrivateOrderWithTrades is parsed properly" $ recordAesCheck "{\"base\":\"568.7\", \"counter\":3764.2,\"creation_timestamp\":478873467, \ \ \"expiration_timestamp\":8768834222, \"fee_base\":\"3687.3\", \"fee_counter\":12.9,\ \ \"limit_price\":765,\"limit_volume\":55.2,\"order_id\":\"83YG\",\"pair\":\"NADXBT\",\ \ \"state\":\"COMPLETE\",\"type\":\"BID\", \"trades\":[{\"timestamp\":1431811395699, \ \ \"volume\":\"6754.09\",\"price\":\"5327.765\"}]}" - ([record| - {base = 568.7, - counter = 3764.2, - creationTimestamp = (posixSecondsToUTCTime 478873.467), - expirationTimestamp = (posixSecondsToUTCTime 8768834.222), - feeBase = 3687.3, - feeCounter = 12.9, - limitPrice = 765, - limitVolume = 55.2, - id = "83YG", - pair = NADXBT, - state = COMPLETE, - type = BID, - trades = [tradeInner]} |] :: PrivateOrderWithTrades) - it "WithdrawalRequest is parsed properly" $ do + PrivateOrderWithTrades + {privateOrderWithTradesBase = 568.7, + privateOrderWithTradesCounter = 3764.2, + privateOrderWithTradesCreationTimestamp = posixSecondsToUTCTime 478873.467, + privateOrderWithTradesExpirationTimestamp = posixSecondsToUTCTime 8768834.222, + privateOrderWithTradesFeeBase = 3687.3, + privateOrderWithTradesFeeCounter = 12.9, + privateOrderWithTradesLimitPrice = 765, + privateOrderWithTradesLimitVolume = 55.2, + privateOrderWithTradesId = "83YG", + privateOrderWithTradesPair = NADXBT, + privateOrderWithTradesState = COMPLETE, + privateOrderWithTradesOrderType = BID, + privateOrderWithTradesTrades = [tradeInner]} + it "WithdrawalRequest is parsed properly" $ recordAesCheck "{\"status\":\"PENDING\", \"id\":\"7yrfU4987\"}" - ([record| - {status = PENDING, - id = "7yrfU4987" } |] :: WithdrawalRequest) - it "FundingAddress is parsed properly" $ do + WithdrawalRequest + {withdrawalRequestStatus = PENDING, + withdrawalRequestId = "7yrfU4987" } + it "FundingAddress is parsed properly" $ recordAesCheck "{\"asset\":\"ZAR\", \"address\":\"093gu959t894G\", \"total_received\":\"432.5\", \ \ \"total_unconfirmed\":\"0.023\"}" - ([record| - {asset = ZAR, - address = "093gu959t894G", - totalReceived = 432.5, - totalUnconfirmed = 0.023} |] :: FundingAddress) - it "Transaction is parsed properly" $ do + FundingAddress + {fundingAddressAsset = ZAR, + fundingAddressAddress = "093gu959t894G", + fundingAddressTotalReceived = 432.5, + fundingAddressTotalUnconfirmed = 0.023} + it "Transaction is parsed properly" $ recordAesCheck "{\"row_index\":1,\"timestamp\":1387527013000,\"balance\":0.0199, \"available\":0.0299, \ \ \"account_id\":\"3485527347968330182\", \"balance_delta\":0.0399, \ \ \"available_delta\":0.0099, \"currency\":\"XBT\",\"description\":\"Bought BTC 0.01 for R 79.00\"}" - ([record| - {rowIndex = 1, - timestamp = (posixSecondsToUTCTime 1387527013), - balance = 0.0199, - available = 0.0299, - balanceDelta = 0.0399, - availableDelta = 0.0099, - currency = XBT, - description = "Bought BTC 0.01 for R 79.00"}|] :: Transaction) - it "Transactions is parsed properly" $ do + Transaction + {transactionRowIndex = 1, + transactionTimestamp = posixSecondsToUTCTime 1387527013, + transactionBalance = 0.0199, + transactionAvailable = 0.0299, + transactionBalanceDelta = 0.0399, + transactionAvailableDelta = 0.0099, + transactionCurrency = XBT, + transactionDescription = "Bought BTC 0.01 for R 79.00"} + it "Transactions is parsed properly" $ recordAesCheck "{\"transactions\":[{\"row_index\":1,\"timestamp\":1387527013000,\"balance\":0.0199, \"available\":0.0299, \ \ \"account_id\":\"3485527347968330182\", \"balance_delta\":0.0399, \ @@ -175,51 +172,48 @@ tickerInner :: Ticker tickerInner = - [record| - {ask = 3115.00, - timestamp = (posixSecondsToUTCTime 1431811395.699), - bid = 3083.0, - rolling24HourVolume = 19.776608, - lastTrade = 3116.00, - pair = XBTZAR} |] + Ticker (posixSecondsToUTCTime 1431811395.699) + 3083.0 + 3115.00 + 3116.00 + 19.776608 + XBTZAR orderInner :: Order orderInner = - [record| - {volume = 654.98, - price = 3789.66} |] + Order 654.98 3789.66 tradeInner :: Trade tradeInner = - [record| - {timestamp = (posixSecondsToUTCTime 1431811395.699), - volume = 6754.09, - price = 5327.765 } |] + Trade { + tradeTimestamp = posixSecondsToUTCTime 1431811395.699, + tradeVolume = 6754.09, + tradePrice = 5327.765} privateOrderInner :: PrivateOrder privateOrderInner = - [record| - {base = 568.7, - counter = 3764.2, - creationTimestamp = (posixSecondsToUTCTime 478873.467), - expirationTimestamp = (posixSecondsToUTCTime 8768834.222), - feeBase = 3687.3, - feeCounter = 12.9, - limitPrice = 765, - limitVolume = 55.2, - id = "83YG", - pair = NADXBT, - state = COMPLETE, - type = BID } |] + PrivateOrder + {privateOrderBase = 568.7, + privateOrderCounter = 3764.2, + privateOrderCreationTimestamp = posixSecondsToUTCTime 478873.467, + privateOrderExpirationTimestamp = posixSecondsToUTCTime 8768834.222, + privateOrderFeeBase = 3687.3, + privateOrderFeeCounter = 12.9, + privateOrderLimitPrice = 765, + privateOrderLimitVolume = 55.2, + privateOrderId = "83YG", + privateOrderPair = NADXBT, + privateOrderState = COMPLETE, + privateOrderOrderType = BID} transactionInner :: Transaction transactionInner = - [record| - {rowIndex = 1, - timestamp = (posixSecondsToUTCTime 1387527013), - balance = 0.0199, - available = 0.0299, - balanceDelta = 0.0399, - availableDelta = 0.0099, - currency = XBT, - description = "Bought BTC 0.01 for R 79.00"}|] + Transaction + {transactionRowIndex = 1, + transactionTimestamp = posixSecondsToUTCTime 1387527013, + transactionBalance = 0.0199, + transactionAvailable = 0.0299, + transactionBalanceDelta = 0.0399, + transactionAvailableDelta = 0.0099, + transactionCurrency = XBT, + transactionDescription = "Bought BTC 0.01 for R 79.00"} diff --git a/test/Network/Bitcoin/BitX/Spec/Specs/JsonSpec.hs b/test/Network/Bitcoin/BitX/Spec/Specs/JsonSpec.hs --- a/test/Network/Bitcoin/BitX/Spec/Specs/JsonSpec.hs +++ b/test/Network/Bitcoin/BitX/Spec/Specs/JsonSpec.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings, QuasiQuotes, DataKinds #-} +{-# LANGUAGE OverloadedStrings, DataKinds #-} module Network.Bitcoin.BitX.Spec.Specs.JsonSpec ( @@ -7,110 +7,105 @@ import Test.Hspec import Network.Bitcoin.BitX.Types -import Record import Network.Bitcoin.BitX.Spec.Common import Data.Time.Clock.POSIX spec :: Spec -spec = do +spec = describe "FromJSON intances" $ do - it "QuotedDecimal is parsed whether quoted or not, for floating point numbers" $ do + it "QuotedDecimal is parsed whether quoted or not, for floating point numbers" $ recordAesCheck "{\"volume\":314159.23,\"price\":\"4321.56\"}" - ([record| - {volume = 314159.23, - price = 4321.56} |] :: Order) - it "QuotedDecimal is parsed whether quoted or not, for integral numbers" $ do + (Order 314159.23 4321.56) + it "QuotedDecimal is parsed whether quoted or not, for integral numbers" $ recordAesCheck "{\"volume\":314159,\"price\":\"4321\"}" - ([record| - {volume = 314159, - price = 4321} |] :: Order) - it "OrderType BUY is parsed properly" $ do + (Order 314159 4321) + it "OrderType BUY is parsed properly" $ recordAesCheck "{\"base\":\"568.7\", \"counter\":3764.2,\"creation_timestamp\":478873467, \ \\"expiration_timestamp\":8768834222, \"fee_base\":\"3687.3\", \"fee_counter\":12.9,\ \\"limit_price\":765,\"limit_volume\":55.2,\"order_id\":\"83YG\",\"pair\":\"NADXBT\",\ \\"state\":\"COMPLETE\",\"type\":\"BUY\"}" - ([record| - {base = 568.7, - counter = 3764.2, - creationTimestamp = (posixSecondsToUTCTime 478873.467), - expirationTimestamp = (posixSecondsToUTCTime 8768834.222), - feeBase = 3687.3, - feeCounter = 12.9, - limitPrice = 765, - limitVolume = 55.2, - id = "83YG", - pair = NADXBT, - state = COMPLETE, - type = BID } |] :: PrivateOrder) - it "OrderType BID is parsed properly" $ do + PrivateOrder + {privateOrderBase = 568.7, + privateOrderCounter = 3764.2, + privateOrderCreationTimestamp = posixSecondsToUTCTime 478873.467, + privateOrderExpirationTimestamp = posixSecondsToUTCTime 8768834.222, + privateOrderFeeBase = 3687.3, + privateOrderFeeCounter = 12.9, + privateOrderLimitPrice = 765, + privateOrderLimitVolume = 55.2, + privateOrderId = "83YG", + privateOrderPair = NADXBT, + privateOrderState = COMPLETE, + privateOrderOrderType = BID } + it "OrderType BID is parsed properly" $ recordAesCheck "{\"base\":\"568.7\", \"counter\":3764.2,\"creation_timestamp\":478873467, \ \\"expiration_timestamp\":8768834222, \"fee_base\":\"3687.3\", \"fee_counter\":12.9,\ \\"limit_price\":765,\"limit_volume\":55.2,\"order_id\":\"83YG\",\"pair\":\"NADXBT\",\ \\"state\":\"COMPLETE\",\"type\":\"BID\"}" - ([record| - {base = 568.7, - counter = 3764.2, - creationTimestamp = (posixSecondsToUTCTime 478873.467), - expirationTimestamp = (posixSecondsToUTCTime 8768834.222), - feeBase = 3687.3, - feeCounter = 12.9, - limitPrice = 765, - limitVolume = 55.2, - id = "83YG", - pair = NADXBT, - state = COMPLETE, - type = BID } |] :: PrivateOrder) - it "OrderType ASK is parsed properly" $ do + PrivateOrder + {privateOrderBase = 568.7, + privateOrderCounter = 3764.2, + privateOrderCreationTimestamp = posixSecondsToUTCTime 478873.467, + privateOrderExpirationTimestamp = posixSecondsToUTCTime 8768834.222, + privateOrderFeeBase = 3687.3, + privateOrderFeeCounter = 12.9, + privateOrderLimitPrice = 765, + privateOrderLimitVolume = 55.2, + privateOrderId = "83YG", + privateOrderPair = NADXBT, + privateOrderState = COMPLETE, + privateOrderOrderType = BID } + it "OrderType ASK is parsed properly" $ recordAesCheck "{\"base\":\"568.7\", \"counter\":3764.2,\"creation_timestamp\":478873467, \ \\"expiration_timestamp\":8768834222, \"fee_base\":\"3687.3\", \"fee_counter\":12.9,\ \\"limit_price\":765,\"limit_volume\":55.2,\"order_id\":\"83YG\",\"pair\":\"NADXBT\",\ \\"state\":\"COMPLETE\",\"type\":\"ASK\"}" - ([record| - {base = 568.7, - counter = 3764.2, - creationTimestamp = (posixSecondsToUTCTime 478873.467), - expirationTimestamp = (posixSecondsToUTCTime 8768834.222), - feeBase = 3687.3, - feeCounter = 12.9, - limitPrice = 765, - limitVolume = 55.2, - id = "83YG", - pair = NADXBT, - state = COMPLETE, - type = ASK } |] :: PrivateOrder) - it "OrderType SELL is parsed properly" $ do + PrivateOrder + {privateOrderBase = 568.7, + privateOrderCounter = 3764.2, + privateOrderCreationTimestamp = posixSecondsToUTCTime 478873.467, + privateOrderExpirationTimestamp = posixSecondsToUTCTime 8768834.222, + privateOrderFeeBase = 3687.3, + privateOrderFeeCounter = 12.9, + privateOrderLimitPrice = 765, + privateOrderLimitVolume = 55.2, + privateOrderId = "83YG", + privateOrderPair = NADXBT, + privateOrderState = COMPLETE, + privateOrderOrderType = ASK } + it "OrderType SELL is parsed properly" $ recordAesCheck "{\"base\":\"568.7\", \"counter\":3764.2,\"creation_timestamp\":478873467, \ \\"expiration_timestamp\":8768834222, \"fee_base\":\"3687.3\", \"fee_counter\":12.9,\ \\"limit_price\":765,\"limit_volume\":55.2,\"order_id\":\"83YG\",\"pair\":\"NADXBT\",\ \\"state\":\"COMPLETE\",\"type\":\"SELL\"}" - ([record| - {base = 568.7, - counter = 3764.2, - creationTimestamp = (posixSecondsToUTCTime 478873.467), - expirationTimestamp = (posixSecondsToUTCTime 8768834.222), - feeBase = 3687.3, - feeCounter = 12.9, - limitPrice = 765, - limitVolume = 55.2, - id = "83YG", - pair = NADXBT, - state = COMPLETE, - type = ASK } |] :: PrivateOrder) - it "RequestStatus COMPLETE is parsed properly" $ do + PrivateOrder + {privateOrderBase = 568.7, + privateOrderCounter = 3764.2, + privateOrderCreationTimestamp = posixSecondsToUTCTime 478873.467, + privateOrderExpirationTimestamp = posixSecondsToUTCTime 8768834.222, + privateOrderFeeBase = 3687.3, + privateOrderFeeCounter = 12.9, + privateOrderLimitPrice = 765, + privateOrderLimitVolume = 55.2, + privateOrderId = "83YG", + privateOrderPair = NADXBT, + privateOrderState = COMPLETE, + privateOrderOrderType = ASK } + it "RequestStatus COMPLETE is parsed properly" $ recordAesCheck "{\"status\":\"COMPLETE\", \"id\":\"\"}" - ([record| - {status = COMPLETE, - id = "" } |] :: WithdrawalRequest) - it "RequestStatus COMPLETED is parsed properly" $ do + WithdrawalRequest + {withdrawalRequestStatus = COMPLETE, + withdrawalRequestId = "" } + it "RequestStatus COMPLETED is parsed properly" $ recordAesCheck "{\"status\":\"COMPLETED\", \"id\":\"\"}" - ([record| - {status = COMPLETE, - id = "" } |] :: WithdrawalRequest) + WithdrawalRequest + {withdrawalRequestStatus = COMPLETE, + withdrawalRequestId = "" } diff --git a/test/Network/Bitcoin/BitX/Spec/Specs/LensSpec.hs b/test/Network/Bitcoin/BitX/Spec/Specs/LensSpec.hs new file mode 100644 --- /dev/null +++ b/test/Network/Bitcoin/BitX/Spec/Specs/LensSpec.hs @@ -0,0 +1,176 @@ +{-# LANGUAGE OverloadedStrings, DataKinds #-} + +module Network.Bitcoin.BitX.Spec.Specs.LensSpec + ( + spec + ) where + +import Test.Hspec +import Lens.Micro +import qualified Network.Bitcoin.BitX as BitX +import Network.Bitcoin.BitX.Types +import Data.Time.Clock.POSIX + +spec :: Spec +spec = + describe "Lens functionality test" $ + it "This file should just compile" $ + True `shouldBe` True + +-- If this file compiles, then (hopefully) all the Has* classes have been created and exported properly + +_bitXError :: Maybe Int +_bitXError = do + let x = BitX.BitXError "" "" + let _ = x ^. BitX.error + let _ = x ^. BitX.errorCode + Nothing + +_ticker :: Maybe Int +_ticker = do + let x = BitX.Ticker (posixSecondsToUTCTime 0) 0 0 0 0 XBTZAR + let _ = x ^. BitX.timestamp + let _ = x ^. BitX.bid + let _ = x ^. BitX.ask + let _ = x ^. BitX.lastTrade + let _ = x ^. BitX.rolling24HourVolume + let _ = x ^. BitX.pair + Nothing + +_order :: Maybe Int +_order = do + let x = BitX.Order 0 0 + let _ = x ^. BitX.volume + let _ = x ^. BitX.price + Nothing + +_orderbook :: Maybe Int +_orderbook = do + let x = BitX.Orderbook (posixSecondsToUTCTime 0) [BitX.Order 0 0] [BitX.Order 0 0] + let _ = x ^. BitX.timestamp + let _ = x ^. BitX.asks + let _ = x ^. BitX.bids + Nothing + +_trade :: Maybe Int +_trade = do + let x = BitX.Trade (posixSecondsToUTCTime 0) 0 0 + let _ = x ^. BitX.timestamp + let _ = x ^. BitX.volume + let _ = x ^. BitX.price + Nothing + +_bitXAuth :: Maybe Int +_bitXAuth = do + let x = BitX.BitXAuth "" "" + let _ = x ^. BitX.id + let _ = x ^. BitX.secret + Nothing + +_privateOrder :: Maybe Int +_privateOrder = do + let x = BitX.PrivateOrder 0 0 (posixSecondsToUTCTime 0) (posixSecondsToUTCTime 0) 0 0 0 0 "" XBTZAR PENDING ASK + let _ = x ^. BitX.base + let _ = x ^. BitX.counter + let _ = x ^. BitX.creationTimestamp + let _ = x ^. BitX.feeBase + let _ = x ^. BitX.feeCounter + let _ = x ^. BitX.limitPrice + let _ = x ^. BitX.limitVolume + let _ = x ^. BitX.id + let _ = x ^. BitX.pair + let _ = x ^. BitX.state + let _ = x ^. BitX.orderType + let _ = x ^. BitX.expirationTimestamp + Nothing + +_privateOrderWithTrades :: Maybe Int +_privateOrderWithTrades = do + let x = BitX.PrivateOrderWithTrades 0 0 (posixSecondsToUTCTime 0) (posixSecondsToUTCTime 0) 0 0 0 0 "" XBTZAR PENDING ASK [BitX.Trade (posixSecondsToUTCTime 0) 0 0] + let _ = x ^. BitX.base + let _ = x ^. BitX.counter + let _ = x ^. BitX.creationTimestamp + let _ = x ^. BitX.feeBase + let _ = x ^. BitX.feeCounter + let _ = x ^. BitX.limitPrice + let _ = x ^. BitX.limitVolume + let _ = x ^. BitX.id + let _ = x ^. BitX.pair + let _ = x ^. BitX.state + let _ = x ^. BitX.orderType + let _ = x ^. BitX.expirationTimestamp + let _ = x ^. BitX.trades + Nothing + +_transaction :: Maybe Int +_transaction = do + let x = BitX.Transaction 0 (posixSecondsToUTCTime 0) 0 0 0 0 ZAR "" + let _ = x ^. BitX.rowIndex + let _ = x ^. BitX.timestamp + let _ = x ^. BitX.balance + let _ = x ^. BitX.available + let _ = x ^. BitX.balanceDelta + let _ = x ^. BitX.availableDelta + let _ = x ^. BitX.currency + let _ = x ^. BitX.description + Nothing + +_balance :: Maybe Int +_balance = do + let x = BitX.Balance "" ZAR 0 0 0 + let _ = x ^. BitX.id + let _ = x ^. BitX.asset + let _ = x ^. BitX.balance + let _ = x ^. BitX.reserved + let _ = x ^. BitX.unconfirmed + Nothing + +_fundingAddress :: Maybe Int +_fundingAddress = do + let x = BitX.FundingAddress ZAR "" 0 0 + let _ = x ^. BitX.asset + let _ = x ^. BitX.address + let _ = x ^. BitX.totalReceived + let _ = x ^. BitX.totalUnconfirmed + Nothing + +_newWithdrawal :: Maybe Int +_newWithdrawal = do + let x = BitX.NewWithdrawal ZAR_EFT 0 + let _ = x ^. BitX.withdrawalType + let _ = x ^. BitX.amount + Nothing + +_bitcoinSendRequest :: Maybe Int +_bitcoinSendRequest = do + let x = BitX.BitcoinSendRequest 0 ZAR "" (Just "") (Just "") + let _ = x ^. BitX.amount + let _ = x ^. BitX.currency + let _ = x ^. BitX.address + let _ = x ^. BitX.description + let _ = x ^. BitX.message + Nothing + +_orderQuote :: Maybe Int +_orderQuote = do + let x = BitX.OrderQuote "" BUY XBTZAR 0 0 (posixSecondsToUTCTime 0) (posixSecondsToUTCTime 0) False False + let _ = x ^. BitX.id + let _ = x ^. BitX.quoteType + let _ = x ^. BitX.pair + let _ = x ^. BitX.baseAmount + let _ = x ^. BitX.counterAmount + let _ = x ^. BitX.createdAt + let _ = x ^. BitX.expiresAt + let _ = x ^. BitX.discarded + let _ = x ^. BitX.exercised + Nothing + +_account :: Maybe Int +_account = do + let x = BitX.Account "" "" ZAR + let _ = x ^. BitX.id + let _ = x ^. BitX.name + let _ = x ^. BitX.currency + Nothing + + diff --git a/test/Network/Bitcoin/BitX/Spec/Specs/PostSpec.hs b/test/Network/Bitcoin/BitX/Spec/Specs/PostSpec.hs --- a/test/Network/Bitcoin/BitX/Spec/Specs/PostSpec.hs +++ b/test/Network/Bitcoin/BitX/Spec/Specs/PostSpec.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings, QuasiQuotes, DataKinds #-} +{-# LANGUAGE OverloadedStrings, DataKinds #-} module Network.Bitcoin.BitX.Spec.Specs.PostSpec ( @@ -7,55 +7,54 @@ import Test.Hspec import Network.Bitcoin.BitX -import Record spec :: Spec -spec = do +spec = describe "PostEncode test" $ do - it "OrderRequest is post-encoded properly" $ do + it "OrderRequest is post-encoded properly" $ postEncode - ([record| - {pair = XBTZAR, - type = BID, - volume = 83.02, - price = 15.23 } |] :: OrderRequest) + OrderRequest + {orderRequestPair = XBTZAR, + orderRequestOrderType = BID, + orderRequestVolume = 83.02, + orderRequestPrice = 15.23 } `shouldBe` [("pair", "XBTZAR"), ("type", "BID"), ("volume", "83.02"), ("price", "15.23")] - it "Asset is post-encoded properly" $ do + it "Asset is post-encoded properly" $ postEncode ZAR `shouldBe` [("asset", "ZAR")] - it "NewWithdrawal is post-encoded properly" $ do + it "NewWithdrawal is post-encoded properly" $ postEncode - ([record| - {type = ZAR_EFT, - amount = 83.02} |] :: NewWithdrawal) + NewWithdrawal + {newWithdrawalWithdrawalType = ZAR_EFT, + newWithdrawalAmount = 83.02} `shouldBe` [("type", "ZAR_EFT"), ("amount", "83.02")] - it "BitcoinSendRequest is post-encoded properly" $ do + it "BitcoinSendRequest is post-encoded properly" $ postEncode - ([record| - {amount = 83.02, - currency = XBT, - address = "ahglk98aslfk", - description = Just "Send some coinz to dis ere dude.", - message = Just "Dude, ere'z your coinz."} |] :: BitcoinSendRequest) + BitcoinSendRequest + {bitcoinSendRequestAmount = 83.02, + bitcoinSendRequestCurrency = XBT, + bitcoinSendRequestAddress = "ahglk98aslfk", + bitcoinSendRequestDescription = Just "Send some coinz to dis ere dude.", + bitcoinSendRequestMessage = Just "Dude, ere'z your coinz."} `shouldBe` [("amount", "83.02"), ("currency", "XBT"), ("address", "ahglk98aslfk"), ("description", "Send some coinz to dis ere dude."), ("message", "Dude, ere'z your coinz.")] - it "QuoteRequest is post-encoded properly" $ do + it "QuoteRequest is post-encoded properly" $ postEncode - ([record| - {type = BUY, - pair = XBTKES, - baseAmount = 566.76} |] :: QuoteRequest) + QuoteRequest + {quoteRequestQuoteType = BUY, + quoteRequestPair = XBTKES, + quoteRequestBaseAmount = 566.76} `shouldBe` [("type", "BUY"), ("pair", "XBTKES"),