diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -1,5 +1,13 @@ # Changelog +## 0.4.0 + +- Migrated to the new v20 REST API + +## 0.3.1 + +- Added endpoint to create orders + ## 0.3.0.0 - Prefer `Text` instead of `String` for arguments. We still use `String` in diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -2,19 +2,11 @@ [![Build Status](https://travis-ci.org/jdreaver/oanda-rest-api.svg)](https://travis-ci.org/jdreaver/oanda-rest-api) -This library implements Haskell client to the -[OANDA REST API](http://developer.oanda.com/rest-live/introduction/). +This library implements a Haskell client to the +[OANDA v20 REST API](http://developer.oanda.com/rest-live-v20/introduction/). ## Status -There are still parts of the API that are not yet implemented. Here is the -status of each part of the API: - -* Rates: Mostly done, just need to refactor so the parameters are cleaner. -* Accounts: Done. -* Orders: Can only get a list of open orders. Can't yet create or modify - orders. -* Trades: Almost done, just need to add closing a trade. -* Positions: Done. -* Transaction History: Almost done. Could probably refactor the types to be - more specific, instead of putting `Maybe` everywhere. +Right now the only methods I have implemented are the ones I currently use. +Feel free to make a PR or open an issue if there is a missing API endpoint that +you need. diff --git a/oanda-rest-api.cabal b/oanda-rest-api.cabal --- a/oanda-rest-api.cabal +++ b/oanda-rest-api.cabal @@ -1,9 +1,9 @@ --- This file has been generated from package.yaml by hpack version 0.15.0. +-- This file has been generated from package.yaml by hpack version 0.17.0. -- -- see: https://github.com/sol/hpack name: oanda-rest-api -version: 0.3.0.0 +version: 0.4.0 synopsis: Client to the OANDA REST API description: Client to the OANDA REST API category: API @@ -30,28 +30,31 @@ library hs-source-dirs: src + default-extensions: CPP GeneralizedNewtypeDeriving OverloadedStrings RecordWildCards ScopedTypeVariables TemplateHaskell TupleSections ghc-options: -Wall build-depends: - base >= 4.7 && < 5 + base >= 4.8 && < 5 , aeson >= 0.8.0 , bytestring >= 0.10.0 + , conduit , containers >= 0.5.2 , Decimal >= 0.4.2 + , http-client , http-conduit , lens >= 4.0 , old-locale >= 1.0.0.6 + , resourcet , scientific >= 0.3.3.0 , text >= 1.2.0 , thyme + , transformers , vector >= 0.10.0 exposed-modules: OANDA OANDA.Accounts - OANDA.Environment + OANDA.Instrument OANDA.Orders - OANDA.Positions - OANDA.Rates - OANDA.Trades + OANDA.Pricing OANDA.Transactions other-modules: OANDA.Internal @@ -65,19 +68,24 @@ main-is: HLint.hs hs-source-dirs: tests + default-extensions: CPP GeneralizedNewtypeDeriving OverloadedStrings RecordWildCards ScopedTypeVariables TemplateHaskell TupleSections ghc-options: -Wall build-depends: - base >= 4.7 && < 5 + base >= 4.8 && < 5 , aeson >= 0.8.0 , bytestring >= 0.10.0 + , conduit , containers >= 0.5.2 , Decimal >= 0.4.2 + , http-client , http-conduit , lens >= 4.0 , old-locale >= 1.0.0.6 + , resourcet , scientific >= 0.3.3.0 , text >= 1.2.0 , thyme + , transformers , vector >= 0.10.0 , hlint other-modules: @@ -89,20 +97,25 @@ main-is: Spec.hs hs-source-dirs: src - , tests + tests + default-extensions: CPP GeneralizedNewtypeDeriving OverloadedStrings RecordWildCards ScopedTypeVariables TemplateHaskell TupleSections ghc-options: -Wall build-depends: - base >= 4.7 && < 5 + base >= 4.8 && < 5 , aeson >= 0.8.0 , bytestring >= 0.10.0 + , conduit , containers >= 0.5.2 , Decimal >= 0.4.2 + , http-client , http-conduit , lens >= 4.0 , old-locale >= 1.0.0.6 + , resourcet , scientific >= 0.3.3.0 , text >= 1.2.0 , thyme + , transformers , vector >= 0.10.0 , oanda-rest-api , hspec @@ -110,15 +123,13 @@ other-modules: OANDA OANDA.Accounts - OANDA.Environment + OANDA.Instrument OANDA.Internal OANDA.Internal.Import OANDA.Internal.Request OANDA.Internal.Types OANDA.Orders - OANDA.Positions - OANDA.Rates - OANDA.Trades + OANDA.Pricing 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,11 +1,16 @@ module OANDA - ( module X - ) where + ( module X + ) where import OANDA.Accounts as X -import OANDA.Environment as X +import OANDA.Instrument as X +import OANDA.Internal as X + ( OANDARequest + , makeOandaRequest + , OANDAStreamingRequest + , makeOandaStreamingRequest + ) +import OANDA.Internal.Types as X import OANDA.Orders as X -import OANDA.Positions as X -import OANDA.Rates as X -import OANDA.Trades as X +import OANDA.Pricing 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 @@ -1,61 +1,181 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} - -- | Defines the endpoints listed in the --- section of the +-- section of the -- API. module OANDA.Accounts - ( Account (..) - , accounts - , AccountInfo (..) - , accountInfo + ( AccountProperties (..) + , oandaAccounts + , AccountsResponse (..) + , oandaAccountDetails + , AccountDetailsResponse (..) + , oandaAccountChanges + , AccountChangesResponse (..) + , AccountChanges (..) + , AccountChangesState (..) + , Account (..) + , Position (..) + , PositionSide (..) ) where +import qualified Data.ByteString.Char8 as BS8 import qualified Data.Vector as V +import OANDA.Instrument import OANDA.Internal +import OANDA.Orders +import OANDA.Transactions -- | Wraps the JSON response for accounts -data Account = Account - { accountAccountId :: Int - , accountAccountName :: Text - , accountAccountCurrency :: Text - , accountMarginRate :: Decimal - } deriving (Show, Generic) +data AccountProperties = AccountProperties + { accountPropertiesId :: AccountID + , accountPropertiesMt4AccountID :: Maybe Text + , accountPropertiesTags :: [Text] + } deriving (Show) -instance FromJSON Account where - parseJSON = genericParseJSON $ jsonOpts "account" +deriveJSON (unPrefix "accountProperties") ''AccountProperties --- | Get all accounts for given access token -accounts :: OandaEnv -> IO (V.Vector Account) -accounts od = do - let url = "GET " ++ baseURL od ++ "/v1/accounts" - request <- constructRequest od url [] - jsonResponseArray request "accounts" +oandaAccounts :: OandaEnv -> OANDARequest AccountsResponse +oandaAccounts env = OANDARequest $ baseApiRequest env "GET" "/v3/accounts" +data AccountsResponse + = AccountsResponse + { accountsResponseAccounts :: V.Vector AccountProperties + } deriving (Show) --- | Get all account info associated with an account ID. -accountInfo :: OandaEnv -> AccountID -> IO AccountInfo -accountInfo od (AccountID aid) = do - let url = "GET " ++ baseURL od ++ "/v1/accounts/" ++ show aid - request <- constructRequest od url [] - jsonResponse request +deriveJSON (unPrefix "accountsResponse") ''AccountsResponse +data PositionSide = + PositionSide + { positionSideUnits :: Decimal + , positionSideAveragePrice :: Maybe PriceValue + , positionSideTradeIDs :: Maybe [TradeID] + , positionSidePl :: AccountUnits + , positionSideUnrealizedPL :: Maybe AccountUnits + , positionSideResettablePL :: Maybe AccountUnits + } deriving (Show) -data AccountInfo = AccountInfo - { accountInfoAccountId :: Integer - , accountInfoAccountName :: Text - , accountInfoBalance :: Decimal - , accountInfoUnrealizedPl :: Decimal - , accountInfoRealizedPl :: Decimal - , accountInfoMarginUsed :: Decimal - , accountInfoMarginAvail :: Decimal - , accountInfoOpenTrades :: Integer - , accountInfoOpenOrders :: Integer - , accountInfoMarginRate :: Decimal - , accountInfoAccountCurrency :: Text - } deriving (Show, Generic) +deriveJSON (unPrefix "positionSide") ''PositionSide -instance FromJSON AccountInfo where - parseJSON = genericParseJSON $ jsonOpts "accountInfo" +data Position = + Position + { positionInstrument :: InstrumentName + , positionPl :: AccountUnits + , positionUnrealizedPL :: Maybe AccountUnits + , positionResettablePL :: Maybe AccountUnits + , positionLong :: PositionSide + , positionShort :: PositionSide + } deriving (Show) + +deriveJSON (unPrefix "position") ''Position + +data Account = + Account + { accountId :: AccountID + , accountAlias :: Text + , accountCurrency :: Currency + , accountBalance :: AccountUnits + , accountCreatedByUserID :: Integer + , accountCreatedTime :: OandaZonedTime + , accountPl :: AccountUnits + , accountResettablePL :: AccountUnits + , accountResettablePLTime :: Maybe OandaZonedTime + , accountMarginRate :: Decimal + , accountMarginCallEnterTime :: Maybe OandaZonedTime + , accountMarginCallExtensionCount :: Maybe Integer + , accountLastMarginCallExtensionTime :: Maybe OandaZonedTime + , accountOpenTradeCount :: Integer + , accountOpenPositionCount :: Integer + , accountPendingOrderCount :: Integer + , accountHedgingEnabled :: Bool + , accountUnrealizedPL :: AccountUnits + -- TODO: accountNAV :: AccountUnits + , accountMarginUsed :: AccountUnits + , accountMarginAvailable :: AccountUnits + , accountPositionValue :: AccountUnits + , accountMarginCloseoutUnrealizedPL :: AccountUnits + , accountMarginCloseoutNAV :: AccountUnits + , accountMarginCloseoutMarginUsed :: AccountUnits + , accountMarginCloseoutPercent :: Decimal + , accountWithdrawalLimit :: AccountUnits + , accountMarginCallMarginUsed :: AccountUnits + , accountMarginCallPercent :: Decimal + , accountLastTransactionID :: TransactionID + -- TODO: accountTrades :: [TradeSummary] + , accountPositions :: [Position] + , accountOrders :: [Order] + } deriving (Show) + +deriveJSON (unPrefix "account") ''Account + +data AccountDetailsResponse = + AccountDetailsResponse + { accountDetailsResponseAccount :: Account + , accountDetailsResponseLastTransactionID :: TransactionID + } deriving (Show) + +deriveJSON (unPrefix "accountDetailsResponse") ''AccountDetailsResponse + +oandaAccountDetails :: OandaEnv -> AccountID -> OANDARequest AccountDetailsResponse +oandaAccountDetails env (AccountID accountId) = OANDARequest request + where + request = + baseApiRequest env "GET" ("/v3/accounts/" ++ accountId) + +data AccountChanges = + AccountChanges + { accountChangesOrdersCreated :: [Order] + , accountChangesOrdersCancelled :: [Order] + , accountChangesOrdersFilled :: [Order] + , accountChangesOrdersTriggered :: [Order] + -- TODO: accountChangesTradesOpened :: [TradeSummary] + -- TODO: accountChangesTradesReduced :: [TradeSummary] + -- TODO: accountChangesTradesClosed :: [TradeSummary] + , accountChangesPositions :: [Position] + , accountChangesTransactions :: [Transaction] + } deriving (Show) + +deriveJSON (unPrefix "accountChanges") ''AccountChanges + +data AccountChangesState = + AccountChangesState + { accountChangesStateUnrealizedPL :: AccountUnits + -- TODO: accountChangesStateNAV :: AccountUnits + , accountChangesStateMarginUsed :: AccountUnits + , accountChangesStateMarginAvailable :: AccountUnits + , accountChangesStatePositionValue :: AccountUnits + , accountChangesStateMarginCloseoutUnrealizedPL :: Maybe AccountUnits + , accountChangesStateMarginCloseoutNAV :: Maybe AccountUnits + , accountChangesStateMarginCloseoutMarginUsed :: Maybe AccountUnits + , accountChangesStateMarginCloseoutPercent :: Maybe Decimal + , accountChangesStateMarginCloseoutPositionValue :: Maybe Decimal + , accountChangesStateWithdrawalLimit :: AccountUnits + , accountChangesStateMarginCallMarginUsed :: AccountUnits + , accountChangesStateMarginCallPercent :: Decimal + -- TODO: accountChangesStateOrders :: [DynamicOrderState] + -- TODO: accountChangesStateTrades :: [CalculatedTradeState] + -- TODO: accountChangesStatePositions :: [CalculatedPositionState] + } deriving (Show) + +deriveJSON (unPrefix "accountChangesState") ''AccountChangesState + +data AccountChangesResponse = + AccountChangesResponse + { accountChangesResponseChanges :: AccountChanges + , accountChangesResponseState :: AccountChangesState + , accountChangesResponseLastTransactionID :: TransactionID + } deriving (Show) + +deriveJSON (unPrefix "accountChangesResponse") ''AccountChangesResponse + +oandaAccountChanges :: OandaEnv -> AccountID -> TransactionID -> OANDARequest AccountChangesResponse +oandaAccountChanges env (AccountID accountId) (TransactionID sinceId) = OANDARequest request + where + request = + baseApiRequest env "GET" ("/v3/accounts/" ++ accountId ++ "/changes") + & setRequestQueryString params + params = [("sinceTransactionID", Just (BS8.pack $ show sinceId))] + +-- TODO: +-- GET /v3/accounts/{AccoundId}/summary +-- GET /v3/accounts/{AccoundId}/instruments +-- PATCH /v3/accounts/{AccoundId}/configuration diff --git a/src/OANDA/Environment.hs b/src/OANDA/Environment.hs deleted file mode 100644 --- a/src/OANDA/Environment.hs +++ /dev/null @@ -1,17 +0,0 @@ --- | 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/Instrument.hs b/src/OANDA/Instrument.hs new file mode 100644 --- /dev/null +++ b/src/OANDA/Instrument.hs @@ -0,0 +1,207 @@ +-- | Defines the endpoints listed in the +-- section of the +-- API. + +module OANDA.Instrument + ( CandlestickGranularity (..) + , granularityFromDiffTime + , granularityToDiffTime + , WeeklyAlignment (..) + , PriceValue (..) + , Candlestick (..) + , CandlestickData (..) + , CandlestickArgs (..) + , candlestickArgsInstrument + , candlestickArgsPrice + , candlestickArgsGranularity + , candlestickArgsCount + , candlestickArgsFrom + , candlestickArgsTo + , candlestickArgsSmooth + , candlestickArgsIncludeFirst + , candlestickArgsDailyAlignment + , candlestickArgsAlignmentTimezone + , candlestickArgsWeeklyAlignment + , candlestickArgs + , oandaCandles + , CandlestickResponse (..) + ) where + +import OANDA.Internal + +data CandlestickGranularity + = S5 + | S10 + | S15 + | S30 + | M1 + | M2 + | M4 + | M5 + | M10 + | M15 + | M30 + | H1 + | H2 + | H3 + | H4 + | H6 + | H8 + | H12 + | D + | W + | M + deriving (Show) + +deriveJSON defaultOptions ''CandlestickGranularity + +granularityFromDiffTime :: NominalDiffTime -> Maybe CandlestickGranularity +granularityFromDiffTime = go . toSeconds' + where + go 5 = Just S5 + go 10 = Just S10 + go 15 = Just S15 + go 30 = Just S30 + go 60 = Just M1 + go 120 = Just M2 + go 240 = Just M4 + go 300 = Just M5 + go 600 = Just M10 + go 900 = Just M15 + go 1800 = Just M30 + go 3600 = Just H1 + go 7200 = Just H2 + go 10800 = Just H3 + go 14400 = Just H4 + go 21600 = Just H6 + go 28800 = Just H8 + go 43200 = Just H12 + go 86400 = Just D + go 604800 = Just W + -- go _ = Just M -- Not well-defined for a month + go _ = Nothing + +-- | 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 :: CandlestickGranularity -> 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 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 + +data WeeklyAlignment + = Monday + | Tuesday + | Wednesday + | Thursday + | Friday + | Saturday + | Sunday + deriving (Show) + +newtype PriceValue = PriceValue { unPriceValue :: Text } + deriving (Show, ToJSON, FromJSON) + +data CandlestickData + = CandlestickData + { candlestickDataO :: PriceValue + , candlestickDataH :: PriceValue + , candlestickDataL :: PriceValue + , candlestickDataC :: PriceValue + } deriving (Show) + +deriveJSON (unPrefix "candlestickData") ''CandlestickData + +data Candlestick + = Candlestick + { candlestickTime :: OandaZonedTime + , candlestickBid :: Maybe CandlestickData + , candlestickAsk :: Maybe CandlestickData + , candlestickMid :: Maybe CandlestickData + , candlestickVolume :: Integer + , candlestickComplete :: Bool + } deriving (Show) + +deriveJSON (unPrefix "candlestick") ''Candlestick + +data CandlestickArgs + = CandlestickArgs + { _candlestickArgsInstrument :: InstrumentName + , _candlestickArgsPrice :: Maybe Text + , _candlestickArgsGranularity :: CandlestickGranularity + , _candlestickArgsCount :: Maybe Int + , _candlestickArgsFrom :: Maybe ZonedTime + , _candlestickArgsTo :: Maybe ZonedTime + , _candlestickArgsSmooth :: Maybe Bool + , _candlestickArgsIncludeFirst :: Maybe Bool + , _candlestickArgsDailyAlignment :: Maybe Int + , _candlestickArgsAlignmentTimezone :: Maybe String + , _candlestickArgsWeeklyAlignment :: Maybe WeeklyAlignment + } + +candlestickArgs :: InstrumentName -> CandlestickGranularity -> CandlestickArgs +candlestickArgs instrument granularity = + CandlestickArgs + { _candlestickArgsInstrument = instrument + , _candlestickArgsPrice = Nothing + , _candlestickArgsGranularity = granularity + , _candlestickArgsCount = Nothing + , _candlestickArgsFrom = Nothing + , _candlestickArgsTo = Nothing + , _candlestickArgsSmooth = Nothing + , _candlestickArgsIncludeFirst = Nothing + , _candlestickArgsDailyAlignment = Nothing + , _candlestickArgsAlignmentTimezone = Nothing + , _candlestickArgsWeeklyAlignment = Nothing + } + +makeLenses ''CandlestickArgs + +oandaCandles :: OandaEnv -> CandlestickArgs -> OANDARequest CandlestickResponse +oandaCandles env CandlestickArgs{..} = OANDARequest request + where + instrumentText = unpack $ unInstrumentName _candlestickArgsInstrument + request = + baseApiRequest env "GET" ("/v3/instruments/" ++ instrumentText ++ "/candles") + & setRequestQueryString params + params = + catMaybes + [ ("price",) . Just . encodeUtf8 <$> _candlestickArgsPrice + , Just ("granularity", Just . fromString $ show _candlestickArgsGranularity) + , ("count",) . Just . fromString . show <$> _candlestickArgsCount + , ("from",) . Just . fromString . formatTimeRFC3339 <$> _candlestickArgsFrom + , ("to",) . Just . fromString . formatTimeRFC3339 <$> _candlestickArgsTo + , ("smooth",) . Just . fromString . show <$> _candlestickArgsSmooth + , ("includeFirst",) . Just . fromString . show <$> _candlestickArgsIncludeFirst + , ("dailyAlignment",) . Just . fromString . show <$> _candlestickArgsDailyAlignment + , ("alignmentTimezone",) . Just . fromString . show <$> _candlestickArgsAlignmentTimezone + , ("weeklyAlignment",) . Just . fromString . show <$> _candlestickArgsWeeklyAlignment + ] + +data CandlestickResponse + = CandlestickResponse + { candlestickResponseInstrument :: InstrumentName + , candlestickResponseGranularity :: CandlestickGranularity + , candlestickResponseCandles :: [Candlestick] + } deriving (Show) + +deriveJSON (unPrefix "candlestickResponse") ''CandlestickResponse diff --git a/src/OANDA/Internal.hs b/src/OANDA/Internal.hs --- a/src/OANDA/Internal.hs +++ b/src/OANDA/Internal.hs @@ -1,12 +1,8 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} - -- | Utility functions. module OANDA.Internal - ( module X - ) where + ( module X + ) where import OANDA.Internal.Import as X import OANDA.Internal.Request as X diff --git a/src/OANDA/Internal/Import.hs b/src/OANDA/Internal/Import.hs --- a/src/OANDA/Internal/Import.hs +++ b/src/OANDA/Internal/Import.hs @@ -3,33 +3,61 @@ module OANDA.Internal.Import ( module X - , (.~) - , (^.) - , (&) - , mzero - , toLower - , catMaybes - , Text - , intercalate - , unpack - , pack - , Generic - , defaultTimeLocale - , (<>) + , unPrefix + , parseJSONFromString ) where -import Control.Lens ((.~), (^.), (&)) -import Control.Monad (mzero) +import Control.Lens as X + ( (.~) + , (^.) + , (&) + , makeLenses + ) +import Control.Monad as X (mzero) import Data.Aeson as X -import Data.Char (toLower) +import Data.Aeson.TH as X +import Data.Aeson.Types as X +import Data.Char as X (toLower) import Data.Decimal as X -import Data.Maybe (catMaybes) -import Data.Monoid ((<>)) +import Data.Maybe as X (catMaybes) +import Data.Monoid as X ((<>)) import Data.Scientific as X -import Data.Text (Text, intercalate, unpack, pack) +import Data.String as X (IsString (..), fromString) +import Data.Text as X (Text, 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) +import System.Locale as X (defaultTimeLocale) +import Text.Read (readMaybe) + +-- | Aeson Options that remove the prefix from fields +unPrefix :: String -> Options +unPrefix prefix = defaultOptions + { fieldLabelModifier = unCapitalize . dropPrefix prefix + , omitNothingFields = True + } + +-- | Lower case leading character +unCapitalize :: String -> String +unCapitalize [] = [] +unCapitalize (c:cs) = toLower c : cs + +-- | Remove given prefix +dropPrefix :: String -> String -> String +dropPrefix prefix input = go prefix input + where + go pre [] = error $ contextual $ "prefix leftover: " <> pre + go [] (c:cs) = c : cs + go (p:preRest) (c:cRest) + | p == c = go preRest cRest + | otherwise = error $ contextual $ "not equal: " <> (p:preRest) <> " " <> (c:cRest) + + contextual msg = "dropPrefix: " <> msg <> ". " <> prefix <> " " <> input + +parseJSONFromString :: (Read a) => Value -> Parser a +parseJSONFromString v = do + numString <- parseJSON v + case readMaybe (numString :: String) of + Nothing -> fail $ "Invalid number for TransactionID: " ++ show v + Just n -> return n diff --git a/src/OANDA/Internal/Request.hs b/src/OANDA/Internal/Request.hs --- a/src/OANDA/Internal/Request.hs +++ b/src/OANDA/Internal/Request.hs @@ -1,67 +1,87 @@ -{-# LANGUAGE OverloadedStrings #-} - {-# OPTIONS_GHC -fno-warn-orphans #-} --- | Internal module for dealing with requests via wreq +-- | Internal module for dealing with requests via http-conduit module OANDA.Internal.Request - ( constructRequest - , baseURL - , commaList - , jsonOpts - , jsonResponse - , jsonResponseArray - -- , jsonDelete + ( OANDARequest (..) + , makeOandaRequest + , OANDAStreamingRequest (..) + , makeOandaStreamingRequest + , baseApiRequest + , baseStreamingRequest + , apiBaseURL + , streamingBaseURL , formatTimeRFC3339 ) where -import qualified Data.Aeson.TH as TH +import Control.Monad.IO.Class +import Control.Monad.Trans.Resource (MonadResource) import qualified Data.ByteString as BS -import qualified Data.Map as Map +import Data.Conduit +import qualified Network.HTTP.Client as H import OANDA.Internal.Import import OANDA.Internal.Types +-- | This is the type returned by the API functions. This is meant to be used +-- with some of our request functions, depending on how safe the user wants to +-- be. +newtype OANDARequest a = OANDARequest { unOANDARequest :: Request } + deriving (Show) + +-- | Simplest way to make requests, but throws exception on errors. +makeOandaRequest :: (MonadIO m, FromJSON a) => OANDARequest a -> m a +makeOandaRequest (OANDARequest request) = getResponseBody <$> httpJSON request + +-- | This is the type returned by the streaming API functions. This is meant to +-- be used with some of our streaming request functions, depending on how safe +-- the user wants to be. +newtype OANDAStreamingRequest a = OANDAStreamingRequest { unOANDAStreamingRequest :: Request } + deriving (Show) + +-- | Simplest way to make streaming, but throws exception on errors. +makeOandaStreamingRequest :: (MonadResource m, FromJSON a) => OANDAStreamingRequest a -> Source m a +makeOandaStreamingRequest (OANDAStreamingRequest request) = httpSource request parseBody + where + --parseBody :: (MonadIO m) => Response (Source m ByteString) -> Source m a + parseBody response = mapOutput (either error id . eitherDecodeStrict) $ getResponseBody response + -- | 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" +apiBaseURL :: OandaEnv -> String +apiBaseURL env = apiEndpoint (apiType env) + where + 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' +-- | Specifies the streaming endpoints for each `APIType`. These are the base +-- URLs for each streaming call. +streamingBaseURL :: OandaEnv -> String +streamingBaseURL env = apiEndpoint (apiType env) 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 + apiEndpoint Practice = "https://stream-fxpractice.oanda.com" + apiEndpoint Live = "https://stream-fxtrade.oanda.com" --- | Convert a Maybe [Text] item into empty text or comma-separated text. -commaList :: [Text] -> Text -commaList = intercalate "," +-- | Creates a request with the needed base url and an Authorization header for +-- the Bearer token. +baseRequest :: OandaEnv -> String -> String -> String -> Request +baseRequest env baseUrl requestType url = + unsafeParseRequest (requestType ++ " " ++ baseUrl ++ url) + & makeAuthHeader (accessToken env) + where + makeAuthHeader (AccessToken t) = addRequestHeader "Authorization" ("Bearer " `BS.append` t) --- | 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 +baseApiRequest :: OandaEnv -> String -> String -> Request +baseApiRequest env = baseRequest env (apiBaseURL env) --- | Boilerplate function to perform a request and extract the response body. -jsonResponse :: (FromJSON a) => Request -> IO a -jsonResponse request = getResponseBody <$> httpJSON request +baseStreamingRequest :: OandaEnv -> String -> String -> Request +baseStreamingRequest env = baseRequest env (streamingBaseURL env) --- | 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) +unsafeParseRequest :: String -> Request +unsafeParseRequest = unsafeParseRequest' . H.parseUrlThrow + where + unsafeParseRequest' (Left err) = error $ show err + unsafeParseRequest' (Right request) = request -- | Formats time according to RFC3339 (which is the time format used by -- OANDA). Taken from the library. @@ -72,6 +92,8 @@ then "Z" else take 3 timeZoneStr <> ":" <> drop 3 timeZoneStr +instance (Show a, Integral a) => ToJSON (DecimalRaw a) where + toJSON = toJSON . show instance (Integral a) => FromJSON (DecimalRaw a) where parseJSON (Number n) = readDecimalJSON n diff --git a/src/OANDA/Internal/Types.hs b/src/OANDA/Internal/Types.hs --- a/src/OANDA/Internal/Types.hs +++ b/src/OANDA/Internal/Types.hs @@ -1,76 +1,88 @@ -{-# 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 + ( OandaEnv + , apiType + , accessToken + , practiceAuth + , liveAuth + , APIType (..) + , AccessToken (..) + , AccountID (..) + , InstrumentText + , InstrumentName (..) + , AccountUnits (..) + , Currency (..) + , OandaZonedTime (..) + ) where +import Control.Applicative ((<|>)) +import Control.Lens (from, view) import qualified Data.ByteString as BS +import Data.Thyme.Clock.POSIX (posixTime) +import Data.Thyme.Time.Core (fromMicroseconds) + import OANDA.Internal.Import +import Debug.Trace + -- | 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. +-- `practiceAuth` or `liveAuth` functions. data OandaEnv = OandaEnv { apiType :: APIType - , accessToken :: Maybe AccessToken + , accessToken :: AccessToken } deriving (Show) --- | Use the sandbox API. -sandboxAuth :: OandaEnv -sandboxAuth = OandaEnv Sandbox Nothing - -- | Use the practice API. practiceAuth :: AccessToken -> OandaEnv -practiceAuth = OandaEnv Practice . Just +practiceAuth = OandaEnv Practice -- | Use the live API. liveAuth :: AccessToken -> OandaEnv -liveAuth = OandaEnv Live . Just - +liveAuth = OandaEnv Live -- | The three endpoint types used in the REST API. See the following link for -- details: -data APIType = Sandbox - | Practice - | Live - deriving (Show) +data APIType + = Practice + | Live + deriving (Show) -- | The token given by OANDA used to access the API newtype AccessToken = AccessToken { unAccessToken :: BS.ByteString } - deriving (Show) - + deriving (Show) -- | Integer representing the Account ID of an account -newtype AccountID = AccountID { unAccountID :: Int} - deriving (Show) +newtype AccountID = AccountID { unAccountID :: String } + deriving (Show, FromJSON, ToJSON) --- | Used when reporting a position in the API -data Side = Buy - | Sell - deriving (Show, Generic) +type InstrumentText = Text -instance FromJSON Side where - parseJSON (String s) = fmap readSide (pure $ unpack s) - parseJSON _ = mzero +newtype InstrumentName = InstrumentName { unInstrumentName :: Text } + deriving (Show, FromJSON, ToJSON, IsString) +newtype AccountUnits = AccountUnits { unAccountUnits :: Text } + deriving (Show, FromJSON, ToJSON, IsString) -readSide :: String -> Side -readSide "buy" = Buy -readSide "sell" = Sell -readSide _ = error "No parse Side" +newtype Currency = Currency { unCurrency :: Text } + deriving (Show, FromJSON, ToJSON, IsString) -type InstrumentText = Text +-- | Newtype wrapper around 'ZonedTime' to make a new JSON instance. Apparently +-- OANDA decides to use either UNIX epoch seconds or RFC3339 on the fly. +newtype OandaZonedTime = OandaZonedTime { unOandaZonedTime :: ZonedTime } + deriving (Show, Eq, ToJSON) + +instance FromJSON OandaZonedTime where + parseJSON v = OandaZonedTime <$> (parseJSON v <|> parseZonedFromEpoch v) + where + -- If we reach this branch then OANDA has encoded the time as a string + -- with a number that represents the seconds since the epoch. + parseZonedFromEpoch :: Value -> Parser ZonedTime + parseZonedFromEpoch v' = do + (secondsSinceEpoch :: Double) <- parseJSONFromString v' + let + microsecondsSinceEpoch = secondsSinceEpoch * 1e6 + (timeInUTC :: UTCTime) = view (from posixTime) (fromMicroseconds (round microsecondsSinceEpoch) :: NominalDiffTime) + (timeInZoned :: ZonedTime) = view zonedTime (utc, timeInUTC) + return $ traceShow (secondsSinceEpoch, microsecondsSinceEpoch, timeInUTC, timeInZoned) timeInZoned diff --git a/src/OANDA/Orders.hs b/src/OANDA/Orders.hs --- a/src/OANDA/Orders.hs +++ b/src/OANDA/Orders.hs @@ -1,42 +1,152 @@ -{-# LANGUAGE DeriveGeneric #-} - -- | Defines the endpoints listed in the --- section of the API. - +-- section of the API. -module OANDA.Orders - ( openOrders - , Order (..) - ) where +module OANDA.Orders where -import qualified Data.Vector as V +import Data.List (intercalate) +import OANDA.Instrument import OANDA.Internal +import OANDA.Transactions --- | Get all open orders for an account. -openOrders :: OandaEnv -> AccountID -> IO (V.Vector Order) -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 + { orderId :: OrderID + , orderCreateTime :: OandaZonedTime + , orderState :: OrderState + , orderClientExtensions :: Maybe ClientExtensions + , orderType :: OrderType + , orderInstrument :: Maybe InstrumentName + , orderUnits :: Maybe Decimal + , orderTimeInForce :: Maybe TimeInForce + , orderPrice :: Maybe PriceValue + , orderPriceBound :: Maybe PriceValue + , orderPositionFill :: Maybe OrderPositionFill + , orderInitialMarketPrice :: Maybe PriceValue + , orderTradeClose :: Maybe MarketOrderTradeClose + , orderTradeID :: Maybe TradeID + , orderClientTradeID :: Maybe Text + , orderDistance :: Maybe PriceValue + , orderLongPositionCloseout :: Maybe MarketOrderPositionCloseout + , orderShortPositionCloseout :: Maybe MarketOrderPositionCloseout + , orderMarginCloseout :: Maybe MarketOrderMarginCloseout + , orderDelayedTradeClose :: Maybe MarketOrderDelayedTradeClose + , orderTakeProfitOnFill :: Maybe TakeProfitDetails + , orderStopLossOnFill :: Maybe StopLossDetails + , orderTrailingStopLossOnFill :: Maybe TrailingStopLossDetails + , orderTradeClientExtensions :: Maybe ClientExtensions + , orderFillingTransactionID :: Maybe TransactionID + , orderFilledTime :: Maybe OandaZonedTime + , orderTradeOpenedID :: Maybe TradeID + , orderTradeReducedID :: Maybe TradeID + , orderTradeClosedIDs :: Maybe [TradeID] + , orderCancellingTransactionID :: Maybe TransactionID + , orderCancelledTime :: Maybe OandaZonedTime + , orderGtdTime :: Maybe OandaZonedTime + , orderReplacesOrderID :: Maybe OrderID + , orderReplacedByOrderID :: Maybe OrderID + } deriving (Show) +deriveJSON (unPrefix "order") ''Order -data Order = Order - { orderId :: Integer - , orderInstrument :: InstrumentText - , orderUnits :: Integer - , orderSide :: Side - , orderType :: Text -- "marketIfTouched", - , orderTime :: ZonedTime - , orderPrice :: Decimal - , orderTakeProfit :: Decimal - , orderStopLoss :: Decimal - , orderExpiry :: ZonedTime - , orderUpperBound :: Decimal - , orderLowerBound :: Decimal - , orderTrailingStop :: Decimal - } deriving (Show, Generic) +data OrdersArgs + = OrdersArgs + { _ordersArgsIds :: Maybe [OrderID] + , _ordersArgsState :: Maybe OrderState + , _ordersArgsInstrument :: Maybe InstrumentName + , _ordersArgsCount :: Maybe Int + , _ordersArgsBeforeID :: Maybe OrderID + } deriving (Show) +ordersArgs :: OrdersArgs +ordersArgs = OrdersArgs Nothing Nothing Nothing Nothing Nothing -instance FromJSON Order where - parseJSON = genericParseJSON $ jsonOpts "order" +makeLenses ''OrdersArgs + +data OrdersResponse + = OrdersResponse + { ordersResponseOrders :: [Order] + , ordersResponseLastTransactionID :: TransactionID + } deriving (Show) + +deriveJSON (unPrefix "ordersResponse") ''OrdersResponse + +oandaOrders :: OandaEnv -> AccountID -> OrdersArgs -> OANDARequest OrdersResponse +oandaOrders env (AccountID accountId) OrdersArgs{..} = OANDARequest request + where + request = + baseApiRequest env "GET" ("/v3/accounts/" ++ accountId ++ "/orders") + & setRequestQueryString params + params = + catMaybes + [ ("ids",) . Just . fromString . intercalate "," . fmap (show . unOrderID) <$> _ordersArgsIds + , ("state",) . Just . fromString . show <$> _ordersArgsState + , ("instrument",) . Just . fromString . unpack . unInstrumentName <$> _ordersArgsInstrument + , ("count",) . Just . fromString . show <$> _ordersArgsCount + , ("beforeID",) . Just . fromString . show . unOrderID <$> _ordersArgsBeforeID + ] + +data OrderRequest + = OrderRequest + { _orderRequestType :: OrderType + , _orderRequestClientExtensions :: Maybe ClientExtensions + , _orderRequestInstrument :: Maybe InstrumentName + , _orderRequestUnits :: Maybe Decimal + , _orderRequestTimeInForce :: Maybe TimeInForce + , _orderRequestPrice :: Maybe PriceValue + , _orderRequestPriceBound :: Maybe PriceValue + , _orderRequestPositionFill :: Maybe OrderPositionFill + , _orderRequestTradeID :: Maybe TradeID + , _orderRequestClientTradeID :: Maybe Text + , _orderRequestDistance :: Maybe PriceValue + , _orderRequestTakeProfitOnFill :: Maybe TakeProfitDetails + , _orderRequestStopLossOnFill :: Maybe StopLossDetails + , _orderRequestTrailingStopLossOnFill :: Maybe TrailingStopLossDetails + , _orderRequestTradeClientExtensions :: Maybe ClientExtensions + , _orderRequestGtdTime :: Maybe ZonedTime + } deriving (Show) + +makeLenses ''OrderRequest + +orderRequest :: OrderType -> OrderRequest +orderRequest orderType = + OrderRequest + { _orderRequestType = orderType + , _orderRequestClientExtensions = Nothing + , _orderRequestInstrument = Nothing + , _orderRequestUnits = Nothing + , _orderRequestTimeInForce = Nothing + , _orderRequestPrice = Nothing + , _orderRequestPriceBound = Nothing + , _orderRequestPositionFill = Nothing + , _orderRequestTradeID = Nothing + , _orderRequestClientTradeID = Nothing + , _orderRequestDistance = Nothing + , _orderRequestTakeProfitOnFill = Nothing + , _orderRequestStopLossOnFill = Nothing + , _orderRequestTrailingStopLossOnFill = Nothing + , _orderRequestTradeClientExtensions = Nothing + , _orderRequestGtdTime = Nothing + } + +deriveJSON (unPrefix "_orderRequest") ''OrderRequest + +data CreateOrderResponse + = CreateOrderResponse + { createOrderResponseOrderCreateTransaction :: Transaction + , createOrderResponseOrderFillTransaction :: Maybe Transaction + , createOrderResponseOrderCancelTransaction :: Maybe Transaction + , createOrderResponseOrderReissueTransaction :: Maybe Transaction + , createOrderResponseOrderReissueRejectTransaction :: Maybe Transaction + , createOrderResponseRelatedTransactionIDs :: [TransactionID] + , createOrderResponseLastTransactionID :: TransactionID + } deriving (Show) + +deriveJSON (unPrefix "createOrderResponse") ''CreateOrderResponse + +oandaCreateOrder :: OandaEnv -> AccountID -> OrderRequest -> OANDARequest CreateOrderResponse +oandaCreateOrder env (AccountID accountId) orderRequest' = OANDARequest request + where + request = + baseApiRequest env "POST" ("/v3/accounts/" ++ accountId ++ "/orders") + & setRequestBodyJSON (object ["order" .= orderRequest']) diff --git a/src/OANDA/Positions.hs b/src/OANDA/Positions.hs deleted file mode 100644 --- a/src/OANDA/Positions.hs +++ /dev/null @@ -1,59 +0,0 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} - --- | Defines the endpoints listed in the --- section of the --- API. - -module OANDA.Positions - ( Position (..) - , openPositions - , position - , closePosition - , CloseResponse (..) - ) where - -import qualified Data.Vector as V - -import OANDA.Internal - --- | Get all open positions for an account. -openPositions :: OandaEnv -> AccountID -> IO (V.Vector Position) -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 :: Text - , positionUnits :: Int - , positionSide :: Side - , positionAvgPrice :: Decimal - } deriving (Show, Generic) - -instance FromJSON Position where - parseJSON = genericParseJSON $ jsonOpts "position" - --- | Get open position for an account on a given instrument. -position :: OandaEnv -> AccountID -> InstrumentText -> IO Position -position od (AccountID aid) ins = do - let url = "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 = "DELETE " ++ baseURL od ++ "/v1/accounts/" ++ show aid ++ "/positions/" ++ unpack ins - request <- constructRequest od url [] - jsonResponse request - -data CloseResponse = CloseResponse - { closeResponseIds :: V.Vector Int - , closeResponseInstrument :: InstrumentText - , closeResponseTotalUnits :: Int - , closeResponsePrice :: Decimal - } deriving (Show, Generic) - -instance FromJSON CloseResponse where - parseJSON = genericParseJSON $ jsonOpts "closeResponse" diff --git a/src/OANDA/Pricing.hs b/src/OANDA/Pricing.hs new file mode 100644 --- /dev/null +++ b/src/OANDA/Pricing.hs @@ -0,0 +1,116 @@ +-- | Defines the endpoints listed in the +-- section of +-- the API. + +module OANDA.Pricing where + +import qualified Data.ByteString.Lazy as BSL +import Data.List (intercalate) + +import OANDA.Instrument +import OANDA.Internal + +data PriceBucket + = PriceBucket + { priceBucketPrice :: PriceValue + , priceBucketLiquidity :: Integer + } deriving (Show) + +deriveJSON (unPrefix "priceBucket") ''PriceBucket + +data Price + = Price + { priceInstrument :: InstrumentName + , priceTime :: OandaZonedTime + , priceStatus :: Text + , priceBids :: [PriceBucket] + , priceAsks :: [PriceBucket] + , priceCloseoutBid :: PriceValue + , priceCloseoutAsk :: PriceValue + } deriving (Show) + +deriveJSON (unPrefix "price") ''Price + +data PricingArgs + = PricingArgs + { _pricingArgsInstruments :: [InstrumentName] + , _pricingArgsSince :: Maybe ZonedTime + } deriving (Show) + +makeLenses ''PricingArgs + +pricingArgs :: [InstrumentName] -> PricingArgs +pricingArgs instruments = + PricingArgs + { _pricingArgsInstruments = instruments + , _pricingArgsSince = Nothing + } + +data PricingResponse + = PricingResponse + { pricingResponsePrices :: [Price] + } deriving (Show) + +deriveJSON (unPrefix "pricingResponse") ''PricingResponse + +oandaPricing :: OandaEnv -> AccountID -> PricingArgs -> OANDARequest PricingResponse +oandaPricing env (AccountID accountId) PricingArgs{..} = OANDARequest request + where + request = + baseApiRequest env "GET" ("/v3/accounts/" ++ accountId ++ "/pricing") + & setRequestQueryString params + params = + catMaybes + [ Just ("instruments", Just . fromString . intercalate "," . fmap (unpack . unInstrumentName) $ _pricingArgsInstruments) + , ("since",) . Just . fromString . formatTimeRFC3339 <$> _pricingArgsSince + ] + +data PricingStreamArgs + = PricingStreamArgs + { _pricingStreamArgsInstruments :: [InstrumentName] + , _pricingStreamArgsSnapshot :: Maybe Bool + } deriving (Show) + +makeLenses ''PricingStreamArgs + +pricingStreamArgs :: [InstrumentName] -> PricingStreamArgs +pricingStreamArgs instruments = + PricingStreamArgs + { _pricingStreamArgsInstruments = instruments + , _pricingStreamArgsSnapshot = Nothing + } + +data PricingHeartbeat + = PricingHeartbeat + { pricingHeartbeatTime :: OandaZonedTime + } deriving (Show) + +deriveJSON (unPrefix "pricingHeartbeat") ''PricingHeartbeat + +data PricingStreamResponse + = StreamPricingHeartbeat PricingHeartbeat + | StreamPrice Price + deriving (Show) + +-- The ToJSON instance is just for debugging, it's not actually correct +deriveToJSON defaultOptions ''PricingStreamResponse + +instance FromJSON PricingStreamResponse where + parseJSON (Object o) = do + type' <- o .: "type" :: Parser String + case type' of + "HEARTBEAT" -> StreamPricingHeartbeat <$> parseJSON (Object o) + _ -> StreamPrice <$> parseJSON (Object o) + parseJSON _ = mempty + +oandaPricingStream :: OandaEnv -> AccountID -> PricingStreamArgs -> OANDAStreamingRequest PricingStreamResponse +oandaPricingStream env (AccountID accountId) PricingStreamArgs{..} = OANDAStreamingRequest request + where + request = + baseStreamingRequest env "GET" ("/v3/accounts/" ++ accountId ++ "/pricing/stream") + & setRequestQueryString params + params = + catMaybes + [ Just ("instruments", Just . fromString . intercalate "," . fmap (unpack . unInstrumentName) $ _pricingStreamArgsInstruments) + , ("since",) . Just . BSL.toStrict . encode <$> _pricingStreamArgsSnapshot + ] diff --git a/src/OANDA/Rates.hs b/src/OANDA/Rates.hs deleted file mode 100644 --- a/src/OANDA/Rates.hs +++ /dev/null @@ -1,256 +0,0 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} - --- | Defines the endpoints listed in the --- section of the API. - -module OANDA.Rates - ( InstrumentsArgs (..) - , instrumentsArgs - , Instrument (..) - , instruments - , Price (..) - , prices - , MidpointCandlestick (..) - , midpointCandles - , BidAskCandlestick (..) - , bidaskCandles - , CandlesArgs (..) - , candlesArgs - , CandlesCount (..) - , DayOfWeek (..) - , Granularity (..) - , granularityToDiffTime - ) where - -import qualified Data.Vector as V - -import OANDA.Internal - - -data InstrumentsArgs = InstrumentsArgs - { instrumentsFields :: Maybe [Text] - , instrumentsInstruments :: Maybe [Text] - } deriving (Show) - -instrumentsArgs :: InstrumentsArgs -instrumentsArgs = InstrumentsArgs Nothing Nothing - -data Instrument = Instrument - { instrumentInstrument :: Text - , instrumentPip :: Maybe Decimal - , instrumentMaxTradeUnits :: Maybe Integer - , instrumentDisplayName :: Maybe Text - , instrumentPrecision :: Maybe Decimal - , instrumentMaxTrailingStop :: Maybe Decimal - , instrumentMinTrailingStop :: Maybe Decimal - , instrumentMarginRate :: Maybe Decimal - , instrumentHalted :: Maybe Bool - , instrumentInterestRate :: Maybe Object - } deriving (Show, Generic) - -instance FromJSON Instrument where - parseJSON = genericParseJSON $ jsonOpts "instrument" - --- | Retrieve a list of instruments from OANDA -instruments :: OandaEnv -> AccountID -> InstrumentsArgs -> IO (V.Vector Instrument) -instruments od (AccountID aid) (InstrumentsArgs fs is) = do - let url = "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 = "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 - , priceTime :: ZonedTime - , priceBid :: Decimal - , priceAsk :: Decimal - } deriving (Show, Generic) - -instance FromJSON Price where - parseJSON = genericParseJSON $ jsonOpts "price" - - --- | Retrieve the price history of a single instrument in midpoint candles -midpointCandles :: OandaEnv -> InstrumentText -> CandlesArgs -> - IO (V.Vector MidpointCandlestick) -midpointCandles od i args = do - 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 - 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 -> 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 - , midpointCandlestickOpenMid :: Decimal - , midpointCandlestickHighMid :: Decimal - , midpointCandlestickLowMid :: Decimal - , midpointCandlestickCloseMid :: Decimal - , midpointCandlestickVolume :: Int - , midpointCandlestickComplete :: Bool - } deriving (Show, Generic) - -instance FromJSON MidpointCandlestick where - parseJSON = genericParseJSON $ jsonOpts "midpointCandlestick" - - -data BidAskCandlestick = BidAskCandlestick - { bidaskCandlestickTime :: ZonedTime - , bidaskCandlestickOpenBid :: Decimal - , bidaskCandlestickOpenAsk :: Decimal - , bidaskCandlestickHighBid :: Decimal - , bidaskCandlestickHighAsk :: Decimal - , bidaskCandlestickLowBid :: Decimal - , bidaskCandlestickLowAsk :: Decimal - , bidaskCandlestickCloseBid :: Decimal - , bidaskCandlestickCloseAsk :: Decimal - , bidaskCandlestickVolume :: Int - , bidaskCandlestickComplete :: Bool - } deriving (Show, Generic) - -instance FromJSON BidAskCandlestick where - parseJSON = genericParseJSON $ jsonOpts "bidaskCandlestick" - -data CandlesArgs = CandlesArgs - { candlesCount :: Maybe CandlesCount - , candlesGranularity :: Maybe Granularity - , candlesDailyAlignment :: Maybe Int - , candlesAlignmentTZ :: Maybe Text - , candlesWeeklyAlignment :: Maybe DayOfWeek - } deriving (Show) - -candlesArgs :: CandlesArgs -candlesArgs = CandlesArgs Nothing Nothing Nothing Nothing Nothing - -data CandlesCount = Count Int - | StartEnd - { start :: ZonedTime - , end :: ZonedTime - , includeFirst :: Bool - } - | StartCount - { start :: ZonedTime - , count :: Int - , includeFirst :: Bool - } - | EndCount - { end :: ZonedTime - , count :: Int - } - deriving (Show) - -data DayOfWeek = Monday - | Tuesday - | Wednesday - | Thursday - | Friday - | Saturday - | Sunday - deriving (Show) - -data Granularity = S5 | S10 | S15 | S30 - | M1 | M2 | M3 | M4 | M5 | M10 | M15 | M30 - | H1 | H2 | H3 | H4 | H6 | H8 | H12 - | D - | W - | M - deriving (Show) - --- | Utility 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 :: Text - , _midcandlesResponseCandles :: V.Vector MidpointCandlestick - } deriving (Show, Generic) - - -instance FromJSON MidpointCandlesResponse where - parseJSON = genericParseJSON $ jsonOpts "_midcandlesResponse" - - --- | Utility type for `bidaskCandles` function response. Not exported. -data BidAskCandlesResponse = BidAskCandlesResponse - { _bidaskResponseInstrument :: InstrumentText - , _bidaskResponseGranularity :: Text - , _bidaskResponseCandles :: V.Vector BidAskCandlestick - } deriving (Show, Generic) - - -instance FromJSON BidAskCandlesResponse where - parseJSON = genericParseJSON $ jsonOpts "_bidaskResponse" diff --git a/src/OANDA/Trades.hs b/src/OANDA/Trades.hs deleted file mode 100644 --- a/src/OANDA/Trades.hs +++ /dev/null @@ -1,47 +0,0 @@ -{-# LANGUAGE DeriveGeneric #-} - --- | Defines the endpoints listed in the --- section of the --- API. - -module OANDA.Trades - ( Trade (..) - , openTrades - , tradeInfo - ) where - -import qualified Data.Vector as V - -import OANDA.Internal - -data Trade = Trade - { tradeId :: !Int - , tradeUnits :: !Int - , tradeSide :: !Side - , tradeInstrument :: !Text - , tradeTime :: !ZonedTime - , tradePrice :: !Decimal - , tradeTakeProfit :: !Decimal - , tradeStopLoss :: !Decimal - , tradeTrailingStop :: !Decimal - , tradeTrailingAmount :: !Decimal - } deriving (Show, Generic) - -instance FromJSON Trade where - parseJSON = genericParseJSON $ jsonOpts "trade" - --- | Gets a list of all open trades in an account. -openTrades :: OandaEnv -> AccountID -> IO (V.Vector Trade) -openTrades od (AccountID aid) = do - let url = "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 = "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 @@ -1,54 +1,330 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} - -- | Defines the endpoints listed in the --- section of the API. -module OANDA.Transactions - ( Transaction (..) - , transactionHistory - ) where +module OANDA.Transactions where -import qualified Data.Vector as V +import qualified Data.ByteString.Char8 as BS8 import OANDA.Internal --- data TransactionArgs = TransactionArgs --- { transactionsMaxID :: Maybe Integer --- , transactionsMinID :: Maybe Integer --- , transactionsCount :: Maybe Integer --- , transactionsInstrument :: Maybe InstrumentText --- , transactionsIds :: [Integer] --- } deriving (Show) +newtype OrderID = OrderID { unOrderID :: Int } + deriving (Show, Eq) --- | Get a list of transactions for the account. -transactionHistory :: OandaEnv -> AccountID -> IO (V.Vector Transaction) -transactionHistory od (AccountID aid) = - do let url = "GET " ++ baseURL od ++ "/v1/accounts/" ++ show aid ++ "/transactions" - request <- constructRequest od url [] - jsonResponseArray request "transactions" +instance ToJSON OrderID where + toJSON = toJSON . show . unOrderID +instance FromJSON OrderID where + parseJSON = fmap OrderID . parseJSONFromString +newtype TransactionID = TransactionID { unTransactionID :: Int } + deriving (Show, Eq) + +instance ToJSON TransactionID where + toJSON = toJSON . show . unTransactionID + +instance FromJSON TransactionID where + parseJSON = fmap TransactionID . parseJSONFromString + +newtype TradeID = TradeID { unTradeID :: Int } + deriving (Show, Eq) + +instance ToJSON TradeID where + toJSON = toJSON . show . unTradeID + +instance FromJSON TradeID where + parseJSON = fmap TradeID . parseJSONFromString + +data OrderType + = MARKET + | LIMIT + | STOP + | MARKET_IF_TOUCHED + | TAKE_PROFIT + | STOP_LOSS + | TRAILING_STOP_LOSS + deriving (Show, Eq) + +deriveJSON defaultOptions ''OrderType + +data OrderState + = PENDING + | FILLED + | TRIGGERED + | CANCELLED + deriving (Show, Eq) + +deriveJSON defaultOptions ''OrderState + +data ClientExtensions + = ClientExtensions + { clientExtensionsID :: Text + , clientExtensionsTag :: Text + , clientExtensionsComment :: Text + } deriving (Show) + +deriveJSON (unPrefix "clientExtensions") ''ClientExtensions + +data TimeInForce + = GTC + | GTD + | GFD + | FOK + | IOC + deriving (Show, Eq) + +deriveJSON defaultOptions ''TimeInForce + +data OrderPositionFill + = OPEN_ONLY + | REDUCE_FIRST + | REDUCE_ONLY + | POSITION_DEFAULT + deriving (Show, Eq) + +deriveJSON defaultOptions ''OrderPositionFill + +data MarketOrderPositionCloseout + = MarketOrderPositionCloseout + { marketOrderPositionCloseoutInstrument :: InstrumentName + , marketOrderPositionCloseoutUnits :: Text + } deriving (Show) + +deriveJSON (unPrefix "marketOrderPositionCloseout") ''MarketOrderPositionCloseout + +data MarketOrderTradeClose + = MarketOrderTradeClose + { marketOrderTradeCloseTradeID :: TradeID + , marketOrderTradeCloseClientTradeID :: Text + , marketOrderTradeCloseUnits :: Text + } deriving (Show) + +deriveJSON (unPrefix "marketOrderTradeClose") ''MarketOrderTradeClose + +data MarketOrderMarginCloseout + = MarketOrderMarginCloseout + { marketOrderMarginCloseoutReason :: Text + } deriving (Show) + +deriveJSON (unPrefix "marketOrderMarginCloseout") ''MarketOrderMarginCloseout + +data MarketOrderDelayedTradeClose + = MarketOrderDelayedTradeClose + { marketOrderDelayedTradeCloseTradeID :: TradeID + , marketOrderDelayedTradeCloseClientTradeID :: Text + , marketOrderDelayedTradeCloseSourceTransactionID :: TransactionID + } deriving (Show) + +deriveJSON (unPrefix "marketOrderDelayedTradeClose") ''MarketOrderDelayedTradeClose + +data TakeProfitDetails + = TakeProfitDetails + { takeProfitDetailsPrice :: Text + , takeProfitDetailsTimeInForce :: TimeInForce + , takeProfitDetailsGtdTime :: OandaZonedTime + , takeProfitDetailsClientExtensions :: Maybe ClientExtensions + } deriving (Show) + +deriveJSON (unPrefix "takeProfitDetails") ''TakeProfitDetails + +data StopLossDetails + = StopLossDetails + { stopLossDetailsPrice :: Text + , stopLossDetailsTimeInForce :: TimeInForce + , stopLossDetailsGtdTime :: OandaZonedTime + , stopLossDetailsClientExtensions :: Maybe ClientExtensions + } deriving (Show) + +deriveJSON (unPrefix "stopLossDetails") ''StopLossDetails + +data TrailingStopLossDetails + = TrailingStopLossDetails + { trailingStopLossDetailsDistance :: Text + , trailingStopLossDetailsTimeInForce :: TimeInForce + , trailingStopLossDetailsGtdTime :: OandaZonedTime + , trailingStopLossDetailsClientExtensions :: Maybe ClientExtensions + } deriving (Show) + +deriveJSON (unPrefix "trailingStopLossDetails") ''TrailingStopLossDetails + +data TransactionType + = CREATE + | CLOSE + | REOPEN + | CLIENT_CONFIGURE + | CLIENT_CONFIGURE_REJECT + | TRANSFER_FUNDS + | TRANSFER_FUNDS_REJECT + | MARKET_ORDER + | MARKET_ORDER_REJECT + | LIMIT_ORDER + | LIMIT_ORDER_REJECT + | STOP_ORDER + | STOP_ORDER_REJECT + | MARKET_IF_TOUCHED_ORDER + | MARKET_IF_TOUCHED_ORDER_REJECT + | TAKE_PROFIT_ORDER + | TAKE_PROFIT_ORDER_REJECT + | STOP_LOSS_ORDER + | STOP_LOSS_ORDER_REJECT + | TRAILING_STOP_LOSS_ORDER + | TRAILING_STOP_LOSS_ORDER_REJECT + | ORDER_FILL + | ORDER_CANCEL + | ORDER_CANCEL_REJECT + | ORDER_CLIENT_EXTENSIONS_MODIFY + | ORDER_CLIENT_EXTENSIONS_MODIFY_REJECT + | TRADE_CLIENT_EXTENSIONS_MODIFY + | TRADE_CLIENT_EXTENSIONS_MODIFY_REJECT + | MARGIN_CALL_ENTER + | MARGIN_CALL_EXTEND + | MARGIN_CALL_EXIT + | DELAYED_TRADE_CLOSURE + | DAILY_FINANCING + | RESET_RESETTABLE_PL + deriving (Show, Eq) + +deriveJSON defaultOptions ''TransactionType + +data TradeOpen + = TradeOpen + { tradeOpenTradeID :: TradeID + , tradeOpenUnits :: Decimal + , tradeOpenClientExtensions :: Maybe ClientExtensions + } deriving (Show) + +deriveJSON (unPrefix "tradeOpen") ''TradeOpen + +data TradeReduce + = TradeReduce + { tradeReduceTradeID :: TradeID + , tradeReduceUnits :: Decimal + , tradeReduceRealizedPL :: AccountUnits + , tradeReduceFinancing :: AccountUnits + } deriving (Show) + +deriveJSON (unPrefix "tradeReduce") ''TradeReduce + +data OpenTradeFinancing + = OpenTradeFinancing + { openTradeFinancingTradeID :: TradeID + , openTradeFinancingFinancing :: AccountUnits + } deriving (Show) + +deriveJSON (unPrefix "openTradeFinancing") ''OpenTradeFinancing + +data PositionFinancing + = PositionFinancing + { -- BUG: Their docs say instrumentID but the field is actually called instrument + positionFinancingInstrument :: InstrumentName + , positionFinancingFinancing :: AccountUnits + , positionFinancingOpenTradeFinancings :: [OpenTradeFinancing] + } deriving (Show) + +deriveJSON (unPrefix "positionFinancing") ''PositionFinancing + data Transaction = Transaction - { transactionId :: Integer - , transactionAccountId :: Integer - , transactionTime :: ZonedTime - , transactionType :: String -- Can be an enum type in the future - , transactionInstrument :: Maybe InstrumentText - , transactionSide :: Maybe Side - , transactionUnits :: Maybe Decimal - , transactionPrice :: Maybe Decimal - , transactionLowerBound :: Maybe Decimal - , transactionUpperBound :: Maybe Decimal - , transactionTakeProfitPrice :: Maybe Decimal - , transactionStopLossPrice :: Maybe Decimal - , transactionTrailingStopLossDistance :: Maybe Decimal - , transactionPL :: Maybe Decimal - , transactionInterest :: Maybe Decimal - , transactionAccountBalance :: Maybe Decimal - } deriving (Show, Generic) + { -- Common to all transactions + transactionId :: TransactionID + , transactionTime :: OandaZonedTime + , transactionAccountID :: AccountID + , transactionUserID :: Integer + , transactionBatchID :: TransactionID + , transactionType :: TransactionType + -- Specific to individual transactions + , transactionDivisionID :: Maybe Integer + , transactionSiteID :: Maybe Integer + , transactionAccountUserID :: Maybe Integer + , transactionAccountNumber :: Maybe Integer + , transactionHomeCurrency :: Maybe Currency + , transactionAlias :: Maybe Text + , transactionMarginRate :: Maybe Decimal + , transactionRejectReason :: Maybe Text + , transactionAmount :: Maybe AccountUnits + , transactionFundingReason :: Maybe Text + , transactionAccountBalance :: Maybe AccountUnits + , transactionInstrument :: Maybe InstrumentText + , transactionUnits :: Maybe Decimal + , transactionPrice :: Maybe Decimal + , transactionTimeInForce :: Maybe TimeInForce + , transactionPriceBound :: Maybe Text + , transactionPositionFill :: Maybe Text + , transactionMarketOrderTradeClose :: Maybe MarketOrderTradeClose + , transactionLongPositionCloseout :: Maybe MarketOrderPositionCloseout + , transactionShortPositionCloseout :: Maybe MarketOrderPositionCloseout + , transactionMarginCloseout :: Maybe MarketOrderMarginCloseout + , transactionDelayedTradeClose :: Maybe MarketOrderDelayedTradeClose + , transactionReason :: Maybe Text + , transactionClientExtensions :: Maybe ClientExtensions + , transactionTakeProfitOnFill :: Maybe TakeProfitDetails + , transactionStopLossOnFill :: Maybe StopLossDetails + , transactionTrailingStopLossOnFill :: Maybe TrailingStopLossDetails + , transactionTradeClientExtensions :: Maybe ClientExtensions + , transactionGtdTime :: Maybe OandaZonedTime + , transactionReplacesOrderID :: Maybe OrderID + , transactionReplacedOrderCancelTransactionID :: Maybe TransactionID + , transactionIntendedReplacesOrderID :: Maybe OrderID + , transactionDistance :: Maybe Text + , transactionOrderID :: Maybe OrderID + , transactionClientOrderID :: Maybe Text + , transactionPl :: Maybe AccountUnits + , transactionFinancing :: Maybe AccountUnits + , transactionTradeOpened :: Maybe TradeOpen + , transactionTradesClosed :: Maybe [TradeReduce] + , transactionTradeReduced :: Maybe TradeReduce + , transactionTradeClientExtensionsModify :: Maybe ClientExtensions + , transactionExtensionNumber :: Maybe Integer + , transactionTradeIDs :: Maybe TradeID + , transactionAccountFinancingMode :: Maybe Text + , transactionPositionFinancings :: Maybe [PositionFinancing] + } deriving (Show) -instance FromJSON Transaction where - parseJSON = genericParseJSON $ jsonOpts "transaction" +deriveJSON (unPrefix "transaction") ''Transaction + +oandaTransaction :: OandaEnv -> AccountID -> TransactionID -> OANDARequest Transaction +oandaTransaction env (AccountID accountId) (TransactionID transId) = + OANDARequest $ baseApiRequest env "GET" ("/v3/accounts/" ++ accountId ++ "/transactions/" ++ show transId) + +data TransactionsSinceIDResponse + = TransactionsSinceIDResponse + { transactionsSinceIDResponseTransactions :: [Transaction] + , transactionsSinceIDResponseLastTransactionID :: TransactionID + } deriving (Show) + +deriveJSON (unPrefix "transactionsSinceIDResponse") ''TransactionsSinceIDResponse + +oandaTransactionsSinceID :: OandaEnv -> AccountID -> TransactionID -> OANDARequest TransactionsSinceIDResponse +oandaTransactionsSinceID env (AccountID accountId) (TransactionID transId) = OANDARequest request + where + request = + baseApiRequest env "GET" ("/v3/accounts/" ++ accountId ++ "/transactions/sinceid") + & setRequestQueryString [("id", Just $ BS8.pack $ show transId)] + +data TransactionHeartbeat + = TransactionHeartbeat + { transactionHeartbeatLastTransactionID :: TransactionID + , transactionHeartbeatTime :: OandaZonedTime + } deriving (Show) + +deriveJSON (unPrefix "transactionHeartbeat") ''TransactionHeartbeat + +data TransactionsStreamResponse + = StreamTransactionHeartbeat TransactionHeartbeat + | StreamTransaction Transaction + deriving (Show) + +-- The ToJSON instance is just for debugging, it's not actually correct +deriveToJSON defaultOptions ''TransactionsStreamResponse + +instance FromJSON TransactionsStreamResponse where + parseJSON (Object o) = do + type' <- o .: "type" :: Parser String + case type' of + "HEARTBEAT" -> StreamTransactionHeartbeat <$> parseJSON (Object o) + _ -> StreamTransaction <$> parseJSON (Object o) + parseJSON _ = mempty + +oandaTransactionStream :: OandaEnv -> AccountID -> OANDAStreamingRequest TransactionsStreamResponse +oandaTransactionStream env (AccountID accountId) = + OANDAStreamingRequest $ baseStreamingRequest env "GET" ("/v3/accounts/" ++ accountId ++ "/transactions/stream") diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -1,3 +1,3 @@ -resolver: lts-7.9 +resolver: nightly-2017-03-02 packages: - '.' diff --git a/tests/HLint.hs b/tests/HLint.hs --- a/tests/HLint.hs +++ b/tests/HLint.hs @@ -5,10 +5,11 @@ arguments :: [String] arguments = - [ "--cpp-simple" - , "src" - , "tests" - ] + [ "--cpp-simple" + , "src" + , "tests" + , "-i", "Use newtype instead of data" + ] main :: IO () main = do