32 lines
1.0 KiB
Haskell
32 lines
1.0 KiB
Haskell
{-# LANGUAGE OverloadedRecordDot #-}
|
|
{-# LANGUAGE TypeFamilies #-}
|
|
|
|
module Yore.Servant (GetSendfile, Sendfile (..)) where
|
|
|
|
import Network.HTTP.Types (ResponseHeaders, status200)
|
|
import Network.Wai (responseFile)
|
|
import Servant (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
|