git.iko.soy/typeable/openapi3
on 2e25e83 help sign in
typeable/openapi3/src/Data/Swagger/Operation.hs
193 lines 7.3 kB history raw
1{-# LANGUAGE RankNTypes #-}
2-- |
3-- Module: Data.Swagger.Operation
4-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
5-- Stability: experimental
6--
7-- Helper traversals and functions for Swagger operations manipulations.
8-- These might be useful when you already have Swagger specification
9-- generated by something else.
10module Data.Swagger.Operation (
11 -- * Operation traversals
12 allOperations,
13 operationsOf,
15 -- * Manipulation
16 -- ** Tags
17 applyTags,
18 applyTagsFor,
20 -- ** Responses
21 setResponse,
22 setResponseWith,
23 setResponseFor,
24 setResponseForWith,
26 -- ** Paths
27 prependPath,
29 -- * Miscellaneous
30 declareResponse,
31) where
33import Prelude ()
34import Prelude.Compat
36import Control.Lens
37import Data.Data.Lens
38import Data.List.Compat
39import Data.Maybe (mapMaybe)
40import Data.Monoid
41import qualified Data.Set as Set
43import Data.Swagger.Declare
44import Data.Swagger.Internal
45import Data.Swagger.Lens
46import Data.Swagger.Schema
48import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
50-- $setup
51-- >>> import Data.Aeson
52-- >>> import Data.Proxy
53-- >>> import Data.Time
55-- | Prepend path piece to all operations of the spec.
56-- Leading and trailing slashes are trimmed/added automatically.
57--
58-- >>> let api = (mempty :: Swagger) & paths .~ [("/info", mempty)]
59-- >>> encode $ prependPath "user/{user_id}" api ^. paths
60-- "{\"/user/{user_id}/info\":{}}"
61prependPath :: FilePath -> Swagger -> Swagger
62prependPath path = paths %~ InsOrdHashMap.mapKeys (path </>)
63 where
64 x </> y = case trim y of
65 "" -> "/" <> trim x
66 y' -> "/" <> trim x <> "/" <> y'
68 trim = dropWhile (== '/') . dropWhileEnd (== '/')
70-- | All operations of a Swagger spec.
71allOperations :: Traversal' Swagger Operation
72allOperations = paths.traverse.template
74-- | @'operationsOf' sub@ will traverse only those operations
75-- that are present in @sub@. Note that @'Operation'@ is determined
76-- by both path and method.
77--
78-- >>> let ok = (mempty :: Operation) & at 200 ?~ "OK"
79-- >>> let api = (mempty :: Swagger) & paths .~ [("/user", mempty & get ?~ ok & post ?~ ok)]
80-- >>> let sub = (mempty :: Swagger) & paths .~ [("/user", mempty & get ?~ mempty)]
81-- >>> encode api
82-- "{\"swagger\":\"2.0\",\"info\":{\"version\":\"\",\"title\":\"\"},\"paths\":{\"/user\":{\"get\":{\"responses\":{\"200\":{\"description\":\"OK\"}}},\"post\":{\"responses\":{\"200\":{\"description\":\"OK\"}}}}}}"
83-- >>> encode $ api & operationsOf sub . at 404 ?~ "Not found"
84-- "{\"swagger\":\"2.0\",\"info\":{\"version\":\"\",\"title\":\"\"},\"paths\":{\"/user\":{\"get\":{\"responses\":{\"404\":{\"description\":\"Not found\"},\"200\":{\"description\":\"OK\"}}},\"post\":{\"responses\":{\"200\":{\"description\":\"OK\"}}}}}}"
85operationsOf :: Swagger -> Traversal' Swagger Operation
86operationsOf sub = paths.itraversed.withIndex.subops
87 where
88 -- | Traverse operations that correspond to paths and methods of the sub API.
89 subops :: Traversal' (FilePath, PathItem) Operation
90 subops f (path, item) = case InsOrdHashMap.lookup path (sub ^. paths) of
91 Just subitem -> (,) path <$> methodsOf subitem f item
92 Nothing -> pure (path, item)
94 -- | Traverse operations that exist in a given @'PathItem'@
95 -- This is used to traverse only the operations that exist in sub API.
96 methodsOf :: PathItem -> Traversal' PathItem Operation
97 methodsOf pathItem = partsOf template . itraversed . indices (`elem` ns) . _Just
98 where
99 ops = pathItem ^.. template :: [Maybe Operation]
100 ns = mapMaybe (fmap fst . sequenceA) $ zip [0..] ops
102-- | Apply tags to all operations and update the global list of tags.
103--
104-- @
105-- 'applyTags' = 'applyTagsFor' 'allOperations'
106-- @
107applyTags :: [Tag] -> Swagger -> Swagger
108applyTags = applyTagsFor allOperations
110-- | Apply tags to a part of Swagger spec and update the global
111-- list of tags.
112applyTagsFor :: Traversal' Swagger Operation -> [Tag] -> Swagger -> Swagger
113applyTagsFor ops ts swag = swag
114 & ops . tags %~ (<> Set.fromList (map _tagName ts))
115 & tags %~ (<> Set.fromList ts)
117-- | Construct a response with @'Schema'@ while declaring all
118-- necessary schema definitions.
119--
120-- >>> encode $ runDeclare (declareResponse (Proxy :: Proxy Day)) mempty
121-- "[{\"Day\":{\"example\":\"2016-07-22\",\"format\":\"date\",\"type\":\"string\"}},{\"description\":\"\",\"schema\":{\"$ref\":\"#/definitions/Day\"}}]"
122declareResponse :: ToSchema a => proxy a -> Declare (Definitions Schema) Response
123declareResponse proxy = do
124 s <- declareSchemaRef proxy
125 return (mempty & schema ?~ s)
127-- | Set response for all operations.
128-- This will also update global schema definitions.
129--
130-- If the response already exists it will be overwritten.
131--
132-- @
133-- 'setResponse' = 'setResponseFor' 'allOperations'
134-- @
135--
136-- Example:
137--
138-- >>> let api = (mempty :: Swagger) & paths .~ [("/user", mempty & get ?~ mempty)]
139-- >>> let res = declareResponse (Proxy :: Proxy Day)
140-- >>> encode $ api & setResponse 200 res
141-- "{\"swagger\":\"2.0\",\"info\":{\"version\":\"\",\"title\":\"\"},\"paths\":{\"/user\":{\"get\":{\"responses\":{\"200\":{\"schema\":{\"$ref\":\"#/definitions/Day\"},\"description\":\"\"}}}}},\"definitions\":{\"Day\":{\"example\":\"2016-07-22\",\"format\":\"date\",\"type\":\"string\"}}}"
142--
143-- See also @'setResponseWith'@.
144setResponse :: HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
145setResponse = setResponseFor allOperations
147-- | Set or update response for all operations.
148-- This will also update global schema definitions.
149--
150-- If the response already exists, but it can't be dereferenced (invalid @\$ref@),
151-- then just the new response is used.
152--
153-- @
154-- 'setResponseWith' = 'setResponseForWith' 'allOperations'
155-- @
156--
157-- See also @'setResponse'@.
158setResponseWith :: (Response -> Response -> Response) -> HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
159setResponseWith = setResponseForWith allOperations
161-- | Set response for specified operations.
162-- This will also update global schema definitions.
163--
164-- If the response already exists it will be overwritten.
165--
166-- See also @'setResponseForWith'@.
167setResponseFor :: Traversal' Swagger Operation -> HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
168setResponseFor ops code dres swag = swag
169 & definitions %~ (<> defs)
170 & ops . at code ?~ Inline res
171 where
172 (defs, res) = runDeclare dres mempty
174-- | Set or update response for specified operations.
175-- This will also update global schema definitions.
176--
177-- If the response already exists, but it can't be dereferenced (invalid @\$ref@),
178-- then just the new response is used.
179--
180-- See also @'setResponseFor'@.
181setResponseForWith :: Traversal' Swagger Operation -> (Response -> Response -> Response) -> HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
182setResponseForWith ops f code dres swag = swag
183 & definitions %~ (<> defs)
184 & ops . at code %~ Just . Inline . combine
185 where
186 (defs, new) = runDeclare dres mempty
188 combine (Just (Ref (Reference n))) = case swag ^. responses.at n of
189 Just old -> f old new
190 Nothing -> new -- response name can't be dereferenced, replacing with new response
191 combine (Just (Inline old)) = f old new
192 combine Nothing = new