diff --git a/Main.hs b/Main.hs index 42758aedb..26d5a59c9 100644 --- a/Main.hs +++ b/Main.hs @@ -22,10 +22,10 @@ import qualified Data.ByteString.Char8 as BS import PgStructure (printTables, printColumns) import PgQuery (selectWhere) -import Debug.Trace - -traceThis :: (Show a) => a -> a -traceThis x = trace (show x) x +import Data.Maybe (fromMaybe) +import qualified Data.Text as T +import Text.Regex.Posix ((=~)) +import Text.Read (readMaybe) data AppConfig = AppConfig { configDbUri :: String @@ -52,11 +52,11 @@ app :: AppConfig -> Application app config req respond = do r <- try $ case path of - [] -> responseLBS status200 [json] <$> (printTables =<< conn) + [] -> responseLBS status200 [json] <$> (printTables ver =<< conn) [table] -> responseLBS status200 [json] <$> ( if verb == methodOptions then printColumns table =<< conn - else selectWhere table qq =<< conn ) + else selectWhere (T.pack $ show ver) table qq =<< conn ) _ -> return $ responseLBS status404 [] "" respond $ either sqlErrorHandler id r @@ -67,6 +67,17 @@ app config req respond = do json = (hContentType, "application/json") conn = connectPostgreSQL $ configDbUri config qq = queryString req + ver = fromMaybe 1 $ requestedVersion (requestHeaders req) + +requestedVersion :: RequestHeaders -> Maybe Int +requestedVersion hdrs = + case verStr of + Just [[_, ver]] -> readMaybe ver + _ -> Nothing + + where verRegex = "version[ ]*=[ ]*([0-9]+)" :: String + accept = BS.unpack <$> lookup hAccept hdrs :: Maybe String + verStr = (=~ verRegex) <$> accept :: Maybe [[String]] sqlErrorHandler :: SqlError -> Response sqlErrorHandler e = diff --git a/PgQuery.hs b/PgQuery.hs index 599c22b29..836b58f76 100644 --- a/PgQuery.hs +++ b/PgQuery.hs @@ -16,8 +16,8 @@ import Database.HDBC.PostgreSQL import Network.HTTP.Types.URI -selectWhere :: T.Text -> Query -> Connection -> IO BL.ByteString -selectWhere table qq conn = do +selectWhere :: T.Text -> T.Text -> Query -> Connection -> IO BL.ByteString +selectWhere ver table qq conn = do s <- selectSql w <- whereClause conn qq r <- quickQuery conn (BS.unpack $ s <> w) [] @@ -29,7 +29,7 @@ selectWhere table qq conn = do selectSql = pgFormat conn "select array_to_json(array_agg(row_to_json(t)))\ \ from (select * from %I.%I) t" - [toSql (T.pack "base"), toSql table] + [toSql ver, toSql table] whereClause :: Connection -> Query -> IO BS.ByteString diff --git a/PgStructure.hs b/PgStructure.hs index c5f8b1eb2..d6f04ca5f 100644 --- a/PgStructure.hs +++ b/PgStructure.hs @@ -97,8 +97,8 @@ columns t conn = do namedColumnHash :: [Column] -> HashMap String Column namedColumnHash = fromList . (Prelude.zip =<< Prelude.map colName) -printTables :: Connection -> IO BL.ByteString -printTables conn = JSON.encode <$> tables "base" conn +printTables :: Int -> Connection -> IO BL.ByteString +printTables schema conn = JSON.encode <$> tables (show schema) conn printColumns :: T.Text -> Connection -> IO BL.ByteString printColumns table conn = JSON.encode . namedColumnHash <$> columns table conn diff --git a/dbapi.cabal b/dbapi.cabal index 44f017be2..8ed3ee099 100644 --- a/dbapi.cabal +++ b/dbapi.cabal @@ -22,5 +22,6 @@ executable dbapi , bytestring, aeson, network , text, optparse-applicative , unordered-containers + , http-media, regex-posix -- hs-source-dirs: default-language: Haskell2010