openapi3 3.1.0 → 3.2.0
raw patch · 11 files changed
+192/−69 lines, 11 filesdep ~aesondep ~base-compat-batteriesdep ~lens
Dependency ranges changed: aeson, base-compat-batteries, lens
Files
- CHANGELOG.md +4/−0
- openapi3.cabal +8/−6
- src/Data/OpenApi/Aeson/Compat.hs +76/−0
- src/Data/OpenApi/Internal.hs +18/−15
- src/Data/OpenApi/Internal/AesonUtils.hs +11/−10
- src/Data/OpenApi/Internal/Schema.hs +15/−14
- src/Data/OpenApi/Internal/Schema/Validation.hs +23/−11
- src/Data/OpenApi/Schema/Generator.hs +3/−1
- test/Data/OpenApi/Schema/ValidationSpec.hs +17/−3
- test/Data/OpenApiSpec.hs +17/−1
- test/SpecCommon.hs +0/−8
CHANGELOG.md view
@@ -1,6 +1,10 @@ Unreleased ---------- +- Support aeson-2 [#34](https://github.com/biocad/openapi3/pull/34).+- Use `SecurityDefinitions` type for `_componentsSecuritySchemes`+ [#32](https://github.com/biocad/openapi3/pull/32).+ 3.1.0 -----
openapi3.cabal view
@@ -1,6 +1,6 @@ cabal-version: >=1.10 name: openapi3-version: 3.1.0+version: 3.2.0 synopsis: OpenAPI 3.0 data model category: Web, Swagger, OpenApi@@ -56,6 +56,8 @@ Data.OpenApi.Internal.AesonUtils Data.OpenApi.Internal.TypeShape + Data.OpenApi.Aeson.Compat+ -- GHC boot libraries build-depends: base >=4.11.1.0 && <4.16@@ -71,13 +73,13 @@ -- other dependencies build-depends:- base-compat-batteries >=0.11.1 && <0.12- , aeson >=1.4.2.0 && <1.6+ base-compat-batteries >=0.11.1 && <0.13+ , aeson >=1.4.2.0 && <1.6 || >=2.0.1.0 && < 2.1 , aeson-pretty >=0.8.7 && <0.9 -- cookie 0.4.3 is needed by GHC 7.8 due to time>=1.4 constraint , cookie >=0.4.3 && <0.5 , generics-sop >=0.5.1.0 && <0.6- , hashable >=1.2.7.0 && <1.4+ , hashable >=1.2.7.0 && <1.5 , http-media >=0.8.0.0 && <0.9 , insert-ordered-containers >=0.2.3 && <0.3 , lens >=4.16.1 && <5.1@@ -119,14 +121,14 @@ -- test-suite only dependencies build-depends:- hspec >=2.5.5 && <2.8+ hspec >=2.5.5 && <2.10 , HUnit >=1.6.0.0 && <1.7 , quickcheck-instances >=0.3.19 && <0.14 , utf8-string >=1.0.1.1 && <1.1 -- https://github.com/haskell/cabal/issues/3708 build-tool-depends:- hspec-discover:hspec-discover >=2.5.5 && <2.8+ hspec-discover:hspec-discover >=2.5.5 && <2.10 other-modules: SpecCommon
+ src/Data/OpenApi/Aeson/Compat.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE CPP #-}++module Data.OpenApi.Aeson.Compat where++#if MIN_VERSION_aeson(2,0,0)+import Data.Aeson (Key)+import qualified Data.Aeson.Key as Key+import qualified Data.Aeson.KeyMap as KeyMap+#else+import qualified Data.HashMap.Strict as HM+#endif+import Data.Bifunctor (first)+import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap+import qualified Data.Text as T++#if MIN_VERSION_aeson(2,0,0)+deleteKey :: Key -> KeyMap.KeyMap v -> KeyMap.KeyMap v+deleteKey = KeyMap.delete++objectToList :: KeyMap.KeyMap v -> [(Key, v)]+objectToList = KeyMap.toList++objectKeys :: KeyMap.KeyMap v -> [T.Text]+objectKeys = map Key.toText . KeyMap.keys++stringToKey :: String -> Key+stringToKey = Key.fromString++keyToString :: Key -> String+keyToString = Key.toString++keyToText :: Key -> T.Text+keyToText = Key.toText++toInsOrdHashMap :: KeyMap.KeyMap v -> InsOrdHashMap.InsOrdHashMap T.Text v+toInsOrdHashMap = InsOrdHashMap.fromList . fmap (first Key.toText) . KeyMap.toList++fromInsOrdHashMap :: InsOrdHashMap.InsOrdHashMap T.Text v -> KeyMap.KeyMap v+fromInsOrdHashMap = KeyMap.fromList . fmap (first Key.fromText) . InsOrdHashMap.toList++lookupKey :: T.Text -> KeyMap.KeyMap v -> Maybe v+lookupKey = KeyMap.lookup . Key.fromText++hasKey :: T.Text -> KeyMap.KeyMap a -> Bool+hasKey = KeyMap.member . Key.fromText+#else+deleteKey :: T.Text -> HM.HashMap T.Text v -> HM.HashMap T.Text v+deleteKey = HM.delete++objectToList :: HM.HashMap T.Text v -> [(T.Text, v)]+objectToList = HM.toList++objectKeys :: HM.HashMap T.Text v -> [T.Text]+objectKeys = HM.keys++stringToKey :: String -> T.Text+stringToKey = T.pack++keyToString :: T.Text -> String+keyToString = T.unpack++keyToText :: T.Text -> T.Text+keyToText = id++toInsOrdHashMap :: HM.HashMap T.Text v -> InsOrdHashMap.InsOrdHashMap T.Text v+toInsOrdHashMap = InsOrdHashMap.fromHashMap++fromInsOrdHashMap :: InsOrdHashMap.InsOrdHashMap T.Text v -> HM.HashMap T.Text v+fromInsOrdHashMap = InsOrdHashMap.toHashMap++lookupKey :: T.Text -> HM.HashMap T.Text v -> Maybe v+lookupKey = HM.lookup++hasKey :: T.Text -> HM.HashMap T.Text a -> Bool+hasKey = HM.member+#endif
src/Data/OpenApi/Internal.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-}@@ -21,6 +22,9 @@ import Control.Applicative import Control.Lens ((&), (.~), (?~)) import Data.Aeson hiding (Encoding)+#if MIN_VERSION_aeson(2,0,0)+import qualified Data.Aeson.KeyMap as KeyMap+#endif import qualified Data.Aeson.Types as JSON import Data.Data (Constr, Data (..), DataType, Fixity (..), Typeable, constrIndex, mkConstr, mkDataType)@@ -45,17 +49,13 @@ import Data.HashMap.Strict.InsOrd (InsOrdHashMap) import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap -import Generics.SOP.TH (deriveGeneric)-import Data.OpenApi.Internal.AesonUtils (sopSwaggerGenericToJSON- ,sopSwaggerGenericToJSONWithOpts- ,sopSwaggerGenericParseJSON- ,HasSwaggerAesonOptions(..)- ,AesonDefaultValue(..)- ,mkSwaggerAesonOptions- ,saoAdditionalPairs- ,saoSubObject)+import Data.OpenApi.Aeson.Compat (deleteKey)+import Data.OpenApi.Internal.AesonUtils (AesonDefaultValue (..), HasSwaggerAesonOptions (..),+ mkSwaggerAesonOptions, saoAdditionalPairs, saoSubObject,+ sopSwaggerGenericParseJSON, sopSwaggerGenericToEncoding,+ sopSwaggerGenericToJSON, sopSwaggerGenericToJSONWithOpts) import Data.OpenApi.Internal.Utils-import Data.OpenApi.Internal.AesonUtils (sopSwaggerGenericToEncoding)+import Generics.SOP.TH (deriveGeneric) -- $setup -- >>> :seti -XDataKinds@@ -196,7 +196,7 @@ , _componentsExamples :: Definitions Example , _componentsRequestBodies :: Definitions RequestBody , _componentsHeaders :: Definitions Header- , _componentsSecuritySchemes :: Definitions SecurityScheme+ , _componentsSecuritySchemes :: SecurityDefinitions , _componentsLinks :: Definitions Link , _componentsCallbacks :: Definitions Callback } deriving (Eq, Show, Generic, Data, Typeable)@@ -337,7 +337,7 @@ -- | The content of the request body. -- The key is a media type or media type range and the value describes it. -- For requests that match multiple keys, only the most specific key is applicable.- -- e.g. @text/plain@ overrides @text/*@+ -- e.g. @text/plain@ overrides @text/\*@ , _requestBodyContent :: InsOrdHashMap MediaType MediaTypeObject -- | Determines if the request body is required in the request.@@ -394,7 +394,7 @@ -- for other primitive types – @text/plain@; for object - @application/json@; -- for array – the default is defined based on the inner type. -- The value can be a specific media type (e.g. @application/json@),- -- a wildcard media type (e.g. @image/*@), or a comma-separated list of the two types.+ -- a wildcard media type (e.g. @image/\*@), or a comma-separated list of the two types. _encodingContentType :: Maybe MediaType -- | A map allowing additional information to be provided as headers,@@ -734,7 +734,7 @@ -- | A map containing descriptions of potential response payloads. -- The key is a media type or media type range and the value describes it. -- For responses that match multiple keys, only the most specific key is applicable.- -- e.g. @text/plain@ overrides @text/*@.+ -- e.g. @text/plain@ overrides @text/\*@. , _responseContent :: InsOrdHashMap MediaType MediaTypeObject -- | Maps a header name to its definition.@@ -1125,6 +1125,7 @@ instance SwaggerMonoid ExternalDocs instance SwaggerMonoid Operation instance (Eq a, Hashable a) => SwaggerMonoid (InsOrdHashSet a)+instance SwaggerMonoid SecurityDefinitions instance SwaggerMonoid MimeList deriving instance SwaggerMonoid URL@@ -1491,7 +1492,7 @@ instance FromJSON Responses where parseJSON (Object o) = Responses <$> o .:? "default"- <*> parseJSON (Object (HashMap.delete "default" o))+ <*> parseJSON (Object (deleteKey "default" o)) parseJSON _ = empty instance FromJSON Example where@@ -1614,3 +1615,5 @@ instance AesonDefaultValue Info instance AesonDefaultValue ParamLocation instance AesonDefaultValue Link+instance AesonDefaultValue SecurityDefinitions where+ defaultValue = Just mempty
src/Data/OpenApi/Internal/AesonUtils.hs view
@@ -36,18 +36,19 @@ import Generics.SOP import qualified Data.Text as T-import qualified Data.HashMap.Strict as HM import qualified Data.Set as Set import qualified Data.HashMap.Strict.InsOrd as InsOrd import qualified Data.HashSet.InsOrd as InsOrdHS +import Data.OpenApi.Aeson.Compat (keyToString, objectToList, stringToKey)+ ------------------------------------------------------------------------------- -- SwaggerAesonOptions ------------------------------------------------------------------------------- data SwaggerAesonOptions = SwaggerAesonOptions { _saoPrefix :: String- , _saoAdditionalPairs :: [(Text, Value)]+ , _saoAdditionalPairs :: [Pair] , _saoSubObject :: Maybe String } @@ -154,14 +155,14 @@ go Nil Nil Nil = [] go (I x :* xs) (FieldInfo name :* names) (def :* defs) | Just name' == sub = case json of- Object m -> HM.toList m ++ rest+ Object m -> objectToList m ++ rest Null -> rest _ -> error $ "sopSwaggerGenericToJSON: subjson is not an object: " ++ show json -- If default value: omit it. | Just x == def = rest | otherwise =- (T.pack name', json) : rest+ (stringToKey name', json) : rest where json = toJSON x name' = fieldNameModifier name@@ -195,11 +196,11 @@ proxy = Proxy :: Proxy a opts = swaggerAesonOptions proxy - parseAdditionalField :: Object -> (Text, Value) -> Parser ()+ parseAdditionalField :: Object -> Pair -> Parser () parseAdditionalField obj (k, v) = do v' <- obj .: k unless (v == v') $ fail $- "Additonal field don't match for key " ++ T.unpack k+ "Additonal field don't match for key " ++ keyToString k ++ ": " ++ show v ++ " /= " ++ show v' @@ -230,8 +231,8 @@ -- Note: we might strip fields of outer structure. cons <$> (withDef $ parseJSON $ Object obj) <*> rest | otherwise = case def of- Just def' -> cons <$> obj .:? T.pack name' .!= def' <*> rest- Nothing -> cons <$> obj .: T.pack name' <*> rest+ Just def' -> cons <$> obj .:? stringToKey name' .!= def' <*> rest+ Nothing -> cons <$> obj .: stringToKey name' <*> rest where cons h t = I h :* t name' = fieldNameModifier name@@ -294,14 +295,14 @@ go Nil Nil Nil = mempty go (I x :* xs) (FieldInfo name :* names) (def :* defs) | Just name' == sub = case toJSON x of- Object m -> pairsToSeries (HM.toList m) <> rest+ Object m -> pairsToSeries (objectToList m) <> rest Null -> rest _ -> error $ "sopSwaggerGenericToJSON: subjson is not an object: " ++ show (toJSON x) -- If default value: omit it. | Just x == def = rest | otherwise =- (T.pack name' .= x) <> rest+ (stringToKey name' .= x) <> rest where name' = fieldNameModifier name rest = go xs names defs
src/Data/OpenApi/Internal/Schema.hs view
@@ -64,13 +64,14 @@ import qualified Data.UUID.Types as UUID import Type.Reflection (Typeable, typeRep) -import Data.OpenApi.Declare-import Data.OpenApi.Internal-import Data.OpenApi.Internal.ParamSchema (ToParamSchema(..))-import Data.OpenApi.Lens hiding (name, schema)-import qualified Data.OpenApi.Lens as Swagger-import Data.OpenApi.SchemaOptions-import Data.OpenApi.Internal.TypeShape+import Data.OpenApi.Aeson.Compat (keyToText, objectKeys, toInsOrdHashMap)+import Data.OpenApi.Declare+import Data.OpenApi.Internal+import Data.OpenApi.Internal.ParamSchema (ToParamSchema (..))+import Data.OpenApi.Internal.TypeShape+import Data.OpenApi.Lens hiding (name, schema)+import qualified Data.OpenApi.Lens as Swagger+import Data.OpenApi.SchemaOptions import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy.Char8 as BSL@@ -405,8 +406,8 @@ _ -> Nothing go (Object o) = mempty & type_ ?~ OpenApiObject- & required .~ sort (HashMap.keys o)- & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)+ & required .~ sort (objectKeys o)+ & properties .~ fmap (Inline . go) (toInsOrdHashMap o) -- | Make a restrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance. -- Produced schema uses as much constraints as possible.@@ -570,12 +571,12 @@ go js@(Object o) = mempty & type_ ?~ OpenApiObject & required .~ sort names- & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)+ & properties .~ fmap (Inline . go) (toInsOrdHashMap o) & maxProperties ?~ fromIntegral (length names) & minProperties ?~ fromIntegral (length names) & enum_ ?~ [js] where- names = HashMap.keys o+ names = objectKeys o class GToSchema (f :: * -> *) where gdeclareNamedSchema :: SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema@@ -810,13 +811,13 @@ (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value) => Proxy (map key value) -> Declare (Definitions Schema) Schema declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key of- ToJSONKeyText keyToText _ -> objectSchema keyToText+ ToJSONKeyText getKey _ -> objectSchema getKey ToJSONKeyValue _ _ -> declareSchema (Proxy :: Proxy [(key, value)]) where- objectSchema keyToText = do+ objectSchema getKey = do valueRef <- declareSchemaRef (Proxy :: Proxy value) let allKeys = [minBound..maxBound :: key]- mkPair k = (keyToText k, valueRef)+ mkPair k = (keyToText $ getKey k, valueRef) return $ mempty & type_ ?~ OpenApiObject & properties .~ InsOrdHashMap.fromList (map mkPair allKeys)
src/Data/OpenApi/Internal/Schema/Validation.hs view
@@ -1,4 +1,5 @@ {-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE FlexibleInstances #-}@@ -31,10 +32,14 @@ import Control.Monad (forM, forM_, when) import Data.Aeson hiding (Result)+#if MIN_VERSION_aeson(2,0,0)+import qualified Data.Aeson.KeyMap as KeyMap+#endif import Data.Foldable (for_, sequenceA_, traverse_)+#if !MIN_VERSION_aeson(2,0,0) import Data.HashMap.Strict (HashMap)-import qualified Data.HashMap.Strict as HashMap+#endif import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap import qualified "unordered-containers" Data.HashSet as HashSet import Data.Maybe (fromMaybe)@@ -47,11 +52,12 @@ import Data.Vector (Vector) import qualified Data.Vector as Vector -import Data.OpenApi.Declare-import Data.OpenApi.Internal-import Data.OpenApi.Internal.Utils-import Data.OpenApi.Internal.Schema-import Data.OpenApi.Lens+import Data.OpenApi.Aeson.Compat (hasKey, keyToText, lookupKey, objectToList)+import Data.OpenApi.Declare+import Data.OpenApi.Internal+import Data.OpenApi.Internal.Schema+import Data.OpenApi.Internal.Utils+import Data.OpenApi.Lens -- | Validate @'ToJSON'@ instance matches @'ToSchema'@ for a given value. -- This can be used with QuickCheck to ensure those instances are coherent:@@ -366,10 +372,16 @@ len = Vector.length xs allUnique = len == HashSet.size (HashSet.fromList (Vector.toList xs)) -validateObject :: HashMap Text Value -> Validation Schema ()+validateObject ::+#if MIN_VERSION_aeson(2,0,0)+ KeyMap.KeyMap Value+#else+ HashMap Text Value+#endif+ -> Validation Schema () validateObject o = withSchema $ \sch -> case sch ^. discriminator of- Just (Discriminator pname types) -> case fromJSON <$> HashMap.lookup pname o of+ Just (Discriminator pname types) -> case fromJSON <$> lookupKey pname o of Just (Success pvalue) -> let ref = fromMaybe pvalue $ InsOrdHashMap.lookup pvalue types -- TODO ref may be name or reference@@ -388,15 +400,15 @@ validateRequired validateProps where- size = fromIntegral (HashMap.size o)+ size = fromIntegral (length o) validateRequired = withSchema $ \sch -> traverse_ validateReq (sch ^. required) validateReq n =- when (not (HashMap.member n o)) $+ when (not (hasKey n o)) $ invalid ("property " ++ show n ++ " is required, but not found in " ++ show (encode o)) validateProps = withSchema $ \sch -> do- for_ (HashMap.toList o) $ \(k, v) ->+ for_ (objectToList o) $ \(keyToText -> k, v) -> case v of Null | not (k `elem` (sch ^. required)) -> valid -- null is fine for non-required property _ ->
src/Data/OpenApi/Schema/Generator.hs view
@@ -25,6 +25,8 @@ import Test.QuickCheck.Gen import Test.QuickCheck.Property +import Data.OpenApi.Aeson.Compat (fromInsOrdHashMap)+ -- | Note: 'schemaGen' may 'error', if schema type is not specified, -- and cannot be inferred. schemaGen :: Definitions Schema -> Schema -> Gen Value@@ -95,7 +97,7 @@ return . M.fromList $ zip additionalKeys (repeat . schemaGen defns $ dereference defns addlSchema) _ -> return [] x <- sequence $ gens <> additionalGens- return . Object $ M.toHashMap x+ return . Object $ fromInsOrdHashMap x dereference :: Definitions a -> Referenced a -> a dereference _ (Inline a) = a
test/Data/OpenApi/Schema/ValidationSpec.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE RecordWildCards #-}@@ -8,6 +9,10 @@ import Control.Applicative import Control.Lens ((&), (.~), (?~)) import Data.Aeson+#if MIN_VERSION_aeson(2,0,0)+import qualified Data.Aeson.Key as Key+import qualified Data.Aeson.KeyMap as KeyMap+#endif import Data.Aeson.Types import Data.Hashable (Hashable) import Data.HashMap.Strict (HashMap)@@ -30,6 +35,7 @@ import Data.OpenApi import Data.OpenApi.Declare+import Data.OpenApi.Aeson.Compat (stringToKey) import Test.Hspec import Test.Hspec.QuickCheck@@ -124,9 +130,9 @@ invalidPersonToJSON :: Person -> Value invalidPersonToJSON Person{..} = object- [ T.pack "personName" .= toJSON name- , T.pack "personPhone" .= toJSON phone- , T.pack "personEmail" .= toJSON email+ [ stringToKey "personName" .= toJSON name+ , stringToKey "personPhone" .= toJSON phone+ , stringToKey "personEmail" .= toJSON email ] -- ========================================================================@@ -305,3 +311,11 @@ , (3, Number <$> arbitrary) , (3, Bool <$> arbitrary) , (1, return Null) ]++#if MIN_VERSION_aeson(2,0,0)+instance Arbitrary v => Arbitrary (KeyMap.KeyMap v) where+ arbitrary = KeyMap.fromList <$> arbitrary++instance Arbitrary Key.Key where+ arbitrary = Key.fromText <$> arbitrary+#endif
test/Data/OpenApiSpec.hs view
@@ -45,6 +45,10 @@ fromJSON petstoreExampleJSON `shouldSatisfy` (\x -> case x of Success (_ :: OpenApi) -> True; _ -> False) it "roundtrips: fmap toJSON . fromJSON" $ do (toJSON :: OpenApi -> Value) <$> fromJSON petstoreExampleJSON `shouldBe` Success petstoreExampleJSON+ context "Security schemes" $ do+ it "merged correctly" $ do+ let merged = oAuth2SecurityDefinitionsReadOpenApi <> oAuth2SecurityDefinitionsWriteOpenApi+ merged `shouldBe` oAuth2SecurityDefinitionsOpenApi main :: IO () main = hspec spec@@ -441,7 +445,7 @@ |] -- =======================================================================--- Responses Definition object+-- Security Definition object -- ======================================================================= securityDefinitionsExample :: SecurityDefinitions@@ -526,6 +530,18 @@ } } |]++oAuth2SecurityDefinitionsReadOpenApi :: OpenApi+oAuth2SecurityDefinitionsReadOpenApi =+ mempty & components . securitySchemes .~ oAuth2SecurityDefinitionsReadExample++oAuth2SecurityDefinitionsWriteOpenApi :: OpenApi+oAuth2SecurityDefinitionsWriteOpenApi =+ mempty & components . securitySchemes .~ oAuth2SecurityDefinitionsWriteExample++oAuth2SecurityDefinitionsOpenApi :: OpenApi+oAuth2SecurityDefinitionsOpenApi =+ mempty & components . securitySchemes .~ oAuth2SecurityDefinitionsExample -- ======================================================================= -- Swagger object
test/SpecCommon.hs view
@@ -8,14 +8,6 @@ import Test.Hspec -isSubJSON :: Value -> Value -> Bool-isSubJSON Null _ = True-isSubJSON (Object x) (Object y) = HashMap.keys x == HashMap.keys i && F.and i- where- i = HashMap.intersectionWith isSubJSON x y-isSubJSON (Array xs) (Array ys) = Vector.length xs == Vector.length ys && F.and (Vector.zipWith isSubJSON xs ys)-isSubJSON x y = x == y- (<=>) :: (Eq a, Show a, ToJSON a, FromJSON a, HasCallStack) => a -> Value -> Spec x <=> js = do it "encodes correctly" $ do