hstradeking (empty) → 0.1.0
raw patch · 10 files changed
+748/−0 lines, 10 filesdep +RSAdep +aesondep +attoparsecsetup-changed
Dependencies added: RSA, aeson, attoparsec, base, bytestring, case-insensitive, conduit, configurator, containers, hoauth, hstradeking, http-conduit, lifted-base, numbers, old-locale, resourcet, safe, text, time, transformers, vector
Files
- LICENSE +25/−0
- Setup.hs +6/−0
- client/Client.hs +73/−0
- client/Client/Quote.hs +36/−0
- hstradeking.cabal +59/−0
- src/Finance/TradeKing.hs +17/−0
- src/Finance/TradeKing/Config.hs +36/−0
- src/Finance/TradeKing/Quotes.hs +218/−0
- src/Finance/TradeKing/Service.hs +74/−0
- src/Finance/TradeKing/Types.hs +204/−0
+ LICENSE view
@@ -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.+
+ Setup.hs view
@@ -0,0 +1,6 @@+module Main where++import Distribution.Simple++main :: IO ()+main = defaultMain
+ client/Client.hs view
@@ -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>") "Consumer Key",+ Option "s" ["consumer-secret"] (ReqArg ConsumerSecret "<consumer-secret>") "Consumer Secret",+ Option "t" ["oauth-token"] (ReqArg OAuthToken "<oauth-token>") "OAuth Token",+ Option "S" ["oauth-secret"] (ReqArg OAuthTokenSecret "<oauth-secret>") "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 ++ " <COMMAND>"+ 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
+ client/Client/Quote.hs view
@@ -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)
+ hstradeking.cabal view
@@ -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 = <tradeking consumer key>+ > consumer-secret = <tradeking consumer secret>+ > oauth-token = <tradeking oauth token>+ > oauth-token-secret = <tradeking 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 <travis@athougies.net>+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
+ src/Finance/TradeKing.hs view
@@ -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
+ src/Finance/TradeKing/Config.hs view
@@ -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)
+ src/Finance/TradeKing/Quotes.hs view
@@ -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
+ src/Finance/TradeKing/Service.hs view
@@ -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
+ src/Finance/TradeKing/Types.hs view
@@ -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" }