diff --git a/CHANGES.md b/CHANGES.md new file mode 100644 --- /dev/null +++ b/CHANGES.md @@ -0,0 +1,3 @@ +# 0.1.0.0 + +Initial release. The API is not yet complete, but there is enough to be useful. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright John David Reaver (c) 2015 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of John David Reaver nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,20 @@ +# oanda-rest-api + +[![Build Status](https://travis-ci.org/jdreaver/oanda-rest-api.svg)](https://travis-ci.org/jdreaver/oanda-rest-api) + +This library implements Haskell client to the +[OANDA REST API](http://developer.oanda.com/rest-live/introduction/). + +## Status + +There are still parts of the API that are not yet implemented. Here is the +status of each part of the API: + +* Rates: Mostly done, just need to refactor so the parameters are cleaner. +* Accounts: Done. +* Orders: Can only get a list of open orders. Can't yet create or modify + orders. +* Trades: Almost done, just need to add closing a trade. +* Positions: Done. +* Transaction History: Almost done. Could probably refactor the types to be + more specific, instead of putting `Maybe` everywhere. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/oanda-rest-api.cabal b/oanda-rest-api.cabal new file mode 100644 --- /dev/null +++ b/oanda-rest-api.cabal @@ -0,0 +1,81 @@ +name: oanda-rest-api +version: 0.1.0.0 +synopsis: Client to the OANDA REST API +description: Client to the OANDA REST API +homepage: http://github.com/jdreaver/oanda-rest-api +license: BSD3 +license-file: LICENSE +author: John David Reaver +maintainer: johndreaver@gmail.com +copyright: (c) 2015-2016 John David Reaver +category: API +build-type: Simple +stability: experimental +extra-source-files: README.md + , CHANGES.md +cabal-version: >=1.10 + +library + hs-source-dirs: src + ghc-options: -Wall + exposed-modules: OANDA + , OANDA.Accounts + , OANDA.Orders + , OANDA.Positions + , OANDA.Rates + , OANDA.Trades + , OANDA.Transactions + , OANDA.Types + other-modules: OANDA.Util + build-depends: base >= 4.7 && < 5 + , aeson >= 0.8.0 + , bytestring >= 0.10.0 + , containers >= 0.5.2 + , Decimal >= 0.4.2 + , lens >= 4.0 + , old-locale >= 1.0.0.6 + , scientific >= 0.3.3.0 + , text >= 1.2.0 + , time >= 1.4 + , vector >= 0.10.0 + , wreq >= 0.3.0.0 + default-language: Haskell2010 + + +test-suite tests + type: exitcode-stdio-1.0 + main-is: Spec.hs + build-depends: base >=4 && <5 + , aeson >= 0.8.0 + , bytestring >= 0.10.0 + , containers >= 0.5.2 + , Decimal >= 0.4.2 + , lens >= 4.0 + , old-locale >= 1.0.0.6 + , scientific >= 0.3.3.0 + , text >= 1.2.0 + , time >= 1.4 + , vector >= 0.10.0 + , wreq >= 0.3.0.0 + + , hspec ==2.* + , HUnit -any + default-language: Haskell2010 + hs-source-dirs: src tests + ghc-prof-options: -prof -fprof-auto + ghc-options: -Wall + + +test-suite style + type: exitcode-stdio-1.0 + main-is: HLint.hs + build-depends: base -any + , hlint ==1.* + default-language: Haskell2010 + hs-source-dirs: tests + ghc-options: -Wall + + +source-repository head + type: git + location: https://github.com/jdreaver/oanda-rest-api diff --git a/src/OANDA.hs b/src/OANDA.hs new file mode 100644 --- /dev/null +++ b/src/OANDA.hs @@ -0,0 +1,19 @@ +module OANDA + ( module OANDA.Rates + , module OANDA.Accounts + , module OANDA.Orders + , module OANDA.Positions + , module OANDA.Trades + , module OANDA.Transactions + , module OANDA.Types + ) where + +import OANDA.Accounts +import OANDA.Orders +import OANDA.Positions +import OANDA.Rates +import OANDA.Trades +import OANDA.Transactions +import OANDA.Types + +{-# ANN module "HLint: ignore Use import/export shortcut" #-} diff --git a/src/OANDA/Accounts.hs b/src/OANDA/Accounts.hs new file mode 100644 --- /dev/null +++ b/src/OANDA/Accounts.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Defines the endpoints listed in the +-- section of the +-- API. + +module OANDA.Accounts + ( Account (..) + , accounts + , AccountInfo (..) + , accountInfo + ) where + +import Data.Aeson +import Data.Decimal +import qualified Data.Vector as V +import GHC.Generics (Generic) + +import OANDA.Util +import OANDA.Types + + +-- | Wraps the JSON response for accounts +data Account = Account + { accountAccountId :: Int + , accountAccountName :: String + , accountAccountCurrency :: String + , accountMarginRate :: Decimal + } deriving (Show, Generic) + +instance FromJSON Account where + parseJSON = genericParseJSON $ jsonOpts "account" + +-- | Get all accounts for given access token +accounts :: OandaEnv -> IO (V.Vector Account) +accounts od = do + let url = baseURL od ++ "/v1/accounts" + opts = constructOpts od [] + jsonResponseArray url opts "accounts" + + +-- | Get all account info associated with an account ID. +accountInfo :: OandaEnv -> AccountID -> IO AccountInfo +accountInfo od (AccountID aid) = + do let url = baseURL od ++ "/v1/accounts/" ++ show aid + opts = constructOpts od [] + jsonResponse url opts + + +data AccountInfo = AccountInfo + { accountInfoAccountId :: Integer + , accountInfoAccountName :: String + , accountInfoBalance :: Decimal + , accountInfoUnrealizedPl :: Decimal + , accountInfoRealizedPl :: Decimal + , accountInfoMarginUsed :: Decimal + , accountInfoMarginAvail :: Decimal + , accountInfoOpenTrades :: Integer + , accountInfoOpenOrders :: Integer + , accountInfoMarginRate :: Decimal + , accountInfoAccountCurrency :: String + } deriving (Show, Generic) + +instance FromJSON AccountInfo where + parseJSON = genericParseJSON $ jsonOpts "accountInfo" diff --git a/src/OANDA/Orders.hs b/src/OANDA/Orders.hs new file mode 100644 --- /dev/null +++ b/src/OANDA/Orders.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE DeriveGeneric #-} + +-- | Defines the endpoints listed in the +-- section of the API. + + +module OANDA.Orders + ( openOrders + , Order (..) + ) where + + +import Data.Aeson +import Data.Decimal +import Data.Time (ZonedTime) +import qualified Data.Vector as V +import GHC.Generics (Generic) + +import OANDA.Types +import OANDA.Util + + +-- | Get all open orders for an account. +openOrders :: OandaEnv -> AccountID -> IO (V.Vector Order) +openOrders od (AccountID aid) = + do let url = baseURL od ++ "/v1/accounts/" ++ show aid ++ "/orders" + opts = constructOpts od [] + jsonResponseArray url opts "orders" + + +data Order = Order + { orderId :: Integer + , orderInstrument :: InstrumentText + , orderUnits :: Integer + , orderSide :: Side + , orderType :: String -- "marketIfTouched", + , orderTime :: ZonedTime + , orderPrice :: Decimal + , orderTakeProfit :: Decimal + , orderStopLoss :: Decimal + , orderExpiry :: ZonedTime + , orderUpperBound :: Decimal + , orderLowerBound :: Decimal + , orderTrailingStop :: Decimal + } deriving (Show, Generic) + + +instance FromJSON Order where + parseJSON = genericParseJSON $ jsonOpts "order" diff --git a/src/OANDA/Positions.hs b/src/OANDA/Positions.hs new file mode 100644 --- /dev/null +++ b/src/OANDA/Positions.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Defines the endpoints listed in the +-- section of the +-- API. + +module OANDA.Positions + ( Position (..) + , openPositions + , position + , closePosition + , CloseResponse (..) + ) where + +import Data.Aeson +import Data.Decimal +import Data.Text (unpack) +import qualified Data.Vector as V +import GHC.Generics (Generic) + +import OANDA.Util +import OANDA.Types + +-- | Get all open positions for an account. +openPositions :: OandaEnv -> AccountID -> IO (V.Vector Position) +openPositions od (AccountID aid) = + do let url = baseURL od ++ "/v1/accounts/" ++ show aid ++ "/positions" + opts = constructOpts od [] + jsonResponseArray url opts "positions" + +data Position = Position + { positionInstrument :: String + , positionUnits :: Int + , positionSide :: Side + , positionAvgPrice :: Decimal + } deriving (Show, Generic) + +instance FromJSON Position where + parseJSON = genericParseJSON $ jsonOpts "position" + + +-- | Get open position for an account on a given instrument. +position :: OandaEnv -> AccountID -> InstrumentText -> IO Position +position od (AccountID aid) ins = + do let url = baseURL od ++ "/v1/accounts/" ++ show aid ++ "/positions/" ++ unpack ins + opts = constructOpts od [] + jsonResponse url opts + + +-- | Closes an existing position. +closePosition :: OandaEnv -> AccountID -> InstrumentText -> IO CloseResponse +closePosition od (AccountID aid) ins = + do let url = baseURL od ++ "/v1/accounts/" ++ show aid ++ "/positions/" ++ unpack ins + opts = constructOpts od [] + jsonDelete url opts + + +data CloseResponse = CloseResponse + { closeResponseIds :: V.Vector Int + , closeResponseInstrument :: InstrumentText + , closeResponseTotalUnits :: Int + , closeResponsePrice :: Decimal + } deriving (Show, Generic) + + +instance FromJSON CloseResponse where + parseJSON = genericParseJSON $ jsonOpts "closeResponse" diff --git a/src/OANDA/Rates.hs b/src/OANDA/Rates.hs new file mode 100644 --- /dev/null +++ b/src/OANDA/Rates.hs @@ -0,0 +1,214 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Defines the endpoints listed in the +-- section of the API. + +module OANDA.Rates + ( InstrumentsArgs (..) + , instrumentsArgs + , Instrument (..) + , instruments + , Price (..) + , prices + , MidpointCandlestick (..) + , midpointCandles + , BidAskCandlestick (..) + , bidaskCandles + , CandlesArgs (..) + , candlesArgs + , CandlesCount (..) + , DayOfWeek (..) + , Granularity (..) + ) where + +import Data.Aeson +import Data.Char (toLower) +import Data.Decimal +import Data.Text (Text, pack) +import Data.Time +import qualified Data.Vector as V +import GHC.Generics (Generic) +import Network.Wreq (Options) + +import OANDA.Util +import OANDA.Types + + +data InstrumentsArgs = InstrumentsArgs + { instrumentsFields :: [Text] + , instrumentsInstruments :: [Text] + } deriving (Show) + +instrumentsArgs :: InstrumentsArgs +instrumentsArgs = InstrumentsArgs ["displayName", "pip", "maxTradeUnits"] [] + +data Instrument = Instrument + { instrumentInstrument :: String + , instrumentPip :: Maybe Decimal + , instrumentMaxTradeUnits :: Maybe Integer + , instrumentDisplayName :: Maybe String + , instrumentPrecision :: Maybe Decimal + , instrumentMaxTrailingStop :: Maybe Decimal + , instrumentMinTrailingStop :: Maybe Decimal + , instrumentMarginRate :: Maybe Decimal + , instrumentHalted :: Maybe String + , instrumentInterestRate :: Maybe Decimal + } deriving (Show, Generic) + +instance FromJSON Instrument where + parseJSON = genericParseJSON $ jsonOpts "instrument" + +-- | Retrieve a list of instruments from OANDA +instruments :: OandaEnv -> AccountID -> InstrumentsArgs -> IO (V.Vector Instrument) +instruments od (AccountID aid) (InstrumentsArgs fs is) = do + let url = baseURL od ++ "/v1/instruments" + opts = constructOpts od [ ("accountId", [pack $ show aid]) + , ("instruments", is) + , ("fields", fs) + ] + jsonResponseArray url opts "instruments" + + +-- | Retrieve the current prices for a list of instruments. +prices :: OandaEnv -> [InstrumentText] -> Maybe ZonedTime -> IO (V.Vector Price) +prices od is zt = + do let url = baseURL od ++ "/v1/prices" + ztOpt = maybe [] (\zt' -> [("since", [pack $ formatTimeRFC3339 zt'])]) zt + opts = constructOpts od $ ("instruments", is) : ztOpt + + jsonResponseArray url opts "prices" + +data Price = Price + { priceInstrument :: InstrumentText + , priceTime :: ZonedTime + , priceBid :: Decimal + , priceAsk :: Decimal + } deriving (Show, Generic) + +instance FromJSON Price where + parseJSON = genericParseJSON $ jsonOpts "price" + + +-- | Retrieve the price history of a single instrument in midpoint candles +midpointCandles :: OandaEnv -> InstrumentText -> CandlesArgs -> + IO (V.Vector MidpointCandlestick) +midpointCandles od i args = + do let (url, opts) = candleOpts od i args "midpoint" + response <- jsonResponse url opts :: IO MidpointCandlesResponse + return $ _midcandlesResponseCandles response + +-- | Retrieve the price history of a single instrument in bid/ask candles +bidaskCandles :: OandaEnv -> InstrumentText -> CandlesArgs -> + IO (V.Vector BidAskCandlestick) +bidaskCandles od i args = + do let (url, opts) = candleOpts od i args "bidask" + response <- jsonResponse url opts :: IO BidAskCandlesResponse + return $ _bidaskResponseCandles response + + +-- | Utility function for both candle history functions +candleOpts :: OandaEnv -> InstrumentText -> CandlesArgs -> String -> (String, Options) +candleOpts od i (CandlesArgs c g di atz wa) fmt = (url, opts) + where url = baseURL od ++ "/v1/candles" + opts = constructOpts od $ [ ("instrument", [i]) + , ("granularity", [pack $ show g]) + , ("candleFormat", [pack fmt]) + , ("dailyAlignment", [pack $ show di]) + , ("alignmentTimeZone", [pack atz]) + , ("weeklyAlignment", [pack $ show wa]) + ] ++ countOpts c + countOpts (Count count) = [("count", [pack $ show count])] + countOpts (StartEnd st ed incf) = [ ("start", [pack $ formatTimeRFC3339 st]) + , ("end", [pack $ formatTimeRFC3339 ed]) + , ("includeFirst", [pack $ map toLower (show incf)]) + ] + +data MidpointCandlestick = MidpointCandlestick + { midpointCandlestickTime :: ZonedTime + , midpointCandlestickOpenMid :: Decimal + , midpointCandlestickHighMid :: Decimal + , midpointCandlestickLowMid :: Decimal + , midpointCandlestickCloseMid :: Decimal + , midpointCandlestickVolume :: Int + , midpointCandlestickComplete :: Bool + } deriving (Show, Generic) + +instance FromJSON MidpointCandlestick where + parseJSON = genericParseJSON $ jsonOpts "midpointCandlestick" + + +data BidAskCandlestick = BidAskCandlestick + { bidaskCandlestickTime :: ZonedTime + , bidaskCandlestickOpenBid :: Decimal + , bidaskCandlestickOpenAsk :: Decimal + , bidaskCandlestickHighBid :: Decimal + , bidaskCandlestickHighAsk :: Decimal + , bidaskCandlestickLowBid :: Decimal + , bidaskCandlestickLowAsk :: Decimal + , bidaskCandlestickCloseBid :: Decimal + , bidaskCandlestickCloseAsk :: Decimal + , bidaskCandlestickVolume :: Int + , bidaskCandlestickComplete :: Bool + } deriving (Show, Generic) + +instance FromJSON BidAskCandlestick where + parseJSON = genericParseJSON $ jsonOpts "bidaskCandlestick" + +data CandlesArgs = CandlesArgs + { candlesCount :: CandlesCount + , candlesGranularity :: Granularity + , candlesDailyAlignment :: Int + , candlesAlignmentTZ :: String + , candlesWeeklyAlignment :: DayOfWeek + } deriving (Show) + +candlesArgs :: CandlesArgs +candlesArgs = CandlesArgs (Count 500) S5 17 "America/New_York" Friday + +data CandlesCount = Count Int + | StartEnd { start :: ZonedTime + , end :: ZonedTime + , includeFirst :: Bool + } + deriving (Show) + +data DayOfWeek = Monday + | Tuesday + | Wednesday + | Thursday + | Friday + | Saturday + | Sunday + deriving (Show) + +data Granularity = S5 | S10 | S15 | S30 + | M1 | M2 | M3 | M4 | M5 | M10 | M15 | M30 + | H1 | H2 | H3 | H4 | H6 | H8 | H12 + | D + | W + | M + deriving (Show) + +-- | Utility type for `midpointCandles` function response. Not exported. +data MidpointCandlesResponse = MidpointCandlesResponse + { _midcandlesResponseInstrument :: InstrumentText + , _midcandlesResponseGranularity :: String + , _midcandlesResponseCandles :: V.Vector MidpointCandlestick + } deriving (Show, Generic) + + +instance FromJSON MidpointCandlesResponse where + parseJSON = genericParseJSON $ jsonOpts "_midcandlesResponse" + + +-- | Utility type for `bidaskCandles` function response. Not exported. +data BidAskCandlesResponse = BidAskCandlesResponse + { _bidaskResponseInstrument :: InstrumentText + , _bidaskResponseGranularity :: String + , _bidaskResponseCandles :: V.Vector BidAskCandlestick + } deriving (Show, Generic) + + +instance FromJSON BidAskCandlesResponse where + parseJSON = genericParseJSON $ jsonOpts "_bidaskResponse" diff --git a/src/OANDA/Trades.hs b/src/OANDA/Trades.hs new file mode 100644 --- /dev/null +++ b/src/OANDA/Trades.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE DeriveGeneric #-} + +-- | Defines the endpoints listed in the +-- section of the +-- API. + +module OANDA.Trades + ( Trade (..) + , openTrades + , tradeInfo + ) where + +import Data.Aeson +import Data.Decimal +import Data.Time (ZonedTime) +import qualified Data.Vector as V +import GHC.Generics (Generic) + +import OANDA.Types +import OANDA.Util + +data Trade = Trade + { tradeId :: !Int + , tradeUnits :: !Int + , tradeSide :: !Side + , tradeInstrument :: !String + , tradeTime :: !ZonedTime + , tradePrice :: !Decimal + , tradeTakeProfit :: !Decimal + , tradeStopLoss :: !Decimal + , tradeTrailingStop :: !Decimal + , tradeTrailingAmount :: !Decimal + } deriving (Show, Generic) + +instance FromJSON Trade where + parseJSON = genericParseJSON $ jsonOpts "trade" + +-- | Gets a list of all open trades in an account. +openTrades :: OandaEnv -> AccountID -> IO (V.Vector Trade) +openTrades od (AccountID aid) = + do let url = baseURL od ++ "/v1/accounts/" ++ show aid ++ "/trades" + opts = constructOpts od [] + jsonResponseArray url opts "trades" + + +type TradeID = Int + +-- | Get info for a specific trade. +tradeInfo :: OandaEnv -> AccountID -> TradeID -> IO Trade +tradeInfo od (AccountID aid) tid = + do let url = baseURL od ++ "/v1/accounts/" ++ show aid ++ "/trades/" ++ show tid + opts = constructOpts od [] + jsonResponse url opts diff --git a/src/OANDA/Transactions.hs b/src/OANDA/Transactions.hs new file mode 100644 --- /dev/null +++ b/src/OANDA/Transactions.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Defines the endpoints listed in the +-- section of the API. + +module OANDA.Transactions + ( Transaction (..) + , transactionHistory + ) where + +import Data.Aeson +import Data.Decimal +import Data.Time (ZonedTime) +import qualified Data.Vector as V +import GHC.Generics (Generic) + +import OANDA.Types +import OANDA.Util + +-- data TransactionArgs = TransactionArgs +-- { transactionsMaxID :: Maybe Integer +-- , transactionsMinID :: Maybe Integer +-- , transactionsCount :: Maybe Integer +-- , transactionsInstrument :: Maybe InstrumentText +-- , transactionsIds :: [Integer] +-- } deriving (Show) + +-- | Get a list of transactions for the account. +transactionHistory :: OandaEnv -> AccountID -> IO (V.Vector Transaction) +transactionHistory od (AccountID aid) = + do let url = baseURL od ++ "/v1/accounts/" ++ show aid ++ "/transactions" + opts = constructOpts od [] + jsonResponseArray url opts "transactions" + + +data Transaction = Transaction + { transactionId :: Integer + , transactionAccountId :: Integer + , transactionTime :: ZonedTime + , transactionType :: String -- Can be an enum type in the future + , transactionInstrument :: Maybe InstrumentText + , transactionSide :: Maybe Side + , transactionUnits :: Maybe Decimal + , transactionPrice :: Maybe Decimal + , transactionLowerBound :: Maybe Decimal + , transactionUpperBound :: Maybe Decimal + , transactionTakeProfitPrice :: Maybe Decimal + , transactionStopLossPrice :: Maybe Decimal + , transactionTrailingStopLossDistance :: Maybe Decimal + , transactionPL :: Maybe Decimal + , transactionInterest :: Maybe Decimal + , transactionAccountBalance :: Maybe Decimal + } deriving (Show, Generic) + + +instance FromJSON Transaction where + parseJSON = genericParseJSON $ jsonOpts "transaction" diff --git a/src/OANDA/Types.hs b/src/OANDA/Types.hs new file mode 100644 --- /dev/null +++ b/src/OANDA/Types.hs @@ -0,0 +1,92 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Defines types used in the REST API + +module OANDA.Types + ( OandaEnv + , apiType + , accessToken + , sandboxAuth + , practiceAuth + , liveAuth + , APIType (..) + , apiEndpoint + , AccessToken (..) + , AccountID (..) + , Side (..) + , InstrumentText + ) where + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative (pure) +#endif + +import Control.Monad (mzero) +import Data.Aeson +import Data.ByteString (ByteString) +import Data.Text (Text, unpack) +import GHC.Generics (Generic) + + +-- | Wraps an `APIType` and an `AccessToken`. Mainly just a convenience wrapper +-- to make functions have fewer arguments. To instantiate this type, use the +-- `sandboxAuth`, `practiceAuth`, or `liveAuth` functions. +data OandaEnv = OandaEnv + { apiType :: APIType + , accessToken :: Maybe AccessToken + } deriving (Show) + +-- | Use the sandbox API. +sandboxAuth :: OandaEnv +sandboxAuth = OandaEnv Sandbox Nothing + +-- | Use the practice API. +practiceAuth :: AccessToken -> OandaEnv +practiceAuth = OandaEnv Practice . Just + +-- | Use the live API. +liveAuth :: AccessToken -> OandaEnv +liveAuth = OandaEnv Live . Just + + +-- | The three endpoint types used in the REST API. See the following link for +-- details: +data APIType = Sandbox + | Practice + | Live + deriving (Show) + +-- | Specifies the endpoints for each `APIType`. These are the base URLs for +-- each API call. +apiEndpoint :: APIType -> String +apiEndpoint Sandbox = "http://api-sandbox.oanda.com" +apiEndpoint Practice = "https://api-fxpractice.oanda.com" +apiEndpoint Live = "https://api-fxtrade.oanda.com" + +-- | The token given by OANDA used to access the API +newtype AccessToken = AccessToken { unAccessToken :: ByteString } + deriving (Show) + + +-- | Integer representing the Account ID of an account +newtype AccountID = AccountID { unAccountID :: Int} + deriving (Show) + +-- | Used when reporting a position in the API +data Side = Buy + | Sell + deriving (Show, Generic) + +instance FromJSON Side where + parseJSON (String s) = fmap readSide (pure $ unpack s) + parseJSON _ = mzero + + +readSide :: String -> Side +readSide "buy" = Buy +readSide "sell" = Sell +readSide _ = error "No parse Side" + +type InstrumentText = Text diff --git a/src/OANDA/Util.hs b/src/OANDA/Util.hs new file mode 100644 --- /dev/null +++ b/src/OANDA/Util.hs @@ -0,0 +1,111 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +-- | Utility functions. + +module OANDA.Util + ( constructOpts + , baseURL + , makeParams + , commaList + , jsonOpts + , jsonResponse + , jsonResponseArray + , jsonDelete + , formatTimeRFC3339 + ) where + + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative (Applicative, pure) +import System.Locale (defaultTimeLocale) +#endif + +import Control.Lens +import Data.Aeson +import qualified Data.Aeson.TH as TH +import Data.ByteString (append) +import Data.Char (toLower) +import Data.Decimal +import qualified Data.Map as Map +import Data.Monoid ( +#if !MIN_VERSION_base(4,8,0) + mempty, +#endif + (<>)) +import Data.Scientific +import Data.Text (Text, intercalate, unpack) +import Data.Time +import Network.Wreq + +import OANDA.Types + +-- | Convenience wrapper around `apiEndpoint`. +baseURL :: OandaEnv -> String +baseURL env = apiEndpoint (apiType env) + +-- | Create options for Wreq `getWith` using access token and params. +constructOpts :: OandaEnv -> [(Text, [Text])] -> Options +constructOpts env = constructOpts' (accessToken env) + +constructOpts' :: Maybe AccessToken -> [(Text, [Text])] -> Options +constructOpts' maybeTok ps = defaults & params' & header' + where params' = makeParams ps + header' = maybe id makeHeader maybeTok + makeHeader (AccessToken t) = header "Authorization" .~ ["Bearer " `append` t] + + +-- | Create a valid list of params for wreq. +makeParams :: [(Text, [Text])] -> Options -> Options +makeParams xs = params .~ params' + where params' = [(name, commaList p) | (name, p) <- xs] + + +-- | Convert a Maybe [Text] item into empty text or comma-separated text. +commaList :: [Text] -> Text +commaList = intercalate "," + + +-- | Used to derive FromJSON instances. +jsonOpts :: String -> TH.Options +jsonOpts s = TH.defaultOptions { TH.fieldLabelModifier = firstLower . drop (length s) } + where firstLower [] = [] + firstLower (x:xs) = toLower x : xs + +-- | Boilerplate function to perform a request and extract the response body. +jsonResponse :: (FromJSON a) => String -> Options -> IO a +jsonResponse url opts = + do r <- asJSON =<< getWith opts url + return $ r ^. responseBody + +-- | Boilerplate function to perform a request and extract the response body. +jsonResponseArray :: (FromJSON a) => String -> Options -> String -> IO a +jsonResponseArray url opts name = + do body <- jsonResponse url opts + return $ body Map.! (name :: String) + +jsonDelete :: (FromJSON a) => String -> Options -> IO a +jsonDelete url opts = + do r <- asJSON =<< deleteWith opts url + return $ r ^. responseBody + +-- | Formats time according to RFC3339 (which is the time format used by +-- OANDA). Taken from the library. +formatTimeRFC3339 :: ZonedTime -> String +formatTimeRFC3339 zt@(ZonedTime _ z) = formatTime defaultTimeLocale "%FT%T" zt <> printZone + where timeZoneStr = timeZoneOffsetString z + printZone = if timeZoneStr == timeZoneOffsetString utc + then "Z" + else take 3 timeZoneStr <> ":" <> drop 3 timeZoneStr + + +instance (Integral a) => FromJSON (DecimalRaw a) where + parseJSON (Number n) = readDecimalJSON n + parseJSON (String s) = readDecimalJSON (read (unpack s)) + parseJSON _ = mempty + + +readDecimalJSON :: (Num i, Applicative f) => Scientific -> f (DecimalRaw i) +readDecimalJSON n = pure $ Decimal ((*) (-1) $ fromIntegral $ base10Exponent n) + (fromIntegral $ coefficient n) diff --git a/tests/HLint.hs b/tests/HLint.hs new file mode 100644 --- /dev/null +++ b/tests/HLint.hs @@ -0,0 +1,16 @@ +module Main (main) where + +import Language.Haskell.HLint (hlint) +import System.Exit (exitFailure, exitSuccess) + +arguments :: [String] +arguments = + [ "--cpp-simple" + , "src" + , "tests" + ] + +main :: IO () +main = do + hints <- hlint arguments + if null hints then exitSuccess else exitFailure diff --git a/tests/Spec.hs b/tests/Spec.hs new file mode 100644 --- /dev/null +++ b/tests/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}