coinbase-exchange-0.4.0.0: test/Coinbase/Exchange/Private/Test.hs
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
module Coinbase.Exchange.Private.Test
( tests
, giveAwayOrder
, run_placeOrder
) where
import Control.Monad
import Control.Monad.IO.Class
import Control.Concurrent
import Data.IORef
import Data.Maybe
import Data.List
import Data.Time
import Data.Scientific
import Data.UUID
import System.Random
import Test.Tasty
import Test.Tasty.HUnit
import Coinbase.Exchange.Private
import Coinbase.Exchange.Types
import Coinbase.Exchange.Types.Core
import Coinbase.Exchange.Types.Private
import Network.HTTP.Client.TLS
import Network.HTTP.Conduit
import System.Environment
import qualified Data.ByteString.Char8 as CBS
deriving instance Eq Order
tests :: ExchangeConf -> TestTree
tests conf = testGroup "Private"
[ testCase "getAccountList" (do as <- run_getAccountList conf
case as of
[] -> error "Received empty list of accounts"
_ -> return ()
)
, testCase "getUSDAccount" (do as <- run_getAccountList conf
let usdAccount = findUSDAccount as
ac <- run_getAccount conf (accId usdAccount)
assertEqual "accounts match" usdAccount ac
)
,testCase "getUSDAccountLedger" (do as <- run_getAccountList conf
let usdAccount = findUSDAccount as
es <- run_getAccountLedger conf (accId usdAccount)
case es of
[] -> assertFailure "Received empty list of ledger entries" -- must not be empty to test parser
_ -> return ()
)
, testCase "placeOrder" (do o <- creatNewLimitOrder
oid <- run_placeOrder conf o -- limit order
oid'<- run_placeOrder conf giveAwayOrder -- market order
return ()
)
, testCase "getOrderList" (do run_getOrderList conf [Open, Pending] -- making sure this request is well formed
os <- run_getOrderList conf []
case os of
[] -> assertFailure "Received empty order list"
_ -> return ()
)
, testCase "getOrder" (do no <- creatNewLimitOrder
oid <- run_placeOrder conf no
threadDelay 1000000 -- 1 second delay
o <- run_getOrder conf oid
assertEqual "order price" (noPrice no) (orderPrice o)
assertEqual "order size" (noSize no) (orderSize o)
assertEqual "order side" (noSide no) (orderSide o)
assertEqual "order product" (noProductId no) (orderProductId o)
)
, testCase "cancelOrder" (do no <- creatNewLimitOrder
threadDelay 4000000 -- 4 second delay, to run after other tests
oid <- run_placeOrder conf no
threadDelay 1000000 -- 1 second delay
os <- run_getOrderList conf [Open, Pending]
threadDelay 1000000 -- 1 second delay
run_cancelOrder conf oid
threadDelay 1000000 -- 1 second delay
os' <- run_getOrderList conf [Open, Pending]
case os \\ os' of
[o] -> do
assertEqual "order price" (noPrice no) (orderPrice o)
assertEqual "order size" (noSize no) (orderSize o)
assertEqual "order side" (noSide no) (orderSide o)
assertEqual "order product" (noProductId no) (orderProductId o)
[] -> assertFailure "order not canceled"
_ -> assertFailure "more than one order canceled"
)
, testCase "getFills" (do oid <- run_placeOrder conf giveAwayOrder
threadDelay 1000000 -- 1 second delay
fs <- run_getFills conf (Just oid) Nothing
case fs of
[] -> assertFailure "No fills found for an order that should execute immediately"
_ -> return ()
)
-------------------------- BTC TRANSFER TESTS --------------------------
-- CAREFULL ON LIVE ENVIRONMENT!!! TRANSFERS ARE IRREVERSIBLE!!!
-- This test cause a "403 Forbiden" error when run in the Sanbox. I'm not sure that can be fixed on my end.
, testCase "Withdraw BTCs" $
assertFailure "BTC withdrawal test Suspended for Safety"
-- (do
-- res <- run_withdrawBTC conf sampleTransfer
-- print res
-- return ()
-- )
--------------------------------------------------------------------------------
]
-----------------------------------------------
-- DO NOT USE!! CAREFUL!! THIS WILL TRY TO SEND YOUR BITCOINS TO THE SPECIFIED WALLET BELOW!
-- THIS MAY BE IRREVERSIBLE.
sampleTransfer :: CryptoWithdrawal
sampleTransfer = Withdrawal
{ wdAmount = 0.02
, wdCurrency = CurrencyId "BTC"
, wdCryptoAddress = BTCWallet (FromBTCAddress "INVALID-WALLET-INVALID-WALLET-INVA")
}
giveAwayOrder :: NewOrder
giveAwayOrder = NewMarketOrder
-- CAREFUL CHANGING THESE VALUES IF YOU PERFORM TESTING IN THE LIVE ENVIRONMENT. YOU MAY LOSE MONEY.
{ noProductId = "BTC-USD"
, noSide = Sell
, noSelfTrade = DecrementAndCancel
, noClientOid = Just $ ClientOrderId $ fromJust $ fromString "c2cc10e1-57d6-4b6f-9899-deadbeef2d8c"
, noSizeAndOrFunds = Right (Just 0.01, 5) -- at most 1 BTC cent or 5 dollars per test
}
creatNewLimitOrder :: IO NewOrder
creatNewLimitOrder = do
-- can't be deterministic because exchange is stateful
-- running a test twice with same random input may produce different results
sz <- randomRIO (0,9999)
-- CAREFUL CHANGING THESE VALUES IF YOU PERFORM TESTING IN THE LIVE ENVIRONMENT. YOU MAY LOOSE MONEY.
return NewLimitOrder
{ noSize = 0.01 + Size (CoinScientific $ fromInteger sz / 1000000 )
, noPrice = 10.36
, noProductId = "BTC-USD"
, noSide = Buy
, noSelfTrade = DecrementAndCancel
, noClientOid = Just $ ClientOrderId $ fromJust $ fromString "c2cc10e1-57d6-4b6f-9899-111122223d8c"
, noPostOnly = False
, noTimeInForce = GoodTillCanceled
, noCancelAfter = Nothing
}
findUSDAccount :: [Account] -> Account
findUSDAccount as = case filter (\a -> accCurrency a == CurrencyId "USD") as of
[a] -> a
[] -> error "no USD denominated account found"
_ -> error "more than one account denominated in USD found"
-----------------------------------------------
onSuccess :: ExchangeConf -> Exchange a -> String -> IO a
onSuccess conf apicall errorstring = do
r <- liftIO $ runExchange conf apicall
case r of
Left e -> print e >> error errorstring
Right a -> return a
run_getAccountList :: ExchangeConf -> IO [Account]
run_getAccountList conf = onSuccess conf getAccountList "Failed to get account list"
run_getAccount :: ExchangeConf -> AccountId -> IO Account
run_getAccount conf acID = onSuccess conf (getAccount acID) "Failed to get account info"
run_getAccountLedger :: ExchangeConf -> AccountId -> IO [Entry]
run_getAccountLedger conf acID = onSuccess conf (getAccountLedger acID) "Failed to get account ledger"
run_placeOrder :: ExchangeConf -> NewOrder -> IO OrderId
run_placeOrder conf o = onSuccess conf (createOrder o) "Failed to create order"
run_getOrder :: ExchangeConf -> OrderId -> IO Order
run_getOrder conf oid = onSuccess conf (getOrder oid) "Failed to get order info"
run_getOrderList :: ExchangeConf -> [OrderStatus] -> IO [Order]
run_getOrderList conf ss = onSuccess conf (getOrderList ss) "Failed to get order list"
run_cancelOrder :: ExchangeConf -> OrderId -> IO ()
run_cancelOrder conf oid = onSuccess conf (cancelOrder oid) "Failed to cancel order"
run_getFills :: ExchangeConf -> Maybe OrderId -> Maybe ProductId -> IO [Fill]
run_getFills conf moid mpid = onSuccess conf (getFills moid mpid) "Failed to get fills"
run_withdrawBTC :: ExchangeConf -> CryptoWithdrawal -> IO CryptoWithdrawalResp
run_withdrawBTC conf w = onSuccess conf (createCryptoWithdrawal w) "Failed to create withdrawal"