Allow user to override schema used for v1 of api

src/App.hs

@@ -35,8 +35,8 @@ import PgQuery
 import RangeQuery
 import PgStructure
 
-app :: BL.ByteString -> Request -> H.Tx P.Postgres s Response
-app reqBody req =
+app :: Text -> BL.ByteString -> Request -> H.Tx P.Postgres s Response
+app v1schema reqBody req =
   case (path, verb) of
     ([], _) -> do
       body <- encode <$> tables (cs schema)
@@ -171,7 +171,7 @@ app reqBody req =
     verb   = requestMethod req
     qq     = queryString req
     hdrs   = requestHeaders req
-    schema = requestedSchema hdrs
+    schema = requestedSchema v1schema hdrs
     range  = rangeRequested hdrs
     allOrigins = ("Access-Control-Allow-Origin", "*") :: Header
 
@@ -197,11 +197,11 @@ contentRangeH from to total =
        <> cs (show total)
   )
 
-requestedSchema :: RequestHeaders -> Text
-requestedSchema hdrs =
+requestedSchema :: Text -> RequestHeaders -> Text
+requestedSchema v1schema hdrs =
   case verStr of
-       Just [[_, ver]] -> ver
-       _ -> "1"
+       Just [[_, ver]] -> if ver == "1" then v1schema else ver
+       _ -> v1schema
 
   where verRegex = "version[ ]*=[ ]*([0-9]+)" :: String
         accept = cs <$> lookup hAccept hdrs :: Maybe Text

src/Config.hs

@@ -20,6 +20,7 @@ data AppConfig = AppConfig {
   , configAnonRole :: String
   , configSecure :: Bool
   , configPool :: Int
+  , configV1Schema :: String
   }
 
 argParser :: Parser AppConfig
@@ -34,6 +35,7 @@ argParser = AppConfig
   <*> strOption (long "anonymous" <> short 'a' <> metavar "ROLE" <> help "postgres role to use for non-authenticated requests")
   <*> switch (long "secure" <> short 's' <> help "Redirect all requests to HTTPS")
   <*> option auto (long "db-pool" <> metavar "COUNT" <> value 10 <> help "Max connections in database pool" <> showDefault)
+  <*> strOption (long "v1schema" <> metavar "NAME" <> value "1" <> help "Schema to use for nonspecified version (or explicit v1)" <> showDefault)
 
 defaultCorsPolicy :: CorsResourcePolicy
 defaultCorsPolicy =  CorsResourcePolicy Nothing

src/Main.hs

@@ -63,7 +63,7 @@ main = do
   runSettings appSettings $ middle $ \req respond -> do
     body <- strictRequestBody req
     resOrError <- liftIO $ H.session pool $ H.tx Nothing $
-      authenticated currRole anonRole (app body) req
+      authenticated currRole anonRole (app (cs $ configV1Schema conf) body) req
     either (respond . errResponse) respond resOrError
 
   where