From 94d8456bc4cbb6c98693932174fff30b7fb1ca66 Mon Sep 17 00:00:00 2001 From: Alex Biehl Date: Wed, 9 Mar 2022 07:53:03 +0100 Subject: [PATCH] Proper dependency analysis for parameters --- src/Tie/Operation.hs | 6 + test/golden/enum.yaml | 38 ++- test/golden/enum.yaml.out | 479 ++++++++++++++++++++++++-------------- 3 files changed, 344 insertions(+), 179 deletions(-) diff --git a/src/Tie/Operation.hs b/src/Tie/Operation.hs index 49ba9fa..009fdb9 100644 --- a/src/Tie/Operation.hs +++ b/src/Tie/Operation.hs @@ -177,6 +177,12 @@ operationSchemaDependencies getDependencies Operation {..} = ++ [ getDependencies jsonContent | (_, Response {jsonResponseContent = Just jsonContent}) <- responses ] + ++ [ getDependencies schema + | Param{schema} <- queryParams + ] + ++ [ getDependencies schema + | Param{schema} <- headerParams + ] -- | Dependencies in the Response.* modules. operationResponseDependencies :: Operation -> [Name] diff --git a/test/golden/enum.yaml b/test/golden/enum.yaml index 522ff6c..c08b2be 100644 --- a/test/golden/enum.yaml +++ b/test/golden/enum.yaml @@ -23,7 +23,7 @@ paths: /packages2: get: summary: List all packages - operationId: listPackages + operationId: listPackages2 tags: - packages responses: @@ -49,21 +49,43 @@ paths: - desc get: summary: List all packages - operationId: listPackages + operationId: listPackages3 + tags: + - packages + responses: + '201': + description: Cool! + /packages4: + parameters: + - "$ref": "#/components/parameters/order" + get: + summary: List all packages + operationId: listPackages4 tags: - packages responses: '201': description: Cool! - components: + parameters: + order: + name: order + in: query + required: false + schema: + "$ref": "#/components/schemas/Order" schemas: + Order: + type: string + enum: + - asc + - desc Package: - type: string - enum: - - DOCKER - - PYTHON - - NPM + type: string + enum: + - DOCKER + - PYTHON + - NPM Packages: type: array items: diff --git a/test/golden/enum.yaml.out b/test/golden/enum.yaml.out index f92be1a..544f876 100644 --- a/test/golden/enum.yaml.out +++ b/test/golden/enum.yaml.out @@ -35,23 +35,30 @@ import Test.Response import Test.Schemas.Package +import Test.Schemas.Order import Test.Response.ListPackages -import Test.Response.ListPackages -import Test.Response.ListPackages +import Test.Response.ListPackages3 +import Test.Response.ListPackages2 +import Test.Response.ListPackages4 data Api m = Api { -- | List all packages listPackages :: m ListPackagesResponse, -- | List all packages - listPackages :: + listPackages3 :: -- @order@ - (Data.Maybe.Maybe (ListPackagesOrderParam)) -> - m ListPackagesResponse, + (Data.Maybe.Maybe (ListPackages3OrderParam)) -> + m ListPackages3Response, -- | List all packages - listPackages :: - m ListPackagesResponse + listPackages2 :: + m ListPackages2Response, + -- | List all packages + listPackages4 :: + -- @order@ + (Data.Maybe.Maybe (Order)) -> + m ListPackages4Response } 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 @@ -71,7 +78,7 @@ application run api notFound request respond = case Network.Wai.requestMethod request of "GET" -> run request (do - response <- Control.Monad.Catch.handle pure (listPackages api ) + response <- Control.Monad.Catch.handle pure (listPackages2 api ) Control.Monad.IO.Class.liftIO (respond $! (toResponse response)) ) x -> @@ -82,7 +89,18 @@ application run api notFound request respond = "GET" -> optionalQueryParameter "order" False (\__order request respond -> run request (do - response <- Control.Monad.Catch.handle pure (listPackages api __order ) + response <- Control.Monad.Catch.handle pure (listPackages3 api __order ) + Control.Monad.IO.Class.liftIO (respond $! (toResponse response)) + )) request respond + x -> + unsupportedMethod x + + ["packages4"] -> + case Network.Wai.requestMethod request of + "GET" -> + optionalQueryParameter "order" False (\__order request respond -> + run request (do + response <- Control.Monad.Catch.handle pure (listPackages4 api __order ) Control.Monad.IO.Class.liftIO (respond $! (toResponse response)) )) request respond x -> @@ -354,168 +372,6 @@ import qualified Network.HTTP.Types import qualified Network.Wai import qualified Web.HttpApiData - - -import Test.Response - -data ListPackagesResponseBody200 - = ListPackagesResponseBody200A - | ListPackagesResponseBody200B - | ListPackagesResponseBody200C - deriving (Eq, Show) - -instance Data.Aeson.ToJSON ListPackagesResponseBody200 where - toJSON x = case x of - ListPackagesResponseBody200A -> "A" - ListPackagesResponseBody200B -> "B" - ListPackagesResponseBody200C -> "C" - - toEncoding x = case x of - ListPackagesResponseBody200A -> Data.Aeson.Encoding.text "A" - ListPackagesResponseBody200B -> Data.Aeson.Encoding.text "B" - ListPackagesResponseBody200C -> Data.Aeson.Encoding.text "C" - -instance Data.Aeson.FromJSON ListPackagesResponseBody200 where - parseJSON = Data.Aeson.withText "ListPackagesResponseBody200" $ \s -> - case s of - "A" -> pure ListPackagesResponseBody200A - "B" -> pure ListPackagesResponseBody200B - "C" -> pure ListPackagesResponseBody200C - _ -> fail "invalid enum value" - -instance Web.HttpApiData.ToHttpApiData ListPackagesResponseBody200 where - toQueryParam x = case x of - ListPackagesResponseBody200A -> "A" - ListPackagesResponseBody200B -> "B" - ListPackagesResponseBody200C -> "C" - -instance Web.HttpApiData.FromHttpApiData ListPackagesResponseBody200 where - parseUrlPiece x = - case x of - "A" -> pure ListPackagesResponseBody200A - "B" -> pure ListPackagesResponseBody200B - "C" -> pure ListPackagesResponseBody200C - _ -> Left "invalid enum value" - -data ListPackagesResponse - = ListPackagesResponse200 ListPackagesResponseBody200 - deriving (Show) - -instance Control.Exception.Exception ListPackagesResponse - -instance ToResponse ListPackagesResponse where - toResponse (ListPackagesResponse200 x ) = - Network.Wai.responseBuilder (toEnum 200) [(Network.HTTP.Types.hContentType, "application/json")] (Data.Aeson.fromEncoding (Data.Aeson.toEncoding x)) ---------------------- -Test/Response/ListPackages.hs - -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE RecordWildCards #-} -module Test.Response.ListPackages 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 - -data ListPackagesOrderParam - = ListPackagesOrderParamAsc - | ListPackagesOrderParamDesc - deriving (Eq, Show) - -instance Data.Aeson.ToJSON ListPackagesOrderParam where - toJSON x = case x of - ListPackagesOrderParamAsc -> "asc" - ListPackagesOrderParamDesc -> "desc" - - toEncoding x = case x of - ListPackagesOrderParamAsc -> Data.Aeson.Encoding.text "asc" - ListPackagesOrderParamDesc -> Data.Aeson.Encoding.text "desc" - -instance Data.Aeson.FromJSON ListPackagesOrderParam where - parseJSON = Data.Aeson.withText "ListPackagesOrderParam" $ \s -> - case s of - "asc" -> pure ListPackagesOrderParamAsc - "desc" -> pure ListPackagesOrderParamDesc - _ -> fail "invalid enum value" - -instance Web.HttpApiData.ToHttpApiData ListPackagesOrderParam where - toQueryParam x = case x of - ListPackagesOrderParamAsc -> "asc" - ListPackagesOrderParamDesc -> "desc" - -instance Web.HttpApiData.FromHttpApiData ListPackagesOrderParam where - parseUrlPiece x = - case x of - "asc" -> pure ListPackagesOrderParamAsc - "desc" -> pure ListPackagesOrderParamDesc - _ -> Left "invalid enum value" - -data ListPackagesResponse - = ListPackagesResponse201 - deriving (Show) - -instance Control.Exception.Exception ListPackagesResponse - -instance ToResponse ListPackagesResponse where - toResponse (ListPackagesResponse201 ) = - Network.Wai.responseBuilder (toEnum 201) [] mempty ---------------------- -Test/Response/ListPackages.hs - -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE RecordWildCards #-} -module Test.Response.ListPackages 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.Schemas.Package import Test.Response @@ -532,6 +388,283 @@ instance ToResponse ListPackagesResponse where toResponse (ListPackagesResponse200 x ) = Network.Wai.responseBuilder (toEnum 200) [(Network.HTTP.Types.hContentType, "application/json")] (Data.Aeson.fromEncoding (Data.Aeson.toEncoding x)) --------------------- +Test/Response/ListPackages2.hs + +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +module Test.Response.ListPackages2 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 + +data ListPackages2ResponseBody200 + = ListPackages2ResponseBody200A + | ListPackages2ResponseBody200B + | ListPackages2ResponseBody200C + deriving (Eq, Show) + +instance Data.Aeson.ToJSON ListPackages2ResponseBody200 where + toJSON x = case x of + ListPackages2ResponseBody200A -> "A" + ListPackages2ResponseBody200B -> "B" + ListPackages2ResponseBody200C -> "C" + + toEncoding x = case x of + ListPackages2ResponseBody200A -> Data.Aeson.Encoding.text "A" + ListPackages2ResponseBody200B -> Data.Aeson.Encoding.text "B" + ListPackages2ResponseBody200C -> Data.Aeson.Encoding.text "C" + +instance Data.Aeson.FromJSON ListPackages2ResponseBody200 where + parseJSON = Data.Aeson.withText "ListPackages2ResponseBody200" $ \s -> + case s of + "A" -> pure ListPackages2ResponseBody200A + "B" -> pure ListPackages2ResponseBody200B + "C" -> pure ListPackages2ResponseBody200C + _ -> fail "invalid enum value" + +instance Web.HttpApiData.ToHttpApiData ListPackages2ResponseBody200 where + toQueryParam x = case x of + ListPackages2ResponseBody200A -> "A" + ListPackages2ResponseBody200B -> "B" + ListPackages2ResponseBody200C -> "C" + +instance Web.HttpApiData.FromHttpApiData ListPackages2ResponseBody200 where + parseUrlPiece x = + case x of + "A" -> pure ListPackages2ResponseBody200A + "B" -> pure ListPackages2ResponseBody200B + "C" -> pure ListPackages2ResponseBody200C + _ -> Left "invalid enum value" + +data ListPackages2Response + = ListPackages2Response200 ListPackages2ResponseBody200 + deriving (Show) + +instance Control.Exception.Exception ListPackages2Response + +instance ToResponse ListPackages2Response where + toResponse (ListPackages2Response200 x ) = + Network.Wai.responseBuilder (toEnum 200) [(Network.HTTP.Types.hContentType, "application/json")] (Data.Aeson.fromEncoding (Data.Aeson.toEncoding x)) +--------------------- +Test/Response/ListPackages3.hs + +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +module Test.Response.ListPackages3 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 + +data ListPackages3OrderParam + = ListPackages3OrderParamAsc + | ListPackages3OrderParamDesc + deriving (Eq, Show) + +instance Data.Aeson.ToJSON ListPackages3OrderParam where + toJSON x = case x of + ListPackages3OrderParamAsc -> "asc" + ListPackages3OrderParamDesc -> "desc" + + toEncoding x = case x of + ListPackages3OrderParamAsc -> Data.Aeson.Encoding.text "asc" + ListPackages3OrderParamDesc -> Data.Aeson.Encoding.text "desc" + +instance Data.Aeson.FromJSON ListPackages3OrderParam where + parseJSON = Data.Aeson.withText "ListPackages3OrderParam" $ \s -> + case s of + "asc" -> pure ListPackages3OrderParamAsc + "desc" -> pure ListPackages3OrderParamDesc + _ -> fail "invalid enum value" + +instance Web.HttpApiData.ToHttpApiData ListPackages3OrderParam where + toQueryParam x = case x of + ListPackages3OrderParamAsc -> "asc" + ListPackages3OrderParamDesc -> "desc" + +instance Web.HttpApiData.FromHttpApiData ListPackages3OrderParam where + parseUrlPiece x = + case x of + "asc" -> pure ListPackages3OrderParamAsc + "desc" -> pure ListPackages3OrderParamDesc + _ -> Left "invalid enum value" + +data ListPackages3Response + = ListPackages3Response201 + deriving (Show) + +instance Control.Exception.Exception ListPackages3Response + +instance ToResponse ListPackages3Response where + toResponse (ListPackages3Response201 ) = + Network.Wai.responseBuilder (toEnum 201) [] mempty +--------------------- +Test/Response/ListPackages4.hs + +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +module Test.Response.ListPackages4 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.Schemas.Order + +import Test.Response + + + +data ListPackages4Response + = ListPackages4Response201 + deriving (Show) + +instance Control.Exception.Exception ListPackages4Response + +instance ToResponse ListPackages4Response where + toResponse (ListPackages4Response201 ) = + Network.Wai.responseBuilder (toEnum 201) [] mempty +--------------------- +Test/Schemas/Order.hs + +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +module Test.Schemas.Order 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 + + + + + +data Order + = OrderAsc + | OrderDesc + deriving (Eq, Show) + +instance Data.Aeson.ToJSON Order where + toJSON x = case x of + OrderAsc -> "asc" + OrderDesc -> "desc" + + toEncoding x = case x of + OrderAsc -> Data.Aeson.Encoding.text "asc" + OrderDesc -> Data.Aeson.Encoding.text "desc" + +instance Data.Aeson.FromJSON Order where + parseJSON = Data.Aeson.withText "Order" $ \s -> + case s of + "asc" -> pure OrderAsc + "desc" -> pure OrderDesc + _ -> fail "invalid enum value" + +instance Web.HttpApiData.ToHttpApiData Order where + toQueryParam x = case x of + OrderAsc -> "asc" + OrderDesc -> "desc" + +instance Web.HttpApiData.FromHttpApiData Order where + parseUrlPiece x = + case x of + "asc" -> pure OrderAsc + "desc" -> pure OrderDesc + _ -> Left "invalid enum value" +--------------------- Test/Schemas/Package.hs {-# LANGUAGE BangPatterns #-} @@ -629,4 +762,8 @@ library Test.Request Test.Response Test.Response.ListPackages + Test.Response.ListPackages2 + Test.Response.ListPackages3 + Test.Response.ListPackages4 + Test.Schemas.Order Test.Schemas.Package \ No newline at end of file