diff --git a/app/Main.hs b/app/Main.hs index 04487b4..15752b3 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -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 diff --git a/mateamt.cabal b/mateamt.cabal index 8ad18ea..469286d 100644 --- a/mateamt.cabal +++ b/mateamt.cabal @@ -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 diff --git a/src/API.hs b/src/API.hs index 42820c3..6998769 100644 --- a/src/API.hs +++ b/src/API.hs @@ -16,8 +16,6 @@ import Data.Proxy import Servant.RawM import Servant.RawM.Server () -import Network.Wai (Application) - -- internal imports import Types