master...8a4e66c · typeable/openapi3

git.iko.soy/typeable/openapi3

on 8a4e66c help sign in

openapi3.cabal+5−5

since splitsnapshots

unifiedsplit

@@ -66,21 +66,20 @@ library

67 build-depends:

68 mtl >=2.2.2 && <2.3

69− , text >=1.2.3.1 && <1.3

69+ , text >=1.2.3.0 && <1.3

71 -- other dependencies

72 build-depends:

73− base-compat-batteries >=0.11.1 && <0.12

73+ base-compat-batteries >=0.10.5 && <0.12

74 , aeson >=1.4.2.0 && <1.6

75 , aeson-pretty >=0.8.7 && <0.9

76 -- cookie 0.4.3 is needed by GHC 7.8 due to time>=1.4 constraint

77 , cookie >=0.4.3 && <0.5

78− , generics-sop >=0.5.1.0 && <0.6

78+ , generics-sop >=0.4.0.1 && <0.6

79 , hashable >=1.2.7.0 && <1.4

80− , http-media >=0.8.0.0 && <0.9

80+ , http-media >=0.7.1.3 && <0.9

81 , insert-ordered-containers >=0.2.3 && <0.3

82 , lens >=4.16.1 && <4.20

83− , network >=2.6.3.5 && <3.2

84 , optics-core >=0.2 && <0.4

83 , optics-core >=0.2 && <0.4

85 , optics-th >=0.2 && <0.4

84 , optics-th >=0.2 && <0.4

86 , scientific >=0.3.6.2 && <0.4

85 , scientific >=0.3.6.2 && <0.4

@@ -88,6 +87,7 @@ library

88 , uuid-types >=1.0.3 && <1.1

87 , uuid-types >=1.0.3 && <1.1

89 , vector >=0.12.0.1 && <0.13

88 , vector >=0.12.0.1 && <0.13

90 , QuickCheck >=2.10.1 && <2.15

89 , QuickCheck >=2.10.1 && <2.15

90+ , generic-arbitrary >=0.1

92 default-language: Haskell2010

src/Data/OpenApi.hs+3

@@ -94,6 +94,9 @@ module Data.OpenApi (

94 SecurityDefinitions(..),

95 SecurityRequirement(..),

97+ -- ** Http Scheme

98+ HttpScheme(..),

99+

97 -- *** API key

100 -- *** API key

98 ApiKeyParams(..),

101 ApiKeyParams(..),

99 ApiKeyLocation(..),

102 ApiKeyLocation(..),

src/Data/OpenApi/Internal.hs+38−5

@@ -1,3 +1,5 @@

1+{-# OPTIONS_GHC -fconstraint-solver-iterations=5 #-}

1{-# LANGUAGE DataKinds #-}

3{-# LANGUAGE DataKinds #-}

2{-# LANGUAGE DeriveDataTypeable #-}

4{-# LANGUAGE DeriveDataTypeable #-}

3{-# LANGUAGE DeriveGeneric #-}

5{-# LANGUAGE DeriveGeneric #-}

@@ -39,8 +41,8 @@ import Data.Text.Encoding (encodeUtf8)

39import GHC.Generics (Generic)

41import GHC.Generics (Generic)

40import Network.HTTP.Media (MediaType, mainType, parameters, parseAccept, subType, (//),

42import Network.HTTP.Media (MediaType, mainType, parameters, parseAccept, subType, (//),

41 (/:))

43 (/:))

42−import Network.Socket (HostName, PortNumber)

43import Text.Read (readMaybe)

44import Text.Read (readMaybe)

45+import Test.QuickCheck.Arbitrary.Generic

45import Data.HashMap.Strict.InsOrd (InsOrdHashMap)

47import Data.HashMap.Strict.InsOrd (InsOrdHashMap)

46import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap

48import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap

@@ -774,6 +776,20 @@ data Header = Header

774 , _headerSchema :: Maybe (Referenced Schema)

776 , _headerSchema :: Maybe (Referenced Schema)

775 } deriving (Eq, Show, Generic, Data, Typeable)

777 } deriving (Eq, Show, Generic, Data, Typeable)

776

778

779+-- | According to RFC7235

780+data HttpScheme

781+ = Basic

782+ | Bearer

783+ | Digest

784+ | HOBA

785+ | Mutual

786+ | Negotiate

787+ | OAuth

788+ | SCRAM_SHA_1

789+ | SCRAM_SHA_256

790+ | Vapid

791+ deriving (Eq, Show, Generic, Data, Typeable)

792+

777-- | The location of the API key.

793-- | The location of the API key.

778data ApiKeyLocation

794data ApiKeyLocation

779 = ApiKeyQuery

795 = ApiKeyQuery

@@ -839,7 +855,7 @@ data OAuth2Flows = OAuth2Flows

839 } deriving (Eq, Show, Generic, Data, Typeable)

855 } deriving (Eq, Show, Generic, Data, Typeable)

840

856

841data SecuritySchemeType

857data SecuritySchemeType

842− = SecuritySchemeHttp

858+ = SecuritySchemeHttp HttpScheme

843 | SecuritySchemeApiKey ApiKeyParams

859 | SecuritySchemeApiKey ApiKeyParams

844 | SecuritySchemeOAuth2 OAuth2Flows

860 | SecuritySchemeOAuth2 OAuth2Flows

845 | SecuritySchemeOpenIdConnect URL

861 | SecuritySchemeOpenIdConnect URL

@@ -1127,6 +1143,13 @@ instance ToJSON License where

1127instance ToJSON ServerVariable where

1143instance ToJSON ServerVariable where

1128 toJSON = genericToJSON (jsonPrefix "ServerVariable")

1144 toJSON = genericToJSON (jsonPrefix "ServerVariable")

1129

1145

1146+instance ToJSON HttpScheme where

1147+ toJSON scheme = case scheme of

1148+ SCRAM_SHA_1 -> "SCRAM-SHA-1"

1149+ SCRAM_SHA_256 -> "SCRAM-SHA-256"

1150+ Vapid -> "vapid"

1151+ other -> genericToJSON defaultOptions other

1152+

1130instance ToJSON ApiKeyLocation where

1153instance ToJSON ApiKeyLocation where

1131 toJSON = genericToJSON (jsonPrefix "ApiKey")

1154 toJSON = genericToJSON (jsonPrefix "ApiKey")

1132

1155

@@ -1182,6 +1205,13 @@ instance FromJSON License where

1182instance FromJSON ServerVariable where

1205instance FromJSON ServerVariable where

1183 parseJSON = genericParseJSON (jsonPrefix "ServerVariable")

1206 parseJSON = genericParseJSON (jsonPrefix "ServerVariable")

1184

1207

1208+instance FromJSON HttpScheme where

1209+ parseJSON = withText "HttpScheme" $ \txt -> case txt of

1210+ "SCRAM-SHA-1" -> pure SCRAM_SHA_1

1211+ "SCRAM-SHA-256" -> pure SCRAM_SHA_256

1212+ "vapid" -> pure Vapid

1213+ _ -> genericParseJSON defaultOptions $ String txt

1214+

1185instance FromJSON ApiKeyLocation where

1215instance FromJSON ApiKeyLocation where

1186 parseJSON = genericParseJSON (jsonPrefix "ApiKey")

1216 parseJSON = genericParseJSON (jsonPrefix "ApiKey")

1187

1217

@@ -1229,8 +1259,8 @@ instance ToJSON OAuth2Flows where

1229 toEncoding = sopSwaggerGenericToEncoding

1259 toEncoding = sopSwaggerGenericToEncoding

1230

1260

1231instance ToJSON SecuritySchemeType where

1261instance ToJSON SecuritySchemeType where

1232− toJSON SecuritySchemeHttp

1262+ toJSON (SecuritySchemeHttp scheme)

1233− = object [ "type" .= ("http" :: Text) ]

1263+ = object [ "type" .= ("http" :: Text), "scheme" .= toJSON scheme ]

1234 toJSON (SecuritySchemeApiKey params)

1264 toJSON (SecuritySchemeApiKey params)

1235 = toJSON params

1265 = toJSON params

1236 <+> object [ "type" .= ("apiKey" :: Text) ]

1266 <+> object [ "type" .= ("apiKey" :: Text) ]

@@ -1379,7 +1409,7 @@ instance FromJSON SecuritySchemeType where

1379 parseJSON js@(Object o) = do

1409 parseJSON js@(Object o) = do

1380 (t :: Text) <- o .: "type"

1410 (t :: Text) <- o .: "type"

1381 case t of

1411 case t of

1382− "http" -> pure SecuritySchemeHttp

1412+ "http" -> SecuritySchemeHttp <$> o .: "scheme"

1383 "apiKey" -> SecuritySchemeApiKey <$> parseJSON js

1413 "apiKey" -> SecuritySchemeApiKey <$> parseJSON js

1384 "oauth2" -> SecuritySchemeOAuth2 <$> (o .: "flows")

1414 "oauth2" -> SecuritySchemeOAuth2 <$> (o .: "flows")

1385 "openIdConnect" -> SecuritySchemeOpenIdConnect <$> (o .: "openIdConnectUrl")

1415 "openIdConnect" -> SecuritySchemeOpenIdConnect <$> (o .: "openIdConnectUrl")

@@ -1550,3 +1580,6 @@ instance AesonDefaultValue MimeList where defaultValue = Just mempty

1550instance AesonDefaultValue Info

1580instance AesonDefaultValue Info

1551instance AesonDefaultValue ParamLocation

1581instance AesonDefaultValue ParamLocation

1552instance AesonDefaultValue Link

1582instance AesonDefaultValue Link

1583+

1584+instance Arbitrary HttpScheme where

1585+ arbitrary = genericArbitrary

src/Data/OpenApi/Internal/AesonUtils.hs+28−3

@@ -1,3 +1,4 @@

1+{-# LANGUAGE CPP #-}

1{-# LANGUAGE DataKinds #-}

2{-# LANGUAGE DataKinds #-}

2{-# LANGUAGE FlexibleContexts #-}

3{-# LANGUAGE FlexibleContexts #-}

3{-# LANGUAGE GADTs #-}

4{-# LANGUAGE GADTs #-}

@@ -137,7 +138,15 @@ sopSwaggerGenericToJSON'

137 -> DatatypeInfo '[xs]

138 -> DatatypeInfo '[xs]

138 -> POP Maybe '[xs]

139 -> POP Maybe '[xs]

139 -> [Pair]

140 -> [Pair]

141+sopSwaggerGenericToJSON'

142+ opts

143+ (SOP (Z fields))

144+#if MIN_VERSION_generics_sop(0,5,0)

140−sopSwaggerGenericToJSON' opts (SOP (Z fields)) (ADT _ _ (Record _ fieldsInfo :* Nil) _) (POP (defs :* Nil)) =

145+ (ADT _ _ (Record _ fieldsInfo :* Nil) _)

146+#else

147+ (ADT _ _ (Record _ fieldsInfo :* Nil))

148+#endif

149+ (POP (defs :* Nil)) =

141 sopSwaggerGenericToJSON'' opts fields fieldsInfo defs

150 sopSwaggerGenericToJSON'' opts fields fieldsInfo defs

142sopSwaggerGenericToJSON' _ _ _ _ = error "sopSwaggerGenericToJSON: unsupported type"

151sopSwaggerGenericToJSON' _ _ _ _ = error "sopSwaggerGenericToJSON: unsupported type"

143

152

@@ -210,7 +219,15 @@ sopSwaggerGenericParseJSON'

210 -> DatatypeInfo '[xs]

219 -> DatatypeInfo '[xs]

211 -> POP Maybe '[xs]

220 -> POP Maybe '[xs]

212 -> Parser (SOP I '[xs])

221 -> Parser (SOP I '[xs])

213−sopSwaggerGenericParseJSON' opts obj (ADT _ _ (Record _ fieldsInfo :* Nil) _) (POP (defs :* Nil)) =

222+sopSwaggerGenericParseJSON'

223+ opts

224+ obj

225+#if MIN_VERSION_generics_sop(0,5,0)

226+ (ADT _ _ (Record _ fieldsInfo :* Nil) _)

227+#else

228+ (ADT _ _ (Record _ fieldsInfo :* Nil))

229+#endif

230+ (POP (defs :* Nil)) =

214 SOP . Z <$> sopSwaggerGenericParseJSON'' opts obj fieldsInfo defs

231 SOP . Z <$> sopSwaggerGenericParseJSON'' opts obj fieldsInfo defs

215sopSwaggerGenericParseJSON' _ _ _ _ = error "sopSwaggerGenericParseJSON: unsupported type"

232sopSwaggerGenericParseJSON' _ _ _ _ = error "sopSwaggerGenericParseJSON: unsupported type"

216

233

@@ -277,7 +294,15 @@ sopSwaggerGenericToEncoding'

277 -> DatatypeInfo '[xs]

294 -> DatatypeInfo '[xs]

278 -> POP Maybe '[xs]

295 -> POP Maybe '[xs]

279 -> Series

296 -> Series

280−sopSwaggerGenericToEncoding' opts (SOP (Z fields)) (ADT _ _ (Record _ fieldsInfo :* Nil) _) (POP (defs :* Nil)) =

297+sopSwaggerGenericToEncoding'

298+ opts

299+ (SOP (Z fields))

300+#if MIN_VERSION_generics_sop(0,5,0)

301+ (ADT _ _ (Record _ fieldsInfo :* Nil) _)

302+#else

303+ (ADT _ _ (Record _ fieldsInfo :* Nil))

304+#endif

305+ (POP (defs :* Nil)) =

281 sopSwaggerGenericToEncoding'' opts fields fieldsInfo defs

306 sopSwaggerGenericToEncoding'' opts fields fieldsInfo defs

282sopSwaggerGenericToEncoding' _ _ _ _ = error "sopSwaggerGenericToEncoding: unsupported type"

307sopSwaggerGenericToEncoding' _ _ _ _ = error "sopSwaggerGenericToEncoding: unsupported type"

283

308

src/Data/OpenApi/Internal/Schema/Validation.hs+2−1

@@ -25,6 +25,7 @@ module Data.OpenApi.Internal.Schema.Validation where

26import Prelude ()

27import Prelude.Compat

28+import Debug.Trace

29import Control.Applicative

30import Control.Applicative

30import Control.Lens hiding (allOf)

31import Control.Lens hiding (allOf)

@@ -472,7 +473,7 @@ validateSchemaType val = withSchema $ \sch ->

472 res <- forM variants $ \var ->

473 res <- forM variants $ \var ->

473 (True <$ validateWithSchemaRef var val) <|> (return False)

474 (True <$ validateWithSchemaRef var val) <|> (return False)

474 case length $ filter id res of

475 case length $ filter id res of

475− 0 -> invalid $ "Value not valid under any of 'oneOf' schemas: " ++ show val

476+ 0 -> traceShow (val, variants) $ invalid $ "Value not valid under any of 'oneOf' schemas: " ++ show val

476 1 -> valid

477 1 -> valid

477 _ -> invalid $ "Value matches more than one of 'oneOf' schemas: " ++ show val

478 _ -> invalid $ "Value matches more than one of 'oneOf' schemas: " ++ show val

478 (view allOf -> Just variants) -> do

479 (view allOf -> Just variants) -> do

test/Data/OpenApiSpec.hs+12−2

@@ -13,9 +13,11 @@ import Data.Aeson

13import Data.Aeson.QQ.Simple

14import Data.HashMap.Strict (HashMap)

15import qualified Data.HashSet.InsOrd as InsOrdHS

16+import Data.Proxy

16import Data.Text (Text)

17import Data.Text (Text)

18import Data.OpenApi

19import Data.OpenApi

20+import Data.OpenApi.Internal

19import SpecCommon

21import SpecCommon

20import Test.Hspec hiding (example)

22import Test.Hspec hiding (example)

@@ -45,6 +47,7 @@ spec = do

45 fromJSON petstoreExampleJSON `shouldSatisfy` (\x -> case x of Success (_ :: OpenApi) -> True; _ -> False)

47 fromJSON petstoreExampleJSON `shouldSatisfy` (\x -> case x of Success (_ :: OpenApi) -> True; _ -> False)

46 it "roundtrips: fmap toJSON . fromJSON" $ do

48 it "roundtrips: fmap toJSON . fromJSON" $ do

47 (toJSON :: OpenApi -> Value) <$> fromJSON petstoreExampleJSON `shouldBe` Success petstoreExampleJSON

49 (toJSON :: OpenApi -> Value) <$> fromJSON petstoreExampleJSON `shouldBe` Success petstoreExampleJSON

50+ testJsonIdempotency (Proxy :: Proxy HttpScheme)

49main :: IO ()

52main :: IO ()

50main = hspec spec

53main = hspec spec

@@ -456,7 +459,10 @@ securityDefinitionsExample = SecurityDefinitions

456 , _oAuth2Scopes =

459 , _oAuth2Scopes =

457 [ ("write:pets", "modify pets in your account")

460 [ ("write:pets", "modify pets in your account")

458 , ("read:pets", "read your pets") ] } )

461 , ("read:pets", "read your pets") ] } )

459− , _securitySchemeDescription = Nothing }) ]

462+ , _securitySchemeDescription = Nothing })

463+ , ("basic", SecurityScheme

464+ { _securitySchemeType = SecuritySchemeHttp Basic

465+ , _securitySchemeDescription = Nothing })]

460

466

461securityDefinitionsExampleJSON :: Value

467securityDefinitionsExampleJSON :: Value

462securityDefinitionsExampleJSON = [aesonQQ|

468securityDefinitionsExampleJSON = [aesonQQ|

@@ -477,7 +483,11 @@ securityDefinitionsExampleJSON = [aesonQQ|

477 "authorizationUrl": "http://swagger.io/api/oauth/dialog"

483 "authorizationUrl": "http://swagger.io/api/oauth/dialog"

478 }

484 }

479 }

485 }

480− }

486+ },

487+ "basic": {

488+ "type": "http",

489+ "scheme": "Basic"

490+ }

481}

491}

482

492

483|]

493|]

test/SpecCommon.hs+11

@@ -4,9 +4,12 @@ import Data.Aeson

4import Data.ByteString.Builder (toLazyByteString)

5import qualified Data.Foldable as F

6import qualified Data.HashMap.Strict as HashMap

7+import Data.Proxy

8+import Data.Typeable

7import qualified Data.Vector as Vector

9import qualified Data.Vector as Vector

9import Test.Hspec

11import Test.Hspec

12+import Test.QuickCheck (Arbitrary, property)

11isSubJSON :: Value -> Value -> Bool

14isSubJSON :: Value -> Value -> Bool

12isSubJSON Null _ = True

15isSubJSON Null _ = True

@@ -28,3 +31,11 @@ x <=> js = do

28 eitherDecode (encode $ toJSON x) `shouldBe` Right x

31 eitherDecode (encode $ toJSON x) `shouldBe` Right x

29 it "roundtrips with toEncoding" $ do

32 it "roundtrips with toEncoding" $ do

30 eitherDecode (toLazyByteString $ fromEncoding $ toEncoding x) `shouldBe` Right x

33 eitherDecode (toLazyByteString $ fromEncoding $ toEncoding x) `shouldBe` Right x

34+

35+testJsonIdempotency :: (Eq a, Show a, Arbitrary a, FromJSON a, ToJSON a, Typeable a, HasCallStack) =>

36+ Proxy a -> Spec

37+testJsonIdempotency px = describe (show ty) $ do

38+ it "roundtrips: decode . encode" $ property $ \x ->

39+ decode (encode x) == Just (x `asProxyTypeOf` px)

40+ where

41+ ty = typeOf $ undefined `asProxyTypeOf` px