diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,24 @@ -# 0.1.0.0 +# Changelog + +## 0.3.0.0 + +- Prefer `Text` instead of `String` for arguments. We still use `String` in + endpoints since that is what `wreq` uses. +- Use `http-conduit` instead of `wreq` + +## 0.2.0.0 + +- Use thyme instead of time. Thyme uses a much more efficient representation of + time stamps. Note that thyme has a module called Data.Thyme.Time that + provides wrappers and conversion functions to and from time types. +- Added a convenient `granularityToDiffTime` to convert from `Granularity` to + `NominalDiffTime`. +- Fixed not being able to use a start/end time in conjunction with a count for + the candlestick endpoints. +- Use true optional arguments using `Maybe`. This fixes some endpoints breaking + when empty lists were passed, and also makes it so we don't have to hard-code + defaults. + +## 0.1.0.0 Initial release. The API is not yet complete, but there is enough to be useful. diff --git a/oanda-rest-api.cabal b/oanda-rest-api.cabal --- a/oanda-rest-api.cabal +++ b/oanda-rest-api.cabal @@ -1,81 +1,124 @@ -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 +-- This file has been generated from package.yaml by hpack version 0.15.0. +-- +-- see: https://github.com/sol/hpack +name: oanda-rest-api +version: 0.3.0.0 +synopsis: Client to the OANDA REST API +description: Client to the OANDA REST API +category: API +stability: experimental +homepage: https://github.com/jdreaver/oanda-rest-api#readme +bug-reports: https://github.com/jdreaver/oanda-rest-api/issues +author: John David Reaver +maintainer: johndreaver@gmail.com +copyright: (c) 2015-2016 John David Reaver +license: BSD3 +license-file: LICENSE +build-type: Simple +cabal-version: >= 1.10 -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 +extra-source-files: + CHANGES.md + README.md + stack.yaml - , hspec ==2.* - , HUnit -any - default-language: Haskell2010 - hs-source-dirs: src tests - ghc-prof-options: -prof -fprof-auto - ghc-options: -Wall +source-repository head + type: git + location: https://github.com/jdreaver/oanda-rest-api +library + hs-source-dirs: + src + ghc-options: -Wall + build-depends: + base >= 4.7 && < 5 + , aeson >= 0.8.0 + , bytestring >= 0.10.0 + , containers >= 0.5.2 + , Decimal >= 0.4.2 + , http-conduit + , lens >= 4.0 + , old-locale >= 1.0.0.6 + , scientific >= 0.3.3.0 + , text >= 1.2.0 + , thyme + , vector >= 0.10.0 + exposed-modules: + OANDA + OANDA.Accounts + OANDA.Environment + OANDA.Orders + OANDA.Positions + OANDA.Rates + OANDA.Trades + OANDA.Transactions + other-modules: + OANDA.Internal + OANDA.Internal.Import + OANDA.Internal.Request + OANDA.Internal.Types + default-language: Haskell2010 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 - + type: exitcode-stdio-1.0 + main-is: HLint.hs + hs-source-dirs: + tests + ghc-options: -Wall + build-depends: + base >= 4.7 && < 5 + , aeson >= 0.8.0 + , bytestring >= 0.10.0 + , containers >= 0.5.2 + , Decimal >= 0.4.2 + , http-conduit + , lens >= 4.0 + , old-locale >= 1.0.0.6 + , scientific >= 0.3.3.0 + , text >= 1.2.0 + , thyme + , vector >= 0.10.0 + , hlint + other-modules: + Spec + default-language: Haskell2010 -source-repository head - type: git - location: https://github.com/jdreaver/oanda-rest-api +test-suite tests + type: exitcode-stdio-1.0 + main-is: Spec.hs + hs-source-dirs: + src + , tests + ghc-options: -Wall + build-depends: + base >= 4.7 && < 5 + , aeson >= 0.8.0 + , bytestring >= 0.10.0 + , containers >= 0.5.2 + , Decimal >= 0.4.2 + , http-conduit + , lens >= 4.0 + , old-locale >= 1.0.0.6 + , scientific >= 0.3.3.0 + , text >= 1.2.0 + , thyme + , vector >= 0.10.0 + , oanda-rest-api + , hspec + , HUnit + other-modules: + OANDA + OANDA.Accounts + OANDA.Environment + OANDA.Internal + OANDA.Internal.Import + OANDA.Internal.Request + OANDA.Internal.Types + OANDA.Orders + OANDA.Positions + OANDA.Rates + OANDA.Trades + OANDA.Transactions + HLint + default-language: Haskell2010 diff --git a/src/OANDA.hs b/src/OANDA.hs --- a/src/OANDA.hs +++ b/src/OANDA.hs @@ -1,19 +1,11 @@ module OANDA - ( module OANDA.Rates - , module OANDA.Accounts - , module OANDA.Orders - , module OANDA.Positions - , module OANDA.Trades - , module OANDA.Transactions - , module OANDA.Types + ( module X ) 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" #-} +import OANDA.Accounts as X +import OANDA.Environment as X +import OANDA.Orders as X +import OANDA.Positions as X +import OANDA.Rates as X +import OANDA.Trades as X +import OANDA.Transactions as X diff --git a/src/OANDA/Accounts.hs b/src/OANDA/Accounts.hs --- a/src/OANDA/Accounts.hs +++ b/src/OANDA/Accounts.hs @@ -6,26 +6,21 @@ -- API. module OANDA.Accounts - ( Account (..) - , accounts - , AccountInfo (..) - , accountInfo - ) where + ( 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 - +import OANDA.Internal -- | Wraps the JSON response for accounts data Account = Account { accountAccountId :: Int - , accountAccountName :: String - , accountAccountCurrency :: String + , accountAccountName :: Text + , accountAccountCurrency :: Text , accountMarginRate :: Decimal } deriving (Show, Generic) @@ -35,22 +30,22 @@ -- | 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" + let url = "GET " ++ baseURL od ++ "/v1/accounts" + request <- constructRequest od url [] + jsonResponseArray request "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 +accountInfo od (AccountID aid) = do + let url = "GET " ++ baseURL od ++ "/v1/accounts/" ++ show aid + request <- constructRequest od url [] + jsonResponse request data AccountInfo = AccountInfo { accountInfoAccountId :: Integer - , accountInfoAccountName :: String + , accountInfoAccountName :: Text , accountInfoBalance :: Decimal , accountInfoUnrealizedPl :: Decimal , accountInfoRealizedPl :: Decimal @@ -59,7 +54,7 @@ , accountInfoOpenTrades :: Integer , accountInfoOpenOrders :: Integer , accountInfoMarginRate :: Decimal - , accountInfoAccountCurrency :: String + , accountInfoAccountCurrency :: Text } deriving (Show, Generic) instance FromJSON AccountInfo where diff --git a/src/OANDA/Environment.hs b/src/OANDA/Environment.hs new file mode 100644 --- /dev/null +++ b/src/OANDA/Environment.hs @@ -0,0 +1,17 @@ +-- | Definition of types used to set up the API. + +module OANDA.Environment + ( OandaEnv + , apiType + , accessToken + , sandboxAuth + , practiceAuth + , liveAuth + , APIType (..) + , AccessToken (..) + , AccountID (..) + , Side (..) + , InstrumentText + ) where + +import OANDA.Internal diff --git a/src/OANDA/Internal.hs b/src/OANDA/Internal.hs new file mode 100644 --- /dev/null +++ b/src/OANDA/Internal.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +-- | Utility functions. + +module OANDA.Internal + ( module X + ) where + +import OANDA.Internal.Import as X +import OANDA.Internal.Request as X +import OANDA.Internal.Types as X diff --git a/src/OANDA/Internal/Import.hs b/src/OANDA/Internal/Import.hs new file mode 100644 --- /dev/null +++ b/src/OANDA/Internal/Import.hs @@ -0,0 +1,35 @@ +-- | Common imports used throughout the library. Easier to just put them in one +-- spot. + +module OANDA.Internal.Import + ( module X + , (.~) + , (^.) + , (&) + , mzero + , toLower + , catMaybes + , Text + , intercalate + , unpack + , pack + , Generic + , defaultTimeLocale + , (<>) + ) where + +import Control.Lens ((.~), (^.), (&)) +import Control.Monad (mzero) +import Data.Aeson as X +import Data.Char (toLower) +import Data.Decimal as X +import Data.Maybe (catMaybes) +import Data.Monoid ((<>)) +import Data.Scientific as X +import Data.Text (Text, intercalate, unpack, pack) +import Data.Text.Encoding as X +import Data.Thyme as X +import Data.Thyme.Format.Aeson as X () +import GHC.Generics (Generic) +import Network.HTTP.Simple as X +import System.Locale (defaultTimeLocale) diff --git a/src/OANDA/Internal/Request.hs b/src/OANDA/Internal/Request.hs new file mode 100644 --- /dev/null +++ b/src/OANDA/Internal/Request.hs @@ -0,0 +1,84 @@ +{-# LANGUAGE OverloadedStrings #-} + +{-# OPTIONS_GHC -fno-warn-orphans #-} + +-- | Internal module for dealing with requests via wreq + +module OANDA.Internal.Request + ( constructRequest + , baseURL + , commaList + , jsonOpts + , jsonResponse + , jsonResponseArray + -- , jsonDelete + , formatTimeRFC3339 + ) where + +import qualified Data.Aeson.TH as TH +import qualified Data.ByteString as BS +import qualified Data.Map as Map + +import OANDA.Internal.Import +import OANDA.Internal.Types + +-- | Specifies the endpoints for each `APIType`. These are the base URLs for +-- each API call. +baseURL :: OandaEnv -> String +baseURL env = apiEndpoint (apiType env) + where apiEndpoint Sandbox = "http://api-sandbox.oanda.com" + apiEndpoint Practice = "https://api-fxpractice.oanda.com" + apiEndpoint Live = "https://api-fxtrade.oanda.com" + +constructRequest :: OandaEnv -> String -> [(Text, Maybe [Text])] -> IO Request +constructRequest env url params = do + initRequest <- parseRequest url + return $ + initRequest + & maybe id makeAuthHeader (accessToken env) + & setRequestQueryString params' + where + makeAuthHeader (AccessToken t) = addRequestHeader "Authorization" ("Bearer " `BS.append` t) + paramToMaybe (name, Just xs') = Just (encodeUtf8 name, Just $ encodeUtf8 $ commaList xs') + paramToMaybe (_, Nothing) = Nothing + params' = catMaybes $ fmap paramToMaybe params + +-- | 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) => Request -> IO a +jsonResponse request = getResponseBody <$> httpJSON request + +-- | Boilerplate function to perform a request and extract the response body. +jsonResponseArray :: (FromJSON a) => Request -> String -> IO a +jsonResponseArray request name = + do body <- jsonResponse request + return $ body Map.! (name :: String) + +-- | 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/src/OANDA/Internal/Types.hs b/src/OANDA/Internal/Types.hs new file mode 100644 --- /dev/null +++ b/src/OANDA/Internal/Types.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Defines types used in the REST API + +module OANDA.Internal.Types + ( OandaEnv + , apiType + , accessToken + , sandboxAuth + , practiceAuth + , liveAuth + , APIType (..) + , AccessToken (..) + , AccountID (..) + , Side (..) + , InstrumentText + ) where + +import qualified Data.ByteString as BS +import OANDA.Internal.Import + +-- | 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) + +-- | The token given by OANDA used to access the API +newtype AccessToken = AccessToken { unAccessToken :: BS.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/Orders.hs b/src/OANDA/Orders.hs --- a/src/OANDA/Orders.hs +++ b/src/OANDA/Orders.hs @@ -5,27 +5,20 @@ module OANDA.Orders - ( openOrders - , Order (..) - ) where - + ( 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 - +import OANDA.Internal -- | 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" +openOrders od (AccountID aid) = do + let url = "GET " ++ baseURL od ++ "/v1/accounts/" ++ show aid ++ "/orders" + request <- constructRequest od url [] + jsonResponseArray request "orders" data Order = Order @@ -33,7 +26,7 @@ , orderInstrument :: InstrumentText , orderUnits :: Integer , orderSide :: Side - , orderType :: String -- "marketIfTouched", + , orderType :: Text -- "marketIfTouched", , orderTime :: ZonedTime , orderPrice :: Decimal , orderTakeProfit :: Decimal diff --git a/src/OANDA/Positions.hs b/src/OANDA/Positions.hs --- a/src/OANDA/Positions.hs +++ b/src/OANDA/Positions.hs @@ -6,31 +6,26 @@ -- API. module OANDA.Positions - ( Position (..) - , openPositions - , position - , closePosition - , CloseResponse (..) - ) where + ( 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 +import OANDA.Internal -- | 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" +openPositions od (AccountID aid) = do + let url = "GET " ++ baseURL od ++ "/v1/accounts/" ++ show aid ++ "/positions" + request <- constructRequest od url [] + jsonResponseArray request "positions" data Position = Position - { positionInstrument :: String + { positionInstrument :: Text , positionUnits :: Int , positionSide :: Side , positionAvgPrice :: Decimal @@ -39,22 +34,19 @@ 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 - +position od (AccountID aid) ins = do + let url = "GET " ++ baseURL od ++ "/v1/accounts/" ++ show aid ++ "/positions/" ++ unpack ins + request <- constructRequest od url [] + jsonResponse request -- | 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 - +closePosition od (AccountID aid) ins = do + let url = "DELETE " ++ baseURL od ++ "/v1/accounts/" ++ show aid ++ "/positions/" ++ unpack ins + request <- constructRequest od url [] + jsonResponse request data CloseResponse = CloseResponse { closeResponseIds :: V.Vector Int @@ -62,7 +54,6 @@ , 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 --- a/src/OANDA/Rates.hs +++ b/src/OANDA/Rates.hs @@ -5,55 +5,48 @@ -- section of the API. module OANDA.Rates - ( InstrumentsArgs (..) - , instrumentsArgs - , Instrument (..) - , instruments - , Price (..) - , prices - , MidpointCandlestick (..) - , midpointCandles - , BidAskCandlestick (..) - , bidaskCandles - , CandlesArgs (..) - , candlesArgs - , CandlesCount (..) - , DayOfWeek (..) - , Granularity (..) - ) where + ( InstrumentsArgs (..) + , instrumentsArgs + , Instrument (..) + , instruments + , Price (..) + , prices + , MidpointCandlestick (..) + , midpointCandles + , BidAskCandlestick (..) + , bidaskCandles + , CandlesArgs (..) + , candlesArgs + , CandlesCount (..) + , DayOfWeek (..) + , Granularity (..) + , granularityToDiffTime + ) 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 +import OANDA.Internal data InstrumentsArgs = InstrumentsArgs - { instrumentsFields :: [Text] - , instrumentsInstruments :: [Text] + { instrumentsFields :: Maybe [Text] + , instrumentsInstruments :: Maybe [Text] } deriving (Show) instrumentsArgs :: InstrumentsArgs -instrumentsArgs = InstrumentsArgs ["displayName", "pip", "maxTradeUnits"] [] +instrumentsArgs = InstrumentsArgs Nothing Nothing data Instrument = Instrument - { instrumentInstrument :: String + { instrumentInstrument :: Text , instrumentPip :: Maybe Decimal , instrumentMaxTradeUnits :: Maybe Integer - , instrumentDisplayName :: Maybe String + , instrumentDisplayName :: Maybe Text , instrumentPrecision :: Maybe Decimal , instrumentMaxTrailingStop :: Maybe Decimal , instrumentMinTrailingStop :: Maybe Decimal , instrumentMarginRate :: Maybe Decimal - , instrumentHalted :: Maybe String - , instrumentInterestRate :: Maybe Decimal + , instrumentHalted :: Maybe Bool + , instrumentInterestRate :: Maybe Object } deriving (Show, Generic) instance FromJSON Instrument where @@ -62,22 +55,22 @@ -- | 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" - + let url = "GET " ++ baseURL od ++ "/v1/instruments" + request <- constructRequest od url + [ ("accountId", Just [pack $ show aid]) + , ("instruments", is) + , ("fields", fs) + ] + jsonResponseArray request "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" +prices od is zt = do + let + url = "GET " ++ baseURL od ++ "/v1/prices" + ztOpt = maybe [] (\zt' -> [("since", Just [pack $ formatTimeRFC3339 zt'])]) zt + request <- constructRequest od url (("instruments", Just is) : ztOpt) + jsonResponseArray request "prices" data Price = Price { priceInstrument :: InstrumentText @@ -93,36 +86,47 @@ -- | 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 +midpointCandles od i args = do + request <- candleOpts od i args "midpoint" + response <- jsonResponse request :: 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 +bidaskCandles od i args = do + request <- candleOpts od i args "bidask" + response <- jsonResponse request :: 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)]) - ] +candleOpts :: OandaEnv -> InstrumentText -> CandlesArgs -> String -> IO Request +candleOpts od i (CandlesArgs c g di atz wa) fmt = constructRequest od url opts + where url = "GET " ++ baseURL od ++ "/v1/candles" + opts = + [ ("instrument", Just [i]) + , ("granularity", (:[]) . pack . show <$> g) + , ("candleFormat", Just [pack fmt]) + , ("dailyAlignment", (:[]) . pack . show <$> di) + , ("alignmentTimeZone", (:[]) <$> atz) + , ("weeklyAlignment", (:[]) . pack . show <$> wa) + ] ++ maybe [] countOpts c + countOpts (Count c') = [("count", Just [pack $ show c'])] + countOpts (StartEnd st ed incf) = + [ ("start", Just [pack $ formatTimeRFC3339 st]) + , ("end", Just [pack $ formatTimeRFC3339 ed]) + , ("includeFirst", Just [pack $ map toLower (show incf)]) + ] + countOpts (StartCount st c' incf) = + [ ("start", Just [pack $ formatTimeRFC3339 st]) + , ("count", Just [pack $ show c']) + , ("includeFirst", Just [pack $ map toLower (show incf)]) + ] + countOpts (EndCount ed c') = + [ ("end", Just [pack $ formatTimeRFC3339 ed]) + , ("count", Just [pack $ show c']) + ] data MidpointCandlestick = MidpointCandlestick { midpointCandlestickTime :: ZonedTime @@ -156,21 +160,31 @@ parseJSON = genericParseJSON $ jsonOpts "bidaskCandlestick" data CandlesArgs = CandlesArgs - { candlesCount :: CandlesCount - , candlesGranularity :: Granularity - , candlesDailyAlignment :: Int - , candlesAlignmentTZ :: String - , candlesWeeklyAlignment :: DayOfWeek + { candlesCount :: Maybe CandlesCount + , candlesGranularity :: Maybe Granularity + , candlesDailyAlignment :: Maybe Int + , candlesAlignmentTZ :: Maybe Text + , candlesWeeklyAlignment :: Maybe DayOfWeek } deriving (Show) candlesArgs :: CandlesArgs -candlesArgs = CandlesArgs (Count 500) S5 17 "America/New_York" Friday +candlesArgs = CandlesArgs Nothing Nothing Nothing Nothing Nothing data CandlesCount = Count Int - | StartEnd { start :: ZonedTime - , end :: ZonedTime - , includeFirst :: Bool - } + | StartEnd + { start :: ZonedTime + , end :: ZonedTime + , includeFirst :: Bool + } + | StartCount + { start :: ZonedTime + , count :: Int + , includeFirst :: Bool + } + | EndCount + { end :: ZonedTime + , count :: Int + } deriving (Show) data DayOfWeek = Monday @@ -190,10 +204,38 @@ | M deriving (Show) +-- | Utility function to convert Granularity to NominalDiffTime. __NOTE__: The +-- conversion from month to NominalDiffTime is not correct in general; we just +-- assume 31 days in a month, which is obviously false for 5 months of the +-- year. +granularityToDiffTime :: Granularity -> NominalDiffTime +granularityToDiffTime S5 = fromSeconds' 5 +granularityToDiffTime S10 = fromSeconds' 10 +granularityToDiffTime S15 = fromSeconds' 15 +granularityToDiffTime S30 = fromSeconds' 30 +granularityToDiffTime M1 = fromSeconds' $ 1 * 60 +granularityToDiffTime M2 = fromSeconds' $ 2 * 60 +granularityToDiffTime M3 = fromSeconds' $ 3 * 60 +granularityToDiffTime M4 = fromSeconds' $ 4 * 60 +granularityToDiffTime M5 = fromSeconds' $ 5 * 60 +granularityToDiffTime M10 = fromSeconds' $ 10 * 60 +granularityToDiffTime M15 = fromSeconds' $ 15 * 60 +granularityToDiffTime M30 = fromSeconds' $ 30 * 60 +granularityToDiffTime H1 = fromSeconds' $ 1 * 60 * 60 +granularityToDiffTime H2 = fromSeconds' $ 2 * 60 * 60 +granularityToDiffTime H3 = fromSeconds' $ 3 * 60 * 60 +granularityToDiffTime H4 = fromSeconds' $ 4 * 60 * 60 +granularityToDiffTime H6 = fromSeconds' $ 6 * 60 * 60 +granularityToDiffTime H8 = fromSeconds' $ 8 * 60 * 60 +granularityToDiffTime H12 = fromSeconds' $ 12 * 60 * 60 +granularityToDiffTime D = fromSeconds' $ 1 * 60 * 60 * 24 +granularityToDiffTime W = fromSeconds' $ 7 * 60 * 60 * 24 +granularityToDiffTime M = fromSeconds' $ 31 * 60 * 60 * 24 + -- | Utility type for `midpointCandles` function response. Not exported. data MidpointCandlesResponse = MidpointCandlesResponse { _midcandlesResponseInstrument :: InstrumentText - , _midcandlesResponseGranularity :: String + , _midcandlesResponseGranularity :: Text , _midcandlesResponseCandles :: V.Vector MidpointCandlestick } deriving (Show, Generic) @@ -205,7 +247,7 @@ -- | Utility type for `bidaskCandles` function response. Not exported. data BidAskCandlesResponse = BidAskCandlesResponse { _bidaskResponseInstrument :: InstrumentText - , _bidaskResponseGranularity :: String + , _bidaskResponseGranularity :: Text , _bidaskResponseCandles :: V.Vector BidAskCandlestick } deriving (Show, Generic) diff --git a/src/OANDA/Trades.hs b/src/OANDA/Trades.hs --- a/src/OANDA/Trades.hs +++ b/src/OANDA/Trades.hs @@ -5,25 +5,20 @@ -- API. module OANDA.Trades - ( Trade (..) - , openTrades - , tradeInfo - ) where + ( 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 +import OANDA.Internal data Trade = Trade { tradeId :: !Int , tradeUnits :: !Int , tradeSide :: !Side - , tradeInstrument :: !String + , tradeInstrument :: !Text , tradeTime :: !ZonedTime , tradePrice :: !Decimal , tradeTakeProfit :: !Decimal @@ -37,17 +32,16 @@ -- | 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" - +openTrades od (AccountID aid) = do + let url = "GET " ++ baseURL od ++ "/v1/accounts/" ++ show aid ++ "/trades" + request <- constructRequest od url [] + jsonResponseArray request "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 +tradeInfo od (AccountID aid) tid = do + let url = "GET " ++ baseURL od ++ "/v1/accounts/" ++ show aid ++ "/trades/" ++ show tid + request <- constructRequest od url [] + jsonResponse request diff --git a/src/OANDA/Transactions.hs b/src/OANDA/Transactions.hs --- a/src/OANDA/Transactions.hs +++ b/src/OANDA/Transactions.hs @@ -6,18 +6,13 @@ -- History> section of the API. module OANDA.Transactions - ( Transaction (..) - , transactionHistory - ) where + ( 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 +import OANDA.Internal -- data TransactionArgs = TransactionArgs -- { transactionsMaxID :: Maybe Integer @@ -30,9 +25,9 @@ -- | 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" + do let url = "GET " ++ baseURL od ++ "/v1/accounts/" ++ show aid ++ "/transactions" + request <- constructRequest od url [] + jsonResponseArray request "transactions" data Transaction = Transaction diff --git a/src/OANDA/Types.hs b/src/OANDA/Types.hs deleted file mode 100644 --- a/src/OANDA/Types.hs +++ /dev/null @@ -1,92 +0,0 @@ -{-# 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 deleted file mode 100644 --- a/src/OANDA/Util.hs +++ /dev/null @@ -1,111 +0,0 @@ -{-# 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/stack.yaml b/stack.yaml new file mode 100644 --- /dev/null +++ b/stack.yaml @@ -0,0 +1,3 @@ +resolver: lts-7.9 +packages: + - '.'