diff --git a/Data/Factual/Response.hs b/Data/Factual/Response.hs --- a/Data/Factual/Response.hs +++ b/Data/Factual/Response.hs @@ -61,7 +61,9 @@ -- | This function can be used to extract any Aeson value from an Aeson Object -- (HashMap) value. lookupValue :: String -> Value -> Value -lookupValue key hashmap = fromJust $ lookupValueSafe key hashmap +lookupValue key hashmap = if maybeValue == Nothing then Null else fromJust maybeValue + where maybeValue = lookupValueSafe key hashmap + -- | This function can be used to safely extract any Aeson value from an Aeson -- Object (HashMap) value. diff --git a/Data/Factual/Write/Flag.hs b/Data/Factual/Write/Flag.hs --- a/Data/Factual/Write/Flag.hs +++ b/Data/Factual/Write/Flag.hs @@ -12,6 +12,7 @@ import Data.Factual.Write import Data.Factual.Shared.Table import Data.Maybe (fromJust) +import Data.List.Utils (join) import Data.Factual.Utils import qualified Data.Map as M @@ -34,7 +35,8 @@ , problem :: Problem , user :: String , comment :: Maybe String - , debug :: Bool + , dataJSON :: Maybe String + , fields :: Maybe [String] , reference :: Maybe String } deriving (Eq, Show) @@ -46,7 +48,8 @@ body flag = M.fromList [ ("problem", show $ problem flag) , ("user", user flag) , commentPair flag - , debugPair flag + , dataPair flag + , fieldsPair flag , referencePair flag ] -- The following functions are helpers for the body function @@ -55,10 +58,16 @@ | comment flag == Nothing = ("comment", "") | otherwise = ("comment", fromJust $ comment flag) -debugPair :: Flag -> (String, String) -debugPair flag - | debug flag == True = ("debug", "true") - | otherwise = ("debug", "false") +dataPair :: Flag -> (String, String) +dataPair flag + | dataJSON flag == Nothing = ("data", "") + | otherwise = ("data", fromJust $ dataJSON flag) + +fieldsPair :: Flag -> (String, String) +fieldsPair flag + | fields flag == Nothing = ("fields", "") + | otherwise = ("fields", arrayString) + where arrayString = "[" ++ (join "," $ fromJust $ fields flag) ++ "]" referencePair :: Flag -> (String, String) referencePair flag diff --git a/Data/Factual/Write/Submit.hs b/Data/Factual/Write/Submit.hs --- a/Data/Factual/Write/Submit.hs +++ b/Data/Factual/Write/Submit.hs @@ -15,12 +15,15 @@ -- | The Submit type represents a Write to the API which performs an upsert -- (a row can be updated or a new row can be written). The table and user --- must be specified, while the factual ID is optional (omitted for new --- rows). Finally the values are specified in a String to String Map. +-- must be specified, while the factual ID, reference, and comment are +-- optional (omitted for new rows). Finally the values are specified in a +-- String to String Map. data Submit = Submit { table :: Table , user :: String , factualId :: Maybe String , values :: M.Map String String + , reference :: Maybe String + , comment :: Maybe String } deriving (Eq, Show) -- The Submit type is a member of the Write typeclass so that it can be @@ -29,7 +32,9 @@ path submit = pathString submit params _ = M.empty body submit = M.fromList [ ("user", user submit) - , ("values", valuesString (values submit)) ] + , ("values", valuesString (values submit)) + , ("reference", maybeString (reference submit)) + , ("comment", maybeString (reference submit)) ] -- The following functions are helpers for the Write typeclass functions. pathString :: Submit -> String @@ -44,3 +49,7 @@ valuesString values = "{" ++ join "," (map valueString $ M.keys values) ++ "}" where valueString key = "\"" ++ key ++ "\":\"" ++ (fromJust $ M.lookup key values) ++ "\"" + +maybeString :: Maybe String -> String +maybeString (Just s) = s +maybeString Nothing = "" diff --git a/Network/Factual/API.hs b/Network/Factual/API.hs --- a/Network/Factual/API.hs +++ b/Network/Factual/API.hs @@ -14,6 +14,9 @@ -- * Debug functions , debugQuery , debugWrite + -- * Options type + , Options(..) + , Long -- * The hoauth Token type , Token(..) , urlEncode @@ -25,10 +28,12 @@ import Network.OAuth.Http.Request (Request(..), Method(..), parseURL, fromList) import Network.OAuth.Http.Response (Response(..)) import Network.OAuth.Http.CurlHttpClient (CurlClient(..)) +import Network.Curl.Opts (CurlOption(..)) import Data.Aeson (Value, decode) import Data.Aeson.Encode (encode) import Data.List.Utils (join) import Data.Factual.Query +import Network.Curl.Types (Long) import qualified Data.Factual.Write as W import qualified Data.Map as M import qualified Data.ByteString.Lazy.Char8 as B @@ -44,24 +49,28 @@ type Params = M.Map String String type Body = M.Map String String +-- | Options is used to store the Token and a potential timeout +data Options = Options { token :: Token, + timeout :: Maybe Long } + -- | This function takes a Key and Secret, and generates a Token that is passed -- to the various methods used to make requests. generateToken :: Key -> Secret -> Token generateToken key secret = fromApplication $ Application key secret OOB --- | This function takes a Token and Query value and sends the query to the +-- | This function takes Options and a Query value and sends the query to the -- Factual API. The resultant IO action contains a Response value which wraps -- the resultant data. -executeQuery :: (Query query) => Token -> query -> IO F.Response -executeQuery token query = get token (path query) (params query) +executeQuery :: (Query query) => Options -> query -> IO F.Response +executeQuery options query = get options (path query) (params query) -- | This function can be used to make a Multi Query (multiple queries in a single --- request. It takes a Token, a Map of key Strings to Queries and returns a Map +-- request. It takes Options, a Map of key Strings to Queries and returns a Map -- from the same keys to Response values. -executeMultiQuery :: (Query query) => Token -> M.Map String query -> IO (M.Map String F.Response) -executeMultiQuery token multiMap = do +executeMultiQuery :: (Query query) => Options -> M.Map String query -> IO (M.Map String F.Response) +executeMultiQuery options multiMap = do let queryString = formMultiQueryString $ M.toList multiMap - response <- get'' token queryString + response <- get'' options queryString return $ formMultiResponse response $ M.keys multiMap -- | This function can be used to debug Queries. It takes a Query value and prints @@ -69,10 +78,10 @@ debugQuery :: (Query query) => query -> IO () debugQuery query = putStrLn $ "Query path: " ++ basePath ++ (formQueryString (path query) (params query)) --- | This function is used to execute Writes. The function takes a Token and a +-- | This function is used to execute Writes. The function takes Options and a -- Write value, and returns a Response value. -executeWrite :: (W.Write write) => Token -> write -> IO F.Response -executeWrite token write = post token (W.path write) (W.params write) (W.body write) +executeWrite :: (W.Write write) => Options -> write -> IO F.Response +executeWrite options write = post options (W.path write) (W.params write) (W.body write) -- | This function can be used to debug Writes. It takes a Write value and prints -- out the URL path, and post body generated by that write. @@ -83,40 +92,42 @@ putStrLn $ formParamsString $ W.body write -- | This function can be used to perform raw read queries to any API endpoint. --- It takes a Token, a Path string and a Map of params (both keys and values +-- It takes Options, a Path string and a Map of params (both keys and values -- are strings). The function returns a standard Response value. -get :: Token -> Path -> Params -> IO F.Response -get token path params = get' token (formQueryString path params) +get :: Options -> Path -> Params -> IO F.Response +get options path params = get' options (formQueryString path params) -- | This function can be used to perform raw post queries to any API endpoint. --- It takes a Token, a Path string, a Map of params and a body Map. Both Maps +-- It takes Options, a Path string, a Map of params and a body Map. Both Maps -- have String keys and values. The function returns a standard Response value. -post :: Token -> Path -> Params -> Body -> IO F.Response -post token path params body = post' token queryString bodyString +post :: Options -> Path -> Params -> Body -> IO F.Response +post options path params body = post' options queryString bodyString where queryString = formQueryString path params bodyString = formParamsString body -- The following helper functions aid the exported API functions -get' :: Token -> String -> IO F.Response -get' token queryString = do - response <- get'' token queryString +get' :: Options -> String -> IO F.Response +get' options queryString = do + response <- get'' options queryString return $ F.fromValue $ extractJSON response -get'' :: Token -> String -> IO Response -get'' token queryString = do +get'' :: Options -> String -> IO Response +get'' options queryString = do let fullPath = basePath ++ queryString let request = generateRequest fullPath - execute token request + execute options request -post' :: Token -> String -> String -> IO F.Response -post' token queryString bodyString = do +post' :: Options -> String -> String -> IO F.Response +post' options queryString bodyString = do let fullPath = basePath ++ queryString let request = generatePostRequest fullPath bodyString - response <- execute token request + response <- execute options request return $ F.fromValue $ extractJSON response -execute :: Token -> Request -> IO Response -execute token request = runOAuthM token $ setupOAuth request +execute :: Options -> Request -> IO Response +execute options request = runOAuthM auth $ setupOAuth request to + where auth = token options + to = timeout options formQueryString :: String -> M.Map String String -> String formQueryString path params = path ++ "?" ++ (formParamsString params) @@ -150,10 +161,13 @@ where baseRequest = (fromJust $ parseURL url) postHeaders = headersList ++ [("Content-Type", "application/x-www-form-urlencoded")] -setupOAuth :: Request -> OAuthMonadT IO Response -setupOAuth request = do +setupOAuth :: Request -> Maybe Long -> OAuthMonadT IO Response +setupOAuth request Nothing = do oauthRequest <- signRq2 HMACSHA1 Nothing request serviceRequest CurlClient oauthRequest +setupOAuth request (Just timeout) = do + oauthRequest <- signRq2 HMACSHA1 Nothing request + serviceRequest (OptionsCurlClient [CurlTimeout timeout]) oauthRequest extractJSON :: Response -> Value extractJSON = fromJust . decode . rspPayload @@ -162,7 +176,7 @@ urlEncode = U.encode . S.encode headersList :: [(String, String)] -headersList = [("X-Factual-Lib", "factual-haskell-driver-0.5.2")] +headersList = [("X-Factual-Lib", "factual-haskell-driver-0.6.0")] basePath :: String basePath = "http://api.v3.factual.com" diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -53,19 +53,26 @@ # Tests +To run the integration tests you'll need an to create a yaml file +at ~/.factual/factual-auth.yaml to store your Factual credentials: + + --- + key: MYKEY + secret: MYSECRET + Load the tests file into ghci to run the tests: $ ghci test/Tests.hs -To run the integration tests you'll need an API key and secret, but you -can always run the unit tests: +Next you use the following functions to run the unit and integration +tests respectively: *Main> runUnitTests Cases: 53 Tried: 53 Errors: 0 Failures: 0 Counts {cases = 53, tried = 53, errors = 0, failures = 0} - *Main> runIntegrationTests "mykey" "mysecret" - Cases: 11 Tried: 11 Errors: 0 Failures: 0 - Counts {cases = 11, tried = 11, errors = 0, failures = 0} + *Main> runIntegrationTests + Cases: 14 Tried: 14 Errors: 0 Failures: 0 + Counts {cases = 14, tried = 14, errors = 0, failures = 0} # Documentation @@ -85,17 +92,3 @@ In this example replace mykey with your key and mysecret with your secret. Note that compiling the source code generates .o and .hi files in the source directories. - -# Notes - -## Writes - -Although there is code in the current version to support API writes, -these features have not yet been implemented in the Factual API. Please -refrain from attempting to use these features until they have been -officially announced. - -## Crosswalk deprecation - -The Crosswalk API endpoint has been migrated into a regular read table. -For more information see the [Factual V3 documentation](http://developer.factual.com/display/docs/Places+API+-+Crosswalk). diff --git a/examples/DiffsExample.hs b/examples/DiffsExample.hs --- a/examples/DiffsExample.hs +++ b/examples/DiffsExample.hs @@ -10,9 +10,9 @@ args <- getArgs let oauthKey = head args let oauthSecret = last args - let token = generateToken oauthKey oauthSecret + let options = Options { token = generateToken oauthKey oauthSecret, timeout = Nothing } let query = DiffsQuery { table = Custom "canada-stable", start = 1339123455775, end = 1339124455775 } - result <- executeQuery token query + result <- executeQuery options query putStrLn $ "Status: " ++ status result putStrLn $ "Version: " ++ show (version result) putStrLn $ "Data: " ++ show (response result) diff --git a/examples/FacetsExample.hs b/examples/FacetsExample.hs --- a/examples/FacetsExample.hs +++ b/examples/FacetsExample.hs @@ -10,7 +10,7 @@ args <- getArgs let oauthKey = head args let oauthSecret = last args - let token = generateToken oauthKey oauthSecret + let options = Options { token = generateToken oauthKey oauthSecret, timeout = Nothing } let query = FacetsQuery { table = Places , search = AndSearch ["Starbucks"] , select = ["country"] @@ -19,7 +19,7 @@ , limit = Nothing , minCount = Nothing , includeCount = False } - result <- executeQuery token query + result <- executeQuery options query putStrLn $ "Status: " ++ status result putStrLn $ "Version: " ++ show (version result) putStrLn $ "Data: " ++ show (response result) diff --git a/examples/GeocodeExample.hs b/examples/GeocodeExample.hs --- a/examples/GeocodeExample.hs +++ b/examples/GeocodeExample.hs @@ -10,9 +10,9 @@ args <- getArgs let oauthKey = head args let oauthSecret = last args - let token = generateToken oauthKey oauthSecret + let options = Options { token = generateToken oauthKey oauthSecret, timeout = Nothing } let query = GeocodeQuery $ Point 34.06021 (-118.41828) - result <- executeQuery token query + result <- executeQuery options query putStrLn $ "Status: " ++ status result putStrLn $ "Version: " ++ show (version result) putStrLn $ "Data: " ++ show (response result) diff --git a/examples/GeopulseExample.hs b/examples/GeopulseExample.hs --- a/examples/GeopulseExample.hs +++ b/examples/GeopulseExample.hs @@ -10,10 +10,10 @@ args <- getArgs let oauthKey = head args let oauthSecret = last args - let token = generateToken oauthKey oauthSecret + let options = Options { token = generateToken oauthKey oauthSecret, timeout = Nothing } let query = GeopulseQuery { geo = Point 34.06021 (-118.41828) , select = ["commercial_density"] } - result <- executeQuery token query + result <- executeQuery options query putStrLn $ "Status: " ++ status result putStrLn $ "Version: " ++ show (version result) putStrLn $ "Data: " ++ show (response result) diff --git a/examples/MatchExample.hs b/examples/MatchExample.hs --- a/examples/MatchExample.hs +++ b/examples/MatchExample.hs @@ -10,10 +10,10 @@ args <- getArgs let oauthKey = head args let oauthSecret = last args - let token = generateToken oauthKey oauthSecret + let options = Options { token = generateToken oauthKey oauthSecret, timeout = Nothing } let query = MatchQuery [ MatchStr "name" "McDonalds" , MatchStr "address" "10451 Santa Monica Blvd" ] - result <- executeQuery token query + result <- executeQuery options query putStrLn $ "Status: " ++ status result putStrLn $ "Version: " ++ show (version result) putStrLn $ "Data: " ++ show (response result) diff --git a/examples/MultiExample.hs b/examples/MultiExample.hs --- a/examples/MultiExample.hs +++ b/examples/MultiExample.hs @@ -11,7 +11,7 @@ args <- getArgs let oauthKey = head args let oauthSecret = last args - let token = generateToken oauthKey oauthSecret + let options = Options { token = generateToken oauthKey oauthSecret, timeout = Nothing } let query1 = ReadQuery { table = Places , search = AndSearch [] , select = ["name"] @@ -29,7 +29,7 @@ , geo = Just (Circle 34.06021 (-118.41828) 5000.0) , filters = [EqualStr "name" "Xerox"] } let multiQuery = M.fromList [("query1", query1), ("query2", query2)] - multiResult <- executeMultiQuery token multiQuery + multiResult <- executeMultiQuery options multiQuery let result1 = multiResult M.! "query1" let result2 = multiResult M.! "query2" putStrLn "query1:" diff --git a/examples/RawReadExample.hs b/examples/RawReadExample.hs --- a/examples/RawReadExample.hs +++ b/examples/RawReadExample.hs @@ -10,8 +10,8 @@ args <- getArgs let oauthKey = head args let oauthSecret = last args - let token = generateToken oauthKey oauthSecret - result <- get token "/t/places" $ M.fromList [("q", "starbucks")] + let options = Options { token = generateToken oauthKey oauthSecret, timeout = Nothing } + result <- get options "/t/places" $ M.fromList [("q", "starbucks")] putStrLn $ "Status: " ++ status result putStrLn $ "Version: " ++ show (version result) putStrLn $ "Data: " ++ show (response result) diff --git a/examples/ReadExample.hs b/examples/ReadExample.hs --- a/examples/ReadExample.hs +++ b/examples/ReadExample.hs @@ -10,7 +10,7 @@ args <- getArgs let oauthKey = head args let oauthSecret = last args - let token = generateToken oauthKey oauthSecret + let options = Options { token = generateToken oauthKey oauthSecret, timeout = Nothing } let query = ReadQuery { table = Places , search = AndSearch [] , select = ["name"] @@ -20,7 +20,7 @@ , geo = Just (Circle 34.06021 (-118.41828) 5000.0) , sort = [] , filters = [EqualStr "name" "Stand"] } - result <- executeQuery token query + result <- executeQuery options query putStrLn $ "Status: " ++ status result putStrLn $ "Version: " ++ show (version result) putStrLn $ "Data: " ++ show (response result) diff --git a/examples/ResolveExample.hs b/examples/ResolveExample.hs --- a/examples/ResolveExample.hs +++ b/examples/ResolveExample.hs @@ -10,12 +10,12 @@ args <- getArgs let oauthKey = head args let oauthSecret = last args - let token = generateToken oauthKey oauthSecret + let options = Options { token = generateToken oauthKey oauthSecret, timeout = Nothing } let resolveValues = [ ResolveStr "name" "McDonalds" , ResolveStr "address" "10451 Santa Monica Blvd" ] let query = ResolveQuery { values = resolveValues , debug = False } - result <- executeQuery token query + result <- executeQuery options query putStrLn $ "Status: " ++ status result putStrLn $ "Version: " ++ show (version result) putStrLn $ "Data: " ++ show (response result) diff --git a/examples/SchemaExample.hs b/examples/SchemaExample.hs --- a/examples/SchemaExample.hs +++ b/examples/SchemaExample.hs @@ -10,9 +10,9 @@ args <- getArgs let oauthKey = head args let oauthSecret = last args - let token = generateToken oauthKey oauthSecret + let options = Options { token = generateToken oauthKey oauthSecret, timeout = Nothing } let query = SchemaQuery Places - result <- executeQuery token query + result <- executeQuery options query putStrLn $ "Status: " ++ status result putStrLn $ "Version: " ++ show (version result) putStrLn $ "Data: " ++ show (response result) diff --git a/factual-api.cabal b/factual-api.cabal --- a/factual-api.cabal +++ b/factual-api.cabal @@ -1,5 +1,5 @@ name: factual-api -version: 0.5.2 +version: 0.6.0 license: BSD3 license-file: LICENSE.txt category: API, Web @@ -55,6 +55,7 @@ base == 4.*, bytestring, containers, + curl >= 1.3.7, dataenc >= 0.14.0.3, hoauth >= 0.3.5, HTTP, diff --git a/test/Tests.hs b/test/Tests.hs --- a/test/Tests.hs +++ b/test/Tests.hs @@ -1,4 +1,7 @@ import Test.HUnit +import System.IO +import System.Environment +import Data.String.Utils import Network.Factual.API import Data.Factual.Query.ReadQuery import Data.Factual.Query.SchemaQuery @@ -18,8 +21,21 @@ runUnitTests = runTestTT unitTests -runIntegrationTests key secret = runTestTT $ integrationTests key secret +runIntegrationTests = do + token <- getTokenFromCredentialsFile + runTestTT $ integrationTests token +getTokenFromCredentialsFile = do + home <- getEnv "HOME" + yaml <- readFile $ home ++ "/.factual/factual-auth.yaml" + let lines = split "\n" yaml + let lines' = filter (\x -> length (split ":" x) == 2) lines + let pairs = map (map strip . split ":") lines' + let key = last $ head $ filter (\x -> head x == "key") pairs + let secret = last $ head $ filter (\x -> head x == "secret") pairs + let token = generateToken key secret + return token + unitTests = TestList [ TestLabel "Place table test" placeTablePathTest , TestLabel "Restaurants table test" restaurantsTablePathTest , TestLabel "Hotels table test" hotelsTablePathTest @@ -74,22 +90,21 @@ , TestLabel "Flag path test" flagPathTest , TestLabel "Flag body test" flagBodyTest ] -integrationTests key secret = TestList [ TestLabel "Read test" (readIntegrationTest token) - , TestLabel "Unicode test" (unicodeIntegrationTest token) - , TestLabel "Schema test" (schemaIntegrationTest token) - , TestLabel "Resolve test" (resolveIntegrationTest token) - , TestLabel "Match test" (matchIntegrationTest token) - , TestLabel "Raw read test" (rawIntegrationTest token) - , TestLabel "Facets test" (facetsIntegrationTest token) - --, TestLabel "Diffs test" (diffsIntegrationTest token) - , TestLabel "Geopulse test" (geopulseIntegrationTest token) - , TestLabel "Geocode test" (geocodeIntegrationTest token) - , TestLabel "Multi test" (multiIntegrationTest token) - --, TestLabel "Submit test" (submitIntegrationTest token) - --, TestLabel "Insert test" (insertIntegrationTest token) - --, TestLabel "Flag test" (flagIntegrationTest token) - , TestLabel "Error test" (errorIntegrationTest token) ] - where token = generateToken key secret +integrationTests token = TestList [ TestLabel "Read test" (readIntegrationTest token) + , TestLabel "Unicode test" (unicodeIntegrationTest token) + , TestLabel "Schema test" (schemaIntegrationTest token) + , TestLabel "Resolve test" (resolveIntegrationTest token) + , TestLabel "Match test" (matchIntegrationTest token) + , TestLabel "Raw read test" (rawIntegrationTest token) + , TestLabel "Facets test" (facetsIntegrationTest token) + --, TestLabel "Diffs test" (diffsIntegrationTest token) + , TestLabel "Geopulse test" (geopulseIntegrationTest token) + , TestLabel "Geocode test" (geocodeIntegrationTest token) + , TestLabel "Multi test" (multiIntegrationTest token) + , TestLabel "Submit test" (submitIntegrationTest token) + , TestLabel "Insert test" (insertIntegrationTest token) + , TestLabel "Flag test" (flagIntegrationTest token) + , TestLabel "Error test" (errorIntegrationTest token) ] placeTablePathTest = TestCase (do let expected = "/t/places" @@ -403,12 +418,10 @@ assertEqual "Correct path for flag" expected path) flagBodyTest = TestCase (do - let expected = "problem=Duplicate&user=user123&comment=There was a problem&debug=false" let bodyParams = W.body flagWrite assertEqual "Correct problem" (bodyParams M.! "problem") "Duplicate" assertEqual "Correct user" (bodyParams M.! "user") "user123" - assertEqual "Correct comment" (bodyParams M.! "comment") "There was a problem" - assertEqual "Correct debug" (bodyParams M.! "debug") "false") + assertEqual "Correct comment" (bodyParams M.! "comment") "There was a problem") readIntegrationTest :: Token -> Test @@ -422,7 +435,7 @@ , geo = Just (Circle 34.06021 (-118.41828) 5000.0) , sort = [] , filters = [EqualStr "name" "Stand"] } - result <- executeQuery token query + result <- executeQuery (Options { token = token, timeout = Nothing }) query assertEqual "Valid read query" "ok" (status result)) unicodeIntegrationTest :: Token -> Test @@ -436,7 +449,7 @@ , geo = Nothing , sort = [] , filters = [EqualStr "locality" "בני ברק"] } - result <- executeQuery token query + result <- executeQuery (Options { token = token, timeout = Nothing }) query let resp = response result let dat = lookupValue "data" resp let row = (toList dat) !! 0 @@ -446,25 +459,25 @@ schemaIntegrationTest :: Token -> Test schemaIntegrationTest token = TestCase (do let query = SchemaQuery Places - result <- executeQuery token query + result <- executeQuery (Options { token = token, timeout = Nothing }) query assertEqual "Valid schema query" "ok" (status result)) resolveIntegrationTest :: Token -> Test resolveIntegrationTest token = TestCase (do let query = ResolveQuery { values = [ResolveStr "name" "McDonalds"], debug = False } - result <- executeQuery token query + result <- executeQuery (Options { token = token, timeout = Nothing }) query assertEqual "Valid resolve query" "ok" (status result)) matchIntegrationTest :: Token -> Test matchIntegrationTest token = TestCase (do let query = MatchQuery [MatchStr "name" "McDonalds"] - result <- executeQuery token query + result <- executeQuery (Options { token = token, timeout = Nothing }) query assertEqual "Valid match query" "ok" (status result)) rawIntegrationTest :: Token -> Test rawIntegrationTest token = TestCase (do - result <- get token "/t/places" (M.fromList [("q", "starbucks")]) + result <- get (Options { token = token, timeout = Nothing }) "/t/places" (M.fromList [("q", "starbucks")]) assertEqual "Valid read query" "ok" (status result)) facetsIntegrationTest token = TestCase (do @@ -476,23 +489,23 @@ , F.limit = Just 100 , F.minCount = Just 1 , F.includeCount = False } - result <- executeQuery token query + result <- executeQuery (Options { token = token, timeout = Nothing }) query assertEqual "Valid facets query" "ok" (status result)) diffsIntegrationTest token = TestCase (do - let query = D.DiffsQuery { D.table = Custom "canada-stable", D.start = 1339123455775, D.end = 1339124455775 } - result <- executeQuery token query + let query = D.DiffsQuery { D.table = Custom "t7RSEV", D.start = 1339123455775, D.end = 1339124455775 } + result <- executeQuery (Options { token = token, timeout = Nothing }) query assertEqual "Valid diffs query" "ok" (status result)) geopulseIntegrationTest token = TestCase (do let query = G.GeopulseQuery { G.geo = Point 34.06021 (-118.41828) , G.select = [] } - result <- executeQuery token query + result <- executeQuery (Options { token = token, timeout = Nothing }) query assertEqual "Valid geopulse query" "ok" (status result)) geocodeIntegrationTest token = TestCase (do let query = GeocodeQuery $ Point 34.06021 (-118.41828) - result <- executeQuery token query + result <- executeQuery (Options { token = token, timeout = Nothing }) query assertEqual "Valid geopulse query" "ok" (status result)) @@ -508,7 +521,7 @@ , sort = [] , filters = [EqualStr "name" "Stand"] } let query2 = query1 { filters = [EqualStr "name" "Xerox"] } - results <- executeMultiQuery token $ M.fromList [("query1", query1), ("query2", query2)] + results <- executeMultiQuery (Options { token = token, timeout = Nothing }) $ M.fromList [("query1", query1), ("query2", query2)] let result1 = results M.! "query1" let result2 = results M.! "query2" assertEqual "Valid multi query" ["ok","ok"] [status result1, status result2]) @@ -519,11 +532,13 @@ , ("address","1801 Avenue of the Stars, Suite 1450") , ("country","USA") , ("locality","Los Angeles") ] - let write = S.Submit { S.table = Custom "canada-edge" + let write = S.Submit { S.table = Custom "t7RSEV" , S.user = "drivertest" , S.factualId = Nothing + , S.reference = Nothing + , S.comment = Nothing , S.values = newValues } - result <- executeWrite token write + result <- executeWrite (Options { token = token, timeout = Nothing }) write assertEqual "Valid submit" "ok" (status result)) insertIntegrationTest :: Token -> Test @@ -532,28 +547,29 @@ , ("address","1801 Avenue of the Stars, Suite 1450") , ("country","USA") , ("locality","Los Angeles") ] - let write = I.Insert { I.table = Custom "canada-edge" + let write = I.Insert { I.table = Custom "t7RSEV" , I.user = "drivertest" , I.factualId = Nothing , I.values = newValues } - result <- executeWrite token write + result <- executeWrite (Options { token = token, timeout = Nothing }) write assertEqual "Valid insert" "ok" (status result)) flagIntegrationTest :: Token -> Test flagIntegrationTest token = TestCase (do - let write = L.Flag { L.table = Custom "canada-edge" + let write = L.Flag { L.table = Custom "t7RSEV" , L.user = "drivertest" - , L.factualId = "f33527e0-a8b4-4808-a820-2686f18cb00c" + , L.factualId = "97a38c06-cde1-402d-ad5a-4ae408530386" , L.problem = L.Inaccurate , L.comment = Nothing - , L.debug = False + , L.dataJSON = Nothing + , L.fields = Nothing , L.reference = Nothing } - result <- executeWrite token write + result <- executeWrite (Options { token = token, timeout = Nothing }) write assertEqual "Valid flag" "ok" (status result)) errorIntegrationTest :: Token -> Test errorIntegrationTest token = TestCase (do - result <- get token "/t/foobarbaz" (M.empty) + result <- get (Options { token = token, timeout = Nothing }) "/t/foobarbaz" (M.empty) assertEqual "Invalud read query" "error" (status result)) blankReadQuery :: ReadQuery @@ -571,6 +587,8 @@ submitWrite = S.Submit { S.table = Places , S.user = "user123" , S.factualId = Just "foobar" + , S.reference = Nothing + , S.comment = Nothing , S.values = M.fromList [("key", "val")] } insertWrite :: I.Insert @@ -580,10 +598,11 @@ , I.values = M.fromList [("key", "val")] } flagWrite :: L.Flag -flagWrite = L.Flag { L.table = Places - , L.factualId = "foobar" - , L.problem = L.Duplicate - , L.user = "user123" - , L.comment = Just "There was a problem" - , L.debug = False - , L.reference = Nothing } +flagWrite = L.Flag { L.table = Places + , L.factualId = "foobar" + , L.problem = L.Duplicate + , L.user = "user123" + , L.comment = Just "There was a problem" + , L.dataJSON = Nothing + , L.fields = Nothing + , L.reference = Nothing }