From 0a767d7b537b8b974fe7df5576254d948f96df38 Mon Sep 17 00:00:00 2001 From: Joel Bach <6702422+joel-bach@users.noreply.github.com> Date: Sat, 23 Mar 2024 17:09:29 +0100 Subject: [PATCH] fix: use ToJSON instance instead of Show to serialize path parameters --- openapi3-code-generator/src/OpenAPI/Common.hs | 31 +++++-------------- .../src/OpenAPI/Generate/Internal/Util.hs | 1 - specifications/petstore-running-example.yaml | 21 +++++++++++++ testing/golden-output/src/OpenAPI/Common.hs | 31 +++++-------------- testing/level3/mock-server/src/Lib.hs | 6 +++- .../petstore-running-example/src/Lib.hs | 3 ++ .../petstore-running-example/test/Spec.hs | 17 ++++++++++ 7 files changed, 62 insertions(+), 48 deletions(-) diff --git a/openapi3-code-generator/src/OpenAPI/Common.hs b/openapi3-code-generator/src/OpenAPI/Common.hs index d7841e2..d1c29e3 100644 --- a/openapi3-code-generator/src/OpenAPI/Common.hs +++ b/openapi3-code-generator/src/OpenAPI/Common.hs @@ -22,7 +22,6 @@ module OpenAPI.Common Configuration (..), SecurityScheme, MonadHTTP (..), - StringifyModel, JsonByteString (..), JsonDateTime (..), RequestBodyEncoding (..), @@ -38,6 +37,7 @@ import qualified Control.Monad.Reader as MR import qualified Control.Monad.Trans.Class as MT import qualified Data.Aeson as Aeson import qualified Data.Aeson.Encoding as Encoding +import Data.Aeson.Text (encodeToTextBuilder) import qualified Data.Bifunctor as BF import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS @@ -47,6 +47,8 @@ import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as TE import Data.Text.Encoding.Error (lenientDecode) +import Data.Text.Lazy (toStrict) +import Data.Text.Lazy.Builder (toLazyText) import qualified Data.Time.LocalTime as Time import qualified Data.Vector as Vector import qualified Network.HTTP.Client as HC @@ -338,30 +340,13 @@ jsonToFormDataPrefixed prefix (Aeson.Object object) = jsonToFormDataPrefixed prefix (Aeson.Array vector) = Vector.toList vector >>= jsonToFormDataPrefixed (prefix <> "[]") --- | This type class makes the code generation for URL parameters easier as it allows to stringify a value +-- | This function makes the code generation for URL parameters easier as it allows to stringify a value -- -- The 'Show' class is not sufficient as strings should not be stringified with quotes. -class Show a => StringifyModel a where - -- | Stringifies a showable value - -- - -- >>> stringifyModel "Test" - -- "Test" - -- - -- >>> stringifyModel 123 - -- "123" - stringifyModel :: a -> Text - -instance StringifyModel String where - -- stringifyModel :: String -> String - stringifyModel = T.pack - -instance StringifyModel Text where - -- stringifyModel :: Text -> String - stringifyModel = id - -instance {-# OVERLAPS #-} Show a => StringifyModel a where - -- stringifyModel :: Show a => a -> String - stringifyModel = T.pack . show +stringifyModel :: Aeson.ToJSON a => a -> Text +stringifyModel x = case Aeson.toJSON x of + Aeson.String s -> s + v -> toStrict $ toLazyText $ encodeToTextBuilder v -- | Wraps a 'BS.ByteString' to implement 'Aeson.ToJSON' and 'Aeson.FromJSON' newtype JsonByteString = JsonByteString BS.ByteString diff --git a/openapi3-code-generator/src/OpenAPI/Generate/Internal/Util.hs b/openapi3-code-generator/src/OpenAPI/Generate/Internal/Util.hs index 8e515d4..fc25483 100644 --- a/openapi3-code-generator/src/OpenAPI/Generate/Internal/Util.hs +++ b/openapi3-code-generator/src/OpenAPI/Generate/Internal/Util.hs @@ -84,7 +84,6 @@ haskellifyText convertToCamelCase startWithUppercase name = replaceReservedWord "where" = "where'" replaceReservedWord "Configuration" = "Configuration'" replaceReservedWord "MonadHTTP" = "MonadHTTP'" - replaceReservedWord "StringifyModel" = "StringifyModel'" replaceReservedWord "SecurityScheme" = "SecurityScheme'" replaceReservedWord "AnonymousSecurityScheme" = "AnonymousSecurityScheme'" replaceReservedWord "JsonByteString" = "JsonByteString'" diff --git a/specifications/petstore-running-example.yaml b/specifications/petstore-running-example.yaml index 00f39a2..df4caa7 100644 --- a/specifications/petstore-running-example.yaml +++ b/specifications/petstore-running-example.yaml @@ -563,6 +563,27 @@ paths: type: string '400': description: No User-Agent header is present + "/echo/{path}": + get: + summary: Echo the path + operationId: echoPath + parameters: + - name: path + in: path + required: true + schema: + type: string + enum: + - test + - foo + - bar + responses: + '200': + description: The path parameter + content: + application/json: + schema: + type: string "/nullable-optional/{mode}": post: summary: Test nullable and optional values diff --git a/testing/golden-output/src/OpenAPI/Common.hs b/testing/golden-output/src/OpenAPI/Common.hs index 9f6453c..f3e27c9 100755 --- a/testing/golden-output/src/OpenAPI/Common.hs +++ b/testing/golden-output/src/OpenAPI/Common.hs @@ -22,7 +22,6 @@ module OpenAPI.Common Configuration (..), SecurityScheme, MonadHTTP (..), - StringifyModel, JsonByteString (..), JsonDateTime (..), RequestBodyEncoding (..), @@ -38,6 +37,7 @@ import qualified Control.Monad.Reader as MR import qualified Control.Monad.Trans.Class as MT import qualified Data.Aeson as Aeson import qualified Data.Aeson.Encoding as Encoding +import Data.Aeson.Text (encodeToTextBuilder) import qualified Data.Bifunctor as BF import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS @@ -47,6 +47,8 @@ import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as TE import Data.Text.Encoding.Error (lenientDecode) +import Data.Text.Lazy (toStrict) +import Data.Text.Lazy.Builder (toLazyText) import qualified Data.Time.LocalTime as Time import qualified Data.Vector as Vector import qualified Network.HTTP.Client as HC @@ -338,30 +340,13 @@ jsonToFormDataPrefixed prefix (Aeson.Object object) = jsonToFormDataPrefixed prefix (Aeson.Array vector) = Vector.toList vector >>= jsonToFormDataPrefixed (prefix <> "[]") --- | This type class makes the code generation for URL parameters easier as it allows to stringify a value +-- | This function makes the code generation for URL parameters easier as it allows to stringify a value -- -- The 'Show' class is not sufficient as strings should not be stringified with quotes. -class Show a => StringifyModel a where - -- | Stringifies a showable value - -- - -- >>> stringifyModel "Test" - -- "Test" - -- - -- >>> stringifyModel 123 - -- "123" - stringifyModel :: a -> Text - -instance StringifyModel String where - -- stringifyModel :: String -> String - stringifyModel = T.pack - -instance StringifyModel Text where - -- stringifyModel :: Text -> String - stringifyModel = id - -instance {-# OVERLAPS #-} Show a => StringifyModel a where - -- stringifyModel :: Show a => a -> String - stringifyModel = T.pack . show +stringifyModel :: Aeson.ToJSON a => a -> Text +stringifyModel x = case Aeson.toJSON x of + Aeson.String s -> s + v -> toStrict $ toLazyText $ encodeToTextBuilder v -- | Wraps a 'BS.ByteString' to implement 'Aeson.ToJSON' and 'Aeson.FromJSON' newtype JsonByteString = JsonByteString BS.ByteString diff --git a/testing/level3/mock-server/src/Lib.hs b/testing/level3/mock-server/src/Lib.hs index 835af80..b32d7ea 100644 --- a/testing/level3/mock-server/src/Lib.hs +++ b/testing/level3/mock-server/src/Lib.hs @@ -34,6 +34,7 @@ type API = :<|> "pet" :> "findByStatus" :> QueryParam "status" String :> Get '[JSON] [Pet] :<|> "pet" :> ReqBody '[JSON] Pet :> Post '[JSON] NoContent :<|> "echo" :> Header "User-Agent" String :> Get '[JSON] String + :<|> "echo" :> Capture "path" String :> Get '[JSON] String :<|> "nullable-optional" :> Capture "mode" String :> ReqBody '[JSON] Value :> Post '[JSON] Value startApp :: IO () @@ -46,7 +47,7 @@ api :: Proxy API api = Proxy server :: Server API -server = pure getInventory :<|> findByStatus :<|> addPet :<|> userAgentEcho :<|> checkNullableAndOptional +server = pure getInventory :<|> findByStatus :<|> addPet :<|> userAgentEcho :<|> pathEcho :<|> checkNullableAndOptional getInventory :: Value getInventory = object ["pet1" .= Number 23, "pet2" .= Number 2] @@ -71,6 +72,9 @@ userAgentEcho :: Maybe String -> Handler String userAgentEcho (Just userAgent) = pure userAgent userAgentEcho Nothing = throwError err400 +pathEcho :: String -> Handler String +pathEcho = pure + checkNullableAndOptional :: String -> Value -> Handler Value checkNullableAndOptional "filled" (Object map) = do when (KeyMap.lookup (Key.fromText "requiredNonNullable") map /= Just "x") $ throwError err400 diff --git a/testing/level3/petstore-running-example/src/Lib.hs b/testing/level3/petstore-running-example/src/Lib.hs index e864365..f29b1ef 100644 --- a/testing/level3/petstore-running-example/src/Lib.hs +++ b/testing/level3/petstore-running-example/src/Lib.hs @@ -38,5 +38,8 @@ runEchoUserAgentWithoutUserAgent = { configIncludeUserAgent = False } +runEchoPath :: MonadHTTP m => EchoPathParametersPath -> m (Response EchoPathResponse) +runEchoPath = echoPathWithConfiguration defaultConfiguration + runSendAndReceiveNullableAndOptional :: MonadHTTP m => Text -> NullableAndOptionalTest -> m (Response SendAndReceiveNullableAndOptionalResponse) runSendAndReceiveNullableAndOptional mode body = sendAndReceiveNullableAndOptionalWithConfiguration defaultConfiguration mode body diff --git a/testing/level3/petstore-running-example/test/Spec.hs b/testing/level3/petstore-running-example/test/Spec.hs index efdb7ee..c77d322 100644 --- a/testing/level3/petstore-running-example/test/Spec.hs +++ b/testing/level3/petstore-running-example/test/Spec.hs @@ -69,6 +69,23 @@ main = getResponseBody response `shouldBe` EchoUserAgentResponse400 + describe "runEchoPath" $ do + it "returns enum value 'test'" $ + do + response <- runEchoPath EchoPathParametersPathEnumTest + getResponseBody response + `shouldBe` EchoPathResponse200 "test" + it "returns enum value 'foo'" $ + do + response <- runEchoPath EchoPathParametersPathEnumFoo + getResponseBody response + `shouldBe` EchoPathResponse200 "foo" + it "works with custom value" $ + do + response <- runEchoPath $ EchoPathParametersPathTyped "xyz" + getResponseBody response + `shouldBe` EchoPathResponse200 "xyz" + describe "runSendAndReceiveNullableAndOptional" $ do it "should work with filled objects" $ do response <-