├── .gitignore ├── LICENSE ├── README.md ├── src └── Data │ └── Swagger │ ├── Build │ ├── Api.hs │ ├── Authorisation.hs │ ├── Resource.hs │ └── Util.hs │ └── Model │ ├── Api.hs │ ├── Authorisation.hs │ ├── Resource.hs │ └── Util.hs ├── swagger.cabal └── test ├── Main.hs └── Test └── Api.hs /.gitignore: -------------------------------------------------------------------------------- 1 | *.o 2 | *.hi 3 | *.chi 4 | *.chs.h 5 | *.prof* 6 | *.aux* 7 | *.ps* 8 | *.hp* 9 | Setup.hs 10 | dist 11 | tags 12 | *.sw[po] 13 | .cabal-sandbox 14 | cabal.sandbox.config 15 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Mozilla Public License Version 2.0 2 | ================================== 3 | 4 | 1. Definitions 5 | -------------- 6 | 7 | 1.1. "Contributor" 8 | means each individual or legal entity that creates, contributes to 9 | the creation of, or owns Covered Software. 10 | 11 | 1.2. "Contributor Version" 12 | means the combination of the Contributions of others (if any) used 13 | by a Contributor and that particular Contributor's Contribution. 14 | 15 | 1.3. "Contribution" 16 | means Covered Software of a particular Contributor. 17 | 18 | 1.4. "Covered Software" 19 | means Source Code Form to which the initial Contributor has attached 20 | the notice in Exhibit A, the Executable Form of such Source Code 21 | Form, and Modifications of such Source Code Form, in each case 22 | including portions thereof. 23 | 24 | 1.5. "Incompatible With Secondary Licenses" 25 | means 26 | 27 | (a) that the initial Contributor has attached the notice described 28 | in Exhibit B to the Covered Software; or 29 | 30 | (b) that the Covered Software was made available under the terms of 31 | version 1.1 or earlier of the License, but not also under the 32 | terms of a Secondary License. 33 | 34 | 1.6. "Executable Form" 35 | means any form of the work other than Source Code Form. 36 | 37 | 1.7. "Larger Work" 38 | means a work that combines Covered Software with other material, in 39 | a separate file or files, that is not Covered Software. 40 | 41 | 1.8. "License" 42 | means this document. 43 | 44 | 1.9. "Licensable" 45 | means having the right to grant, to the maximum extent possible, 46 | whether at the time of the initial grant or subsequently, any and 47 | all of the rights conveyed by this License. 48 | 49 | 1.10. "Modifications" 50 | means any of the following: 51 | 52 | (a) any file in Source Code Form that results from an addition to, 53 | deletion from, or modification of the contents of Covered 54 | Software; or 55 | 56 | (b) any new file in Source Code Form that contains any Covered 57 | Software. 58 | 59 | 1.11. "Patent Claims" of a Contributor 60 | means any patent claim(s), including without limitation, method, 61 | process, and apparatus claims, in any patent Licensable by such 62 | Contributor that would be infringed, but for the grant of the 63 | License, by the making, using, selling, offering for sale, having 64 | made, import, or transfer of either its Contributions or its 65 | Contributor Version. 66 | 67 | 1.12. "Secondary License" 68 | means either the GNU General Public License, Version 2.0, the GNU 69 | Lesser General Public License, Version 2.1, the GNU Affero General 70 | Public License, Version 3.0, or any later versions of those 71 | licenses. 72 | 73 | 1.13. "Source Code Form" 74 | means the form of the work preferred for making modifications. 75 | 76 | 1.14. "You" (or "Your") 77 | means an individual or a legal entity exercising rights under this 78 | License. For legal entities, "You" includes any entity that 79 | controls, is controlled by, or is under common control with You. For 80 | purposes of this definition, "control" means (a) the power, direct 81 | or indirect, to cause the direction or management of such entity, 82 | whether by contract or otherwise, or (b) ownership of more than 83 | fifty percent (50%) of the outstanding shares or beneficial 84 | ownership of such entity. 85 | 86 | 2. License Grants and Conditions 87 | -------------------------------- 88 | 89 | 2.1. Grants 90 | 91 | Each Contributor hereby grants You a world-wide, royalty-free, 92 | non-exclusive license: 93 | 94 | (a) under intellectual property rights (other than patent or trademark) 95 | Licensable by such Contributor to use, reproduce, make available, 96 | modify, display, perform, distribute, and otherwise exploit its 97 | Contributions, either on an unmodified basis, with Modifications, or 98 | as part of a Larger Work; and 99 | 100 | (b) under Patent Claims of such Contributor to make, use, sell, offer 101 | for sale, have made, import, and otherwise transfer either its 102 | Contributions or its Contributor Version. 103 | 104 | 2.2. Effective Date 105 | 106 | The licenses granted in Section 2.1 with respect to any Contribution 107 | become effective for each Contribution on the date the Contributor first 108 | distributes such Contribution. 109 | 110 | 2.3. Limitations on Grant Scope 111 | 112 | The licenses granted in this Section 2 are the only rights granted under 113 | this License. No additional rights or licenses will be implied from the 114 | distribution or licensing of Covered Software under this License. 115 | Notwithstanding Section 2.1(b) above, no patent license is granted by a 116 | Contributor: 117 | 118 | (a) for any code that a Contributor has removed from Covered Software; 119 | or 120 | 121 | (b) for infringements caused by: (i) Your and any other third party's 122 | modifications of Covered Software, or (ii) the combination of its 123 | Contributions with other software (except as part of its Contributor 124 | Version); or 125 | 126 | (c) under Patent Claims infringed by Covered Software in the absence of 127 | its Contributions. 128 | 129 | This License does not grant any rights in the trademarks, service marks, 130 | or logos of any Contributor (except as may be necessary to comply with 131 | the notice requirements in Section 3.4). 132 | 133 | 2.4. Subsequent Licenses 134 | 135 | No Contributor makes additional grants as a result of Your choice to 136 | distribute the Covered Software under a subsequent version of this 137 | License (see Section 10.2) or under the terms of a Secondary License (if 138 | permitted under the terms of Section 3.3). 139 | 140 | 2.5. Representation 141 | 142 | Each Contributor represents that the Contributor believes its 143 | Contributions are its original creation(s) or it has sufficient rights 144 | to grant the rights to its Contributions conveyed by this License. 145 | 146 | 2.6. Fair Use 147 | 148 | This License is not intended to limit any rights You have under 149 | applicable copyright doctrines of fair use, fair dealing, or other 150 | equivalents. 151 | 152 | 2.7. Conditions 153 | 154 | Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted 155 | in Section 2.1. 156 | 157 | 3. Responsibilities 158 | ------------------- 159 | 160 | 3.1. Distribution of Source Form 161 | 162 | All distribution of Covered Software in Source Code Form, including any 163 | Modifications that You create or to which You contribute, must be under 164 | the terms of this License. You must inform recipients that the Source 165 | Code Form of the Covered Software is governed by the terms of this 166 | License, and how they can obtain a copy of this License. You may not 167 | attempt to alter or restrict the recipients' rights in the Source Code 168 | Form. 169 | 170 | 3.2. Distribution of Executable Form 171 | 172 | If You distribute Covered Software in Executable Form then: 173 | 174 | (a) such Covered Software must also be made available in Source Code 175 | Form, as described in Section 3.1, and You must inform recipients of 176 | the Executable Form how they can obtain a copy of such Source Code 177 | Form by reasonable means in a timely manner, at a charge no more 178 | than the cost of distribution to the recipient; and 179 | 180 | (b) You may distribute such Executable Form under the terms of this 181 | License, or sublicense it under different terms, provided that the 182 | license for the Executable Form does not attempt to limit or alter 183 | the recipients' rights in the Source Code Form under this License. 184 | 185 | 3.3. Distribution of a Larger Work 186 | 187 | You may create and distribute a Larger Work under terms of Your choice, 188 | provided that You also comply with the requirements of this License for 189 | the Covered Software. If the Larger Work is a combination of Covered 190 | Software with a work governed by one or more Secondary Licenses, and the 191 | Covered Software is not Incompatible With Secondary Licenses, this 192 | License permits You to additionally distribute such Covered Software 193 | under the terms of such Secondary License(s), so that the recipient of 194 | the Larger Work may, at their option, further distribute the Covered 195 | Software under the terms of either this License or such Secondary 196 | License(s). 197 | 198 | 3.4. Notices 199 | 200 | You may not remove or alter the substance of any license notices 201 | (including copyright notices, patent notices, disclaimers of warranty, 202 | or limitations of liability) contained within the Source Code Form of 203 | the Covered Software, except that You may alter any license notices to 204 | the extent required to remedy known factual inaccuracies. 205 | 206 | 3.5. Application of Additional Terms 207 | 208 | You may choose to offer, and to charge a fee for, warranty, support, 209 | indemnity or liability obligations to one or more recipients of Covered 210 | Software. However, You may do so only on Your own behalf, and not on 211 | behalf of any Contributor. You must make it absolutely clear that any 212 | such warranty, support, indemnity, or liability obligation is offered by 213 | You alone, and You hereby agree to indemnify every Contributor for any 214 | liability incurred by such Contributor as a result of warranty, support, 215 | indemnity or liability terms You offer. You may include additional 216 | disclaimers of warranty and limitations of liability specific to any 217 | jurisdiction. 218 | 219 | 4. Inability to Comply Due to Statute or Regulation 220 | --------------------------------------------------- 221 | 222 | If it is impossible for You to comply with any of the terms of this 223 | License with respect to some or all of the Covered Software due to 224 | statute, judicial order, or regulation then You must: (a) comply with 225 | the terms of this License to the maximum extent possible; and (b) 226 | describe the limitations and the code they affect. Such description must 227 | be placed in a text file included with all distributions of the Covered 228 | Software under this License. Except to the extent prohibited by statute 229 | or regulation, such description must be sufficiently detailed for a 230 | recipient of ordinary skill to be able to understand it. 231 | 232 | 5. Termination 233 | -------------- 234 | 235 | 5.1. The rights granted under this License will terminate automatically 236 | if You fail to comply with any of its terms. However, if You become 237 | compliant, then the rights granted under this License from a particular 238 | Contributor are reinstated (a) provisionally, unless and until such 239 | Contributor explicitly and finally terminates Your grants, and (b) on an 240 | ongoing basis, if such Contributor fails to notify You of the 241 | non-compliance by some reasonable means prior to 60 days after You have 242 | come back into compliance. Moreover, Your grants from a particular 243 | Contributor are reinstated on an ongoing basis if such Contributor 244 | notifies You of the non-compliance by some reasonable means, this is the 245 | first time You have received notice of non-compliance with this License 246 | from such Contributor, and You become compliant prior to 30 days after 247 | Your receipt of the notice. 248 | 249 | 5.2. If You initiate litigation against any entity by asserting a patent 250 | infringement claim (excluding declaratory judgment actions, 251 | counter-claims, and cross-claims) alleging that a Contributor Version 252 | directly or indirectly infringes any patent, then the rights granted to 253 | You by any and all Contributors for the Covered Software under Section 254 | 2.1 of this License shall terminate. 255 | 256 | 5.3. In the event of termination under Sections 5.1 or 5.2 above, all 257 | end user license agreements (excluding distributors and resellers) which 258 | have been validly granted by You or Your distributors under this License 259 | prior to termination shall survive termination. 260 | 261 | ************************************************************************ 262 | * * 263 | * 6. Disclaimer of Warranty * 264 | * ------------------------- * 265 | * * 266 | * Covered Software is provided under this License on an "as is" * 267 | * basis, without warranty of any kind, either expressed, implied, or * 268 | * statutory, including, without limitation, warranties that the * 269 | * Covered Software is free of defects, merchantable, fit for a * 270 | * particular purpose or non-infringing. The entire risk as to the * 271 | * quality and performance of the Covered Software is with You. * 272 | * Should any Covered Software prove defective in any respect, You * 273 | * (not any Contributor) assume the cost of any necessary servicing, * 274 | * repair, or correction. This disclaimer of warranty constitutes an * 275 | * essential part of this License. No use of any Covered Software is * 276 | * authorized under this License except under this disclaimer. * 277 | * * 278 | ************************************************************************ 279 | 280 | ************************************************************************ 281 | * * 282 | * 7. Limitation of Liability * 283 | * -------------------------- * 284 | * * 285 | * Under no circumstances and under no legal theory, whether tort * 286 | * (including negligence), contract, or otherwise, shall any * 287 | * Contributor, or anyone who distributes Covered Software as * 288 | * permitted above, be liable to You for any direct, indirect, * 289 | * special, incidental, or consequential damages of any character * 290 | * including, without limitation, damages for lost profits, loss of * 291 | * goodwill, work stoppage, computer failure or malfunction, or any * 292 | * and all other commercial damages or losses, even if such party * 293 | * shall have been informed of the possibility of such damages. This * 294 | * limitation of liability shall not apply to liability for death or * 295 | * personal injury resulting from such party's negligence to the * 296 | * extent applicable law prohibits such limitation. Some * 297 | * jurisdictions do not allow the exclusion or limitation of * 298 | * incidental or consequential damages, so this exclusion and * 299 | * limitation may not apply to You. * 300 | * * 301 | ************************************************************************ 302 | 303 | 8. Litigation 304 | ------------- 305 | 306 | Any litigation relating to this License may be brought only in the 307 | courts of a jurisdiction where the defendant maintains its principal 308 | place of business and such litigation shall be governed by laws of that 309 | jurisdiction, without reference to its conflict-of-law provisions. 310 | Nothing in this Section shall prevent a party's ability to bring 311 | cross-claims or counter-claims. 312 | 313 | 9. Miscellaneous 314 | ---------------- 315 | 316 | This License represents the complete agreement concerning the subject 317 | matter hereof. If any provision of this License is held to be 318 | unenforceable, such provision shall be reformed only to the extent 319 | necessary to make it enforceable. Any law or regulation which provides 320 | that the language of a contract shall be construed against the drafter 321 | shall not be used to construe this License against a Contributor. 322 | 323 | 10. Versions of the License 324 | --------------------------- 325 | 326 | 10.1. New Versions 327 | 328 | Mozilla Foundation is the license steward. Except as provided in Section 329 | 10.3, no one other than the license steward has the right to modify or 330 | publish new versions of this License. Each version will be given a 331 | distinguishing version number. 332 | 333 | 10.2. Effect of New Versions 334 | 335 | You may distribute the Covered Software under the terms of the version 336 | of the License under which You originally received the Covered Software, 337 | or under the terms of any subsequent version published by the license 338 | steward. 339 | 340 | 10.3. Modified Versions 341 | 342 | If you create software not governed by this License, and you want to 343 | create a new license for such software, you may create and use a 344 | modified version of this License if you rename the license and remove 345 | any references to the name of the license steward (except to note that 346 | such modified license differs from this License). 347 | 348 | 10.4. Distributing Source Code Form that is Incompatible With Secondary 349 | Licenses 350 | 351 | If You choose to distribute Source Code Form that is Incompatible With 352 | Secondary Licenses under the terms of this version of the License, the 353 | notice described in Exhibit B of this License must be attached. 354 | 355 | Exhibit A - Source Code Form License Notice 356 | ------------------------------------------- 357 | 358 | This Source Code Form is subject to the terms of the Mozilla Public 359 | License, v. 2.0. If a copy of the MPL was not distributed with this 360 | file, You can obtain one at http://mozilla.org/MPL/2.0/. 361 | 362 | If it is not possible or desirable to put the notice in a particular 363 | file, then You may include the notice in a location (such as a LICENSE 364 | file in a relevant directory) where a recipient would be likely to look 365 | for such a notice. 366 | 367 | You may add additional accurate notices of copyright ownership. 368 | 369 | Exhibit B - "Incompatible With Secondary Licenses" Notice 370 | --------------------------------------------------------- 371 | 372 | This Source Code Form is "Incompatible With Secondary Licenses", as 373 | defined by the Mozilla Public License, v. 2.0. 374 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Swagger Spec Implementation 2 | 3 | This library implements the [Swagger 1.2 Specification][1] and provides some 4 | support to conveniently build API descriptions. Here are some examples: 5 | 6 | ## Model definition 7 | 8 | ```haskell 9 | import Data.Swagger.Build.Api 10 | 11 | foo :: Model 12 | foo = defineModel "Foo" $ do 13 | description "Some Foo model" 14 | property "header" bytes' $ 15 | description "Foo's header property" 16 | 17 | bar :: Model 18 | bar = defineModel "Bar" $ do 19 | description "Some other model" 20 | property "header" (string $ enum ["bar", "baz"]) $ 21 | description "lorem ipsum" 22 | ``` 23 | 24 | ## API declaration 25 | 26 | ```haskell 27 | import Data.Swagger.Build.Api 28 | 29 | declare "http://petstore.swagger.wordnik.com/api" "1.2" $ do 30 | apiVersion "1.0.0" 31 | resourcePath "/store" 32 | model foo 33 | model bar 34 | produces "application/json" 35 | produces "text/html" 36 | produces "text/plain" 37 | api "/store/order/{orderId}" $ do 38 | operation "GET" "foo" $ do 39 | summary "give me some foo" 40 | notes "but only the good one" 41 | returns (ref foo) 42 | parameter Header "type" (string $ enum ["bar", "baz"]) $ do 43 | description "specifies the type of foo" 44 | optional 45 | parameter Query "format" (string $ enum ["plain", "html"]) $ 46 | description "output format" 47 | parameter Query "size" (int32 $ min 1 . max 100 . def 10) $ 48 | description "amount of foo" 49 | produces "application/json" 50 | produces "text/html" 51 | response 200 "OK" (model foo) 52 | response 400 "Bad Request" end 53 | operation "POST" "foo" $ do 54 | summary "something else" 55 | deprecated 56 | ``` 57 | 58 | ## Resource listing 59 | 60 | 61 | ```haskell 62 | import Data.Swagger.Build.Resource 63 | 64 | resources "1.2" $ do 65 | apiVersion "1.0" 66 | api "/foo" $ 67 | description "This is Foo's API" 68 | ``` 69 | 70 | The whole swagger model is an instance of Aeson's `ToJSON` type-class, 71 | consequently it can be directly encoded to JSON. 72 | 73 | A complete example can be found in the [wiki][3]. 74 | 75 | --- 76 | [1]: https://github.com/wordnik/swagger-spec/blob/master/versions/1.2.md 77 | [2]: http://hackage.haskell.org/package/wai-routing 78 | [3]: https://github.com/twittner/swagger/wiki/Example-usage 79 | -------------------------------------------------------------------------------- /src/Data/Swagger/Build/Api.hs: -------------------------------------------------------------------------------- 1 | -- This Source Code Form is subject to the terms of the Mozilla Public 2 | -- License, v. 2.0. If a copy of the MPL was not distributed with this 3 | -- file, You can obtain one at http://mozilla.org/MPL/2.0/. 4 | 5 | {-# LANGUAGE DataKinds #-} 6 | {-# LANGUAGE OverloadedStrings #-} 7 | {-# LANGUAGE PolyKinds #-} 8 | {-# LANGUAGE TypeFamilies #-} 9 | {-# LANGUAGE TypeOperators #-} 10 | 11 | -- | Construction of "Data.Swagger.Model.Api" values. For example: 12 | -- 13 | -- @ 14 | -- declare "http://petstore.swagger.wordnik.com/api" "1.2" $ do 15 | -- apiVersion \"1.0.0\" 16 | -- resourcePath \"/store\" 17 | -- model foo 18 | -- model bar 19 | -- produces \"application/json\" 20 | -- produces \"text/html\" 21 | -- produces \"text/plain\" 22 | -- api \"\/store\/order\/{orderId}\" $ do 23 | -- operation \"GET\" \"foo\" $ do 24 | -- summary \"give me some foo\" 25 | -- notes \"but only the good one\" 26 | -- returns (ref foo) 27 | -- parameter Header \"type\" (string $ enum [\"bar\", \"baz\"]) $ do 28 | -- description \"specifies the type of foo\" 29 | -- optional 30 | -- parameter Query \"format\" (string $ enum [\"plain\", \"html\"]) $ 31 | -- description \"output format\" 32 | -- parameter Query \"size\" (int32 $ min 1 . max 100 . def 10) $ 33 | -- description \"amount of foo\" 34 | -- produces \"application/json\" 35 | -- produces \"text/html\" 36 | -- response 200 \"OK\" (model foo) 37 | -- response 400 \"Bad Request\" end 38 | -- operation \"POST\" \"foo\" $ do 39 | -- summary \"something else\" 40 | -- deprecated 41 | -- @ 42 | module Data.Swagger.Build.Api 43 | ( -- * data types 44 | -- ** Re-exports 45 | Api.ApiDecl 46 | , Api.API 47 | , Api.Operation 48 | , Api.Parameter 49 | , Api.ParamType (..) 50 | , Api.Response 51 | , Api.Model 52 | , Api.Property 53 | , Api.DataType 54 | , Api.Primitive 55 | , Api.Items 56 | 57 | -- ** primitive construction 58 | , int32 59 | , int32' 60 | , int64 61 | , int64' 62 | , float 63 | , float' 64 | , bool 65 | , bool' 66 | , double 67 | , double' 68 | , string 69 | , string' 70 | , bytes 71 | , bytes' 72 | , date 73 | , date' 74 | , dateTime 75 | , dateTime' 76 | 77 | -- ** primitive modifiers 78 | , Data.Swagger.Build.Api.def 79 | , Data.Swagger.Build.Api.enum 80 | , Data.Swagger.Build.Api.min 81 | , Data.Swagger.Build.Api.max 82 | 83 | -- ** data-type constructors 84 | , ref 85 | , array 86 | , unique 87 | 88 | -- * builder types 89 | , ApiDeclSt 90 | , ApiDeclBuilder 91 | , ApiSt 92 | , ApiBuilder 93 | , OperationSt 94 | , OperationBuilder 95 | , ParameterSt 96 | , ParameterBuilder 97 | , ResponseSt 98 | , ResponseBuilder 99 | , ModelSt 100 | , ModelBuilder 101 | , PropertySt 102 | , PropertyBuilder 103 | 104 | -- * API declaration 105 | , declare 106 | , Data.Swagger.Build.Api.apiVersion 107 | , Data.Swagger.Build.Api.resourcePath 108 | , api 109 | , model 110 | 111 | -- * operation 112 | , operation 113 | , returns 114 | , parameter 115 | , file 116 | , body 117 | , Data.Swagger.Build.Api.summary 118 | , Data.Swagger.Build.Api.notes 119 | , response 120 | , Data.Swagger.Build.Util.produces 121 | , authorisation 122 | , Data.Swagger.Build.Util.Auth (..) 123 | 124 | -- * parameter 125 | , multiple 126 | 127 | -- * model 128 | , defineModel 129 | , property 130 | , children 131 | 132 | -- * various 133 | , Data.Swagger.Build.Util.description 134 | , optional 135 | , Data.Swagger.Build.Util.consumes 136 | , Data.Swagger.Build.Api.deprecated 137 | , Data.Swagger.Build.Util.end 138 | ) where 139 | 140 | import Control.Applicative hiding (optional) 141 | import Control.Monad.Trans.State.Strict 142 | import Data.Function (on) 143 | import Data.Int 144 | import Data.List (groupBy) 145 | import Data.Maybe (catMaybes) 146 | import Data.Text (Text) 147 | import Data.Time (UTCTime) 148 | import Data.Swagger.Build.Util 149 | import Data.Swagger.Model.Api as Api 150 | import Data.Swagger.Model.Authorisation (Scope) 151 | import Prelude 152 | 153 | ----------------------------------------------------------------------------- 154 | -- Primitive types 155 | 156 | prim :: PrimType -> Primitive a 157 | prim t = Primitive t Nothing Nothing Nothing Nothing 158 | 159 | int32 :: (Primitive Int32 -> Primitive Int32) -> DataType 160 | int32 f = Prim . f $ prim PrimInt32 161 | 162 | int64 :: (Primitive Int64 -> Primitive Int64) -> DataType 163 | int64 f = Prim . f $ prim PrimInt64 164 | 165 | float :: (Primitive Float -> Primitive Float) -> DataType 166 | float f = Prim . f $ prim PrimFloat 167 | 168 | double :: (Primitive Double -> Primitive Double) -> DataType 169 | double f = Prim . f $ prim PrimDouble 170 | 171 | string :: (Primitive String -> Primitive String) -> DataType 172 | string f = Prim . f $ prim PrimString 173 | 174 | bytes :: (Primitive String -> Primitive String) -> DataType 175 | bytes f = Prim . f $ prim PrimByte 176 | 177 | bool :: (Primitive Bool -> Primitive Bool) -> DataType 178 | bool f = Prim . f $ prim PrimBool 179 | 180 | date :: (Primitive UTCTime -> Primitive UTCTime) -> DataType 181 | date f = Prim . f $ prim PrimDate 182 | 183 | dateTime :: (Primitive UTCTime -> Primitive UTCTime) -> DataType 184 | dateTime f = Prim . f $ prim PrimDateTime 185 | 186 | int32' :: DataType 187 | int32' = int32 id 188 | 189 | int64' :: DataType 190 | int64' = int64 id 191 | 192 | float' :: DataType 193 | float' = float id 194 | 195 | double' :: DataType 196 | double' = double id 197 | 198 | string' :: DataType 199 | string' = string id 200 | 201 | bytes' :: DataType 202 | bytes' = bytes id 203 | 204 | bool' :: DataType 205 | bool' = bool id 206 | 207 | date' :: DataType 208 | date' = date id 209 | 210 | dateTime' :: DataType 211 | dateTime' = dateTime id 212 | 213 | -- | Default value of some primitive type. 214 | def :: a -> Primitive a -> Primitive a 215 | def a t = t { defaultValue = Just a } 216 | 217 | -- | Enumerate valid values of some primitive type. 218 | enum :: [a] -> Primitive a -> Primitive a 219 | enum a t = t { Api.enum = Just a } 220 | 221 | -- | Minimum value of some primitive type. 222 | min :: a -> Primitive a -> Primitive a 223 | min a t = t { minVal = Just a } 224 | 225 | -- | Maximum value of some primitive type. 226 | max :: a -> Primitive a -> Primitive a 227 | max a t = t { maxVal = Just a } 228 | 229 | ----------------------------------------------------------------------------- 230 | -- Data types 231 | 232 | ref :: Model -> DataType 233 | ref = Ref . modelId 234 | 235 | array :: DataType -> DataType 236 | array (Prim t) = Array (PrimItems t) Nothing 237 | array (Ref t) = Array (ModelItems t :: Items ()) Nothing 238 | array t@(Array _ _) = t 239 | 240 | -- | Specify that array elements are unique. 241 | unique :: DataType -> DataType 242 | unique (Array t _) = Array t (Just True) 243 | unique t = t 244 | 245 | ----------------------------------------------------------------------------- 246 | -- Api Decl 247 | 248 | type ApiDeclSt = Common '["produces", "consumes", "models", "authorisations"] ApiDecl 249 | type ApiDeclBuilder = State ApiDeclSt () 250 | 251 | -- | Create an API declaration given a base URL, a swagger version, and 252 | -- other API declaration values. 253 | declare :: Text -> Text -> ApiDeclBuilder -> ApiDecl 254 | declare b v s = value $ execState s start 255 | where 256 | start = common $ ApiDecl v b [] Nothing Nothing Nothing Nothing Nothing Nothing 257 | mmmm c = map (\m -> (modelId m, m)) <$> modls c 258 | value c = (other c) { apiProduces = prod c 259 | , apiConsumes = cons c 260 | , models = mmmm c 261 | , apiAuthorisations = toAuthObj <$> auths c 262 | } 263 | 264 | apiVersion :: Text -> ApiDeclBuilder 265 | apiVersion v = modify $ \c -> c { other = (other c) { Api.apiVersion = Just v } } 266 | 267 | resourcePath :: Text -> ApiDeclBuilder 268 | resourcePath p = modify $ \c -> c { other = (other c) { Api.resourcePath = Just p } } 269 | 270 | ----------------------------------------------------------------------------- 271 | -- API 272 | 273 | type ApiSt = Common '["description"] API 274 | type ApiBuilder = State ApiSt () 275 | 276 | -- | Add one API object to an API declaration given some path and other API 277 | -- object values. 278 | api :: Text -> ApiBuilder -> ApiDeclBuilder 279 | api p s = modify $ \c -> do 280 | let d = other c 281 | c { other = d { apis = value (execState s start) : apis d } } 282 | where 283 | start = common $ API p [] Nothing 284 | value c = (other c) { apiDescription = descr c } 285 | 286 | type OperationSt = Common '["produces", "consumes", "authorisations"] Operation 287 | type OperationBuilder = State OperationSt () 288 | 289 | -- | Add one operation object to an API object given an HTTP method, 290 | -- a nickname and other operation specific values. 291 | operation :: Text -> Text -> OperationBuilder -> ApiBuilder 292 | operation m n s = modify $ \c -> do 293 | let o = value (execState s start) 294 | a = other c 295 | c { other = a { operations = o : operations a } } 296 | where 297 | start = common $ Operation m n (Left ()) [] Nothing Nothing Nothing Nothing Nothing Nothing Nothing 298 | value c = (other c) { Api.produces = prod c 299 | , Api.consumes = cons c 300 | , authorisations = toAuthObj <$> auths c 301 | } 302 | 303 | ----------------------------------------------------------------------------- 304 | -- Operation 305 | 306 | type ParameterSt = Common '["description", "required"] Parameter 307 | type ParameterBuilder = State ParameterSt () 308 | 309 | returns :: DataType -> OperationBuilder 310 | returns t = modify $ \c -> c { other = (other c) { returnType = Right t } } 311 | 312 | -- | Add one parameter object to an operation object given the 'ParamType', 313 | -- the parameter name and the actual data-type plus some other parameter 314 | -- values. 315 | parameter :: ParamType -> Text -> DataType -> ParameterBuilder -> OperationBuilder 316 | parameter p n t s = modify $ \c -> do 317 | let op = other c 318 | c { other = op { parameters = value (execState s start) : parameters op } } 319 | where 320 | start = common $ Parameter p (Right t) n Nothing Nothing Nothing 321 | value c = (other c) { Api.description = descr c, Api.required = reqrd c } 322 | 323 | -- | Like 'parameter' but specific for file uploads. 324 | file :: Text -> ParameterBuilder -> OperationBuilder 325 | file n s = modify $ \c -> do 326 | let op = other c 327 | c { other = op { Api.consumes = Just ["multipart/form-data"] 328 | , parameters = value (execState s start) : parameters op 329 | } 330 | } 331 | where 332 | start = common $ Parameter Form (Left File) n Nothing Nothing Nothing 333 | value c = (other c) { Api.description = descr c, Api.required = reqrd c } 334 | 335 | -- | Like 'parameter' but specific for request body parameters. Sets 336 | -- 'ParamType' to 'Body' and uses as name \"body\" which is the only valid 337 | -- name for request bodies. 338 | body :: DataType -> ParameterBuilder -> OperationBuilder 339 | body = parameter Body "body" 340 | 341 | summary :: Text -> OperationBuilder 342 | summary t = modify $ \c -> c { other = (other c) { Api.summary = Just t } } 343 | 344 | notes :: Text -> OperationBuilder 345 | notes t = modify $ \c -> c { other = (other c) { Api.notes = Just t } } 346 | 347 | type ResponseSt = Common '["models"] Response 348 | type ResponseBuilder = State ResponseSt () 349 | 350 | -- | Add one response message object to an operation given a status code 351 | -- and some message plus response message specific values. 352 | response :: Int -> Text -> ResponseBuilder -> OperationBuilder 353 | response i m s = modify $ \x -> do 354 | let r = value $ execState s start 355 | o = other x 356 | x { other = o { responses = maybe (Just [r]) (Just . (r:)) (responses o) } } 357 | where 358 | start = common $ Response i m Nothing 359 | value c = (other c) { responseModel = modelId . head <$> modls c } 360 | 361 | deprecated :: OperationBuilder 362 | deprecated = modify $ \c -> c { other = (other c) { Api.deprecated = Just True } } 363 | 364 | ----------------------------------------------------------------------------- 365 | -- Parameter 366 | 367 | multiple :: ParameterBuilder 368 | multiple = modify $ \c -> c { other = (other c) { allowMultiple = Just True } } 369 | 370 | ----------------------------------------------------------------------------- 371 | -- Model 372 | 373 | type ModelSt = Common '["description"] Model 374 | type ModelBuilder = State ModelSt () 375 | 376 | type PropertySt = Common '["description", "required"] Property 377 | type PropertyBuilder = State PropertySt () 378 | 379 | -- | Construct a complex data-type (aka \"Model\") given some identifier 380 | -- and model-specific values. 381 | defineModel :: ModelId -> ModelBuilder -> Model 382 | defineModel m s = value (execState s start) 383 | where 384 | start = common $ Model m [] Nothing Nothing Nothing Nothing 385 | value c = (other c) { modelDescription = descr c } 386 | 387 | -- | Add a property to a model given a name, type and other propertu 388 | -- values. 389 | property :: PropertyName -> DataType -> PropertyBuilder -> ModelBuilder 390 | property n t s = modify $ \c -> do 391 | let r = execState s $ common (Property t Nothing) 392 | p = (other r) { propDescription = descr r } 393 | m = other c 394 | x = maybe (Just [n]) (Just . (n:)) (requiredProps m) 395 | y = if Just True /= reqrd r then requiredProps m else x 396 | c { other = m { properties = (n, p) : properties m , requiredProps = y } } 397 | 398 | -- | Specify a sub-typing relationship for a model by given 399 | -- a \"discriminator\" property name and all sub-types. 400 | children :: PropertyName -> [Model] -> ModelBuilder 401 | children d tt = modify $ \c -> c { other = (other c) { subTypes = Just tt, discriminator = Just d } } 402 | 403 | ----------------------------------------------------------------------------- 404 | -- Helpers 405 | 406 | toAuthObj :: [(Text, Maybe Scope)] -> [(Text, [Scope])] 407 | toAuthObj = map (\g -> (fst (head g), catMaybes $ map snd g)) . groupBy ((==) `on` fst) 408 | 409 | -------------------------------------------------------------------------------- /src/Data/Swagger/Build/Authorisation.hs: -------------------------------------------------------------------------------- 1 | -- This Source Code Form is subject to the terms of the Mozilla Public 2 | -- License, v. 2.0. If a copy of the MPL was not distributed with this 3 | -- file, You can obtain one at http://mozilla.org/MPL/2.0/. 4 | 5 | {-# LANGUAGE DataKinds #-} 6 | {-# LANGUAGE PolyKinds #-} 7 | {-# LANGUAGE TypeOperators #-} 8 | 9 | module Data.Swagger.Build.Authorisation 10 | ( -- * basic auth 11 | Data.Swagger.Build.Authorisation.basic 12 | 13 | -- * api key 14 | , Data.Swagger.Build.Authorisation.apiKey 15 | , PassMethod (..) 16 | 17 | -- * oauth2 18 | , Data.Swagger.Build.Authorisation.oauth2 19 | , Data.Swagger.Build.Authorisation.scope 20 | , Data.Swagger.Build.Authorisation.implicit 21 | , Data.Swagger.Build.Authorisation.authCode 22 | , Data.Swagger.Build.Authorisation.tokenEndpoint 23 | , Data.Swagger.Build.Authorisation.tokenRequestEndpoint 24 | , Data.Swagger.Build.Authorisation.clientIdName 25 | , Data.Swagger.Build.Authorisation.clientSecretName 26 | , Data.Swagger.Build.Authorisation.token 27 | , Data.Swagger.Build.Util.end 28 | 29 | -- * builder types 30 | , OAuth2Builder 31 | , ScopeSt 32 | , ScopeBuilder 33 | , ImplicitBuilder 34 | , TokenEndpointBuilder 35 | , TokenReqEndpointBuilder 36 | 37 | ) where 38 | 39 | import Control.Monad.Trans.State.Strict 40 | import Data.Text (Text) 41 | import Data.Swagger.Build.Util hiding (Auth (..)) 42 | import Data.Swagger.Model.Authorisation as Auth 43 | 44 | basic :: Authorisation 45 | basic = BasicAuth 46 | 47 | apiKey :: PassMethod -> Text -> Authorisation 48 | apiKey m n = ApiKey m n 49 | 50 | ----------------------------------------------------------------------------- 51 | -- OAuth2 52 | 53 | type OAuth2Builder = State [Scope] () 54 | 55 | oauth2 :: GrantTypes -> OAuth2Builder -> Authorisation 56 | oauth2 t s = 57 | case execState s [] of 58 | [] -> OAuth2 Nothing t 59 | ss -> OAuth2 (Just ss) t 60 | 61 | type ScopeSt = Common '["description"] Scope 62 | type ScopeBuilder = State ScopeSt () 63 | 64 | -- | Add one scope with the given name to an OAuth2 object. 65 | scope :: Text -> ScopeBuilder -> OAuth2Builder 66 | scope t s = modify $ \o -> value (execState s start) : o 67 | where 68 | start = common $ Scope t Nothing 69 | value c = (other c) { Auth.description = descr c } 70 | 71 | type ImplicitBuilder = State (TokenName ImplicitGrant) () 72 | 73 | -- | Construct an implicit grant type with the given login endpoint and 74 | -- some optional token name. 75 | implicit :: Text -> ImplicitBuilder -> GrantTypes 76 | implicit e s = GrantTypes (Just $ value $ execState s start) Nothing 77 | where 78 | start = mkTokenName $ ImplicitGrant (LoginEndpoint e) Nothing 79 | value t = (unwrap t) { Auth.tokenName = tname t } 80 | 81 | -- | Construct an authentorisation code based grant type object. 82 | authCode :: TokenRequestEndpoint -> TokenEndpoint -> GrantTypes 83 | authCode r e = GrantTypes Nothing (Just $ AuthCode r e) 84 | 85 | type TokenEndpointBuilder = State (TokenName TokenEndpoint) () 86 | 87 | tokenEndpoint :: Text -> TokenEndpointBuilder -> TokenEndpoint 88 | tokenEndpoint u s = value $ execState s start 89 | where 90 | start = mkTokenName $ TokenEndpoint u Nothing 91 | value t = (unwrap t) { tokenEndpointTokenName = tname t } 92 | 93 | type TokenReqEndpointBuilder = State TokenRequestEndpoint () 94 | 95 | tokenRequestEndpoint :: Text -> TokenReqEndpointBuilder -> TokenRequestEndpoint 96 | tokenRequestEndpoint u s = execState s start 97 | where 98 | start = TokenRequestEndpoint u Nothing Nothing 99 | 100 | clientIdName :: Text -> TokenReqEndpointBuilder 101 | clientIdName n = modify $ \x -> x { Auth.clientIdName = Just n } 102 | 103 | clientSecretName :: Text -> TokenReqEndpointBuilder 104 | clientSecretName n = modify $ \x -> x { Auth.clientSecretName = Just n } 105 | 106 | ----------------------------------------------------------------------------- 107 | -- Helpers 108 | 109 | data TokenName a = TokenName 110 | { tname :: Maybe Text 111 | , unwrap :: a 112 | } 113 | 114 | token :: Text -> State (TokenName a) () 115 | token n = modify $ \t -> t { tname = Just n } 116 | 117 | mkTokenName :: a -> TokenName a 118 | mkTokenName = TokenName Nothing 119 | -------------------------------------------------------------------------------- /src/Data/Swagger/Build/Resource.hs: -------------------------------------------------------------------------------- 1 | -- This Source Code Form is subject to the terms of the Mozilla Public 2 | -- License, v. 2.0. If a copy of the MPL was not distributed with this 3 | -- file, You can obtain one at http://mozilla.org/MPL/2.0/. 4 | 5 | {-# LANGUAGE DataKinds #-} 6 | {-# LANGUAGE PolyKinds #-} 7 | {-# LANGUAGE TypeOperators #-} 8 | 9 | module Data.Swagger.Build.Resource 10 | ( Data.Swagger.Build.Resource.resources 11 | , Data.Swagger.Build.Resource.api 12 | , Data.Swagger.Build.Resource.apiVersion 13 | , Data.Swagger.Build.Resource.info 14 | , Data.Swagger.Build.Resource.termsOfServiceUrl 15 | , Data.Swagger.Build.Resource.contact 16 | , Data.Swagger.Build.Resource.license 17 | , Data.Swagger.Build.Resource.licenseUrl 18 | , Data.Swagger.Build.Resource.authorisation 19 | , Data.Swagger.Build.Util.end 20 | 21 | -- * builder types 22 | , ResourcesBuilder 23 | , InfoBuilder 24 | ) where 25 | 26 | import Control.Monad.Trans.State.Strict 27 | import Data.Text (Text) 28 | import Data.Swagger.Build.Util hiding (authorisation) 29 | import Data.Swagger.Model.Authorisation as A 30 | import Data.Swagger.Model.Resource as R 31 | 32 | type ResourcesBuilder = State Resources () 33 | 34 | -- | Construct a resource listing object given a swagger version and some 35 | -- resource objects. 36 | resources :: Text -> ResourcesBuilder -> Resources 37 | resources v s = execState s start 38 | where 39 | start = Resources v [] Nothing Nothing Nothing 40 | 41 | type ResourceSt = Common '["description"] Resource 42 | type ResourceBuilder = State ResourceSt () 43 | 44 | -- | Add one resource object to a resource listing given a path and some 45 | -- resource specific values. 46 | api :: Text -> ResourceBuilder -> ResourcesBuilder 47 | api p s = modify $ \r -> 48 | r { apis = value (execState s start) : apis r } 49 | where 50 | start = common $ Resource p Nothing 51 | value c = (other c) { R.description = descr c } 52 | 53 | apiVersion :: Text -> ResourcesBuilder 54 | apiVersion v = modify $ \r -> r { R.apiVersion = Just v } 55 | 56 | type InfoSt = Common '["description"] Info 57 | type InfoBuilder = State InfoSt () 58 | 59 | -- | Set the info object of a resource listing object given a title and 60 | -- other infor object specific values. 61 | info :: Text -> InfoBuilder -> ResourcesBuilder 62 | info t s = modify $ \r -> 63 | r { R.info = Just $ value (execState s start) } 64 | where 65 | start = common $ Info t Nothing Nothing Nothing Nothing Nothing 66 | value c = (other c) { infoDescription = descr c } 67 | 68 | termsOfServiceUrl :: Text -> InfoBuilder 69 | termsOfServiceUrl u = modify $ \c -> c { other = (other c) { R.termsOfServiceUrl = Just u } } 70 | 71 | contact :: Text -> InfoBuilder 72 | contact u = modify $ \c -> c { other = (other c) { R.contact = Just u } } 73 | 74 | license :: Text -> InfoBuilder 75 | license u = modify $ \c -> c { other = (other c) { R.license = Just u } } 76 | 77 | licenseUrl :: Text -> InfoBuilder 78 | licenseUrl u = modify $ \c -> c { other = (other c) { R.licenseUrl = Just u } } 79 | 80 | -- | Add a authorisation object to a resource listing with the given name. 81 | authorisation :: Text -> Authorisation -> ResourcesBuilder 82 | authorisation n a = modify $ \r -> let x = (n, a) in 83 | r { authorisations = maybe (Just [x]) (Just . (x:)) (authorisations r) } 84 | 85 | -------------------------------------------------------------------------------- /src/Data/Swagger/Build/Util.hs: -------------------------------------------------------------------------------- 1 | -- This Source Code Form is subject to the terms of the Mozilla Public 2 | -- License, v. 2.0. If a copy of the MPL was not distributed with this 3 | -- file, You can obtain one at http://mozilla.org/MPL/2.0/. 4 | 5 | {-# LANGUAGE ConstraintKinds #-} 6 | {-# LANGUAGE DataKinds #-} 7 | {-# LANGUAGE OverloadedStrings #-} 8 | {-# LANGUAGE PolyKinds #-} 9 | {-# LANGUAGE TypeFamilies #-} 10 | {-# LANGUAGE TypeOperators #-} 11 | {-# LANGUAGE UndecidableInstances #-} 12 | 13 | module Data.Swagger.Build.Util where 14 | 15 | import Control.Monad.Trans.State.Strict 16 | import Data.Swagger.Model.Api as Api 17 | import Data.Swagger.Model.Authorisation (Scope) 18 | import Data.Text (Text) 19 | import Data.Type.Bool 20 | import Data.Type.Equality 21 | import Prelude 22 | 23 | type Elem a b = IsElem a b ~ 'True 24 | 25 | type family IsElem a b where 26 | IsElem a '[] = 'False 27 | IsElem a (h ': t) = a == h || IsElem a t 28 | 29 | -- | Common contains recurring fields to allow reuse of names. 30 | -- The first type variable is used to constrain the valid fields, e.g. 31 | -- 32 | -- @ 33 | -- type Foo = Common '["description", "models"] Bar 34 | -- @ 35 | -- 36 | -- The various state monad updates check if their field is part of the 37 | -- type-level list, cf. for example 'description'. 38 | -- 39 | data Common f a = Common 40 | { descr :: Maybe Text 41 | , reqrd :: Maybe Bool 42 | , prod :: Maybe [Text] 43 | , cons :: Maybe [Text] 44 | , modls :: Maybe [Model] 45 | , auths :: Maybe [(Text, Maybe Scope)] 46 | , other :: a 47 | } 48 | 49 | common :: a -> Common f a 50 | common = Common Nothing (Just True) Nothing Nothing Nothing Nothing 51 | 52 | description :: Elem "description" f => Text -> State (Common f a) () 53 | description d = modify $ \c -> c { descr = Just d } 54 | 55 | optional :: Elem "required" f => State (Common f a) () 56 | optional = modify $ \c -> c { reqrd = Nothing } 57 | 58 | produces :: Elem "produces" f => Text -> State (Common f a) () 59 | produces t = modify $ \c -> c { prod = maybe (Just [t]) (Just . (t:)) (prod c) } 60 | 61 | consumes :: Elem "consumes" f => Text -> State (Common f a) () 62 | consumes t = modify $ \c -> c { cons = maybe (Just [t]) (Just . (t:)) (cons c) } 63 | 64 | model :: Elem "models" f => Model -> State (Common f a) () 65 | model m = modify $ \c -> c { modls = maybe (Just [m]) (Just . (m:)) (modls c) } 66 | 67 | data Auth = Basic | ApiKey | OAuth2 Scope | None 68 | 69 | authorisation :: Elem "authorisations" f => Auth -> State (Common f a) () 70 | authorisation a = modify $ \c -> 71 | c { auths = maybe (Just (f a)) (Just . (f a ++)) (auths c) } 72 | where 73 | f Basic = [("basic", Nothing)] 74 | f ApiKey = [("apiKey", Nothing)] 75 | f (OAuth2 s) = [("oauth2", Just s)] 76 | f None = [] 77 | 78 | -- | If cases where no build steps are provided but a builder is required 79 | -- 'end' can be used, e.g. @defineModel \"Foo\" end@ 80 | end :: Monad m => m () 81 | end = return () 82 | 83 | -------------------------------------------------------------------------------- /src/Data/Swagger/Model/Api.hs: -------------------------------------------------------------------------------- 1 | -- This Source Code Form is subject to the terms of the Mozilla Public 2 | -- License, v. 2.0. If a copy of the MPL was not distributed with this 3 | -- file, You can obtain one at http://mozilla.org/MPL/2.0/. 4 | 5 | {-# LANGUAGE ExtendedDefaultRules #-} 6 | {-# LANGUAGE GADTs #-} 7 | {-# LANGUAGE OverloadedStrings #-} 8 | {-# LANGUAGE StandaloneDeriving #-} 9 | {-# OPTIONS_GHC -fno-warn-type-defaults #-} 10 | 11 | -- | The 12 | -- part of the swagger specification. For construction please consider 13 | -- using "Data.Swagger.Build.Api". 14 | module Data.Swagger.Model.Api 15 | ( ApiDecl (..) 16 | , API (..) 17 | , Operation (..) 18 | , Parameter (..) 19 | , ParamType (..) 20 | , Response (..) 21 | , Model (..) 22 | , Property (..) 23 | , DataType (..) 24 | , Primitive (..) 25 | , Items (..) 26 | , PrimType (..) 27 | , File (..) 28 | , ModelId 29 | , PropertyName 30 | ) where 31 | 32 | import Control.Applicative 33 | import Data.Aeson hiding (Array) 34 | import Data.Aeson.Types (Pair) 35 | import Data.Swagger.Model.Authorisation (Scope) 36 | import Data.Swagger.Model.Util 37 | import Data.Text (Text) 38 | import Prelude 39 | 40 | default (Text) 41 | 42 | -- | Cf. 43 | data ApiDecl = ApiDecl 44 | { swaggerVersion :: Text 45 | , basePath :: Text 46 | , apis :: [API] 47 | , apiVersion :: Maybe Text 48 | , resourcePath :: Maybe Text 49 | , models :: Maybe [(Text, Model)] 50 | , apiProduces :: Maybe [Text] 51 | , apiConsumes :: Maybe [Text] 52 | , apiAuthorisations :: Maybe [(Text, [Scope])] 53 | } deriving Show 54 | 55 | -- | Cf. 56 | data API = API 57 | { path :: Text 58 | , operations :: [Operation] 59 | , apiDescription :: Maybe Text 60 | } deriving Show 61 | 62 | -- | Cf. 63 | data Operation = Operation 64 | { method :: Text 65 | , nickname :: Text 66 | , returnType :: Either () DataType 67 | , parameters :: [Parameter] 68 | , summary :: Maybe Text 69 | , notes :: Maybe Text 70 | , authorisations :: Maybe [(Text, [Scope])] 71 | , responses :: Maybe [Response] 72 | , produces :: Maybe [Text] 73 | , consumes :: Maybe [Text] 74 | , deprecated :: Maybe Bool 75 | } deriving Show 76 | 77 | -- | Cf. 78 | data Parameter = Parameter 79 | { paramType :: ParamType 80 | , inputType :: Either File DataType 81 | , paramName :: Text 82 | , description :: Maybe Text 83 | , required :: Maybe Bool 84 | , allowMultiple :: Maybe Bool 85 | } deriving Show 86 | 87 | data ParamType 88 | = Path 89 | | Query 90 | | Body 91 | | Header 92 | | Form 93 | deriving (Eq, Show) 94 | 95 | -- | Cf. 96 | data Response = Response 97 | { code :: Int 98 | , message :: Text 99 | , responseModel :: Maybe ModelId 100 | } deriving Show 101 | 102 | type ModelId = Text 103 | type PropertyName = Text 104 | 105 | -- | Cf. 106 | data Model = Model 107 | { modelId :: ModelId 108 | , properties :: [(PropertyName, Property)] 109 | , modelDescription :: Maybe Text 110 | , requiredProps :: Maybe [PropertyName] 111 | , subTypes :: Maybe [Model] 112 | , discriminator :: Maybe PropertyName 113 | } deriving Show 114 | 115 | -- | Cf. 116 | data Property = Property 117 | { propertyType :: DataType 118 | , propDescription :: Maybe Text 119 | } deriving Show 120 | 121 | data DataType where 122 | Prim :: (Show a, ToJSON a) => Primitive a -> DataType 123 | Array :: (Show a, ToJSON a) => Items a -> Maybe Bool -> DataType 124 | Ref :: ModelId -> DataType 125 | 126 | deriving instance Show DataType 127 | 128 | -- | Cf. 129 | data Primitive a = Primitive 130 | { primType :: PrimType 131 | , defaultValue :: Maybe a 132 | , enum :: Maybe [a] 133 | , minVal :: Maybe a 134 | , maxVal :: Maybe a 135 | } deriving Show 136 | 137 | data Items a 138 | = PrimItems (Primitive a) 139 | | ModelItems ModelId 140 | deriving Show 141 | 142 | data PrimType 143 | = PrimInt32 144 | | PrimInt64 145 | | PrimFloat 146 | | PrimDouble 147 | | PrimString 148 | | PrimByte 149 | | PrimBool 150 | | PrimDate 151 | | PrimDateTime 152 | deriving Show 153 | 154 | data File = File deriving Show 155 | 156 | ----------------------------------------------------------------------------- 157 | -- JSON instances 158 | 159 | instance ToJSON ApiDecl where 160 | toJSON a = object 161 | $ "swaggerVersion" .= swaggerVersion a 162 | # "apiVersion" .= apiVersion a 163 | # "basePath" .= basePath a 164 | # "resourcePath" .= resourcePath a 165 | # "apis" .= apis a 166 | # "models" .= (fromPairs <$> models a) 167 | # "produces" .= apiProduces a 168 | # "consumes" .= apiConsumes a 169 | # "authorizations" .= (fromAuth <$> apiAuthorisations a) 170 | # [] 171 | 172 | instance ToJSON API where 173 | toJSON a = object 174 | $ "path" .= path a 175 | # "description" .= apiDescription a 176 | # "operations" .= operations a 177 | # [] 178 | 179 | instance ToJSON Operation where 180 | toJSON a = object 181 | $ "method" .= method a 182 | # "summary" .= summary a 183 | # "notes" .= notes a 184 | # "nickname" .= nickname a 185 | # "authorizations" .= (fromAuth <$> authorisations a) 186 | # "parameters" .= parameters a 187 | # "responseMessages" .= responses a 188 | # "produces" .= produces a 189 | # "consumes" .= consumes a 190 | # "deprecated" .= deprecated a 191 | # either (const ["type" .= "void"]) (fromType False) (returnType a) 192 | 193 | instance ToJSON Parameter where 194 | toJSON a = object 195 | $ "paramType" .= paramType a 196 | # "name" .= paramName a 197 | # "description" .= description a 198 | # "required" .= required a 199 | # "allowMultiple" .= allowMultiple a 200 | # either (const ["type" .= "File"]) (fromType False) (inputType a) 201 | 202 | instance ToJSON ParamType where 203 | toJSON Path = "path" 204 | toJSON Query = "query" 205 | toJSON Body = "body" 206 | toJSON Header = "header" 207 | toJSON Form = "form" 208 | 209 | instance ToJSON Response where 210 | toJSON a = object 211 | $ "code" .= code a 212 | # "message" .= message a 213 | # "responseModel" .= responseModel a 214 | # [] 215 | 216 | instance ToJSON Model where 217 | toJSON a = object 218 | $ "id" .= modelId a 219 | # "description" .= modelDescription a 220 | # "required" .= requiredProps a 221 | # "properties" .= fromPairs (properties a) 222 | # "subTypes" .= (map modelId <$> subTypes a) 223 | # "discriminator" .= discriminator a 224 | # [] 225 | 226 | instance ToJSON Property where 227 | toJSON a = object 228 | $ "description" .= propDescription a 229 | # fromType True (propertyType a) 230 | 231 | fromType :: Bool -> DataType -> [Pair] 232 | fromType _ (Prim p) = fromPrim p 233 | fromType _ (Array i b) = fromArray i b 234 | fromType False (Ref r) = ["type" .= r] 235 | fromType True (Ref r) = ["$ref" .= r] 236 | 237 | fromPrim :: ToJSON a => Primitive a -> [Pair] 238 | fromPrim p = 239 | "defaultValue" .= defaultValue p 240 | # "enum" .= enum p 241 | # "minimum" .= minVal p 242 | # "maximum" .= maxVal p 243 | # fromPrimType (primType p) 244 | 245 | fromArray :: ToJSON a => Items a -> Maybe Bool -> [Pair] 246 | fromArray i b = 247 | "type" .= "array" 248 | # "items" .= fromPairs (fromItems i) 249 | # "uniqueItems" .= b 250 | # [] 251 | 252 | fromPrimType :: PrimType -> [Pair] 253 | fromPrimType PrimInt32 = ["type" .= "integer", "format" .= "int32" ] 254 | fromPrimType PrimInt64 = ["type" .= "integer", "format" .= "int64" ] 255 | fromPrimType PrimFloat = ["type" .= "number", "format" .= "float" ] 256 | fromPrimType PrimDouble = ["type" .= "number", "format" .= "double" ] 257 | fromPrimType PrimString = ["type" .= "string"] 258 | fromPrimType PrimByte = ["type" .= "string", "format" .= "byte" ] 259 | fromPrimType PrimBool = ["type" .= "boolean"] 260 | fromPrimType PrimDate = ["type" .= "string", "format" .= "date" ] 261 | fromPrimType PrimDateTime = ["type" .= "string", "format" .= "date-time" ] 262 | 263 | fromItems :: ToJSON a => Items a -> [Pair] 264 | fromItems (ModelItems i) = [ "$ref" .= i ] 265 | fromItems (PrimItems p) = fromPrim p 266 | 267 | fromAuth :: [(Text, [Scope])] -> Value 268 | fromAuth = fromPairs . map (\x -> (fst x, map toJSON (snd x))) 269 | 270 | -------------------------------------------------------------------------------- /src/Data/Swagger/Model/Authorisation.hs: -------------------------------------------------------------------------------- 1 | -- This Source Code Form is subject to the terms of the Mozilla Public 2 | -- License, v. 2.0. If a copy of the MPL was not distributed with this 3 | -- file, You can obtain one at http://mozilla.org/MPL/2.0/. 4 | 5 | {-# LANGUAGE ExtendedDefaultRules #-} 6 | {-# LANGUAGE OverloadedStrings #-} 7 | {-# OPTIONS_GHC -fno-warn-type-defaults #-} 8 | 9 | -- | The 10 | -- part of the swagger specification. For construction please consider 11 | -- using "Data.Swagger.Build.Authorisation". 12 | module Data.Swagger.Model.Authorisation where 13 | 14 | import Data.Aeson 15 | import Data.Swagger.Model.Util 16 | import Data.Text (Text) 17 | 18 | default (Text) 19 | 20 | -- | Cf. 21 | data Authorisation 22 | = BasicAuth 23 | | ApiKey 24 | { passAs :: PassMethod 25 | , keyname :: Text 26 | } 27 | | OAuth2 28 | { scopes :: Maybe [Scope] 29 | , grantTypes :: GrantTypes 30 | } 31 | deriving Show 32 | 33 | data PassMethod 34 | = PassAsHeader 35 | | PassAsQuery 36 | deriving (Eq, Show) 37 | 38 | -- | Cf. 39 | data Scope = Scope 40 | { scope :: Text 41 | , description :: Maybe Text 42 | } deriving Show 43 | 44 | -- | Cf. 45 | data GrantTypes = GrantTypes 46 | { implicit :: Maybe ImplicitGrant 47 | , authCode :: Maybe AuthCode 48 | } deriving Show 49 | 50 | -- | Cf. 51 | data ImplicitGrant = ImplicitGrant 52 | { loginEndpoint :: LoginEndpoint 53 | , tokenName :: Maybe Text 54 | } deriving Show 55 | 56 | newtype LoginEndpoint = LoginEndpoint 57 | { loginUrl :: Text 58 | } deriving Show 59 | 60 | -- | Cf. 61 | data AuthCode = AuthCode 62 | { tokenRequestEndpoint :: TokenRequestEndpoint 63 | , tokenEndpoint :: TokenEndpoint 64 | } deriving Show 65 | 66 | -- | Cf. 67 | data TokenRequestEndpoint = TokenRequestEndpoint 68 | { tokenRequestUrl :: Text 69 | , clientIdName :: Maybe Text 70 | , clientSecretName :: Maybe Text 71 | } deriving Show 72 | 73 | -- | Cf. 74 | data TokenEndpoint = TokenEndpoint 75 | { tokenEndpointUrl :: Text 76 | , tokenEndpointTokenName :: Maybe Text 77 | } deriving Show 78 | 79 | ----------------------------------------------------------------------------- 80 | -- JSON instances 81 | 82 | instance ToJSON Authorisation where 83 | toJSON BasicAuth = object [ "type" .= "basicAuth" ] 84 | toJSON (ApiKey p k) = object 85 | $ "type" .= "apiKey" 86 | # "passAs" .= p 87 | # "keyname" .= k 88 | # [] 89 | toJSON (OAuth2 s g) = object 90 | $ "type" .= "oauth2" 91 | # "scopes" .= s 92 | # "grantTypes" .= g 93 | # [] 94 | 95 | instance ToJSON PassMethod where 96 | toJSON PassAsHeader = "header" 97 | toJSON PassAsQuery = "query" 98 | 99 | instance ToJSON Scope where 100 | toJSON a = object 101 | $ "scope" .= scope a 102 | # "description" .= description a 103 | # [] 104 | 105 | instance ToJSON GrantTypes where 106 | toJSON a = object 107 | $ "implicit" .= implicit a 108 | # "authorization_code" .= authCode a 109 | # [] 110 | 111 | instance ToJSON ImplicitGrant where 112 | toJSON a = object 113 | $ "loginEndpoint" .= loginEndpoint a 114 | # "tokenName" .= tokenName a 115 | # [] 116 | 117 | instance ToJSON AuthCode where 118 | toJSON a = object 119 | $ "tokenRequestEndpoint" .= tokenRequestEndpoint a 120 | # "tokenEndpoint" .= tokenEndpoint a 121 | # [] 122 | 123 | instance ToJSON LoginEndpoint where 124 | toJSON a = object [ "url" .= loginUrl a ] 125 | 126 | instance ToJSON TokenRequestEndpoint where 127 | toJSON a = object 128 | $ "url" .= tokenRequestUrl a 129 | # "clientIdName" .= clientIdName a 130 | # "clientSecretName" .= clientSecretName a 131 | # [] 132 | 133 | instance ToJSON TokenEndpoint where 134 | toJSON a = object 135 | $ "url" .= tokenEndpointUrl a 136 | # "tokenName" .= tokenEndpointTokenName a 137 | # [] 138 | 139 | -------------------------------------------------------------------------------- /src/Data/Swagger/Model/Resource.hs: -------------------------------------------------------------------------------- 1 | -- This Source Code Form is subject to the terms of the Mozilla Public 2 | -- License, v. 2.0. If a copy of the MPL was not distributed with this 3 | -- file, You can obtain one at http://mozilla.org/MPL/2.0/. 4 | 5 | {-# LANGUAGE ExtendedDefaultRules #-} 6 | {-# LANGUAGE OverloadedStrings #-} 7 | {-# OPTIONS_GHC -fno-warn-type-defaults #-} 8 | 9 | -- | The 10 | -- part of the swagger specification. For construction please consider 11 | -- using "Data.Swagger.Build.Resource". 12 | module Data.Swagger.Model.Resource where 13 | 14 | import Data.Aeson 15 | import Data.Swagger.Model.Authorisation (Authorisation) 16 | import Data.Swagger.Model.Util 17 | import Data.Text (Text) 18 | 19 | default (Text) 20 | 21 | -- | Cf. 22 | data Resources = Resources 23 | { swaggerVersion :: Text 24 | , apis :: [Resource] 25 | , apiVersion :: Maybe Text 26 | , info :: Maybe Info 27 | , authorisations :: Maybe [(Text, Authorisation)] 28 | } deriving Show 29 | 30 | -- | Cf. 31 | data Resource = Resource 32 | { path :: Text 33 | , description :: Maybe Text 34 | } deriving Show 35 | 36 | -- | Cf. 37 | data Info = Info 38 | { title :: Text 39 | , infoDescription :: Maybe Text 40 | , termsOfServiceUrl :: Maybe Text 41 | , contact :: Maybe Text 42 | , license :: Maybe Text 43 | , licenseUrl :: Maybe Text 44 | } deriving Show 45 | 46 | ----------------------------------------------------------------------------- 47 | -- JSON instances 48 | 49 | instance ToJSON Resources where 50 | toJSON a = object 51 | $ "swaggerVersion" .= swaggerVersion a 52 | # "apis" .= apis a 53 | # "apiVersion" .= apiVersion a 54 | # "info" .= info a 55 | # "authorizations" .= authorisations a 56 | # [] 57 | 58 | instance ToJSON Resource where 59 | toJSON a = object 60 | $ "path" .= path a 61 | # "description" .= description a 62 | # [] 63 | 64 | instance ToJSON Info where 65 | toJSON a = object 66 | $ "title" .= title a 67 | # "description" .= infoDescription a 68 | # "termsOfServiceUrl" .= termsOfServiceUrl a 69 | # "contact" .= contact a 70 | # "license" .= license a 71 | # "licenseUrl" .= licenseUrl a 72 | # [] 73 | -------------------------------------------------------------------------------- /src/Data/Swagger/Model/Util.hs: -------------------------------------------------------------------------------- 1 | -- This Source Code Form is subject to the terms of the Mozilla Public 2 | -- License, v. 2.0. If a copy of the MPL was not distributed with this 3 | -- file, You can obtain one at http://mozilla.org/MPL/2.0/. 4 | 5 | module Data.Swagger.Model.Util where 6 | 7 | import Data.Aeson hiding (Array) 8 | import Data.Aeson.Types (Pair) 9 | import Data.Text (Text) 10 | 11 | fromPairs :: ToJSON a => [(Text, a)] -> Value 12 | fromPairs = object . map (\p -> fst p .= toJSON (snd p)) 13 | 14 | infixr 5 # 15 | 16 | (#) :: Pair -> [Pair] -> [Pair] 17 | (_, Null) # pp = pp 18 | p # pp = p:pp 19 | {-# INLINE (#) #-} 20 | 21 | -------------------------------------------------------------------------------- /swagger.cabal: -------------------------------------------------------------------------------- 1 | name: swagger 2 | version: 0.2.2 3 | synopsis: Implementation of swagger data model 4 | author: Toralf Wittner 5 | maintainer: Toralf Wittner 6 | copyright: (C) 2014-2015 Toralf Wittner 7 | license: OtherLicense 8 | license-file: LICENSE 9 | category: Data 10 | build-type: Simple 11 | cabal-version: >= 1.10 12 | 13 | description: 14 | Implementation of Swagger specification version 1.2 as defined in 15 | 16 | 17 | source-repository head 18 | type: git 19 | location: git://github.com/twittner/swagger.git 20 | 21 | library 22 | default-language: Haskell2010 23 | hs-source-dirs: src 24 | ghc-options: -Wall -O2 -fwarn-tabs 25 | ghc-prof-options: -prof -auto-all 26 | 27 | exposed-modules: 28 | Data.Swagger.Build.Api 29 | Data.Swagger.Build.Authorisation 30 | Data.Swagger.Build.Resource 31 | Data.Swagger.Model.Api 32 | Data.Swagger.Model.Authorisation 33 | Data.Swagger.Model.Resource 34 | 35 | other-modules: 36 | Data.Swagger.Build.Util 37 | Data.Swagger.Model.Util 38 | 39 | build-depends: 40 | aeson >= 0.6 && < 1.0 41 | , base == 4.* 42 | , bytestring >= 0.10.4 && < 1.0 43 | , text >= 0.11 && < 2.0 44 | , time >= 1.4 && < 2.0 45 | , transformers >= 0.3 && < 1.0 46 | 47 | test-suite tests 48 | type: exitcode-stdio-1.0 49 | default-language: Haskell2010 50 | main-is: Main.hs 51 | hs-source-dirs: test 52 | ghc-options: -threaded -Wall -O2 -fwarn-tabs 53 | other-modules: Test.Api 54 | 55 | build-depends: 56 | aeson 57 | , base 58 | , bytestring 59 | , swagger 60 | , tasty >= 0.8 61 | , tasty-hunit >= 0.8 62 | 63 | -------------------------------------------------------------------------------- /test/Main.hs: -------------------------------------------------------------------------------- 1 | module Main (main) where 2 | 3 | import Test.Api 4 | import Test.Tasty 5 | 6 | main :: IO () 7 | main = defaultMain tests 8 | -------------------------------------------------------------------------------- /test/Test/Api.hs: -------------------------------------------------------------------------------- 1 | -- This Source Code Form is subject to the terms of the Mozilla Public 2 | -- License, v. 2.0. If a copy of the MPL was not distributed with this 3 | -- file, You can obtain one at http://mozilla.org/MPL/2.0/. 4 | 5 | {-# LANGUAGE OverloadedStrings #-} 6 | 7 | module Test.Api where 8 | 9 | import Data.Aeson 10 | import Data.Swagger.Build.Api 11 | import Prelude hiding (min, max) 12 | import Test.Tasty 13 | import Test.Tasty.HUnit 14 | 15 | import qualified Data.ByteString.Lazy.Char8 as B 16 | 17 | tests :: TestTree 18 | tests = testGroup "example declarations" 19 | [ testCase "api" (render apiDecl) 20 | , testCase "model foo" (render foo) 21 | ] 22 | where 23 | render :: ToJSON a => a -> IO () 24 | render = B.putStrLn . encode 25 | 26 | apiDecl :: ApiDecl 27 | apiDecl = declare "http://petstore.swagger.wordnik.com/api" "1.2" $ do 28 | apiVersion "1.0.0" 29 | resourcePath "/store" 30 | model foo 31 | model bar 32 | produces "application/json" 33 | produces "text/html" 34 | produces "text/plain" 35 | api "/store/order/{orderId}" $ do 36 | operation "GET" "foo" $ do 37 | summary "give me some foo" 38 | notes "but only the good one" 39 | returns (ref foo) 40 | parameter Header "type" (string $ enum ["bar", "baz"]) $ do 41 | description "specifies the type of foo" 42 | optional 43 | parameter Query "format" (string $ enum ["plain", "html"]) $ 44 | description "output format" 45 | parameter Query "size" (int32 $ min 1 . max 100 . def 10) $ 46 | description "amount of foo" 47 | produces "application/json" 48 | produces "text/html" 49 | response 200 "OK" (model foo) 50 | response 400 "Bad Request" end 51 | operation "POST" "foo" $ do 52 | summary "something else" 53 | deprecated 54 | 55 | foo :: Model 56 | foo = defineModel "Foo" $ do 57 | description "A bottle of foo" 58 | property "rabbit" (array int32') $ 59 | description "A foo's rabbit" 60 | property "white" (bool $ def False) $ do 61 | description "a white rabbit?" 62 | optional 63 | property "bar" (ref bar) end 64 | 65 | bar :: Model 66 | bar = defineModel "Bar" $ 67 | property "foo" (ref foo) end 68 | 69 | --------------------------------------------------------------------------------