module Network.Bitcoin.BitX.Types.Internal
(
BitXAesRecordConvert(..),
POSTEncodeable(..),
Transaction_(..),
pendingTransactionsToTransactions
)
where
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
import qualified Data.Text.Encoding as Txt
import Data.Text (Text)
import Data.Time.Clock (UTCTime)
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Lens.Micro ((^.))
#if MIN_VERSION_base(4,8,0)
#else
import Data.Monoid (mempty)
#endif
import Data.Scientific (Scientific)
import Data.ByteString (ByteString)
import Data.List.Split (splitOn)
#if MIN_VERSION_base(4,7,0)
import Data.Coerce
#endif
timestampParse_ :: Integer -> UTCTime
timestampParse_ = posixSecondsToUTCTime
. realToFrac
. ( / 1000)
. (fromIntegral :: Integer -> Scientific)
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
newtype QuotedScientific = QuotedScientific Scientific deriving (Read, Show)
instance FromJSON QuotedScientific where
parseJSON (String x) = return . QuotedScientific . read . Txt.unpack $ x
parseJSON (Number x) = return . QuotedScientific . read . show $ x
parseJSON _ = mempty
qsToScientific :: QuotedScientific -> Scientific
#if MIN_VERSION_base(4,7,0)
qsToScientific = coerce
#else
qsToScientific (QuotedScientific sci) = sci
#endif
newtype TimestampMS = TimestampMS Integer deriving (Read, Show)
instance FromJSON TimestampMS where
parseJSON (Number x) = return . TimestampMS . round $ x
parseJSON _ = mempty
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_ -> 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
newtype RequestStatus_ = RequestStatus_ Text deriving (Read, Show)
instance FromJSON RequestStatus_ where
parseJSON (String x) = return . RequestStatus_ $ x
parseJSON _ = mempty
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
data Ticker_ = Ticker_
{ ticker'timestamp :: TimestampMS
, ticker'bid :: QuotedScientific
, ticker'ask :: QuotedScientific
, ticker'last_trade :: QuotedScientific
, ticker'rolling_24_hour_volume :: QuotedScientific
, ticker'pair :: Types.CcyPair
}
$(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"}
''Ticker_)
instance BitXAesRecordConvert Types.Ticker Ticker_ where
aesToRec (Ticker_ {..}) =
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}
data Tickers_ = Tickers_
{ tickers'tickers :: [Ticker_]
}
$(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"}
''Tickers_)
instance BitXAesRecordConvert [Types.Ticker] Tickers_ where
aesToRec (Tickers_ {..}) =
map aesToRec tickers'tickers
data BitXError_= BitXError_
{ bitXError'error :: Text,
bitXError'error_code :: Text
} deriving (Show, Eq)
$(AesTH.deriveJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"} ''BitXError_)
instance BitXAesRecordConvert Types.BitXError BitXError_ where
aesToRec (BitXError_ {..}) =
Types.BitXError { bitXErrorError = bitXError'error, bitXErrorErrorCode = bitXError'error_code}
data Order_ = Order_
{ order'volume :: QuotedScientific,
order'price :: QuotedScientific
}
$(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"} ''Order_)
instance BitXAesRecordConvert Types.Order Order_ where
aesToRec (Order_ {..}) =
Types.Order {orderVolume = (qsToScientific order'volume),
orderPrice = (qsToScientific order'price)}
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 Types.Orderbook Orderbook_ where
aesToRec (Orderbook_ {..}) =
Types.Orderbook {orderbookTimestamp = (tsmsToUTCTime orderbook'timestamp),
orderbookBids = (map aesToRec orderbook'bids),
orderbookAsks = (map aesToRec orderbook'asks)}
data Trade_ = Trade_
{ trade'volume :: QuotedScientific
, trade'timestamp :: TimestampMS
, trade'price :: QuotedScientific
}
$(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"}
''Trade_)
instance BitXAesRecordConvert Types.Trade Trade_ where
aesToRec (Trade_ {..}) =
Types.Trade { tradeTimestamp = (tsmsToUTCTime trade'timestamp),
tradeVolume = (qsToScientific trade'volume),
tradePrice = (qsToScientific trade'price) }
data PublicTrades_ = PublicTrades_
{ publicTrades'trades :: [Trade_]
}
$(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"}
''PublicTrades_)
instance BitXAesRecordConvert [Types.Trade] PublicTrades_ where
aesToRec (PublicTrades_ {..}) =
map aesToRec publicTrades'trades
data PrivateOrder_ = PrivateOrder_
{ privateOrder'base :: QuotedScientific
, privateOrder'counter :: QuotedScientific
, privateOrder'creation_timestamp :: TimestampMS
, privateOrder'expiration_timestamp :: TimestampMS
, privateOrder'fee_base :: QuotedScientific
, privateOrder'fee_counter :: QuotedScientific
, privateOrder'limit_price :: QuotedScientific
, privateOrder'limit_volume :: QuotedScientific
, privateOrder'order_id :: Types.OrderID
, privateOrder'pair :: Types.CcyPair
, privateOrder'state :: RequestStatus_
, privateOrder'type :: OrderType_
}
$(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"}
''PrivateOrder_)
instance BitXAesRecordConvert Types.PrivateOrder PrivateOrder_ where
aesToRec (PrivateOrder_ {..}) =
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}
data PrivateOrders_ = PrivateOrders_
{privateOrders'orders :: [PrivateOrder_]
}
$(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"}
''PrivateOrders_)
instance BitXAesRecordConvert [Types.PrivateOrder] PrivateOrders_ where
aesToRec (PrivateOrders_ {..}) =
map aesToRec privateOrders'orders
instance POSTEncodeable Types.OrderRequest where
postEncode oreq =
[("pair", showableToBytestring_ (oreq ^. Types.pair)),
("type", showableToBytestring_ (oreq ^. Types.orderType)),
("volume", showableToBytestring_ (oreq ^. Types.volume)),
("price", showableToBytestring_ (oreq ^. Types.price))]
data OrderIDRec_ = OrderIDRec_
{ orderIDResponse'order_id :: Types.OrderID
}
$(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"}
''OrderIDRec_)
instance BitXAesRecordConvert Types.OrderID OrderIDRec_ where
aesToRec (OrderIDRec_ {..}) =
orderIDResponse'order_id
instance POSTEncodeable Types.OrderID where
postEncode oid =
[("order_id", Txt.encodeUtf8 oid)]
data RequestSuccess_ = RequestSuccess_
{ requestSuccess'success :: Bool
}
$(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"}
''RequestSuccess_)
instance BitXAesRecordConvert Types.RequestSuccess RequestSuccess_ where
aesToRec (RequestSuccess_ {..}) =
requestSuccess'success
data PrivateOrderWithTrades_ = PrivateOrderWithTrades_
{ privateOrderWithTrades'base :: QuotedScientific
, privateOrderWithTrades'counter :: QuotedScientific
, privateOrderWithTrades'creation_timestamp :: TimestampMS
, privateOrderWithTrades'expiration_timestamp :: TimestampMS
, privateOrderWithTrades'fee_base :: QuotedScientific
, privateOrderWithTrades'fee_counter :: QuotedScientific
, privateOrderWithTrades'limit_price :: QuotedScientific
, privateOrderWithTrades'limit_volume :: QuotedScientific
, privateOrderWithTrades'order_id :: Types.OrderID
, privateOrderWithTrades'pair :: Types.CcyPair
, privateOrderWithTrades'state :: RequestStatus_
, privateOrderWithTrades'type :: OrderType_
, privateOrderWithTrades'trades :: [Trade_]
}
$(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"}
''PrivateOrderWithTrades_)
instance BitXAesRecordConvert Types.PrivateOrderWithTrades PrivateOrderWithTrades_ where
aesToRec (PrivateOrderWithTrades_ {..}) =
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}
data Balance_ = Balance_
{ balance'account_id :: Types.AccountID
, balance'asset :: Types.Asset
, balance'balance :: QuotedScientific
, balance'reserved :: QuotedScientific
, balance'unconfirmed :: QuotedScientific
}
$(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"}
''Balance_)
instance BitXAesRecordConvert Types.Balance Balance_ where
aesToRec (Balance_ {..}) =
Types.Balance {balanceId = balance'account_id,
balanceAsset = balance'asset,
balanceBalance = qsToScientific balance'balance,
balanceReserved = qsToScientific balance'reserved,
balanceUnconfirmed = qsToScientific balance'unconfirmed}
data Balances_ = Balances_
{ balances'balance :: [Balance_]
}
$(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"}
''Balances_)
instance BitXAesRecordConvert [Types.Balance] Balances_ where
aesToRec (Balances_ {..}) =
map aesToRec balances'balance
data FundingAddress_ = FundingAddress_
{ fundingAdress'asset :: Types.Asset
, fundingAdress'address :: Text
, fundingAdress'total_received :: QuotedScientific
, fundingAdress'total_unconfirmed :: QuotedScientific
}
$(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"}
''FundingAddress_)
instance BitXAesRecordConvert Types.FundingAddress FundingAddress_ where
aesToRec (FundingAddress_ {..}) =
Types.FundingAddress {fundingAddressAsset = fundingAdress'asset,
fundingAddressAddress = fundingAdress'address,
fundingAddressTotalReceived = qsToScientific fundingAdress'total_received,
fundingAddressTotalUnconfirmed = qsToScientific fundingAdress'total_unconfirmed}
instance POSTEncodeable Types.Asset where
postEncode asset =
[("asset", showableToBytestring_ asset)]
data WithdrawalRequest_ = WithdrawalRequest_
{ withdrawalRequest'status :: RequestStatus_
, withdrawalRequest'id :: Text
}
$(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"}
''WithdrawalRequest_)
instance BitXAesRecordConvert Types.WithdrawalRequest WithdrawalRequest_ where
aesToRec (WithdrawalRequest_ {..}) =
Types.WithdrawalRequest {withdrawalRequestStatus = requestStatusParse withdrawalRequest'status,
withdrawalRequestId = withdrawalRequest'id}
data WithdrawalRequests_ = WithdrawalRequests_
{ withdrawalRequests'withdrawals :: [WithdrawalRequest_]
}
$(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"}
''WithdrawalRequests_)
instance BitXAesRecordConvert [Types.WithdrawalRequest] WithdrawalRequests_ where
aesToRec (WithdrawalRequests_ {..}) =
map aesToRec withdrawalRequests'withdrawals
instance POSTEncodeable Types.NewWithdrawal where
postEncode nwthd =
[("type", showableToBytestring_ (nwthd ^. Types.withdrawalType)),
("amount", showableToBytestring_ (nwthd ^. Types.amount))]
instance POSTEncodeable Types.BitcoinSendRequest where
postEncode 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 = ""
instance POSTEncodeable Types.QuoteRequest where
postEncode oreq =
[("type", showableToBytestring_ (oreq ^. Types.quoteType)),
("pair", showableToBytestring_ (oreq ^. Types.pair)),
("base_amount", showableToBytestring_ (oreq ^. Types.baseAmount))]
data OrderQuote_ = OrderQuote_
{ orderQuote'id :: Text
, orderQuote'type :: Types.QuoteType
, orderQuote'pair :: Types.CcyPair
, orderQuote'base_amount :: QuotedScientific
, orderQuote'counter_amount :: QuotedScientific
, 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 Types.OrderQuote OrderQuote_ where
aesToRec (OrderQuote_ {..}) =
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}
data BitXAuth_ = BitXAuth_
{ bitXAuth'api_key_id :: Text
, bitXAuth'api_key_secret :: Text
}
$(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"}
''BitXAuth_)
instance BitXAesRecordConvert Types.BitXAuth BitXAuth_ where
aesToRec (BitXAuth_ {..}) =
Types.BitXAuth {bitXAuthId = bitXAuth'api_key_id,
bitXAuthSecret = bitXAuth'api_key_secret}
data Transaction_ = Transaction_
{ transaction'row_index :: Int
, transaction'timestamp :: TimestampMS
, transaction'balance :: QuotedScientific
, transaction'available :: QuotedScientific
, transaction'balance_delta :: QuotedScientific
, transaction'available_delta :: QuotedScientific
, transaction'currency :: Types.Asset
, transaction'description :: Text
}
$(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"}
''Transaction_)
instance BitXAesRecordConvert Types.Transaction Transaction_ where
aesToRec (Transaction_ {..}) =
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}
data Transactions_ = Transactions_
{ transactions'transactions :: [Transaction_]
}
$(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"}
''Transactions_)
instance BitXAesRecordConvert [Types.Transaction] Transactions_ where
aesToRec (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_ {..}) =
PendingTransactions__ {pendingTransactions__transactions = map aesToRec transactions'pending}
data PendingTransactions__ = PendingTransactions__
{pendingTransactions__transactions :: [Types.Transaction]}
pendingTransactionsToTransactions :: PendingTransactions__ -> [Types.Transaction]
pendingTransactionsToTransactions (PendingTransactions__ tx) = tx
data Account_ = Account_
{ account'id :: Text
, account'name :: Text
, account'currency :: Types.Asset
}
$(AesTH.deriveFromJSON AesTH.defaultOptions{AesTH.fieldLabelModifier = last . splitOn "'"}
''Account_)
instance BitXAesRecordConvert Types.Account Account_ where
aesToRec (Account_ {..}) =
Types.Account {accountId = account'id,
accountName = account'name,
accountCurrency = account'currency}
instance POSTEncodeable Types.Account where
postEncode acc =
[("name", showableToBytestring_ (acc ^. Types.name)),
("currency", showableToBytestring_ (acc ^. Types.currency))]