json-spec-openapi (empty) → 0.1.0.0
raw patch · 5 files changed
+624/−0 lines, 5 filesdep +aesondep +basedep +bytestring
Dependencies added: aeson, base, bytestring, hspec, json-spec, json-spec-openapi, lens, openapi3, scientific, text, time
Files
- LICENSE +21/−0
- README.md +51/−0
- json-spec-openapi.cabal +102/−0
- src/Data/JsonSpec/OpenApi.hs +240/−0
- test/test.hs +210/−0
+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2023 Rick Owens++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
@@ -0,0 +1,51 @@+# json-spec-openapi++This package provides a way to produce+[`openapi3`](https://hackage.haskell.org/package/openapi3) documentation from a+[`json-spec`](https://hackage.haskell.org/package/json-spec-0.1.0.0)+specification.++## Example++Given this data type:++```haskell+data User = User+ { name :: Text+ , lastLogin :: UTCTime+ }+ deriving ToSchema via (EncodingSchema User) -- <-- ToSchema instance defined here+instance HasJsonEncodingSpec User where+ type EncodingSpec User =+ JsonObject+ '[ '("name", JsonString)+ , '("last-login", JsonDateTime)+ ]+ toJSONStructure user =+ (Field @"name" (name user),+ (Field @"last-login" (lastLogin user),+ ()))+```++Calling `Data.Aeson.encode (Data.OpenApi3.toSchema (Proxy :: Proxy User))`+will produce the following Schema:++```json+{+ "additionalProperties": false,+ "properties": {+ "last-login": {+ "format": "date-time",+ "type": "string"+ },+ "name": {+ "type": "string"+ }+ },+ "required": [+ "name",+ "last-login"+ ],+ "type": "object"+}+```
+ json-spec-openapi.cabal view
@@ -0,0 +1,102 @@+cabal-version: 3.0+name: json-spec-openapi+version: 0.1.0.0+synopsis: json-spec-openapi+description:+ This package provides a way to produce+ [`openapi3`](https://hackage.haskell.org/package/openapi3) documentation from a+ [`json-spec`](https://hackage.haskell.org/package/json-spec-0.1.0.0)+ specification.++ = Example++ Given this data type:++ > data User = User+ > { name :: Text+ > , lastLogin :: UTCTime+ > }+ > deriving ToSchema via (EncodingSchema User) -- <-- ToSchema instance defined here+ > instance HasJsonEncodingSpec User where+ > type EncodingSpec User =+ > JsonObject+ > '[ '("name", JsonString)+ > , '("last-login", JsonDateTime)+ > ]+ > toJSONStructure user =+ > (Field @"name" (name user),+ > (Field @"last-login" (lastLogin user),+ > ()))++ Calling `Data.Aeson.encode (Data.OpenApi3.toSchema (Proxy :: Proxy User))`+ will produce the following Schema:++ > {+ > "additionalProperties": false,+ > "properties": {+ > "last-login": {+ > "format": "date-time",+ > "type": "string"+ > },+ > "name": {+ > "type": "string"+ > }+ > },+ > "required": [+ > "name",+ > "last-login"+ > ],+ > "type": "object"+ > }+homepage: https://github.com/owensmurray/json-spec-openapi+license: MIT+license-file: LICENSE+author: Rick Owens+maintainer: rick@owensmurray.com+copyright: 2022 Rick Owens+category: JSON, OpenApi+build-type: Simple+extra-source-files:+ README.md+ LICENSE++common dependencies+ build-depends:+ , base >= 4.17 && < 4.18+ , json-spec >= 0.1.0.0 && < 0.2+ , lens >= 5.2.2 && < 5.3+ , openapi3 >= 3.2.3 && < 3.3+ , text >= 2.0.2 && < 2.1++common warnings+ ghc-options:+ -Wmissing-deriving-strategies+ -Wmissing-export-lists+ -Wmissing-import-lists+ -Wredundant-constraints+ -Wall++library+ import: dependencies, warnings+ exposed-modules: + Data.JsonSpec.OpenApi+ -- other-modules: + -- other-extensions: + hs-source-dirs: src+ default-language: Haskell2010++test-suite json-spec-openapi-tests+ import: dependencies, warnings+ main-is: test.hs+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ default-language: Haskell2010+ build-depends:+ , json-spec-openapi++ , aeson >= 2.1.2.1 && < 2.2+ , bytestring >= 0.11.4.0 && < 0.12+ , hspec >= 2.11.1 && < 2.12+ , scientific >= 0.3.7.0 && < 0.4+ , time >= 1.12.2 && < 1.13+
+ src/Data/JsonSpec/OpenApi.hs view
@@ -0,0 +1,240 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++{-|+ This module provides tools for integrating the type-level JSON+ 'Specification' with the "openapi" package.++ You can use 'toOpenApiSchema' as a low-level tool to transform @json-spec@+ 'Specification's into @openapi3@ 'Schema's directly, irrespective of any+ particular business data type.++ More likely you will want to use @-XDerivingVia@ along with 'EncodingSchema'+ or 'DecodingSchema' to derive 'ToSchema' instances for your data types.++ Example, given this data type:++ > data User = User+ > { name :: Text+ > , lastLogin :: UTCTime+ > }+ > deriving ToSchema via (EncodingSchema User) -- <-- ToSchema instance defined here+ > instance HasJsonEncodingSpec User where+ > type EncodingSpec User =+ > JsonObject+ > '[ '("name", JsonString)+ > , '("last-login", JsonDateTime)+ > ]+ > toJSONStructure user =+ > (Field @"name" (name user),+ > (Field @"last-login" (lastLogin user),+ > ()))++ Calling @'Data.Aeson.encode' ('Data.OpenApi3.toSchema' ('Proxy' :: 'Proxy' User))@+ will produce the following Schema:++ > {+ > "additionalProperties": false,+ > "properties": {+ > "last-login": {+ > "format": "date-time",+ > "type": "string"+ > },+ > "name": {+ > "type": "string"+ > }+ > },+ > "required": [+ > "name",+ > "last-login"+ > ],+ > "type": "object"+ > }++ If you needed more control over the content of the schema you might also+ consider doing something like this, e.g. in the case where you would like to+ allow additional properties:++ > data User = User+ > { name :: Text+ > , lastLogin :: UTCTime+ > }+ > instance HasJsonEncodingSpec User where+ > type EncodingSpec User =+ > JsonObject+ > '[ '("name", JsonString)+ > , '("last-login", JsonDateTime)+ > ]+ > toJSONStructure user =+ > (Field @"name" (name user),+ > (Field @"last-login" (lastLogin user),+ > ()))+ > instance ToSchema User where+ > declareNamedSchema _proxy =+ > pure $+ > NamedSchema+ > Nothing+ > (+ > toOpenApiSchema (EncodingSpec User)+ > & set+ > additionalProperties+ > (Just (AdditionalPropertiesAllowed True))+ > )++-}+module Data.JsonSpec.OpenApi (+ toOpenApiSchema,+ EncodingSchema(..),+ DecodingSchema(..),+) where+++import Control.Lens (At(at), (&), over, set)+import Data.JsonSpec (HasJsonDecodingSpec(DecodingSpec),+ HasJsonEncodingSpec(EncodingSpec), Specification(JsonArray, JsonBool,+ JsonDateTime, JsonInt, JsonNum, JsonObject, JsonString))+import Data.OpenApi (AdditionalProperties(AdditionalPropertiesAllowed),+ HasAdditionalProperties(additionalProperties),+ HasFormat(format), HasItems(items), HasProperties(properties),+ HasRequired(required), HasType(type_), NamedSchema(NamedSchema),+ OpenApiItems(OpenApiItemsObject), OpenApiType(OpenApiArray,+ OpenApiBoolean, OpenApiInteger, OpenApiNumber, OpenApiObject,+ OpenApiString), Referenced(Inline), ToSchema(declareNamedSchema),+ Schema)+import Data.String (IsString(fromString))+import Data.Text (Text)+import Data.Typeable (Proxy(Proxy), Typeable)+import GHC.TypeLits (KnownSymbol, symbolVal)+++{-|+ Convert a 'Specification' into an OpenAPI 'Schema'. The type class+ 'Internal' is an internal and opaque implementation detail and not+ something you should have to worry about. It /should/ already have an+ instance for every possible 'Specification' that can be constructed. If+ it does not, then that is a bug. Please report it! :-)+-}+toOpenApiSchema+ :: (Internal spec)+ => Proxy (spec :: Specification)+ -> Schema+toOpenApiSchema = internal+++class Internal (spec :: Specification) where+ {-|+ Given a `Specification`, produce an OpenApi schema equivalent to+ the specification. Usually you will want to use this in conjunction with+ `HasJsonEncodingSpec` or `HasJsonDecodingSpec`.++ Example:++ > data MyType = ...+ > instance HasJsonEncodingSpec MyType where+ > type EncodingSpec MyType = ...+ >+ > schema :: Schema+ > schema = toOpenApiSchema (Proxy :: Proxy (EncodingSpec MyType))++ -}+ internal :: Proxy spec -> Schema+instance Internal 'JsonString where+ internal _ =+ mempty & set type_ (Just OpenApiString)+instance Internal 'JsonNum where+ internal _ =+ mempty & set type_ (Just OpenApiNumber)+instance Internal 'JsonInt where+ internal _ =+ mempty & set type_ (Just OpenApiInteger)+instance Internal ('JsonObject '[]) where+ internal _ =+ mempty+ & set type_ (Just OpenApiObject)+ & set additionalProperties (Just (AdditionalPropertiesAllowed False))+instance (KnownSymbol key, Internal spec, Internal ('JsonObject more)) => Internal ('JsonObject ( '(key, spec) : more )) where+ internal _ =+ let+ propertyName :: Text+ propertyName = sym @key++ propertySchema :: Schema+ propertySchema = internal (Proxy @spec)+ in+ internal (Proxy @('JsonObject more))+ & over properties (set (at propertyName) (Just (Inline propertySchema)))+ & over required (propertyName:)+instance (Internal spec) => Internal ('JsonArray spec) where+ internal _ =+ let+ elementSchema :: Schema+ elementSchema = internal (Proxy @spec)+ in+ mempty+ & set type_ (Just OpenApiArray)+ & set items (Just (OpenApiItemsObject (Inline elementSchema)))+instance Internal 'JsonBool where+ internal _ =+ mempty & set type_ (Just OpenApiBoolean)++instance Internal 'JsonDateTime where+ internal _ =+ mempty+ & set type_ (Just OpenApiString)+ & set format (Just "date-time")+++{-|+ Helper for defining `ToSchema` instances based on `HasJsonEncodingSpec`+ using @deriving via@.++ Example:++ > data MyType = ...+ > deriving ToSchema via (EncodingSchema MyType)+ > instance HasJsonEncodingSchema MyType where+ > ...+-}+newtype EncodingSchema a =+ EncodingSchema {unEncodingSchema :: a}+instance (Typeable a, Internal (EncodingSpec a)) => ToSchema (EncodingSchema a) where+ declareNamedSchema _ =+ pure (NamedSchema Nothing (toOpenApiSchema (Proxy @(EncodingSpec a))))+++{-|+ Helper for defining `ToSchema` instances based on `HasJsonDecodingSpec`+ using @deriving via@.+ + Example:++ > data MyType = ...+ > deriving ToSchema via (DecodingSchema MyType)+ > instance HasJsonDecodingSchema MyType where+ > ...+-}+newtype DecodingSchema a =+ DecodingSchema {unDecodingSchema :: a}+instance (Typeable a, Internal (DecodingSpec a)) => ToSchema (DecodingSchema a) where+ declareNamedSchema _ =+ pure (NamedSchema Nothing (toOpenApiSchema (Proxy @(DecodingSpec a))))+++{- | Shorthand for demoting type-level strings. -}+sym+ :: forall a b.+ ( IsString b+ , KnownSymbol a+ )+ => b+sym = fromString $ symbolVal (Proxy @a)++
+ test/test.hs view
@@ -0,0 +1,210 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++module Main (main) where++import Control.Lens (At(at), (&), set)+import Data.Aeson (FromJSON, ToJSON, encode)+import Data.JsonSpec (Field(Field), HasJsonDecodingSpec(DecodingSpec,+ fromJSONStructure), HasJsonEncodingSpec(EncodingSpec, toJSONStructure),+ SpecJSON(SpecJSON), Specification(JsonArray, JsonBool, JsonDateTime,+ JsonNum, JsonObject, JsonString))+import Data.JsonSpec.OpenApi (EncodingSchema, toOpenApiSchema)+import Data.OpenApi (ToSchema)+import Data.Proxy (Proxy(Proxy))+import Data.Text (Text)+import Data.Time (UTCTime)+import Test.Hspec (describe, hspec, it, shouldBe)+import qualified Data.OpenApi as OA+++main :: IO ()+main =+ hspec $ do+ describe "toOpenApiSchema" $ do+ it "string" $+ let+ actual :: OA.Schema+ actual =+ toOpenApiSchema (Proxy @JsonString)++ expected :: OA.Schema+ expected = stringSchema+ in+ actual `shouldBe` expected++ it "object" $+ let+ actual :: OA.Schema+ actual =+ toOpenApiSchema (Proxy @(+ JsonObject '[+ '("Foo", JsonString),+ '("Bar", JsonString)+ ]+ ))++ expected :: OA.Schema+ expected =+ mempty+ & set OA.type_ (Just OA.OpenApiObject)+ & set OA.properties (+ mempty+ & set (at "Foo") (Just (OA.Inline stringSchema))+ & set (at "Bar") (Just (OA.Inline stringSchema))+ )+ & set OA.required ["Foo", "Bar"]+ & set+ OA.additionalProperties+ (Just (OA.AdditionalPropertiesAllowed False))+ in+ actual `shouldBe` expected++ it "num" $+ let+ actual :: OA.Schema+ actual =+ toOpenApiSchema (Proxy @JsonNum)++ expected :: OA.Schema+ expected = numSchema+ in+ actual `shouldBe` expected++ it "complex array" $+ let+ actual :: OA.Schema+ actual =+ toOpenApiSchema (Proxy @(+ JsonArray (+ JsonObject '[+ '("Foo", JsonString),+ '("Bar", JsonString)+ ]+ )+ ))++ expected :: OA.Schema+ expected =+ let+ elementSchema :: OA.Schema+ elementSchema =+ mempty+ & set OA.type_ (Just OA.OpenApiObject)+ & set OA.properties (+ mempty+ & set (at "Foo") (Just (OA.Inline stringSchema))+ & set (at "Bar") (Just (OA.Inline stringSchema))+ )+ & set OA.required ["Foo", "Bar"]+ & set+ OA.additionalProperties+ (Just (OA.AdditionalPropertiesAllowed False))+ in+ mempty+ & set OA.type_ (Just OA.OpenApiArray)+ & set OA.items (Just (OA.OpenApiItemsObject (OA.Inline elementSchema)))++ in+ actual `shouldBe` expected++ it "bool" $+ let+ actual :: OA.Schema+ actual =+ toOpenApiSchema (Proxy @JsonBool)++ expected :: OA.Schema+ expected = boolSchema+ in+ actual `shouldBe` expected++ it "date-time" $+ let+ actual :: OA.Schema+ actual = + toOpenApiSchema (Proxy @JsonDateTime)++ expected :: OA.Schema+ expected =+ stringSchema+ & set OA.format (Just "date-time")+ in+ actual `shouldBe` expected+ describe "EncodingSpec" $+ it "works" $+ let+ actual :: OA.Schema+ actual = OA.toSchema (Proxy @User)++ expected :: OA.Schema+ expected =+ mempty+ & set OA.type_ (Just OA.OpenApiObject)+ & set OA.properties (+ mempty+ & set (at "name") (Just (OA.Inline stringSchema))+ & set (at "last-login") (Just (OA.Inline dateSchema))+ )+ & set OA.required ["name", "last-login"]+ & set+ OA.additionalProperties+ (Just (OA.AdditionalPropertiesAllowed False))++ in+ encode actual `shouldBe` encode expected+++data User = User+ { name :: Text+ , lastLogin :: UTCTime+ }+ deriving stock (Show, Eq)+ deriving ToSchema via (EncodingSchema User)+ deriving (ToJSON, FromJSON) via (SpecJSON User)+instance HasJsonEncodingSpec User where+ type EncodingSpec User =+ JsonObject+ '[ '("name", JsonString)+ , '("last-login", JsonDateTime)+ ]+ toJSONStructure user =+ (Field @"name" (name user),+ (Field @"last-login" (lastLogin user),+ ()))+instance HasJsonDecodingSpec User where+ type DecodingSpec User = EncodingSpec User+ fromJSONStructure+ (Field @"name" name,+ (Field @"last-login" lastLogin,+ ()))+ =+ pure User { name , lastLogin }+++stringSchema :: OA.Schema+stringSchema = mempty & set OA.type_ (Just OA.OpenApiString)+++numSchema :: OA.Schema+numSchema = mempty & set OA.type_ (Just OA.OpenApiNumber)+++boolSchema :: OA.Schema+boolSchema = mempty & set OA.type_ (Just OA.OpenApiBoolean)+++dateSchema :: OA.Schema+dateSchema =+ mempty+ & set OA.type_ (Just OA.OpenApiString)+ & set OA.format (Just "date-time")++