977a8b0aaa
This code allows to embed static content such as javascript and CSS into the executable at compile time so that it does not need to be distributed along with the server. In addition, this module supports processing of these resources before they are embedded, such as javascript or CSS minification. Finally, there is a development mode which will recompute each resource on every request, so allow a simple browser refresh to reload potentially changed javascript or CSS. Documentation is in the haddock comment in Servant.Server.Embedded.hs
50 lines
1.6 KiB
Haskell
50 lines
1.6 KiB
Haskell
module Servant.Server.Embedded.Types (
|
|
Etag(..)
|
|
, EmbeddedContent(..)
|
|
, EmbeddedEntry(..)
|
|
) where
|
|
|
|
import Data.Proxy (Proxy(..))
|
|
import GHC.TypeLits (Symbol)
|
|
import Network.Wai
|
|
import Servant.Server
|
|
import Servant.Server.Internal
|
|
import Servant.Utils.Links
|
|
|
|
import qualified Data.ByteString as B
|
|
import qualified Data.Text as T
|
|
import qualified Data.Text.Encoding as T
|
|
|
|
-- | Endpoint for embedded content.
|
|
data EmbeddedContent (mime :: Symbol) = EmbeddedContent
|
|
|
|
-- | An etag is used to return 304 not modified responses and cache control headers.
|
|
-- If the content changes, the etag must change as well.
|
|
newtype Etag = Etag B.ByteString
|
|
|
|
-- | This structure exists at runtime and describes content that has
|
|
-- been embedded.
|
|
data EmbeddedEntry (mime :: Symbol) = EmbeddedEntry {
|
|
eeEtag :: Maybe Etag
|
|
, eeApp :: Application
|
|
}
|
|
|
|
instance HasServer (EmbeddedContent mime) config where
|
|
type ServerT (EmbeddedContent mime) m = EmbeddedEntry mime
|
|
route Proxy _ entry = LeafRouter $ \request respond -> do
|
|
r <- runDelayed entry
|
|
case r of
|
|
Route e -> (eeApp e) request (respond . Route)
|
|
Fail a -> respond $ Fail a
|
|
FailFatal e -> respond $ FailFatal e
|
|
|
|
instance HasLink (EmbeddedContent mime) where
|
|
type MkLink (EmbeddedContent mime) = Maybe Etag -> URI
|
|
toLink Proxy lnk metag = uri { uriQuery = q }
|
|
where
|
|
uri = linkURI lnk
|
|
q = case (uriQuery uri, metag) of
|
|
("", Just (Etag etag)) -> "?etag=" ++ T.unpack (T.decodeUtf8 etag)
|
|
(query, Just (Etag etag)) -> query ++ "&etag=" ++ T.unpack (T.decodeUtf8 etag)
|
|
(query, _) -> query
|