git.iko.soy/typeable/openapi3
on d695efe help sign in
6 files changed+95−15
since splitsnapshots
unifiedsplit
openapi3.cabal+5−5 src/Data/OpenApi.hs+3 src/Data/OpenApi/Internal.hs+36−5 src/Data/OpenApi/Internal/AesonUtils.hs+28−3 test/Data/OpenApiSpec.hs+12−2 test/SpecCommon.hs+11
openapi3.cabal+5−5
@@ -66,21 +66,20 @@ library
6666
6767 build-depends:
6868 mtl >=2.2.2 && <2.3
69− , text >=1.2.3.1 && <1.3
69+ , text >=1.2.3.0 && <1.3
7070
7171 -- other dependencies
7272 build-depends:
73− base-compat-batteries >=0.11.1 && <0.12
73+ base-compat-batteries >=0.10.5 && <0.12
7474 , aeson >=1.4.2.0 && <1.6
7575 , aeson-pretty >=0.8.7 && <0.9
7676 -- cookie 0.4.3 is needed by GHC 7.8 due to time>=1.4 constraint
7777 , cookie >=0.4.3 && <0.5
78− , generics-sop >=0.5.1.0 && <0.6
78+ , generics-sop >=0.4.0.1 && <0.6
7979 , 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
8181 , insert-ordered-containers >=0.2.3 && <0.3
8282 , lens >=4.16.1 && <4.20
83− , network >=2.6.3.5 && <3.2
8483 , optics-core >=0.2 && <0.4
8584 , optics-th >=0.2 && <0.4
8685 , scientific >=0.3.6.2 && <0.4
@@ -88,6 +87,7 @@ library
8887 , uuid-types >=1.0.3 && <1.1
8988 , vector >=0.12.0.1 && <0.13
9089 , QuickCheck >=2.10.1 && <2.15
90+ , generic-arbitrary >=0.1 && <0.2
9191
9292 default-language: Haskell2010
9393
src/Data/OpenApi.hs+3
@@ -94,6 +94,9 @@ module Data.OpenApi (
9494 SecurityDefinitions(..),
9595 SecurityRequirement(..),
9696
97+ -- ** Http Scheme
98+ HttpScheme(..),
99+
97100 -- *** API key
98101 ApiKeyParams(..),
99102 ApiKeyLocation(..),
src/Data/OpenApi/Internal.hs+36−5
@@ -39,8 +39,8 @@ import Data.Text.Encoding (encodeUtf8)
3939import GHC.Generics (Generic)
4040import Network.HTTP.Media (MediaType, mainType, parameters, parseAccept, subType, (//),
4141 (/:))
42−import Network.Socket (HostName, PortNumber)
4342import Text.Read (readMaybe)
43+import Test.QuickCheck.Arbitrary.Generic
4444
4545import Data.HashMap.Strict.InsOrd (InsOrdHashMap)
4646import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
@@ -774,6 +774,20 @@ data Header = Header
774774 , _headerSchema :: Maybe (Referenced Schema)
775775 } deriving (Eq, Show, Generic, Data, Typeable)
776776
777+-- | According to RFC7235
778+data HttpScheme
779+ = Basic
780+ | Bearer
781+ | Digest
782+ | HOBA
783+ | Mutual
784+ | Negotiate
785+ | OAuth
786+ | SCRAM_SHA_1
787+ | SCRAM_SHA_256
788+ | Vapid
789+ deriving (Eq, Show, Generic, Data, Typeable)
790+
777791-- | The location of the API key.
778792data ApiKeyLocation
779793 = ApiKeyQuery
@@ -839,7 +853,7 @@ data OAuth2Flows = OAuth2Flows
839853 } deriving (Eq, Show, Generic, Data, Typeable)
840854
841855data SecuritySchemeType
842− = SecuritySchemeHttp
856+ = SecuritySchemeHttp HttpScheme
843857 | SecuritySchemeApiKey ApiKeyParams
844858 | SecuritySchemeOAuth2 OAuth2Flows
845859 | SecuritySchemeOpenIdConnect URL
@@ -1127,6 +1141,13 @@ instance ToJSON License where
11271141instance ToJSON ServerVariable where
11281142 toJSON = genericToJSON (jsonPrefix "ServerVariable")
11291143
1144+instance ToJSON HttpScheme where
1145+ toJSON scheme = case scheme of
1146+ SCRAM_SHA_1 -> "SCRAM-SHA-1"
1147+ SCRAM_SHA_256 -> "SCRAM-SHA-256"
1148+ Vapid -> "vapid"
1149+ other -> genericToJSON defaultOptions other
1150+
11301151instance ToJSON ApiKeyLocation where
11311152 toJSON = genericToJSON (jsonPrefix "ApiKey")
11321153
@@ -1182,6 +1203,13 @@ instance FromJSON License where
11821203instance FromJSON ServerVariable where
11831204 parseJSON = genericParseJSON (jsonPrefix "ServerVariable")
11841205
1206+instance FromJSON HttpScheme where
1207+ parseJSON = withText "HttpScheme" $ \txt -> case txt of
1208+ "SCRAM-SHA-1" -> pure SCRAM_SHA_1
1209+ "SCRAM-SHA-256" -> pure SCRAM_SHA_256
1210+ "vapid" -> pure Vapid
1211+ _ -> genericParseJSON defaultOptions $ String txt
1212+
11851213instance FromJSON ApiKeyLocation where
11861214 parseJSON = genericParseJSON (jsonPrefix "ApiKey")
11871215
@@ -1229,8 +1257,8 @@ instance ToJSON OAuth2Flows where
12291257 toEncoding = sopSwaggerGenericToEncoding
12301258
12311259instance ToJSON SecuritySchemeType where
1232− toJSON SecuritySchemeHttp
1233− = object [ "type" .= ("http" :: Text) ]
1260+ toJSON (SecuritySchemeHttp scheme)
1261+ = object [ "type" .= ("http" :: Text), "scheme" .= toJSON scheme ]
12341262 toJSON (SecuritySchemeApiKey params)
12351263 = toJSON params
12361264 <+> object [ "type" .= ("apiKey" :: Text) ]
@@ -1379,7 +1407,7 @@ instance FromJSON SecuritySchemeType where
13791407 parseJSON js@(Object o) = do
13801408 (t :: Text) <- o .: "type"
13811409 case t of
1382− "http" -> pure SecuritySchemeHttp
1410+ "http" -> SecuritySchemeHttp <$> o .: "scheme"
13831411 "apiKey" -> SecuritySchemeApiKey <$> parseJSON js
13841412 "oauth2" -> SecuritySchemeOAuth2 <$> (o .: "flows")
13851413 "openIdConnect" -> SecuritySchemeOpenIdConnect <$> (o .: "openIdConnectUrl")
@@ -1550,3 +1578,6 @@ instance AesonDefaultValue MimeList where defaultValue = Just mempty
15501578instance AesonDefaultValue Info
15511579instance AesonDefaultValue ParamLocation
15521580instance AesonDefaultValue Link
1581+
1582+instance Arbitrary HttpScheme where
1583+ arbitrary = genericArbitrary
src/Data/OpenApi/Internal/AesonUtils.hs+28−3
@@ -1,3 +1,4 @@
1+{-# LANGUAGE CPP #-}
12{-# LANGUAGE DataKinds #-}
23{-# LANGUAGE FlexibleContexts #-}
34{-# LANGUAGE GADTs #-}
@@ -137,7 +138,15 @@ sopSwaggerGenericToJSON'
137138 -> DatatypeInfo '[xs]
138139 -> POP Maybe '[xs]
139140 -> [Pair]
140−sopSwaggerGenericToJSON' opts (SOP (Z fields)) (ADT _ _ (Record _ fieldsInfo :* Nil) _) (POP (defs :* Nil)) =
141+sopSwaggerGenericToJSON'
142+ opts
143+ (SOP (Z fields))
144+#if MIN_VERSION_generics_sop(0,5,0)
145+ (ADT _ _ (Record _ fieldsInfo :* Nil) _)
146+#else
147+ (ADT _ _ (Record _ fieldsInfo :* Nil))
148+#endif
149+ (POP (defs :* Nil)) =
141150 sopSwaggerGenericToJSON'' opts fields fieldsInfo defs
142151sopSwaggerGenericToJSON' _ _ _ _ = error "sopSwaggerGenericToJSON: unsupported type"
143152
@@ -210,7 +219,15 @@ sopSwaggerGenericParseJSON'
210219 -> DatatypeInfo '[xs]
211220 -> POP Maybe '[xs]
212221 -> 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)) =
214231 SOP . Z <$> sopSwaggerGenericParseJSON'' opts obj fieldsInfo defs
215232sopSwaggerGenericParseJSON' _ _ _ _ = error "sopSwaggerGenericParseJSON: unsupported type"
216233
@@ -277,7 +294,15 @@ sopSwaggerGenericToEncoding'
277294 -> DatatypeInfo '[xs]
278295 -> POP Maybe '[xs]
279296 -> 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)) =
281306 sopSwaggerGenericToEncoding'' opts fields fieldsInfo defs
282307sopSwaggerGenericToEncoding' _ _ _ _ = error "sopSwaggerGenericToEncoding: unsupported type"
283308
test/Data/OpenApiSpec.hs+12−2
@@ -13,9 +13,11 @@ import Data.Aeson
1313import Data.Aeson.QQ.Simple
1414import Data.HashMap.Strict (HashMap)
1515import qualified Data.HashSet.InsOrd as InsOrdHS
16+import Data.Proxy
1617import Data.Text (Text)
1718
1819import Data.OpenApi
20+import Data.OpenApi.Internal
1921import SpecCommon
2022import Test.Hspec hiding (example)
2123
@@ -45,6 +47,7 @@ spec = do
4547 fromJSON petstoreExampleJSON `shouldSatisfy` (\x -> case x of Success (_ :: OpenApi) -> True; _ -> False)
4648 it "roundtrips: fmap toJSON . fromJSON" $ do
4749 (toJSON :: OpenApi -> Value) <$> fromJSON petstoreExampleJSON `shouldBe` Success petstoreExampleJSON
50+ testJsonIdempotency (Proxy :: Proxy HttpScheme)
4851
4952main :: IO ()
5053main = hspec spec
@@ -456,7 +459,10 @@ securityDefinitionsExample = SecurityDefinitions
456459 , _oAuth2Scopes =
457460 [ ("write:pets", "modify pets in your account")
458461 , ("read:pets", "read your pets") ] } )
459− , _securitySchemeDescription = Nothing }) ]
462+ , _securitySchemeDescription = Nothing })
463+ , ("basic", SecurityScheme
464+ { _securitySchemeType = SecuritySchemeHttp Basic
465+ , _securitySchemeDescription = Nothing })]
460466
461467securityDefinitionsExampleJSON :: Value
462468securityDefinitionsExampleJSON = [aesonQQ|
@@ -477,7 +483,11 @@ securityDefinitionsExampleJSON = [aesonQQ|
477483 "authorizationUrl": "http://swagger.io/api/oauth/dialog"
478484 }
479485 }
480− }
486+ },
487+ "basic": {
488+ "type": "http",
489+ "scheme": "Basic"
490+ }
481491}
482492
483493|]
test/SpecCommon.hs+11
@@ -4,9 +4,12 @@ import Data.Aeson
44import Data.ByteString.Builder (toLazyByteString)
55import qualified Data.Foldable as F
66import qualified Data.HashMap.Strict as HashMap
7+import Data.Proxy
8+import Data.Typeable
79import qualified Data.Vector as Vector
810
911import Test.Hspec
12+import Test.QuickCheck (Arbitrary, property)
1013
1114isSubJSON :: Value -> Value -> Bool
1215isSubJSON Null _ = True
@@ -28,3 +31,11 @@ x <=> js = do
2831 eitherDecode (encode $ toJSON x) `shouldBe` Right x
2932 it "roundtrips with toEncoding" $ do
3033 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