git.iko.soy/typeable/openapi3
on 042c4eb help sign in
typeable/openapi3/src/Data/Swagger/Operation.hs
192 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 qualified Data.Set as Set
42import Data.Swagger.Declare
43import Data.Swagger.Internal
44import Data.Swagger.Lens
45import Data.Swagger.Schema
47import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
49-- $setup
50-- >>> import Data.Aeson
51-- >>> import Data.Proxy
52-- >>> import Data.Time
54-- | Prepend path piece to all operations of the spec.
55-- Leading and trailing slashes are trimmed/added automatically.
56--
57-- >>> let api = (mempty :: Swagger) & paths .~ [("/info", mempty)]
58-- >>> encode $ prependPath "user/{user_id}" api ^. paths
59-- "{\"/user/{user_id}/info\":{}}"
60prependPath :: FilePath -> Swagger -> Swagger
61prependPath path = paths %~ InsOrdHashMap.mapKeys (path </>)
62 where
63 x </> y = case trim y of
64 "" -> "/" <> trim x
65 y' -> "/" <> trim x <> "/" <> y'
67 trim = dropWhile (== '/') . dropWhileEnd (== '/')
69-- | All operations of a Swagger spec.
70allOperations :: Traversal' Swagger Operation
71allOperations = paths.traverse.template
73-- | @'operationsOf' sub@ will traverse only those operations
74-- that are present in @sub@. Note that @'Operation'@ is determined
75-- by both path and method.
76--
77-- >>> let ok = (mempty :: Operation) & at 200 ?~ "OK"
78-- >>> let api = (mempty :: Swagger) & paths .~ [("/user", mempty & get ?~ ok & post ?~ ok)]
79-- >>> let sub = (mempty :: Swagger) & paths .~ [("/user", mempty & get ?~ mempty)]
80-- >>> encode api
81-- "{\"swagger\":\"2.0\",\"info\":{\"version\":\"\",\"title\":\"\"},\"paths\":{\"/user\":{\"get\":{\"responses\":{\"200\":{\"description\":\"OK\"}}},\"post\":{\"responses\":{\"200\":{\"description\":\"OK\"}}}}}}"
82-- >>> encode $ api & operationsOf sub . at 404 ?~ "Not found"
83-- "{\"swagger\":\"2.0\",\"info\":{\"version\":\"\",\"title\":\"\"},\"paths\":{\"/user\":{\"get\":{\"responses\":{\"404\":{\"description\":\"Not found\"},\"200\":{\"description\":\"OK\"}}},\"post\":{\"responses\":{\"200\":{\"description\":\"OK\"}}}}}}"
84operationsOf :: Swagger -> Traversal' Swagger Operation
85operationsOf sub = paths.itraversed.withIndex.subops
86 where
87 -- | Traverse operations that correspond to paths and methods of the sub API.
88 subops :: Traversal' (FilePath, PathItem) Operation
89 subops f (path, item) = case InsOrdHashMap.lookup path (sub ^. paths) of
90 Just subitem -> (,) path <$> methodsOf subitem f item
91 Nothing -> pure (path, item)
93 -- | Traverse operations that exist in a given @'PathItem'@
94 -- This is used to traverse only the operations that exist in sub API.
95 methodsOf :: PathItem -> Traversal' PathItem Operation
96 methodsOf pathItem = partsOf template . itraversed . indices (`elem` ns) . _Just
97 where
98 ops = pathItem ^.. template :: [Maybe Operation]
99 ns = mapMaybe (fmap fst . sequenceA) $ zip [0..] ops
101-- | Apply tags to all operations and update the global list of tags.
102--
103-- @
104-- 'applyTags' = 'applyTagsFor' 'allOperations'
105-- @
106applyTags :: [Tag] -> Swagger -> Swagger
107applyTags = applyTagsFor allOperations
109-- | Apply tags to a part of Swagger spec and update the global
110-- list of tags.
111applyTagsFor :: Traversal' Swagger Operation -> [Tag] -> Swagger -> Swagger
112applyTagsFor ops ts swag = swag
113 & ops . tags %~ (<> Set.fromList (map _tagName ts))
114 & tags %~ (<> Set.fromList ts)
116-- | Construct a response with @'Schema'@ while declaring all
117-- necessary schema definitions.
118--
119-- >>> encode $ runDeclare (declareResponse (Proxy :: Proxy Day)) mempty
120-- "[{\"Day\":{\"example\":\"2016-07-22\",\"format\":\"date\",\"type\":\"string\"}},{\"description\":\"\",\"schema\":{\"$ref\":\"#/definitions/Day\"}}]"
121declareResponse :: ToSchema a => proxy a -> Declare (Definitions Schema) Response
122declareResponse proxy = do
123 s <- declareSchemaRef proxy
124 return (mempty & schema ?~ s)
126-- | Set response for all operations.
127-- This will also update global schema definitions.
128--
129-- If the response already exists it will be overwritten.
130--
131-- @
132-- 'setResponse' = 'setResponseFor' 'allOperations'
133-- @
134--
135-- Example:
136--
137-- >>> let api = (mempty :: Swagger) & paths .~ [("/user", mempty & get ?~ mempty)]
138-- >>> let res = declareResponse (Proxy :: Proxy Day)
139-- >>> encode $ api & setResponse 200 res
140-- "{\"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\"}}}"
141--
142-- See also @'setResponseWith'@.
143setResponse :: HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
144setResponse = setResponseFor allOperations
146-- | Set or update response for all operations.
147-- This will also update global schema definitions.
148--
149-- If the response already exists, but it can't be dereferenced (invalid @\$ref@),
150-- then just the new response is used.
151--
152-- @
153-- 'setResponseWith' = 'setResponseForWith' 'allOperations'
154-- @
155--
156-- See also @'setResponse'@.
157setResponseWith :: (Response -> Response -> Response) -> HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
158setResponseWith = setResponseForWith allOperations
160-- | Set response for specified operations.
161-- This will also update global schema definitions.
162--
163-- If the response already exists it will be overwritten.
164--
165-- See also @'setResponseForWith'@.
166setResponseFor :: Traversal' Swagger Operation -> HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
167setResponseFor ops code dres swag = swag
168 & definitions %~ (<> defs)
169 & ops . at code ?~ Inline res
170 where
171 (defs, res) = runDeclare dres mempty
173-- | Set or update response for specified operations.
174-- This will also update global schema definitions.
175--
176-- If the response already exists, but it can't be dereferenced (invalid @\$ref@),
177-- then just the new response is used.
178--
179-- See also @'setResponseFor'@.
180setResponseForWith :: Traversal' Swagger Operation -> (Response -> Response -> Response) -> HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
181setResponseForWith ops f code dres swag = swag
182 & definitions %~ (<> defs)
183 & ops . at code %~ Just . Inline . combine
184 where
185 (defs, new) = runDeclare dres mempty
187 combine (Just (Ref (Reference n))) = case swag ^. responses.at n of
188 Just old -> f old new
189 Nothing -> new -- response name can't be dereferenced, replacing with new response
190 combine (Just (Inline old)) = f old new
191 combine Nothing = new