Introduce the OpenAPI header

Also bring back the original behavior of GET "/"

src/PostgREST/ApiRequest.hs

@@ -45,10 +45,11 @@ data Target = TargetIdent QualifiedIdentifier
 data PreferRepresentation = Full | HeadersOnly | None deriving Eq
 -- | Enumeration of currently supported content types for
 -- route responses and upload payloads
-data ContentType = ApplicationJSON | TextCSV deriving Eq
+data ContentType = ApplicationJSON | TextCSV | OpenAPI deriving Eq
 instance Show ContentType where
   show ApplicationJSON = "application/json; charset=utf-8"
   show TextCSV         = "text/csv; charset=utf-8"
+  show OpenAPI         = "application/openapi+json; charset=utf-8"
 
 {-|
   Describes what the user wants to do. This data type is a
@@ -123,6 +124,8 @@ userApiRequest schema req reqBody =
               Nothing -> PayloadParseError "All lines must have same number of fields"
               Just json -> PayloadJSON json)
             (CSV.decodeByName reqBody)
+        Right OpenAPI ->
+          PayloadParseError "Content-type not acceptable"
         -- This is a Left value because form-urlencoded is not a content
         -- type which we ever use for responses, only something we handle
         -- just this once for requests
@@ -208,11 +211,13 @@ pickContentType :: Maybe BS.ByteString -> Either BS.ByteString ContentType
 pickContentType accept
   | isNothing accept || has ctAll || has ctJson = Right ApplicationJSON
   | has ctCsv = Right TextCSV
+  | has ctOpenAPI = Right OpenAPI
   | otherwise = Left accept'
  where
   ctAll  = "*/*"
   ctCsv  = "text/csv"
   ctJson = "application/json"
+  ctOpenAPI = "application/openapi+json"
   Just accept' = accept
   findInAccept = flip find $ parseHttpAccept accept'
   has          = isJust . findInAccept . BS.isPrefixOf

src/PostgREST/App.hs

@@ -204,7 +204,9 @@ app dbStructure conf apiRequest =
         else return notFound
 
     (ActionRead, TargetRoot, Nothing) -> do
-      body <- (encodeApi . toTableInfo) <$> H.query schema accessibleTables
+      body <- if contentType == OpenAPI
+                 then (encodeApi . toTableInfo) <$> H.query schema accessibleTables
+                 else encode <$> H.query schema accessibleTables
       return $ responseLBS status200 [jsonH] $ cs body
 
     (ActionInappropriate, _, _) -> return $ responseLBS status405 [] ""

src/PostgREST/OpenAPI.hs

@@ -10,7 +10,6 @@ import           Data.ByteString.Lazy        (ByteString)
 import           Data.HashMap.Strict.InsOrd  (InsOrdHashMap, fromList)
 import           Data.String                 (IsString (..))
 import           Data.Text                   (Text, unpack, pack, concat, intercalate)
-import           Network.HTTP.Media          (MediaType)
 import qualified Data.Set                    as Set
 
 import           Prelude hiding              (concat)
@@ -22,8 +21,8 @@ import           PostgREST.Config            (prettyVersion)
 import           PostgREST.QueryBuilder      (operators)
 import           PostgREST.Types             (Table(..), Column(..))
 
-makeMimeList :: [MediaType]
-makeMimeList = map (fromString . show) [ApplicationJSON, TextCSV]
+makeMimeList :: [ContentType] -> MimeList
+makeMimeList cs = MimeList $ map (fromString . show) cs
 
 toSwaggerType :: Text -> SwaggerType t
 toSwaggerType "text"      = SwaggerString
@@ -168,15 +167,15 @@ makePathItem (t, cs, _) = ("/" ++ unpack tn, p $ tableInsertable t)
   where
     tOp = (mempty :: Operation)
       & tags .~ Set.fromList [tn]
-      & produces ?~ MimeList makeMimeList
+      & produces ?~ makeMimeList [ApplicationJSON, TextCSV]
       & at 200 ?~ "OK"
     getOp = tOp
       & parameters .~ map Inline (makeGetParams cs ++ rs)
     postOp = tOp
-      & consumes ?~ MimeList makeMimeList
+      & consumes ?~ makeMimeList [ApplicationJSON, TextCSV]
       & parameters .~ map Inline (makePostParams tn)
     patchOp = tOp
-      & consumes ?~ MimeList makeMimeList
+      & consumes ?~ makeMimeList [ApplicationJSON, TextCSV]
       & parameters .~ map Inline (makePostParams tn ++ rs)
     deletOp = tOp
       & parameters .~ map Inline (makeDeleteParams ++ rs)
@@ -192,7 +191,8 @@ makeRootPathItem = ("/", p)
   where
     getOp = (mempty :: Operation)
       & tags .~ Set.fromList ["/"]
-      & produces ?~ MimeList [(fromString . show) ApplicationJSON]
+      & produces ?~ makeMimeList [ApplicationJSON, OpenAPI]
+      & consumes ?~ makeMimeList [ApplicationJSON, OpenAPI]
       & at 200 ?~ "OK"
     pr = (mempty :: PathItem) & get ?~ getOp
     p = pr