├── Setup.hs ├── tests └── Spec.hs ├── stack.yaml ├── .gitignore ├── src ├── OANDA │ ├── Internal.hs │ ├── Internal │ │ ├── Import.hs │ │ ├── Types.hs │ │ └── Request.hs │ ├── Pricing.hs │ ├── Orders.hs │ ├── Accounts.hs │ ├── Instrument.hs │ └── Transactions.hs └── OANDA.hs ├── README.md ├── .travis.yml ├── CHANGES.md ├── package.yaml └── LICENSE /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /tests/Spec.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -F -pgmF hspec-discover #-} 2 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: nightly-2017-12-16 2 | packages: 3 | - '.' 4 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .cabal-sandbox 2 | cabal.sandbox.config 3 | dist/ 4 | .stack-work/ 5 | oanda-rest-api.cabal -------------------------------------------------------------------------------- /src/OANDA/Internal.hs: -------------------------------------------------------------------------------- 1 | -- | Utility functions. 2 | 3 | module OANDA.Internal 4 | ( module X 5 | ) where 6 | 7 | import OANDA.Internal.Import as X 8 | import OANDA.Internal.Request as X 9 | import OANDA.Internal.Types as X 10 | -------------------------------------------------------------------------------- /src/OANDA.hs: -------------------------------------------------------------------------------- 1 | module OANDA 2 | ( module X 3 | ) where 4 | 5 | import OANDA.Accounts as X 6 | import OANDA.Instrument as X 7 | import OANDA.Internal as X 8 | ( OANDARequest 9 | , makeOandaRequest 10 | , OANDAStreamingRequest 11 | , makeOandaStreamingRequest 12 | ) 13 | import OANDA.Internal.Types as X 14 | import OANDA.Orders as X 15 | import OANDA.Pricing as X 16 | import OANDA.Transactions as X 17 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # oanda-rest-api 2 | 3 | [![Build Status](https://travis-ci.org/jdreaver/oanda-rest-api.svg)](https://travis-ci.org/jdreaver/oanda-rest-api) 4 | 5 | This library implements a Haskell client to the 6 | [OANDA v20 REST API](http://developer.oanda.com/rest-live-v20/introduction/). 7 | 8 | ## Status 9 | 10 | Right now the only methods I have implemented are the ones I currently use. 11 | Feel free to make a PR or open an issue if there is a missing API endpoint that 12 | you need. 13 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # Use new container infrastructure to enable caching 2 | sudo: false 3 | 4 | # Choose a lightweight base image; we provide our own build tools. 5 | language: c 6 | 7 | # GHC depends on GMP. You can add other dependencies here as well. 8 | addons: 9 | apt: 10 | packages: 11 | - libgmp-dev 12 | 13 | # The different configurations we want to test. You could also do things like 14 | # change flags or use --stack-yaml to point to a different file. 15 | env: 16 | # - ARGS="--stack-yaml stack-7.8.yaml" 17 | # - ARGS="--stack-yaml stack-7.10.yaml" 18 | - ARGS="--stack-yaml stack.yaml" 19 | 20 | before_install: 21 | # Download and unpack the stack executable 22 | - mkdir -p ~/.local/bin 23 | - export PATH=$HOME/.local/bin:$PATH 24 | - travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack' 25 | 26 | # This line does all of the work: installs GHC if necessary, build the library, 27 | # executables, and test suites, and runs the test suites. --no-terminal works 28 | # around some quirks in Travis's terminal implementation. 29 | script: stack $ARGS --no-terminal --install-ghc test --haddock --no-haddock-deps 30 | 31 | # Caching so the next build will be fast too. 32 | cache: 33 | directories: 34 | - $HOME/.stack 35 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | # Changelog 2 | 3 | 4 | ## 0.5.0 5 | 6 | - Use `time` instead of `thyme`. `time` is a lot faster now, and `thyme` seems 7 | unmaintained. 8 | 9 | ## 0.4.1 10 | 11 | - Fix style suggestions for newer hlint 12 | 13 | ## 0.4.0 14 | 15 | - Migrated to the new v20 REST API 16 | 17 | ## 0.3.1 18 | 19 | - Added endpoint to create orders 20 | 21 | ## 0.3.0.0 22 | 23 | - Prefer `Text` instead of `String` for arguments. We still use `String` in 24 | endpoints since that is what `wreq` uses. 25 | - Use `http-conduit` instead of `wreq` 26 | 27 | ## 0.2.0.0 28 | 29 | - Use thyme instead of time. Thyme uses a much more efficient representation of 30 | time stamps. Note that thyme has a module called Data.Thyme.Time that 31 | provides wrappers and conversion functions to and from time types. 32 | - Added a convenient `granularityToDiffTime` to convert from `Granularity` to 33 | `NominalDiffTime`. 34 | - Fixed not being able to use a start/end time in conjunction with a count for 35 | the candlestick endpoints. 36 | - Use true optional arguments using `Maybe`. This fixes some endpoints breaking 37 | when empty lists were passed, and also makes it so we don't have to hard-code 38 | defaults. 39 | 40 | ## 0.1.0.0 41 | 42 | Initial release. The API is not yet complete, but there is enough to be useful. 43 | -------------------------------------------------------------------------------- /package.yaml: -------------------------------------------------------------------------------- 1 | name: oanda-rest-api 2 | version: "0.5.0" 3 | synopsis: Client to the OANDA REST API 4 | description: Client to the OANDA REST API 5 | license: BSD3 6 | license-file: LICENSE 7 | author: John David Reaver 8 | maintainer: johndreaver@gmail.com 9 | copyright: (c) 2015-2018 John David Reaver 10 | category: API 11 | stability: experimental 12 | extra-source-files: 13 | - README.md 14 | - CHANGES.md 15 | - stack.yaml 16 | 17 | github: jdreaver/oanda-rest-api 18 | 19 | dependencies: 20 | - base >= 4.8 && < 5 21 | - aeson >= 0.8.0 22 | - bytestring >= 0.10.0 23 | - conduit 24 | - containers >= 0.5.2 25 | - Decimal >= 0.4.2 26 | - http-client 27 | - http-conduit 28 | - lens >= 4.0 29 | - resourcet 30 | - scientific >= 0.3.3.0 31 | - text >= 1.2.0 32 | - time 33 | - vector >= 0.10.0 34 | 35 | default-extensions: 36 | - CPP 37 | - GeneralizedNewtypeDeriving 38 | - OverloadedStrings 39 | - RecordWildCards 40 | - ScopedTypeVariables 41 | - TemplateHaskell 42 | - TupleSections 43 | 44 | ghc-options: -Wall 45 | 46 | library: 47 | source-dirs: 48 | - src 49 | other-modules: 50 | - OANDA.Internal 51 | - OANDA.Internal.Import 52 | - OANDA.Internal.Request 53 | - OANDA.Internal.Types 54 | 55 | tests: 56 | tests: 57 | main: Spec.hs 58 | source-dirs: 59 | - tests 60 | dependencies: 61 | - oanda-rest-api 62 | - hspec 63 | - HUnit 64 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright John David Reaver (c) 2015 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of John David Reaver nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -------------------------------------------------------------------------------- /src/OANDA/Internal/Import.hs: -------------------------------------------------------------------------------- 1 | -- | Common imports used throughout the library. Easier to just put them in one 2 | -- spot. 3 | 4 | module OANDA.Internal.Import 5 | ( module X 6 | , unPrefix 7 | , parseJSONFromString 8 | ) where 9 | 10 | import Control.Lens as X 11 | ( (.~) 12 | , (^.) 13 | , (&) 14 | , makeLenses 15 | ) 16 | import Control.Monad as X (mzero) 17 | import Data.Aeson as X 18 | import Data.Aeson.TH as X 19 | import Data.Aeson.Types as X 20 | import Data.Char as X (toLower) 21 | import Data.Decimal as X 22 | import Data.Maybe as X (catMaybes) 23 | import Data.Monoid as X ((<>)) 24 | import Data.Scientific as X 25 | import Data.String as X (IsString (..), fromString) 26 | import Data.Text as X (Text, unpack, pack) 27 | import Data.Text.Encoding as X 28 | import Data.Time as X 29 | import Network.HTTP.Simple as X 30 | import Text.Read (readMaybe) 31 | 32 | -- | Aeson Options that remove the prefix from fields 33 | unPrefix :: String -> Options 34 | unPrefix prefix = defaultOptions 35 | { fieldLabelModifier = unCapitalize . dropPrefix prefix 36 | , omitNothingFields = True 37 | } 38 | 39 | -- | Lower case leading character 40 | unCapitalize :: String -> String 41 | unCapitalize [] = [] 42 | unCapitalize (c:cs) = toLower c : cs 43 | 44 | -- | Remove given prefix 45 | dropPrefix :: String -> String -> String 46 | dropPrefix prefix input = go prefix input 47 | where 48 | go pre [] = error $ contextual $ "prefix leftover: " <> pre 49 | go [] (c:cs) = c : cs 50 | go (p:preRest) (c:cRest) 51 | | p == c = go preRest cRest 52 | | otherwise = error $ contextual $ "not equal: " <> (p:preRest) <> " " <> (c:cRest) 53 | 54 | contextual msg = "dropPrefix: " <> msg <> ". " <> prefix <> " " <> input 55 | 56 | parseJSONFromString :: (Read a) => Value -> Parser a 57 | parseJSONFromString v = do 58 | numString <- parseJSON v 59 | case readMaybe (numString :: String) of 60 | Nothing -> fail $ "Invalid number for TransactionID: " ++ show v 61 | Just n -> return n 62 | -------------------------------------------------------------------------------- /src/OANDA/Internal/Types.hs: -------------------------------------------------------------------------------- 1 | -- | Defines types used in the REST API 2 | 3 | module OANDA.Internal.Types 4 | ( OandaEnv 5 | , apiType 6 | , accessToken 7 | , practiceAuth 8 | , liveAuth 9 | , APIType (..) 10 | , AccessToken (..) 11 | , AccountID (..) 12 | , InstrumentText 13 | , InstrumentName (..) 14 | , AccountUnits (..) 15 | , Currency (..) 16 | , OandaZonedTime (..) 17 | ) where 18 | 19 | import Control.Applicative ((<|>)) 20 | import qualified Data.ByteString as BS 21 | import Data.Time 22 | import Data.Time.Clock.POSIX (posixSecondsToUTCTime) 23 | 24 | import OANDA.Internal.Import 25 | 26 | -- | Wraps an `APIType` and an `AccessToken`. Mainly just a convenience wrapper 27 | -- to make functions have fewer arguments. To instantiate this type, use the 28 | -- `practiceAuth` or `liveAuth` functions. 29 | data OandaEnv = OandaEnv 30 | { apiType :: APIType 31 | , accessToken :: AccessToken 32 | } deriving (Show) 33 | 34 | -- | Use the practice API. 35 | practiceAuth :: AccessToken -> OandaEnv 36 | practiceAuth = OandaEnv Practice 37 | 38 | -- | Use the live API. 39 | liveAuth :: AccessToken -> OandaEnv 40 | liveAuth = OandaEnv Live 41 | 42 | -- | The three endpoint types used in the REST API. See the following link for 43 | -- details: 44 | data APIType 45 | = Practice 46 | | Live 47 | deriving (Show) 48 | 49 | -- | The token given by OANDA used to access the API 50 | newtype AccessToken = AccessToken { unAccessToken :: BS.ByteString } 51 | deriving (Show) 52 | 53 | -- | Integer representing the Account ID of an account 54 | newtype AccountID = AccountID { unAccountID :: String } 55 | deriving (Show, FromJSON, ToJSON) 56 | 57 | type InstrumentText = Text 58 | 59 | newtype InstrumentName = InstrumentName { unInstrumentName :: Text } 60 | deriving (Show, FromJSON, ToJSON, IsString) 61 | 62 | newtype AccountUnits = AccountUnits { unAccountUnits :: Text } 63 | deriving (Show, FromJSON, ToJSON, IsString) 64 | 65 | newtype Currency = Currency { unCurrency :: Text } 66 | deriving (Show, FromJSON, ToJSON, IsString) 67 | 68 | -- | Newtype wrapper around 'ZonedTime' to make a new JSON instance. Apparently 69 | -- OANDA decides to use either UNIX epoch seconds or RFC3339 on the fly. 70 | newtype OandaZonedTime = OandaZonedTime { unOandaZonedTime :: ZonedTime } 71 | deriving (Show, ToJSON) 72 | 73 | instance FromJSON OandaZonedTime where 74 | parseJSON v = OandaZonedTime <$> (parseJSON v <|> parseZonedFromEpoch v) 75 | where 76 | -- If we reach this branch then OANDA has encoded the time as a string 77 | -- with a number that represents the seconds since the epoch. 78 | parseZonedFromEpoch :: Value -> Parser ZonedTime 79 | parseZonedFromEpoch v' = do 80 | (secondsSinceEpoch :: Integer) <- parseJSONFromString v' 81 | let 82 | (timeInUTC :: UTCTime) = posixSecondsToUTCTime (fromInteger secondsSinceEpoch) 83 | (timeInZoned :: ZonedTime) = utcToZonedTime utc timeInUTC 84 | return timeInZoned 85 | -------------------------------------------------------------------------------- /src/OANDA/Pricing.hs: -------------------------------------------------------------------------------- 1 | -- | Defines the endpoints listed in the 2 | -- section of 3 | -- the API. 4 | 5 | module OANDA.Pricing where 6 | 7 | import qualified Data.ByteString.Lazy as BSL 8 | import Data.List (intercalate) 9 | 10 | import OANDA.Instrument 11 | import OANDA.Internal 12 | 13 | data PriceBucket 14 | = PriceBucket 15 | { priceBucketPrice :: PriceValue 16 | , priceBucketLiquidity :: Integer 17 | } deriving (Show) 18 | 19 | deriveJSON (unPrefix "priceBucket") ''PriceBucket 20 | 21 | data Price 22 | = Price 23 | { priceInstrument :: InstrumentName 24 | , priceTime :: OandaZonedTime 25 | , priceStatus :: Text 26 | , priceBids :: [PriceBucket] 27 | , priceAsks :: [PriceBucket] 28 | , priceCloseoutBid :: PriceValue 29 | , priceCloseoutAsk :: PriceValue 30 | } deriving (Show) 31 | 32 | deriveJSON (unPrefix "price") ''Price 33 | 34 | data PricingArgs 35 | = PricingArgs 36 | { _pricingArgsInstruments :: [InstrumentName] 37 | , _pricingArgsSince :: Maybe ZonedTime 38 | } deriving (Show) 39 | 40 | makeLenses ''PricingArgs 41 | 42 | pricingArgs :: [InstrumentName] -> PricingArgs 43 | pricingArgs instruments = 44 | PricingArgs 45 | { _pricingArgsInstruments = instruments 46 | , _pricingArgsSince = Nothing 47 | } 48 | 49 | data PricingResponse 50 | = PricingResponse 51 | { pricingResponsePrices :: [Price] 52 | } deriving (Show) 53 | 54 | deriveJSON (unPrefix "pricingResponse") ''PricingResponse 55 | 56 | oandaPricing :: OandaEnv -> AccountID -> PricingArgs -> OANDARequest PricingResponse 57 | oandaPricing env (AccountID accountId) PricingArgs{..} = OANDARequest request 58 | where 59 | request = 60 | baseApiRequest env "GET" ("/v3/accounts/" ++ accountId ++ "/pricing") 61 | & setRequestQueryString params 62 | params = 63 | catMaybes 64 | [ Just ("instruments", Just . fromString . intercalate "," . fmap (unpack . unInstrumentName) $ _pricingArgsInstruments) 65 | , ("since",) . Just . fromString . formatTimeRFC3339 <$> _pricingArgsSince 66 | ] 67 | 68 | data PricingStreamArgs 69 | = PricingStreamArgs 70 | { _pricingStreamArgsInstruments :: [InstrumentName] 71 | , _pricingStreamArgsSnapshot :: Maybe Bool 72 | } deriving (Show) 73 | 74 | makeLenses ''PricingStreamArgs 75 | 76 | pricingStreamArgs :: [InstrumentName] -> PricingStreamArgs 77 | pricingStreamArgs instruments = 78 | PricingStreamArgs 79 | { _pricingStreamArgsInstruments = instruments 80 | , _pricingStreamArgsSnapshot = Nothing 81 | } 82 | 83 | data PricingHeartbeat 84 | = PricingHeartbeat 85 | { pricingHeartbeatTime :: OandaZonedTime 86 | } deriving (Show) 87 | 88 | deriveJSON (unPrefix "pricingHeartbeat") ''PricingHeartbeat 89 | 90 | data PricingStreamResponse 91 | = StreamPricingHeartbeat PricingHeartbeat 92 | | StreamPrice Price 93 | deriving (Show) 94 | 95 | -- The ToJSON instance is just for debugging, it's not actually correct 96 | deriveToJSON defaultOptions ''PricingStreamResponse 97 | 98 | instance FromJSON PricingStreamResponse where 99 | parseJSON (Object o) = do 100 | type' <- o .: "type" :: Parser String 101 | case type' of 102 | "HEARTBEAT" -> StreamPricingHeartbeat <$> parseJSON (Object o) 103 | _ -> StreamPrice <$> parseJSON (Object o) 104 | parseJSON _ = mempty 105 | 106 | oandaPricingStream :: OandaEnv -> AccountID -> PricingStreamArgs -> OANDAStreamingRequest PricingStreamResponse 107 | oandaPricingStream env (AccountID accountId) PricingStreamArgs{..} = OANDAStreamingRequest request 108 | where 109 | request = 110 | baseStreamingRequest env "GET" ("/v3/accounts/" ++ accountId ++ "/pricing/stream") 111 | & setRequestQueryString params 112 | params = 113 | catMaybes 114 | [ Just ("instruments", Just . fromString . intercalate "," . fmap (unpack . unInstrumentName) $ _pricingStreamArgsInstruments) 115 | , ("since",) . Just . BSL.toStrict . encode <$> _pricingStreamArgsSnapshot 116 | ] 117 | -------------------------------------------------------------------------------- /src/OANDA/Internal/Request.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -fno-warn-orphans #-} 2 | 3 | -- | Internal module for dealing with requests via http-conduit 4 | 5 | module OANDA.Internal.Request 6 | ( OANDARequest (..) 7 | , makeOandaRequest 8 | , OANDAStreamingRequest (..) 9 | , makeOandaStreamingRequest 10 | , baseApiRequest 11 | , baseStreamingRequest 12 | , apiBaseURL 13 | , streamingBaseURL 14 | , formatTimeRFC3339 15 | ) where 16 | 17 | import Control.Monad.IO.Class 18 | import Control.Monad.Trans.Resource (MonadResource) 19 | import qualified Data.ByteString as BS 20 | import Data.Conduit 21 | import qualified Network.HTTP.Client as H 22 | 23 | import OANDA.Internal.Import 24 | import OANDA.Internal.Types 25 | 26 | -- | This is the type returned by the API functions. This is meant to be used 27 | -- with some of our request functions, depending on how safe the user wants to 28 | -- be. 29 | newtype OANDARequest a = OANDARequest { unOANDARequest :: Request } 30 | deriving (Show) 31 | 32 | -- | Simplest way to make requests, but throws exception on errors. 33 | makeOandaRequest :: (MonadIO m, FromJSON a) => OANDARequest a -> m a 34 | makeOandaRequest (OANDARequest request) = getResponseBody <$> httpJSON request 35 | 36 | -- | This is the type returned by the streaming API functions. This is meant to 37 | -- be used with some of our streaming request functions, depending on how safe 38 | -- the user wants to be. 39 | newtype OANDAStreamingRequest a = OANDAStreamingRequest { unOANDAStreamingRequest :: Request } 40 | deriving (Show) 41 | 42 | -- | Simplest way to make streaming, but throws exception on errors. 43 | makeOandaStreamingRequest :: (MonadResource m, FromJSON a) => OANDAStreamingRequest a -> Source m a 44 | makeOandaStreamingRequest (OANDAStreamingRequest request) = httpSource request parseBody 45 | where 46 | --parseBody :: (MonadIO m) => Response (Source m ByteString) -> Source m a 47 | parseBody response = mapOutput (either error id . eitherDecodeStrict) $ getResponseBody response 48 | 49 | -- | Specifies the endpoints for each `APIType`. These are the base URLs for 50 | -- each API call. 51 | apiBaseURL :: OandaEnv -> String 52 | apiBaseURL env = apiEndpoint (apiType env) 53 | where 54 | apiEndpoint Practice = "https://api-fxpractice.oanda.com" 55 | apiEndpoint Live = "https://api-fxtrade.oanda.com" 56 | 57 | -- | Specifies the streaming endpoints for each `APIType`. These are the base 58 | -- URLs for each streaming call. 59 | streamingBaseURL :: OandaEnv -> String 60 | streamingBaseURL env = apiEndpoint (apiType env) 61 | where 62 | apiEndpoint Practice = "https://stream-fxpractice.oanda.com" 63 | apiEndpoint Live = "https://stream-fxtrade.oanda.com" 64 | 65 | -- | Creates a request with the needed base url and an Authorization header for 66 | -- the Bearer token. 67 | baseRequest :: OandaEnv -> String -> String -> String -> Request 68 | baseRequest env baseUrl requestType url = 69 | unsafeParseRequest (requestType ++ " " ++ baseUrl ++ url) 70 | & makeAuthHeader (accessToken env) 71 | where 72 | makeAuthHeader (AccessToken t) = addRequestHeader "Authorization" ("Bearer " `BS.append` t) 73 | 74 | baseApiRequest :: OandaEnv -> String -> String -> Request 75 | baseApiRequest env = baseRequest env (apiBaseURL env) 76 | 77 | baseStreamingRequest :: OandaEnv -> String -> String -> Request 78 | baseStreamingRequest env = baseRequest env (streamingBaseURL env) 79 | 80 | unsafeParseRequest :: String -> Request 81 | unsafeParseRequest = unsafeParseRequest' . H.parseUrlThrow 82 | where 83 | unsafeParseRequest' (Left err) = error $ show err 84 | unsafeParseRequest' (Right request) = request 85 | 86 | -- | Formats time according to RFC3339 (which is the time format used by 87 | -- OANDA). Taken from the library. 88 | formatTimeRFC3339 :: ZonedTime -> String 89 | formatTimeRFC3339 zt@(ZonedTime _ z) = formatTime defaultTimeLocale "%FT%T" zt <> printZone 90 | where timeZoneStr = timeZoneOffsetString z 91 | printZone = if timeZoneStr == timeZoneOffsetString utc 92 | then "Z" 93 | else take 3 timeZoneStr <> ":" <> drop 3 timeZoneStr 94 | 95 | instance (Show a, Integral a) => ToJSON (DecimalRaw a) where 96 | toJSON = toJSON . show 97 | 98 | instance (Integral a) => FromJSON (DecimalRaw a) where 99 | parseJSON (Number n) = readDecimalJSON n 100 | parseJSON (String s) = readDecimalJSON (read (unpack s)) 101 | parseJSON _ = mempty 102 | 103 | 104 | readDecimalJSON :: (Integral i, Applicative f) => Scientific -> f (DecimalRaw i) 105 | readDecimalJSON n = pure $ fromRational $ toRational n 106 | -------------------------------------------------------------------------------- /src/OANDA/Orders.hs: -------------------------------------------------------------------------------- 1 | -- | Defines the endpoints listed in the 2 | -- section of the API. 3 | 4 | module OANDA.Orders where 5 | 6 | import Data.List (intercalate) 7 | 8 | import OANDA.Instrument 9 | import OANDA.Internal 10 | import OANDA.Transactions 11 | 12 | data Order 13 | = Order 14 | { orderId :: OrderID 15 | , orderCreateTime :: OandaZonedTime 16 | , orderState :: OrderState 17 | , orderClientExtensions :: Maybe ClientExtensions 18 | , orderType :: OrderType 19 | , orderInstrument :: Maybe InstrumentName 20 | , orderUnits :: Maybe Decimal 21 | , orderTimeInForce :: Maybe TimeInForce 22 | , orderPrice :: Maybe PriceValue 23 | , orderPriceBound :: Maybe PriceValue 24 | , orderPositionFill :: Maybe OrderPositionFill 25 | , orderInitialMarketPrice :: Maybe PriceValue 26 | , orderTradeClose :: Maybe MarketOrderTradeClose 27 | , orderTradeID :: Maybe TradeID 28 | , orderClientTradeID :: Maybe Text 29 | , orderDistance :: Maybe PriceValue 30 | , orderLongPositionCloseout :: Maybe MarketOrderPositionCloseout 31 | , orderShortPositionCloseout :: Maybe MarketOrderPositionCloseout 32 | , orderMarginCloseout :: Maybe MarketOrderMarginCloseout 33 | , orderDelayedTradeClose :: Maybe MarketOrderDelayedTradeClose 34 | , orderTakeProfitOnFill :: Maybe TakeProfitDetails 35 | , orderStopLossOnFill :: Maybe StopLossDetails 36 | , orderTrailingStopLossOnFill :: Maybe TrailingStopLossDetails 37 | , orderTradeClientExtensions :: Maybe ClientExtensions 38 | , orderFillingTransactionID :: Maybe TransactionID 39 | , orderFilledTime :: Maybe OandaZonedTime 40 | , orderTradeOpenedID :: Maybe TradeID 41 | , orderTradeReducedID :: Maybe TradeID 42 | , orderTradeClosedIDs :: Maybe [TradeID] 43 | , orderCancellingTransactionID :: Maybe TransactionID 44 | , orderCancelledTime :: Maybe OandaZonedTime 45 | , orderGtdTime :: Maybe OandaZonedTime 46 | , orderReplacesOrderID :: Maybe OrderID 47 | , orderReplacedByOrderID :: Maybe OrderID 48 | } deriving (Show) 49 | 50 | deriveJSON (unPrefix "order") ''Order 51 | 52 | data OrdersArgs 53 | = OrdersArgs 54 | { _ordersArgsIds :: Maybe [OrderID] 55 | , _ordersArgsState :: Maybe OrderState 56 | , _ordersArgsInstrument :: Maybe InstrumentName 57 | , _ordersArgsCount :: Maybe Int 58 | , _ordersArgsBeforeID :: Maybe OrderID 59 | } deriving (Show) 60 | 61 | ordersArgs :: OrdersArgs 62 | ordersArgs = OrdersArgs Nothing Nothing Nothing Nothing Nothing 63 | 64 | makeLenses ''OrdersArgs 65 | 66 | data OrdersResponse 67 | = OrdersResponse 68 | { ordersResponseOrders :: [Order] 69 | , ordersResponseLastTransactionID :: TransactionID 70 | } deriving (Show) 71 | 72 | deriveJSON (unPrefix "ordersResponse") ''OrdersResponse 73 | 74 | oandaOrders :: OandaEnv -> AccountID -> OrdersArgs -> OANDARequest OrdersResponse 75 | oandaOrders env (AccountID accountId) OrdersArgs{..} = OANDARequest request 76 | where 77 | request = 78 | baseApiRequest env "GET" ("/v3/accounts/" ++ accountId ++ "/orders") 79 | & setRequestQueryString params 80 | params = 81 | catMaybes 82 | [ ("ids",) . Just . fromString . intercalate "," . fmap (show . unOrderID) <$> _ordersArgsIds 83 | , ("state",) . Just . fromString . show <$> _ordersArgsState 84 | , ("instrument",) . Just . fromString . unpack . unInstrumentName <$> _ordersArgsInstrument 85 | , ("count",) . Just . fromString . show <$> _ordersArgsCount 86 | , ("beforeID",) . Just . fromString . show . unOrderID <$> _ordersArgsBeforeID 87 | ] 88 | 89 | data OrderRequest 90 | = OrderRequest 91 | { _orderRequestType :: OrderType 92 | , _orderRequestClientExtensions :: Maybe ClientExtensions 93 | , _orderRequestInstrument :: Maybe InstrumentName 94 | , _orderRequestUnits :: Maybe Decimal 95 | , _orderRequestTimeInForce :: Maybe TimeInForce 96 | , _orderRequestPrice :: Maybe PriceValue 97 | , _orderRequestPriceBound :: Maybe PriceValue 98 | , _orderRequestPositionFill :: Maybe OrderPositionFill 99 | , _orderRequestTradeID :: Maybe TradeID 100 | , _orderRequestClientTradeID :: Maybe Text 101 | , _orderRequestDistance :: Maybe PriceValue 102 | , _orderRequestTakeProfitOnFill :: Maybe TakeProfitDetails 103 | , _orderRequestStopLossOnFill :: Maybe StopLossDetails 104 | , _orderRequestTrailingStopLossOnFill :: Maybe TrailingStopLossDetails 105 | , _orderRequestTradeClientExtensions :: Maybe ClientExtensions 106 | , _orderRequestGtdTime :: Maybe ZonedTime 107 | } deriving (Show) 108 | 109 | makeLenses ''OrderRequest 110 | 111 | orderRequest :: OrderType -> OrderRequest 112 | orderRequest orderType = 113 | OrderRequest 114 | { _orderRequestType = orderType 115 | , _orderRequestClientExtensions = Nothing 116 | , _orderRequestInstrument = Nothing 117 | , _orderRequestUnits = Nothing 118 | , _orderRequestTimeInForce = Nothing 119 | , _orderRequestPrice = Nothing 120 | , _orderRequestPriceBound = Nothing 121 | , _orderRequestPositionFill = Nothing 122 | , _orderRequestTradeID = Nothing 123 | , _orderRequestClientTradeID = Nothing 124 | , _orderRequestDistance = Nothing 125 | , _orderRequestTakeProfitOnFill = Nothing 126 | , _orderRequestStopLossOnFill = Nothing 127 | , _orderRequestTrailingStopLossOnFill = Nothing 128 | , _orderRequestTradeClientExtensions = Nothing 129 | , _orderRequestGtdTime = Nothing 130 | } 131 | 132 | deriveJSON (unPrefix "_orderRequest") ''OrderRequest 133 | 134 | data CreateOrderResponse 135 | = CreateOrderResponse 136 | { createOrderResponseOrderCreateTransaction :: Transaction 137 | , createOrderResponseOrderFillTransaction :: Maybe Transaction 138 | , createOrderResponseOrderCancelTransaction :: Maybe Transaction 139 | , createOrderResponseOrderReissueTransaction :: Maybe Transaction 140 | , createOrderResponseOrderReissueRejectTransaction :: Maybe Transaction 141 | , createOrderResponseRelatedTransactionIDs :: [TransactionID] 142 | , createOrderResponseLastTransactionID :: TransactionID 143 | } deriving (Show) 144 | 145 | deriveJSON (unPrefix "createOrderResponse") ''CreateOrderResponse 146 | 147 | oandaCreateOrder :: OandaEnv -> AccountID -> OrderRequest -> OANDARequest CreateOrderResponse 148 | oandaCreateOrder env (AccountID accountId) orderRequest' = OANDARequest request 149 | where 150 | request = 151 | baseApiRequest env "POST" ("/v3/accounts/" ++ accountId ++ "/orders") 152 | & setRequestBodyJSON (object ["order" .= orderRequest']) 153 | -------------------------------------------------------------------------------- /src/OANDA/Accounts.hs: -------------------------------------------------------------------------------- 1 | -- | Defines the endpoints listed in the 2 | -- section of the 3 | -- API. 4 | 5 | module OANDA.Accounts 6 | ( AccountProperties (..) 7 | , oandaAccounts 8 | , AccountsResponse (..) 9 | , oandaAccountDetails 10 | , AccountDetailsResponse (..) 11 | , oandaAccountChanges 12 | , AccountChangesResponse (..) 13 | , AccountChanges (..) 14 | , AccountChangesState (..) 15 | , Account (..) 16 | , Position (..) 17 | , PositionSide (..) 18 | ) where 19 | 20 | import qualified Data.ByteString.Char8 as BS8 21 | import qualified Data.Vector as V 22 | 23 | import OANDA.Instrument 24 | import OANDA.Internal 25 | import OANDA.Orders 26 | import OANDA.Transactions 27 | 28 | -- | Wraps the JSON response for accounts 29 | data AccountProperties = AccountProperties 30 | { accountPropertiesId :: AccountID 31 | , accountPropertiesMt4AccountID :: Maybe Text 32 | , accountPropertiesTags :: [Text] 33 | } deriving (Show) 34 | 35 | deriveJSON (unPrefix "accountProperties") ''AccountProperties 36 | 37 | oandaAccounts :: OandaEnv -> OANDARequest AccountsResponse 38 | oandaAccounts env = OANDARequest $ baseApiRequest env "GET" "/v3/accounts" 39 | 40 | data AccountsResponse 41 | = AccountsResponse 42 | { accountsResponseAccounts :: V.Vector AccountProperties 43 | } deriving (Show) 44 | 45 | deriveJSON (unPrefix "accountsResponse") ''AccountsResponse 46 | 47 | data PositionSide = 48 | PositionSide 49 | { positionSideUnits :: Decimal 50 | , positionSideAveragePrice :: Maybe PriceValue 51 | , positionSideTradeIDs :: Maybe [TradeID] 52 | , positionSidePl :: AccountUnits 53 | , positionSideUnrealizedPL :: Maybe AccountUnits 54 | , positionSideResettablePL :: Maybe AccountUnits 55 | } deriving (Show) 56 | 57 | deriveJSON (unPrefix "positionSide") ''PositionSide 58 | 59 | data Position = 60 | Position 61 | { positionInstrument :: InstrumentName 62 | , positionPl :: AccountUnits 63 | , positionUnrealizedPL :: Maybe AccountUnits 64 | , positionResettablePL :: Maybe AccountUnits 65 | , positionLong :: PositionSide 66 | , positionShort :: PositionSide 67 | } deriving (Show) 68 | 69 | deriveJSON (unPrefix "position") ''Position 70 | 71 | data Account = 72 | Account 73 | { accountId :: AccountID 74 | , accountAlias :: Text 75 | , accountCurrency :: Currency 76 | , accountBalance :: AccountUnits 77 | , accountCreatedByUserID :: Integer 78 | , accountCreatedTime :: OandaZonedTime 79 | , accountPl :: AccountUnits 80 | , accountResettablePL :: AccountUnits 81 | , accountResettablePLTime :: Maybe OandaZonedTime 82 | , accountMarginRate :: Decimal 83 | , accountMarginCallEnterTime :: Maybe OandaZonedTime 84 | , accountMarginCallExtensionCount :: Maybe Integer 85 | , accountLastMarginCallExtensionTime :: Maybe OandaZonedTime 86 | , accountOpenTradeCount :: Integer 87 | , accountOpenPositionCount :: Integer 88 | , accountPendingOrderCount :: Integer 89 | , accountHedgingEnabled :: Bool 90 | , accountUnrealizedPL :: AccountUnits 91 | -- TODO: accountNAV :: AccountUnits 92 | , accountMarginUsed :: AccountUnits 93 | , accountMarginAvailable :: AccountUnits 94 | , accountPositionValue :: AccountUnits 95 | , accountMarginCloseoutUnrealizedPL :: AccountUnits 96 | , accountMarginCloseoutNAV :: AccountUnits 97 | , accountMarginCloseoutMarginUsed :: AccountUnits 98 | , accountMarginCloseoutPercent :: Decimal 99 | , accountWithdrawalLimit :: AccountUnits 100 | , accountMarginCallMarginUsed :: AccountUnits 101 | , accountMarginCallPercent :: Decimal 102 | , accountLastTransactionID :: TransactionID 103 | -- TODO: accountTrades :: [TradeSummary] 104 | , accountPositions :: [Position] 105 | , accountOrders :: [Order] 106 | } deriving (Show) 107 | 108 | deriveJSON (unPrefix "account") ''Account 109 | 110 | data AccountDetailsResponse = 111 | AccountDetailsResponse 112 | { accountDetailsResponseAccount :: Account 113 | , accountDetailsResponseLastTransactionID :: TransactionID 114 | } deriving (Show) 115 | 116 | deriveJSON (unPrefix "accountDetailsResponse") ''AccountDetailsResponse 117 | 118 | oandaAccountDetails :: OandaEnv -> AccountID -> OANDARequest AccountDetailsResponse 119 | oandaAccountDetails env (AccountID accountId) = OANDARequest request 120 | where 121 | request = 122 | baseApiRequest env "GET" ("/v3/accounts/" ++ accountId) 123 | 124 | data AccountChanges = 125 | AccountChanges 126 | { accountChangesOrdersCreated :: [Order] 127 | , accountChangesOrdersCancelled :: [Order] 128 | , accountChangesOrdersFilled :: [Order] 129 | , accountChangesOrdersTriggered :: [Order] 130 | -- TODO: accountChangesTradesOpened :: [TradeSummary] 131 | -- TODO: accountChangesTradesReduced :: [TradeSummary] 132 | -- TODO: accountChangesTradesClosed :: [TradeSummary] 133 | , accountChangesPositions :: [Position] 134 | , accountChangesTransactions :: [Transaction] 135 | } deriving (Show) 136 | 137 | deriveJSON (unPrefix "accountChanges") ''AccountChanges 138 | 139 | data AccountChangesState = 140 | AccountChangesState 141 | { accountChangesStateUnrealizedPL :: AccountUnits 142 | -- TODO: accountChangesStateNAV :: AccountUnits 143 | , accountChangesStateMarginUsed :: AccountUnits 144 | , accountChangesStateMarginAvailable :: AccountUnits 145 | , accountChangesStatePositionValue :: AccountUnits 146 | , accountChangesStateMarginCloseoutUnrealizedPL :: Maybe AccountUnits 147 | , accountChangesStateMarginCloseoutNAV :: Maybe AccountUnits 148 | , accountChangesStateMarginCloseoutMarginUsed :: Maybe AccountUnits 149 | , accountChangesStateMarginCloseoutPercent :: Maybe Decimal 150 | , accountChangesStateMarginCloseoutPositionValue :: Maybe Decimal 151 | , accountChangesStateWithdrawalLimit :: AccountUnits 152 | , accountChangesStateMarginCallMarginUsed :: AccountUnits 153 | , accountChangesStateMarginCallPercent :: Decimal 154 | -- TODO: accountChangesStateOrders :: [DynamicOrderState] 155 | -- TODO: accountChangesStateTrades :: [CalculatedTradeState] 156 | -- TODO: accountChangesStatePositions :: [CalculatedPositionState] 157 | } deriving (Show) 158 | 159 | deriveJSON (unPrefix "accountChangesState") ''AccountChangesState 160 | 161 | data AccountChangesResponse = 162 | AccountChangesResponse 163 | { accountChangesResponseChanges :: AccountChanges 164 | , accountChangesResponseState :: AccountChangesState 165 | , accountChangesResponseLastTransactionID :: TransactionID 166 | } deriving (Show) 167 | 168 | deriveJSON (unPrefix "accountChangesResponse") ''AccountChangesResponse 169 | 170 | oandaAccountChanges :: OandaEnv -> AccountID -> TransactionID -> OANDARequest AccountChangesResponse 171 | oandaAccountChanges env (AccountID accountId) (TransactionID sinceId) = OANDARequest request 172 | where 173 | request = 174 | baseApiRequest env "GET" ("/v3/accounts/" ++ accountId ++ "/changes") 175 | & setRequestQueryString params 176 | params = [("sinceTransactionID", Just (BS8.pack $ show sinceId))] 177 | 178 | -- TODO: 179 | -- GET /v3/accounts/{AccoundId}/summary 180 | -- GET /v3/accounts/{AccoundId}/instruments 181 | -- PATCH /v3/accounts/{AccoundId}/configuration 182 | -------------------------------------------------------------------------------- /src/OANDA/Instrument.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | 3 | -- | Defines the endpoints listed in the 4 | -- section of the 5 | -- API. 6 | 7 | module OANDA.Instrument 8 | ( CandlestickGranularity (..) 9 | , granularityFromDiffTime 10 | , granularityToDiffTime 11 | , WeeklyAlignment (..) 12 | , PriceValue (..) 13 | , Candlestick (..) 14 | , CandlestickData (..) 15 | , CandlestickArgs (..) 16 | , candlestickArgsInstrument 17 | , candlestickArgsPrice 18 | , candlestickArgsGranularity 19 | , candlestickArgsCount 20 | , candlestickArgsFrom 21 | , candlestickArgsTo 22 | , candlestickArgsSmooth 23 | , candlestickArgsIncludeFirst 24 | , candlestickArgsDailyAlignment 25 | , candlestickArgsAlignmentTimezone 26 | , candlestickArgsWeeklyAlignment 27 | , candlestickArgs 28 | , oandaCandles 29 | , CandlestickResponse (..) 30 | ) where 31 | 32 | import OANDA.Internal 33 | 34 | data CandlestickGranularity 35 | = S5 36 | | S10 37 | | S15 38 | | S30 39 | | M1 40 | | M2 41 | | M4 42 | | M5 43 | | M10 44 | | M15 45 | | M30 46 | | H1 47 | | H2 48 | | H3 49 | | H4 50 | | H6 51 | | H8 52 | | H12 53 | | D 54 | | W 55 | | M 56 | deriving (Show) 57 | 58 | deriveJSON defaultOptions ''CandlestickGranularity 59 | 60 | granularityFromDiffTime :: NominalDiffTime -> Maybe CandlestickGranularity 61 | granularityFromDiffTime = 62 | \case 63 | 5 -> Just S5 64 | 10 -> Just S10 65 | 15 -> Just S15 66 | 30 -> Just S30 67 | 60 -> Just M1 68 | 120 -> Just M2 69 | 240 -> Just M4 70 | 300 -> Just M5 71 | 600 -> Just M10 72 | 900 -> Just M15 73 | 1800 -> Just M30 74 | 3600 -> Just H1 75 | 7200 -> Just H2 76 | 10800 -> Just H3 77 | 14400 -> Just H4 78 | 21600 -> Just H6 79 | 28800 -> Just H8 80 | 43200 -> Just H12 81 | 86400 -> Just D 82 | 604800 -> Just W 83 | -- _ -> Just M -- Not well-defined for a month 84 | _ -> Nothing 85 | 86 | -- | Utility function to convert Granularity to NominalDiffTime. __NOTE__: The 87 | -- conversion from month to NominalDiffTime is not correct in general; we just 88 | -- assume 31 days in a month, which is obviously false for 5 months of the 89 | -- year. 90 | granularityToDiffTime :: CandlestickGranularity -> NominalDiffTime 91 | granularityToDiffTime S5 = 5 92 | granularityToDiffTime S10 = 10 93 | granularityToDiffTime S15 = 15 94 | granularityToDiffTime S30 = 30 95 | granularityToDiffTime M1 = 1 * 60 96 | granularityToDiffTime M2 = 2 * 60 97 | granularityToDiffTime M4 = 4 * 60 98 | granularityToDiffTime M5 = 5 * 60 99 | granularityToDiffTime M10 = 10 * 60 100 | granularityToDiffTime M15 = 15 * 60 101 | granularityToDiffTime M30 = 30 * 60 102 | granularityToDiffTime H1 = 1 * 60 * 60 103 | granularityToDiffTime H2 = 2 * 60 * 60 104 | granularityToDiffTime H3 = 3 * 60 * 60 105 | granularityToDiffTime H4 = 4 * 60 * 60 106 | granularityToDiffTime H6 = 6 * 60 * 60 107 | granularityToDiffTime H8 = 8 * 60 * 60 108 | granularityToDiffTime H12 = 12 * 60 * 60 109 | granularityToDiffTime D = 1 * 60 * 60 * 24 110 | granularityToDiffTime W = 7 * 60 * 60 * 24 111 | granularityToDiffTime M = 31 * 60 * 60 * 24 112 | 113 | data WeeklyAlignment 114 | = Monday 115 | | Tuesday 116 | | Wednesday 117 | | Thursday 118 | | Friday 119 | | Saturday 120 | | Sunday 121 | deriving (Show) 122 | 123 | newtype PriceValue = PriceValue { unPriceValue :: Text } 124 | deriving (Show, ToJSON, FromJSON) 125 | 126 | data CandlestickData 127 | = CandlestickData 128 | { candlestickDataO :: PriceValue 129 | , candlestickDataH :: PriceValue 130 | , candlestickDataL :: PriceValue 131 | , candlestickDataC :: PriceValue 132 | } deriving (Show) 133 | 134 | deriveJSON (unPrefix "candlestickData") ''CandlestickData 135 | 136 | data Candlestick 137 | = Candlestick 138 | { candlestickTime :: OandaZonedTime 139 | , candlestickBid :: Maybe CandlestickData 140 | , candlestickAsk :: Maybe CandlestickData 141 | , candlestickMid :: Maybe CandlestickData 142 | , candlestickVolume :: Integer 143 | , candlestickComplete :: Bool 144 | } deriving (Show) 145 | 146 | deriveJSON (unPrefix "candlestick") ''Candlestick 147 | 148 | data CandlestickArgs 149 | = CandlestickArgs 150 | { _candlestickArgsInstrument :: InstrumentName 151 | , _candlestickArgsPrice :: Maybe Text 152 | , _candlestickArgsGranularity :: CandlestickGranularity 153 | , _candlestickArgsCount :: Maybe Int 154 | , _candlestickArgsFrom :: Maybe ZonedTime 155 | , _candlestickArgsTo :: Maybe ZonedTime 156 | , _candlestickArgsSmooth :: Maybe Bool 157 | , _candlestickArgsIncludeFirst :: Maybe Bool 158 | , _candlestickArgsDailyAlignment :: Maybe Int 159 | , _candlestickArgsAlignmentTimezone :: Maybe String 160 | , _candlestickArgsWeeklyAlignment :: Maybe WeeklyAlignment 161 | } deriving (Show) 162 | 163 | candlestickArgs :: InstrumentName -> CandlestickGranularity -> CandlestickArgs 164 | candlestickArgs instrument granularity = 165 | CandlestickArgs 166 | { _candlestickArgsInstrument = instrument 167 | , _candlestickArgsPrice = Nothing 168 | , _candlestickArgsGranularity = granularity 169 | , _candlestickArgsCount = Nothing 170 | , _candlestickArgsFrom = Nothing 171 | , _candlestickArgsTo = Nothing 172 | , _candlestickArgsSmooth = Nothing 173 | , _candlestickArgsIncludeFirst = Nothing 174 | , _candlestickArgsDailyAlignment = Nothing 175 | , _candlestickArgsAlignmentTimezone = Nothing 176 | , _candlestickArgsWeeklyAlignment = Nothing 177 | } 178 | 179 | makeLenses ''CandlestickArgs 180 | 181 | oandaCandles :: OandaEnv -> CandlestickArgs -> OANDARequest CandlestickResponse 182 | oandaCandles env CandlestickArgs{..} = OANDARequest request 183 | where 184 | instrumentText = unpack $ unInstrumentName _candlestickArgsInstrument 185 | request = 186 | baseApiRequest env "GET" ("/v3/instruments/" ++ instrumentText ++ "/candles") 187 | & setRequestQueryString params 188 | params = 189 | catMaybes 190 | [ ("price",) . Just . encodeUtf8 <$> _candlestickArgsPrice 191 | , Just ("granularity", Just . fromString $ show _candlestickArgsGranularity) 192 | , ("count",) . Just . fromString . show <$> _candlestickArgsCount 193 | , ("from",) . Just . fromString . formatTimeRFC3339 <$> _candlestickArgsFrom 194 | , ("to",) . Just . fromString . formatTimeRFC3339 <$> _candlestickArgsTo 195 | , ("smooth",) . Just . fromString . show <$> _candlestickArgsSmooth 196 | , ("includeFirst",) . Just . fromString . show <$> _candlestickArgsIncludeFirst 197 | , ("dailyAlignment",) . Just . fromString . show <$> _candlestickArgsDailyAlignment 198 | , ("alignmentTimezone",) . Just . fromString . show <$> _candlestickArgsAlignmentTimezone 199 | , ("weeklyAlignment",) . Just . fromString . show <$> _candlestickArgsWeeklyAlignment 200 | ] 201 | 202 | data CandlestickResponse 203 | = CandlestickResponse 204 | { candlestickResponseInstrument :: InstrumentName 205 | , candlestickResponseGranularity :: CandlestickGranularity 206 | , candlestickResponseCandles :: [Candlestick] 207 | } deriving (Show) 208 | 209 | deriveJSON (unPrefix "candlestickResponse") ''CandlestickResponse 210 | -------------------------------------------------------------------------------- /src/OANDA/Transactions.hs: -------------------------------------------------------------------------------- 1 | -- | Defines the endpoints listed in the 2 | -- section of the API. 4 | 5 | module OANDA.Transactions where 6 | 7 | import qualified Data.ByteString.Char8 as BS8 8 | 9 | import OANDA.Internal 10 | 11 | newtype OrderID = OrderID { unOrderID :: Int } 12 | deriving (Show, Eq, Ord, Num) 13 | 14 | instance ToJSON OrderID where 15 | toJSON = toJSON . show . unOrderID 16 | 17 | instance FromJSON OrderID where 18 | parseJSON = fmap OrderID . parseJSONFromString 19 | 20 | newtype TransactionID = TransactionID { unTransactionID :: Int } 21 | deriving (Show, Eq, Ord, Num) 22 | 23 | instance ToJSON TransactionID where 24 | toJSON = toJSON . show . unTransactionID 25 | 26 | instance FromJSON TransactionID where 27 | parseJSON = fmap TransactionID . parseJSONFromString 28 | 29 | newtype TradeID = TradeID { unTradeID :: Int } 30 | deriving (Show, Eq, Ord, Num) 31 | 32 | instance ToJSON TradeID where 33 | toJSON = toJSON . show . unTradeID 34 | 35 | instance FromJSON TradeID where 36 | parseJSON = fmap TradeID . parseJSONFromString 37 | 38 | data OrderType 39 | = MARKET 40 | | LIMIT 41 | | STOP 42 | | MARKET_IF_TOUCHED 43 | | TAKE_PROFIT 44 | | STOP_LOSS 45 | | TRAILING_STOP_LOSS 46 | deriving (Show, Eq) 47 | 48 | deriveJSON defaultOptions ''OrderType 49 | 50 | data OrderState 51 | = PENDING 52 | | FILLED 53 | | TRIGGERED 54 | | CANCELLED 55 | deriving (Show, Eq) 56 | 57 | deriveJSON defaultOptions ''OrderState 58 | 59 | data ClientExtensions 60 | = ClientExtensions 61 | { clientExtensionsId :: Maybe Text 62 | , clientExtensionsTag :: Maybe Text 63 | , clientExtensionsComment :: Maybe Text 64 | } deriving (Show) 65 | 66 | deriveJSON (unPrefix "clientExtensions") ''ClientExtensions 67 | 68 | data TimeInForce 69 | = GTC 70 | | GTD 71 | | GFD 72 | | FOK 73 | | IOC 74 | deriving (Show, Eq) 75 | 76 | deriveJSON defaultOptions ''TimeInForce 77 | 78 | data OrderPositionFill 79 | = OPEN_ONLY 80 | | REDUCE_FIRST 81 | | REDUCE_ONLY 82 | | POSITION_DEFAULT 83 | deriving (Show, Eq) 84 | 85 | deriveJSON defaultOptions ''OrderPositionFill 86 | 87 | data MarketOrderPositionCloseout 88 | = MarketOrderPositionCloseout 89 | { marketOrderPositionCloseoutInstrument :: InstrumentName 90 | , marketOrderPositionCloseoutUnits :: Text 91 | } deriving (Show) 92 | 93 | deriveJSON (unPrefix "marketOrderPositionCloseout") ''MarketOrderPositionCloseout 94 | 95 | data MarketOrderTradeClose 96 | = MarketOrderTradeClose 97 | { marketOrderTradeCloseTradeID :: TradeID 98 | , marketOrderTradeCloseClientTradeID :: Text 99 | , marketOrderTradeCloseUnits :: Text 100 | } deriving (Show) 101 | 102 | deriveJSON (unPrefix "marketOrderTradeClose") ''MarketOrderTradeClose 103 | 104 | data MarketOrderMarginCloseout 105 | = MarketOrderMarginCloseout 106 | { marketOrderMarginCloseoutReason :: Text 107 | } deriving (Show) 108 | 109 | deriveJSON (unPrefix "marketOrderMarginCloseout") ''MarketOrderMarginCloseout 110 | 111 | data MarketOrderDelayedTradeClose 112 | = MarketOrderDelayedTradeClose 113 | { marketOrderDelayedTradeCloseTradeID :: TradeID 114 | , marketOrderDelayedTradeCloseClientTradeID :: Text 115 | , marketOrderDelayedTradeCloseSourceTransactionID :: TransactionID 116 | } deriving (Show) 117 | 118 | deriveJSON (unPrefix "marketOrderDelayedTradeClose") ''MarketOrderDelayedTradeClose 119 | 120 | data TakeProfitDetails 121 | = TakeProfitDetails 122 | { takeProfitDetailsPrice :: Text 123 | , takeProfitDetailsTimeInForce :: TimeInForce 124 | , takeProfitDetailsGtdTime :: OandaZonedTime 125 | , takeProfitDetailsClientExtensions :: Maybe ClientExtensions 126 | } deriving (Show) 127 | 128 | deriveJSON (unPrefix "takeProfitDetails") ''TakeProfitDetails 129 | 130 | data StopLossDetails 131 | = StopLossDetails 132 | { stopLossDetailsPrice :: Text 133 | , stopLossDetailsTimeInForce :: TimeInForce 134 | , stopLossDetailsGtdTime :: OandaZonedTime 135 | , stopLossDetailsClientExtensions :: Maybe ClientExtensions 136 | } deriving (Show) 137 | 138 | deriveJSON (unPrefix "stopLossDetails") ''StopLossDetails 139 | 140 | data TrailingStopLossDetails 141 | = TrailingStopLossDetails 142 | { trailingStopLossDetailsDistance :: Text 143 | , trailingStopLossDetailsTimeInForce :: TimeInForce 144 | , trailingStopLossDetailsGtdTime :: OandaZonedTime 145 | , trailingStopLossDetailsClientExtensions :: Maybe ClientExtensions 146 | } deriving (Show) 147 | 148 | deriveJSON (unPrefix "trailingStopLossDetails") ''TrailingStopLossDetails 149 | 150 | data TransactionType 151 | = CREATE 152 | | CLOSE 153 | | REOPEN 154 | | CLIENT_CONFIGURE 155 | | CLIENT_CONFIGURE_REJECT 156 | | TRANSFER_FUNDS 157 | | TRANSFER_FUNDS_REJECT 158 | | MARKET_ORDER 159 | | MARKET_ORDER_REJECT 160 | | LIMIT_ORDER 161 | | LIMIT_ORDER_REJECT 162 | | STOP_ORDER 163 | | STOP_ORDER_REJECT 164 | | MARKET_IF_TOUCHED_ORDER 165 | | MARKET_IF_TOUCHED_ORDER_REJECT 166 | | TAKE_PROFIT_ORDER 167 | | TAKE_PROFIT_ORDER_REJECT 168 | | STOP_LOSS_ORDER 169 | | STOP_LOSS_ORDER_REJECT 170 | | TRAILING_STOP_LOSS_ORDER 171 | | TRAILING_STOP_LOSS_ORDER_REJECT 172 | | ORDER_FILL 173 | | ORDER_CANCEL 174 | | ORDER_CANCEL_REJECT 175 | | ORDER_CLIENT_EXTENSIONS_MODIFY 176 | | ORDER_CLIENT_EXTENSIONS_MODIFY_REJECT 177 | | TRADE_CLIENT_EXTENSIONS_MODIFY 178 | | TRADE_CLIENT_EXTENSIONS_MODIFY_REJECT 179 | | MARGIN_CALL_ENTER 180 | | MARGIN_CALL_EXTEND 181 | | MARGIN_CALL_EXIT 182 | | DELAYED_TRADE_CLOSURE 183 | | DAILY_FINANCING 184 | | RESET_RESETTABLE_PL 185 | deriving (Show, Eq) 186 | 187 | deriveJSON defaultOptions ''TransactionType 188 | 189 | data TradeOpen 190 | = TradeOpen 191 | { tradeOpenTradeID :: TradeID 192 | , tradeOpenUnits :: Decimal 193 | , tradeOpenClientExtensions :: Maybe ClientExtensions 194 | } deriving (Show) 195 | 196 | deriveJSON (unPrefix "tradeOpen") ''TradeOpen 197 | 198 | data TradeReduce 199 | = TradeReduce 200 | { tradeReduceTradeID :: TradeID 201 | , tradeReduceUnits :: Decimal 202 | , tradeReduceRealizedPL :: AccountUnits 203 | , tradeReduceFinancing :: AccountUnits 204 | } deriving (Show) 205 | 206 | deriveJSON (unPrefix "tradeReduce") ''TradeReduce 207 | 208 | data OpenTradeFinancing 209 | = OpenTradeFinancing 210 | { openTradeFinancingTradeID :: TradeID 211 | , openTradeFinancingFinancing :: AccountUnits 212 | } deriving (Show) 213 | 214 | deriveJSON (unPrefix "openTradeFinancing") ''OpenTradeFinancing 215 | 216 | data PositionFinancing 217 | = PositionFinancing 218 | { -- BUG: Their docs say instrumentID but the field is actually called instrument 219 | positionFinancingInstrument :: InstrumentName 220 | , positionFinancingFinancing :: AccountUnits 221 | , positionFinancingOpenTradeFinancings :: [OpenTradeFinancing] 222 | } deriving (Show) 223 | 224 | deriveJSON (unPrefix "positionFinancing") ''PositionFinancing 225 | 226 | data Transaction = Transaction 227 | { -- Common to all transactions 228 | transactionId :: TransactionID 229 | , transactionTime :: OandaZonedTime 230 | , transactionAccountID :: AccountID 231 | , transactionUserID :: Integer 232 | , transactionBatchID :: TransactionID 233 | , transactionType :: TransactionType 234 | 235 | -- Specific to individual transactions 236 | , transactionDivisionID :: Maybe Integer 237 | , transactionSiteID :: Maybe Integer 238 | , transactionAccountUserID :: Maybe Integer 239 | , transactionAccountNumber :: Maybe Integer 240 | , transactionHomeCurrency :: Maybe Currency 241 | , transactionAlias :: Maybe Text 242 | , transactionMarginRate :: Maybe Decimal 243 | , transactionRejectReason :: Maybe Text 244 | , transactionAmount :: Maybe AccountUnits 245 | , transactionFundingReason :: Maybe Text 246 | , transactionAccountBalance :: Maybe AccountUnits 247 | , transactionInstrument :: Maybe InstrumentText 248 | , transactionUnits :: Maybe Decimal 249 | , transactionPrice :: Maybe Decimal 250 | , transactionTimeInForce :: Maybe TimeInForce 251 | , transactionPriceBound :: Maybe Text 252 | , transactionPositionFill :: Maybe Text 253 | , transactionMarketOrderTradeClose :: Maybe MarketOrderTradeClose 254 | , transactionLongPositionCloseout :: Maybe MarketOrderPositionCloseout 255 | , transactionShortPositionCloseout :: Maybe MarketOrderPositionCloseout 256 | , transactionMarginCloseout :: Maybe MarketOrderMarginCloseout 257 | , transactionDelayedTradeClose :: Maybe MarketOrderDelayedTradeClose 258 | , transactionReason :: Maybe Text 259 | , transactionClientExtensions :: Maybe ClientExtensions 260 | , transactionTakeProfitOnFill :: Maybe TakeProfitDetails 261 | , transactionStopLossOnFill :: Maybe StopLossDetails 262 | , transactionTrailingStopLossOnFill :: Maybe TrailingStopLossDetails 263 | , transactionTradeClientExtensions :: Maybe ClientExtensions 264 | , transactionGtdTime :: Maybe OandaZonedTime 265 | , transactionReplacesOrderID :: Maybe OrderID 266 | , transactionReplacedOrderCancelTransactionID :: Maybe TransactionID 267 | , transactionIntendedReplacesOrderID :: Maybe OrderID 268 | , transactionDistance :: Maybe Text 269 | , transactionOrderID :: Maybe OrderID 270 | , transactionClientOrderID :: Maybe Text 271 | , transactionPl :: Maybe AccountUnits 272 | , transactionFinancing :: Maybe AccountUnits 273 | , transactionTradeOpened :: Maybe TradeOpen 274 | , transactionTradesClosed :: Maybe [TradeReduce] 275 | , transactionTradeReduced :: Maybe TradeReduce 276 | , transactionTradeClientExtensionsModify :: Maybe ClientExtensions 277 | , transactionExtensionNumber :: Maybe Integer 278 | , transactionTradeIDs :: Maybe TradeID 279 | , transactionAccountFinancingMode :: Maybe Text 280 | , transactionPositionFinancings :: Maybe [PositionFinancing] 281 | } deriving (Show) 282 | 283 | deriveJSON (unPrefix "transaction") ''Transaction 284 | 285 | oandaTransaction :: OandaEnv -> AccountID -> TransactionID -> OANDARequest Transaction 286 | oandaTransaction env (AccountID accountId) (TransactionID transId) = 287 | OANDARequest $ baseApiRequest env "GET" ("/v3/accounts/" ++ accountId ++ "/transactions/" ++ show transId) 288 | 289 | data TransactionsSinceIDResponse 290 | = TransactionsSinceIDResponse 291 | { transactionsSinceIDResponseTransactions :: [Transaction] 292 | , transactionsSinceIDResponseLastTransactionID :: TransactionID 293 | } deriving (Show) 294 | 295 | deriveJSON (unPrefix "transactionsSinceIDResponse") ''TransactionsSinceIDResponse 296 | 297 | oandaTransactionsSinceID :: OandaEnv -> AccountID -> TransactionID -> OANDARequest TransactionsSinceIDResponse 298 | oandaTransactionsSinceID env (AccountID accountId) (TransactionID transId) = OANDARequest request 299 | where 300 | request = 301 | baseApiRequest env "GET" ("/v3/accounts/" ++ accountId ++ "/transactions/sinceid") 302 | & setRequestQueryString [("id", Just $ BS8.pack $ show transId)] 303 | 304 | data TransactionHeartbeat 305 | = TransactionHeartbeat 306 | { transactionHeartbeatLastTransactionID :: TransactionID 307 | , transactionHeartbeatTime :: OandaZonedTime 308 | } deriving (Show) 309 | 310 | deriveJSON (unPrefix "transactionHeartbeat") ''TransactionHeartbeat 311 | 312 | data TransactionsStreamResponse 313 | = StreamTransactionHeartbeat TransactionHeartbeat 314 | | StreamTransaction Transaction 315 | deriving (Show) 316 | 317 | -- The ToJSON instance is just for debugging, it's not actually correct 318 | deriveToJSON defaultOptions ''TransactionsStreamResponse 319 | 320 | instance FromJSON TransactionsStreamResponse where 321 | parseJSON (Object o) = do 322 | type' <- o .: "type" :: Parser String 323 | case type' of 324 | "HEARTBEAT" -> StreamTransactionHeartbeat <$> parseJSON (Object o) 325 | _ -> StreamTransaction <$> parseJSON (Object o) 326 | parseJSON _ = mempty 327 | 328 | oandaTransactionStream :: OandaEnv -> AccountID -> OANDAStreamingRequest TransactionsStreamResponse 329 | oandaTransactionStream env (AccountID accountId) = 330 | OANDAStreamingRequest $ baseStreamingRequest env "GET" ("/v3/accounts/" ++ accountId ++ "/transactions/stream") 331 | --------------------------------------------------------------------------------