diff --git a/Main.hs b/Main.hs index 9b75cae5f..6b8c6c15d 100644 --- a/Main.hs +++ b/Main.hs @@ -70,12 +70,11 @@ app config req respond = do ([table], "GET") -> if range == Just emptyRange then return $ responseLBS status416 [] "HTTP Range error" - else responseLBS status200 [json] . rrBody <$> + else respondWithRangedResult <$> (getRows (show ver) (unpack table) qq range =<< conn) (_, _) -> return $ responseLBS status404 [] "" - respond $ either sqlErrorHandler id r where @@ -87,6 +86,13 @@ app config req respond = do ver = fromMaybe 1 $ requestedVersion (requestHeaders req) range = requestedRange (requestHeaders req) +respondWithRangedResult :: RangedResult -> Response +respondWithRangedResult rr = + responseLBS status206 [json, ("Content-Range", "*/" <> (BS.pack . show . rrTotal) rr)] (rrBody rr) + + where + json = (hContentType, "application/json") + requestedVersion :: RequestHeaders -> Maybe Int requestedVersion hdrs = case verStr of diff --git a/PgQuery.hs b/PgQuery.hs index 1560d8173..e93917b9f 100644 --- a/PgQuery.hs +++ b/PgQuery.hs @@ -36,14 +36,16 @@ getRows schema table qq range conn = do $ selectStarClause schema table <> whereClause qq <> limitClause range + count <- populateSql conn + $ selectCountClause schema table + <> whereClause qq r <- quickQuery conn query [] + [[n]] <- quickQuery conn count [] - let body = case r of - [[SqlNull]] -> "[]" - [[json]] -> fromSql json - _ -> "" - return $ RangedResult 0 0 0 body - + return $ case r of + [[SqlNull]] -> RangedResult 0 0 0 "" + [[json]] -> RangedResult 0 0 (fromSql n) (fromSql json) + _ -> RangedResult 0 0 0 "" whereClause :: Net.Query -> QuotedSql whereClause qs = @@ -55,7 +57,7 @@ whereClause qs = wherePred :: Net.QueryItem -> QuotedSql wherePred (column, predicate) = - ("t.%I " <> op <> "%L", map toSql [column, value]) + ("%I " <> op <> "%L", map toSql [column, value]) where opCode:rest = BS.split ':' $ fromMaybe "" predicate