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
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)
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")
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 "")
swaggerAversAPI :: Swagger
swaggerAversAPI = toSwagger (Proxy :: Proxy AversAPI)
& info.title .~ "Avers API"
& info.version .~ "0.0.1"
& info.description ?~ "TODO"
& info.license ?~ License "MIT" (Just (URL "http://mit.com"))