39 lines
1.2 KiB
Haskell
39 lines
1.2 KiB
Haskell
{-# LANGUAGE OverloadedRecordDot #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE TypeFamilies #-}
|
|
|
|
module Yore.Servant (GetSendfile, Sendfile (..), HTML) where
|
|
|
|
import Network.HTTP.Media ((//), (/:))
|
|
import Network.HTTP.Types (ResponseHeaders, status200)
|
|
import Network.Wai (responseFile)
|
|
import Servant (Accept (..), HasServer (..))
|
|
import Servant.Server.Internal.Delayed (runAction)
|
|
import Servant.Server.Internal.RouteResult (RouteResult (..))
|
|
import Servant.Server.Internal.Router (Router' (..))
|
|
|
|
-- | Servant route type that responds with a file using @sendfile@.
|
|
data GetSendfile
|
|
|
|
data Sendfile = Sendfile
|
|
{ headers :: ResponseHeaders
|
|
-- ^ The headers to send along with the file, e.g. @content-type@ or cache information.
|
|
, path :: FilePath
|
|
-- ^ The file to respond with.
|
|
}
|
|
deriving (Show)
|
|
|
|
instance HasServer GetSendfile context where
|
|
type ServerT GetSendfile m = m Sendfile
|
|
|
|
hoistServerWithContext _ _ nt = nt
|
|
|
|
route _ _ action = RawRouter $ \env request respond ->
|
|
runAction action env request respond $ \sendfile ->
|
|
Route $ responseFile status200 sendfile.headers sendfile.path Nothing
|
|
|
|
data HTML
|
|
|
|
instance Accept HTML where
|
|
contentType _ = "text" // "html" /: ("charset", "utf-8")
|