mirror of
https://github.com/scarf-sh/tie.git
synced 2024-11-23 02:56:59 +03:00
Default to free form object in case of missing shema type annotation
This commit is contained in:
Alex Biehl
Alexander Biehl
parent
a84d0b4e00
commit
fb2b6e701b
@ -281,7 +281,18 @@ schemaToType resolver schema
|
||||
| Just _enum <- OpenApi._schemaEnum schema =
|
||||
pure (Basic (schemaToStringyType schema))
|
||||
| otherwise =
|
||||
traceShow schema undefined
|
||||
-- Fallback to a free form object type in case nothing else
|
||||
-- matches
|
||||
-- TODO: maybe warn about missing explicit type
|
||||
pure
|
||||
( Object
|
||||
( ObjectType
|
||||
{ properties = mempty,
|
||||
requiredProperties = mempty,
|
||||
freeFormObjectType = True
|
||||
}
|
||||
)
|
||||
)
|
||||
|
||||
-- | Resolves an 'OpenApi.Schema' to an 'ObjectType'. In case the the 'OpenApi.Schema' is an
|
||||
-- allOf-schema. This function doesn't do any additional type checking.
|
||||
|
||||
21
test/golden/object-without-type.yaml
Normal file
21
test/golden/object-without-type.yaml
Normal file
@ -0,0 +1,21 @@
|
||||
openapi: "3.0.0"
|
||||
info:
|
||||
version: 1.0.0
|
||||
title: Scarf
|
||||
license:
|
||||
name: AllRightsReserved
|
||||
servers:
|
||||
- url: https://scarf.sh/api/v1
|
||||
paths:
|
||||
/test:
|
||||
get:
|
||||
summary: test
|
||||
operationId: test
|
||||
responses:
|
||||
'200':
|
||||
description: CSV response without schema
|
||||
content:
|
||||
application/json:
|
||||
schema:
|
||||
description: Undocumented
|
||||
components: {}
|
||||
367
test/golden/object-without-type.yaml.out
Normal file
367
test/golden/object-without-type.yaml.out
Normal file
@ -0,0 +1,367 @@
|
||||
Test/Api.hs
|
||||
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
module Test.Api where
|
||||
|
||||
import qualified Control.Applicative
|
||||
import qualified Control.Exception
|
||||
import qualified Control.Monad
|
||||
import qualified Control.Monad.Catch
|
||||
import qualified Control.Monad.IO.Class
|
||||
import qualified Data.Aeson
|
||||
import qualified Data.Aeson.Encoding
|
||||
import qualified Data.Aeson.Parser
|
||||
import qualified Data.Aeson.Types
|
||||
import qualified Data.Attoparsec.ByteString
|
||||
import qualified Data.List
|
||||
import qualified Data.Maybe
|
||||
import qualified Data.Text
|
||||
import qualified Data.Time
|
||||
import qualified Data.Text.Encoding
|
||||
import qualified GHC.Float
|
||||
import qualified GHC.Int
|
||||
import qualified GHC.Types
|
||||
import qualified Network.HTTP.Types
|
||||
import qualified Network.Wai
|
||||
import qualified Web.HttpApiData
|
||||
|
||||
import Test.Request
|
||||
import Test.Response
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
import Test.Response.Test
|
||||
|
||||
data Api m = Api {
|
||||
-- | test
|
||||
test ::
|
||||
m TestResponse
|
||||
}
|
||||
|
||||
application :: (Control.Monad.Catch.MonadCatch m, Control.Monad.IO.Class.MonadIO m) => (forall a . Network.Wai.Request -> m a -> IO a) -> Api m -> Network.Wai.Application -> Network.Wai.Application
|
||||
application run api notFound request respond =
|
||||
case Network.Wai.pathInfo request of
|
||||
["test"] ->
|
||||
case Network.Wai.requestMethod request of
|
||||
"GET" ->
|
||||
run request (do
|
||||
response <- Control.Monad.Catch.handle pure (test api)
|
||||
Control.Monad.IO.Class.liftIO (respond $! (toResponse response))
|
||||
)
|
||||
x ->
|
||||
unsupportedMethod x
|
||||
|
||||
_ ->
|
||||
notFound request respond
|
||||
where
|
||||
unsupportedMethod _ =
|
||||
respond (Network.Wai.responseBuilder (toEnum 405) [] mempty)
|
||||
---------------------
|
||||
Test/Request.hs
|
||||
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Test.Request
|
||||
( pathVariable,
|
||||
requiredQueryParameter,
|
||||
optionalQueryParameter,
|
||||
requiredHeader,
|
||||
optionalHeader,
|
||||
parseRequestBody,
|
||||
jsonBodyParser,
|
||||
formBodyParser,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Aeson (FromJSON, parseJSON)
|
||||
import qualified Data.Aeson.Parser
|
||||
import qualified Data.Aeson.Types
|
||||
import Data.Attoparsec.ByteString (eitherResult, parseWith)
|
||||
import Data.ByteString (ByteString)
|
||||
import qualified Data.ByteString as ByteString
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import qualified Data.List as List
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as Text
|
||||
import qualified Data.Text.Encoding as Text
|
||||
import Network.HTTP.Types (HeaderName, hContentType)
|
||||
import qualified Network.Wai as Wai
|
||||
import System.IO.Unsafe (unsafeInterleaveIO)
|
||||
import Web.FormUrlEncoded (FromForm, urlDecodeAsForm)
|
||||
import Web.HttpApiData
|
||||
( FromHttpApiData,
|
||||
parseHeader,
|
||||
parseQueryParam,
|
||||
parseUrlPiece,
|
||||
)
|
||||
|
||||
pathVariable ::
|
||||
FromHttpApiData a =>
|
||||
-- | Path variable value
|
||||
Text ->
|
||||
(a -> Wai.Application) ->
|
||||
Wai.Application
|
||||
pathVariable value withVariable = \request respond ->
|
||||
case parseUrlPiece value of
|
||||
Left _err ->
|
||||
respond (Wai.responseBuilder (toEnum 400) [] mempty)
|
||||
Right x ->
|
||||
withVariable x request respond
|
||||
{-# INLINEABLE pathVariable #-}
|
||||
|
||||
requiredQueryParameter ::
|
||||
FromHttpApiData a =>
|
||||
ByteString ->
|
||||
(a -> Wai.Application) ->
|
||||
Wai.Application
|
||||
requiredQueryParameter name withParam = \request respond ->
|
||||
case List.lookup name (Wai.queryString request) of
|
||||
Nothing ->
|
||||
respond (Wai.responseBuilder (toEnum 400) [] mempty)
|
||||
Just Nothing ->
|
||||
respond (Wai.responseBuilder (toEnum 400) [] mempty)
|
||||
Just (Just value) ->
|
||||
case parseQueryParam (Text.decodeUtf8 value) of
|
||||
Left _err ->
|
||||
respond (Wai.responseBuilder (toEnum 400) [] mempty)
|
||||
Right x ->
|
||||
withParam x request respond
|
||||
{-# INLINEABLE requiredQueryParameter #-}
|
||||
|
||||
optionalQueryParameter ::
|
||||
FromHttpApiData a =>
|
||||
ByteString ->
|
||||
-- | Allow empty, e.g. "x="
|
||||
Bool ->
|
||||
(Maybe a -> Wai.Application) ->
|
||||
Wai.Application
|
||||
optionalQueryParameter name allowEmpty withParam = \request respond ->
|
||||
case List.lookup name (Wai.queryString request) of
|
||||
Nothing ->
|
||||
withParam Nothing request respond
|
||||
Just Nothing
|
||||
| allowEmpty ->
|
||||
withParam Nothing request respond
|
||||
| otherwise ->
|
||||
respond (Wai.responseBuilder (toEnum 400) [] mempty)
|
||||
Just (Just value) ->
|
||||
case parseQueryParam (Text.decodeUtf8 value) of
|
||||
Left _err ->
|
||||
respond (Wai.responseBuilder (toEnum 400) [] mempty)
|
||||
Right x ->
|
||||
withParam (Just x) request respond
|
||||
{-# INLINEABLE optionalQueryParameter #-}
|
||||
|
||||
optionalHeader ::
|
||||
FromHttpApiData a =>
|
||||
HeaderName ->
|
||||
(Maybe a -> Wai.Application) ->
|
||||
Wai.Application
|
||||
optionalHeader name withHeader = \request respond ->
|
||||
case List.lookup name (Wai.requestHeaders request) of
|
||||
Nothing ->
|
||||
withHeader Nothing request respond
|
||||
Just value ->
|
||||
case parseHeader value of
|
||||
Left _err ->
|
||||
respond (Wai.responseBuilder (toEnum 400) [] mempty)
|
||||
Right x ->
|
||||
withHeader (Just x) request respond
|
||||
{-# INLINEABLE optionalHeader #-}
|
||||
|
||||
requiredHeader ::
|
||||
FromHttpApiData a =>
|
||||
HeaderName ->
|
||||
(a -> Wai.Application) ->
|
||||
Wai.Application
|
||||
requiredHeader name withHeader = \request respond ->
|
||||
case List.lookup name (Wai.requestHeaders request) of
|
||||
Nothing ->
|
||||
respond (Wai.responseBuilder (toEnum 400) [] mempty)
|
||||
Just value ->
|
||||
case parseHeader value of
|
||||
Left _err ->
|
||||
respond (Wai.responseBuilder (toEnum 400) [] mempty)
|
||||
Right x ->
|
||||
withHeader x request respond
|
||||
{-# INLINEABLE requiredHeader #-}
|
||||
|
||||
data BodyParser a = BodyParser ByteString ((a -> Wai.Application) -> Wai.Application)
|
||||
|
||||
jsonBodyParser :: FromJSON a => BodyParser a
|
||||
jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON
|
||||
{-# INLINE jsonBodyParser #-}
|
||||
|
||||
formBodyParser :: FromForm a => BodyParser a
|
||||
formBodyParser = BodyParser "application/xxx-form-urlencoded" parseRequestBodyForm
|
||||
{-# INLINE formBodyParser #-}
|
||||
|
||||
parseRequestBody :: [BodyParser a] -> (a -> Wai.Application) -> Wai.Application
|
||||
parseRequestBody parsers withBody = \request respond -> do
|
||||
let contentType =
|
||||
fromMaybe
|
||||
"text/html"
|
||||
(List.lookup hContentType (Wai.requestHeaders request))
|
||||
|
||||
bodyParser =
|
||||
List.find
|
||||
(\(BodyParser expectedContentType _) -> expectedContentType == contentType)
|
||||
parsers
|
||||
|
||||
case bodyParser of
|
||||
Just (BodyParser _ parseBody) ->
|
||||
parseBody withBody request respond
|
||||
Nothing ->
|
||||
respond (Wai.responseBuilder (toEnum 415) [] mempty)
|
||||
{-# INLINE parseRequestBody #-}
|
||||
|
||||
parseRequestBodyJSON :: FromJSON a => (a -> Wai.Application) -> Wai.Application
|
||||
parseRequestBodyJSON withBody = \request respond -> do
|
||||
result <- parseWith (Wai.getRequestBodyChunk request) Data.Aeson.Parser.json' mempty
|
||||
case eitherResult result of
|
||||
Left _err ->
|
||||
respond (Wai.responseBuilder (toEnum 400) [] mempty)
|
||||
Right value ->
|
||||
case Data.Aeson.Types.parseEither Data.Aeson.parseJSON value of
|
||||
Left _err ->
|
||||
respond (Wai.responseBuilder (toEnum 400) [] mempty)
|
||||
Right body ->
|
||||
withBody body request respond
|
||||
{-# INLINEABLE parseRequestBodyJSON #-}
|
||||
|
||||
parseRequestBodyForm :: FromForm a => (a -> Wai.Application) -> Wai.Application
|
||||
parseRequestBodyForm withBody = \request respond -> do
|
||||
-- Reads the body using lazy IO. Not great but it gets us
|
||||
-- going and is pretty local.
|
||||
let getBodyBytes :: IO [ByteString]
|
||||
getBodyBytes = do
|
||||
chunk <- Wai.getRequestBodyChunk request
|
||||
case chunk of
|
||||
"" -> pure []
|
||||
_ -> do
|
||||
rest <- unsafeInterleaveIO getBodyBytes
|
||||
pure (chunk : rest)
|
||||
|
||||
bytes <- getBodyBytes
|
||||
case urlDecodeAsForm (LBS.fromChunks bytes) of
|
||||
Left _err ->
|
||||
respond (Wai.responseBuilder (toEnum 400) [] mempty)
|
||||
Right form ->
|
||||
withBody form request respond
|
||||
{-# INLINEABLE parseRequestBodyForm #-}
|
||||
|
||||
---------------------
|
||||
Test/Response.hs
|
||||
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
module Test.Response where
|
||||
|
||||
import qualified Control.Applicative
|
||||
import qualified Control.Exception
|
||||
import qualified Control.Monad
|
||||
import qualified Control.Monad.Catch
|
||||
import qualified Control.Monad.IO.Class
|
||||
import qualified Data.Aeson
|
||||
import qualified Data.Aeson.Encoding
|
||||
import qualified Data.Aeson.Parser
|
||||
import qualified Data.Aeson.Types
|
||||
import qualified Data.Attoparsec.ByteString
|
||||
import qualified Data.List
|
||||
import qualified Data.Maybe
|
||||
import qualified Data.Text
|
||||
import qualified Data.Time
|
||||
import qualified Data.Text.Encoding
|
||||
import qualified GHC.Float
|
||||
import qualified GHC.Int
|
||||
import qualified GHC.Types
|
||||
import qualified Network.HTTP.Types
|
||||
import qualified Network.Wai
|
||||
import qualified Web.HttpApiData
|
||||
|
||||
class ToResponse a where
|
||||
toResponse :: a -> Network.Wai.Response
|
||||
---------------------
|
||||
Test/Response/Test.hs
|
||||
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
module Test.Response.Test where
|
||||
|
||||
import qualified Control.Applicative
|
||||
import qualified Control.Exception
|
||||
import qualified Control.Monad
|
||||
import qualified Control.Monad.Catch
|
||||
import qualified Control.Monad.IO.Class
|
||||
import qualified Data.Aeson
|
||||
import qualified Data.Aeson.Encoding
|
||||
import qualified Data.Aeson.Parser
|
||||
import qualified Data.Aeson.Types
|
||||
import qualified Data.Attoparsec.ByteString
|
||||
import qualified Data.List
|
||||
import qualified Data.Maybe
|
||||
import qualified Data.Text
|
||||
import qualified Data.Time
|
||||
import qualified Data.Text.Encoding
|
||||
import qualified GHC.Float
|
||||
import qualified GHC.Int
|
||||
import qualified GHC.Types
|
||||
import qualified Network.HTTP.Types
|
||||
import qualified Network.Wai
|
||||
import qualified Web.HttpApiData
|
||||
|
||||
|
||||
|
||||
import Test.Response
|
||||
|
||||
type TestResponseBody200 = Data.Aeson.Value
|
||||
|
||||
data TestResponse
|
||||
= TestResponse200 TestResponseBody200
|
||||
deriving (Show)
|
||||
|
||||
instance Control.Exception.Exception TestResponse
|
||||
|
||||
instance ToResponse TestResponse where
|
||||
toResponse (TestResponse200 x) =
|
||||
Network.Wai.responseBuilder (toEnum 200) ([(Network.HTTP.Types.hContentType, "application/json")]) (Data.Aeson.fromEncoding (Data.Aeson.toEncoding x))
|
||||
---------------------
|
||||
test.cabal
|
||||
|
||||
cabal-version: 3.0
|
||||
name: test
|
||||
version: 0.1.0.0
|
||||
library
|
||||
build-depends:
|
||||
, aeson
|
||||
, attoparsec
|
||||
, base
|
||||
, bytestring
|
||||
, exceptions
|
||||
, ghc-prim
|
||||
, http-api-data
|
||||
, http-types
|
||||
, text
|
||||
, time
|
||||
, wai
|
||||
exposed-modules:
|
||||
Test.Api
|
||||
Test.Request
|
||||
Test.Response
|
||||
Test.Response.Test
|
||||
Loading…
Reference in New Issue
Block a user