diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,25 @@ +Copyright (c) 2014, Travis Athougies +All rights reserved. + +Redistribution and use in source and binary forms, with or without modification, are permitted +provided that the following conditions are met: + +1. Redistributions of source code must retain the above copyright notice, this list of conditions + and the following disclaimer. + +2. 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. + +3. Neither the name of the copyright holder nor the names of its 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 HOLDER 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/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,6 @@ +module Main where + +import Distribution.Simple + +main :: IO () +main = defaultMain diff --git a/client/Client.hs b/client/Client.hs new file mode 100644 --- /dev/null +++ b/client/Client.hs @@ -0,0 +1,73 @@ +import qualified Control.Exception as E +import Client.Quote + +import Data.String +import Data.Conduit + +import Finance.TradeKing hiding (Option) + + + + +import System.Console.GetOpt +import System.Environment +import System.Exit +import System.IO + +data AppToken = ConsumerKey String | + ConsumerSecret String | + OAuthToken String | + OAuthTokenSecret String + +options = [Option "k" ["consumer-key"] (ReqArg ConsumerKey "") "Consumer Key", + Option "s" ["consumer-secret"] (ReqArg ConsumerSecret "") "Consumer Secret", + Option "t" ["oauth-token"] (ReqArg OAuthToken "") "OAuth Token", + Option "S" ["oauth-secret"] (ReqArg OAuthTokenSecret "") "OAuth Token Secret"] + +buildApp :: [String] -> IO TradeKingApp +buildApp args = do + let (actions, nonOptions, errors) = getOpt RequireOrder options args + + -- Look for the config file in certain locations + let defEmptyTradeKingApp = TradeKingApp { + tradeKing = defaultTk, + consumerKey = error "Missing consumer key", + consumerSecret = error "Missing consumer secret", + oAuthToken = error "Missing oauth token", + oAuthTokenSecret = error "Missing oauth token secret" + } + + emptyTradeKingAppR <- readTKConf defaultTKConfs + let emptyTradeKingApp = case emptyTradeKingAppR of + Left err -> defEmptyTradeKingApp + Right tkApp -> tkApp + + let modifyApp a (ConsumerKey v) = a { consumerKey = fromString v } + modifyApp a (ConsumerSecret v) = a { consumerSecret = fromString v } + modifyApp a (OAuthToken v) = a { oAuthToken = fromString v } + modifyApp a (OAuthTokenSecret v) = a { oAuthTokenSecret = fromString v } + + finalTradeKingApp = foldl modifyApp emptyTradeKingApp actions + E.evaluate (consumerKey finalTradeKingApp) + E.evaluate (consumerSecret finalTradeKingApp) + E.evaluate (oAuthToken finalTradeKingApp) + E.evaluate (oAuthTokenSecret finalTradeKingApp) + return finalTradeKingApp + +usage = do + progName <- getProgName + let progName' = progName ++ " " + hPutStrLn stderr (usageInfo progName' options) + exitWith ExitSuccess + +main :: IO () +main = getArgs >>= \args -> + case args of + [] -> usage + ["-h"] -> usage + ["--help"] -> usage + ('-':_):_ -> usage -- command starts with '-' + "quote":args -> buildApp args >>= doQuote args + "info":args -> buildApp args >>= doInfo args + "stream":args -> buildApp args >>= doStream args + _ -> usage diff --git a/client/Client/Quote.hs b/client/Client/Quote.hs new file mode 100644 --- /dev/null +++ b/client/Client/Quote.hs @@ -0,0 +1,36 @@ +module Client.Quote where + +import Control.Monad +import Control.Monad.IO.Class +import Control.Monad.Trans.Resource + +import qualified Data.ByteString.Char8 as BS +import Data.String +import Data.Conduit.Binary hiding (mapM_) +import Data.Conduit hiding (mapM_) + +import Finance.TradeKing + +import System.IO + +doQuote :: [String] -> TradeKingApp -> IO () +doQuote args app = do + quotes <- stockQuotes app (map fromString args) + mapM_ (putStrLn . show) quotes + +doInfo :: [String] -> TradeKingApp -> IO () +doInfo args app = do + infos <- stockInfos app (map fromString args) + mapM_ (putStrLn . show) infos + + +doStream :: [String] -> TradeKingApp -> IO () +doStream args app = do + let mySink = await >>= \x -> + case x of + Nothing -> return () + Just x -> do + liftIO (putStrLn (show x)) + liftIO (hFlush stdout) + mySink + streamQuotes app (map fromString args) (\s -> s $$ mySink) diff --git a/hstradeking.cabal b/hstradeking.cabal new file mode 100644 --- /dev/null +++ b/hstradeking.cabal @@ -0,0 +1,59 @@ +name: hstradeking +version: 0.1.0 +cabal-version: >=1.8 +build-type: Simple +license: BSD3 +license-file: LICENSE +synopsis: Tradeking API bindings for Haskell +description: + This is a Haskell binding for the TradeKing developers API (https://developers.tradeking.com/). + . + It currently supports retrieving quotes and stock information, as well as the quote and trade + streaming API. + . + Support for the other TradeKing API endpoints is forthcoming. + . + To use, install the package via cabal. This will create an executable called `tradeking`. To + connect to the TradeKing API, you will need to create a new personal application from the + TradeKing developers site. This should give you four strings: an OAuth consumer key, an OAuth + consumer secret, an OAuth Token, and an OAuth Token Secret. You supply these into the + `tradeking` application using a configuration file (either `$(HOME)/.tradeking` or + `/etc/tradeking.conf`). This configuration file should look like: + . + > consumer-key = + > consumer-secret = + > oauth-token = + > oauth-token-secret = + . + Now you can run `tradeking quote SPY` to have it return the current quote for the S&P 500 + ETF. `tradeking info MSFT` will provide information on Microsoft, and `tradeking stream MSFT` + will provide a live stream of `MSFT` quotes. All commands accept more than one stock, so + `tradeking quote MSFT AAPL`, `tradeking info MSFT SPY`, and `tradeking stream SPY AAPL` work as + expected (subject to TradeKing) limits. + . + You can also request quotes programmatically, using the API described here. + +data-dir: "" +category: Finance +maintainer: Travis Athougies +extra-source-files: + client/Client/Quote.hs + +library + build-depends: base >= 3 && < 5, hoauth >=0.3.5, text >=0.11.3.1, bytestring >=0.9, containers, + aeson >=0.6, old-locale, safe, conduit >=1.0.12, http-conduit >=2.0.0.0, + resourcet >=0.4, RSA <=1.2.2.0, case-insensitive, lifted-base >=0.2, + configurator >=0.2.0.2, vector, time, numbers, attoparsec + exposed-modules: Finance.TradeKing Finance.TradeKing.Quotes Finance.TradeKing.Types + Finance.TradeKing.Service Finance.TradeKing.Config + hs-source-dirs: src + +executable tradeking + build-depends: hstradeking ==0.1.0, base >= 3 && < 5, conduit >=1.0.12, + bytestring >=0.9, resourcet >=0.4, transformers >=0.3 + main-is: Client.hs + hs-source-dirs: client + +source-repository head + type: git + location: git://github.com/tathougies/hstradeking.git diff --git a/src/Finance/TradeKing.hs b/src/Finance/TradeKing.hs new file mode 100644 --- /dev/null +++ b/src/Finance/TradeKing.hs @@ -0,0 +1,17 @@ +-- | Main API module +-- +-- Use the functions in `Finance.TradeKing.Quotes` for access to the TradeKing API. +-- +-- The functions in `Finance.TradeKing.Service` provide lower-level access to the TradeKing API, +-- handling things such as OAuth. +module Finance.TradeKing + (module Finance.TradeKing.Types, + module Finance.TradeKing.Service, + module Finance.TradeKing.Quotes, + module Finance.TradeKing.Config) + where + +import Finance.TradeKing.Types +import Finance.TradeKing.Service +import Finance.TradeKing.Quotes +import Finance.TradeKing.Config diff --git a/src/Finance/TradeKing/Config.hs b/src/Finance/TradeKing/Config.hs new file mode 100644 --- /dev/null +++ b/src/Finance/TradeKing/Config.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE OverloadedStrings #-} +module Finance.TradeKing.Config + ( defaultTKConfs, + readTKConf ) where + +import Finance.TradeKing.Types + +import Prelude hiding (lookup) + +import Control.Applicative + +import Data.Configurator + +-- | Default locations to look for the TradeKing configuration file. +-- +-- > defaultTKConfs = ["/etc/tradeking.conf", "~/.tradeking"] +defaultTKConfs :: [FilePath] +defaultTKConfs = ["/etc/tradeking.conf", "~/.tradeking"] + +-- | Reads in TradeKing configuration file and returns the resulting application +readTKConf :: [FilePath] -> IO (Either String TradeKingApp) +readTKConf confs = do + tkConf <- load (map Optional confs) + + let label l Nothing = Left l + label _ (Just x) = Right x + + consumerKey <- label "Consumer key not present in config" <$> lookup tkConf "consumer-key" + consumerSecret <- label "Consumer secret not present in config" <$> lookup tkConf "consumer-secret" + oAuthToken <- label "OAuth token not present in config" <$> lookup tkConf "oauth-token" + oAuthTokenSecret <- label "OAuth token secret not present in config" <$> lookup tkConf "oauth-token-secret" + return (TradeKingApp <$> pure defaultTk + <*> consumerKey + <*> consumerSecret + <*> oAuthToken + <*> oAuthTokenSecret) diff --git a/src/Finance/TradeKing/Quotes.hs b/src/Finance/TradeKing/Quotes.hs new file mode 100644 --- /dev/null +++ b/src/Finance/TradeKing/Quotes.hs @@ -0,0 +1,218 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | High-level access to TradeKing APIs +module Finance.TradeKing.Quotes (stockQuotes, stockInfos, streamQuotes) where + +import Finance.TradeKing.Types +import Finance.TradeKing.Service (invokeSimple, streamQuotes') + +import qualified Control.Exception.Lifted as E +import Control.Applicative +import Control.Monad + +import qualified Data.ByteString.Lazy.Char8 as LBS8 +import qualified Data.ByteString.Char8 as BS +import qualified Data.Vector as V +import qualified Data.Text as T +import Data.Maybe +import Data.Conduit +import Data.Time +import Data.Time.Clock.POSIX +import Data.Monoid +import Data.Aeson ((.:), (.:?), FromJSON, FromJSON(..), Value(..), Result(..), eitherDecode, fromJSON, json') +import Data.Aeson.Types (Parser) +import Data.Attoparsec (parse, IResult(..)) + +import Network.OAuth.Http.Response + +import Safe (readMay) + +import System.Locale + +newtype TKQuoteResponse fields = TKQuoteResponse { unTKQuoteResponse :: TKQuotes fields } +newtype TKQuotes field = TKQuotes { unTKQuotes :: [field] } +newtype TKStockQuote = TKStockQuote { unTKStockQuote :: StockQuote } +newtype TKStockInfo = TKStockInfo { unTKStockInfo :: StockInfo } +newtype TKPrice = TKPrice Fixed4 +newtype TKFrequency = TKFrequency { unTKFrequency :: Period} + +-- TKPrice always in USD +unTKPrice :: TKPrice -> Price +unTKPrice (TKPrice nominal) = Price USD nominal + +instance FromJSON TKFrequency where + parseJSON (String t) + | t == "A" = return (TKFrequency Annually) + | t == "S" = return (TKFrequency SemiAnnually) + | t == "Q" = return (TKFrequency Quarterly) + | t == "M" = return (TKFrequency Monthly) + parseJSON _ = mzero + +instance FromJSON TKPrice where + parseJSON (String t) = return (TKPrice . read . T.unpack $ t) + parseJSON _ = mzero + +instance FromJSON fields => FromJSON (TKQuoteResponse fields) where + parseJSON (Object v) = do + response <- v .: "response" + quotes <- response .: "quotes" + TKQuoteResponse <$> quotes .: "quote" + parseJSON _ = mzero + +instance FromJSON fields => FromJSON (TKQuotes fields) where + parseJSON o@(Object _) = do + quote <- parseJSON o + return (TKQuotes [quote]) + parseJSON (Array v) = do + quotes <- V.toList <$> V.mapM parseJSON v + return (TKQuotes quotes) + parseJSON _ = mzero + +adapt :: Read a => String -> Parser a +adapt = maybe mzero return . readMay + +adaptMay :: Read a => Maybe String -> Parser (Maybe a) +adaptMay (Just s) = maybe mzero return . Just . readMay $ s +adaptMay Nothing = return Nothing + +instance FromJSON StreamOutput where + parseJSON (Object v) = do + let parseQuote (Object v) = + do + timestamp <- (maybe mzero return . parseTime defaultTimeLocale "%FT%T%z") =<< v .: "datetime" + let day = localDay . zonedTimeToLocalTime $ timestamp + timeFormat = "%R" + timeZone = zonedTimeZone timestamp + StreamQuote <$> pure (zonedTimeToUTC timestamp) + <*> (Stock <$> v .: "symbol") + <*> (unTKPrice <$> v .: "ask") + <*> (adapt =<< v .: "asksz") + <*> (unTKPrice <$> v .: "bid") + <*> (adapt =<< v .: "bidsz") + <*> v .:? "qcond" + parseQuote _ = mzero + + parseTrade (Object v) = + do + timestamp <- (maybe mzero return . parseTime defaultTimeLocale "%FT%T%z") =<< v .: "datetime" + let day = localDay . zonedTimeToLocalTime $ timestamp + timeFormat = "%R" + timeZone = zonedTimeZone timestamp + StreamTrade <$> pure (zonedTimeToUTC timestamp) + <*> (Stock <$> v .: "symbol") + <*> (unTKPrice <$> (maybe (v .: "hi") return =<< (v .:? "last"))) + <*> (adapt =<< v .: "vl") + <*> (adapt =<< v .: "cvol") + <*> (adaptMay =<< v .:? "vwap") + <*> (v .:? "tcond") + <*> (Exchange <$> v .: "exch") + parseTrade _ = mzero + status <- v .:? "status" + quote <- v .:? "quote" + trade <- v .:? "trade" + case status of + Nothing -> case quote of + Nothing -> case trade of + Nothing -> mzero + Just t -> parseTrade t + Just q -> parseQuote q + Just s -> return (StreamStatus s) + parseJSON _ = mzero + +instance FromJSON TKStockQuote where + parseJSON (Object v) = do + timestamp <- (maybe mzero return . parseTime defaultTimeLocale "%FT%T%z") =<< v .: "datetime" + let day = localDay . zonedTimeToLocalTime $ timestamp + timeFormat = "%R" + timeZone = zonedTimeZone timestamp + + TKStockQuote <$> ( + StockQuote <$> + (Stock <$> v .: "symbol") <*> + pure (zonedTimeToUTC timestamp) <*> + (unTKPrice <$> v .: "ask") <*> + (localTimeToUTC timeZone . LocalTime day <$> (maybe mzero return . parseTime defaultTimeLocale timeFormat =<< v .: "ask_time")) <*> + (adapt =<< v .: "asksz") <*> + (unTKPrice <$> v .: "bid") <*> + (localTimeToUTC timeZone . LocalTime day <$> (maybe mzero return . parseTime defaultTimeLocale timeFormat =<< v .: "bid_time")) <*> + (adapt =<< v .: "bidsz") <*> + (unTKPrice <$> v .: "last") <*> + (adapt =<< v .: "incr_vl") <*> + (adapt =<< v .: "vl")) + parseJSON _ = mzero + +instance FromJSON TKStockInfo where + parseJSON o@(Object v) = do + timestamp <- (maybe mzero return . parseTime defaultTimeLocale "%FT%T%z") =<< v .: "datetime" + + let parseDate = maybe mzero return . parseTime defaultTimeLocale "%Y%m%d" + timeZone = zonedTimeZone timestamp + + TKStockInfo <$> ( + StockInfo <$> + (Stock <$> v .: "symbol") <*> + pure (zonedTimeToUTC timestamp) <*> + v .: "name" <*> + (unTKPrice <$> v .: "pcls") <*> + (unTKPrice <$> v .: "popn") <*> + (unTKPrice <$> v .: "opn") <*> + (CUSIP <$> v .: "cusip") <*> + (maybe Nothing (Just . unTKPrice) <$> (v .:? "div")) <*> + (maybe (return Nothing) ((Just <$>) . parseDate) =<< (v .:? "divexdate")) <*> + (maybe Nothing (Just . unTKFrequency) <$> (v .:? "divfreq")) <*> + (maybe (return Nothing) ((Just <$>) . parseDate) =<< (v .:? "divpaydt")) <*> + (adapt . filter (/= ',') =<< v .: "sho") <*> -- Tradeking returns the number separated by commas, ew... + (maybe Nothing (Just . unTKPrice) <$> v .:? "eps") <*> + (Exchange <$> v .: "exch") <*> + (HighLow <$> (unTKPrice <$> v .: "phi") <*> (unTKPrice <$> v .: "plo")) <*> + (HighLow <$> ((,) <$> (parseDate =<< (v .: "wk52lodate")) <*> (unTKPrice <$> v .: "wk52lo")) + <*> ((,) <$> (parseDate =<< (v .: "wk52hidate")) <*> (unTKPrice <$> v .: "wk52hi"))) <*> + (maybe Nothing readMay <$> v .:? "pe") <*> + (unTKPrice <$> v .: "prbook") <*> + (unTKStockQuote <$> parseJSON o)) + parseJSON _ = mzero + +-- | Retrieve the stock quotes for the stocks specified. +stockQuotes :: TradeKingApp -> [Stock] -> IO [StockQuote] +stockQuotes app stocks = do + let command = Quote assets ["timestamp", "ask", "ask_time", "asksz", + "bid", "bid_time", "bidsz", "last", + "date", "incr_vl", "vl"] + assets = map StockAsset stocks + response <- invokeSimple app command JSON + case eitherDecode (rspPayload response) of + Left e -> fail ("Malformed data returned: " ++ e) + Right quoteData -> return (map unTKStockQuote . unTKQuotes . unTKQuoteResponse $ quoteData) + +-- | Retrieve information on the stock symbols specified. +stockInfos :: TradeKingApp -> [Stock] -> IO [StockInfo] +stockInfos app stocks = do + let command = Quote assets [] + assets = map StockAsset stocks + response <- invokeSimple app command JSON + case eitherDecode (rspPayload response) of + Left e -> fail ("Malformed data returned: " ++ e) + Right infoData -> return (map unTKStockInfo . unTKQuotes . unTKQuoteResponse $ infoData) + +-- | Run a streaming operation on the stocks specified. This takes a function which will be passed a +-- `Source` from `Data.Conduit` that will yield the streaming quote information. +streamQuotes :: TradeKingApp -> [Stock] -> (Source (ResourceT IO) StreamOutput -> ResourceT IO b) -> IO b +streamQuotes app stocks f = streamQuotes' app stocks doStream + where doStream bsrc = do + (bsrc', finalizer) <- unwrapResumable bsrc + let decodeMessages p = await >>= \x -> + case x of + Nothing -> return () + Just x -> case p x of + Fail rest _ err -> do + yield (StreamJunk err) + decodeMessages (parse json' . BS.append rest) + Partial p -> decodeMessages p + Done rest x -> do + case fromJSON x of + Error e -> do + yield (StreamJunk e) + decodeMessages (parse json') + Success x -> do + yield x + decodeMessages (parse json' . BS.append rest) + f (bsrc' $= decodeMessages (parse json')) `E.finally` finalizer diff --git a/src/Finance/TradeKing/Service.hs b/src/Finance/TradeKing/Service.hs new file mode 100644 --- /dev/null +++ b/src/Finance/TradeKing/Service.hs @@ -0,0 +1,74 @@ +-- | Low-level access to TradeKing API +module Finance.TradeKing.Service where + +import Finance.TradeKing.Types + +import Control.Monad.Trans.Resource + +import qualified Data.Text as T +import qualified Data.CaseInsensitive as CI +import Data.Maybe +import Data.List +import Data.Conduit +import Data.Aeson (eitherDecode) +import Data.ByteString (ByteString) +import Data.String + +import Network.OAuth.Consumer +import Network.OAuth.Http.CurlHttpClient +import Network.OAuth.Http.Request as Req +import Network.OAuth.Http.Response +import qualified Network.HTTP.Conduit as HttpC + +-- | Given a set of TradeKing URLs, a `Command`, and a `Format`, returns the API endpoint +apiEndPoint :: TradeKing -> Command -> Format -> String +apiEndPoint tk cmd fmt = apiBase tk ++ endPoint ++ "." ++ apiFmt fmt ++ + case queryString of + Nothing -> "" + Just queryString -> "?" ++ queryString + where (endPoint, queryString) = cmdEndPoint cmd + + cmdEndPoint Accounts = ("accounts", Nothing) + cmdEndPoint Clock = ("market/clock", Nothing) + cmdEndPoint (Quote assets fields) = ("market/ext/quotes", Just queryStr) + where queryStr = "symbols=" ++ intercalate "," (symbols assets) ++ fieldsQuery + fieldsQuery = case fields of + [] -> "" + _ -> "&fids=" ++ intercalate "," fields + symbols = map assetSymbol + + assetSymbol (StockAsset (Stock s)) = T.unpack s + + apiFmt XML = "xml" + apiFmt JSON = "json" + +-- | Invokes a simple command signed with OAuth in the given format, and returns the `Response` +-- object. +invokeSimple :: TradeKingApp -> Command -> Format -> IO Response +invokeSimple tk cmd format = do + let uri = fromJust . parseURL $ apiEndPoint (tradeKing tk) cmd format + app = Application (consumerKey tk) (consumerSecret tk) OOB + tok = fromApplication app + tok' = AccessToken { + application = application tok, + oauthParams = fromList [("oauth_token", oAuthToken tk), ("oauth_token_secret", oAuthTokenSecret tk)] } + runOAuthM tok' $ signRq2 HMACSHA1 Nothing uri >>= serviceRequest CurlClient + +-- | Low-level quote streaming command. This differs from `streamQuotes` in that the source it +-- provides produces ByteStrings. +streamQuotes' :: TradeKingApp -> [Stock] -> (ResumableSource (ResourceT IO) ByteString -> ResourceT IO b) -> IO b +streamQuotes' tk stocks f = do + let uri = (streamBase (tradeKing tk)) ++ "market/quotes.json?symbols=" ++ intercalate "," (map (T.unpack . unStock) stocks) + req <- HttpC.parseUrl uri + let app = Application (consumerKey tk) (consumerSecret tk) OOB + tok = fromApplication app + tok' = AccessToken { + application = application tok, + oauthParams = fromList [("oauth_token", oAuthToken tk), ("oauth_token_secret", oAuthTokenSecret tk)] } + oauthReq <- runOAuthM tok' $ signRq2 HMACSHA1 Nothing (fromJust . parseURL $ uri) + let oauthReq' = unpackRq oauthReq + req' = req { HttpC.requestHeaders = map (\(h,b) -> (CI.mk (fromString h), fromString b)) (Req.toList (reqHeaders oauthReq')) } + HttpC.withManager $ \manager -> do + response <- HttpC.http req' manager + let bsrc = HttpC.responseBody response + f bsrc diff --git a/src/Finance/TradeKing/Types.hs b/src/Finance/TradeKing/Types.hs new file mode 100644 --- /dev/null +++ b/src/Finance/TradeKing/Types.hs @@ -0,0 +1,204 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +module Finance.TradeKing.Types where + +import qualified Data.Text as T +import Data.Time +import Data.String +import Data.Int +import Data.Number.Fixed +import Data.Aeson +import Data.Word +import Data.Time.Clock + +-- * TradeKing specific + +-- | Data type that represents the URLs we need to connect to TradeKing +-- This could be useful if you wanted to host your own TradeKing-compatible testing server. +-- . +-- Most of the time, you'll use `defaultTk` to get the default values. +data TradeKing = TradeKing { + apiBase :: String, + streamBase :: String, + authorizeURL :: String, + requestTokenResource :: String, + accessTokenResource :: String } + deriving (Show, Read, Eq, Ord) + +-- | This data type holds the application information provided by TradeKing and is used to make +-- requests. +data TradeKingApp = TradeKingApp { + tradeKing :: TradeKing, -- ^ TradeKing URIs to use + consumerKey :: String, + consumerSecret :: String, + oAuthToken :: String, + oAuthTokenSecret :: String } + deriving (Show, Read, Eq, Ord) + +-- | Expected return format for API calls. +data Format = JSON | XML + deriving (Show, Read, Eq, Ord, Bounded, Enum) + +-- | TradeKing API commmands that we support. +data Command = Accounts | + Clock | + Quote [Asset] [String] + deriving (Show, Read, Eq, Ord) + +-- * Common Financial Asset and Transaction Types + +-- ** Assets +-- | The different types of Assets available on TradeKing. Currently on Stocks and Options are supported. +data Asset = StockAsset Stock | + OptionAsset Option | + NoteAsset Note | + FutureAsset Future + deriving (Show, Read, Eq, Ord) + +newtype Stock = Stock { unStock :: T.Text } + deriving (Show, Read, Eq, Ord, IsString) +-- | Type to represent SEC CUSIP identifiers +newtype CUSIP = CUSIP T.Text + deriving (Show, Read, Eq, Ord, IsString) +newtype Exchange = Exchange { unExchange :: T.Text } + deriving (Show, Read, Eq, Ord, IsString) + +-- ** Prices + +-- | Exact way of representing prices, etc. +type Eps4 = EpsDiv10 (EpsDiv10 (EpsDiv10 (EpsDiv10 Eps1))) +type Fixed4 = Fixed Eps4 + +data Currency = USD | + GBP | + CAD | + Other T.Text + deriving (Show, Read, Eq, Ord) + +-- | A price has both a currency component and a decimal. Currently we only denote prices in USD, +-- but this is here for future compatibility. +data Price = Price Currency Fixed4 + deriving (Show, Read, Eq, Ord) + +-- ** Options + +-- | Describes an option. Option support is TBD. +data Option = Option { + optionType :: OptionType, + optionUnderlying :: Stock, + optionStrikePrice :: Price, + optionExpiration :: Day + } + deriving (Show, Read, Eq, Ord) + +data OptionType = OptionType { + optionContract :: ContractType, + optionStyle :: OptionStyle + } + deriving (Show, Read, Eq, Ord) + +data ContractType = Call | Put + deriving (Show, Read, Eq, Ord, Enum, Bounded) +data OptionStyle = American | European + deriving (Show, Read, Eq, Ord, Enum, Bounded) + +-- ** Other Assets + +-- | Unimplemented +data Note = Note deriving (Show, Read, Eq, Ord) +-- | Unimplemented +data Future = Future deriving (Show, Read, Eq, Ord) + +-- ** Utility types + +data Period = Annually | SemiAnnually | Quarterly | Monthly + deriving (Show, Read, Eq, Ord) + +data HighLow a = HighLow { + high :: a, + low :: a + } deriving (Show, Eq) + +-- * TradeKing API-specific data structures + +-- | A stock quote +data StockQuote = StockQuote { + sqStock :: Stock, -- ^ Stock which we're quoting + sqTime :: UTCTime, -- ^ Time at which the quote was sampled + sqAsk :: Price, + sqAskTime :: UTCTime, -- ^ Time at which the ask quote was last updated + sqAskSz :: Word, -- ^ Current size of ask queue + sqBid :: Price, + sqBidTime :: UTCTime, -- ^ Time at which the bid quote was last updated + sqBidSz :: Word, -- ^ Current size of bid queue + sqLastPrice :: Price, + sqLastTradeVol :: Word, -- ^ Volue of last trade + sqCumVol :: Word -- ^ Number of trades since market open + } deriving (Show, Eq) + +-- | Stock information that may change day-to-day +data StockInfo = StockInfo { + siStock :: Stock, + siTime :: UTCTime, + siCompanyName :: T.Text, + siPrevClose :: Price, -- ^ Previous day close + siPrevOpen :: Price, -- ^ Previous day open + siOpen :: Price, -- ^ Current day open + siCusip :: CUSIP, + siDiv :: Maybe Price, + siDivExDate :: Maybe Day, + siDivFrequency :: Maybe Period, + siDivPayDate :: Maybe Day, + siShares :: Integer, + siEps :: Maybe Price, + siExchange :: Exchange, + siDailyHiLo :: HighLow Price, + siYearlyHiLo :: HighLow (Day, Price), + siPE :: Maybe Double, + siBook :: Price, + siQuote :: StockQuote -- ^ Embedded stock quote + } deriving (Show, Eq) + +-- | This is the type of data that may be output by the streaming calls. We can't use other data +-- types here, because the streaming data is limited in scope. +data StreamOutput = StreamStatus String + -- ^ Stream status. This should be the first thing that comes out of the conduit + -- in `streamQuotes` and should have the argument `"connected"` on success. + + -- | Represents updates to the quote of a symbol + | StreamQuote + { stqTime :: UTCTime + , stqSymbol :: Stock + , stqAsk :: Price + , stqAskSz :: Word + , stqBid :: Price + , stqBidSz :: Word + , stqQCond :: Maybe String } + + -- | Represents a trade that just took place + | StreamTrade + { tTime :: UTCTime + , tSymbol :: Stock + , tPrice :: Price + , tVol :: Word + , tCumVol :: Word + , tVWAP :: Maybe Float + , tCond :: Maybe String + , tExch :: Exchange } + | StreamJunk String -- Sent when there was a parse error + deriving (Show) + +-- | Default TradeKing URIs. Equivalent to +-- +-- > TradeKing { +-- > apiBase = "https://api.tradeking.com/v1/", +-- > streamBase = "https://stream.tradeking.com/v1/", +-- > authorizeURL = "https://developers.tradeking.com/oauth/authorize?oauth_token=", +-- > requestTokenResource = "https://developers.tradeking.com/oauth/request_token", +-- > accessTokenResource = "https://developers.tradeking.com/oauth/access_token" } +defaultTk :: TradeKing +defaultTk = TradeKing { + apiBase = "https://api.tradeking.com/v1/", + streamBase = "https://stream.tradeking.com/v1/", + authorizeURL = "https://developers.tradeking.com/oauth/authorize?oauth_token=", + requestTokenResource = "https://developers.tradeking.com/oauth/request_token", + accessTokenResource = "https://developers.tradeking.com/oauth/access_token" }