{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}

module WaiAppStatic.Storage.Embedded.TH (
    Etag,
    EmbeddableEntry (..),
    mkSettings,
) where

import Codec.Compression.GZip (compress)
import qualified Data.ByteString as B
import Data.ByteString.Builder.Extra (byteStringInsert)
import qualified Data.ByteString.Lazy as BL
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.Storage.Filesystem (defaultWebAppSettings)
import WaiAppStatic.Types
#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 = lookupFile
        , ssGetMimeType = lookupMime
        }
  where
    piecesToFile :: [Piece] -> Text
piecesToFile [Piece]
p = Text -> [Text] -> Text
T.intercalate Text
"/" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Piece -> Text) -> [Piece] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Piece -> Text
fromPiece [Piece]
p

    lookupFile :: [Piece] -> IO LookupResult
lookupFile [] = LookupResult -> IO LookupResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return LookupResult
LRNotFound
    lookupFile [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
piecesToFile [Piece]
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