Fix bug parsing set of valid OpenApi spec versions

src/Data/OpenApi/Internal.hs

@@ -56,6 +56,9 @@ import Data.OpenApi.Internal.AesonUtils (AesonDefaultValue (..), HasSwaggerAeson
                                          sopSwaggerGenericToJSON, sopSwaggerGenericToJSONWithOpts)
 import Data.OpenApi.Internal.Utils
 import Generics.SOP.TH                  (deriveGeneric)
+import Data.Version
+import Control.Monad (unless)
+import Text.ParserCombinators.ReadP (readP_to_S)
 
 -- $setup
 -- >>> :seti -XDataKinds
@@ -99,8 +102,19 @@ data OpenApi = OpenApi
 
     -- | Additional external documentation.
   , _openApiExternalDocs :: Maybe ExternalDocs
+
+  , -- | The spec of OpenApi this spec adheres to. Must be between 'lowerOpenApiSpecVersion' and 'upperOpenApiSpecVersion'
+    _openApiOpenapi :: OpenApiSpecVersion
   } deriving (Eq, Show, Generic, Data, Typeable)
 
+-- | This is the lower version of the OpenApi Spec this library can parse or produce
+lowerOpenApiSpecVersion :: Version
+lowerOpenApiSpecVersion = makeVersion [3, 0, 0]
+
+-- | This is the upper version of the OpenApi Spec this library can parse or produce
+upperOpenApiSpecVersion :: Version
+upperOpenApiSpecVersion = makeVersion [3, 0, 3]
+
 -- | The object provides metadata about the API.
 -- The metadata MAY be used by the clients if needed,
 -- and MAY be presented in editing or documentation generation tools for convenience.
@@ -962,6 +976,8 @@ data AdditionalProperties
   | AdditionalPropertiesSchema (Referenced Schema)
   deriving (Eq, Show, Data, Typeable)
 
+newtype OpenApiSpecVersion = OpenApiSpecVersion {getVersion :: Version} deriving (Eq, Show, Generic, Data, Typeable)
+
 -------------------------------------------------------------------------------
 -- Generic instances
 -------------------------------------------------------------------------------
@@ -984,11 +1000,19 @@ deriveGeneric ''OpenApi
 deriveGeneric ''Example
 deriveGeneric ''Encoding
 deriveGeneric ''Link
+deriveGeneric ''OpenApiSpecVersion
 
 -- =======================================================================
 -- Monoid instances
 -- =======================================================================
 
+instance Semigroup OpenApiSpecVersion where
+  (<>) (OpenApiSpecVersion a) (OpenApiSpecVersion b) = OpenApiSpecVersion $ max a b 
+
+instance Monoid OpenApiSpecVersion where
+  mempty = OpenApiSpecVersion (makeVersion [3,0,0])
+  mappend = (<>)
+
 instance Semigroup OpenApi where
   (<>) = genericMappend
 instance Monoid OpenApi where
@@ -1126,6 +1150,7 @@ instance SwaggerMonoid ExternalDocs
 instance SwaggerMonoid Operation
 instance (Eq a, Hashable a) => SwaggerMonoid (InsOrdHashSet a)
 instance SwaggerMonoid SecurityDefinitions
+instance SwaggerMonoid OpenApiSpecVersion
 
 instance SwaggerMonoid MimeList
 deriving instance SwaggerMonoid URL
@@ -1258,6 +1283,9 @@ instance FromJSON OAuth2AuthorizationCodeFlow where
 -- Manual ToJSON instances
 -- =======================================================================
 
+instance ToJSON OpenApiSpecVersion where 
+  toJSON (OpenApiSpecVersion v)= toJSON . showVersion $ v
+
 instance ToJSON MediaType where
   toJSON = toJSON . show
   toEncoding = toEncoding . show
@@ -1425,6 +1453,22 @@ instance ToJSON Callback where
 -- Manual FromJSON instances
 -- =======================================================================
 
+instance FromJSON OpenApiSpecVersion where
+  parseJSON = withText "OpenApiSpecVersion" $ \str ->
+            let validatedVersion :: Either String Version
+                validatedVersion = do
+                  parsedVersion <- readVersion str 
+                  unless ((parsedVersion >= lowerOpenApiSpecVersion) && (parsedVersion <= upperOpenApiSpecVersion)) $
+                     Left ("The provided version " <> showVersion parsedVersion <> " is out of the allowed range >=" <> showVersion lowerOpenApiSpecVersion <> " && <=" <> showVersion upperOpenApiSpecVersion)
+                  return parsedVersion
+             in 
+              either fail (return . OpenApiSpecVersion) validatedVersion
+    where
+    readVersion :: Text -> Either String Version
+    readVersion v = case readP_to_S parseVersion (Text.unpack v) of 
+      [] -> Left $ "Failed to parse as a version string " <> Text.unpack v
+      solutions -> Right (fst . last $ solutions)
+
 instance FromJSON MediaType where
   parseJSON = withText "MediaType" $ \str ->
     maybe (fail $ "Invalid media type literal " <> Text.unpack str) pure $ parseAccept $ encodeUtf8 str
@@ -1594,8 +1638,10 @@ instance HasSwaggerAesonOptions SecurityScheme where
   swaggerAesonOptions _ = mkSwaggerAesonOptions "securityScheme" & saoSubObject ?~ "type"
 instance HasSwaggerAesonOptions Schema where
   swaggerAesonOptions _ = mkSwaggerAesonOptions "schema" & saoSubObject ?~ "paramSchema"
+instance HasSwaggerAesonOptions OpenApiSpecVersion where
+  swaggerAesonOptions _ = mkSwaggerAesonOptions "openapi"
 instance HasSwaggerAesonOptions OpenApi where
-  swaggerAesonOptions _ = mkSwaggerAesonOptions "swagger" & saoAdditionalPairs .~ [("openapi", "3.0.0")]
+  swaggerAesonOptions _ = mkSwaggerAesonOptions "swagger"
 instance HasSwaggerAesonOptions Example where
   swaggerAesonOptions _ = mkSwaggerAesonOptions "example"
 instance HasSwaggerAesonOptions Encoding where
@@ -1604,6 +1650,9 @@ instance HasSwaggerAesonOptions Encoding where
 instance HasSwaggerAesonOptions Link where
   swaggerAesonOptions _ = mkSwaggerAesonOptions "link"
 
+instance AesonDefaultValue Version where 
+  defaultValue = Just (makeVersion [3,0,0])
+instance AesonDefaultValue OpenApiSpecVersion
 instance AesonDefaultValue Server
 instance AesonDefaultValue Components
 instance AesonDefaultValue OAuth2ImplicitFlow

test/Data/OpenApiSpec.hs

@@ -39,7 +39,10 @@ spec = do
   describe "OAuth2 Security Definitions with empty Scope" $ oAuth2SecurityDefinitionsEmptyExample <=> oAuth2SecurityDefinitionsEmptyExampleJSON
   describe "Composition Schema Example" $ compositionSchemaExample <=> compositionSchemaExampleJSON
   describe "Swagger Object" $ do
-    context "Example with no paths" $ emptyPathsFieldExample <=> emptyPathsFieldExampleJSON
+    context "Example with no paths" $ do 
+      emptyPathsFieldExample <=> emptyPathsFieldExampleJSON
+      it "fails to parse a spec with a wrong Openapi spec version" $ do
+        (fromJSON wrongVersionExampleJSON :: Result OpenApi) `shouldBe` Error "The provided version 3.0.4 is out of the allowed range >=3.0.0 && <=3.0.3"
     context "Todo Example" $ swaggerExample <=> swaggerExampleJSON
     context "PetStore Example" $ do
       it "decodes successfully" $ do
@@ -582,6 +585,16 @@ oAuth2SecurityDefinitionsOpenApi =
 emptyPathsFieldExample :: OpenApi
 emptyPathsFieldExample = mempty
 
+wrongVersionExampleJSON :: Value
+wrongVersionExampleJSON = [aesonQQ|
+{
+  "openapi": "3.0.4",
+  "info": {"version": "", "title": ""},
+  "paths": {},
+  "components": {}
+}
+|]
+
 emptyPathsFieldExampleJSON :: Value
 emptyPathsFieldExampleJSON = [aesonQQ|
 {
@@ -695,7 +708,7 @@ swaggerExampleJSON = [aesonQQ|
 petstoreExampleJSON :: Value
 petstoreExampleJSON = [aesonQQ|
 {
-  "openapi": "3.0.0",
+  "openapi": "3.0.3",
   "info": {
     "version": "1.0.0",
     "title": "Swagger Petstore",