@@ -0,0 +1,492 @@
1+{-# LANGUAGE CPP #-}
2+{-# LANGUAGE ConstraintKinds #-}
3+{-# LANGUAGE DataKinds #-}
4+{-# LANGUAGE FlexibleContexts #-}
5+{-# LANGUAGE FlexibleInstances #-}
6+{-# LANGUAGE OverloadedLists #-}
7+{-# LANGUAGE OverloadedStrings #-}
8+{-# LANGUAGE PolyKinds #-}
9+{-# LANGUAGE RankNTypes #-}
10+{-# LANGUAGE ScopedTypeVariables #-}
11+{-# LANGUAGE TypeOperators #-}
12+{-# LANGUAGE TypeFamilies #-}
13+#if __GLASGOW_HASKELL__ >= 806
14+{-# LANGUAGE UndecidableInstances #-}
15+#endif
16+module Servant.Swagger.Internal where
17+
18+import Prelude ()
19+import Prelude.Compat
20+
21+import Control.Applicative ((<|>))
22+import Control.Lens
23+import Data.Aeson
24+import Data.HashMap.Strict.InsOrd (InsOrdHashMap)
25+import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
26+import Data.Foldable (toList)
27+import Data.Proxy
28+import Data.Typeable
29+import Data.Singletons.Bool
30+import Data.Swagger hiding (Header)
31+import qualified Data.Swagger as Swagger
32+import Data.Swagger.Declare
33+import Data.Text (Text)
34+import qualified Data.Text as Text
35+import GHC.Generics (D1, Meta(..), Rep)
36+import GHC.TypeLits
37+import Network.HTTP.Media (MediaType)
38+import Servant.API
39+import Servant.API.Description (FoldDescription,
40+ reflectDescription)
41+import Servant.API.Generic (ToServantApi, AsApi)
42+import Servant.API.Modifiers (FoldRequired)
43+
44+import Servant.Swagger.Internal.TypeLevel.API
45+
46+-- | Generate a Swagger specification for a servant API.
47+--
48+-- To generate Swagger specification, your data types need
49+-- @'ToParamSchema'@ and/or @'ToSchema'@ instances.
50+--
51+-- @'ToParamSchema'@ is used for @'Capture'@, @'QueryParam'@ and @'Header'@.
52+-- @'ToSchema'@ is used for @'ReqBody'@ and response data types.
53+--
54+-- You can easily derive those instances via @Generic@.
55+-- For more information, refer to <http://hackage.haskell.org/package/swagger2/docs/Data-Swagger.html swagger2 documentation>.
56+--
57+-- Example:
58+--
59+-- @
60+-- newtype Username = Username String deriving (Generic, ToText)
61+--
62+-- instance ToParamSchema Username
63+--
64+-- data User = User
65+-- { username :: Username
66+-- , fullname :: String
67+-- } deriving (Generic)
68+--
69+-- instance ToJSON User
70+-- instance ToSchema User
71+--
72+-- type MyAPI = QueryParam "username" Username :> Get '[JSON] User
73+--
74+-- mySwagger :: Swagger
75+-- mySwagger = toSwagger (Proxy :: Proxy MyAPI)
76+-- @
77+class HasSwagger api where
78+ -- | Generate a Swagger specification for a servant API.
79+ toSwagger :: Proxy api -> Swagger
80+
81+instance HasSwagger Raw where
82+ toSwagger _ = mempty & paths . at "/" ?~ mempty
83+
84+instance HasSwagger EmptyAPI where
85+ toSwagger _ = mempty
86+
87+-- | All operations of sub API.
88+-- This is similar to @'operationsOf'@ but ensures that operations
89+-- indeed belong to the API at compile time.
90+subOperations :: (IsSubAPI sub api, HasSwagger sub) =>
91+ Proxy sub -- ^ Part of a servant API.
92+ -> Proxy api -- ^ The whole servant API.
93+ -> Traversal' Swagger Operation
94+subOperations sub _ = operationsOf (toSwagger sub)
95+
96+-- | Make a singleton Swagger spec (with only one endpoint).
97+-- For endpoints with no content see 'mkEndpointNoContent'.
98+mkEndpoint :: forall a cs hs proxy method status.
99+ (ToSchema a, AllAccept cs, AllToResponseHeader hs, SwaggerMethod method, KnownNat status)
100+ => FilePath -- ^ Endpoint path.
101+ -> proxy (Verb method status cs (Headers hs a)) -- ^ Method, content-types, headers and response.
102+ -> Swagger
103+mkEndpoint path proxy
104+ = mkEndpointWithSchemaRef (Just ref) path proxy
105+ & definitions .~ defs
106+ where
107+ (defs, ref) = runDeclare (declareSchemaRef (Proxy :: Proxy a)) mempty
108+
109+-- | Make a singletone 'Swagger' spec (with only one endpoint) and with no content schema.
110+mkEndpointNoContent :: forall nocontent cs hs proxy method status.
111+ (AllAccept cs, AllToResponseHeader hs, SwaggerMethod method, KnownNat status)
112+ => FilePath -- ^ Endpoint path.
113+ -> proxy (Verb method status cs (Headers hs nocontent)) -- ^ Method, content-types, headers and response.
114+ -> Swagger
115+mkEndpointNoContent path proxy
116+ = mkEndpointWithSchemaRef Nothing path proxy
117+
118+-- | Like @'mkEndpoint'@ but with explicit schema reference.
119+-- Unlike @'mkEndpoint'@ this function does not update @'definitions'@.
120+mkEndpointWithSchemaRef :: forall cs hs proxy method status a.
121+ (AllAccept cs, AllToResponseHeader hs, SwaggerMethod method, KnownNat status)
122+ => Maybe (Referenced Schema)
123+ -> FilePath
124+ -> proxy (Verb method status cs (Headers hs a))
125+ -> Swagger
126+mkEndpointWithSchemaRef mref path _ = mempty
127+ & paths.at path ?~
128+ (mempty & method ?~ (mempty
129+ & produces ?~ MimeList responseContentTypes
130+ & at code ?~ Inline (mempty
131+ & schema .~ mref
132+ & headers .~ responseHeaders)))
133+ where
134+ method = swaggerMethod (Proxy :: Proxy method)
135+ code = fromIntegral (natVal (Proxy :: Proxy status))
136+ responseContentTypes = allContentType (Proxy :: Proxy cs)
137+ responseHeaders = toAllResponseHeaders (Proxy :: Proxy hs)
138+
139+mkEndpointNoContentVerb :: forall proxy method.
140+ (SwaggerMethod method)
141+ => FilePath -- ^ Endpoint path.
142+ -> proxy (NoContentVerb method) -- ^ Method
143+ -> Swagger
144+mkEndpointNoContentVerb path _ = mempty
145+ & paths.at path ?~
146+ (mempty & method ?~ (mempty
147+ & at code ?~ Inline mempty))
148+ where
149+ method = swaggerMethod (Proxy :: Proxy method)
150+ code = 204 -- hardcoded in servant-server
151+
152+-- | Add parameter to every operation in the spec.
153+addParam :: Param -> Swagger -> Swagger
154+addParam param = allOperations.parameters %~ (Inline param :)
155+
156+-- | Add a tag to every operation in the spec.
157+addTag :: Text -> Swagger -> Swagger
158+addTag tag = allOperations.tags %~ ([tag] <>)
159+
160+-- | Add accepted content types to every operation in the spec.
161+addConsumes :: [MediaType] -> Swagger -> Swagger
162+addConsumes cs = allOperations.consumes %~ (<> Just (MimeList cs))
163+
164+-- | Format given text as inline code in Markdown.
165+markdownCode :: Text -> Text
166+markdownCode s = "`" <> s <> "`"
167+
168+addDefaultResponse400 :: ParamName -> Swagger -> Swagger
169+addDefaultResponse400 pname = setResponseWith (\old _new -> alter400 old) 400 (return response400)
170+ where
171+ sname = markdownCode pname
172+ description400 = "Invalid " <> sname
173+ alter400 = description %~ (<> (" or " <> sname))
174+ response400 = mempty & description .~ description400
175+
176+-- | Methods, available for Swagger.
177+class SwaggerMethod method where
178+ swaggerMethod :: proxy method -> Lens' PathItem (Maybe Operation)
179+
180+instance SwaggerMethod 'GET where swaggerMethod _ = get
181+instance SwaggerMethod 'PUT where swaggerMethod _ = put
182+instance SwaggerMethod 'POST where swaggerMethod _ = post
183+instance SwaggerMethod 'DELETE where swaggerMethod _ = delete
184+instance SwaggerMethod 'OPTIONS where swaggerMethod _ = options
185+instance SwaggerMethod 'HEAD where swaggerMethod _ = head_
186+instance SwaggerMethod 'PATCH where swaggerMethod _ = patch
187+
188+instance HasSwagger (UVerb method cs '[]) where
189+ toSwagger _ = mempty
190+
191+-- | @since <TODO>
192+instance
193+ {-# OVERLAPPABLE #-}
194+ ( ToSchema a,
195+ HasStatus a,
196+ AllAccept cs,
197+ SwaggerMethod method,
198+ HasSwagger (UVerb method cs as)
199+ ) =>
200+ HasSwagger (UVerb method cs (a ': as))
201+ where
202+ toSwagger _ =
203+ toSwagger (Proxy :: Proxy (Verb method (StatusOf a) cs a))
204+ `combineSwagger` toSwagger (Proxy :: Proxy (UVerb method cs as))
205+
206+-- ATTENTION: do not remove this instance!
207+-- A similar instance above will always use the more general
208+-- polymorphic -- HasSwagger instance and will result in a type error
209+-- since 'NoContent' does not have a 'ToSchema' instance.
210+instance
211+ ( KnownNat status,
212+ AllAccept cs,
213+ SwaggerMethod method,
214+ HasSwagger (UVerb method cs as)
215+ ) =>
216+ HasSwagger (UVerb method cs (WithStatus status NoContent ': as))
217+ where
218+ toSwagger _ =
219+ toSwagger (Proxy :: Proxy (Verb method status cs NoContent))
220+ `combineSwagger` toSwagger (Proxy :: Proxy (UVerb method cs as))
221+
222+
223+-- workaround for https://github.com/GetShopTV/swagger2/issues/218
224+-- We'd like to juse use (<>) but the instances are wrong
225+combinePathItem :: PathItem -> PathItem -> PathItem
226+combinePathItem s t = PathItem
227+ { _pathItemGet = _pathItemGet s <> _pathItemGet t
228+ , _pathItemPut = _pathItemPut s <> _pathItemPut t
229+ , _pathItemPost = _pathItemPost s <> _pathItemPost t
230+ , _pathItemDelete = _pathItemDelete s <> _pathItemDelete t
231+ , _pathItemOptions = _pathItemOptions s <> _pathItemOptions t
232+ , _pathItemHead = _pathItemHead s <> _pathItemHead t
233+ , _pathItemPatch = _pathItemPatch s <> _pathItemPatch t
234+ , _pathItemParameters = _pathItemParameters s <> _pathItemParameters t
235+ }
236+
237+combineSwagger :: Swagger -> Swagger -> Swagger
238+combineSwagger s t = Swagger
239+ { _swaggerInfo = _swaggerInfo s <> _swaggerInfo t
240+ , _swaggerHost = _swaggerHost s <|> _swaggerHost t
241+ , _swaggerBasePath = _swaggerBasePath s <|> _swaggerBasePath t
242+ , _swaggerSchemes = _swaggerSchemes s <> _swaggerSchemes t
243+ , _swaggerConsumes = _swaggerConsumes s <> _swaggerConsumes t
244+ , _swaggerProduces = _swaggerProduces s <> _swaggerProduces t
245+ , _swaggerPaths = InsOrdHashMap.unionWith combinePathItem (_swaggerPaths s) (_swaggerPaths t)
246+ , _swaggerDefinitions = _swaggerDefinitions s <> _swaggerDefinitions t
247+ , _swaggerParameters = _swaggerParameters s <> _swaggerParameters t
248+ , _swaggerResponses = _swaggerResponses s <> _swaggerResponses t
249+ , _swaggerSecurityDefinitions = _swaggerSecurityDefinitions s <> _swaggerSecurityDefinitions t
250+ , _swaggerSecurity = _swaggerSecurity s <> _swaggerSecurity t
251+ , _swaggerTags = _swaggerTags s <> _swaggerTags t
252+ , _swaggerExternalDocs = _swaggerExternalDocs s <|> _swaggerExternalDocs t
253+ }
254+
255+instance {-# OVERLAPPABLE #-} (ToSchema a, AllAccept cs, KnownNat status, SwaggerMethod method) => HasSwagger (Verb method status cs a) where
256+ toSwagger _ = toSwagger (Proxy :: Proxy (Verb method status cs (Headers '[] a)))
257+
258+-- | @since 1.1.7
259+instance (ToSchema a, Accept ct, KnownNat status, SwaggerMethod method) => HasSwagger (Stream method status fr ct a) where
260+ toSwagger _ = toSwagger (Proxy :: Proxy (Verb method status '[ct] (Headers '[] a)))
261+
262+instance {-# OVERLAPPABLE #-} (ToSchema a, AllAccept cs, AllToResponseHeader hs, KnownNat status, SwaggerMethod method)
263+ => HasSwagger (Verb method status cs (Headers hs a)) where
264+ toSwagger = mkEndpoint "/"
265+
266+-- ATTENTION: do not remove this instance!
267+-- A similar instance above will always use the more general
268+-- polymorphic -- HasSwagger instance and will result in a type error
269+-- since 'NoContent' does not have a 'ToSchema' instance.
270+instance (AllAccept cs, KnownNat status, SwaggerMethod method) => HasSwagger (Verb method status cs NoContent) where
271+ toSwagger _ = toSwagger (Proxy :: Proxy (Verb method status cs (Headers '[] NoContent)))
272+
273+instance (AllAccept cs, AllToResponseHeader hs, KnownNat status, SwaggerMethod method)
274+ => HasSwagger (Verb method status cs (Headers hs NoContent)) where
275+ toSwagger = mkEndpointNoContent "/"
276+
277+instance (SwaggerMethod method) => HasSwagger (NoContentVerb method) where
278+ toSwagger = mkEndpointNoContentVerb "/"
279+
280+instance (HasSwagger a, HasSwagger b) => HasSwagger (a :<|> b) where
281+ toSwagger _ = toSwagger (Proxy :: Proxy a) <> toSwagger (Proxy :: Proxy b)
282+
283+-- | @'Vault'@ combinator does not change our specification at all.
284+instance (HasSwagger sub) => HasSwagger (Vault :> sub) where
285+ toSwagger _ = toSwagger (Proxy :: Proxy sub)
286+
287+-- | @'IsSecure'@ combinator does not change our specification at all.
288+instance (HasSwagger sub) => HasSwagger (IsSecure :> sub) where
289+ toSwagger _ = toSwagger (Proxy :: Proxy sub)
290+
291+-- | @'RemoteHost'@ combinator does not change our specification at all.
292+instance (HasSwagger sub) => HasSwagger (RemoteHost :> sub) where
293+ toSwagger _ = toSwagger (Proxy :: Proxy sub)
294+
295+-- | @'Fragment'@ combinator does not change our specification at all.
296+instance HasSwagger sub => HasSwagger (Fragment a :> sub) where
297+ toSwagger _ = toSwagger (Proxy :: Proxy sub)
298+
299+-- | @'HttpVersion'@ combinator does not change our specification at all.
300+instance (HasSwagger sub) => HasSwagger (HttpVersion :> sub) where
301+ toSwagger _ = toSwagger (Proxy :: Proxy sub)
302+
303+-- | @'WithNamedContext'@ combinator does not change our specification at all.
304+instance (HasSwagger sub) => HasSwagger (WithNamedContext x c sub) where
305+ toSwagger _ = toSwagger (Proxy :: Proxy sub)
306+
307+-- | @'WithResource'@ combinator does not change our specification at all.
308+instance (HasSwagger sub) => HasSwagger (WithResource res :> sub) where
309+ toSwagger _ = toSwagger (Proxy :: Proxy sub)
310+
311+instance (KnownSymbol sym, HasSwagger sub) => HasSwagger (sym :> sub) where
312+ toSwagger _ = prependPath piece (toSwagger (Proxy :: Proxy sub))
313+ where
314+ piece = symbolVal (Proxy :: Proxy sym)
315+
316+instance (KnownSymbol sym, Typeable a, ToParamSchema a, HasSwagger sub, KnownSymbol (FoldDescription mods)) => HasSwagger (Capture' mods sym a :> sub) where
317+ toSwagger _ = toSwagger (Proxy :: Proxy sub)
318+ & addParam param
319+ & prependPath capture
320+ & addDefaultResponse400 tname
321+ where
322+ symbol = symbolVal (Proxy :: Proxy sym)
323+ pname = if symbol == ""
324+ then camelTo2 '-' . tyConName . typeRepTyCon $ typeRep (Proxy :: Proxy a)
325+ else symbol
326+ tname = Text.pack pname
327+ transDesc "" = Nothing
328+ transDesc desc = Just (Text.pack desc)
329+ capture = "{" <> pname <> "}"
330+ param = mempty
331+ & name .~ tname
332+ & description .~ transDesc (reflectDescription (Proxy :: Proxy mods))
333+ & required ?~ True
334+ & schema .~ ParamOther (mempty
335+ & in_ .~ ParamPath
336+ & paramSchema .~ toParamSchema (Proxy :: Proxy a))
337+
338+-- | Swagger Spec doesn't have a notion of CaptureAll, this instance is the best effort.
339+instance (KnownSymbol sym, Typeable a, ToParamSchema a, HasSwagger sub) => HasSwagger (CaptureAll sym a :> sub) where
340+ toSwagger _ = toSwagger (Proxy :: Proxy (Capture sym a :> sub))
341+
342+instance (KnownSymbol desc, HasSwagger api) => HasSwagger (Description desc :> api) where
343+ toSwagger _ = toSwagger (Proxy :: Proxy api)
344+ & allOperations.description %~ (Just (Text.pack (symbolVal (Proxy :: Proxy desc))) <>)
345+
346+instance (KnownSymbol desc, HasSwagger api) => HasSwagger (Summary desc :> api) where
347+ toSwagger _ = toSwagger (Proxy :: Proxy api)
348+ & allOperations.summary %~ (Just (Text.pack (symbolVal (Proxy :: Proxy desc))) <>)
349+
350+instance (KnownSymbol sym, ToParamSchema a, HasSwagger sub, SBoolI (FoldRequired mods), KnownSymbol (FoldDescription mods)) => HasSwagger (QueryParam' mods sym a :> sub) where
351+ toSwagger _ = toSwagger (Proxy :: Proxy sub)
352+ & addParam param
353+ & addDefaultResponse400 tname
354+ where
355+ tname = Text.pack (symbolVal (Proxy :: Proxy sym))
356+ transDesc "" = Nothing
357+ transDesc desc = Just (Text.pack desc)
358+ param = mempty
359+ & name .~ tname
360+ & description .~ transDesc (reflectDescription (Proxy :: Proxy mods))
361+ & required ?~ reflectBool (Proxy :: Proxy (FoldRequired mods))
362+ & schema .~ ParamOther sch
363+ sch = mempty
364+ & in_ .~ ParamQuery
365+ & paramSchema .~ toParamSchema (Proxy :: Proxy a)
366+
367+instance (KnownSymbol sym, ToParamSchema a, HasSwagger sub) => HasSwagger (QueryParams sym a :> sub) where
368+ toSwagger _ = toSwagger (Proxy :: Proxy sub)
369+ & addParam param
370+ & addDefaultResponse400 tname
371+ where
372+ tname = Text.pack (symbolVal (Proxy :: Proxy sym))
373+ param = mempty
374+ & name .~ tname
375+ & schema .~ ParamOther sch
376+ sch = mempty
377+ & in_ .~ ParamQuery
378+ & paramSchema .~ pschema
379+ pschema = mempty
380+#if MIN_VERSION_swagger2(2,4,0)
381+ & type_ ?~ SwaggerArray
382+#else
383+ & type_ .~ SwaggerArray
384+#endif
385+ & items ?~ SwaggerItemsPrimitive (Just CollectionMulti) (toParamSchema (Proxy :: Proxy a))
386+
387+instance (KnownSymbol sym, HasSwagger sub) => HasSwagger (QueryFlag sym :> sub) where
388+ toSwagger _ = toSwagger (Proxy :: Proxy sub)
389+ & addParam param
390+ & addDefaultResponse400 tname
391+ where
392+ tname = Text.pack (symbolVal (Proxy :: Proxy sym))
393+ param = mempty
394+ & name .~ tname
395+ & schema .~ ParamOther (mempty
396+ & in_ .~ ParamQuery
397+ & allowEmptyValue ?~ True
398+ & paramSchema .~ (toParamSchema (Proxy :: Proxy Bool)
399+ & default_ ?~ toJSON False))
400+
401+instance (KnownSymbol sym, ToParamSchema a, HasSwagger sub, SBoolI (FoldRequired mods), KnownSymbol (FoldDescription mods)) => HasSwagger (Header' mods sym a :> sub) where
402+ toSwagger _ = toSwagger (Proxy :: Proxy sub)
403+ & addParam param
404+ & addDefaultResponse400 tname
405+ where
406+ tname = Text.pack (symbolVal (Proxy :: Proxy sym))
407+ transDesc "" = Nothing
408+ transDesc desc = Just (Text.pack desc)
409+ param = mempty
410+ & name .~ tname
411+ & description .~ transDesc (reflectDescription (Proxy :: Proxy mods))
412+ & required ?~ reflectBool (Proxy :: Proxy (FoldRequired mods))
413+ & schema .~ ParamOther (mempty
414+ & in_ .~ ParamHeader
415+ & paramSchema .~ toParamSchema (Proxy :: Proxy a))
416+
417+instance (ToSchema a, AllAccept cs, HasSwagger sub, KnownSymbol (FoldDescription mods)) => HasSwagger (ReqBody' mods cs a :> sub) where
418+ toSwagger _ = toSwagger (Proxy :: Proxy sub)
419+ & addParam param
420+ & addConsumes (allContentType (Proxy :: Proxy cs))
421+ & addDefaultResponse400 tname
422+ & definitions %~ (<> defs)
423+ where
424+ tname = "body"
425+ transDesc "" = Nothing
426+ transDesc desc = Just (Text.pack desc)
427+ (defs, ref) = runDeclare (declareSchemaRef (Proxy :: Proxy a)) mempty
428+ param = mempty
429+ & name .~ tname
430+ & description .~ transDesc (reflectDescription (Proxy :: Proxy mods))
431+ & required ?~ True
432+ & schema .~ ParamBody ref
433+
434+-- | This instance is an approximation.
435+--
436+-- @since 1.1.7
437+instance (ToSchema a, Accept ct, HasSwagger sub, KnownSymbol (FoldDescription mods)) => HasSwagger (StreamBody' mods fr ct a :> sub) where
438+ toSwagger _ = toSwagger (Proxy :: Proxy sub)
439+ & addParam param
440+ & addConsumes (toList (contentTypes (Proxy :: Proxy ct)))
441+ & addDefaultResponse400 tname
442+ & definitions %~ (<> defs)
443+ where
444+ tname = "body"
445+ transDesc "" = Nothing
446+ transDesc desc = Just (Text.pack desc)
447+ (defs, ref) = runDeclare (declareSchemaRef (Proxy :: Proxy a)) mempty
448+ param = mempty
449+ & name .~ tname
450+ & description .~ transDesc (reflectDescription (Proxy :: Proxy mods))
451+ & required ?~ True
452+ & schema .~ ParamBody ref
453+
454+instance (HasSwagger (ToServantApi routes), KnownSymbol datatypeName, Rep (routes AsApi) ~ D1 ('MetaData datatypeName moduleName packageName isNewtype) f) => HasSwagger (NamedRoutes routes) where
455+ toSwagger _ = addTag (Text.pack $ symbolVal (Proxy :: Proxy datatypeName)) (toSwagger (Proxy :: Proxy (ToServantApi routes)))
456+
457+-- =======================================================================
458+-- Below are the definitions that should be in Servant.API.ContentTypes
459+-- =======================================================================
460+
461+class AllAccept cs where
462+ allContentType :: Proxy cs -> [MediaType]
463+
464+instance AllAccept '[] where
465+ allContentType _ = []
466+
467+instance (Accept c, AllAccept cs) => AllAccept (c ': cs) where
468+ allContentType _ = contentType (Proxy :: Proxy c) : allContentType (Proxy :: Proxy cs)
469+
470+class ToResponseHeader h where
471+ toResponseHeader :: Proxy h -> (HeaderName, Swagger.Header)
472+
473+instance (KnownSymbol sym, ToParamSchema a) => ToResponseHeader (Header sym a) where
474+ toResponseHeader _ = (hname, Swagger.Header Nothing hschema)
475+ where
476+ hname = Text.pack (symbolVal (Proxy :: Proxy sym))
477+ hschema = toParamSchema (Proxy :: Proxy a)
478+
479+class AllToResponseHeader hs where
480+ toAllResponseHeaders :: Proxy hs -> InsOrdHashMap HeaderName Swagger.Header
481+
482+instance AllToResponseHeader '[] where
483+ toAllResponseHeaders _ = mempty
484+
485+instance (ToResponseHeader h, AllToResponseHeader hs) => AllToResponseHeader (h ': hs) where
486+ toAllResponseHeaders _ = InsOrdHashMap.insert headerName headerBS hdrs
487+ where
488+ (headerName, headerBS) = toResponseHeader (Proxy :: Proxy h)
489+ hdrs = toAllResponseHeaders (Proxy :: Proxy hs)
490+
491+instance AllToResponseHeader hs => AllToResponseHeader (HList hs) where
492+ toAllResponseHeaders _ = toAllResponseHeaders (Proxy :: Proxy hs)