Implement single route selection

This commit is contained in:
calebmer
2015-11-16 17:21:07 -05:00
parent aa87853e71
commit 54eb0d3ec4
2 changed files with 48 additions and 22 deletions
+15 -7
View File
@@ -19,7 +19,7 @@ import qualified Data.HashMap.Strict as HM
import Data.List (find, sortBy, delete, transpose) import Data.List (find, sortBy, delete, transpose)
import Data.Maybe (fromMaybe, fromJust, isJust, isNothing, mapMaybe) import Data.Maybe (fromMaybe, fromJust, isJust, isNothing, mapMaybe)
import Data.Ord (comparing) import Data.Ord (comparing)
import Data.Ranged.Ranges (emptyRange) import Data.Ranged.Ranges (emptyRange, singletonRange)
import Data.String.Conversions (cs) import Data.String.Conversions (cs)
import Data.Text (Text, replace, strip) import Data.Text (Text, replace, strip)
import Data.Tree import Data.Tree
@@ -88,10 +88,15 @@ app dbStructure conf reqBody req =
if range == Just emptyRange if range == Just emptyRange
then return $ responseLBS status416 [] "HTTP Range error" then return $ responseLBS status416 [] "HTTP Range error"
else do else do
let q = createReadStatement selectQuery range (not $ hasPrefer "count=none") isCsv let q = createReadStatement selectQuery (if singular then Nothing else range) singular (not $ hasPrefer "count=none") isCsv
row <- H.maybeEx q row <- H.maybeEx q
let (tableTotal, queryTotal, _ , body) = extractQueryResult row let (tableTotal, queryTotal, _ , body) = extractQueryResult row
frm = fromMaybe 0 $ rangeOffset <$> range if singular
then return $ if queryTotal <= 0
then responseLBS status404 [] ""
else responseLBS status200 [contentTypeH] (fromMaybe "{}" body)
else do
let frm = fromMaybe 0 $ rangeOffset <$> range
to = frm+queryTotal-1 to = frm+queryTotal-1
contentRange = contentRangeH frm to tableTotal contentRange = contentRangeH frm to tableTotal
status = rangeStatus frm to tableTotal status = rangeStatus frm to tableTotal
@@ -183,6 +188,7 @@ app dbStructure conf reqBody req =
isCsv = contentType == csvMT isCsv = contentType == csvMT
contentTypeH = (hContentType, contentType) contentTypeH = (hContentType, contentType)
echoRequested = hasPrefer "return=representation" echoRequested = hasPrefer "return=representation"
singular = hasPrefer "plurality=singular"
request = parseRequest schema (dbRelations dbStructure) (head path) req reqBody --TODO! is head safe? request = parseRequest schema (dbRelations dbStructure) (head path) req reqBody --TODO! is head safe?
rangeStatus :: Int -> Int -> Maybe Int -> Status rangeStatus :: Int -> Int -> Maybe Int -> Status
@@ -404,15 +410,17 @@ parseRequest schema allRels rootTableName httpRequest reqBody =
then M.fromList <$> (zip <$> flds <*> (head <$> vals)) then M.fromList <$> (zip <$> flds <*> (head <$> vals))
else Left "Expecting a sigle CSV line with header or a JSON object" else Left "Expecting a sigle CSV line with header or a JSON object"
createReadStatement :: SqlQuery -> Maybe NonnegRange -> Bool -> Bool -> B.Stmt P.Postgres createReadStatement :: SqlQuery -> Maybe NonnegRange -> Bool -> Bool -> Bool -> B.Stmt P.Postgres
createReadStatement selectQuery range countTable asCsv = createReadStatement selectQuery range isSingle countTable asCsv =
B.Stmt ( B.Stmt (
wrapQuery selectQuery [ wrapQuery selectQuery [
if countTable then countAllF else countNoneF, if countTable then countAllF else countNoneF,
countF, countF,
"null", -- location header can not be calucalted "null", -- location header can not be calucalted
if asCsv then asCsvF else asJsonF if asCsv
] selectStarF range then asCsvF
else if isSingle then asJsonSingleF else asJsonF
] selectStarF (if isNothing range && isSingle then Just $ singletonRange 0 else range)
) V.empty True ) V.empty True
createWriteStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> [Text] -> Bool -> B.Stmt P.Postgres createWriteStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> [Text] -> Bool -> B.Stmt P.Postgres
+18
View File
@@ -214,6 +214,24 @@ spec =
get "/users_tasks?user_id=eq.2&task_id=eq.6&select=*, comments(content)" `shouldRespondWith` get "/users_tasks?user_id=eq.2&task_id=eq.6&select=*, comments(content)" `shouldRespondWith`
"[{\"user_id\":2,\"task_id\":6,\"comments\":[{\"content\":\"Needs to be delivered ASAP\"}]}]" "[{\"user_id\":2,\"task_id\":6,\"comments\":[{\"content\":\"Needs to be delivered ASAP\"}]}]"
describe "Plurality singular" $ do
it "will select an existing object" $
request methodGet "/items?id=eq.5" [("Prefer","plurality=singular")] ""
`shouldRespondWith` ResponseMatcher {
matchBody = Just [json| {"id":5} |]
, matchStatus = 200
, matchHeaders = []
}
it "will respond with 404 when not found" $
request methodGet "/items?id=eq.9999" [("Prefer","plurality=singular")] ""
`shouldRespondWith` 404
it "can shape plurality singular object routes" $
request methodGet "/projects_view?id=eq.1&select=id,name,clients(*),tasks(id,name)" [("Prefer","plurality=singular")] ""
`shouldRespondWith`
"{\"id\":1,\"name\":\"Windows 7\",\"clients\":{\"id\":1,\"name\":\"Microsoft\"},\"tasks\":[{\"id\":1,\"name\":\"Design w7\"},{\"id\":2,\"name\":\"Code w7\"}]}"
describe "ordering response" $ do describe "ordering response" $ do
it "by a column asc" $ it "by a column asc" $