swagger now includes UI

This commit is contained in:
nek0 2022-07-18 06:34:46 +02:00
parent 7aea50af90
commit 2ddf3d907b
3 changed files with 59 additions and 47 deletions

View File

@ -5,6 +5,7 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
module Main where
import Prelude as P
@ -12,6 +13,8 @@ import Prelude as P
import Servant
import Servant.Server.Experimental.Auth
import qualified Servant.OpenApi as OA
import Servant.Swagger.UI
import Servant.Swagger.UI.Core
import Servant.RawM
import Data.Set as S (empty)
@ -24,6 +27,7 @@ import Data.IP
import qualified Data.OpenApi as OA hiding (Server)
import Data.Typeable
import Data.Data (Typeable)
import Data.Tagged
import Database.PostgreSQL.Simple
import Database.PostgreSQL.Simple.Migration
@ -60,6 +64,7 @@ import Janitor
-- import Middleware
import Paths_mateamt (version)
import Control.Monad.Except (runExceptT)
main :: IO ()
main = do
@ -162,59 +167,65 @@ main = do
app :: ReadState -> Application
-- app conn = serveWithContext userApi genAuthServerContext (users conn)
app initState =
serveWithContext combinedAPI (genAuthServerContext (rsConnection initState)) $
hoistServerWithContext
combinedAPI
authProxy
(`runReaderT` initState)
( mateSwagger :<|>
( authGet :<|>
authSend :<|>
authLogout :<|>
app initState =
serveWithContext combinedAPI (genAuthServerContext (rsConnection initState)) server
where
server :: Server CombinedAPI
server = appToServer initState mateAPI thisApi :<|>
swaggerSchemaUIServer mateSwagger
authManageList :<|>
authManageNewAuth :<|>
authManageDeleteAuth :<|>
appToServer initState myApi =
hoistServerWithContext
myApi
authProxy
(`runReaderT` initState)
userNew :<|>
userGet :<|>
userUpdate :<|>
userList :<|>
userRecharge :<|>
userTransfer :<|>
thisApi :: ServerT MateAPI MateHandler
thisApi =
authGet :<|>
authSend :<|>
authLogout :<|>
productNew :<|>
productOverview :<|>
productStockRefill :<|>
productStockUpdate :<|>
productList :<|>
productShortList :<|>
authManageList :<|>
authManageNewAuth :<|>
authManageDeleteAuth :<|>
buy :<|>
userNew :<|>
userGet :<|>
userUpdate :<|>
userList :<|>
userRecharge :<|>
userTransfer :<|>
journalShow :<|>
journalCheck :<|>
productNew :<|>
productOverview :<|>
productStockRefill :<|>
productStockUpdate :<|>
productList :<|>
productShortList :<|>
avatarGet :<|>
avatarInsert :<|>
avatarUpdate :<|>
avatarList :<|>
buy :<|>
roleList :<|>
roleNew :<|>
roleUpdate :<|>
roleDelete :<|>
roleAssociationList :<|>
roleAssociationSubmit :<|>
roleAssociationDelete :<|>
journalShow :<|>
journalCheck :<|>
metaGet
)
)
avatarGet :<|>
avatarInsert :<|>
avatarUpdate :<|>
avatarList :<|>
mateSwagger :: ReaderT ReadState Handler OA.OpenApi
mateSwagger = return $ OA.toOpenApi mateAPI
roleList :<|>
roleNew :<|>
roleUpdate :<|>
roleDelete :<|>
roleAssociationList :<|>
roleAssociationSubmit :<|>
roleAssociationDelete :<|>
metaGet
mateSwagger :: OA.OpenApi
mateSwagger = OA.toOpenApi mateAPI
& OA.info.OA.title .~ "Mateamt API"
& OA.info.OA.version .~ "1.0"
& OA.info.OA.description ?~ "AN API to buy Mate and other products from your local Hackerspace or event."
@ -229,7 +240,7 @@ swaggerAPI = Proxy
combinedAPI :: Proxy CombinedAPI
combinedAPI = Proxy
type CombinedAPI = SwaggerAPI :<|> MateAPI
type CombinedAPI = MateAPI :<|> SwaggerSchemaUI "swagger-ui" "swagger.json"
authProxy :: Proxy '[ AuthHandler Request (Maybe (Int, AuthMethod)) ]
authProxy = Proxy

View File

@ -149,6 +149,8 @@ executable mateamt
, servant-server
, servant-rawm
, servant-openapi3
, servant-swagger-ui
, servant-swagger-ui-core
, warp
, wai
, wai-logger
@ -158,6 +160,7 @@ executable mateamt
, case-insensitive
, iproute
, clock
, tagged
hs-source-dirs: app
default-language: Haskell2010

View File

@ -16,8 +16,6 @@ import Data.Proxy
import Servant.RawM
import Servant.RawM.Server ()
import Network.Wai (Application)
-- internal imports
import Types