openapi-hs 4.0.0 → 4.1.0

raw patch · 7 files changed

+205/−10 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +9/−0
• README.md +0/−5
• openapi-hs.cabal +1/−1
• src/Data/OpenApi.hs +2/−1
• src/Data/OpenApi/Internal.hs +102/−2
• test/Data/OpenApi/Schema/RoundtripSpec.hs +15/−1
• test/Data/OpenApiSpec.hs +76/−0

@@ -1,3 +1,12 @@+4.1.0+-----++- **Breaking:** `HttpStatusCode` is now a data type (`StatusCode Int | StatusRange+  StatusCodeRange`) instead of `type HttpStatusCode = Int`, so a `Responses` map can hold+  OpenAPI 3.1 status-code range keys (`1XX`...`5XX`) in addition to explicit codes. A `Num`+  instance keeps integer literals such as `at 200` and `setResponse 404` working unchanged.+  Fixes #1.+ 4.0.0 ----- 

@@ -207,11 +207,6 @@ The design and implementation strategy behind the 3.1 work is documented in **[`docs/OPENAPI31_MIGRATION_PLAN.md`](https://github.com/shinzui/openapi-hs/blob/master/docs/OPENAPI31_MIGRATION_PLAN.md)**. -## Contributing--Bug reports, fixes, documentation improvements, and other contributions are welcome. Please open-an issue or pull request on the [GitHub issue tracker](https://github.com/shinzui/openapi-hs/issues).- ## License  `openapi-hs` retains the original **BSD-3-Clause** license of the upstream

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               openapi-hs-version:            4.0.0+version:            4.1.0 synopsis:           OpenAPI 3.1 data model category:           Web, OpenApi description:

@@ -92,7 +92,8 @@     -- ** Responses     Responses (..),     Response (..),-    HttpStatusCode,+    HttpStatusCode (..),+    StatusCodeRange (..),     Link (..),     Callback (..), 

@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveAnyClass #-} {-# OPTIONS_GHC -Wno-orphans #-}  -- |@@ -20,6 +21,7 @@ #endif import Control.Monad (unless) import Data.Aeson.Types qualified as JSON+import Data.Char (isDigit) import Data.Data   ( Constr,     Data (..),@@ -792,8 +794,106 @@   }   deriving stock (Eq, Show, Generic, Data, Typeable) --- | An HTTP status code keying an entry in 'Responses' (e.g. @200@, @404@).-type HttpStatusCode = Int+-- | A key in a 'Responses' map. Per the OpenAPI 3.1 specification a response+-- may be keyed either by an explicit HTTP status code (e.g. @200@, @404@) or by+-- a status-code /range/ that stands for a whole class of responses. A range is+-- written as a single leading digit @1@-@5@ followed by two literal uppercase+-- @X@ characters: @1XX@, @2XX@, @3XX@, @4XX@, @5XX@.+--+-- The @default@ key is represented separately by '_responsesDefault' and is+-- never stored in the map, so it is not a constructor here.+--+-- A 'Num' instance is provided so that ordinary integer literals continue to+-- denote explicit status codes: writing @200@ where an 'HttpStatusCode' is+-- expected yields @'StatusCode' 200@. Only 'fromInteger' is meaningful; the+-- arithmetic operators are defined for totality (projecting to 'Int') but have+-- no real-world meaning for status codes.+data HttpStatusCode+  = -- | An explicit status code such as @200@ or @404@.+    StatusCode Int+  | -- | A whole class of responses, e.g. @'StatusRange' 'R4XX'@ for the @4XX@ key.+    StatusRange StatusCodeRange+  deriving stock (Eq, Ord, Show, Generic, Data, Typeable)+  deriving anyclass (Hashable)++-- | The five status-code range classes permitted by OpenAPI 3.1, one per+-- leading digit. @'R1XX'@ serializes as @1XX@, @'R2XX'@ as @2XX@, and so on.+data StatusCodeRange+  = R1XX+  | R2XX+  | R3XX+  | R4XX+  | R5XX+  deriving stock (Eq, Ord, Show, Enum, Bounded, Generic, Data, Typeable)+  deriving anyclass (Hashable)++-- | Project an 'HttpStatusCode' onto a representative integer: explicit codes map+-- to themselves; a range maps to its hundreds value (@R1XX -> 100@, ..., @R5XX ->+-- 500@). Used only to give the 'Num' instance total arithmetic; not exported.+httpStatusCodeToInt :: HttpStatusCode -> Int+httpStatusCodeToInt (StatusCode n) = n+httpStatusCodeToInt (StatusRange r) = (fromEnum r + 1) * 100++-- | Integer literals denote explicit status codes (see 'HttpStatusCode'). The+-- non-'fromInteger' methods are total but not semantically meaningful.+instance Num HttpStatusCode where+  fromInteger = StatusCode . fromInteger+  a + b = StatusCode (httpStatusCodeToInt a + httpStatusCodeToInt b)+  a - b = StatusCode (httpStatusCodeToInt a - httpStatusCodeToInt b)+  a * b = StatusCode (httpStatusCodeToInt a * httpStatusCodeToInt b)+  abs = StatusCode . abs . httpStatusCodeToInt+  signum = StatusCode . signum . httpStatusCodeToInt+  negate = StatusCode . negate . httpStatusCodeToInt++-- | Render an 'HttpStatusCode' as the text used for a JSON object key.+renderHttpStatusCode :: HttpStatusCode -> Text+renderHttpStatusCode (StatusCode n) = Text.pack (show n)+renderHttpStatusCode (StatusRange r) = case r of+  R1XX -> "1XX"+  R2XX -> "2XX"+  R3XX -> "3XX"+  R4XX -> "4XX"+  R5XX -> "5XX"++-- | Parse a JSON object key into an 'HttpStatusCode'. Accepts a run of ASCII+-- digits as an explicit code, or the exact forms @1XX@...@5XX@ (uppercase @X@)+-- as a range. Anything else is rejected with a descriptive message.+parseHttpStatusCode :: Text -> Either String HttpStatusCode+parseHttpStatusCode t = case parseRange t of+  Just r -> Right (StatusRange r)+  Nothing+    | not (Text.null t) && Text.all isDigit t ->+        case readMaybe (Text.unpack t) of+          Just n -> Right (StatusCode n)+          Nothing -> Left err+    | otherwise -> Left err+  where+    err =+      "Invalid Responses key "+        <> show (Text.unpack t)+        <> "; expected an HTTP status code (e.g. \"200\") or a range (\"1XX\"...\"5XX\")."+    parseRange x = case Text.unpack x of+      [d, 'X', 'X'] -> case d of+        '1' -> Just R1XX+        '2' -> Just R2XX+        '3' -> Just R3XX+        '4' -> Just R4XX+        '5' -> Just R5XX+        _ -> Nothing+      _ -> Nothing++instance ToJSON HttpStatusCode where+  toJSON = String . renderHttpStatusCode+  toEncoding = toEncoding . renderHttpStatusCode++instance ToJSONKey HttpStatusCode where+  toJSONKey = JSON.toJSONKeyText renderHttpStatusCode++instance FromJSON HttpStatusCode where+  parseJSON = withText "HttpStatusCode" (either fail pure . parseHttpStatusCode)++instance FromJSONKey HttpStatusCode where+  fromJSONKey = FromJSONKeyTextParser (either fail pure . parseHttpStatusCode)  -- | Describes a single response from an API Operation. data Response = Response

@@ -49,7 +49,21 @@ prop_schema31_roundtrip = forAll genSchema $ \s ->   (decode (encode s) :: Maybe Schema) === Just s +-- | Every key the renderer can produce must parse back to the same value.+genHttpStatusCode :: Gen HttpStatusCode+genHttpStatusCode =+  oneof+    [ StatusCode <$> choose (100, 599),+      StatusRange <$> elements [minBound .. maxBound]+    ]++prop_httpStatusCode_key_roundtrip :: Property+prop_httpStatusCode_key_roundtrip = forAll genHttpStatusCode $ \c ->+  parseHttpStatusCode (renderHttpStatusCode c) === Right c+ spec :: Spec-spec =+spec = do   describe "Schema 3.1 round-trip" $     prop "decode . encode == Just for random 3.1 schemas" prop_schema31_roundtrip+  describe "HttpStatusCode key round-trip" $+    prop "parse . render == Right for codes and ranges" prop_httpStatusCode_key_roundtrip

@@ -32,6 +32,40 @@   describe "Definitions Object" $ definitionsExample <=> definitionsExampleJSON   describe "Parameters Definition Object" $ paramsDefinitionExample <=> paramsDefinitionExampleJSON   describe "Responses Definition Object" $ responsesDefinitionExample <=> responsesDefinitionExampleJSON+  describe "Status Code Range Responses" $ statusRangeResponsesExample <=> statusRangeResponsesExampleJSON+  describe "Responses with default, exact, range and $ref" $ responsesMixedExample <=> responsesMixedExampleJSON+  describe "Issue #1: range status code parses"+    $ it "decodes an operation whose responses include a 4XX range"+    $ do+      let js =+            [aesonQQ|+{+  "operationId": "test_endpoint",+  "responses": {+    "200": { "description": "200 response" },+    "429": { "description": "too many requests" },+    "4XX": { "description": "client error" }+  }+}+|]+      case fromJSON js :: Result Operation of+        Success op ->+          (op ^. responses . at (StatusRange R4XX))+            `shouldBe` Just (Inline (mempty & description .~ "client error"))+        Error e -> expectationFailure ("expected successful parse, got: " <> e)+  describe "Responses key parsing" $ do+    it "rejects a lowercase range key"+      $ (fromJSON [aesonQQ| { "4xx": { "description": "x" } } |] :: Result Responses)+      `shouldSatisfy` isError+    it "rejects an out-of-range class key"+      $ (fromJSON [aesonQQ| { "6XX": { "description": "x" } } |] :: Result Responses)+      `shouldSatisfy` isError+    it "accepts every valid range class"+      $ ( fromJSON+            [aesonQQ| { "1XX": {"description":"a"}, "5XX": {"description":"b"} } |] ::+            Result Responses+        )+      `shouldSatisfy` isSuccess   describe "Security Definitions Object" $ securityDefinitionsExample <=> securityDefinitionsExampleJSON   describe "OAuth2 Security Definitions with merged Scope" $ oAuth2SecurityDefinitionsExample <=> oAuth2SecurityDefinitionsExampleJSON   describe "OAuth2 Security Definitions with empty Scope" $ oAuth2SecurityDefinitionsEmptyExample <=> oAuth2SecurityDefinitionsEmptyExampleJSON@@ -55,6 +89,14 @@ main :: IO () main = hspec spec +isError :: Result a -> Bool+isError (Error _) = True+isError _ = False++isSuccess :: Result a -> Bool+isSuccess (Success _) = True+isSuccess _ = False+ -- ======================================================================= -- Info object -- =======================================================================@@ -515,6 +557,40 @@   "IllegalInput": {     "description": "Illegal input for operation."   }+}+|]++statusRangeResponsesExample :: Responses+statusRangeResponsesExample =+  mempty+    & at 200 ?~ Inline (mempty & description .~ "OK")+    & at (StatusRange R4XX) ?~ Inline (mempty & description .~ "Client error")++statusRangeResponsesExampleJSON :: Value+statusRangeResponsesExampleJSON =+  [aesonQQ|+{+  "200": { "description": "OK" },+  "4XX": { "description": "Client error" }+}+|]++responsesMixedExample :: Responses+responsesMixedExample =+  mempty+    & default_ ?~ Inline (mempty & description .~ "Unexpected error")+    & at 200 ?~ Inline (mempty & description .~ "OK")+    & at (StatusRange R4XX) ?~ Inline (mempty & description .~ "Client error")+    & at (StatusRange R5XX) ?~ Ref (Reference "ServerError")++responsesMixedExampleJSON :: Value+responsesMixedExampleJSON =+  [aesonQQ|+{+  "default": { "description": "Unexpected error" },+  "200": { "description": "OK" },+  "4XX": { "description": "Client error" },+  "5XX": { "$ref": "#/components/responses/ServerError" } } |]