{-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings, MagicHash, CPP #-}
module WaiAppStatic.Storage.Embedded.TH(
    Etag
  , EmbeddableEntry(..)
  , mkSettings
) where

import Data.ByteString.Builder.Extra (byteStringInsert)
import Codec.Compression.GZip (compress)
import Data.ByteString.Unsafe (unsafePackAddressLen)
import Data.Either (lefts, rights)
import GHC.Exts (Int(..))
import Language.Haskell.TH
import Network.Mime (MimeType, defaultMimeLookup)
import System.IO.Unsafe (unsafeDupablePerformIO)
import WaiAppStatic.Types
import WaiAppStatic.Storage.Filesystem (defaultWebAppSettings)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
#if !MIN_VERSION_template_haskell(2, 8, 0)
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Lazy.Char8 as BL8
#endif
import qualified Data.HashMap.Strict as M
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Network.Wai as W

-- | An Etag is used to return 304 Not Modified responses so the client does not need
--   to download resources a second time.  Usually the etag is built from a hash of
--   the content.  To disable Etags, you can pass the empty string.  This will cause the
--   content to be redownloaded on every request.
type Etag = T.Text

-- | Used at compile time to hold data about an entry to embed into the compiled executable.
data EmbeddableEntry = EmbeddableEntry {
    EmbeddableEntry -> Text
eLocation :: T.Text        -- ^ The location where this resource should be served from.  The
                               --   location can contain forward slashes (/) to simulate directories,
                               --   but must not end with a forward slash.
  , EmbeddableEntry -> ByteString
eMimeType :: MimeType      -- ^ The mime type.
  , EmbeddableEntry -> Either (Text, ByteString) ExpQ
eContent  :: Either (Etag, BL.ByteString) ExpQ
                    -- ^ The content itself.  The content can be given as a tag and bytestring,
                    --   in which case the content will be embedded directly into the execuatble.
                    --   Alternatively, the content can be given as a template haskell expression
                    --   returning @IO ('Etag', 'BL.ByteString')@ in which case this action will
                    --   be executed on every request to reload the content (this is useful
                    --   for a debugging mode).
}

-- | This structure is used at runtime to hold the entry.
data EmbeddedEntry = EmbeddedEntry {
    EmbeddedEntry -> Text
embLocation   :: !T.Text
  , EmbeddedEntry -> ByteString
embMime       :: !MimeType
  , EmbeddedEntry -> ByteString
embEtag       :: !B.ByteString
  , EmbeddedEntry -> Bool
embCompressed :: !Bool
  , EmbeddedEntry -> ByteString
embContent    :: !B.ByteString
}

-- | This structure is used at runtime to hold the reload entries.
data ReloadEntry = ReloadEntry {
    ReloadEntry -> Text
reloadLocation :: !T.Text
  , ReloadEntry -> ByteString
reloadMime     :: !MimeType
  , ReloadEntry -> IO (Text, ByteString)
reloadContent  :: IO (T.Text, BL.ByteString)
}

-- The use of unsafePackAddressLen is safe here because the length
-- is correct and we will only be reading from the bytestring, never
-- modifying it.
--
-- The only IO within unsafePackAddressLen is within newForeignPtr_ where
-- a new IORef is created as newIORef (NoFinalizers, []) to hold the finalizer
-- for the pointer.  Since the pointer for the content will never have a finalizer
-- added, we do not care if this finalizer IORef gets created more than once since
-- the IORef will always be holding (NoFinalizers, []).  Therefore
-- unsafeDupablePerformIO is safe.
bytestringE :: B.ByteString -> ExpQ
#if MIN_VERSION_template_haskell(2, 8, 0)
bytestringE :: ByteString -> ExpQ
bytestringE ByteString
b = [| unsafeDupablePerformIO (unsafePackAddressLen (I# $ExpQ
lenE) $ExpQ
ctE) |]
    where
        lenE :: ExpQ
lenE = Lit -> ExpQ
forall (m :: * -> *). Quote m => Lit -> m Exp
litE (Lit -> ExpQ) -> Lit -> ExpQ
forall a b. (a -> b) -> a -> b
$ Integer -> Lit
intPrimL (Integer -> Lit) -> Integer -> Lit
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
b
        ctE :: ExpQ
ctE = Lit -> ExpQ
forall (m :: * -> *). Quote m => Lit -> m Exp
litE (Lit -> ExpQ) -> Lit -> ExpQ
forall a b. (a -> b) -> a -> b
$ [Word8] -> Lit
stringPrimL ([Word8] -> Lit) -> [Word8] -> Lit
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
B.unpack ByteString
b
#else
bytestringE b =
    [| B8.pack $s |]
  where
    s = litE $ stringL $ B8.unpack b
#endif

bytestringLazyE :: BL.ByteString -> ExpQ
#if MIN_VERSION_template_haskell(2, 8, 0)
bytestringLazyE :: ByteString -> ExpQ
bytestringLazyE ByteString
b = [| unsafeDupablePerformIO (unsafePackAddressLen (I# $ExpQ
lenE) $ExpQ
ctE) |]
    where
        lenE :: ExpQ
lenE = Lit -> ExpQ
forall (m :: * -> *). Quote m => Lit -> m Exp
litE (Lit -> ExpQ) -> Lit -> ExpQ
forall a b. (a -> b) -> a -> b
$ Integer -> Lit
intPrimL (Integer -> Lit) -> Integer -> Lit
forall a b. (a -> b) -> a -> b
$ Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Int64 -> Integer) -> Int64 -> Integer
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
BL.length ByteString
b
        ctE :: ExpQ
ctE = Lit -> ExpQ
forall (m :: * -> *). Quote m => Lit -> m Exp
litE (Lit -> ExpQ) -> Lit -> ExpQ
forall a b. (a -> b) -> a -> b
$ [Word8] -> Lit
stringPrimL ([Word8] -> Lit) -> [Word8] -> Lit
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
BL.unpack ByteString
b
#else
bytestringLazyE b =
    [| B8.pack $s |]
  where
    s = litE $ stringL $ BL8.unpack b
#endif

-- | A template haskell expression which creates either an EmbeddedEntry or ReloadEntry.
mkEntry :: EmbeddableEntry -> ExpQ
mkEntry :: EmbeddableEntry -> ExpQ
mkEntry (EmbeddableEntry Text
loc ByteString
mime (Left (Text
etag, ByteString
ct))) =
        [| Left $ EmbeddedEntry (T.pack $ExpQ
locE)
                                $(ByteString -> ExpQ
bytestringE ByteString
mime)
                                $(ByteString -> ExpQ
bytestringE (ByteString -> ExpQ) -> ByteString -> ExpQ
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 Text
etag)
                                (1 == I# $ExpQ
compressedE)
                                $(ByteString -> ExpQ
bytestringLazyE ByteString
ct')
        |]
    where
        locE :: ExpQ
locE = Lit -> ExpQ
forall (m :: * -> *). Quote m => Lit -> m Exp
litE (Lit -> ExpQ) -> Lit -> ExpQ
forall a b. (a -> b) -> a -> b
$ String -> Lit
stringL (String -> Lit) -> String -> Lit
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
loc
        (Bool
compressed, ByteString
ct') = ByteString -> ByteString -> (Bool, ByteString)
tryCompress ByteString
mime ByteString
ct
        compressedE :: ExpQ
compressedE = Lit -> ExpQ
forall (m :: * -> *). Quote m => Lit -> m Exp
litE (Lit -> ExpQ) -> Lit -> ExpQ
forall a b. (a -> b) -> a -> b
$ Integer -> Lit
intPrimL (Integer -> Lit) -> Integer -> Lit
forall a b. (a -> b) -> a -> b
$ if Bool
compressed then Integer
1 else Integer
0

mkEntry (EmbeddableEntry Text
loc ByteString
mime (Right ExpQ
expr)) =
        [| Right $ ReloadEntry (T.pack $ExpQ
locE)
                               $(ByteString -> ExpQ
bytestringE ByteString
mime)
                               $ExpQ
expr
        |]
    where
        locE :: ExpQ
locE = Lit -> ExpQ
forall (m :: * -> *). Quote m => Lit -> m Exp
litE (Lit -> ExpQ) -> Lit -> ExpQ
forall a b. (a -> b) -> a -> b
$ String -> Lit
stringL (String -> Lit) -> String -> Lit
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
loc

-- | Converts an embedded entry to a file
embeddedToFile :: EmbeddedEntry -> File
embeddedToFile :: EmbeddedEntry -> File
embeddedToFile EmbeddedEntry
entry = File
    { fileGetSize :: Integer
fileGetSize = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ EmbeddedEntry -> ByteString
embContent EmbeddedEntry
entry
    , fileToResponse :: Status -> ResponseHeaders -> Response
fileToResponse = \Status
s ResponseHeaders
h ->
        let h' :: ResponseHeaders
h' = if EmbeddedEntry -> Bool
embCompressed EmbeddedEntry
entry
                    then ResponseHeaders
h ResponseHeaders -> ResponseHeaders -> ResponseHeaders
forall a. [a] -> [a] -> [a]
++ [(HeaderName
"Content-Encoding", ByteString
"gzip")]
                    else ResponseHeaders
h
         in Status -> ResponseHeaders -> Builder -> Response
W.responseBuilder Status
s ResponseHeaders
h' (Builder -> Response) -> Builder -> Response
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
byteStringInsert (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ EmbeddedEntry -> ByteString
embContent EmbeddedEntry
entry

    -- Usually the fileName should just be the filename not the entire path,
    -- but we need the whole path to make the lookup within lookupMime
    -- possible.  lookupMime is provided only with the File and from that
    -- we must find the mime type. Putting the path here is OK since
    -- within staticApp the fileName is used for directory listings which
    -- we have disabled.
    , fileName :: Piece
fileName = Text -> Piece
unsafeToPiece (Text -> Piece) -> Text -> Piece
forall a b. (a -> b) -> a -> b
$ EmbeddedEntry -> Text
embLocation EmbeddedEntry
entry
    , fileGetHash :: IO (Maybe ByteString)
fileGetHash = Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString -> IO (Maybe ByteString))
-> Maybe ByteString -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ if ByteString -> Bool
B.null (EmbeddedEntry -> ByteString
embEtag EmbeddedEntry
entry)
                                 then Maybe ByteString
forall a. Maybe a
Nothing
                                 else ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ EmbeddedEntry -> ByteString
embEtag EmbeddedEntry
entry
    , fileGetModified :: Maybe EpochTime
fileGetModified = Maybe EpochTime
forall a. Maybe a
Nothing
    }

-- | Converts a reload entry to a file
reloadToFile :: ReloadEntry -> IO File
reloadToFile :: ReloadEntry -> IO File
reloadToFile ReloadEntry
entry = do
    (Text
etag, ByteString
ct) <- ReloadEntry -> IO (Text, ByteString)
reloadContent ReloadEntry
entry
    let etag' :: ByteString
etag' = Text -> ByteString
T.encodeUtf8 Text
etag
    File -> IO File
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (File -> IO File) -> File -> IO File
forall a b. (a -> b) -> a -> b
$ File
        { fileGetSize :: Integer
fileGetSize = Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Integer) -> Int64 -> Integer
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
BL.length ByteString
ct
        , fileToResponse :: Status -> ResponseHeaders -> Response
fileToResponse = \Status
s ResponseHeaders
h -> Status -> ResponseHeaders -> ByteString -> Response
W.responseLBS Status
s ResponseHeaders
h ByteString
ct
        -- Similar to above the entire path needs to be in the fileName.
        , fileName :: Piece
fileName = Text -> Piece
unsafeToPiece (Text -> Piece) -> Text -> Piece
forall a b. (a -> b) -> a -> b
$ ReloadEntry -> Text
reloadLocation ReloadEntry
entry
        , fileGetHash :: IO (Maybe ByteString)
fileGetHash = Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString -> IO (Maybe ByteString))
-> Maybe ByteString -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ if Text -> Bool
T.null Text
etag then Maybe ByteString
forall a. Maybe a
Nothing else ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
etag'
        , fileGetModified :: Maybe EpochTime
fileGetModified = Maybe EpochTime
forall a. Maybe a
Nothing
        }


-- | Build a static settings based on a filemap.
filemapToSettings :: M.HashMap T.Text (MimeType, IO File) -> StaticSettings
filemapToSettings :: HashMap Text (ByteString, IO File) -> StaticSettings
filemapToSettings HashMap Text (ByteString, IO File)
mfiles = (String -> StaticSettings
defaultWebAppSettings String
"")
                              { ssLookupFile :: Pieces -> IO LookupResult
ssLookupFile = Pieces -> IO LookupResult
lookupFile
                              , ssGetMimeType :: File -> IO ByteString
ssGetMimeType = File -> IO ByteString
forall {m :: * -> *}. Monad m => File -> m ByteString
lookupMime
                              }
    where
        piecesToFile :: Pieces -> Text
piecesToFile Pieces
p = Text -> [Text] -> Text
T.intercalate Text
"/" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Piece -> Text) -> Pieces -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Piece -> Text
fromPiece Pieces
p

        lookupFile :: Pieces -> IO LookupResult
lookupFile [] = LookupResult -> IO LookupResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return LookupResult
LRNotFound
        lookupFile Pieces
p =
            case Text
-> HashMap Text (ByteString, IO File)
-> Maybe (ByteString, IO File)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup (Pieces -> Text
piecesToFile Pieces
p) HashMap Text (ByteString, IO File)
mfiles of
                Maybe (ByteString, IO File)
Nothing -> LookupResult -> IO LookupResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return LookupResult
LRNotFound
                Just (ByteString
_,IO File
act) -> File -> LookupResult
LRFile (File -> LookupResult) -> IO File -> IO LookupResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO File
act

        lookupMime :: File -> m ByteString
lookupMime (File { fileName :: File -> Piece
fileName = Piece
p }) =
            case Text
-> HashMap Text (ByteString, IO File)
-> Maybe (ByteString, IO File)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup (Piece -> Text
fromPiece Piece
p) HashMap Text (ByteString, IO File)
mfiles of
                Just (ByteString
mime,IO File
_) -> ByteString -> m ByteString
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
mime
                Maybe (ByteString, IO File)
Nothing -> ByteString -> m ByteString
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
defaultMimeLookup (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Piece -> Text
fromPiece Piece
p

-- | Create a 'StaticSettings' from a list of entries.  Executed at run time.
entriesToSt :: [Either EmbeddedEntry ReloadEntry] -> StaticSettings
entriesToSt :: [Either EmbeddedEntry ReloadEntry] -> StaticSettings
entriesToSt [Either EmbeddedEntry ReloadEntry]
entries = HashMap Text (ByteString, IO File)
hmap HashMap Text (ByteString, IO File)
-> StaticSettings -> StaticSettings
forall a b. a -> b -> b
`seq` HashMap Text (ByteString, IO File) -> StaticSettings
filemapToSettings HashMap Text (ByteString, IO File)
hmap
    where
        embFiles :: [(Text, (ByteString, IO File))]
embFiles = [ (EmbeddedEntry -> Text
embLocation EmbeddedEntry
e, (EmbeddedEntry -> ByteString
embMime EmbeddedEntry
e, File -> IO File
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (File -> IO File) -> File -> IO File
forall a b. (a -> b) -> a -> b
$ EmbeddedEntry -> File
embeddedToFile EmbeddedEntry
e)) | EmbeddedEntry
e <- [Either EmbeddedEntry ReloadEntry] -> [EmbeddedEntry]
forall a b. [Either a b] -> [a]
lefts [Either EmbeddedEntry ReloadEntry]
entries]
        reloadFiles :: [(Text, (ByteString, IO File))]
reloadFiles = [ (ReloadEntry -> Text
reloadLocation ReloadEntry
r, (ReloadEntry -> ByteString
reloadMime ReloadEntry
r, ReloadEntry -> IO File
reloadToFile ReloadEntry
r)) | ReloadEntry
r <- [Either EmbeddedEntry ReloadEntry] -> [ReloadEntry]
forall a b. [Either a b] -> [b]
rights [Either EmbeddedEntry ReloadEntry]
entries]
        hmap :: HashMap Text (ByteString, IO File)
hmap = [(Text, (ByteString, IO File))]
-> HashMap Text (ByteString, IO File)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList ([(Text, (ByteString, IO File))]
 -> HashMap Text (ByteString, IO File))
-> [(Text, (ByteString, IO File))]
-> HashMap Text (ByteString, IO File)
forall a b. (a -> b) -> a -> b
$ [(Text, (ByteString, IO File))]
embFiles [(Text, (ByteString, IO File))]
-> [(Text, (ByteString, IO File))]
-> [(Text, (ByteString, IO File))]
forall a. [a] -> [a] -> [a]
++ [(Text, (ByteString, IO File))]
reloadFiles

-- | Create a 'StaticSettings' at compile time that embeds resources directly into the compiled
--   executable.  The embedded resources are precompressed (depending on mime type)
--   so that during runtime the resource can be served very quickly.
--
--   Because of GHC Template Haskell stage restrictions, you must define
--   the entries in a different module than where you create the 'StaticSettings'.
--   For example,
--
-- > {-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-}
-- > module A (mkEmbedded) where
-- > 
-- > import WaiAppStatic.Storage.Embedded
-- > import Crypto.Hash.MD5 (hashlazy)
-- > import qualified Data.ByteString.Lazy as BL
-- > import qualified Data.ByteString.Base64 as B64
-- > import qualified Data.Text as T
-- > import qualified Data.Text.Encoding as T
-- > 
-- > hash :: BL.ByteString -> T.Text
-- > hash = T.take 8 . T.decodeUtf8 . B64.encode . hashlazy
-- > 
-- > mkEmbedded :: IO [EmbeddableEntry]
-- > mkEmbedded = do
-- >     file <- BL.readFile "test.css"
-- >     let emb = EmbeddableEntry {
-- >                   eLocation = "somedir/test.css"
-- >                 , eMimeType = "text/css"
-- >                 , eContent  = Left (hash file, file)
-- >                 }
-- > 
-- >     let reload = EmbeddableEntry {
-- >                      eLocation = "anotherdir/test2.txt"
-- >                    , eMimeType = "text/plain"
-- >                    , eContent  = Right [| BL.readFile "test2.txt" >>= \c -> return (hash c, c) |]
-- >                    }
-- > 
-- >     return [emb, reload]
--
-- The above @mkEmbedded@ will be executed at compile time.  It loads the contents of test.css and
-- computes the hash of test.css for the etag.  The content will be available at the URL somedir/test.css.
-- Internally, 'embedApp' below will attempt to compress the content at compile time. The compression will
-- only happen if the compressed content is shorter than the original and the mime type is either text or
-- javascript.  If the content is compressed, at runtime the precomputed compressed content will be served
-- with the appropriate HTTP header. If 'embedApp' decides not to compress the content, it will be
-- served directly.
--
-- Secondly, @mkEmbedded@ creates a reloadable entry.  This will be available at the URL anotherdir/test2.txt.
-- Whenver a request comes in for anotherdir/test2.txt, the action inside the quasiquote in eContent will
-- be executed.  This will re-read the test2.txt file and recompute its hash.
--
-- Finally, here is a module which uses the above action to create a 'W.Application'.
--
-- > {-# LANGUAGE TemplateHaskell #-}
-- > module B where
-- > 
-- > import A
-- > import Network.Wai (Application)
-- > import Network.Wai.Application.Static (staticApp)
-- > import WaiAppStatic.Storage.Embedded
-- > import Network.Wai.Handler.Warp (run)
-- > 
-- > myApp :: Application
-- > myApp = staticApp $(mkSettings mkEmbedded)
-- > 
-- > main :: IO ()
-- > main = run 3000 myApp
mkSettings :: IO [EmbeddableEntry] -> ExpQ
mkSettings :: IO [EmbeddableEntry] -> ExpQ
mkSettings IO [EmbeddableEntry]
action = do
    [EmbeddableEntry]
entries <- IO [EmbeddableEntry] -> Q [EmbeddableEntry]
forall a. IO a -> Q a
runIO IO [EmbeddableEntry]
action
    [| entriesToSt $([ExpQ] -> ExpQ
forall (m :: * -> *). Quote m => [m Exp] -> m Exp
listE ([ExpQ] -> ExpQ) -> [ExpQ] -> ExpQ
forall a b. (a -> b) -> a -> b
$ (EmbeddableEntry -> ExpQ) -> [EmbeddableEntry] -> [ExpQ]
forall a b. (a -> b) -> [a] -> [b]
map EmbeddableEntry -> ExpQ
mkEntry [EmbeddableEntry]
entries) |]

shouldCompress :: MimeType -> Bool
shouldCompress :: ByteString -> Bool
shouldCompress ByteString
m = ByteString
"text/" ByteString -> ByteString -> Bool
`B.isPrefixOf` ByteString
m Bool -> Bool -> Bool
|| ByteString
m ByteString -> [ByteString] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ByteString]
extra
    where
        extra :: [ByteString]
extra = [ ByteString
"application/json"
                , ByteString
"application/javascript"
                , ByteString
"application/ecmascript"
                ]

-- | Only compress if the mime type is correct and the compressed text is actually shorter.
tryCompress :: MimeType -> BL.ByteString -> (Bool, BL.ByteString)
tryCompress :: ByteString -> ByteString -> (Bool, ByteString)
tryCompress ByteString
mime ByteString
ct
        | ByteString -> Bool
shouldCompress ByteString
mime = (Bool
c, ByteString
ct')
        | Bool
otherwise = (Bool
False, ByteString
ct)
    where
        compressed :: ByteString
compressed = ByteString -> ByteString
compress ByteString
ct
        c :: Bool
c = ByteString -> Int64
BL.length ByteString
compressed Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< ByteString -> Int64
BL.length ByteString
ct
        ct' :: ByteString
ct' = if Bool
c then ByteString
compressed else ByteString
ct