module Servant.RawM.Internal.Server where
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Resource (runResourceT)
import Data.ByteString (ByteString)
import Data.Proxy (Proxy(Proxy))
import Network.Wai
(Application, Request, Response, ResponseReceived)
import Network.Wai.Application.Static
(StaticSettings, defaultFileServerSettings, defaultWebAppSettings,
embeddedSettings, staticApp, webAppSettingsWithLookup)
import Servant (Context, HasServer(route), Handler, ServerT, runHandler)
import Servant.Server.Internal
(Delayed, Router'(RawRouter), RouteResult(Fail, FailFatal, Route), responseServantErr,
runDelayed)
import System.FilePath (addTrailingPathSeparator)
import WaiAppStatic.Storage.Filesystem (ETagLookup)
import Servant.RawM.Internal.API (RawM)
instance HasServer RawM context where
type ServerT RawM m = m Application
route
:: forall env.
Proxy RawM
-> Context context
-> Delayed env (Handler Application)
-> Router' env (Request -> (RouteResult Response -> IO ResponseReceived) -> IO ResponseReceived)
route Proxy _ rawApplication = RawRouter go
where
go
:: env
-> Request
-> (RouteResult Response -> IO ResponseReceived)
-> IO ResponseReceived
go env request respond =
runResourceT $ do
routeRes <- runDelayed rawApplication env request
liftIO $
case routeRes of
(Fail e) -> respond $ Fail e
(FailFatal e) -> respond $ FailFatal e
(Route handlerApp) -> do
eitherApp <- runHandler handlerApp
case eitherApp of
Left err -> respond . Route $ responseServantErr err
Right app -> app request (respond . Route)
serveDirectoryWebApp :: Applicative m => FilePath -> ServerT RawM m
serveDirectoryWebApp = serveDirectoryWith . defaultWebAppSettings . addTrailingPathSeparator
serveDirectoryFileServer :: Applicative m => FilePath -> ServerT RawM m
serveDirectoryFileServer = serveDirectoryWith . defaultFileServerSettings . addTrailingPathSeparator
serveDirectoryWebAppLookup :: Applicative m => ETagLookup -> FilePath -> ServerT RawM m
serveDirectoryWebAppLookup etag =
serveDirectoryWith . flip webAppSettingsWithLookup etag . addTrailingPathSeparator
serveDirectoryEmbedded :: Applicative m => [(FilePath, ByteString)] -> ServerT RawM m
serveDirectoryEmbedded files = serveDirectoryWith (embeddedSettings files)
serveDirectoryWith :: Applicative m => StaticSettings -> ServerT RawM m
serveDirectoryWith = pure . staticApp