avers-api-docs (empty) → 0.0.17.0
raw patch · 4 files changed
+273/−0 lines, 4 filesdep +aesondep +aversdep +avers-apisetup-changed
Dependencies added: aeson, avers, avers-api, base, cookie, lens, servant, servant-swagger, swagger2, text, unordered-containers
Files
- LICENSE +21/−0
- Setup.hs +2/−0
- avers-api-docs.cabal +38/−0
- src/Avers/API/Documentation.hs +212/−0
+ LICENSE view
@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2016 Tomas Carnecky++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ avers-api-docs.cabal view
@@ -0,0 +1,38 @@+name: avers-api-docs+version: 0.0.17.0+cabal-version: >=1.10+build-type: Simple+license: MIT+license-file: LICENSE+copyright: 2016 Tomas Carnecky+maintainer: tomas.carnecky@gmail.com+homepage: http://github.com/wereHamster/avers-api-docs+synopsis: Swagger documentation for the Avers API+description:+ See README.md+category: Avers+author: Tomas Carnecky++source-repository head+ type: git+ location: https://github.com/wereHamster/avers-api-docs++library+ exposed-modules:+ Avers.API.Documentation+ build-depends:+ base >=4.7 && <5,+ aeson >=1.0.2.0 && <1.1,+ avers -any,+ avers-api -any,+ cookie >=0.4.2.1 && <0.5,+ lens ==4.14.*,+ servant >=0.9.0.1 && <0.10,+ servant-swagger >=1.1.2 && <1.2,+ swagger2 >=2.1.3 && <2.2,+ text >=1.2.2.1 && <1.3,+ unordered-containers >=0.2.7.1 && <0.3+ default-language: Haskell2010+ hs-source-dirs: src+ ghc-options: -Wall+
+ src/Avers/API/Documentation.hs view
@@ -0,0 +1,212 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++{-# OPTIONS_GHC -fno-warn-orphans #-}++module Avers.API.Documentation+ ( swaggerAversAPI+ ) where+++import Control.Lens++import Data.Proxy+import Data.Swagger hiding (Operation, Header)+import Data.Aeson+import Data.Monoid+import Data.Text (Text)+import qualified Data.Text as Text+import Data.Char++import Servant.API hiding (Patch)+import Servant.Swagger++import Web.Cookie++import Avers.Types+import Avers.API++++-- | Add parameter to every operation in the spec.+addParam :: Param -> Swagger -> Swagger+addParam param = allOperations.parameters %~ (Inline param :)++addDefaultResponse400 :: ParamName -> Swagger -> Swagger+addDefaultResponse400 n = setResponseWith (\old _new -> alter400 old) 400 (pure response400)+ where+ description400 = "Invalid " <> n+ alter400 = description %~ (<> (" or " <> n))+ response400 = mempty & description .~ description400++++--------------------------------------------------------------------------------+schemaOptions :: String -> SchemaOptions+schemaOptions p = defaultSchemaOptions+ { fieldLabelModifier = dropPrefix p+ , constructorTagModifier = map toLower+ }++dropPrefix :: String -> String -> String+dropPrefix p x = toLower (head rest) : tail rest+ where rest = drop (length p) x++++--------------------------------------------------------------------------------+instance (HasSwagger sub) => HasSwagger (Credentials :> sub) where+ toSwagger _ = toSwagger (Proxy :: Proxy sub)+ & addParam param+ & addDefaultResponse400 (Text.pack paramName)+ where+ paramName = "Cookie"+ param = mempty+ & name .~ (Text.pack paramName)+ & schema .~ ParamOther (mempty+ & in_ .~ ParamHeader+ & paramSchema .~ toParamSchema (Proxy :: Proxy Text))+++--------------------------------------------------------------------------------+instance (HasSwagger sub) => HasSwagger (SessionId :> sub) where+ toSwagger _ = toSwagger (Proxy :: Proxy sub)+ & addParam param+ & addDefaultResponse400 (Text.pack paramName)+ where+ paramName = "Cookie"+ param = mempty+ & name .~ (Text.pack paramName)+ & schema .~ ParamOther (mempty+ & in_ .~ ParamHeader+ & paramSchema .~ toParamSchema (Proxy :: Proxy Text))++++--------------------------------------------------------------------------------+instance ToSchema Value where+ declareNamedSchema _ = pure (NamedSchema (Just "Value") (mempty & type_ .~ SwaggerObject))+++--------------------------------------------------------------------------------+instance ToParamSchema ObjectId where+ toParamSchema _ = toParamSchema (Proxy :: Proxy Text)++instance ToSchema ObjectId where+ declareNamedSchema a = pure (NamedSchema (Just "ObjectId") (paramSchemaToSchema a))+++instance ToParamSchema ObjId+instance ToSchema ObjId+instance ToParamSchema RevId+instance ToSchema RevId+instance ToSchema SecretId+instance ToSchema SessionId+instance ToSchema BlobId+instance ToParamSchema BlobId+instance ToSchema Path+++instance ToParamSchema SetCookie where+ toParamSchema _ = toParamSchema (Proxy :: Proxy Text)++instance ToSchema BlobContent where+ declareNamedSchema _ = pure (NamedSchema (Just "BlobContent") binarySchema)+++--------------------------------------------------------------------------------+-- FIXME: This doesn't generate a correct representation of an 'Operation'+-- object. May need to declare it manually :(+instance ToSchema Operation where+ declareNamedSchema = genericDeclareNamedSchema (schemaOptions "op")+++--------------------------------------------------------------------------------+instance ToSchema Patch where+ declareNamedSchema = genericDeclareNamedSchema (schemaOptions "patch")++++instance ToSchema CreateObjectBody where+ declareNamedSchema = genericDeclareNamedSchema (schemaOptions "cob")+instance ToSchema CreateObjectResponse where+ declareNamedSchema = genericDeclareNamedSchema (schemaOptions "cor")+++instance ToSchema LookupObjectResponse where+ declareNamedSchema = genericDeclareNamedSchema (schemaOptions "lor")+++instance ToSchema PatchObjectBody where+ declareNamedSchema = genericDeclareNamedSchema (schemaOptions "pob")+instance ToSchema PatchObjectResponse where+ declareNamedSchema = genericDeclareNamedSchema (schemaOptions "por")+++instance ToSchema ObjectChangeNotification where+ declareNamedSchema = genericDeclareNamedSchema (schemaOptions "cob")+++-- LookupPatchResponse is a type synonym for Patch+-- instance ToSchema LookupPatchResponse+++instance ToSchema CreateReleaseBody where+ declareNamedSchema = genericDeclareNamedSchema (schemaOptions "crb")+instance ToSchema CreateReleaseResponse where+ declareNamedSchema = genericDeclareNamedSchema (schemaOptions "crr")+++instance ToSchema LookupReleaseResponse where+ declareNamedSchema = genericDeclareNamedSchema (schemaOptions "lrr")++instance ToSchema LookupLatestReleaseResponse where+ declareNamedSchema = genericDeclareNamedSchema (schemaOptions "llrr")+++instance ToSchema CreateSessionBody where+ declareNamedSchema = genericDeclareNamedSchema (schemaOptions "csb")+instance ToSchema CreateSessionResponse where+ declareNamedSchema = genericDeclareNamedSchema (schemaOptions "csr")+++instance ToSchema LookupSessionResponse where+ declareNamedSchema = genericDeclareNamedSchema (schemaOptions "lsr")+++instance ToSchema ChangeSecretBody where+ declareNamedSchema = genericDeclareNamedSchema (schemaOptions "csb")+++instance ToSchema UploadBlobResponse where+ declareNamedSchema = genericDeclareNamedSchema (schemaOptions "")+++instance ToSchema LookupBlobResponse where+ declareNamedSchema = genericDeclareNamedSchema (schemaOptions "")+++instance ToSchema SignupBody where+ declareNamedSchema = genericDeclareNamedSchema (schemaOptions "")++instance ToSchema SignupResponse where+ declareNamedSchema = genericDeclareNamedSchema (schemaOptions "")++++--------------------------------------------------------------------------------++swaggerAversAPI :: Swagger+swaggerAversAPI = toSwagger (Proxy :: Proxy AversAPI)+ & info.title .~ "Avers API"+ & info.version .~ "0.0.1" -- FIXME: Get the version from the avers-api package+ & info.description ?~ "TODO"+ & info.license ?~ License "MIT" (Just (URL "http://mit.com"))