diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,3 @@ +# Changelog for ally-invest + +## Unreleased changes diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Vlad Levenfeld (c) 2020 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,7 @@ +# ally-invest + +Thin layer over Ally Invest API + +An API key from ally.com/invest is required + +Currently only timesales per day, quotes and account summary are implemented. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/ally-invest.cabal b/ally-invest.cabal new file mode 100644 --- /dev/null +++ b/ally-invest.cabal @@ -0,0 +1,74 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.33.0. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: a1d64dd3fd2d2ed04a17740ad997a09b067e7cbe9aee1e447796bfed5e6d6b68 + +name: ally-invest +version: 0.1.0.0 +synopsis: Ally Invest integration library +description: Please see the README on GitHub at +category: Finance +homepage: https://github.com/evenex/ally-invest#readme +bug-reports: https://github.com/evenex/ally-invest/issues +author: Vlad Levenfeld +maintainer: vlevenfeld@gmail.com +copyright: 2020 Vlad Levenfeld +license: BSD3 +license-file: LICENSE +build-type: Simple +extra-source-files: + README.md + ChangeLog.md + +source-repository head + type: git + location: https://github.com/evenex/ally-invest + +library + exposed-modules: + AllyInvest + AllyInvest.Account + AllyInvest.Credentials + AllyInvest.Error + AllyInvest.Internal + AllyInvest.Quote + AllyInvest.TimeSales + other-modules: + Paths_ally_invest + hs-source-dirs: + src + build-depends: + aeson >=1.4.7 && <1.5 + , authenticate-oauth >=1.6.0 && <1.7 + , base >=4.7 && <5 + , bytestring >=0.10.10 && <0.11 + , http-client >=0.6.4 && <0.7 + , http-client-tls >=0.3.5 && <0.4 + , safe >=0.3.18 && <0.4 + , text >=1.2.4 && <1.3 + , time >=1.9.3 && <1.10 + default-language: Haskell2010 + +test-suite ally-invest-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Paths_ally_invest + hs-source-dirs: + test + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: + aeson >=1.4.7 && <1.5 + , ally-invest + , authenticate-oauth >=1.6.0 && <1.7 + , base >=4.7 && <5 + , bytestring >=0.10.10 && <0.11 + , http-client >=0.6.4 && <0.7 + , http-client-tls >=0.3.5 && <0.4 + , safe >=0.3.18 && <0.4 + , text >=1.2.4 && <1.3 + , time >=1.9.3 && <1.10 + default-language: Haskell2010 diff --git a/src/AllyInvest.hs b/src/AllyInvest.hs new file mode 100644 --- /dev/null +++ b/src/AllyInvest.hs @@ -0,0 +1,13 @@ +module AllyInvest ( + module AllyInvest.Account +, module AllyInvest.Credentials +, module AllyInvest.Error +, module AllyInvest.Quote +, module AllyInvest.TimeSales +) where + +import AllyInvest.Account +import AllyInvest.Credentials +import AllyInvest.Error +import AllyInvest.Quote +import AllyInvest.TimeSales diff --git a/src/AllyInvest/Account.hs b/src/AllyInvest/Account.hs new file mode 100644 --- /dev/null +++ b/src/AllyInvest/Account.hs @@ -0,0 +1,200 @@ +{-# LANGUAGE OverloadedStrings #-} + +module AllyInvest.Account ( + getAccounts +, AccountSummary(..) +, Balance(..) +, BuyingPower(..) +, MoneyBalance(..) +, SecuritiesBalance(..) +, Holding(..) +, Instrument(..) +, AccountType(..) +) where + +import AllyInvest.Credentials +import AllyInvest.Error +import AllyInvest.Internal + +import Data.Aeson +import Data.Time + +getAccounts :: Credentials -> IO (Either AllyInvestError AccountSummary) +getAccounts cred = fetchAndDecode cred "https://api.tradeking.com/v1/accounts.json" + +data AccountSummary + = AccountSummary { + aNumber :: Int + , aBalance :: Balance + , aHoldings :: [Holding] + } deriving Show +instance FromJSON AccountSummary + where + parseJSON (Object o) + = let o' = o .: "response" >>= (.: "accounts") >>= (.: "accountsummary") + in + AccountSummary + <$> (fmap read $ o' >>= (.: "account")) + <*> ( o' >>= (.: "accountbalance")) + <*> ( o' >>= (.: "accountholdings") >>= (.: "holding")) + +data Balance + = Balance { + bAccountValue :: Double + , bBuyingPower :: BuyingPower + , bFedCall :: Double + , bHouseCall :: Double + , bMoney :: MoneyBalance + , bSecurities :: SecuritiesBalance + } deriving Show +instance FromJSON Balance + where + parseJSON (Object o) + = Balance + <$> (read <$> o .: "accountvalue") + <*> ( o .: "buyingpower") + <*> (read <$> o .: "fedcall") + <*> (read <$> o .: "housecall") + <*> ( o .: "money") + <*> ( o .: "securities") + +data BuyingPower + = BuyingPower { + bpCashAvailableForWithdrawal :: Double + , bpDayTrading :: Double + , bpEquityPercentage :: Double + , bpOptions :: Double + , bpSodDayTrading :: Double + , bpSodOptions :: Double + , bpSodStock :: Double + , bpStock :: Double + } deriving Show +instance FromJSON BuyingPower + where + parseJSON (Object o) + = BuyingPower + <$> (read <$> o .: "cashavailableforwithdrawal") + <*> (read <$> o .: "daytrading") + <*> (read <$> o .: "equitypercentage") + <*> (read <$> o .: "options") + <*> (read <$> o .: "soddaytrading") + <*> (read <$> o .: "sodoptions") + <*> (read <$> o .: "sodstock") + <*> (read <$> o .: "stock") + +data MoneyBalance + = MoneyBalance { + mbAccruedInterest :: Double + , mbCash :: Double + , mbCashAvailable :: Double + , mbMarginBalance :: Double + , mbMoneyMarketFund :: Double + , mbTotal :: Double + , mbUnclearedDeposits :: Double + , mbUnsettledFunds :: Double + , mbYield :: Double + } deriving Show +instance FromJSON MoneyBalance + where + parseJSON (Object o) + = MoneyBalance + <$> (read <$> o .: "accruedinterest") + <*> (read <$> o .: "cash") + <*> (read <$> o .: "cashavailable") + <*> (read <$> o .: "marginbalance") + <*> (read <$> o .: "mmf") + <*> (read <$> o .: "total") + <*> (read <$> o .: "uncleareddeposits") + <*> (read <$> o .: "unsettledfunds") + <*> (read <$> o .: "yield") + +data SecuritiesBalance + = SecuritiesBalance { + sbLongOptions :: Double + , sbLongStocks :: Double + , sbOptions :: Double + , sbShortOptions :: Double + , sbShortStocks :: Double + , sbStocks :: Double + , sbTotal :: Double + } deriving Show +instance FromJSON SecuritiesBalance + where + parseJSON (Object o) + = SecuritiesBalance + <$> (read <$> o .: "longoptions") + <*> (read <$> o .: "longstocks") + <*> (read <$> o .: "options") + <*> (read <$> o .: "shortoptions") + <*> (read <$> o .: "shortstocks") + <*> (read <$> o .: "stocks") + <*> (read <$> o .: "total") + +data Holding + = Holding { + hAccountType :: AccountType + , hCostBasis :: Double + , hGainLoss :: Double + , hInstrument :: Instrument + , hMarketValue :: Double + , hMarketValueChange :: Double + , hPrice :: Double + , hPurchasePrice :: Double + , hQuantity :: Double + , hQuoteChange :: Double + , hQuoteLastPrice :: Double + } deriving Show +instance FromJSON Holding + where + parseJSON (Object o) + = Holding + <$> ( o .: "accounttype") + <*> (read <$> o .: "costbasis") + <*> (read <$> o .: "gainloss") + <*> ( o .: "instrument") + <*> (read <$> o .: "marketvalue") + <*> (read <$> o .: "marketvaluechange") + <*> (read <$> o .: "price") + <*> (read <$> o .: "purchaseprice") + <*> (read <$> o .: "qty") + <*> (read <$> (o .: "quote" >>= (.: "change"))) + <*> (read <$> (o .: "quote" >>= (.: "lastprice"))) + +data Instrument + = Instrument { + iCusip :: String + , iDesc :: String + , iFactor :: Double + , iMaturityDate :: ZonedTime + , iMaturityMonthYear :: Maybe String + , iMultiplier :: Double + , iPutOrCall :: String + , iSecurityType :: String + , iStrikePrice :: Double + , iSymbol :: String + } deriving Show +instance FromJSON Instrument + where + parseJSON (Object o) + = Instrument + <$> ( o .: "cusip") + <*> ( o .: "desc") + <*> (read <$> o .: "factor") + <*> ( o .: "matdt") + <*> ( o .: "mmy") + <*> (read <$> o .: "mult") + <*> ( o .: "putcall") + <*> ( o .: "sectyp") + <*> (read <$> o .: "strkpx") + <*> ( o .: "sym") + +data AccountType = CashAccount | MarginLongAccount | MarginShortAccount + deriving Show +instance FromJSON AccountType where + parseJSON v = case (fromJSON v :: Result String) of + Error err -> fail err + Success t -> case t of + "1" -> return CashAccount + "2" -> return MarginLongAccount + "5" -> return MarginShortAccount + _ -> fail "bad accounttype enum" diff --git a/src/AllyInvest/Credentials.hs b/src/AllyInvest/Credentials.hs new file mode 100644 --- /dev/null +++ b/src/AllyInvest/Credentials.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE OverloadedStrings #-} + +module AllyInvest.Credentials ( + Credentials(..) +) where + +import Data.Aeson +import qualified Data.ByteString.Char8 as S8 + +data Credentials + = Credentials { + consumerKey :: S8.ByteString + , consumerSecret :: S8.ByteString + , oAuthToken :: S8.ByteString + , oAuthTokenSecret :: S8.ByteString + } +instance FromJSON Credentials + where + parseJSON (Object o) + = Credentials + <$> (S8.pack <$> o .: "consumer_key") + <*> (S8.pack <$> o .: "consumer_secret") + <*> (S8.pack <$> o .: "oauth_token") + <*> (S8.pack <$> o .: "oauth_token_secret") diff --git a/src/AllyInvest/Error.hs b/src/AllyInvest/Error.hs new file mode 100644 --- /dev/null +++ b/src/AllyInvest/Error.hs @@ -0,0 +1,13 @@ +module AllyInvest.Error ( + AllyInvestError(..) +, Pending +) where + +import Network.HTTP.Client + +data AllyInvestError + = NetworkError HttpException + | DecodeFailed String + deriving Show + +type Pending = String diff --git a/src/AllyInvest/Internal.hs b/src/AllyInvest/Internal.hs new file mode 100644 --- /dev/null +++ b/src/AllyInvest/Internal.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE RecordWildCards, OverloadedStrings #-} + + +module AllyInvest.Internal ( + signRequest +, boxException +, fetchAndDecode +) where + +import AllyInvest.Credentials +import AllyInvest.Error + +import qualified Network.HTTP.Client.TLS as HTTPS +import Network.HTTP.Client +import Web.Authenticate.OAuth + +import Data.Aeson + +import Control.Exception + +signRequest :: Credentials -> String -> IO Request +signRequest (Credentials {..}) url + = do + initReq <- parseRequest url + let req = initReq { method = "GET" } + let oAuth = def { oauthConsumerKey = consumerKey, oauthConsumerSecret = consumerSecret } + let cred = newCredential oAuthToken oAuthTokenSecret + signOAuth oAuth cred req + +boxException :: (e -> AllyInvestError) -> Either e a -> Either AllyInvestError a +boxException fBox (Left e) = Left $ fBox e +boxException _ (Right x) = Right x + +fetchAndDecode :: FromJSON a => Credentials -> String -> IO (Either AllyInvestError a) +fetchAndDecode cred url + = do + req <- signRequest cred url + mgr <- HTTPS.newTlsManager + res <- try $ httpLbs req mgr + return $ boxException NetworkError res + >>= boxException DecodeFailed . eitherDecode . responseBody diff --git a/src/AllyInvest/Quote.hs b/src/AllyInvest/Quote.hs new file mode 100644 --- /dev/null +++ b/src/AllyInvest/Quote.hs @@ -0,0 +1,396 @@ +{-# LANGUAGE OverloadedStrings #-} + +module AllyInvest.Quote ( + getQuotes +, TradeConditionCode(..) +, TradingSession(..) +, DividendFrequency(..) +, OptionDelivery(..) +, OptionStyle(..) +, OptionClass(..) +, OptionType(..) +, Quote(..) +) where + +import AllyInvest.Credentials +import AllyInvest.Error +import AllyInvest.Internal + +import Safe + +import Data.Aeson +import qualified Data.Text as T +import Data.List + +getQuotes :: Credentials -> [String] -> IO (Either AllyInvestError [Quote]) +getQuotes cred syms + = if length syms > 1 + then fmap unQuotesResult <$> fetchAndDecode cred url + else fmap (return . unQuoteResult) <$> fetchAndDecode cred url + where + url = "https://api.tradeking.com/v1/market/ext/quotes.json?symbols=" ++ intercalate "," syms + +data TradeConditionCode = TradeHalted | TradeResumed | TradeConditionUnknown String + deriving Show +instance FromJSON TradeConditionCode where + parseJSON (String "H") = return TradeHalted + parseJSON (String "R") = return TradeResumed + parseJSON (String x) = return . TradeConditionUnknown . T.unpack $ x + parseJSON x = fail (show x) + +data TradingSession = PremarketSession | RegularSession | PostmarketSession | MarketClosed + deriving Show +instance FromJSON TradingSession where + parseJSON (String "pre") = return PremarketSession + parseJSON (String "regular") = return RegularSession + parseJSON (String "post") = return PostmarketSession + parseJSON (String "na") = return MarketClosed + parseJSON x = fail (show x) + +data DividendFrequency = AnnualDividend | SemiAnnualDividend | QuarterlyDividend | MonthlyDividend | NoDividend + deriving Show +instance FromJSON DividendFrequency where + parseJSON (String "A") = return AnnualDividend + parseJSON (String "S") = return SemiAnnualDividend + parseJSON (String "Q") = return QuarterlyDividend + parseJSON (String "M") = return MonthlyDividend + parseJSON (String "N") = return NoDividend + parseJSON x = fail (show x) + +data OptionDelivery = StandardSettlement | NonstandardSettlement | NoSettlement + deriving Show +instance FromJSON OptionDelivery where + parseJSON (String "S") = return StandardSettlement + parseJSON (String "N") = return NonstandardSettlement + parseJSON (String "X") = return NoSettlement + parseJSON x = fail (show x) + +data OptionStyle = AmericanOption | EuropeanOption + deriving Show +instance FromJSON OptionStyle where + parseJSON (String "A") = return AmericanOption + parseJSON (String "E") = return EuropeanOption + parseJSON x = fail (show x) + +data OptionClass = StandardOption | LeapOption | ShortTermOption + deriving Show +instance FromJSON OptionClass where + parseJSON (String "0") = return StandardOption + parseJSON (String "1") = return LeapOption + parseJSON (String "3") = return ShortTermOption + parseJSON x = fail (show x) + +data OptionType = PutOption | CallOption + deriving Show +instance FromJSON OptionType where + parseJSON (String "Put") = return PutOption + parseJSON (String "Call") = return CallOption + parseJSON x = fail (show x) + +data Quote + = StockQuote { + sqAskPrice :: Double + , sqLatestAskSize :: Int + , sqLatestAskTime :: Pending + , sqReportedPrecision :: Maybe Int + , sqBidPrice :: Double + , sqLatestBidSize :: Int + , sqLatestBidTime :: Pending + , sqChangeSincePriorDayClose :: Pending + , sqChangeSign :: Maybe Ordering + , sqChangeText :: Maybe String + , sqPreviousClose :: Double + , sqDateTime :: Pending + , sqLastTradeDate :: Pending + , sqTotalValueTradedToday :: Double + , sqExchangeDescription :: String + , sqExchangeCode :: Pending + , sqTodayHighTradePrice :: Double + , sqLastTradeVolume :: Int + , sqLastTradePrice :: Double + , sqTodayLowTradePrice :: Double + , sqCompanyName :: String + , sqOpenTradePrice :: Double + , sqPercentageChangeFromPriorDayClose :: Double + , sqPercentageChangeSign :: Maybe Ordering + , sqPriorDayClose :: Double + , sqPriorDayHighTradePrice :: Double + , sqPriorDayLowTradePrice :: Double + , sqPriorDayOpenPrice :: Double + , sqPriorDayPriceChange :: Double + , sqPriorLastTradeDate :: Pending + , sqPriorDayTotalVolume :: Int + , sqSecurityIsOption :: Bool + , sqTradingSession :: TradingSession + , sqSymbol :: String + , sqTradeConditionCode :: TradeConditionCode + , sqTimestamp :: Pending + , sqTickDirFromPriorTrade :: Ordering + , sqTrendBasedOn10PriorTicks :: Maybe Ordering + , sqNumTradesSinceMarketOpen :: Int + , sqCumulativeVolume :: Int + , sqVolumeWeightedAveragePrice :: Double + , sq52WeekHigh :: Double + , sq52WeekHighDate :: Pending + , sq52WeekLow :: Double + , sq52WeekLowDate :: Pending + , sq100DayAveragePrice :: Double + , sq200DayAveragePrice :: Double + , sq50DayAveragePrice :: Double + , sq21DayAverageVolume :: Int + , sq30DayAverageVolume :: Int + , sq90DaysAverageVolume :: Int + , sqBeta :: Double + , sqTickDirSinceLastBid :: Ordering + , sqCusip :: Maybe String + , sqExDividendDate :: Pending + , sqDividendFrequency :: DividendFrequency + , sqLatestAnnouncedCashDividend :: Double + , sqLastAnnouncedDividendPayDate :: Pending + , sqEarningsPerShare :: Double + , sqIndicatedAnnualDividend :: Pending + , sqSecurityHasOptions :: Bool + , sqPriceEarningsRatio :: Double + , sqPrior100DayAveragePrice :: Double + , sqPrior200DayAveragePrice :: Double + , sqPrior50DayAveragePrice :: Double + , sqBookValuePrice :: Double + , sqSharesOutstanding :: Int + , sqOneYearVolatilityMeasure :: Double + , sqDividendYield :: Double + } + | OptionQuote { + oqAskPrice :: Double + , oqLatestAskSize :: Int + , oqLatestAskTime :: Pending + , oqReportedPrecision :: Maybe Int + , oqBidPrice :: Double + , oqLatestBidSize :: Int + , oqLatestBidTime :: Pending + , oqChangeSincePriorDayClose :: Pending + , oqChangeSign :: Maybe Ordering + , oqChangeText :: Maybe String + , oqPreviousClose :: Double + , oqDateTime :: Pending + , oqLastTradeDate :: Pending + , oqTotalValueTradedToday :: Double + , oqExchangeDescription :: String + , oqExchangeCode :: Pending + , oqTodayHighTradePrice :: Double + , oqLastTradeVolume :: Int + , oqLastTradePrice :: Double + , oqTodayLowTradePrice :: Double + , oqCompanyName :: String + , oqOpenTradePrice :: Double + , oqPercentageChangeFromPriorDayClose :: Double + , oqPercentageChangeSign :: Maybe Ordering + , oqPriorDayClose :: Double + , oqPriorDayHighTradePrice :: Double + , oqPriorDayLowTradePrice :: Double + , oqPriorDayOpenPrice :: Double + , oqPriorDayPriceChange :: Double + , oqPriorLastTradeDate :: Pending + , oqPriorDayTotalVolume :: Int + , oqSecurityIsOption :: Bool + , oqTradingSession :: TradingSession + , oqSymbol :: String + , oqTradeConditionCode :: TradeConditionCode + , oqTimestamp :: Pending + , oqTickDirFromPriorTrade :: Ordering + , oqTrendBasedOn10PriorTicks :: Maybe Ordering + , oqNumTradesSinceMarketOpen :: Int + , oqCumulativeVolume :: Int + , oqVolumeWeightedAveragePrice :: Double + , oq52WeekHigh :: Double + , oq52WeekHighDate :: Pending + , oq52WeekLow :: Double + , oq52WeekLowDate :: Pending + , oqContractSize :: Int + , oqDaysUntilExpiration :: Int + , oqImpliedVolatilityDelta :: Double + , oqImpliedVolatilityGamma :: Double + , oqImpliedVolatilityPrice :: Double + , oqImpliedVolatilityRho :: Double + , oqIssueDescription :: String + , oqImpliedVolatilityTheta :: Double + , oqImpliedVolatilityVega :: Double + , oqSettlementDesignation :: OptionDelivery + , oqOpenInterest :: Double + , oqOptionStyle :: OptionStyle + , oqOptionClass :: OptionClass + , oqEstimatedOptionValue :: Double -- via Ju/Zhong or Black-Scholes + , oqPremiumMultiplier :: Double + , oqPriorDayOpenInterest :: Double + , oqOptionType :: OptionType + , oqConditionCode :: String + , oqRootSymbol :: String + , oqStrikePrice :: Double + , oqUnderlyingCusip :: String + , oqUnderlyingSymbol :: String + , oqExpirationDate :: Pending + , oqExpirationDay :: Pending + , oqExpirationMonth :: Pending + , oqExpirationYear :: Pending + } + deriving Show + +toOrd :: String -> Ordering +toOrd "u" = GT +toOrd "e" = EQ +toOrd "d" = LT + +toOrdMay :: String -> Maybe Ordering +toOrdMay "na" = Nothing +toOrdMay x = Just $ toOrd x + +toBool :: String -> Bool +toBool "0" = False +toBool "1" = True + +toStrMay :: String -> Maybe String +toStrMay "na" = Nothing +toStrMay x = Just x + +instance FromJSON Quote where + parseJSON (Object o) + = do + askPrice <- read <$> o .: "ask" + latestAskSize <- (*100) . read <$> o .: "asksz" + latestAskTime <- o .: "ask_time" + reportedPrecision <- readMay <$> o .: "basis" + bidPrice <- read <$> o .: "bid" + latestBidSize <- (*100) . read <$> o .: "bidsz" + latestBidTime <- o .: "bid_time" + changeSincePriorDayClose <- o .: "chg" + changeSign <- toOrdMay <$> o .: "chg_sign" + changeText <- toStrMay<$> o .: "chg_t" + previousClose <- read <$> o .: "cl" + dateTime <- o .: "datetime" + lastTradeDate <- o .: "date" + totalValueTradedToday <- read <$> o .: "dollar_value" + exchangeDescription <- o .: "exch_desc" + exchangeCode <- o .: "exch" + todayHighTradePrice <- read <$> o .: "hi" + lastTradeVolume <- read <$> o .: "incr_vl" + lastTradePrice <- read <$> o .: "last" + todayLowTradePrice <- read <$> o .: "lo" + companyName <- o .: "name" + openTradePrice <- read <$> o .: "opn" + percentageChangeFromPriorDayClose <- read <$> o .: "pchg" + percentageChangeSign <- toOrdMay <$> o .: "pchg_sign" + priorDayClose <- read <$> o .: "pcls" + priorDayHighTradePrice <- read <$> o .: "phi" + priorDayLowTradePrice <- read <$> o .: "plo" + priorDayOpenPrice <- read <$> o .: "popn" + priorDayPriceChange <- read <$> o .: "prchg" + priorLastTradeDate <- o .: "pr_date" + priorDayTotalVolume <- read <$> o .: "pvol" + securityIsOption <- toBool <$> o .: "secclass" + tradingSession <- o .: "sesn" + symbol <- o .: "symbol" + tradeConditionCode <- o .: "tcond" + timestamp <- o .: "timestamp" + tickDirFromPriorTrade <- toOrd <$> o .: "tradetick" + trendBasedOn10PriorTicks <- toOrdMay <$> o .: "trend" + numTradesSinceMarketOpen <- read <$> o .: "tr_num" + cumulativeVolume <- read <$> o .: "vl" + volumeWeightedAveragePrice <- read <$> o .: "vwap" + week52High <- read <$> o .: "wk52hi" + week52HighDate <- o .: "wk52hidate" + week52Low <- read <$> o .: "wk52lo" + week52LowDate <- o .: "wk52lodate" + if securityIsOption + then OptionQuote + askPrice latestAskSize latestAskTime reportedPrecision bidPrice + latestBidSize latestBidTime changeSincePriorDayClose changeSign changeText + previousClose dateTime lastTradeDate totalValueTradedToday exchangeDescription + exchangeCode todayHighTradePrice lastTradeVolume lastTradePrice todayLowTradePrice + companyName openTradePrice percentageChangeFromPriorDayClose percentageChangeSign priorDayClose + priorDayHighTradePrice priorDayLowTradePrice priorDayOpenPrice priorDayPriceChange priorLastTradeDate + priorDayTotalVolume securityIsOption tradingSession symbol tradeConditionCode + timestamp tickDirFromPriorTrade trendBasedOn10PriorTicks numTradesSinceMarketOpen cumulativeVolume + volumeWeightedAveragePrice week52High week52HighDate week52Low week52LowDate + <$> (read <$> o .: "contract_size") + <*> (read <$> o .: "days_to_expiration") + <*> (read <$> o .: "idelta") + <*> (read <$> o .: "igamma") + <*> (read <$> o .: "imp_volatility") + <*> (read <$> o .: "irho") + <*> (read <$> o .: "issue_desc") + <*> (read <$> o .: "itheta") + <*> (read <$> o .: "ivega") + <*> ( o .: "op_delivery") + <*> (read <$> o .: "openinterest") + <*> ( o .: "op_style") + <*> ( o .: "op_subclass") + <*> (read <$> o .: "opt_val") + <*> (read <$> o .: "prem_mult") + <*> (read <$> o .: "pr_openinterest") + <*> ( o .: "put_call") + <*> (read <$> o .: "qcond") + <*> (read <$> o .: "rootsymbol") + <*> (read <$> o .: "strikeprice") + <*> (read <$> o .: "under_cusip") + <*> (read <$> o .: "undersymbol") + <*> (read <$> o .: "xdate") + <*> (read <$> o .: "xday") + <*> (read <$> o .: "xmonth") + <*> (read <$> o .: "xyear") + else StockQuote + askPrice latestAskSize latestAskTime reportedPrecision bidPrice + latestBidSize latestBidTime changeSincePriorDayClose changeSign changeText + previousClose dateTime lastTradeDate totalValueTradedToday exchangeDescription + exchangeCode todayHighTradePrice lastTradeVolume lastTradePrice todayLowTradePrice + companyName openTradePrice percentageChangeFromPriorDayClose percentageChangeSign priorDayClose + priorDayHighTradePrice priorDayLowTradePrice priorDayOpenPrice priorDayPriceChange priorLastTradeDate + priorDayTotalVolume securityIsOption tradingSession symbol tradeConditionCode + timestamp tickDirFromPriorTrade trendBasedOn10PriorTicks numTradesSinceMarketOpen cumulativeVolume + volumeWeightedAveragePrice week52High week52HighDate week52Low week52LowDate + <$> (read <$> o .: "adp_100") + <*> (read <$> o .: "adp_200") + <*> (read <$> o .: "adp_50") + <*> (read <$> o .: "adv_21") + <*> (read <$> o .: "adv_30") + <*> (read <$> o .: "adv_90") + <*> (read <$> o .: "beta") + <*> (toOrd<$> o .: "bidtick") + <*> (toStrMay<$> o .: "cusip") + <*> ( o .: "divexdate") + <*> ( o .: "divfreq") + <*> (read <$> o .: "div") + <*> ( o .: "divpaydt") + <*> (read <$> o .: "eps") + <*> ( o .: "iad") + <*> (toBool<$>o .: "op_flag") + <*> (read <$> o .: "pe") + <*> (read <$> o .: "pr_adp_100") + <*> (read <$> o .: "pr_adp_200") + <*> (read <$> o .: "pr_adp_50") + <*> (read <$> o .: "prbook") + <*> (read <$> o .: "sho") + <*> (read <$> o .: "volatility12") + <*> (read <$> o .: "yield") + parseJSON x = fail . show $ x + +-------------------------------------------------------------------------------- +-- INTERNAL +-------------------------------------------------------------------------------- + +data QuoteResult + = QuoteResult { + unQuoteResult :: Quote + } +instance FromJSON QuoteResult + where + parseJSON (Object o) + = QuoteResult <$> (o .: "response" >>= (.: "quotes") >>= (.: "quote")) + +data QuotesResult + = QuotesResult { + unQuotesResult :: [Quote] + } +instance FromJSON QuotesResult + where + parseJSON (Object o) + = QuotesResult <$> (o .: "response" >>= (.: "quotes") >>= (.: "quote")) + diff --git a/src/AllyInvest/TimeSales.hs b/src/AllyInvest/TimeSales.hs new file mode 100644 --- /dev/null +++ b/src/AllyInvest/TimeSales.hs @@ -0,0 +1,64 @@ +{-# LANGUAGE OverloadedStrings #-} + +module AllyInvest.TimeSales ( + getTimeSales +, Candle(..) +) where + +import AllyInvest.Credentials +import AllyInvest.Error +import AllyInvest.Internal + +import Data.Aeson +import Data.Time +import Data.List + +getTimeSales :: Credentials -> String -> Day -> IO (Either AllyInvestError [Candle]) +getTimeSales cred sym day + = fmap unCandleResult <$> fetchAndDecode cred url + where + url = intercalate "?" [ + "https://api.tradeking.com/v1/market/timesales.json" + , intercalate "&" + . fmap (\(x,y) -> intercalate "=" [x, y]) + $ [ ("symbols", sym) + , ("startdate", show day) + , ("enddate", show $ addDays 1 day) + ] + ] + +data Candle + = Candle { + tDate :: Day + , tDateTime :: UTCTime + , tLowPrice :: Double + , tHighPrice :: Double + , tOpenPrice :: Double + , tLastPrice :: Double + , tTradeVolume :: Int + , tCumulativeTradeVolume :: Int + } deriving Show +instance FromJSON Candle + where + parseJSON (Object o) + = Candle + <$> (o .: "date") + <*> (o .: "datetime") + <*> (read <$> o .: "lo") + <*> (read <$> o .: "hi") + <*> (read <$> o .: "opn") + <*> (read <$> o .: "last") + <*> (read <$> o .: "incr_vl") + <*> (read <$> o .: "vl") + +-------------------------------------------------------------------------------- +-- private +-------------------------------------------------------------------------------- +data CandleResult + = CandleResult { + unCandleResult :: [Candle] + } +instance FromJSON CandleResult + where + parseJSON (Object o) + = CandleResult <$> (o .: "response" >>= (.: "quotes") >>= (.: "quote")) diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "Test suite not yet implemented"